diff --git a/basis/compiler/tests/stack-trace.factor b/basis/compiler/tests/stack-trace.factor index cfbea3bcb9..b317ed3eb5 100755 --- a/basis/compiler/tests/stack-trace.factor +++ b/basis/compiler/tests/stack-trace.factor @@ -14,7 +14,7 @@ words splitting grouping sorting accessors ; [ t ] [ symbolic-stack-trace [ word? ] filter - { baz bar foo throw } tail? + { baz bar foo } tail? ] unit-test : bleh ( seq -- seq' ) [ 3 + ] map [ 0 > ] filter ; diff --git a/basis/generalizations/generalizations-docs.factor b/basis/generalizations/generalizations-docs.factor index 376ae5bed2..2088e468c6 100644 --- a/basis/generalizations/generalizations-docs.factor +++ b/basis/generalizations/generalizations-docs.factor @@ -58,7 +58,7 @@ HELP: npick "placed on the top of the stack." } { $examples - { $example "USING: kernel prettyprint generalizations ;" "1 2 3 4 4 npick .s clear" "1\n2\n3\n4\n1" } + { $example "USING: kernel prettyprint generalizations ;" "1 2 3 4 4 npick 5 narray ." "{ 1 2 3 4 1 }" } "Some core words expressed in terms of " { $link npick } ":" { $table { { $link dup } { $snippet "1 npick" } } @@ -75,7 +75,7 @@ HELP: ndup "placed on the top of the stack." } { $examples - { $example "USING: prettyprint generalizations kernel ;" "1 2 3 4 4 ndup .s clear" "1\n2\n3\n4\n1\n2\n3\n4" } + { $example "USING: prettyprint generalizations kernel ;" "1 2 3 4 4 ndup 8 narray ." "{ 1 2 3 4 1 2 3 4 }" } "Some core words expressed in terms of " { $link ndup } ":" { $table { { $link dup } { $snippet "1 ndup" } } @@ -91,7 +91,7 @@ HELP: nnip "for any number of items." } { $examples - { $example "USING: prettyprint generalizations kernel ;" "1 2 3 4 3 nnip .s clear" "4" } + { $example "USING: prettyprint generalizations kernel ;" "1 2 3 4 3 nnip ." "4" } "Some core words expressed in terms of " { $link nnip } ":" { $table { { $link nip } { $snippet "1 nnip" } } @@ -106,7 +106,7 @@ HELP: ndrop "for any number of items." } { $examples - { $example "USING: prettyprint generalizations kernel ;" "1 2 3 4 3 ndrop .s clear" "1" } + { $example "USING: prettyprint generalizations kernel ;" "1 2 3 4 3 ndrop ." "1" } "Some core words expressed in terms of " { $link ndrop } ":" { $table { { $link drop } { $snippet "1 ndrop" } } @@ -121,7 +121,7 @@ HELP: nrot "number of items on the stack. " } { $examples - { $example "USING: prettyprint generalizations kernel ;" "1 2 3 4 4 nrot .s clear" "2\n3\n4\n1" } + { $example "USING: arrays generalizations kernel prettyprint ;" "1 2 3 4 4 nrot 4array ." "{ 2 3 4 1 }" } "Some core words expressed in terms of " { $link nrot } ":" { $table { { $link swap } { $snippet "1 nrot" } } @@ -135,7 +135,7 @@ HELP: -nrot "number of items on the stack. " } { $examples - { $example "USING: prettyprint generalizations kernel ;" "1 2 3 4 4 -nrot .s clear" "4\n1\n2\n3" } + { $example "USING: arrays generalizations kernel prettyprint ;" "1 2 3 4 4 -nrot 4array ." "{ 4 1 2 3 }" } "Some core words expressed in terms of " { $link -nrot } ":" { $table { { $link swap } { $snippet "1 -nrot" } } @@ -151,8 +151,8 @@ HELP: ndip "stack. The quotation can consume and produce any number of items." } { $examples - { $example "USING: generalizations kernel prettyprint kernel ;" "1 2 [ dup ] 1 ndip .s clear" "1\n1\n2" } - { $example "USING: generalizations kernel prettyprint kernel ;" "1 2 3 [ drop ] 2 ndip .s clear" "2\n3" } + { $example "USING: arrays generalizations kernel prettyprint ;" "1 2 [ dup ] 1 ndip 3array ." "{ 1 1 2 }" } + { $example "USING: arrays generalizations kernel prettyprint ;" "1 2 3 [ drop ] 2 ndip 2array ." "{ 2 3 }" } "Some core words expressed in terms of " { $link ndip } ":" { $table { { $link dip } { $snippet "1 ndip" } } @@ -168,7 +168,7 @@ HELP: nslip "removed from the stack, the quotation called, and the items restored." } { $examples - { $example "USING: generalizations kernel prettyprint ;" "[ 99 ] 1 2 3 4 5 5 nslip .s clear" "99\n1\n2\n3\n4\n5" } + { $example "USING: generalizations kernel prettyprint ;" "[ 99 ] 1 2 3 4 5 5 nslip 6 narray ." "{ 99 1 2 3 4 5 }" } "Some core words expressed in terms of " { $link nslip } ":" { $table { { $link slip } { $snippet "1 nslip" } } @@ -184,7 +184,7 @@ HELP: nkeep "saved, the quotation called, and the items restored." } { $examples - { $example "USING: generalizations kernel prettyprint ;" "1 2 3 4 5 [ drop drop drop drop drop 99 ] 5 nkeep .s clear" "99\n1\n2\n3\n4\n5" } + { $example "USING: generalizations kernel prettyprint ;" "1 2 3 4 5 [ drop drop drop drop drop 99 ] 5 nkeep 6 narray ." "{ 99 1 2 3 4 5 }" } "Some core words expressed in terms of " { $link nkeep } ":" { $table { { $link keep } { $snippet "1 nkeep" } } diff --git a/basis/html/streams/streams-tests.factor b/basis/html/streams/streams-tests.factor index 249861b12a..835874cbb7 100644 --- a/basis/html/streams/streams-tests.factor +++ b/basis/html/streams/streams-tests.factor @@ -61,6 +61,4 @@ M: funky url-of "http://www.funky-town.com/" swap town>> append ; [ H{ } [ ] with-nesting nl ] make-html-string ] unit-test -[ ] [ [ { 1 2 3 } describe ] with-html-writer drop ] unit-test - -[ ] [ [ \ predicate-instance? def>> . ] with-html-writer drop ] unit-test +[ ] [ [ { 1 2 3 } describe ] with-html-writer drop ] unit-test \ No newline at end of file diff --git a/basis/regexp/prettyprint/authors.txt b/basis/regexp/prettyprint/authors.txt new file mode 100644 index 0000000000..d4f5d6b3ae --- /dev/null +++ b/basis/regexp/prettyprint/authors.txt @@ -0,0 +1 @@ +Slava Pestov \ No newline at end of file diff --git a/basis/regexp/prettyprint/prettyprint.factor b/basis/regexp/prettyprint/prettyprint.factor new file mode 100644 index 0000000000..7af762a34e --- /dev/null +++ b/basis/regexp/prettyprint/prettyprint.factor @@ -0,0 +1,13 @@ +! Copyright (C) 2008, 2009 Doug Coleman, Daniel Ehrenberg. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors kernel make prettyprint.backend +prettyprint.custom regexp regexp.parser regexp.private ; +IN: regexp.prettyprint + +M: regexp pprint* + [ + [ + [ raw>> dup find-regexp-syntax swap % swap % % ] + [ options>> options>string % ] bi + ] "" make + ] keep present-text ; \ No newline at end of file diff --git a/basis/regexp/regexp.factor b/basis/regexp/regexp.factor index 5889b19e47..33499b1437 100644 --- a/basis/regexp/regexp.factor +++ b/basis/regexp/regexp.factor @@ -1,10 +1,9 @@ ! Copyright (C) 2008, 2009 Doug Coleman, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: accessors combinators kernel kernel.private math sequences -sequences.private strings sets assocs prettyprint.backend -prettyprint.custom make lexer namespaces parser arrays fry locals -regexp.parser splitting sorting regexp.ast regexp.negation -regexp.compiler compiler.units words math.ranges ; +sequences.private strings sets assocs make lexer namespaces parser +arrays fry locals regexp.parser splitting sorting regexp.ast +regexp.negation regexp.compiler compiler.units words math.ranges ; IN: regexp TUPLE: regexp @@ -217,11 +216,8 @@ PRIVATE> : R{ CHAR: } parsing-regexp ; parsing : R| CHAR: | parsing-regexp ; parsing -M: regexp pprint* - [ - [ - [ raw>> dup find-regexp-syntax swap % swap % % ] - [ options>> options>string % ] bi - ] "" make - ] keep present-text ; +USING: vocabs vocabs.loader ; +"prettyprint" vocab [ + "regexp.prettyprint" require +] when \ No newline at end of file diff --git a/basis/tools/deploy/deploy-tests.factor b/basis/tools/deploy/deploy-tests.factor index 3a2f960fc9..0a7549430d 100644 --- a/basis/tools/deploy/deploy-tests.factor +++ b/basis/tools/deploy/deploy-tests.factor @@ -26,6 +26,8 @@ os macosx? [ [ t ] [ "webkit-demo" shake-and-bake 500000 small-enough? ] unit-test ] when +[ t ] [ "benchmark.regex-dna" shake-and-bake 1200000 small-enough? ] unit-test + { "tools.deploy.test.1" "tools.deploy.test.2" diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index 239d34b864..a729e40e2a 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -54,11 +54,8 @@ IN: tools.deploy.shaker ] when ; : strip-call ( -- ) - "call" vocab [ - "Stripping stack effect checking from call( and execute(" show - "vocab:tools/deploy/shaker/strip-call.factor" - run-file - ] when ; + "Stripping stack effect checking from call( and execute(" show + "vocab:tools/deploy/shaker/strip-call.factor" run-file ; : strip-cocoa ( -- ) "cocoa" vocab [ diff --git a/basis/tools/deploy/shaker/strip-call.factor b/basis/tools/deploy/shaker/strip-call.factor index 860a0f3849..d0593b6c15 100644 --- a/basis/tools/deploy/shaker/strip-call.factor +++ b/basis/tools/deploy/shaker/strip-call.factor @@ -2,8 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. IN: tools.deploy.shaker.call -IN: call -USE: call.private +IN: combinators +USE: combinators.private : call-effect ( word effect -- ) call-effect-unsafe ; inline diff --git a/basis/urls/urls-docs.factor b/basis/urls/urls-docs.factor index 437a9419e3..707caf3188 100644 --- a/basis/urls/urls-docs.factor +++ b/basis/urls/urls-docs.factor @@ -82,9 +82,9 @@ HELP: parse-host { $notes "This word is used by " { $link >url } ". It can also be used directly to parse " { $snippet "host:port" } " strings which are not full URLs." } { $examples { $example - "USING: prettyprint urls kernel ;" - "\"sbcl.org:80\" parse-host .s 2drop" - "\"sbcl.org\"\n80" + "USING: arrays kernel prettyprint urls ;" + "\"sbcl.org:80\" parse-host 2array ." + "{ \"sbcl.org\" 80 }" } } ; diff --git a/core/vocabs/loader/loader-tests.factor b/core/vocabs/loader/loader-tests.factor index cb4a0b50aa..4241999bcd 100644 --- a/core/vocabs/loader/loader-tests.factor +++ b/core/vocabs/loader/loader-tests.factor @@ -27,20 +27,18 @@ combinators vocabs.parser grouping ; IN: vocabs.loader.test.2 -: hello 3 ; +: hello ( -- ) ; MAIN: hello IN: vocabs.loader.tests -[ { 3 3 3 } ] [ +[ ] [ "vocabs.loader.test.2" run "vocabs.loader.test.2" vocab run "vocabs.loader.test.2" run - 3array ] unit-test - [ "resource:core/vocabs/loader/test/a/a.factor" forget-source "vocabs.loader.test.a" forget-vocab diff --git a/extra/advice/advice.factor b/extra/advice/advice.factor index fbdfa9c66b..be9835c5b9 100644 --- a/extra/advice/advice.factor +++ b/extra/advice/advice.factor @@ -49,7 +49,7 @@ PRIVATE> in-advice? get [ "ad-do-it should only be called inside 'around' advice" throw ] unless coyield ; : make-advised ( word -- ) - [ dup [ over dup '[ _ call-before _ _ call-around _ call-after ] ] annotate ] + [ dup '[ [ _ ] dip over dup '[ _ call-before _ _ call-around _ call-after ] ] annotate ] [ { before after around } [ swap set-word-prop ] with each ] [ t advised set-word-prop ] tri ; diff --git a/extra/benchmark/regex-dna/regex-dna.factor b/extra/benchmark/regex-dna/regex-dna.factor index 5c11be357f..24e7759783 100644 --- a/extra/benchmark/regex-dna/regex-dna.factor +++ b/extra/benchmark/regex-dna/regex-dna.factor @@ -1,7 +1,7 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors prettyprint io io.encodings.ascii -io.files kernel sequences assocs namespaces regexp ; +USING: accessors io io.encodings.ascii io.files kernel sequences +assocs math.parser namespaces regexp ; IN: benchmark.regex-dna ! Based on http://shootout.alioth.debian.org/gp4/benchmark.php?test=regexdna&lang=ruby&id=1 @@ -22,7 +22,7 @@ IN: benchmark.regex-dna R/ agggtaa[cgt]|[acg]ttaccct/i } [ [ raw>> write bl ] - [ count-matches . ] + [ count-matches number>string print ] bi ] with each ; @@ -50,9 +50,9 @@ SYMBOL: clen dup count-patterns do-replacements nl - ilen get . - clen get . - length . ; + ilen get number>string print + clen get number>string print + length number>string print ; : regex-dna-main ( -- ) "resource:extra/benchmark/regex-dna/regex-dna-test-in.txt" regex-dna ; diff --git a/extra/wordtimer/wordtimer.factor b/extra/wordtimer/wordtimer.factor index 7abdc149dd..34cd19c34f 100644 --- a/extra/wordtimer/wordtimer.factor +++ b/extra/wordtimer/wordtimer.factor @@ -1,6 +1,6 @@ USING: kernel sequences namespaces make math assocs words arrays tools.annotations vocabs sorting prettyprint io system -math.statistics accessors tools.time ; +math.statistics accessors tools.time fry ; IN: wordtimer SYMBOL: *wordtimes* @@ -40,7 +40,7 @@ SYMBOL: *calling* [ swap time-unless-recursing ] 2curry ; : add-timer ( word -- ) - dup [ (add-timer) ] annotate ; + dup '[ [ _ ] dip (add-timer) ] annotate ; : add-timers ( vocab -- ) words [ add-timer ] each ;