diff --git a/basis/multiline/multiline-docs.factor b/basis/multiline/multiline-docs.factor index 4782571d4a..1b7ca3fdaa 100644 --- a/basis/multiline/multiline-docs.factor +++ b/basis/multiline/multiline-docs.factor @@ -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:" diff --git a/basis/multiline/multiline-tests.factor b/basis/multiline/multiline-tests.factor index 153b6cedbe..2458589d27 100644 --- a/basis/multiline/multiline-tests.factor +++ b/basis/multiline/multiline-tests.factor @@ -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 + diff --git a/basis/multiline/multiline.factor b/basis/multiline/multiline.factor index c0d109e3c5..e4334f1201 100644 --- a/basis/multiline/multiline.factor +++ b/basis/multiline/multiline.factor @@ -27,7 +27,7 @@ SYNTAX: STRING: > :> 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 ; diff --git a/basis/sorting/functor/functor.factor b/basis/sorting/functor/functor.factor index 7f46af4c92..8e9ea6a9ea 100644 --- a/basis/sorting/functor/functor.factor +++ b/basis/sorting/functor/functor.factor @@ -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 diff --git a/unmaintained/multi-methods/authors.txt b/extra/multi-methods/authors.txt similarity index 100% rename from unmaintained/multi-methods/authors.txt rename to extra/multi-methods/authors.txt diff --git a/unmaintained/multi-methods/multi-methods.factor b/extra/multi-methods/multi-methods.factor similarity index 98% rename from unmaintained/multi-methods/multi-methods.factor rename to extra/multi-methods/multi-methods.factor index 17f0de120e..d3e1d443aa 100755 --- a/unmaintained/multi-methods/multi-methods.factor +++ b/extra/multi-methods/multi-methods.factor @@ -21,7 +21,7 @@ SYMBOL: total : canonicalize-specializer-1 ( specializer -- specializer' ) [ [ class? ] filter - [ length [ 1+ neg ] map ] keep zip + [ length [ 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 ) diff --git a/unmaintained/multi-methods/summary.txt b/extra/multi-methods/summary.txt similarity index 100% rename from unmaintained/multi-methods/summary.txt rename to extra/multi-methods/summary.txt diff --git a/unmaintained/multi-methods/tags.txt b/extra/multi-methods/tags.txt similarity index 100% rename from unmaintained/multi-methods/tags.txt rename to extra/multi-methods/tags.txt diff --git a/unmaintained/multi-methods/tests/canonicalize.factor b/extra/multi-methods/tests/canonicalize.factor similarity index 100% rename from unmaintained/multi-methods/tests/canonicalize.factor rename to extra/multi-methods/tests/canonicalize.factor index 91982de95c..6ddd5d63ce 100644 --- a/unmaintained/multi-methods/tests/canonicalize.factor +++ b/extra/multi-methods/tests/canonicalize.factor @@ -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 diff --git a/unmaintained/multi-methods/tests/definitions.factor b/extra/multi-methods/tests/definitions.factor similarity index 95% rename from unmaintained/multi-methods/tests/definitions.factor rename to extra/multi-methods/tests/definitions.factor index aa66f41d8d..a483a492b3 100644 --- a/unmaintained/multi-methods/tests/definitions.factor +++ b/extra/multi-methods/tests/definitions.factor @@ -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 diff --git a/unmaintained/multi-methods/tests/legacy.factor b/extra/multi-methods/tests/legacy.factor similarity index 100% rename from unmaintained/multi-methods/tests/legacy.factor rename to extra/multi-methods/tests/legacy.factor index b6d732643f..28bfa286b9 100644 --- a/unmaintained/multi-methods/tests/legacy.factor +++ b/extra/multi-methods/tests/legacy.factor @@ -1,5 +1,5 @@ -IN: multi-methods.tests USING: math strings sequences tools.test ; +IN: multi-methods.tests GENERIC: legacy-test ( a -- b ) diff --git a/unmaintained/multi-methods/tests/syntax.factor b/extra/multi-methods/tests/syntax.factor similarity index 76% rename from unmaintained/multi-methods/tests/syntax.factor rename to extra/multi-methods/tests/syntax.factor index cc073099d8..afe6037adc 100644 --- a/unmaintained/multi-methods/tests/syntax.factor +++ b/extra/multi-methods/tests/syntax.factor @@ -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 } ; diff --git a/unmaintained/multi-methods/tests/topological-sort.factor b/extra/multi-methods/tests/topological-sort.factor similarity index 100% rename from unmaintained/multi-methods/tests/topological-sort.factor rename to extra/multi-methods/tests/topological-sort.factor