diff --git a/extra/peg/ebnf/ebnf-tests.factor b/extra/peg/ebnf/ebnf-tests.factor index ba34248159..ef90929b79 100644 --- a/extra/peg/ebnf/ebnf-tests.factor +++ b/extra/peg/ebnf/ebnf-tests.factor @@ -7,11 +7,11 @@ USING: kernel tools.test peg peg.ebnf words math math.parser IN: peg.ebnf.tests { T{ ebnf-non-terminal f "abc" } } [ - "abc" 'non-terminal' parse ast>> + "abc" 'non-terminal' parse ] unit-test { T{ ebnf-terminal f "55" } } [ - "'55'" 'terminal' parse ast>> + "'55'" 'terminal' parse ] unit-test { @@ -22,7 +22,7 @@ IN: peg.ebnf.tests } } } [ - "digit = '1' | '2'" 'rule' parse ast>> + "digit = '1' | '2'" 'rule' parse ] unit-test { @@ -33,7 +33,7 @@ IN: peg.ebnf.tests } } } [ - "digit = '1' '2'" 'rule' parse ast>> + "digit = '1' '2'" 'rule' parse ] unit-test { @@ -46,7 +46,7 @@ IN: peg.ebnf.tests } } } [ - "one two | three" 'choice' parse ast>> + "one two | three" 'choice' parse ] unit-test { @@ -61,7 +61,7 @@ IN: peg.ebnf.tests } } } [ - "one {two | three}" 'choice' parse ast>> + "one {two | three}" 'choice' parse ] unit-test { @@ -81,7 +81,7 @@ IN: peg.ebnf.tests } } } [ - "one ((two | three) four)*" 'choice' parse ast>> + "one ((two | three) four)*" 'choice' parse ] unit-test { @@ -93,23 +93,23 @@ IN: peg.ebnf.tests } } } [ - "one ( two )? three" 'choice' parse ast>> + "one ( two )? three" 'choice' parse ] unit-test { "foo" } [ - "\"foo\"" 'identifier' parse ast>> + "\"foo\"" 'identifier' parse ] unit-test { "foo" } [ - "'foo'" 'identifier' parse ast>> + "'foo'" 'identifier' parse ] unit-test { "foo" } [ - "foo" 'non-terminal' parse ast>> ebnf-non-terminal-symbol + "foo" 'non-terminal' parse ebnf-non-terminal-symbol ] unit-test { "foo" } [ - "foo]" 'non-terminal' parse ast>> ebnf-non-terminal-symbol + "foo]" 'non-terminal' parse ebnf-non-terminal-symbol ] unit-test { V{ "a" "b" } } [ @@ -252,7 +252,7 @@ IN: peg.ebnf.tests ] unit-test { t } [ - "abcd='9' | ('8'):x => [[ x ]]" 'ebnf' parse parse-result-remaining empty? + "abcd='9' | ('8'):x => [[ x ]]" 'ebnf' (parse) remaining>> empty? ] unit-test EBNF: primary @@ -385,29 +385,29 @@ main = Primary ] unit-test { t } [ - "number=(digit)+:n 'a'" 'ebnf' parse remaining>> length zero? + "number=(digit)+:n 'a'" 'ebnf' (parse) remaining>> length zero? ] unit-test { t } [ - "number=(digit)+ 'a'" 'ebnf' parse remaining>> length zero? + "number=(digit)+ 'a'" 'ebnf' (parse) remaining>> length zero? ] unit-test { t } [ - "number=digit+ 'a'" 'ebnf' parse remaining>> length zero? + "number=digit+ 'a'" 'ebnf' (parse) remaining>> length zero? ] unit-test { t } [ - "number=digit+:n 'a'" 'ebnf' parse remaining>> length zero? + "number=digit+:n 'a'" 'ebnf' (parse) remaining>> length zero? ] unit-test { t } [ - "foo=(name):n !(keyword) => [[ n ]]" 'rule' parse ast>> - "foo=name:n !(keyword) => [[ n ]]" 'rule' parse ast>> = + "foo=(name):n !(keyword) => [[ n ]]" 'rule' parse + "foo=name:n !(keyword) => [[ n ]]" 'rule' parse = ] unit-test { t } [ - "foo=!(keyword) (name):n => [[ n ]]" 'rule' parse ast>> - "foo=!(keyword) name:n => [[ n ]]" 'rule' parse ast>> = + "foo=!(keyword) (name):n => [[ n ]]" 'rule' parse + "foo=!(keyword) name:n => [[ n ]]" 'rule' parse = ] unit-test << @@ -455,7 +455,7 @@ foo= 'd' { t } [ #! Rule lookup occurs in a namespace. This causes an incorrect duplicate rule #! if a var in a namespace is set. This unit test is to remind me to fix this. - [ "fail" "foo" set "foo='a'" 'ebnf' parse ast>> transform drop t ] with-scope + [ "fail" "foo" set "foo='a'" 'ebnf' parse transform drop t ] with-scope ] unit-test #! Tokenizer tests diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor index ff4bd2db61..2a57015fa6 100644 --- a/extra/peg/ebnf/ebnf.factor +++ b/extra/peg/ebnf/ebnf.factor @@ -504,7 +504,7 @@ M: ebnf-non-terminal (transform) ( ast -- parser ) ] [ ] make box ; : transform-ebnf ( string -- object ) - 'ebnf' parse parse-result-ast transform ; + 'ebnf' parse transform ; : check-parse-result ( result -- result ) dup [ @@ -519,7 +519,7 @@ M: ebnf-non-terminal (transform) ( ast -- parser ) ] if ; : parse-ebnf ( string -- hashtable ) - 'ebnf' parse check-parse-result ast>> transform ; + 'ebnf' (parse) check-parse-result ast>> transform ; : ebnf>quot ( string -- hashtable quot ) parse-ebnf dup dup parser [ main swap at compile ] with-variable diff --git a/extra/peg/parsers/parsers-tests.factor b/extra/peg/parsers/parsers-tests.factor index 0cf3ad8b17..20d19c9a64 100644 --- a/extra/peg/parsers/parsers-tests.factor +++ b/extra/peg/parsers/parsers-tests.factor @@ -2,50 +2,50 @@ USING: kernel peg peg.parsers tools.test accessors ; IN: peg.parsers.tests { V{ "a" } } -[ "a" "a" token "," token list-of parse ast>> ] unit-test +[ "a" "a" token "," token list-of parse ] unit-test { V{ "a" "a" "a" "a" } } -[ "a,a,a,a" "a" token "," token list-of parse ast>> ] unit-test +[ "a,a,a,a" "a" token "," token list-of parse ] unit-test [ "a" "a" token "," token list-of-many parse ] must-fail { V{ "a" "a" "a" "a" } } -[ "a,a,a,a" "a" token "," token list-of-many parse ast>> ] unit-test +[ "a,a,a,a" "a" token "," token list-of-many parse ] unit-test [ "aaa" "a" token 4 exactly-n parse ] must-fail { V{ "a" "a" "a" "a" } } -[ "aaaa" "a" token 4 exactly-n parse ast>> ] unit-test +[ "aaaa" "a" token 4 exactly-n parse ] unit-test [ "aaa" "a" token 4 at-least-n parse ] must-fail { V{ "a" "a" "a" "a" } } -[ "aaaa" "a" token 4 at-least-n parse ast>> ] unit-test +[ "aaaa" "a" token 4 at-least-n parse ] unit-test { V{ "a" "a" "a" "a" "a" } } -[ "aaaaa" "a" token 4 at-least-n parse ast>> ] unit-test +[ "aaaaa" "a" token 4 at-least-n parse ] unit-test { V{ "a" "a" "a" "a" } } -[ "aaaa" "a" token 4 at-most-n parse ast>> ] unit-test +[ "aaaa" "a" token 4 at-most-n parse ] unit-test { V{ "a" "a" "a" "a" } } -[ "aaaaa" "a" token 4 at-most-n parse ast>> ] unit-test +[ "aaaaa" "a" token 4 at-most-n parse ] unit-test { V{ "a" "a" "a" } } -[ "aaa" "a" token 3 4 from-m-to-n parse ast>> ] unit-test +[ "aaa" "a" token 3 4 from-m-to-n parse ] unit-test { V{ "a" "a" "a" "a" } } -[ "aaaa" "a" token 3 4 from-m-to-n parse ast>> ] unit-test +[ "aaaa" "a" token 3 4 from-m-to-n parse ] unit-test { V{ "a" "a" "a" "a" } } -[ "aaaaa" "a" token 3 4 from-m-to-n parse ast>> ] unit-test +[ "aaaaa" "a" token 3 4 from-m-to-n parse ] unit-test { 97 } -[ "a" any-char parse ast>> ] unit-test +[ "a" any-char parse ] unit-test { V{ } } -[ "" epsilon parse ast>> ] unit-test +[ "" epsilon parse ] unit-test { "a" } [ - "a" "a" token just parse ast>> + "a" "a" token just parse ] unit-test \ No newline at end of file diff --git a/extra/peg/parsers/parsers.factor b/extra/peg/parsers/parsers.factor index da44c12e8f..351e3b5fc1 100755 --- a/extra/peg/parsers/parsers.factor +++ b/extra/peg/parsers/parsers.factor @@ -3,7 +3,7 @@ USING: kernel sequences strings namespaces math assocs shuffle vectors arrays math.parser unicode.categories sequences.deep peg peg.private - peg.search math.ranges words memoize ; + peg.search math.ranges words ; IN: peg.parsers TUPLE: just-parser p1 ; @@ -19,7 +19,7 @@ TUPLE: just-parser p1 ; M: just-parser (compile) ( parser -- quot ) just-parser-p1 compiled-parser just-pattern curry ; -MEMO: just ( parser -- parser ) +: just ( parser -- parser ) just-parser boa init-parser ; : 1token ( ch -- parser ) 1string token ; @@ -45,10 +45,10 @@ MEMO: just ( parser -- parser ) PRIVATE> -MEMO: exactly-n ( parser n -- parser' ) +: exactly-n ( parser n -- parser' ) swap seq ; -MEMO: at-most-n ( parser n -- parser' ) +: at-most-n ( parser n -- parser' ) dup zero? [ 2drop epsilon ] [ @@ -56,15 +56,15 @@ MEMO: at-most-n ( parser n -- parser' ) -rot 1- at-most-n 2choice ] if ; -MEMO: at-least-n ( parser n -- parser' ) +: at-least-n ( parser n -- parser' ) dupd exactly-n swap repeat0 2seq [ flatten-vectors ] action ; -MEMO: from-m-to-n ( parser m n -- parser' ) +: from-m-to-n ( parser m n -- parser' ) >r [ exactly-n ] 2keep r> swap - at-most-n 2seq [ flatten-vectors ] action ; -MEMO: pack ( begin body end -- parser ) +: pack ( begin body end -- parser ) >r >r hide r> r> hide 3seq [ first ] action ; : surrounded-by ( parser begin end -- parser' ) diff --git a/extra/peg/peg-tests.factor b/extra/peg/peg-tests.factor index 466da83b6e..f9e4a0d4a6 100644 --- a/extra/peg/peg-tests.factor +++ b/extra/peg/peg-tests.factor @@ -10,7 +10,7 @@ IN: peg.tests ] must-fail { "begin" "end" } [ - "beginend" "begin" token parse + "beginend" "begin" token (parse) { ast>> remaining>> } get-slots >string ] unit-test @@ -24,11 +24,11 @@ IN: peg.tests ] must-fail { CHAR: a } [ - "abcd" CHAR: a CHAR: z range parse ast>> + "abcd" CHAR: a CHAR: z range parse ] unit-test { CHAR: z } [ - "zbcd" CHAR: a CHAR: z range parse ast>> + "zbcd" CHAR: a CHAR: z range parse ] unit-test [ @@ -36,15 +36,15 @@ IN: peg.tests ] must-fail { V{ "g" "o" } } [ - "good" "g" token "o" token 2array seq parse ast>> + "good" "g" token "o" token 2array seq parse ] unit-test { "a" } [ - "abcd" "a" token "b" token 2array choice parse ast>> + "abcd" "a" token "b" token 2array choice parse ] unit-test { "b" } [ - "bbcd" "a" token "b" token 2array choice parse ast>> + "bbcd" "a" token "b" token 2array choice parse ] unit-test [ @@ -56,15 +56,15 @@ IN: peg.tests ] must-fail { 0 } [ - "" "a" token repeat0 parse ast>> length + "" "a" token repeat0 parse length ] unit-test { 0 } [ - "b" "a" token repeat0 parse ast>> length + "b" "a" token repeat0 parse length ] unit-test { V{ "a" "a" "a" } } [ - "aaab" "a" token repeat0 parse ast>> + "aaab" "a" token repeat0 parse ] unit-test [ @@ -76,15 +76,15 @@ IN: peg.tests ] must-fail { V{ "a" "a" "a" } } [ - "aaab" "a" token repeat1 parse ast>> + "aaab" "a" token repeat1 parse ] unit-test { V{ "a" "b" } } [ - "ab" "a" token optional "b" token 2array seq parse ast>> + "ab" "a" token optional "b" token 2array seq parse ] unit-test { V{ f "b" } } [ - "b" "a" token optional "b" token 2array seq parse ast>> + "b" "a" token optional "b" token 2array seq parse ] unit-test [ @@ -92,7 +92,7 @@ IN: peg.tests ] must-fail { V{ CHAR: a CHAR: b } } [ - "ab" "a" token ensure CHAR: a CHAR: z range dup 3array seq parse ast>> + "ab" "a" token ensure CHAR: a CHAR: z range dup 3array seq parse ] unit-test [ @@ -124,11 +124,11 @@ IN: peg.tests ] must-fail { 1 } [ - "a" "a" token [ drop 1 ] action parse ast>> + "a" "a" token [ drop 1 ] action parse ] unit-test { V{ 1 1 } } [ - "aa" "a" token [ drop 1 ] action dup 2array seq parse ast>> + "aa" "a" token [ drop 1 ] action dup 2array seq parse ] unit-test [ @@ -140,19 +140,19 @@ IN: peg.tests ] must-fail { CHAR: a } [ - "a" [ CHAR: a = ] satisfy parse ast>> + "a" [ CHAR: a = ] satisfy parse ] unit-test { "a" } [ - " a" "a" token sp parse ast>> + " a" "a" token sp parse ] unit-test { "a" } [ - "a" "a" token sp parse ast>> + "a" "a" token sp parse ] unit-test { V{ "a" } } [ - "[a]" "[" token hide "a" token "]" token hide 3array seq parse ast>> + "[a]" "[" token hide "a" token "]" token hide 3array seq parse ] unit-test [ @@ -165,8 +165,8 @@ IN: peg.tests [ "1" token , "-" token , "1" token , ] seq* , [ "1" token , "+" token , "1" token , ] seq* , ] choice* - "1-1" over parse ast>> swap - "1+1" swap parse ast>> + "1-1" over parse swap + "1+1" swap parse ] unit-test : expr ( -- parser ) @@ -175,7 +175,7 @@ IN: peg.tests [ expr ] delay "+" token "1" token 3seq "1" token 2choice ; { V{ V{ "1" "+" "1" } "+" "1" } } [ - "1+1+1" expr parse ast>> + "1+1+1" expr parse ] unit-test { t } [ @@ -190,6 +190,6 @@ IN: peg.tests ] must-fail { CHAR: B } [ - "B" [ drop t ] satisfy [ 66 >= ] semantic parse ast>> + "B" [ drop t ] satisfy [ 66 >= ] semantic parse ] unit-test diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index d388bbd124..0847c57299 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -286,9 +286,12 @@ SYMBOL: delayed : compiled-parse ( state word -- result ) swap [ execute [ error-stack get first throw ] unless* ] with-packrat ; inline -: parse ( input parser -- result ) +: (parse) ( input parser -- result ) dup word? [ compile ] unless compiled-parse ; +: parse ( input parser -- ast ) + (parse) ast>> ; + > empty? + "CONST foo = 1;" "block" \ pl0 rule (parse) remaining>> empty? ] unit-test { t } [ - "VAR foo;" "block" \ pl0 rule parse remaining>> empty? + "VAR foo;" "block" \ pl0 rule (parse) remaining>> empty? ] unit-test { t } [ - "VAR foo,bar , baz;" "block" \ pl0 rule parse remaining>> empty? + "VAR foo,bar , baz;" "block" \ pl0 rule (parse) remaining>> empty? ] unit-test { t } [ - "foo := 5" "statement" \ pl0 rule parse remaining>> empty? + "foo := 5" "statement" \ pl0 rule (parse) remaining>> empty? ] unit-test { t } [ - "BEGIN foo := 5 END" "statement" \ pl0 rule parse remaining>> empty? + "BEGIN foo := 5 END" "statement" \ pl0 rule (parse) remaining>> empty? ] unit-test { t } [ - "IF 1=1 THEN foo := 5" "statement" \ pl0 rule parse remaining>> empty? + "IF 1=1 THEN foo := 5" "statement" \ pl0 rule (parse) remaining>> empty? ] unit-test { t } [ - "WHILE 1=1 DO foo := 5" "statement" \ pl0 rule parse remaining>> empty? + "WHILE 1=1 DO foo := 5" "statement" \ pl0 rule (parse) remaining>> empty? ] unit-test { t } [ - "WHILE ODD 1 DO foo := 5" "statement" \ pl0 rule parse remaining>> empty? + "WHILE ODD 1 DO foo := 5" "statement" \ pl0 rule (parse) remaining>> empty? ] unit-test { t } [ - "PROCEDURE square; BEGIN squ:=x*x END" "block" \ pl0 rule parse remaining>> empty? + "PROCEDURE square; BEGIN squ:=x*x END" "block" \ pl0 rule (parse) remaining>> empty? ] unit-test { t } [ diff --git a/extra/peg/search/search.factor b/extra/peg/search/search.factor index 7ab7e83d12..04e4affe39 100755 --- a/extra/peg/search/search.factor +++ b/extra/peg/search/search.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2006 Chris Double. ! See http://factorcode.org/license.txt for BSD license. USING: kernel math io io.streams.string sequences strings -combinators peg memoize arrays ; +combinators peg memoize arrays continuations ; IN: peg.search : tree-write ( object -- ) @@ -16,15 +16,12 @@ MEMO: any-char-parser ( -- parser ) [ drop t ] satisfy ; : search ( string parser -- seq ) - any-char-parser [ drop f ] action 2array choice repeat0 parse dup [ - parse-result-ast sift - ] [ - drop { } - ] if ; + any-char-parser [ drop f ] action 2array choice repeat0 + [ parse sift ] [ 3drop { } ] recover ; : (replace) ( string parser -- seq ) - any-char-parser 2array choice repeat0 parse parse-result-ast sift ; + any-char-parser 2array choice repeat0 parse sift ; : replace ( string parser -- result ) [ (replace) [ tree-write ] each ] with-string-writer ;