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

db4
Daniel Ehrenberg 2009-03-11 19:39:55 -05:00
commit 98392ef2ab
18 changed files with 85 additions and 96 deletions

View File

@ -1,7 +1,7 @@
USING: delegate kernel arrays tools.test words math definitions USING: delegate kernel arrays tools.test words math definitions
compiler.units parser generic prettyprint io.streams.string compiler.units parser generic prettyprint io.streams.string
accessors eval multiline generic.standard delegate.protocols accessors eval multiline generic.standard delegate.protocols
delegate.private assocs ; delegate.private assocs see ;
IN: delegate.tests IN: delegate.tests
TUPLE: hello this that ; TUPLE: hello this that ;

View File

@ -1,6 +1,6 @@
USING: math definitions help.topics help tools.test USING: math definitions help.topics help tools.test
prettyprint parser io.streams.string kernel source-files prettyprint parser io.streams.string kernel source-files
assocs namespaces words io sequences eval accessors ; assocs namespaces words io sequences eval accessors see ;
IN: help.definitions.tests IN: help.definitions.tests
[ ] [ \ + >link see ] unit-test [ ] [ \ + >link see ] unit-test

View File

@ -8,7 +8,7 @@ f describe
H{ } describe H{ } describe
H{ } describe H{ } describe
[ "fixnum instance\n" ] [ [ 3 describe ] with-string-writer ] unit-test [ "fixnum instance\n\n" ] [ [ 3 describe ] with-string-writer ] unit-test
[ ] [ H{ } clone inspect ] unit-test [ ] [ H{ } clone inspect ] unit-test

View File

@ -2,7 +2,7 @@ USING: locals math sequences tools.test hashtables words kernel
namespaces arrays strings prettyprint io.streams.string parser namespaces arrays strings prettyprint io.streams.string parser
accessors generic eval combinators combinators.short-circuit accessors generic eval combinators combinators.short-circuit
combinators.short-circuit.smart math.order math.functions combinators.short-circuit.smart math.order math.functions
definitions compiler.units fry lexer words.symbol ; definitions compiler.units fry lexer words.symbol see ;
IN: locals.tests IN: locals.tests
:: foo ( a b -- a a ) a a ; :: foo ( a b -- a a ) a a ;

View File

@ -1,6 +1,6 @@
IN: macros.tests IN: macros.tests
USING: tools.test macros math kernel arrays USING: tools.test macros math kernel arrays
vectors io.streams.string prettyprint parser eval ; vectors io.streams.string prettyprint parser eval see ;
MACRO: see-test ( a b -- c ) + ; MACRO: see-test ( a b -- c ) + ;

View File

@ -1,7 +1,7 @@
! Copyright (C) 2007, 2009 Slava Pestov, Daniel Ehrenberg. ! Copyright (C) 2007, 2009 Slava Pestov, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: math kernel memoize tools.test parser generalizations USING: math kernel memoize tools.test parser generalizations
prettyprint io.streams.string sequences eval namespaces ; prettyprint io.streams.string sequences eval namespaces see ;
IN: memoize.tests IN: memoize.tests
MEMO: fib ( m -- n ) MEMO: fib ( m -- n )

View File

