Merge branch 'master' of git://factorcode.org/git/factor
commit
630ffb8ae6
|
@ -18,6 +18,16 @@ HELP: /*
|
|||
""
|
||||
} ;
|
||||
|
||||
HELP: HEREDOC:
|
||||
{ $syntax "HEREDOC: marker\n...text...marker" }
|
||||
{ $values { "marker" "a word (token)" } { "text" "arbitrary text" } { "" "a string" } }
|
||||
{ $description "A multiline string syntax with a user-specified terminating delimiter. HEREDOC: reads the next word, and uses it as the 'close quote'. All input from the beginning of the HEREDOC:'s next line, until the first appearance of the word's name, becomes a string. The terminating word does not need to be at the beginning of a line.\n\nThe HEREDOC: line should not have anything after the delimiting word. The delimiting word should be an alphanumeric token. It should not be, as in some other languages, a \"quoted string\"." }
|
||||
{ $examples
|
||||
{ $example "USING: heredoc ;" "HEREDOC: END\nx\nEND" "! \"x\\n\"" }
|
||||
{ $example "HEREDOC: END\nxEND" "! \"x\"" }
|
||||
{ $example "2 5 HEREDOC: zap\nfoo\nbarzap subseq" "! \"o\\nb\"" }
|
||||
} ;
|
||||
|
||||
{ POSTPONE: <" POSTPONE: STRING: } related-words
|
||||
|
||||
HELP: parse-multiline-string
|
||||
|
@ -29,6 +39,7 @@ ARTICLE: "multiline" "Multiline"
|
|||
"Multiline strings:"
|
||||
{ $subsection POSTPONE: STRING: }
|
||||
{ $subsection POSTPONE: <" }
|
||||
{ $subsection POSTPONE: HEREDOC: }
|
||||
"Multiline comments:"
|
||||
{ $subsection POSTPONE: /* }
|
||||
"Writing new multiline parsing words:"
|
||||
|
|
|
@ -19,3 +19,43 @@ world"> ] unit-test
|
|||
|
||||
[ "\nhi" ] [ <"
|
||||
hi"> ] unit-test
|
||||
|
||||
|
||||
! HEREDOC:
|
||||
|
||||
[ "foo\nbar\n" ] [ HEREDOC: END
|
||||
foo
|
||||
bar
|
||||
END ] unit-test
|
||||
|
||||
[ "foo\nbar" ] [ HEREDOC: END
|
||||
foo
|
||||
barEND ] unit-test
|
||||
|
||||
[ "" ] [ HEREDOC: END
|
||||
END ] unit-test
|
||||
|
||||
[ " " ] [ HEREDOC: END
|
||||
END ] unit-test
|
||||
|
||||
[ "\n" ] [ HEREDOC: END
|
||||
|
||||
END ] unit-test
|
||||
|
||||
[ "x" ] [ HEREDOC: END
|
||||
xEND ] unit-test
|
||||
|
||||
[ "xyz " ] [ HEREDOC: END
|
||||
xyz END ] unit-test
|
||||
|
||||
[ "} ! * # \" «\n" ] [ HEREDOC: END
|
||||
} ! * # " «
|
||||
END ] unit-test
|
||||
|
||||
[ 21 "foo\nbar" " HEREDOC: FOO\n FOO\n" 22 ] [ 21 HEREDOC: X
|
||||
foo
|
||||
barX HEREDOC: END ! mumble
|
||||
HEREDOC: FOO
|
||||
FOO
|
||||
END 22 ] unit-test
|
||||
|
||||
|
|
|
@ -27,7 +27,7 @@ SYNTAX: STRING:
|
|||
|
||||
<PRIVATE
|
||||
|
||||
:: (parse-multiline-string) ( i end -- j )
|
||||
:: (scan-multiline-string) ( i end -- j )
|
||||
lexer get line-text>> :> text
|
||||
text [
|
||||
end text i start* [| j |
|
||||
|
@ -35,18 +35,21 @@ SYNTAX: STRING:
|
|||
] [
|
||||
text i short tail % CHAR: \n ,
|
||||
lexer get next-line
|
||||
0 end (parse-multiline-string)
|
||||
0 end (scan-multiline-string)
|
||||
] if*
|
||||
] [ end unexpected-eof ] if ;
|
||||
|
||||
:: (parse-multiline-string) ( end-text skip-n-chars -- str )
|
||||
[
|
||||
lexer get
|
||||
[ skip-n-chars + end-text (scan-multiline-string) ]
|
||||
change-column drop
|
||||
] "" make ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: parse-multiline-string ( end-text -- str )
|
||||
[
|
||||
lexer get
|
||||
[ 1 + swap (parse-multiline-string) ]
|
||||
change-column drop
|
||||
] "" make ;
|
||||
1 (parse-multiline-string) ;
|
||||
|
||||
SYNTAX: <"
|
||||
"\">" parse-multiline-string parsed ;
|
||||
|
@ -61,3 +64,9 @@ SYNTAX: {"
|
|||
"\"}" parse-multiline-string parsed ;
|
||||
|
||||
SYNTAX: /* "*/" parse-multiline-string drop ;
|
||||
|
||||
SYNTAX: HEREDOC:
|
||||
scan
|
||||
lexer get next-line
|
||||
0 (parse-multiline-string)
|
||||
parsed ;
|
||||
|
|
|
@ -10,7 +10,7 @@ NAME>=< DEFINES ${NAME}>=<
|
|||
|
||||
WHERE
|
||||
|
||||
: NAME<=> ( obj1 obj2 -- <=> ) QUOT bi@ <=> ;
|
||||
: NAME<=> ( obj1 obj2 -- <=> ) QUOT compare ;
|
||||
: NAME>=< ( obj1 obj2 -- >=< ) NAME<=> invert-comparison ;
|
||||
|
||||
;FUNCTOR
|
||||
|
|
|
@ -21,7 +21,7 @@ SYMBOL: total
|
|||
: canonicalize-specializer-1 ( specializer -- specializer' )
|
||||
[
|
||||
[ class? ] filter
|
||||
[ length <reversed> [ 1+ neg ] map ] keep zip
|
||||
[ length <reversed> [ 1 + neg ] map ] keep zip
|
||||
[ length args [ max ] change ] keep
|
||||
]
|
||||
[
|
||||
|
@ -104,7 +104,7 @@ SYMBOL: total
|
|||
{ 0 [ [ dup ] ] }
|
||||
{ 1 [ [ over ] ] }
|
||||
{ 2 [ [ pick ] ] }
|
||||
[ 1- picker [ dip swap ] curry ]
|
||||
[ 1 - picker [ dip swap ] curry ]
|
||||
} case ;
|
||||
|
||||
: (multi-predicate) ( class picker -- quot )
|
|
@ -1,6 +1,6 @@
|
|||
IN: multi-methods.tests
|
||||
USING: multi-methods tools.test math sequences namespaces system
|
||||
kernel strings ;
|
||||
IN: multi-methods.tests
|
||||
|
||||
[ { POSTPONE: f integer } ] [ { f integer } canonicalize-specializer-0 ] unit-test
|
||||
|
|
@ -1,9 +1,10 @@
|
|||
IN: multi-methods.tests
|
||||
USING: multi-methods tools.test math sequences namespaces system
|
||||
kernel strings words compiler.units quotations ;
|
||||
IN: multi-methods.tests
|
||||
|
||||
DEFER: fake
|
||||
\ fake H{ } clone "multi-methods" set-word-prop
|
||||
<< (( -- )) \ fake set-stack-effect >>
|
||||
|
||||
[ "fake-{ }" ] [ { } \ fake method-word-name ] unit-test
|
||||
|
|
@ -1,5 +1,5 @@
|
|||
IN: multi-methods.tests
|
||||
USING: math strings sequences tools.test ;
|
||||
IN: multi-methods.tests
|
||||
|
||||
GENERIC: legacy-test ( a -- b )
|
||||
|
|
@ -1,9 +1,10 @@
|
|||
IN: multi-methods.tests
|
||||
USING: multi-methods tools.test math sequences namespaces system
|
||||
kernel strings definitions prettyprint debugger arrays
|
||||
hashtables continuations classes assocs accessors see ;
|
||||
RENAME: GENERIC: multi-methods => multi-methods:GENERIC:
|
||||
IN: multi-methods.tests
|
||||
|
||||
GENERIC: first-test ( -- )
|
||||
multi-methods:GENERIC: first-test ( -- )
|
||||
|
||||
[ t ] [ \ first-test generic? ] unit-test
|
||||
|
||||
|
@ -13,14 +14,14 @@ SINGLETON: paper INSTANCE: paper thing
|
|||
SINGLETON: scissors INSTANCE: scissors thing
|
||||
SINGLETON: rock INSTANCE: rock thing
|
||||
|
||||
GENERIC: beats? ( obj1 obj2 -- ? )
|
||||
multi-methods:GENERIC: beats? ( obj1 obj2 -- ? )
|
||||
|
||||
METHOD: beats? { paper scissors } t ;
|
||||
METHOD: beats? { scissors rock } t ;
|
||||
METHOD: beats? { rock paper } t ;
|
||||
METHOD: beats? { thing thing } f ;
|
||||
METHOD: beats? { paper scissors } 2drop t ;
|
||||
METHOD: beats? { scissors rock } 2drop t ;
|
||||
METHOD: beats? { rock paper } 2drop t ;
|
||||
METHOD: beats? { thing thing } 2drop f ;
|
||||
|
||||
: play ( obj1 obj2 -- ? ) beats? 2nip ;
|
||||
: play ( obj1 obj2 -- ? ) beats? ;
|
||||
|
||||
[ { } 3 play ] must-fail
|
||||
[ t ] [ error get no-method? ] unit-test
|
||||
|
@ -34,7 +35,7 @@ METHOD: beats? { thing thing } f ;
|
|||
|
||||
SYMBOL: some-var
|
||||
|
||||
GENERIC: hook-test ( -- obj )
|
||||
multi-methods:GENERIC: hook-test ( obj -- obj )
|
||||
|
||||
METHOD: hook-test { array { some-var array } } reverse ;
|
||||
METHOD: hook-test { { some-var array } } class ;
|
||||
|
@ -57,7 +58,7 @@ TUPLE: busted-1 ;
|
|||
TUPLE: busted-2 ; INSTANCE: busted-2 busted
|
||||
TUPLE: busted-3 ;
|
||||
|
||||
GENERIC: busted-sort ( obj1 obj2 -- obj1 obj2 )
|
||||
multi-methods:GENERIC: busted-sort ( obj1 obj2 -- obj1 obj2 )
|
||||
|
||||
METHOD: busted-sort { busted-1 busted-2 } ;
|
||||
METHOD: busted-sort { busted-2 busted-3 } ;
|
Loading…
Reference in New Issue