From 53810cd17b49a9de41a80977e9c0e03b58be176a Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 5 Feb 2008 18:28:05 -0600 Subject: [PATCH 1/9] builder: update target --- extra/builder/builder.factor | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/extra/builder/builder.factor b/extra/builder/builder.factor index 3216105d47..832b89a7dc 100755 --- a/extra/builder/builder.factor +++ b/extra/builder/builder.factor @@ -33,7 +33,12 @@ SYMBOL: builder-recipients ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: target ( -- target ) `{ ,[ os ] %[ cpu "." split ] } "-" join ; +! : target ( -- target ) `{ ,[ os ] %[ cpu "." split ] } "-" join ; + +: target ( -- target ) + { { [ os "windows" = ] [ "windows-nt-x86-32" ] } + { [ t ] [ `{ ,[ os ] %[ cpu "." split ] } "-" join ] } } + cond ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! From e3e2cc7e0d647b628b245372a7c178ed492f42c4 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 5 Feb 2008 23:09:33 -0600 Subject: [PATCH 2/9] Add builder.load-everything --- extra/builder/builder.factor | 57 ++++++++++++------- .../load-everything/load-everything.factor | 23 ++++++++ 2 files changed, 58 insertions(+), 22 deletions(-) create mode 100644 extra/builder/load-everything/load-everything.factor diff --git a/extra/builder/builder.factor b/extra/builder/builder.factor index 832b89a7dc..375023cb5e 100755 --- a/extra/builder/builder.factor +++ b/extra/builder/builder.factor @@ -33,19 +33,19 @@ SYMBOL: builder-recipients ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! : target ( -- target ) `{ ,[ os ] %[ cpu "." split ] } "-" join ; +: target ( -- target ) `{ ,[ os ] %[ cpu "." split ] } "-" join ; -: target ( -- target ) - { { [ os "windows" = ] [ "windows-nt-x86-32" ] } - { [ t ] [ `{ ,[ os ] %[ cpu "." split ] } "-" join ] } } - cond ; +! : target ( -- target ) +! { { [ os "windows" = ] [ "windows-nt-x86-32" ] } +! { [ t ] [ `{ ,[ os ] %[ cpu "." split ] } "-" join ] } } +! cond ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : factor-binary ( -- name ) os { { "macosx" [ "./Factor.app/Contents/MacOS/factor" ] } - { "windows" [ "./factor-nt.exe" ] } + { "winnt" [ "./factor-nt.exe" ] } [ drop "./factor" ] } case ; @@ -61,7 +61,13 @@ VAR: stamp "/builds/factor" cd - { "git" "pull" "--no-summary" "git://factorcode.org/git/factor.git" } + { + "git" + "pull" + "--no-summary" + "git://factorcode.org/git/factor.git" + "master" + } run-process process-status 0 = [ ] @@ -74,7 +80,7 @@ VAR: stamp "/builds/" stamp> append make-directory "/builds/" stamp> append cd - { "git" "clone" "/builds/factor" } run-process drop + { "git" "clone" "../factor" } run-process drop "factor" cd @@ -121,20 +127,27 @@ VAR: stamp "builder: bootstrap" throw ] if - `{ - { +arguments+ - { ,[ factor-binary ] "-e=USE: tools.browser load-everything" } } - { +stdout+ "../load-everything-log" } - { +stderr+ +stdout+ } - } - >hashtable [ run-process process-status ] benchmark nip - "../load-everything-time" [ . ] with-stream - 0 = - [ ] - [ - "builder: load-everything" "../load-everything-log" email-file - "builder: load-everything" throw - ] if ; +! `{ +! { +arguments+ +! { ,[ factor-binary ] "-e=USE: tools.browser load-everything" } } +! { +stdout+ "../load-everything-log" } +! { +stderr+ +stdout+ } +! } +! >hashtable [ run-process process-status ] benchmark nip +! "../load-everything-time" [ . ] with-stream +! 0 = +! [ ] +! [ +! "builder: load-everything" "../load-everything-log" email-file +! "builder: load-everything" throw +! ] if ; + + `{ ,[ factor-binary ] "-run=builder.load-everything" } run-process drop + "../load-everything-log" exists? + [ "builder: load-everything" "../load-everything-log" email-file ] + when + + ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/extra/builder/load-everything/load-everything.factor b/extra/builder/load-everything/load-everything.factor new file mode 100644 index 0000000000..12007f214b --- /dev/null +++ b/extra/builder/load-everything/load-everything.factor @@ -0,0 +1,23 @@ + +USING: kernel continuations io io.files prettyprint vocabs.loader + tools.time tools.browser ; + +IN: builder.load-everything + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: runtime ( quot -- time ) benchmark nip ; + +: log-runtime ( quot file -- ) + >r runtime r> [ . ] with-stream ; + +: log-object ( object file -- ) [ . ] with-stream ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: do-load-everything ( -- ) + [ [ load-everything ] catch ] "../load-everything-time" log-runtime + [ require-all-error-vocabs "../load-everything-log" log-object ] + when ; + +MAIN: do-load-everything \ No newline at end of file From 7d2f6b32f5c6db32a6098491ce367dbb3bf90c0f Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 6 Feb 2008 04:26:13 -0600 Subject: [PATCH 3/9] Add builder.test --- extra/builder/builder.factor | 46 +++++++++++++--------------------- extra/builder/test/test.factor | 33 ++++++++++++++++++++++++ 2 files changed, 51 insertions(+), 28 deletions(-) create mode 100644 extra/builder/test/test.factor diff --git a/extra/builder/builder.factor b/extra/builder/builder.factor index 375023cb5e..2acdbc3294 100755 --- a/extra/builder/builder.factor +++ b/extra/builder/builder.factor @@ -8,6 +8,15 @@ IN: builder ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +: runtime ( quot -- time ) benchmark nip ; + +: log-runtime ( quot file -- ) + >r runtime r> [ . ] with-stream ; + +: log-object ( object file -- ) [ . ] with-stream ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + : datestamp ( -- string ) now `{ ,[ dup timestamp-year ] ,[ dup timestamp-month ] @@ -35,11 +44,6 @@ SYMBOL: builder-recipients : target ( -- target ) `{ ,[ os ] %[ cpu "." split ] } "-" join ; -! : target ( -- target ) -! { { [ os "windows" = ] [ "windows-nt-x86-32" ] } -! { [ t ] [ `{ ,[ os ] %[ cpu "." split ] } "-" join ] } } -! cond ; - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : factor-binary ( -- name ) @@ -84,10 +88,8 @@ VAR: stamp "factor" cd - { "git" "show" } - [ readln ] with-stream - " " split second - "../git-id" [ print ] with-stream + { "git" "show" } [ readln ] with-stream " " split second + "../git-id" log-object { "make" "clean" } run-process drop @@ -117,9 +119,7 @@ VAR: stamp { +stdout+ "../boot-log" } { +stderr+ +stdout+ } } - >hashtable - [ run-process process-status ] - benchmark nip "../boot-time" [ . ] with-stream + >hashtable [ run-process ] "../boot-time" log-runtime process-status 0 = [ ] [ @@ -127,26 +127,16 @@ VAR: stamp "builder: bootstrap" throw ] if -! `{ -! { +arguments+ -! { ,[ factor-binary ] "-e=USE: tools.browser load-everything" } } -! { +stdout+ "../load-everything-log" } -! { +stderr+ +stdout+ } -! } -! >hashtable [ run-process process-status ] benchmark nip -! "../load-everything-time" [ . ] with-stream -! 0 = -! [ ] -! [ -! "builder: load-everything" "../load-everything-log" email-file -! "builder: load-everything" throw -! ] if ; - - `{ ,[ factor-binary ] "-run=builder.load-everything" } run-process drop + `{ ,[ factor-binary ] "-run=builder.test" } run-process drop + "../load-everything-log" exists? [ "builder: load-everything" "../load-everything-log" email-file ] when + "../failing-tests" exists? + [ "builder: failing tests" "../failing-tests" email-file ] + when + ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/extra/builder/test/test.factor b/extra/builder/test/test.factor new file mode 100644 index 0000000000..ed75e99527 --- /dev/null +++ b/extra/builder/test/test.factor @@ -0,0 +1,33 @@ + +USING: kernel sequences assocs builder continuations vocabs vocabs.loader + io + io.files + tools.browser + tools.test ; + +IN: builder.test + +: do-load ( -- ) + [ [ load-everything ] catch ] "../load-everything-time" log-runtime + [ require-all-error-vocabs "../load-everything-log" log-object ] + when* ; + +: do-tests ( -- ) + "" child-vocabs + [ vocab-source-loaded? ] subset + [ vocab-tests-path ] map + [ dup [ ?resource-path exists? ] when ] subset + [ dup run-test ] { } map>assoc + [ second empty? not ] subset + dup empty? + [ drop ] + [ + "../failing-tests" + [ [ nl failures. ] assoc-each ] + with-stream + ] + if ; + +: do-all ( -- ) do-load do-tests ; + +MAIN: do-all \ No newline at end of file From a5c69dae631af981fdc598828c44ecdc12423bbe Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 6 Feb 2008 06:10:55 -0600 Subject: [PATCH 4/9] update builder.test --- .../load-everything/load-everything.factor | 23 ------------------- extra/builder/test/test.factor | 9 +++++--- 2 files changed, 6 insertions(+), 26 deletions(-) delete mode 100644 extra/builder/load-everything/load-everything.factor diff --git a/extra/builder/load-everything/load-everything.factor b/extra/builder/load-everything/load-everything.factor deleted file mode 100644 index 12007f214b..0000000000 --- a/extra/builder/load-everything/load-everything.factor +++ /dev/null @@ -1,23 +0,0 @@ - -USING: kernel continuations io io.files prettyprint vocabs.loader - tools.time tools.browser ; - -IN: builder.load-everything - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: runtime ( quot -- time ) benchmark nip ; - -: log-runtime ( quot file -- ) - >r runtime r> [ . ] with-stream ; - -: log-object ( object file -- ) [ . ] with-stream ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: do-load-everything ( -- ) - [ [ load-everything ] catch ] "../load-everything-time" log-runtime - [ require-all-error-vocabs "../load-everything-log" log-object ] - when ; - -MAIN: do-load-everything \ No newline at end of file diff --git a/extra/builder/test/test.factor b/extra/builder/test/test.factor index ed75e99527..fb9c62e2aa 100644 --- a/extra/builder/test/test.factor +++ b/extra/builder/test/test.factor @@ -8,9 +8,12 @@ USING: kernel sequences assocs builder continuations vocabs vocabs.loader IN: builder.test : do-load ( -- ) - [ [ load-everything ] catch ] "../load-everything-time" log-runtime - [ require-all-error-vocabs "../load-everything-log" log-object ] - when* ; + [ + [ load-everything ] + [ require-all-error-vocabs "../load-everything-log" log-object ] + recover + ] + "../load-everything-time" log-runtime ; : do-tests ( -- ) "" child-vocabs From 5f997fe2c7c5c071a0f7975170daa6d9f4256aef Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 6 Feb 2008 20:04:09 -0600 Subject: [PATCH 5/9] Make extra/unix load on Windows --- extra/unix/unix.factor | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor index d32fc25eab..59141c1940 100755 --- a/extra/unix/unix.factor +++ b/extra/unix/unix.factor @@ -220,7 +220,8 @@ FUNCTION: pid_t waitpid ( pid_t wpid, int* status, int options ) ; FUNCTION: ssize_t write ( int fd, void* buf, size_t nbytes ) ; { - { [ linux? ] [ "unix.linux" ] } - { [ bsd? ] [ "unix.bsd" ] } - { [ solaris? ] [ "unix.solaris" ] } -} cond require + { [ linux? ] [ "unix.linux" require ] } + { [ bsd? ] [ "unix.bsd" require ] } + { [ solaris? ] [ "unix.solaris" require ] } + { [ t ] [ ] } +} cond From f3c8bd266b0300a920fd8896372177504aa6984c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 6 Feb 2008 20:05:03 -0600 Subject: [PATCH 6/9] Improved syntax for ratios --- core/math/parser/parser-tests.factor | 10 --- core/math/parser/parser.factor | 89 ++++++++++++++++++--------- extra/math/ratios/ratios-tests.factor | 5 ++ extra/math/ratios/ratios.factor | 1 + 4 files changed, 66 insertions(+), 39 deletions(-) diff --git a/core/math/parser/parser-tests.factor b/core/math/parser/parser-tests.factor index 7c30012a19..226e47090a 100755 --- a/core/math/parser/parser-tests.factor +++ b/core/math/parser/parser-tests.factor @@ -95,16 +95,6 @@ unit-test [ f ] [ "\0." string>number ] unit-test -! [ t ] [ -! { "1.0/0.0" "-1.0/0.0" "0.0/0.0" } -! [ dup string>number number>string = ] all? -! ] unit-test -! -! [ t ] [ -! { 1.0/0.0 -1.0/0.0 0.0/0.0 } -! [ dup number>string string>number = ] all? -! ] unit-test - [ 1 1 >base ] must-fail [ 1 0 >base ] must-fail [ 1 -1 >base ] must-fail diff --git a/core/math/parser/parser.factor b/core/math/parser/parser.factor index 7f0404812d..73b4a725d2 100755 --- a/core/math/parser/parser.factor +++ b/core/math/parser/parser.factor @@ -4,12 +4,6 @@ USING: kernel math.private namespaces sequences strings arrays combinators splitting math assocs ; IN: math.parser -DEFER: base> - -: string>ratio ( str radix -- a/b ) - >r "/" split1 r> tuck base> >r base> r> - 2dup and [ / ] [ 2drop f ] if ; - : digit> ( ch -- n ) H{ { CHAR: 0 0 } @@ -36,30 +30,54 @@ DEFER: base> { CHAR: f 15 } } at ; -: digits>integer ( radix seq -- n ) - 0 rot [ swapd * + ] curry reduce ; - -: valid-digits? ( radix seq -- ? ) - { - { [ dup empty? ] [ 2drop f ] } - { [ f over memq? ] [ 2drop f ] } - { [ t ] [ swap [ < ] curry all? ] } - } cond ; - : string>digits ( str -- digits ) [ digit> ] { } map-as ; -: string>integer ( str radix -- n/f ) - swap "-" ?head >r - string>digits 2dup valid-digits? - [ digits>integer r> [ neg ] when ] [ r> 3drop f ] if ; +DEFER: base> + +) ( str -- n ) radix get base> ; + +: whole-part ( str -- m n ) + "+" split1 >r (base>) r> + dup [ (base>) ] [ drop 0 swap ] if ; + +: string>ratio ( str -- a/b ) + "/" split1 (base>) >r whole-part r> + 3dup and and [ / + ] [ 3drop f ] if ; + +: digits>integer ( seq -- n ) + 0 radix get [ swapd * + ] curry reduce ; + +: valid-digits? ( seq -- ? ) + { + { [ dup empty? ] [ drop f ] } + { [ f over memq? ] [ drop f ] } + { [ t ] [ radix get [ < ] curry all? ] } + } cond ; + +: string>integer ( str -- n/f ) + string>digits dup valid-digits? + [ digits>integer ] [ drop f ] if ; + +PRIVATE> : base> ( str radix -- n/f ) - { - { [ CHAR: / pick member? ] [ string>ratio ] } - { [ CHAR: . pick member? ] [ drop string>float ] } - { [ t ] [ string>integer ] } - } cond ; + [ + "-" ?head >r + { + { [ CHAR: / over member? ] [ string>ratio ] } + { [ CHAR: . over member? ] [ string>float ] } + { [ t ] [ string>integer ] } + } cond + r> [ dup [ neg ] when ] when + ] with-radix ; : string>number ( str -- n/f ) 10 base> ; : bin> ( str -- n/f ) 2 base> ; @@ -74,8 +92,16 @@ DEFER: base> dup >r /mod >digit , dup 0 > [ r> integer, ] [ r> 2drop ] if ; +PRIVATE> + GENERIC# >base 1 ( n radix -- str ) +base) ( n -- str ) radix get >base ; + +PRIVATE> + M: integer >base [ over 0 < [ @@ -87,10 +113,15 @@ M: integer >base M: ratio >base [ - over numerator over >base % - CHAR: / , - swap denominator swap >base % - ] "" make ; + [ + dup 0 < [ "-" % neg ] when + 1 /mod + >r dup zero? [ drop ] [ (>base) % "+" % ] if r> + dup numerator (>base) % + "/" % + denominator (>base) % + ] "" make + ] with-radix ; : fix-float ( str -- newstr ) { diff --git a/extra/math/ratios/ratios-tests.factor b/extra/math/ratios/ratios-tests.factor index 79b0b21d28..858a7b0544 100755 --- a/extra/math/ratios/ratios-tests.factor +++ b/extra/math/ratios/ratios-tests.factor @@ -105,3 +105,8 @@ unit-test [ "33/100" ] [ "66/200" string>number number>string ] unit-test + +[ 3 ] [ "1+1/2" string>number 2 * ] unit-test +[ -3 ] [ "-1+1/2" string>number 2 * ] unit-test +[ "2+1/7" ] [ 1 7 / 2 + number>string ] unit-test +[ "1/8" ] [ 1 8 / number>string ] unit-test diff --git a/extra/math/ratios/ratios.factor b/extra/math/ratios/ratios.factor index 954fd8dd20..5d07bd046f 100755 --- a/extra/math/ratios/ratios.factor +++ b/extra/math/ratios/ratios.factor @@ -48,3 +48,4 @@ M: ratio * 2>fraction * >r * r> / ; M: ratio / scale / ; M: ratio /i scale /i ; M: ratio mod 2dup >r >r /i r> r> rot * - ; +M: ratio /mod [ /i ] 2keep mod ; From 7534d84d2769fa7d83a78dfa9ec00bca79db38b5 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 6 Feb 2008 21:15:33 -0600 Subject: [PATCH 7/9] Refactor tools.test --- extra/tools/test/test.factor | 41 +++++++++++++++++++++--------------- 1 file changed, 24 insertions(+), 17 deletions(-) diff --git a/extra/tools/test/test.factor b/extra/tools/test/test.factor index 9590f32539..d761df35d2 100755 --- a/extra/tools/test/test.factor +++ b/extra/tools/test/test.factor @@ -61,35 +61,42 @@ M: expected-error summary dup first print-error "Traceback" swap third write-object ; -: failures. ( path failures -- ) - "Failing tests in " write swap . - [ nl failure. nl ] each ; - -: run-tests ( seq -- ) - dup empty? [ drop "==== NOTHING TO TEST" print ] [ - [ dup run-test ] { } map>assoc - [ second empty? not ] subset +: failures. ( assoc -- ) + dup [ nl dup empty? [ drop "==== ALL TESTS PASSED" print ] [ "==== FAILING TESTS:" print - [ nl failures. ] assoc-each + [ + nl + "Failing tests in " write swap . + [ nl failure. nl ] each + ] assoc-each ] if + ] [ + drop "==== NOTHING TO TEST" print ] if ; -: run-vocab-tests ( vocabs -- ) - [ vocab-tests-path ] map - [ dup [ ?resource-path exists? ] when ] subset - run-tests ; +: run-vocab-tests ( vocabs -- failures ) + dup empty? [ f ] [ + [ dup run-test ] { } map>assoc + [ second empty? not ] subset + ] if ; -: test ( prefix -- ) +: run-tests ( prefix -- failures ) child-vocabs [ vocab-source-loaded? ] subset + [ vocab-tests-path ] map + [ dup [ ?resource-path exists? ] when ] subset run-vocab-tests ; -: test-all ( -- ) "" test ; +: test ( prefix -- ) + run-tests failures. ; -: test-changes ( -- ) - "" to-refresh dupd do-refresh run-vocab-tests ; +: run-all-tests ( prefix -- failures ) + "" run-tests ; + +: test-all ( -- ) + run-all-tests failures. ; From 2541c62e291ad04de93fadbac7514820bcae657c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 6 Feb 2008 21:15:47 -0600 Subject: [PATCH 8/9] Fix code for math.parser changes --- core/math/parser/parser.factor | 8 ++++---- core/syntax/syntax-docs.factor | 4 +++- extra/json/reader/reader.factor | 2 +- extra/math/ratios/ratios-docs.factor | 1 + extra/math/text/english/english.factor | 2 +- extra/parser-combinators/simple/simple.factor | 2 +- extra/peg/peg.factor | 2 +- extra/project-euler/024/024.factor | 2 +- extra/project-euler/032/032.factor | 10 +++++----- extra/project-euler/035/035.factor | 2 +- extra/project-euler/037/037.factor | 2 +- extra/project-euler/038/038.factor | 2 +- extra/project-euler/040/040.factor | 2 +- extra/random-tester/safe-words/safe-words.factor | 2 +- 14 files changed, 23 insertions(+), 20 deletions(-) mode change 100644 => 100755 extra/json/reader/reader.factor mode change 100644 => 100755 extra/math/text/english/english.factor mode change 100644 => 100755 extra/peg/peg.factor mode change 100644 => 100755 extra/project-euler/024/024.factor mode change 100644 => 100755 extra/project-euler/032/032.factor mode change 100644 => 100755 extra/project-euler/035/035.factor mode change 100644 => 100755 extra/project-euler/037/037.factor mode change 100644 => 100755 extra/project-euler/038/038.factor mode change 100644 => 100755 extra/project-euler/040/040.factor mode change 100644 => 100755 extra/random-tester/safe-words/safe-words.factor diff --git a/core/math/parser/parser.factor b/core/math/parser/parser.factor index 73b4a725d2..64ce296a0b 100755 --- a/core/math/parser/parser.factor +++ b/core/math/parser/parser.factor @@ -33,6 +33,9 @@ IN: math.parser : string>digits ( str -- digits ) [ digit> ] { } map-as ; +: digits>integer ( seq radix -- n ) + 0 swap [ swapd * + ] curry reduce ; + DEFER: base> ) >r whole-part r> 3dup and and [ / + ] [ 3drop f ] if ; -: digits>integer ( seq -- n ) - 0 radix get [ swapd * + ] curry reduce ; - : valid-digits? ( seq -- ? ) { { [ dup empty? ] [ drop f ] } @@ -64,7 +64,7 @@ SYMBOL: radix : string>integer ( str -- n/f ) string>digits dup valid-digits? - [ digits>integer ] [ drop f ] if ; + [ radix get digits>integer ] [ drop f ] if ; PRIVATE> diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor index 2e5b41cd8d..9ccfd2efcd 100755 --- a/core/syntax/syntax-docs.factor +++ b/core/syntax/syntax-docs.factor @@ -47,11 +47,13 @@ ARTICLE: "syntax-integers" "Integer syntax" "More information on integers can be found in " { $link "integers" } "." ; ARTICLE: "syntax-ratios" "Ratio syntax" -"The printed representation of a ratio is a pair of integers separated by a slash (/). No intermediate whitespace is permitted. Either integer may be signed, however the ratio will be normalized into a form where the denominator is positive and the greatest common divisor of the two terms is 1." +"The printed representation of a ratio is a pair of integers separated by a slash (/), prefixed by an optional whole number part followed by a plus (+). No intermediate whitespace is permitted. Here are some examples:" { $code "75/33" "1/10" "-5/-6" + "1+1/3" + "-10+1/7" } "More information on ratios can be found in " { $link "rationals" } ; diff --git a/extra/json/reader/reader.factor b/extra/json/reader/reader.factor old mode 100644 new mode 100755 index 105989ab93..b136012433 --- a/extra/json/reader/reader.factor +++ b/extra/json/reader/reader.factor @@ -104,7 +104,7 @@ LAZY: 'digit1-9' ( -- parser ) LAZY: 'digit0-9' ( -- parser ) [ digit? ] satisfy [ digit> ] <@ ; -: decimal>integer ( seq -- num ) 10 swap digits>integer ; +: decimal>integer ( seq -- num ) 10 digits>integer ; LAZY: 'int' ( -- parser ) 'zero' diff --git a/extra/math/ratios/ratios-docs.factor b/extra/math/ratios/ratios-docs.factor index d996acaf1f..b780a7c322 100755 --- a/extra/math/ratios/ratios-docs.factor +++ b/extra/math/ratios/ratios-docs.factor @@ -7,6 +7,7 @@ ARTICLE: "rationals" "Rational numbers" "When we add, subtract or multiply any two integers, the result is always an integer. However, dividing a numerator by a denominator that is not an integral divisor of the denominator yields a ratio:" { $example "1210 11 / ." "110" } { $example "100 330 / ." "10/33" } +{ $example "14 10 / ." "1+2/5" } "Ratios are printed and can be input literally in the form above. Ratios are always reduced to lowest terms by factoring out the greatest common divisor of the numerator and denominator. A ratio with a denominator of 1 becomes an integer. Division with a denominator of 0 throws an error." $nl "Ratios behave just like any other number -- all numerical operations work as you would expect." diff --git a/extra/math/text/english/english.factor b/extra/math/text/english/english.factor old mode 100644 new mode 100755 index 645d7e2054..b77ac725ab --- a/extra/math/text/english/english.factor +++ b/extra/math/text/english/english.factor @@ -33,7 +33,7 @@ SYMBOL: and-needed? : 3digit-groups ( n -- seq ) number>string 3 - [ reverse 10 string>integer ] map ; + [ reverse string>number ] map ; : hundreds-place ( n -- str ) 100 /mod swap dup zero? [ diff --git a/extra/parser-combinators/simple/simple.factor b/extra/parser-combinators/simple/simple.factor index 763f823348..745442610c 100755 --- a/extra/parser-combinators/simple/simple.factor +++ b/extra/parser-combinators/simple/simple.factor @@ -8,7 +8,7 @@ IN: parser-combinators.simple [ digit? ] satisfy [ digit> ] <@ ; : 'integer' ( -- parser ) - 'digit' [ 10 swap digits>integer ] <@ ; + 'digit' [ 10 digits>integer ] <@ ; : 'string' ( -- parser ) [ CHAR: " = ] satisfy diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor old mode 100644 new mode 100755 index 41df8735e5..59a8b63c14 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -343,7 +343,7 @@ MEMO: 'digit' ( -- parser ) [ digit? ] satisfy [ digit> ] action ; MEMO: 'integer' ( -- parser ) - 'digit' repeat1 [ 10 swap digits>integer ] action ; + 'digit' repeat1 [ 10 digits>integer ] action ; MEMO: 'string' ( -- parser ) [ diff --git a/extra/project-euler/024/024.factor b/extra/project-euler/024/024.factor old mode 100644 new mode 100755 index c795fc0169..0cc0c39e07 --- a/extra/project-euler/024/024.factor +++ b/extra/project-euler/024/024.factor @@ -23,7 +23,7 @@ IN: project-euler.024 ! -------- : euler024 ( -- answer ) - 999999 10 permutation 10 swap digits>integer ; + 999999 10 permutation 10 digits>integer ; ! [ euler024 ] 100 ave-time ! 0 ms run / 0 ms GC ave time - 100 trials diff --git a/extra/project-euler/032/032.factor b/extra/project-euler/032/032.factor old mode 100644 new mode 100755 index 2baa6f8714..b8b0758974 --- a/extra/project-euler/032/032.factor +++ b/extra/project-euler/032/032.factor @@ -27,21 +27,21 @@ IN: project-euler.032 integer ] map ; + 9 factorial [ 9 permutation [ 1+ ] map 10 digits>integer ] map ; : 1and4 ( n -- ? ) number>string 1 cut-slice 4 cut-slice - [ 10 string>integer ] 3apply [ * ] dip = ; + [ string>number ] 3apply [ * ] dip = ; : 2and3 ( n -- ? ) number>string 2 cut-slice 3 cut-slice - [ 10 string>integer ] 3apply [ * ] dip = ; + [ string>number ] 3apply [ * ] dip = ; : valid? ( n -- ? ) dup 1and4 swap 2and3 or ; : products ( seq -- m ) - [ number>string 4 tail* 10 string>integer ] map ; + [ number>string 4 tail* string>number ] map ; PRIVATE> @@ -65,7 +65,7 @@ PRIVATE> ! multiplicand/multiplier/product : mmp ( pair -- n ) - first2 2dup * [ number>string ] 3apply 3append 10 string>integer ; + first2 2dup * [ number>string ] 3apply 3append string>number ; PRIVATE> diff --git a/extra/project-euler/035/035.factor b/extra/project-euler/035/035.factor old mode 100644 new mode 100755 index 867bbc44ac..29172111c1 --- a/extra/project-euler/035/035.factor +++ b/extra/project-euler/035/035.factor @@ -38,7 +38,7 @@ IN: project-euler.035 : (circular?) ( seq n -- ? ) dup 0 > [ - 2dup rotate 10 swap digits>integer + 2dup rotate 10 digits>integer prime? [ 1- (circular?) ] [ 2drop f ] if ] [ 2drop t diff --git a/extra/project-euler/037/037.factor b/extra/project-euler/037/037.factor old mode 100644 new mode 100755 index f2d5d17c4d..66b1665037 --- a/extra/project-euler/037/037.factor +++ b/extra/project-euler/037/037.factor @@ -32,7 +32,7 @@ IN: project-euler.037 ] if ; : reverse-digits ( n -- m ) - number>string reverse 10 string>integer ; + number>string reverse string>number ; : l-trunc? ( n -- ? ) reverse-digits 10 /i reverse-digits dup 0 > [ diff --git a/extra/project-euler/038/038.factor b/extra/project-euler/038/038.factor old mode 100644 new mode 100755 index cbe6f2363c..2369db25fb --- a/extra/project-euler/038/038.factor +++ b/extra/project-euler/038/038.factor @@ -36,7 +36,7 @@ IN: project-euler.038 : (concat-product) ( accum n multiplier -- m ) pick length 8 > [ - 2drop 10 swap digits>integer + 2drop 10 digits>integer ] [ [ * number>digits over push-all ] 2keep 1+ (concat-product) ] if ; diff --git a/extra/project-euler/040/040.factor b/extra/project-euler/040/040.factor old mode 100644 new mode 100755 index 8984559265..e2df1df2c9 --- a/extra/project-euler/040/040.factor +++ b/extra/project-euler/040/040.factor @@ -37,7 +37,7 @@ IN: project-euler.040 SBUF" " clone 1 -rot (concat-upto) ; : nth-integer ( n str -- m ) - [ 1- ] dip nth 1string 10 string>integer ; + [ 1- ] dip nth 1string string>number ; PRIVATE> diff --git a/extra/random-tester/safe-words/safe-words.factor b/extra/random-tester/safe-words/safe-words.factor old mode 100644 new mode 100755 index 9bc87a9c5a..ab528786bb --- a/extra/random-tester/safe-words/safe-words.factor +++ b/extra/random-tester/safe-words/safe-words.factor @@ -16,7 +16,7 @@ IN: random-tester.safe-words array? integer? complex? value-ref? ref? key-ref? interval? number? wrapper? tuple? - [-1,1]? between? bignum? both? either? eq? equal? even? fixnum? float? fp-nan? hashtable? interval-contains? interval-subset? interval? key-ref? key? number? odd? pair? power-of-2? ratio? rational? real? subassoc? valid-digits? zero? assoc? curry? vector? callstack? ! clear 3.14 [ assoc? ] compile-1 + [-1,1]? between? bignum? both? either? eq? equal? even? fixnum? float? fp-nan? hashtable? interval-contains? interval-subset? interval? key-ref? key? number? odd? pair? power-of-2? ratio? rational? real? subassoc? zero? assoc? curry? vector? callstack? ! clear 3.14 [ assoc? ] compile-1 2^ not ! arrays resize-array From c1dd7cf855c2f863c44f4d8cb0877e3f854f525c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 6 Feb 2008 21:16:52 -0600 Subject: [PATCH 9/9] Fix Doug's bug --- extra/ui/tools/operations/operations.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/ui/tools/operations/operations.factor b/extra/ui/tools/operations/operations.factor index 2375730a81..fbb4338b17 100755 --- a/extra/ui/tools/operations/operations.factor +++ b/extra/ui/tools/operations/operations.factor @@ -188,7 +188,7 @@ source-editor "These commands operate on the Factor word named by the token at the caret position." \ selected-word [ selected-word ] -[ search ] +[ dup search [ ] [ no-word ] ?if ] define-operation-map interactor