@ -5,15 +5,19 @@ images kernel namespaces ;
IN: opengl.textures.tests IN: opengl.textures.tests
[ ] [ [ ] [
{ 3 5 } T{ image
RGB { dim { 3 5 } }
B{ { component-order RGB }
1 2 3 4 5 6 7 8 9 { bitmap
10 11 12 13 14 15 16 17 18 B{
19 20 21 22 23 24 25 26 27 1 2 3 4 5 6 7 8 9
28 29 30 31 32 33 34 35 36 10 11 12 13 14 15 16 17 18
37 38 39 40 41 42 43 44 45 19 20 21 22 23 24 25 26 27
} image boa "image" set 28 29 30 31 32 33 34 35 36
37 38 39 40 41 42 43 44 45
}
}
} "image" set
] unit-test ] unit-test
[ [

View File

@ -42,8 +42,8 @@ ARTICLE: { "regexp" "operations" } "Matching operations with regular expressions
{ $subsection matches? } { $subsection matches? }
{ $subsection re-contains? } { $subsection re-contains? }
{ $subsection first-match } { $subsection first-match }
{ $subsection all-matches } { $subsection all-matching-slices }
{ $subsection re-split1 } { $subsection all-matching-subseqs }
{ $subsection re-split } { $subsection re-split }
{ $subsection re-replace } { $subsection re-replace }
{ $subsection count-matches } ; { $subsection count-matches } ;
@ -67,25 +67,21 @@ HELP: matches?
{ $values { "string" string } { "regexp" regexp } { "?" "a boolean" } } { $values { "string" string } { "regexp" regexp } { "?" "a boolean" } }
{ $description "Tests if the string as a whole matches the given regular expression." } ; { $description "Tests if the string as a whole matches the given regular expression." } ;
HELP: re-split1 HELP: all-matching-slices
{ $values { "string" string } { "regexp" regexp } { "before" string } { "after/f" string } }
{ $description "Searches the string for a substring which matches the pattern. If found, the input string is split on the leftmost and longest occurence of the match, and the two halves are given as output. If no match is found, then the input string and " { $link f } " are output." } ;
HELP: all-matches
{ $values { "string" string } { "regexp" regexp } { "seq" "a sequence of slices of the input" } } { $values { "string" string } { "regexp" regexp } { "seq" "a sequence of slices of the input" } }
{ $description "Finds a sequence of disjoint substrings which each match the pattern. It chooses this by finding the leftmost longest match, and then the leftmost longest match which starts after the end of the previous match, and so on." } ; { $description "Finds a sequence of disjoint substrings which each match the pattern. It chooses this by finding the leftmost longest match, and then the leftmost longest match which starts after the end of the previous match, and so on." } ;
HELP: count-matches HELP: count-matches
{ $values { "string" string } { "regexp" regexp } { "n" integer } } { $values { "string" string } { "regexp" regexp } { "n" integer } }
{ $description "Counts how many disjoint matches the regexp has in the string, as made unambiguous by " { $link all-matches } "." } ; { $description "Counts how many disjoint matches the regexp has in the string, as made unambiguous by " { $link all-matching-slices } "." } ;
HELP: re-split HELP: re-split
{ $values { "string" string } { "regexp" regexp } { "seq" "a sequence of slices of the input" } } { $values { "string" string } { "regexp" regexp } { "seq" "a sequence of slices of the input" } }
{ $description "Splits the input string into chunks separated by the regular expression. Each chunk contains no match of the regexp. The chunks are chosen by the strategy of " { $link all-matches } "." } ; { $description "Splits the input string into chunks separated by the regular expression. Each chunk contains no match of the regexp. The chunks are chosen by the strategy of " { $link all-matching-slices } "." } ;
HELP: re-replace HELP: re-replace
{ $values { "string" string } { "regexp" regexp } { "replacement" string } { "result" string } } { $values { "string" string } { "regexp" regexp } { "replacement" string } { "result" string } }
{ $description "Replaces substrings which match the input regexp with the given replacement text. The boundaries of the substring are chosen by the strategy used by " { $link all-matches } "." } ; { $description "Replaces substrings which match the input regexp with the given replacement text. The boundaries of the substring are chosen by the strategy used by " { $link all-matching-slices } "." } ;
HELP: first-match HELP: first-match
{ $values { "string" string } { "regexp" regexp } { "slice/f" "the match, if one exists" } } { $values { "string" string } { "regexp" regexp } { "slice/f" "the match, if one exists" } }

View File

@ -287,7 +287,7 @@ IN: regexp-tests
[ { "a" "" } ] [ "a=" R/ =/ re-split [ >string ] map ] unit-test [ { "a" "" } ] [ "a=" R/ =/ re-split [ >string ] map ] unit-test
[ { "ABC" "DEF" "GHI" } ] [ { "ABC" "DEF" "GHI" } ]
[ "1ABC2DEF3GHI4" R/ [A-Z]+/ all-matches [ >string ] map ] unit-test [ "1ABC2DEF3GHI4" R/ [A-Z]+/ all-matching-subseqs ] unit-test
[ 3 ] [ 3 ]
[ "1ABC2DEF3GHI4" R/ [A-Z]+/ count-matches ] unit-test [ "1ABC2DEF3GHI4" R/ [A-Z]+/ count-matches ] unit-test
@ -431,7 +431,7 @@ IN: regexp-tests
[ f ] [ "a bar b" R/ foo/ re-contains? ] unit-test [ f ] [ "a bar b" R/ foo/ re-contains? ] unit-test
[ t ] [ "foo" R/ foo/ re-contains? ] unit-test [ t ] [ "foo" R/ foo/ re-contains? ] unit-test
[ { "foo" "fxx" "fab" } ] [ "fab fxx foo" R/ f../r all-matches [ >string ] map ] unit-test [ { "foo" "fxx" "fab" } ] [ "fab fxx foo" R/ f../r all-matching-subseqs ] unit-test
[ t ] [ "foo" "\\bfoo\\b" <regexp> re-contains? ] unit-test [ t ] [ "foo" "\\bfoo\\b" <regexp> re-contains? ] unit-test
[ t ] [ "afoob" "\\Bfoo\\B" <regexp> re-contains? ] unit-test [ t ] [ "afoob" "\\Bfoo\\B" <regexp> re-contains? ] unit-test

View File

@ -1,10 +1,10 @@
! 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 math sequences strings sets USING: accessors combinators kernel kernel.private math sequences
assocs prettyprint.backend prettyprint.custom make lexer sequences.private strings sets assocs prettyprint.backend
namespaces parser arrays fry locals regexp.parser splitting prettyprint.custom make lexer namespaces parser arrays fry locals
sorting regexp.ast regexp.negation regexp.compiler words regexp.parser splitting sorting regexp.ast regexp.negation
call call.private math.ranges ; regexp.compiler words call call.private math.ranges ;
IN: regexp IN: regexp
TUPLE: regexp TUPLE: regexp
@ -44,93 +44,82 @@ M: reverse-regexp end/start drop length 1- -1 swap ;
PRIVATE> PRIVATE>
: matches? ( string regexp -- ? ) : matches? ( string regexp -- ? )
[ end/start ] 2keep
[ check-string ] dip [ check-string ] dip
[ end/start ] 2keep
match-index-from match-index-from
[ swap = ] [ drop f ] if* ; [ = ] [ drop f ] if* ;
<PRIVATE <PRIVATE
TUPLE: match { i read-only } { j read-only } { seq read-only } ; :: (next-match) ( i string regexp quot: ( i string regexp -- j ) reverse? -- i start end ? )
i string regexp quot call dup [| j |
: match-slice ( i string quot -- match/f ) j i j
[ 2dup ] dip call reverse? [ swap [ 1+ ] bi@ ] when
[ swap match boa ] [ 2drop f ] if* ; inline string
] [ drop f f f f ] if ; inline
: search-range ( i string reverse? -- seq ) : search-range ( i string reverse? -- seq )
[ drop 0 [a,b] ] [ length [a,b) ] if ; inline [ drop dup 1+ -1 ] [ length 1 ] if range boa ; inline
: match>result ( match reverse? -- i start end string ) :: next-match ( i string regexp quot: ( i string regexp -- j ) reverse? -- i start end ? )
over [ f f f f
[ [ i>> ] [ j>> tuck ] [ seq>> ] tri ] dip
[ [ swap [ 1+ ] bi@ ] dip ] when
] [ 2drop f f f f ] if ; inline
:: next-match ( i string quot reverse? -- i start end string )
i string reverse? search-range i string reverse? search-range
[ string quot match-slice ] map-find drop [ [ 2drop 2drop ] dip string regexp quot reverse? (next-match) dup ] find 2drop ; inline
reverse? match>result ; inline
: do-next-match ( i string regexp -- i start end string ) : do-next-match ( i string regexp -- i start end ? )
dup next-match>> dup next-match>>
execute-unsafe( i string regexp -- i start end string ) ; execute-unsafe( i string regexp -- i start end ? ) ; inline
: next-slice ( i string regexp -- i/f slice/f ) :: (each-match) ( i string regexp quot: ( start end string -- ) -- )
do-next-match i string regexp do-next-match [| i' start end |
[ slice boa ] [ drop ] if* ; inline start end string quot call
i' string regexp quot (each-match)
] [ 3drop ] if ; inline recursive
: prepare-match-iterator ( string regexp -- i string regexp )
[ check-string ] dip [ end/start nip ] 2keep ; inline
PRIVATE> PRIVATE>
TUPLE: match-iterator : each-match ( string regexp quot: ( start end string -- ) -- )
{ string read-only } [ prepare-match-iterator ] dip (each-match) ; inline
{ regexp read-only }
{ i read-only }
{ value read-only } ;
: iterate ( iterator -- iterator'/f ) : map-matches ( string regexp quot: ( start end string -- obj ) -- seq )
dup accumulator [ each-match ] dip >array ; inline
[ i>> ] [ string>> ] [ regexp>> ] tri next-slice
[ [ [ string>> ] [ regexp>> ] bi ] 2dip match-iterator boa ]
[ 2drop f ] if* ;
: value ( iterator/f -- value/f ) : all-matching-slices ( string regexp -- seq )
dup [ value>> ] when ; [ slice boa ] map-matches ;
: <match-iterator> ( string regexp -- match-iterator ) : all-matching-subseqs ( string regexp -- seq )
[ check-string ] dip [ subseq ] map-matches ;
2dup end/start nip f
match-iterator boa
iterate ; inline
: all-matches ( string regexp -- seq )
<match-iterator> [ iterate ] follow [ value ] map ;
: count-matches ( string regexp -- n ) : count-matches ( string regexp -- n )
all-matches length ; [ 0 ] 2dip [ 3drop 1+ ] each-match ;
<PRIVATE <PRIVATE
:: split-slices ( string slices -- new-slices ) :: (re-split) ( string regexp quot -- new-slices )
slices [ to>> ] map 0 prefix 0 string regexp [| end start end' string |
slices [ from>> ] map string length suffix end' ! leave it on the stack for the next iteration
[ string <slice> ] 2map ; end start string quot call
] map-matches
! Final chunk
swap string length string quot call suffix ; inline
PRIVATE> PRIVATE>
: first-match ( string regexp -- slice/f ) : first-match ( string regexp -- slice/f )
<match-iterator> value ; [ prepare-match-iterator do-next-match ] [ drop ] 2bi
'[ _ slice boa nip ] [ 3drop f ] if ;
: re-contains? ( string regexp -- ? ) : re-contains? ( string regexp -- ? )
first-match >boolean ; prepare-match-iterator do-next-match [ 3drop ] dip >boolean ;
: re-split1 ( string regexp -- before after/f )
dupd first-match [ 1array split-slices first2 ] [ f ] if* ;
: re-split ( string regexp -- seq ) : re-split ( string regexp -- seq )
dupd all-matches split-slices ; [ slice boa ] (re-split) ;
: re-replace ( string regexp replacement -- result ) : re-replace ( string regexp replacement -- result )
[ re-split ] dip join ; [ [ subseq ] (re-split) ] dip join ;
<PRIVATE <PRIVATE
@ -162,8 +151,8 @@ DEFER: compile-next-match
: compile-next-match ( regexp -- regexp ) : compile-next-match ( regexp -- regexp )
dup '[ dup '[
dup \ next-initial-word = [ dup \ next-initial-word = [
drop _ [ compile-regexp dfa>> ] [ reverse-regexp? ] bi drop _ [ compile-regexp dfa>> def>> ] [ reverse-regexp? ] bi
'[ _ '[ _ _ execute ] _ next-match ] '[ { array-capacity string regexp } declare _ _ next-match ]
(( i string regexp -- i start end string )) simple-define-temp (( i string regexp -- i start end string )) simple-define-temp
] when ] when
] change-next-match ; ] change-next-match ;

View File

@ -2,7 +2,7 @@ USING: alien ui.gadgets.panes ui.gadgets namespaces
kernel sequences io io.styles io.streams.string tools.test kernel sequences io io.styles io.streams.string tools.test
prettyprint definitions help help.syntax help.markup prettyprint definitions help help.syntax help.markup
help.stylesheet splitting tools.test.ui models math summary help.stylesheet splitting tools.test.ui models math summary
inspector accessors help.topics ; inspector accessors help.topics see ;
IN: ui.gadgets.panes.tests IN: ui.gadgets.panes.tests
: #children "pane" get children>> length ; : #children "pane" get children>> length ;

View File

@ -1,4 +1,4 @@
USING: kernel classes.singleton tools.test prettyprint io.streams.string ; USING: kernel classes.singleton tools.test prettyprint io.streams.string see ;
IN: classes.singleton.tests IN: classes.singleton.tests
[ ] [ SINGLETON: bzzt ] unit-test [ ] [ SINGLETON: bzzt ] unit-test

View File

@ -4,7 +4,7 @@ namespaces quotations sequences.private classes continuations
generic.standard effects classes.tuple classes.tuple.private generic.standard effects classes.tuple classes.tuple.private
arrays vectors strings compiler.units accessors classes.algebra arrays vectors strings compiler.units accessors classes.algebra
calendar prettyprint io.streams.string splitting summary calendar prettyprint io.streams.string splitting summary
columns math.order classes.private slots slots.private eval ; columns math.order classes.private slots slots.private eval see ;
IN: classes.tuple.tests IN: classes.tuple.tests
TUPLE: rect x y w h ; TUPLE: rect x y w h ;

View File

@ -4,7 +4,7 @@ tools.test vectors words quotations classes
classes.private classes.union classes.mixin classes.predicate classes.private classes.union classes.mixin classes.predicate
classes.algebra vectors definitions source-files classes.algebra vectors definitions source-files
compiler.units kernel.private sorting vocabs io.streams.string compiler.units kernel.private sorting vocabs io.streams.string
eval ; eval see ;
IN: classes.union.tests IN: classes.union.tests
! DEFER: bah ! DEFER: bah

View File

@ -5,7 +5,7 @@ specialized-arrays.double byte-arrays bit-arrays parser
namespaces make quotations stack-checker vectors growable namespaces make quotations stack-checker vectors growable
hashtables sbufs prettyprint byte-vectors bit-vectors hashtables sbufs prettyprint byte-vectors bit-vectors
specialized-vectors.double definitions generic sets graphs assocs specialized-vectors.double definitions generic sets graphs assocs
grouping ; grouping see ;
GENERIC: lo-tag-test ( obj -- obj' ) GENERIC: lo-tag-test ( obj -- obj' )

View File

@ -684,7 +684,7 @@ $nl
"This operation is efficient and does not copy the quotation." } "This operation is efficient and does not copy the quotation." }
{ $examples { $examples
{ $example "USING: kernel prettyprint ;" "5 [ . ] curry ." "[ 5 . ]" } { $example "USING: kernel prettyprint ;" "5 [ . ] curry ." "[ 5 . ]" }
{ $example "USING: kernel prettyprint ;" "\\ = [ see ] curry ." "[ \\ = see ]" } { $example "USING: kernel prettyprint see ;" "\\ = [ see ] curry ." "[ \\ = see ]" }
{ $example "USING: kernel math prettyprint sequences ;" "{ 1 2 3 } 2 [ - ] curry map ." "{ -1 0 1 }" } { $example "USING: kernel math prettyprint sequences ;" "{ 1 2 3 } 2 [ - ] curry map ." "{ -1 0 1 }" }
} ; } ;

View File

@ -1,4 +1,4 @@
USING: descriptive kernel math tools.test continuations prettyprint io.streams.string ; USING: descriptive kernel math tools.test continuations prettyprint io.streams.string see ;
IN: descriptive.tests IN: descriptive.tests
DESCRIPTIVE: divide ( num denom -- fraction ) / ; DESCRIPTIVE: divide ( num denom -- fraction ) / ;

View File

@ -1,7 +1,7 @@
IN: multi-methods.tests IN: multi-methods.tests
USING: multi-methods tools.test math sequences namespaces system USING: multi-methods tools.test math sequences namespaces system
kernel strings definitions prettyprint debugger arrays kernel strings definitions prettyprint debugger arrays
hashtables continuations classes assocs accessors ; hashtables continuations classes assocs accessors see ;
GENERIC: first-test GENERIC: first-test