From 45e428f186f1289549e61e74943bad701ed4de05 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 6 Dec 2008 18:25:35 -0600 Subject: [PATCH 01/17] fix file-systems on mac --- basis/io/unix/files/macosx/macosx.factor | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/basis/io/unix/files/macosx/macosx.factor b/basis/io/unix/files/macosx/macosx.factor index 5b128143d9..322358ba14 100644 --- a/basis/io/unix/files/macosx/macosx.factor +++ b/basis/io/unix/files/macosx/macosx.factor @@ -13,7 +13,8 @@ M: macosx file-systems ( -- array ) f dup 0 getmntinfo64 dup io-error [ *void* ] dip "statfs64" heap-size [ * memory>byte-array ] keep group - [ [ new-file-system-info ] dip statfs>file-system-info ] map ; + [ statfs64-f_mntonname utf8 alien>string file-system-info ] map ; + ! [ [ new-file-system-info ] dip statfs>file-system-info ] map ; M: macosx new-file-system-info macosx-file-system-info new ; From 294b84b659580868c1c0f8328be6ae43940b985b Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 6 Dec 2008 18:41:13 -0600 Subject: [PATCH 02/17] remove extra short definition --- extra/project-euler/117/117.factor | 3 --- 1 file changed, 3 deletions(-) diff --git a/extra/project-euler/117/117.factor b/extra/project-euler/117/117.factor index 7174066227..b90a98173e 100644 --- a/extra/project-euler/117/117.factor +++ b/extra/project-euler/117/117.factor @@ -27,9 +27,6 @@ IN: project-euler.117 Date: Sat, 6 Dec 2008 18:42:41 -0600 Subject: [PATCH 03/17] swap ... 3append -> surround in core --- core/classes/intersection/intersection.factor | 2 +- core/parser/parser.factor | 6 +++--- core/slots/slots.factor | 2 +- core/words/words.factor | 2 +- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/core/classes/intersection/intersection.factor b/core/classes/intersection/intersection.factor index fffb172204..43018f6358 100644 --- a/core/classes/intersection/intersection.factor +++ b/core/classes/intersection/intersection.factor @@ -12,7 +12,7 @@ PREDICATE: intersection-class < class [ drop t ] ] [ unclip "predicate" word-prop swap [ - "predicate" word-prop [ dup ] swap [ not ] 3append + "predicate" word-prop [ dup ] [ not ] surround [ drop f ] ] { } map>assoc alist>quot ] if-empty ; diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 3f3af935b6..4586cfe34e 100644 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -71,7 +71,7 @@ TUPLE: no-current-vocab ; : word-restarts ( name possibilities -- restarts ) natural-sort - [ [ "Use the " swap vocabulary>> " vocabulary" 3append ] keep ] { } map>assoc + [ [ vocabulary>> "Use the " " vocabulary" surround ] keep ] { } map>assoc swap "Defer word in current vocabulary" swap 2array suffix ; @@ -89,7 +89,7 @@ SYMBOL: auto-use? dup vocabulary>> [ (use+) ] [ amended-use get dup [ push ] [ 2drop ] if ] - [ "Added ``" swap "'' vocabulary to search path" 3append note. ] + [ "Added ``" "'' vocabulary to search path" surround note. ] tri ] [ create-in ] if ; @@ -292,7 +292,7 @@ print-use-hook global [ [ ] or ] change-at ] with-compilation-unit ; : parse-file-restarts ( file -- restarts ) - "Load " swap " again" 3append t 2array 1array ; + "Load " " again" surround t 2array 1array ; : parse-file ( file -- quot ) [ diff --git a/core/slots/slots.factor b/core/slots/slots.factor index 35aa49d053..187db02c5c 100644 --- a/core/slots/slots.factor +++ b/core/slots/slots.factor @@ -50,7 +50,7 @@ PREDICATE: writer < word "writer" word-prop ; define-typecheck ; : writer-word ( name -- word ) - "(>>" swap ")" 3append (( value object -- )) create-accessor + "(>>" ")" surround (( value object -- )) create-accessor dup t "writer" set-word-prop ; ERROR: bad-slot-value value class ; diff --git a/core/words/words.factor b/core/words/words.factor index b36f8be677..8c144b03a2 100644 --- a/core/words/words.factor +++ b/core/words/words.factor @@ -239,7 +239,7 @@ ERROR: bad-create name vocab ; dup [ 2nip ] [ drop dup reveal ] if ; : constructor-word ( name vocab -- word ) - [ "<" swap ">" 3append ] dip create ; + [ "<" ">" surround ] dip create ; PREDICATE: parsing-word < word "parsing" word-prop ; From c75777b7a208d0ded033e15838ae2e9d42252cc4 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 6 Dec 2008 18:58:05 -0600 Subject: [PATCH 04/17] swap ... 3append -> surround in extra --- extra/combinators/lib/lib-tests.factor | 2 +- extra/html/parser/utils/utils.factor | 4 ++-- extra/multi-methods/multi-methods.factor | 2 +- extra/parser-combinators/simple/simple-docs.factor | 4 ++-- extra/raptor/raptor.factor | 4 ++-- extra/webapps/wiki/wiki.factor | 2 +- 6 files changed, 9 insertions(+), 9 deletions(-) diff --git a/extra/combinators/lib/lib-tests.factor b/extra/combinators/lib/lib-tests.factor index 838bb08b92..9489798b9b 100755 --- a/extra/combinators/lib/lib-tests.factor +++ b/extra/combinators/lib/lib-tests.factor @@ -16,7 +16,7 @@ IN: combinators.lib.tests [ { "foo" "xbarx" } ] [ - { "oof" "bar" } { [ reverse ] [ "x" swap "x" 3append ] } parallel-call + { "oof" "bar" } { [ reverse ] [ "x" dup surround ] } parallel-call ] unit-test { 1 1 } [ diff --git a/extra/html/parser/utils/utils.factor b/extra/html/parser/utils/utils.factor index 976a5ba91f..2f414d2aa5 100644 --- a/extra/html/parser/utils/utils.factor +++ b/extra/html/parser/utils/utils.factor @@ -16,10 +16,10 @@ IN: html.parser.utils [ ?head drop ] [ ?tail drop ] bi ; : single-quote ( str -- newstr ) - "'" swap "'" 3append ; + "'" dup surround ; : double-quote ( str -- newstr ) - "\"" swap "\"" 3append ; + "\"" dup surround ; : quote ( str -- newstr ) CHAR: ' over member? diff --git a/extra/multi-methods/multi-methods.factor b/extra/multi-methods/multi-methods.factor index 682abf3a5d..14062b15db 100755 --- a/extra/multi-methods/multi-methods.factor +++ b/extra/multi-methods/multi-methods.factor @@ -102,7 +102,7 @@ SYMBOL: total { 0 [ [ dup ] ] } { 1 [ [ over ] ] } { 2 [ [ pick ] ] } - [ 1- picker [ >r ] swap [ r> swap ] 3append ] + [ 1- picker [ >r ] [ r> swap ] surround ] } case ; : (multi-predicate) ( class picker -- quot ) diff --git a/extra/parser-combinators/simple/simple-docs.factor b/extra/parser-combinators/simple/simple-docs.factor index fdf32bddb1..be6c01aab8 100755 --- a/extra/parser-combinators/simple/simple-docs.factor +++ b/extra/parser-combinators/simple/simple-docs.factor @@ -41,7 +41,7 @@ HELP: 'bold' "commonly used in markup languages to indicate bold " "faced text." } { $example "USING: parser-combinators parser-combinators.simple prettyprint ;" "\"*foo*\" 'bold' parse-1 ." "\"foo\"" } -{ $example "USING: kernel parser-combinators parser-combinators.simple prettyprint sequences ;" "\"*foo*\" 'bold' [ \"\" swap \"\" 3append ] <@ parse-1 ." "\"foo\"" } ; +{ $example "USING: kernel parser-combinators parser-combinators.simple prettyprint sequences ;" "\"*foo*\" 'bold' [ \"\" \"\" surround ] <@ parse-1 ." "\"foo\"" } ; HELP: 'italic' { $values @@ -53,7 +53,7 @@ HELP: 'italic' "faced text." } { $examples { $example "USING: parser-combinators parser-combinators.simple prettyprint ;" "\"_foo_\" 'italic' parse-1 ." "\"foo\"" } -{ $example "USING: kernel parser-combinators parser-combinators.simple prettyprint sequences ;" "\"_foo_\" 'italic' [ \"\" swap \"\" 3append ] <@ parse-1 ." "\"foo\"" } } ; +{ $example "USING: kernel parser-combinators parser-combinators.simple prettyprint sequences ;" "\"_foo_\" 'italic' [ \"\" \"\" surround ] <@ parse-1 ." "\"foo\"" } } ; HELP: comma-list { $values { "element" "a parser object" } { "parser" "a parser object" } } diff --git a/extra/raptor/raptor.factor b/extra/raptor/raptor.factor index 933275e5bf..c0605fe837 100755 --- a/extra/raptor/raptor.factor +++ b/extra/raptor/raptor.factor @@ -32,8 +32,8 @@ SYMBOL: networking-hook ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: start-service ( name -- ) "/etc/init.d/" swap " start" 3append system drop ; -: stop-service ( name -- ) "/etc/init.d/" swap " stop" 3append system drop ; +: start-service ( name -- ) "/etc/init.d/" " start" surround system drop ; +: stop-service ( name -- ) "/etc/init.d/" " stop" surround system drop ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/extra/webapps/wiki/wiki.factor b/extra/webapps/wiki/wiki.factor index b78dc25d79..f2c0600ed5 100644 --- a/extra/webapps/wiki/wiki.factor +++ b/extra/webapps/wiki/wiki.factor @@ -230,7 +230,7 @@ M: revision feed-entry-url id>> revision-url ; [ list-revisions ] >>entries ; : rollback-description ( description -- description' ) - [ "Rollback of '" swap "'" 3append ] [ "Rollback" ] if* ; + [ "Rollback of '" "'" surround ] [ "Rollback" ] if* ; : ( -- action ) From 14fb58f448c1f32c5e09b4407b9813e599cfe1be Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 6 Dec 2008 18:58:45 -0600 Subject: [PATCH 05/17] swap ... 3append -> surround in basis --- basis/bootstrap/image/image.factor | 2 +- basis/db/sqlite/sqlite.factor | 2 +- basis/html/elements/elements.factor | 6 +++--- basis/io/windows/launcher/launcher.factor | 2 +- basis/prettyprint/backend/backend.factor | 2 +- basis/smtp/smtp.factor | 6 ++++-- basis/tools/vocabs/browser/browser.factor | 2 +- basis/ui/freetype/freetype.factor | 2 +- basis/ui/tools/deploy/deploy.factor | 2 +- 9 files changed, 14 insertions(+), 12 deletions(-) diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor index 380c9b2348..c7d87776a1 100644 --- a/basis/bootstrap/image/image.factor +++ b/basis/bootstrap/image/image.factor @@ -23,7 +23,7 @@ IN: bootstrap.image os name>> cpu name>> arch ; : boot-image-name ( arch -- string ) - "boot." swap ".image" 3append ; + "boot." ".image" surround ; : my-boot-image-name ( -- string ) my-arch boot-image-name ; diff --git a/basis/db/sqlite/sqlite.factor b/basis/db/sqlite/sqlite.factor index 4e96fb5a4d..32c5ca0075 100644 --- a/basis/db/sqlite/sqlite.factor +++ b/basis/db/sqlite/sqlite.factor @@ -164,7 +164,7 @@ M: sqlite-db ( tuple -- statement ) M: sqlite-db bind# ( spec obj -- ) [ - [ column-name>> ":" swap next-sql-counter 3append dup 0% ] + [ column-name>> ":" next-sql-counter surround dup 0% ] [ type>> ] bi ] dip 1, ; diff --git a/basis/html/elements/elements.factor b/basis/html/elements/elements.factor index fa92f18d34..2149bf7bf6 100644 --- a/basis/html/elements/elements.factor +++ b/basis/html/elements/elements.factor @@ -26,7 +26,7 @@ SYMBOL: html #! dynamically creating words. [ elements-vocab create ] 2dip define-declared ; -: ( str -- ) "<" swap ">" 3append ; +: ( str -- ) "<" ">" surround ; : def-for-html-word- ( name -- ) #! Return the name and code for the patterned @@ -49,14 +49,14 @@ SYMBOL: html #! word. foo> [ ">" write-html ] (( -- )) html-word ; -: ( str -- ) "" 3append ; +: ( str -- ) "" surround ; : def-for-html-word- ( name -- ) #! Return the name and code for the patterned #! word. dup '[ _ write-html ] (( -- )) html-word ; -: ( str -- ) "<" swap "/>" 3append ; +: ( str -- ) "<" "/>" surround ; : def-for-html-word- ( name -- ) #! Return the name and code for the patterned diff --git a/basis/io/windows/launcher/launcher.factor b/basis/io/windows/launcher/launcher.factor index 212b405a54..fd31ca999f 100644 --- a/basis/io/windows/launcher/launcher.factor +++ b/basis/io/windows/launcher/launcher.factor @@ -56,7 +56,7 @@ TUPLE: CreateProcess-args : escape-argument ( str -- newstr ) CHAR: \s over member? [ - "\"" swap fix-trailing-backslashes "\"" 3append + fix-trailing-backslashes "\"" dup surround ] when ; : join-arguments ( args -- cmd-line ) diff --git a/basis/prettyprint/backend/backend.factor b/basis/prettyprint/backend/backend.factor index 7a5b16a3c2..76c3918f63 100644 --- a/basis/prettyprint/backend/backend.factor +++ b/basis/prettyprint/backend/backend.factor @@ -10,7 +10,7 @@ IN: prettyprint.backend GENERIC: pprint* ( obj -- ) -M: effect pprint* effect>string "(" swap ")" 3append text ; +M: effect pprint* effect>string "(" ")" surround text ; : ?effect-height ( word -- n ) stack-effect [ effect-height ] [ 0 ] if* ; diff --git a/basis/smtp/smtp.factor b/basis/smtp/smtp.factor index 7f14945633..f689ad0858 100644 --- a/basis/smtp/smtp.factor +++ b/basis/smtp/smtp.factor @@ -72,10 +72,12 @@ ERROR: bad-email-address email ; [ bad-email-address ] unless ; : mail-from ( fromaddr -- ) - "MAIL FROM:<" swap validate-address ">" 3append command ; + validate-address + "MAIL FROM:<" ">" surround command ; : rcpt-to ( to -- ) - "RCPT TO:<" swap validate-address ">" 3append command ; + validate-address + "RCPT TO:<" ">" surround command ; : data ( -- ) "DATA" command ; diff --git a/basis/tools/vocabs/browser/browser.factor b/basis/tools/vocabs/browser/browser.factor index 4cd5653ab4..e9e8d27870 100644 --- a/basis/tools/vocabs/browser/browser.factor +++ b/basis/tools/vocabs/browser/browser.factor @@ -289,7 +289,7 @@ M: vocab-spec article-parent drop "vocab-index" ; M: vocab-tag >link ; M: vocab-tag article-title - name>> "Vocabularies tagged ``" swap "''" 3append ; + name>> "Vocabularies tagged ``" "''" surround ; M: vocab-tag article-name name>> ; diff --git a/basis/ui/freetype/freetype.factor b/basis/ui/freetype/freetype.factor index b0d152fc88..6c0eaaa9ac 100644 --- a/basis/ui/freetype/freetype.factor +++ b/basis/ui/freetype/freetype.factor @@ -61,7 +61,7 @@ M: freetype-renderer free-fonts ( world -- ) } at ; : ttf-path ( name -- string ) - "resource:fonts/" swap ".ttf" 3append ; + "resource:fonts/" ".ttf" surround ; : (open-face) ( path length -- face ) #! We use FT_New_Memory_Face, not FT_New_Face, since diff --git a/basis/ui/tools/deploy/deploy.factor b/basis/ui/tools/deploy/deploy.factor index 127269b325..f023b0959a 100644 --- a/basis/ui/tools/deploy/deploy.factor +++ b/basis/ui/tools/deploy/deploy.factor @@ -119,5 +119,5 @@ deploy-gadget "toolbar" f { : deploy-tool ( vocab -- ) vocab-name [ 10 ] - [ "Deploying \"" swap "\"" 3append ] bi + [ "Deploying \"" "\"" surround ] bi open-window ; From 34fe5769196cd8ef82ab4643e588c4588bff6de8 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 6 Dec 2008 22:58:19 -0600 Subject: [PATCH 06/17] rename hardware-info to system-info --- extra/{hardware-info => system-info}/authors.txt | 0 .../backend/authors.txt | 0 .../backend/backend.factor | 4 +++- .../linux/authors.txt | 0 .../linux/linux.factor | 4 +++- .../{hardware-info => system-info}/linux/tags.txt | 0 .../macosx/authors.txt | 0 .../macosx/macosx.factor | 10 +++++----- .../{hardware-info => system-info}/macosx/tags.txt | 0 extra/{hardware-info => system-info}/summary.txt | 0 .../system-info.factor} | 14 ++++++++------ .../windows/authors.txt | 0 .../windows/ce/authors.txt | 0 .../windows/ce/ce.factor | 8 +++++--- .../windows/ce/tags.txt | 0 .../windows/nt/authors.txt | 0 .../windows/nt/nt.factor | 8 +++++--- .../windows/nt/tags.txt | 0 .../windows/tags.txt | 0 .../windows/windows.factor | 10 ++++++---- 20 files changed, 35 insertions(+), 23 deletions(-) rename extra/{hardware-info => system-info}/authors.txt (100%) rename extra/{hardware-info => system-info}/backend/authors.txt (100%) rename extra/{hardware-info => system-info}/backend/backend.factor (75%) rename extra/{hardware-info => system-info}/linux/authors.txt (100%) rename extra/{hardware-info => system-info}/linux/linux.factor (84%) rename extra/{hardware-info => system-info}/linux/tags.txt (100%) rename extra/{hardware-info => system-info}/macosx/authors.txt (100%) rename extra/{hardware-info => system-info}/macosx/macosx.factor (90%) rename extra/{hardware-info => system-info}/macosx/tags.txt (100%) rename extra/{hardware-info => system-info}/summary.txt (100%) rename extra/{hardware-info/hardware-info.factor => system-info/system-info.factor} (60%) rename extra/{hardware-info => system-info}/windows/authors.txt (100%) rename extra/{hardware-info => system-info}/windows/ce/authors.txt (100%) rename extra/{hardware-info => system-info}/windows/ce/ce.factor (76%) rename extra/{hardware-info => system-info}/windows/ce/tags.txt (100%) rename extra/{hardware-info => system-info}/windows/nt/authors.txt (100%) rename extra/{hardware-info => system-info}/windows/nt/nt.factor (85%) rename extra/{hardware-info => system-info}/windows/nt/tags.txt (100%) rename extra/{hardware-info => system-info}/windows/tags.txt (100%) rename extra/{hardware-info => system-info}/windows/windows.factor (87%) diff --git a/extra/hardware-info/authors.txt b/extra/system-info/authors.txt similarity index 100% rename from extra/hardware-info/authors.txt rename to extra/system-info/authors.txt diff --git a/extra/hardware-info/backend/authors.txt b/extra/system-info/backend/authors.txt similarity index 100% rename from extra/hardware-info/backend/authors.txt rename to extra/system-info/backend/authors.txt diff --git a/extra/hardware-info/backend/backend.factor b/extra/system-info/backend/backend.factor similarity index 75% rename from extra/hardware-info/backend/backend.factor rename to extra/system-info/backend/backend.factor index 283fea6fcc..6e6715f619 100644 --- a/extra/hardware-info/backend/backend.factor +++ b/extra/system-info/backend/backend.factor @@ -1,5 +1,7 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. USING: system ; -IN: hardware-info.backend +IN: system-info.backend HOOK: cpus os ( -- n ) HOOK: cpu-mhz os ( -- n ) diff --git a/extra/hardware-info/linux/authors.txt b/extra/system-info/linux/authors.txt similarity index 100% rename from extra/hardware-info/linux/authors.txt rename to extra/system-info/linux/authors.txt diff --git a/extra/hardware-info/linux/linux.factor b/extra/system-info/linux/linux.factor similarity index 84% rename from extra/hardware-info/linux/linux.factor rename to extra/system-info/linux/linux.factor index ba0cb0c170..d7f53fb9fb 100644 --- a/extra/hardware-info/linux/linux.factor +++ b/extra/system-info/linux/linux.factor @@ -1,6 +1,8 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. USING: unix alien alien.c-types kernel math sequences strings io.unix.backend splitting ; -IN: hardware-info.linux +IN: system-info.linux : (uname) ( buf -- int ) "int" f "uname" { "char*" } alien-invoke ; diff --git a/extra/hardware-info/linux/tags.txt b/extra/system-info/linux/tags.txt similarity index 100% rename from extra/hardware-info/linux/tags.txt rename to extra/system-info/linux/tags.txt diff --git a/extra/hardware-info/macosx/authors.txt b/extra/system-info/macosx/authors.txt similarity index 100% rename from extra/hardware-info/macosx/authors.txt rename to extra/system-info/macosx/authors.txt diff --git a/extra/hardware-info/macosx/macosx.factor b/extra/system-info/macosx/macosx.factor similarity index 90% rename from extra/hardware-info/macosx/macosx.factor rename to extra/system-info/macosx/macosx.factor index e3c604f2fd..a06c01b950 100644 --- a/extra/hardware-info/macosx/macosx.factor +++ b/extra/system-info/macosx/macosx.factor @@ -1,8 +1,9 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types alien.strings alien.syntax byte-arrays kernel namespaces sequences unix -hardware-info.backend system io.unix.backend io.encodings.ascii -; -IN: hardware-info.macosx +system-info.backend system io.unix.backend io.encodings.utf8 ; +IN: system-info.macosx ! See /usr/include/sys/sysctl.h for constants @@ -20,7 +21,7 @@ FUNCTION: int sysctl ( int* name, uint namelen, void* oldp, size_t* oldlenp, voi [ ] [ ] bi (sysctl-query) ; : sysctl-query-string ( seq -- n ) - 4096 sysctl-query ascii malloc-string ; + 4096 sysctl-query utf8 alien>string ; : sysctl-query-uint ( seq -- n ) 4 sysctl-query *uint ; @@ -53,4 +54,3 @@ M: macosx cpu-mhz ( -- n ) { 6 15 } sysctl-query-uint ; : tb-frequency ( -- n ) { 6 23 } sysctl-query-uint ; : mem-size ( -- n ) { 6 24 } sysctl-query-ulonglong ; : available-cpus ( -- n ) { 6 25 } sysctl-query-uint ; - diff --git a/extra/hardware-info/macosx/tags.txt b/extra/system-info/macosx/tags.txt similarity index 100% rename from extra/hardware-info/macosx/tags.txt rename to extra/system-info/macosx/tags.txt diff --git a/extra/hardware-info/summary.txt b/extra/system-info/summary.txt similarity index 100% rename from extra/hardware-info/summary.txt rename to extra/system-info/summary.txt diff --git a/extra/hardware-info/hardware-info.factor b/extra/system-info/system-info.factor similarity index 60% rename from extra/hardware-info/hardware-info.factor rename to extra/system-info/system-info.factor index cc345c7537..5bf886abd8 100755 --- a/extra/hardware-info/hardware-info.factor +++ b/extra/system-info/system-info.factor @@ -1,6 +1,8 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. USING: alien.syntax kernel math prettyprint io math.parser -combinators vocabs.loader hardware-info.backend system ; -IN: hardware-info +combinators vocabs.loader system-info.backend system ; +IN: system-info : write-unit ( x n str -- ) [ 2^ /f number>string write bl ] [ write ] bi* ; @@ -11,13 +13,13 @@ IN: hardware-info : ghz ( x -- ) 1000000000 /f number>string write bl "GHz" write ; << { - { [ os windows? ] [ "hardware-info.windows" ] } - { [ os linux? ] [ "hardware-info.linux" ] } - { [ os macosx? ] [ "hardware-info.macosx" ] } + { [ os windows? ] [ "system-info.windows" ] } + { [ os linux? ] [ "system-info.linux" ] } + { [ os macosx? ] [ "system-info.macosx" ] } [ f ] } cond [ require ] when* >> -: hardware-report. ( -- ) +: system-report. ( -- ) "CPUs: " write cpus number>string write nl "CPU Speed: " write cpu-mhz ghz nl "Physical RAM: " write physical-mem megs nl ; diff --git a/extra/hardware-info/windows/authors.txt b/extra/system-info/windows/authors.txt similarity index 100% rename from extra/hardware-info/windows/authors.txt rename to extra/system-info/windows/authors.txt diff --git a/extra/hardware-info/windows/ce/authors.txt b/extra/system-info/windows/ce/authors.txt similarity index 100% rename from extra/hardware-info/windows/ce/authors.txt rename to extra/system-info/windows/ce/authors.txt diff --git a/extra/hardware-info/windows/ce/ce.factor b/extra/system-info/windows/ce/ce.factor similarity index 76% rename from extra/hardware-info/windows/ce/ce.factor rename to extra/system-info/windows/ce/ce.factor index 6537661b3e..13c7cb9433 100755 --- a/extra/hardware-info/windows/ce/ce.factor +++ b/extra/system-info/windows/ce/ce.factor @@ -1,6 +1,8 @@ -USING: alien.c-types hardware-info kernel math namespaces -windows windows.kernel32 hardware-info.backend system ; -IN: hardware-info.windows.ce +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.c-types system-info kernel math namespaces +windows windows.kernel32 system-info.backend system ; +IN: system-info.windows.ce : memory-status ( -- MEMORYSTATUS ) "MEMORYSTATUS" diff --git a/extra/hardware-info/windows/ce/tags.txt b/extra/system-info/windows/ce/tags.txt similarity index 100% rename from extra/hardware-info/windows/ce/tags.txt rename to extra/system-info/windows/ce/tags.txt diff --git a/extra/hardware-info/windows/nt/authors.txt b/extra/system-info/windows/nt/authors.txt similarity index 100% rename from extra/hardware-info/windows/nt/authors.txt rename to extra/system-info/windows/nt/authors.txt diff --git a/extra/hardware-info/windows/nt/nt.factor b/extra/system-info/windows/nt/nt.factor similarity index 85% rename from extra/hardware-info/windows/nt/nt.factor rename to extra/system-info/windows/nt/nt.factor index 6274e7974c..7f71e08e83 100755 --- a/extra/hardware-info/windows/nt/nt.factor +++ b/extra/system-info/windows/nt/nt.factor @@ -1,8 +1,10 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types alien.strings -kernel libc math namespaces hardware-info.backend -hardware-info.windows windows windows.advapi32 +kernel libc math namespaces system-info.backend +system-info.windows windows windows.advapi32 windows.kernel32 system byte-arrays ; -IN: hardware-info.windows.nt +IN: system-info.windows.nt M: winnt cpus ( -- n ) system-info SYSTEM_INFO-dwNumberOfProcessors ; diff --git a/extra/hardware-info/windows/nt/tags.txt b/extra/system-info/windows/nt/tags.txt similarity index 100% rename from extra/hardware-info/windows/nt/tags.txt rename to extra/system-info/windows/nt/tags.txt diff --git a/extra/hardware-info/windows/tags.txt b/extra/system-info/windows/tags.txt similarity index 100% rename from extra/hardware-info/windows/tags.txt rename to extra/system-info/windows/tags.txt diff --git a/extra/hardware-info/windows/windows.factor b/extra/system-info/windows/windows.factor similarity index 87% rename from extra/hardware-info/windows/windows.factor rename to extra/system-info/windows/windows.factor index d3ebe87501..66abb59ee9 100755 --- a/extra/hardware-info/windows/windows.factor +++ b/extra/system-info/windows/windows.factor @@ -1,8 +1,10 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types kernel libc math namespaces windows windows.kernel32 windows.advapi32 -words combinators vocabs.loader hardware-info.backend +words combinators vocabs.loader system-info.backend system alien.strings ; -IN: hardware-info.windows +IN: system-info.windows : system-info ( -- SYSTEM_INFO ) "SYSTEM_INFO" [ GetSystemInfo ] keep ; @@ -65,6 +67,6 @@ IN: hardware-info.windows << { - { [ os wince? ] [ "hardware-info.windows.ce" ] } - { [ os winnt? ] [ "hardware-info.windows.nt" ] } + { [ os wince? ] [ "system-info.windows.ce" ] } + { [ os winnt? ] [ "system-info.windows.nt" ] } } cond require >> From 9b8fdfc1542ba08915f28636b4de5f2ab8120cbf Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 6 Dec 2008 23:01:17 -0600 Subject: [PATCH 07/17] clean up extra crypto a bit --- extra/crypto/barrett/barrett.factor | 2 -- extra/crypto/hmac/hmac.factor | 2 ++ extra/crypto/timing/timing.factor | 2 ++ extra/crypto/xor/xor.factor | 2 +- 4 files changed, 5 insertions(+), 3 deletions(-) diff --git a/extra/crypto/barrett/barrett.factor b/extra/crypto/barrett/barrett.factor index 25e67d01ce..9d5c65aa94 100644 --- a/extra/crypto/barrett/barrett.factor +++ b/extra/crypto/barrett/barrett.factor @@ -8,5 +8,3 @@ IN: crypto.barrett #! size = word size in bits (8, 16, 32, 64, ...) [ [ log2 1+ ] [ / 2 * ] bi* ] [ 2^ rot ^ swap /i ] 2bi ; - - diff --git a/extra/crypto/hmac/hmac.factor b/extra/crypto/hmac/hmac.factor index d98e8a9798..b480c18913 100755 --- a/extra/crypto/hmac/hmac.factor +++ b/extra/crypto/hmac/hmac.factor @@ -1,3 +1,5 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. USING: arrays combinators checksums checksums.md5 checksums.sha1 checksums.md5.private io io.binary io.files io.streams.byte-array kernel math math.vectors memoize sequences diff --git a/extra/crypto/timing/timing.factor b/extra/crypto/timing/timing.factor index 8fdb807c6a..b2a59a1851 100644 --- a/extra/crypto/timing/timing.factor +++ b/extra/crypto/timing/timing.factor @@ -1,3 +1,5 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. USING: kernel math threads system calendar ; IN: crypto.timing diff --git a/extra/crypto/xor/xor.factor b/extra/crypto/xor/xor.factor index 6e3a605f5c..662881f8cc 100644 --- a/extra/crypto/xor/xor.factor +++ b/extra/crypto/xor/xor.factor @@ -8,5 +8,5 @@ IN: crypto.xor ERROR: empty-xor-key ; : xor-crypt ( seq key -- seq' ) - dup empty? [ empty-xor-key ] when + [ empty-xor-key ] when-empty [ dup length ] dip '[ _ mod-nth bitxor ] 2map ; From 3821b417af1ace5fa5006962719a75eac141de5f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 6 Dec 2008 23:04:54 -0600 Subject: [PATCH 08/17] remove finance words from calendar --- basis/calendar/calendar-docs.factor | 42 ----------------------------- basis/calendar/calendar.factor | 7 ----- 2 files changed, 49 deletions(-) diff --git a/basis/calendar/calendar-docs.factor b/basis/calendar/calendar-docs.factor index 748f9d124c..3d765aeed9 100644 --- a/basis/calendar/calendar-docs.factor +++ b/basis/calendar/calendar-docs.factor @@ -99,48 +99,6 @@ HELP: seconds-per-year { $values { "integer" integer } } { $description "Returns the number of seconds in a year averaged over 400 years. Used internally for adding an arbitrary real number of seconds to a timestamp." } ; -HELP: biweekly -{ $values - { "x" number } - { "y" number } -} -{ $description "Divides a number by the number of two week periods in a year." } ; - -HELP: daily-360 -{ $values - { "x" number } - { "y" number } -} -{ $description "Divides a number by the number of days in a 360-day year." } ; - -HELP: daily-365 -{ $values - { "x" number } - { "y" number } -} -{ $description "Divides a number by the number of days in a 365-day year." } ; - -HELP: monthly -{ $values - { "x" number } - { "y" number } -} -{ $description "Divides a number by the number of months in a year." } ; - -HELP: semimonthly -{ $values - { "x" number } - { "y" number } -} -{ $description "Divides a number by the number of half-months in a year. Note that biweekly has two more periods than semimonthly." } ; - -HELP: weekly -{ $values - { "x" number } - { "y" number } -} -{ $description "Divides a number by the number of weeks in a year." } ; - HELP: julian-day-number { $values { "year" integer } { "month" integer } { "day" integer } { "n" integer } } { $description "Calculates the Julian day number from a year, month, and day. The difference between two Julian day numbers is the number of days that have elapsed between the two corresponding dates." } diff --git a/basis/calendar/calendar.factor b/basis/calendar/calendar.factor index e2564b5a28..793c771b64 100644 --- a/basis/calendar/calendar.factor +++ b/basis/calendar/calendar.factor @@ -89,13 +89,6 @@ PRIVATE> : minutes-per-year ( -- ratio ) 5259492/10 ; inline : seconds-per-year ( -- integer ) 31556952 ; inline -: monthly ( x -- y ) 12 / ; inline -: semimonthly ( x -- y ) 24 / ; inline -: biweekly ( x -- y ) 26 / ; inline -: weekly ( x -- y ) 52 / ; inline -: daily-360 ( x -- y ) 360 / ; inline -: daily-365 ( x -- y ) 365 / ; inline - :: julian-day-number ( year month day -- n ) #! Returns a composite date number #! Not valid before year -4800 From e4efe6ec24832848efca2c6e9332cbb0df3992c5 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 6 Dec 2008 23:05:02 -0600 Subject: [PATCH 09/17] add finance words to math.finance --- extra/math/finance/finance-docs.factor | 41 ++++++++++++++++++++++++++ extra/math/finance/finance.factor | 11 +++++++ 2 files changed, 52 insertions(+) diff --git a/extra/math/finance/finance-docs.factor b/extra/math/finance/finance-docs.factor index 5024e83bff..97e44d2927 100644 --- a/extra/math/finance/finance-docs.factor +++ b/extra/math/finance/finance-docs.factor @@ -32,3 +32,44 @@ HELP: momentum { $list "MOM[t] = SEQ[t] - SEQ[t-n]" } } ; +HELP: biweekly +{ $values + { "x" number } + { "y" number } +} +{ $description "Divides a number by the number of two week periods in a year." } ; + +HELP: daily-360 +{ $values + { "x" number } + { "y" number } +} +{ $description "Divides a number by the number of days in a 360-day year." } ; + +HELP: daily-365 +{ $values + { "x" number } + { "y" number } +} +{ $description "Divides a number by the number of days in a 365-day year." } ; + +HELP: monthly +{ $values + { "x" number } + { "y" number } +} +{ $description "Divides a number by the number of months in a year." } ; + +HELP: semimonthly +{ $values + { "x" number } + { "y" number } +} +{ $description "Divides a number by the number of half-months in a year. Note that biweekly has two more periods than semimonthly." } ; + +HELP: weekly +{ $values + { "x" number } + { "y" number } +} +{ $description "Divides a number by the number of weeks in a year." } ; diff --git a/extra/math/finance/finance.factor b/extra/math/finance/finance.factor index e02f4be624..a1f2316c38 100644 --- a/extra/math/finance/finance.factor +++ b/extra/math/finance/finance.factor @@ -26,3 +26,14 @@ PRIVATE> : momentum ( seq n -- newseq ) [ tail-slice ] 2keep [ dup length ] dip - head-slice v- ; +: monthly ( x -- y ) 12 / ; inline + +: semimonthly ( x -- y ) 24 / ; inline + +: biweekly ( x -- y ) 26 / ; inline + +: weekly ( x -- y ) 52 / ; inline + +: daily-360 ( x -- y ) 360 / ; inline + +: daily-365 ( x -- y ) 365 / ; inline From 4a5bf7e9d18fc6faba6a7d77b9024ada4468799a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 6 Dec 2008 23:08:18 -0600 Subject: [PATCH 10/17] remove moved docs --- basis/calendar/calendar-docs.factor | 14 -------------- 1 file changed, 14 deletions(-) diff --git a/basis/calendar/calendar-docs.factor b/basis/calendar/calendar-docs.factor index 3d765aeed9..433459cb24 100644 --- a/basis/calendar/calendar-docs.factor +++ b/basis/calendar/calendar-docs.factor @@ -540,8 +540,6 @@ ARTICLE: "calendar" "Calendar" { $subsection "years" } { $subsection "months" } { $subsection "days" } -"Calculating amounts per period of time:" -{ $subsection "time-period-calculations" } "Meta-data about the calendar:" { $subsection "calendar-facts" } ; @@ -628,18 +626,6 @@ ARTICLE: "calendar-facts" "Calendar facts" { $subsection day-of-week } ; -ARTICLE: "time-period-calculations" "Calculations over periods of time" -{ $subsection monthly } -{ $subsection semimonthly } -{ $subsection biweekly } -{ $subsection weekly } -{ $subsection daily-360 } -{ $subsection daily-365 } -{ $subsection biweekly } -{ $subsection biweekly } -{ $subsection biweekly } -; - ARTICLE: "years" "Year operations" "Leap year predicate:" { $subsection leap-year? } From 3075eeb4ab4f395286004ba89622076bcb70c4a7 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 6 Dec 2008 23:12:38 -0600 Subject: [PATCH 11/17] fix math docs, refactor a bit --- extra/math/finance/finance-docs.factor | 21 +++++++++++++++---- extra/math/finance/finance.factor | 2 +- .../numerical-integration.factor | 9 ++++---- 3 files changed, 23 insertions(+), 9 deletions(-) diff --git a/extra/math/finance/finance-docs.factor b/extra/math/finance/finance-docs.factor index 97e44d2927..a1e81bf665 100644 --- a/extra/math/finance/finance-docs.factor +++ b/extra/math/finance/finance-docs.factor @@ -1,8 +1,6 @@ -! Copyright (C) 2008 John Benediktsson +! Copyright (C) 2008 John Benediktsson, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license - -USING: help.markup help.syntax ; - +USING: help.markup help.syntax math ; IN: math.finance HELP: sma @@ -73,3 +71,18 @@ HELP: weekly { "y" number } } { $description "Divides a number by the number of weeks in a year." } ; + +ARTICLE: "time-period-calculations" "Calculations over periods of time" +{ $subsection monthly } +{ $subsection semimonthly } +{ $subsection biweekly } +{ $subsection weekly } +{ $subsection daily-360 } +{ $subsection daily-365 } ; + +ARTICLE: "math.finance" "Financial math" +"The " { $vocab-link "math.finance" } " vocabulary contains financial calculation words." $nl +"Calculating payroll over periods of time:" +{ $subsection "time-period-calculations" } ; + +ABOUT: "math.finance" diff --git a/extra/math/finance/finance.factor b/extra/math/finance/finance.factor index a1f2316c38..4823e358b0 100644 --- a/extra/math/finance/finance.factor +++ b/extra/math/finance/finance.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2008 John Benediktsson. +! Copyright (C) 2008 John Benediktsson, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: arrays assocs kernel grouping sequences shuffle math math.functions math.statistics math.vectors ; diff --git a/extra/math/numerical-integration/numerical-integration.factor b/extra/math/numerical-integration/numerical-integration.factor index dfaa618b53..6b46ba0243 100644 --- a/extra/math/numerical-integration/numerical-integration.factor +++ b/extra/math/numerical-integration/numerical-integration.factor @@ -4,15 +4,16 @@ USING: arrays kernel sequences namespaces make math math.ranges math.vectors vectors ; IN: math.numerical-integration -SYMBOL: num-steps 180 num-steps set-global +SYMBOL: num-steps + +180 num-steps set-global : setup-simpson-range ( from to -- frange ) 2dup swap - num-steps get / ; : generate-simpson-weights ( seq -- seq ) - { 1 4 } - swap length 2 / 2 - { 2 4 } concat - { 1 } 3append ; + length 2 / 2 - { 2 4 } concat + { 1 4 } { 1 } surround ; : integrate-simpson ( from to f -- x ) [ setup-simpson-range dup ] dip From 5d7472caf88ef2309c27a1ef5ec87021f0170f4e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 6 Dec 2008 23:38:04 -0600 Subject: [PATCH 12/17] refactor extra inverse a bit --- extra/inverse/inverse.factor | 58 +++++++++++++++++++----------------- 1 file changed, 30 insertions(+), 28 deletions(-) diff --git a/extra/inverse/inverse.factor b/extra/inverse/inverse.factor index 61c5da6bca..0e3d48fe5b 100755 --- a/extra/inverse/inverse.factor +++ b/extra/inverse/inverse.factor @@ -9,14 +9,12 @@ combinators.short-circuit fry qualified ; RENAME: _ fry => __ IN: inverse -TUPLE: fail ; -: fail ( -- * ) \ fail new throw ; +ERROR: fail ; M: fail summary drop "Unification failed" ; : assure ( ? -- ) [ fail ] unless ; -: =/fail ( obj1 obj2 -- ) - = assure ; +: =/fail ( obj1 obj2 -- ) = assure ; ! Inverse of a quotation @@ -26,25 +24,26 @@ M: fail summary drop "Unification failed" ; pick 1quotation 3array "math-inverse" set-word-prop ; : define-pop-inverse ( word n quot -- ) - >r dupd "pop-length" set-word-prop r> + [ dupd "pop-length" set-word-prop ] dip "pop-inverse" set-word-prop ; -TUPLE: no-inverse word ; -: no-inverse ( word -- * ) \ no-inverse new throw ; +ERROR: no-inverse word ; M: no-inverse summary drop "The word cannot be used in pattern matching" ; +ERROR: bad-math-inverse ; + : next ( revquot -- revquot* first ) - [ "Badly formed math inverse" throw ] + [ bad-math-inverse ] [ unclip-slice ] if-empty ; : constant-word? ( word -- ? ) stack-effect - [ out>> length 1 = ] keep - in>> length 0 = and ; + [ out>> length 1 = ] + [ in>> empty? ] bi and ; : assure-constant ( constant -- quot ) - dup word? [ "Badly formed math inverse" throw ] when 1quotation ; + dup word? [ bad-math-inverse ] when 1quotation ; : swap-inverse ( math-inverse revquot -- revquot* quot ) next assure-constant rot second '[ @ swap @ ] ; @@ -55,8 +54,7 @@ M: no-inverse summary : ?word-prop ( word/object name -- value/f ) over word? [ word-prop ] [ 2drop f ] if ; -: undo-literal ( object -- quot ) - [ =/fail ] curry ; +: undo-literal ( object -- quot ) [ =/fail ] curry ; PREDICATE: normal-inverse < word "inverse" word-prop ; PREDICATE: math-inverse < word "math-inverse" word-prop ; @@ -65,13 +63,13 @@ UNION: explicit-inverse normal-inverse math-inverse pop-inverse ; : enough? ( stack word -- ? ) dup deferred? [ 2drop f ] [ - [ >r length r> 1quotation infer in>> >= ] + [ [ length ] dip 1quotation infer in>> >= ] [ 3drop f ] recover ] if ; : fold-word ( stack word -- stack ) 2dup enough? - [ 1quotation with-datastack ] [ >r % r> , { } ] if ; + [ 1quotation with-datastack ] [ [ % ] dip , { } ] if ; : fold ( quot -- folded-quot ) [ { } swap [ fold-word ] each % ] [ ] make ; @@ -95,13 +93,15 @@ UNION: explicit-inverse normal-inverse math-inverse pop-inverse ; throw ] recover ; +ERROR: undefined-inverse ; + GENERIC: inverse ( revquot word -- revquot* quot ) M: object inverse undo-literal ; M: symbol inverse undo-literal ; -M: word inverse drop "Inverse is undefined" throw ; +M: word inverse undefined-inverse ; M: normal-inverse inverse "inverse" word-prop ; @@ -112,8 +112,8 @@ M: math-inverse inverse [ drop swap-inverse ] [ pull-inverse ] if ; M: pop-inverse inverse - [ "pop-length" word-prop cut-slice swap >quotation ] keep - "pop-inverse" word-prop compose call ; + [ "pop-length" word-prop cut-slice swap >quotation ] + [ "pop-inverse" word-prop ] bi compose call ; : (undo) ( revquot -- ) [ unclip-slice inverse % (undo) ] unless-empty ; @@ -129,7 +129,7 @@ MACRO: undo ( quot -- ) [undo] ; \ dup [ [ =/fail ] keep ] define-inverse \ 2dup [ over =/fail over =/fail ] define-inverse \ 3dup [ pick =/fail pick =/fail pick =/fail ] define-inverse -\ pick [ >r pick r> =/fail ] define-inverse +\ pick [ [ pick ] dip =/fail ] define-inverse \ tuck [ swapd [ =/fail ] keep ] define-inverse \ not [ not ] define-inverse @@ -151,9 +151,12 @@ MACRO: undo ( quot -- ) [undo] ; \ sq [ sqrt ] define-inverse \ sqrt [ sq ] define-inverse +ERROR: missing-literal ; + : assert-literal ( n -- n ) - dup [ word? ] keep symbol? not and - [ "Literal missing in pattern matching" throw ] when ; + dup + [ word? ] [ symbol? not ] bi and + [ missing-literal ] when ; \ + [ - ] [ - ] define-math-inverse \ - [ + ] [ - ] define-math-inverse \ * [ / ] [ / ] define-math-inverse @@ -162,7 +165,7 @@ MACRO: undo ( quot -- ) [undo] ; \ ? 2 [ [ assert-literal ] bi@ - [ swap >r over = r> swap [ 2drop f ] [ = [ t ] [ fail ] if ] if ] + [ swap [ over = ] dip swap [ 2drop f ] [ = [ t ] [ fail ] if ] if ] 2curry ] define-pop-inverse @@ -217,7 +220,7 @@ DEFER: _ dup wrapper? [ wrapped>> ] when ; : boa-inverse ( class -- quot ) - [ deconstruct-pred ] keep slot-readers compose ; + [ deconstruct-pred ] [ slot-readers ] bi compose ; \ boa 1 [ ?wrapped boa-inverse ] define-pop-inverse @@ -232,7 +235,7 @@ DEFER: _ : recover-fail ( try fail -- ) [ drop call ] [ - >r nip r> dup fail? + [ nip ] dip dup fail? [ drop call ] [ nip throw ] if ] recover ; inline @@ -243,12 +246,11 @@ DEFER: _ in>> [ ndrop f ] curry [ recover-fail ] curry ; : [matches?] ( quot -- undoes?-quot ) - [undo] dup infer [ true-out ] keep false-recover curry ; + [undo] dup infer [ true-out ] [ false-recover ] bi curry ; MACRO: matches? ( quot -- ? ) [matches?] ; -TUPLE: no-match ; -: no-match ( -- * ) \ no-match new throw ; +ERROR: no-match ; M: no-match summary drop "Fall through in switch" ; : recover-chain ( seq -- quot ) @@ -256,7 +258,7 @@ M: no-match summary drop "Fall through in switch" ; : [switch] ( quot-alist -- quot ) [ dup quotation? [ [ ] swap 2array ] when ] map - reverse [ >r [undo] r> compose ] { } assoc>map + reverse [ [ [undo] ] dip compose ] { } assoc>map recover-chain ; MACRO: switch ( quot-alist -- ) [switch] ; From 6f058a30cabd0de74353c4a2ef3bc2f04d9235bf Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 6 Dec 2008 23:42:41 -0600 Subject: [PATCH 13/17] remove outdated readmes --- unmaintained/README.libs.txt | 88 ------------------------------------ unmaintained/README.txt | 30 ------------ 2 files changed, 118 deletions(-) delete mode 100644 unmaintained/README.libs.txt delete mode 100644 unmaintained/README.txt diff --git a/unmaintained/README.libs.txt b/unmaintained/README.libs.txt deleted file mode 100644 index fb5430ae75..0000000000 --- a/unmaintained/README.libs.txt +++ /dev/null @@ -1,88 +0,0 @@ -This directory contains Factor code that is not part of the core -library, but is useful enough to ship with the Factor distribution. - -Modules can be loaded from the listener: - - "libs/modulename" require - -Available libraries: - -- alarms -- call a quotation at a calendar date (Doug Coleman) -- alien -- Alien utility words (Eduardo Cavazos) -- base64 -- base64 encoding/decoding (Doug Coleman) -- basic-authentication -- basic authentication implementation for HTTP server (Chris Double) -- cairo -- cairo bindings (Sampo Vuori) -- calendar -- timestamp/calendar with timezones (Doug Coleman) -- canvas -- Gadget which renders an OpenGL display list (Slava Pestov) -- cocoa-callbacks -- Allows you to use Factor quotations as actions (Slava Pestov) -- concurrency -- Erlang/Termite-style distibuted concurrency (Chris Double) -- coroutines -- coroutines (Chris Double) -- cryptlib -- cryptlib binding (Elie Chaftari) -- crypto -- Various cryptographic algorithms (Doug Coleman) -- csv -- Comma-separated values parser (Daniel Ehrenberg) -- dlists -- double-linked-lists (Mackenzie Straight) -- editpadpro -- EditPadPro integration for Windows (Ryan Murphy) -- emacs -- emacs integration (Eduardo Cavazos) -- farkup -- Wiki-style markup (Matthew Willis) -- file-appender -- append to existing files (Doug Coleman) -- fjsc -- Factor to Javascript compiler (Chris Double) -- furnace -- Web framework (Slava Pestov) -- gap-buffer -- Efficient text editor buffer (Alex Chapman) -- graphics -- Graphics library in Factor (Doug Coleman) -- hardware-info -- Information about your computer (Doug Coleman) -- handler -- Gesture handler mixin (Eduardo Cavazos) -- heap -- Binary min heap implementation (Ryan Murphy) -- hexdump -- Hexdump routine (Doug Coleman) -- http -- Code shared by HTTP server and client (Slava Pestov) -- http-client -- HTTP client (Slava Pestov) -- id3 -- ID3 parser (Adam Wendt) -- io -- mmap, filesystem utils (Doug Coleman) -- jedit -- jEdit editor integration (Slava Pestov) -- jni -- Java Native Interface Wrapper (Chris Double) -- json -- JSON reader and writer (Chris Double) -- koszul -- Lie algebra cohomology and central representation (Slava Pestov) -- lazy-lists -- Lazy evaluation lists (Chris Double, Matthew Willis) -- locals -- Crappy local variables (Slava Pestov) -- mad -- Wrapper for libmad MP3 decoder (Adam Wendt) -- match -- pattern matching (Chris Double) -- math -- extended math library (Doug Coleman, Slava Pestov) -- matrices -- Matrix math (Slava Pestov) -- memoize -- memoization (caching word results) (Slava Pestov) -- mmap -- memory mapped files (Doug Coleman) -- mysql -- MySQL binding (Berlin Brown) -- null-stream -- Something akin to /dev/null (Slava Pestov) -- odbc -- Wrapper for ODBC library (Chris Double) -- ogg -- Wrapper for libogg library (Chris Double) -- openal -- Wrapper for OpenAL and alut sound libraries (Chris Double) -- oracle -- Oracle binding (Elie Chaftari) -- parser-combinators -- Haskell-style parser combinators (Chris Double) -- porter-stemmer -- Porter stemming algorithm (Slava Pestov) -- postgresql -- PostgreSQL binding (Doug Coleman) -- process -- Run external programs (Slava Pestov, Doug Coleman) -- qualified -- Qualified names for words in other vocabularies (Daniel Ehrenberg) -- rewrite-closures -- Turn quotations into closures (Eduardo Cavazos) -- scite -- SciTE editor integration (Clemens F. Hofreither) -- sequences -- Non-core sequence words (Eduardo Cavazos) -- serialize -- Binary object serialization (Chris Double) -- server -- The with-server combinator formely found in the core (Slava Pestov) -- slate -- Framework for graphical demos (Eduardo Cavazos) -- shuffle -- Shuffle words not in the core library (Chris Double) -- smtp -- SMTP client library (Elie Chaftari) -- splay-trees -- Splay trees (Mackenzie Straight) -- sqlite -- SQLite binding (Chris Double) -- state-machine -- Finite state machine abstraction (Daniel Ehrenberg) -- state-parser -- State-based parsing mechanism (Daniel Ehrenberg) -- textmate -- TextMate integration (Benjamin Pollack) -- theora -- Wrapper for libtheora library (Chris Double) -- trees -- Binary search and AVL (balanced) trees (Alex Chapman) -- usb -- Wrapper for libusb (Chris Double) -- unicode -- Partial Unicode support beyond the core (Daniel Ehrenberg) -- units -- Unit conversion (Doug Coleman) -- vars -- Alternative syntax for variables (Eduardo Cavazos) -- vim -- VIM integration (Alex Chapman) -- visitor -- Double dispatch through the visitor pattern (Daniel Ehrenberg) -- vorbis -- Wrapper for Ogg Vorbis library (Chris Double) -- x11 -- X Window System client library (Eduardo Cavazos) -- xml -- XML parser (Daniel Ehrenberg) -- xml-rpc -- XML-RPC client and server (Daniel Ehrenberg) -- yahoo -- Yahoo! automated search (Daniel Ehrenberg) diff --git a/unmaintained/README.txt b/unmaintained/README.txt deleted file mode 100644 index 91b1c5fe88..0000000000 --- a/unmaintained/README.txt +++ /dev/null @@ -1,30 +0,0 @@ -This directory contains Factor code that is not part of the core -library, but is useful enough to ship with the Factor distribution. - -Modules can be loaded from the listener: - - "apps/modulename" require - -Available applications: - -- article-manager -- Web-based content management system (Chris Double) -- automata -- Graphics demo for the UI (Eduardo Cavazos) -- benchmarks -- Various performance benchmarks (Slava Pestov) -- boids -- Graphics demo for the UI (Eduardo Cavazos) -- factory -- X11 window manager (Eduardo Cavazos) -- furnace-fjsc -- Web frontend for libs/fjsc (Chris Double) -- furnace-onigiri -- Weblog engine (Matthew Willis) -- furnace-pastebin -- demo app for Furnace (Slava Pestov) -- help-lint -- online documentation typo checker (Slava Pestov) -- icfp-2006 -- implements the icfp 2006 vm, boundvariable.org (Gavin Harrison) -- http-server -- HTTP server (Slava Pestov, Chris Double) -- lindenmayer -- L-systems tool (Eduardo Cavazos) -- lisppaste -- Lisppaste XML-RPC demo (Slava Pestov) -- ogg-player -- Ogg Vorbis (audio) and Theora (video) player (Chris Double) -- print-dataflow -- Code to print compiler dataflow IR to the console, or show it in the UI (Slava Pestov) -- random-tester -- Random compiler tester (Doug Coleman) -- rss -- An RSS1, RSS2 and Atom parser and aggregator (Chris Double, Daniel Ehrenberg) -- space-invaders -- Intel 8080-based Space Invaders arcade machine emulator (Chris Double) -- tetris -- Tetris game (Alex Chapman) -- turing -- Turing machine demo (Slava Pestov) -- wee-url -- Web app to make short URLs from long ones (Doug Coleman) From 1e53cf6c9f3572b231ce6eea3dab2df6e6c00acc Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 7 Dec 2008 01:36:10 -0600 Subject: [PATCH 14/17] upper? was copy/pasted and WRONG. found with extra/lint --- basis/unicode/case/case-tests.factor | 6 ++++++ basis/unicode/case/case.factor | 15 +++++++-------- 2 files changed, 13 insertions(+), 8 deletions(-) diff --git a/basis/unicode/case/case-tests.factor b/basis/unicode/case/case-tests.factor index 6401ce201e..0083e49672 100644 --- a/basis/unicode/case/case-tests.factor +++ b/basis/unicode/case/case-tests.factor @@ -16,3 +16,9 @@ USING: unicode.case tools.test namespaces ; "lt" locale set ! Lithuanian casing tests ] with-scope + +[ t ] [ "asdf" lower? ] unit-test +[ f ] [ "asdF" lower? ] unit-test + +[ t ] [ "ASDF" upper? ] unit-test +[ f ] [ "ASDf" upper? ] unit-test diff --git a/basis/unicode/case/case.factor b/basis/unicode/case/case.factor index 932f72960a..ea1baa6e9c 100644 --- a/basis/unicode/case/case.factor +++ b/basis/unicode/case/case.factor @@ -100,11 +100,10 @@ SYMBOL: locale ! Just casing locale, or overall? : >case-fold ( string -- fold ) >upper >lower ; -: lower? ( string -- ? ) - dup >lower = ; -: upper? ( string -- ? ) - dup >lower = ; -: title? ( string -- ? ) - dup >title = ; -: case-fold? ( string -- ? ) - dup >case-fold = ; +: lower? ( string -- ? ) dup >lower = ; + +: upper? ( string -- ? ) dup >upper = ; + +: title? ( string -- ? ) dup >title = ; + +: case-fold? ( string -- ? ) dup >case-fold = ; From 0712db3a276200ae1bd4631d1fa3284e56b21835 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 7 Dec 2008 01:55:19 -0600 Subject: [PATCH 15/17] move lint from unmaintained to extra --- {unmaintained => extra}/lint/authors.txt | 0 extra/lint/lint-tests.factor | 14 ++ extra/lint/lint.factor | 173 +++++++++++++++++++++ {unmaintained => extra}/lint/summary.txt | 0 unmaintained/lint/lint-tests.factor | 18 --- unmaintained/lint/lint.factor | 182 ----------------------- 6 files changed, 187 insertions(+), 200 deletions(-) rename {unmaintained => extra}/lint/authors.txt (100%) create mode 100644 extra/lint/lint-tests.factor create mode 100644 extra/lint/lint.factor rename {unmaintained => extra}/lint/summary.txt (100%) delete mode 100644 unmaintained/lint/lint-tests.factor delete mode 100644 unmaintained/lint/lint.factor diff --git a/unmaintained/lint/authors.txt b/extra/lint/authors.txt similarity index 100% rename from unmaintained/lint/authors.txt rename to extra/lint/authors.txt diff --git a/extra/lint/lint-tests.factor b/extra/lint/lint-tests.factor new file mode 100644 index 0000000000..e2ca8816d9 --- /dev/null +++ b/extra/lint/lint-tests.factor @@ -0,0 +1,14 @@ +USING: io lint kernel math tools.test ; +IN: lint.tests + +! Don't write code like this +: lint1 ( -- ) [ "hi" print ] [ ] if ; ! when + +[ { { lint1 { [ [ ] if ] } } } ] [ \ lint1 lint-word ] unit-test + +: lint2 ( n -- n' ) 1 + ; ! 1+ +[ { [ 1 + ] } ] [ \ lint2 lint ] unit-test + +: lint3 dup -rot ; ! tuck + +[ { { lint3 { [ dup -rot ] } } } ] [ \ lint3 lint-word ] unit-test diff --git a/extra/lint/lint.factor b/extra/lint/lint.factor new file mode 100644 index 0000000000..298bea5c44 --- /dev/null +++ b/extra/lint/lint.factor @@ -0,0 +1,173 @@ +! Copyright (C) 2007, 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors alien alien.accessors arrays assocs +combinators.short-circuit fry hashtables html.elements io +kernel math namespaces prettyprint quotations sequences +sequences.deep sets slots.private vectors vocabs words +kernel.private ; +IN: lint + +SYMBOL: def-hash +SYMBOL: def-hash-keys + +: set-hash-vector ( val key hash -- ) + 2dup at -rot [ ?push ] 2dip set-at ; + +: more-defs ( hash -- ) + { + { -rot [ swap >r swap r> ] } + { -rot [ swap swapd ] } + { rot [ >r swap r> swap ] } + { rot [ swapd swap ] } + { over [ dup swap ] } + { tuck [ dup -rot ] } + { swapd [ >r swap r> ] } + { 2nip [ nip nip ] } + { 2drop [ drop drop ] } + { 3drop [ drop drop drop ] } + { zero? [ 0 = ] } + { pop* [ pop drop ] } + { when [ [ ] if ] } + { >boolean [ f = not ] } + } swap '[ first2 _ set-hash-vector ] each ; + +: accessor-words ( -- seq ) +{ + alien-signed-1 alien-signed-2 alien-signed-4 alien-signed-8 + alien-unsigned-1 alien-unsigned-2 alien-unsigned-4 alien-unsigned-8 + alien-unsigned-cell set-alien-signed-cell + set-alien-unsigned-1 set-alien-signed-1 set-alien-unsigned-2 + set-alien-signed-2 set-alien-unsigned-4 set-alien-signed-4 + set-alien-unsigned-8 set-alien-signed-8 + alien-cell alien-signed-cell set-alien-cell set-alien-unsigned-cell + set-alien-float alien-float +} ; + +: trivial-defs + { + [ . ] + [ get ] + [ t ] [ f ] + [ { } ] + [ 0 = ] + [ drop ] ! because of declare + [ drop f ] + [ "cdecl" ] + [ first ] [ second ] [ third ] [ fourth ] + [ ">" write-html ] [ "/>" write-html ] + } ; + +! ! Add definitions +H{ } clone def-hash set-global + +all-words [ + dup def>> dup callable? + [ def-hash get-global set-hash-vector ] [ drop ] if +] each + +! ! Remove definitions + +! Remove empty word defs +def-hash get-global [ drop empty? not ] assoc-filter + +! Remove constants [ 1 ] +[ drop { [ length 1 = ] [ first number? ] } 1&& not ] assoc-filter + +! Remove words that are their own definition +[ [ [ def>> ] [ 1quotation ] bi = not ] filter ] assoc-map + +! Remove set-alien-cell, etc. +[ drop [ accessor-words diff ] keep [ length ] bi@ = ] assoc-filter + +! Remove trivial defs +[ drop trivial-defs member? not ] assoc-filter + +! Remove tag defs +[ + drop { + [ length 3 = ] + [ first \ tag = ] [ second number? ] [ third \ eq? = ] + } 1&& not +] assoc-filter + +[ + drop { + [ [ wrapper? ] deep-contains? ] + [ [ hashtable? ] deep-contains? ] + } 1|| not +] assoc-filter + +! Remove n m shift defs +[ + drop dup length 3 = [ + [ first2 [ number? ] both? ] + [ third \ shift = ] bi and not + ] [ drop t ] if +] assoc-filter + +! Remove [ n slot ] +[ + drop dup length 2 = + [ first2 [ number? ] [ \ slot = ] bi* and not ] [ drop t ] if +] assoc-filter + + +dup more-defs + +[ def-hash set-global ] [ keys def-hash-keys set-global ] bi + +: find-duplicates ( -- seq ) + def-hash get-global [ nip length 1 > ] assoc-filter ; + +GENERIC: lint ( obj -- seq ) + +M: object lint ( obj -- seq ) drop f ; + +: subseq/member? ( subseq/member seq -- ? ) + { [ start ] [ member? ] } 2|| ; + +M: callable lint ( quot -- seq ) + [ def-hash-keys get-global ] dip '[ _ subseq/member? ] filter ; + +M: word lint ( word -- seq ) + def>> dup callable? [ lint ] [ drop f ] if ; + +: word-path. ( word -- ) + [ vocabulary>> ] [ unparse ] bi ":" glue print ; + +: 4bl ( -- ) bl bl bl bl ; + +: (lint.) ( pair -- ) + first2 [ word-path. ] dip [ + [ 4bl . "-----------------------------------" print ] + [ def-hash get-global at [ 4bl word-path. ] each nl ] bi + ] each nl nl ; + +: lint. ( alist -- ) [ (lint.) ] each ; + +GENERIC: run-lint ( obj -- obj ) + +: (trim-self) ( val key -- obj ? ) + def-hash get-global at* + [ dupd remove empty? not ] [ drop f ] if ; + +: trim-self ( seq -- newseq ) + [ [ (trim-self) ] filter ] assoc-map ; + +: filter-symbols ( alist -- alist ) + [ + nip first dup def-hash get-global at + [ first ] bi@ literalize = not + ] assoc-filter ; + +M: sequence run-lint ( seq -- seq ) + [ dup lint ] { } map>assoc trim-self + [ second empty? not ] filter filter-symbols ; + +M: word run-lint ( word -- seq ) 1array run-lint ; + +: lint-all ( -- seq ) all-words run-lint dup lint. ; + +: lint-vocab ( vocab -- seq ) words run-lint dup lint. ; + +: lint-word ( word -- seq ) 1array run-lint dup lint. ; diff --git a/unmaintained/lint/summary.txt b/extra/lint/summary.txt similarity index 100% rename from unmaintained/lint/summary.txt rename to extra/lint/summary.txt diff --git a/unmaintained/lint/lint-tests.factor b/unmaintained/lint/lint-tests.factor deleted file mode 100644 index 9a39980c9f..0000000000 --- a/unmaintained/lint/lint-tests.factor +++ /dev/null @@ -1,18 +0,0 @@ -USING: io lint kernel math tools.test ; -IN: lint.tests - -! Don't write code like this -: lint1 - [ "hi" print ] [ ] if ; ! when - -[ { [ [ ] if ] } ] [ \ lint1 lint ] unit-test - -: lint2 - 1 + ; ! 1+ -[ { [ 1 + ] } ] [ \ lint2 lint ] unit-test - -: lint3 - dup -rot ; ! tuck - -[ { [ dup -rot ] } ] [ \ lint3 lint ] unit-test - diff --git a/unmaintained/lint/lint.factor b/unmaintained/lint/lint.factor deleted file mode 100644 index ab1a67a83e..0000000000 --- a/unmaintained/lint/lint.factor +++ /dev/null @@ -1,182 +0,0 @@ -! Copyright (C) 2007 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien alien.accessors arrays assocs -combinators.lib io kernel macros math namespaces prettyprint -quotations sequences vectors vocabs words html.elements sets -slots.private combinators.short-circuit math.order hashtables -sequences.deep ; -IN: lint - -SYMBOL: def-hash -SYMBOL: def-hash-keys - -: set-hash-vector ( val key hash -- ) - 2dup at -rot [ ?push ] 2dip set-at ; - -: add-word-def ( word quot -- ) - dup callable? [ - def-hash get-global set-hash-vector - ] [ - 2drop - ] if ; - -: more-defs ( -- ) - { - { [ swap >r swap r> ] -rot } - { [ swap swapd ] -rot } - { [ >r swap r> swap ] rot } - { [ swapd swap ] rot } - { [ dup swap ] over } - { [ dup -rot ] tuck } - { [ >r swap r> ] swapd } - { [ nip nip ] 2nip } - { [ drop drop ] 2drop } - { [ drop drop drop ] 3drop } - { [ 0 = ] zero? } - { [ pop drop ] pop* } - { [ [ ] if ] when } - { [ f = not ] >boolean } - } [ first2 swap add-word-def ] each ; - -: accessor-words ( -- seq ) -{ - alien-signed-1 alien-signed-2 alien-signed-4 alien-signed-8 - alien-unsigned-1 alien-unsigned-2 alien-unsigned-4 alien-unsigned-8 - alien-unsigned-cell set-alien-signed-cell - set-alien-unsigned-1 set-alien-signed-1 set-alien-unsigned-2 - set-alien-signed-2 set-alien-unsigned-4 set-alien-signed-4 - set-alien-unsigned-8 set-alien-signed-8 - alien-cell alien-signed-cell set-alien-cell set-alien-unsigned-cell - set-alien-float alien-float -} ; - -: trivial-defs - { - [ get ] [ t ] [ { } ] [ . ] [ drop f ] - [ drop ] [ f ] [ first ] [ second ] [ third ] [ fourth ] - [ ">" write-html ] [ "/>" write-html ] - } ; - -H{ } clone def-hash set-global -all-words [ dup def>> add-word-def ] each -more-defs - -! Remove empty word defs -def-hash get-global [ - drop empty? not -] assoc-filter - -! Remove constants [ 1 ] -[ - drop { [ length 1 = ] [ first number? ] } 1&& not -] assoc-filter - -! Remove set-alien-cell, etc. -[ - drop [ accessor-words diff ] keep [ length ] bi@ = -] assoc-filter - -! Remove trivial defs -[ - drop trivial-defs member? not -] assoc-filter - -[ - drop { - [ [ wrapper? ] deep-contains? ] - [ [ hashtable? ] deep-contains? ] - } 1|| not -] assoc-filter - -! Remove n m shift defs -[ - drop dup length 3 = [ - dup first2 [ number? ] both? - swap third \ shift = and not - ] [ drop t ] if -] assoc-filter - -! Remove [ n slot ] -[ - drop dup length 2 = [ - first2 \ slot = swap number? and not - ] [ drop t ] if -] assoc-filter def-hash set-global - -: find-duplicates ( -- seq ) - def-hash get-global [ - nip length 1 > - ] assoc-filter ; - -def-hash get-global keys def-hash-keys set-global - -GENERIC: lint ( obj -- seq ) - -M: object lint ( obj -- seq ) - drop f ; - -: subseq/member? ( subseq/member seq -- ? ) - { [ start ] [ member? ] } 2|| ; - -M: callable lint ( quot -- seq ) - def-hash-keys get [ - swap subseq/member? - ] with filter ; - -M: word lint ( word -- seq ) - def>> dup callable? [ lint ] [ drop f ] if ; - -: word-path. ( word -- ) - [ vocabulary>> ":" ] keep unparse 3append write nl ; - -: (lint.) ( pair -- ) - first2 >r word-path. r> [ - bl bl bl bl - dup . - "-----------------------------------" print - def-hash get at [ bl bl bl bl word-path. ] each - nl - ] each nl nl ; - -: lint. ( alist -- ) - [ (lint.) ] each ; - - -GENERIC: run-lint ( obj -- obj ) - -: (trim-self) ( val key -- obj ? ) - def-hash get-global at* [ - dupd remove empty? not - ] [ - drop f - ] if ; - -: trim-self ( seq -- newseq ) - [ [ (trim-self) ] filter ] assoc-map ; - -: filter-symbols ( alist -- alist ) - [ - nip first dup def-hash get at - [ first ] bi@ literalize = not - ] assoc-filter ; - -M: sequence run-lint ( seq -- seq ) - [ - global [ dup . flush ] bind - dup lint - ] { } map>assoc - trim-self - [ second empty? not ] filter - filter-symbols ; - -M: word run-lint ( word -- seq ) - 1array run-lint ; - -: lint-all ( -- seq ) - all-words run-lint dup lint. ; - -: lint-vocab ( vocab -- seq ) - words run-lint dup lint. ; - -: lint-word ( word -- seq ) - 1array run-lint dup lint. ; From 0190ce5b488ecdb0507147da95f1bb24b1458eb3 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 7 Dec 2008 01:59:38 -0600 Subject: [PATCH 16/17] remove bogus equality --- extra/lint/lint.factor | 2 -- 1 file changed, 2 deletions(-) diff --git a/extra/lint/lint.factor b/extra/lint/lint.factor index 298bea5c44..a8320c1464 100644 --- a/extra/lint/lint.factor +++ b/extra/lint/lint.factor @@ -25,7 +25,6 @@ SYMBOL: def-hash-keys { 2nip [ nip nip ] } { 2drop [ drop drop ] } { 3drop [ drop drop drop ] } - { zero? [ 0 = ] } { pop* [ pop drop ] } { when [ [ ] if ] } { >boolean [ f = not ] } @@ -49,7 +48,6 @@ SYMBOL: def-hash-keys [ get ] [ t ] [ f ] [ { } ] - [ 0 = ] [ drop ] ! because of declare [ drop f ] [ "cdecl" ] From 9ec5896a3afe7ca001d7bbe85bfeecdb43666ca8 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 7 Dec 2008 08:39:16 -0600 Subject: [PATCH 17/17] Move two unit tests --- basis/calendar/calendar-tests.factor | 2 -- extra/math/finance/finance-tests.factor | 1 + extra/taxes/usa/usa-tests.factor | 2 +- 3 files changed, 2 insertions(+), 3 deletions(-) diff --git a/basis/calendar/calendar-tests.factor b/basis/calendar/calendar-tests.factor index 943ba8c3d5..00d5730745 100644 --- a/basis/calendar/calendar-tests.factor +++ b/basis/calendar/calendar-tests.factor @@ -167,5 +167,3 @@ IN: calendar.tests [ t ] [ now 50 milliseconds sleep now before? ] unit-test [ t ] [ now 50 milliseconds sleep now swap after? ] unit-test [ t ] [ now 50 milliseconds sleep now 50 milliseconds sleep now swapd between? ] unit-test - -[ 4+1/6 ] [ 100 semimonthly ] unit-test diff --git a/extra/math/finance/finance-tests.factor b/extra/math/finance/finance-tests.factor index dce701bb2f..fc4ad0d07e 100644 --- a/extra/math/finance/finance-tests.factor +++ b/extra/math/finance/finance-tests.factor @@ -6,3 +6,4 @@ IN: math.finance.tests [ { 1 3 1 } ] [ { 1 3 2 6 3 } 2 momentum ] unit-test +[ 4+1/6 ] [ 100 semimonthly ] unit-test diff --git a/extra/taxes/usa/usa-tests.factor b/extra/taxes/usa/usa-tests.factor index 002299fef1..6c12a423eb 100644 --- a/extra/taxes/usa/usa-tests.factor +++ b/extra/taxes/usa/usa-tests.factor @@ -1,6 +1,6 @@ USING: kernel money tools.test taxes.usa taxes.usa.federal taxes.usa.mn -calendar taxes.usa.w4 usa-cities ; +calendar taxes.usa.w4 usa-cities math.finance ; IN: taxes.usa.tests [