Merge branch 'master' of git://factorcode.org/git/factor

db4
Doug Coleman 2009-03-18 17:46:00 -05:00
commit 9a8e7fe3ed
14 changed files with 54 additions and 49 deletions

View File

@ -14,7 +14,7 @@ words splitting grouping sorting accessors ;
[ t ] [ [ t ] [
symbolic-stack-trace symbolic-stack-trace
[ word? ] filter [ word? ] filter
{ baz bar foo throw } tail? { baz bar foo } tail?
] unit-test ] unit-test
: bleh ( seq -- seq' ) [ 3 + ] map [ 0 > ] filter ; : bleh ( seq -- seq' ) [ 3 + ] map [ 0 > ] filter ;

View File

@ -58,7 +58,7 @@ HELP: npick
"placed on the top of the stack." "placed on the top of the stack."
} }
{ $examples { $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 } ":" "Some core words expressed in terms of " { $link npick } ":"
{ $table { $table
{ { $link dup } { $snippet "1 npick" } } { { $link dup } { $snippet "1 npick" } }
@ -75,7 +75,7 @@ HELP: ndup
"placed on the top of the stack." "placed on the top of the stack."
} }
{ $examples { $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 } ":" "Some core words expressed in terms of " { $link ndup } ":"
{ $table { $table
{ { $link dup } { $snippet "1 ndup" } } { { $link dup } { $snippet "1 ndup" } }
@ -91,7 +91,7 @@ HELP: nnip
"for any number of items." "for any number of items."
} }
{ $examples { $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 } ":" "Some core words expressed in terms of " { $link nnip } ":"
{ $table { $table
{ { $link nip } { $snippet "1 nnip" } } { { $link nip } { $snippet "1 nnip" } }
@ -106,7 +106,7 @@ HELP: ndrop
"for any number of items." "for any number of items."
} }
{ $examples { $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 } ":" "Some core words expressed in terms of " { $link ndrop } ":"
{ $table { $table
{ { $link drop } { $snippet "1 ndrop" } } { { $link drop } { $snippet "1 ndrop" } }
@ -121,7 +121,7 @@ HELP: nrot
"number of items on the stack. " "number of items on the stack. "
} }
{ $examples { $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 } ":" "Some core words expressed in terms of " { $link nrot } ":"
{ $table { $table
{ { $link swap } { $snippet "1 nrot" } } { { $link swap } { $snippet "1 nrot" } }
@ -135,7 +135,7 @@ HELP: -nrot
"number of items on the stack. " "number of items on the stack. "
} }
{ $examples { $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 } ":" "Some core words expressed in terms of " { $link -nrot } ":"
{ $table { $table
{ { $link swap } { $snippet "1 -nrot" } } { { $link swap } { $snippet "1 -nrot" } }
@ -151,8 +151,8 @@ HELP: ndip
"stack. The quotation can consume and produce any number of items." "stack. The quotation can consume and produce any number of items."
} }
{ $examples { $examples
{ $example "USING: generalizations kernel prettyprint kernel ;" "1 2 [ dup ] 1 ndip .s clear" "1\n1\n2" } { $example "USING: arrays generalizations kernel prettyprint ;" "1 2 [ dup ] 1 ndip 3array ." "{ 1 1 2 }" }
{ $example "USING: generalizations kernel prettyprint kernel ;" "1 2 3 [ drop ] 2 ndip .s clear" "2\n3" } { $example "USING: arrays generalizations kernel prettyprint ;" "1 2 3 [ drop ] 2 ndip 2array ." "{ 2 3 }" }
"Some core words expressed in terms of " { $link ndip } ":" "Some core words expressed in terms of " { $link ndip } ":"
{ $table { $table
{ { $link dip } { $snippet "1 ndip" } } { { $link dip } { $snippet "1 ndip" } }
@ -168,7 +168,7 @@ HELP: nslip
"removed from the stack, the quotation called, and the items restored." "removed from the stack, the quotation called, and the items restored."
} }
{ $examples { $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 } ":" "Some core words expressed in terms of " { $link nslip } ":"
{ $table { $table
{ { $link slip } { $snippet "1 nslip" } } { { $link slip } { $snippet "1 nslip" } }
@ -184,7 +184,7 @@ HELP: nkeep
"saved, the quotation called, and the items restored." "saved, the quotation called, and the items restored."
} }
{ $examples { $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 } ":" "Some core words expressed in terms of " { $link nkeep } ":"
{ $table { $table
{ { $link keep } { $snippet "1 nkeep" } } { { $link keep } { $snippet "1 nkeep" } }

View File

@ -61,6 +61,4 @@ M: funky url-of "http://www.funky-town.com/" swap town>> append ;
[ H{ } [ ] with-nesting nl ] make-html-string [ H{ } [ ] with-nesting nl ] make-html-string
] unit-test ] unit-test
[ ] [ [ { 1 2 3 } describe ] with-html-writer drop ] unit-test [ ] [ [ { 1 2 3 } describe ] with-html-writer drop ] unit-test
[ ] [ [ \ predicate-instance? def>> . ] with-html-writer drop ] unit-test

View File

@ -0,0 +1 @@
Slava Pestov

View File

@ -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 ;

View File

@ -1,10 +1,9 @@
! Copyright (C) 2008, 2009 Doug Coleman, Daniel Ehrenberg. ! Copyright (C) 2008, 2009 Doug Coleman, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors combinators kernel kernel.private math sequences USING: accessors combinators kernel kernel.private math sequences
sequences.private strings sets assocs prettyprint.backend sequences.private strings sets assocs make lexer namespaces parser
prettyprint.custom make lexer namespaces parser arrays fry locals arrays fry locals regexp.parser splitting sorting regexp.ast
regexp.parser splitting sorting regexp.ast regexp.negation regexp.negation regexp.compiler compiler.units words math.ranges ;
regexp.compiler compiler.units words math.ranges ;
IN: regexp IN: regexp
TUPLE: regexp TUPLE: regexp
@ -217,11 +216,8 @@ PRIVATE>
: R{ CHAR: } parsing-regexp ; parsing : R{ CHAR: } parsing-regexp ; parsing
: R| CHAR: | parsing-regexp ; parsing : R| CHAR: | parsing-regexp ; parsing
M: regexp pprint* USING: vocabs vocabs.loader ;
[
[
[ raw>> dup find-regexp-syntax swap % swap % % ]
[ options>> options>string % ] bi
] "" make
] keep present-text ;
"prettyprint" vocab [
"regexp.prettyprint" require
] when

View File

@ -26,6 +26,8 @@ os macosx? [
[ t ] [ "webkit-demo" shake-and-bake 500000 small-enough? ] unit-test [ t ] [ "webkit-demo" shake-and-bake 500000 small-enough? ] unit-test
] when ] when
[ t ] [ "benchmark.regex-dna" shake-and-bake 1200000 small-enough? ] unit-test
{ {
"tools.deploy.test.1" "tools.deploy.test.1"
"tools.deploy.test.2" "tools.deploy.test.2"

View File

@ -54,11 +54,8 @@ IN: tools.deploy.shaker
] when ; ] when ;
: strip-call ( -- ) : strip-call ( -- )
"call" vocab [ "Stripping stack effect checking from call( and execute(" show
"Stripping stack effect checking from call( and execute(" show "vocab:tools/deploy/shaker/strip-call.factor" run-file ;
"vocab:tools/deploy/shaker/strip-call.factor"
run-file
] when ;
: strip-cocoa ( -- ) : strip-cocoa ( -- )
"cocoa" vocab [ "cocoa" vocab [

View File

@ -2,8 +2,8 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
IN: tools.deploy.shaker.call IN: tools.deploy.shaker.call
IN: call IN: combinators
USE: call.private USE: combinators.private
: call-effect ( word effect -- ) call-effect-unsafe ; inline : call-effect ( word effect -- ) call-effect-unsafe ; inline

View File

@ -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." } { $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 { $examples
{ $example { $example
"USING: prettyprint urls kernel ;" "USING: arrays kernel prettyprint urls ;"
"\"sbcl.org:80\" parse-host .s 2drop" "\"sbcl.org:80\" parse-host 2array ."
"\"sbcl.org\"\n80" "{ \"sbcl.org\" 80 }"
} }
} ; } ;

View File

@ -27,20 +27,18 @@ combinators vocabs.parser grouping ;
IN: vocabs.loader.test.2 IN: vocabs.loader.test.2
: hello 3 ; : hello ( -- ) ;
MAIN: hello MAIN: hello
IN: vocabs.loader.tests IN: vocabs.loader.tests
[ { 3 3 3 } ] [ [ ] [
"vocabs.loader.test.2" run "vocabs.loader.test.2" run
"vocabs.loader.test.2" vocab run "vocabs.loader.test.2" vocab run
"vocabs.loader.test.2" <vocab-link> run "vocabs.loader.test.2" <vocab-link> run
3array
] unit-test ] unit-test
[ [
"resource:core/vocabs/loader/test/a/a.factor" forget-source "resource:core/vocabs/loader/test/a/a.factor" forget-source
"vocabs.loader.test.a" forget-vocab "vocabs.loader.test.a" forget-vocab

View File

@ -49,7 +49,7 @@ PRIVATE>
in-advice? get [ "ad-do-it should only be called inside 'around' advice" throw ] unless coyield ; in-advice? get [ "ad-do-it should only be called inside 'around' advice" throw ] unless coyield ;
: make-advised ( word -- ) : 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 } [ <linked-hash> swap set-word-prop ] with each ] [ { before after around } [ <linked-hash> swap set-word-prop ] with each ]
[ t advised set-word-prop ] tri ; [ t advised set-word-prop ] tri ;

View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors prettyprint io io.encodings.ascii USING: accessors io io.encodings.ascii io.files kernel sequences
io.files kernel sequences assocs namespaces regexp ; assocs math.parser namespaces regexp ;
IN: benchmark.regex-dna IN: benchmark.regex-dna
! Based on http://shootout.alioth.debian.org/gp4/benchmark.php?test=regexdna&lang=ruby&id=1 ! 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 R/ agggtaa[cgt]|[acg]ttaccct/i
} [ } [
[ raw>> write bl ] [ raw>> write bl ]
[ count-matches . ] [ count-matches number>string print ]
bi bi
] with each ; ] with each ;
@ -50,9 +50,9 @@ SYMBOL: clen
dup count-patterns dup count-patterns
do-replacements do-replacements
nl nl
ilen get . ilen get number>string print
clen get . clen get number>string print
length . ; length number>string print ;
: regex-dna-main ( -- ) : regex-dna-main ( -- )
"resource:extra/benchmark/regex-dna/regex-dna-test-in.txt" regex-dna ; "resource:extra/benchmark/regex-dna/regex-dna-test-in.txt" regex-dna ;

View File

@ -1,6 +1,6 @@
USING: kernel sequences namespaces make math assocs words arrays USING: kernel sequences namespaces make math assocs words arrays
tools.annotations vocabs sorting prettyprint io system tools.annotations vocabs sorting prettyprint io system
math.statistics accessors tools.time ; math.statistics accessors tools.time fry ;
IN: wordtimer IN: wordtimer
SYMBOL: *wordtimes* SYMBOL: *wordtimes*
@ -40,7 +40,7 @@ SYMBOL: *calling*
[ swap time-unless-recursing ] 2curry ; [ swap time-unless-recursing ] 2curry ;
: add-timer ( word -- ) : add-timer ( word -- )
dup [ (add-timer) ] annotate ; dup '[ [ _ ] dip (add-timer) ] annotate ;
: add-timers ( vocab -- ) : add-timers ( vocab -- )
words [ add-timer ] each ; words [ add-timer ] each ;