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
{
}
}
} [
- "digit = '1' | '2'" 'rule' parse ast>>
+ "digit = '1' | '2'" 'rule' parse
] unit-test
{
}
}
} [
- "digit = '1' '2'" 'rule' parse ast>>
+ "digit = '1' '2'" 'rule' parse
] unit-test
{
}
}
} [
- "one two | three" 'choice' parse ast>>
+ "one two | three" 'choice' parse
] unit-test
{
}
}
} [
- "one {two | three}" 'choice' parse ast>>
+ "one {two | three}" 'choice' parse
] unit-test
{
}
}
} [
- "one ((two | three) four)*" 'choice' parse ast>>
+ "one ((two | three) four)*" 'choice' parse
] unit-test
{
}
}
} [
- "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" } } [
] 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
] 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
<<
{ 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
] [ ] make box ;\r
\r
: transform-ebnf ( string -- object )\r
- 'ebnf' parse parse-result-ast transform ;\r
+ 'ebnf' parse transform ;\r
\r
: check-parse-result ( result -- result )\r
dup [\r
] if ;\r
\r
: parse-ebnf ( string -- hashtable )\r
- 'ebnf' parse check-parse-result ast>> transform ;\r
+ 'ebnf' (parse) check-parse-result ast>> transform ;\r
\r
: ebnf>quot ( string -- hashtable quot )\r
parse-ebnf dup dup parser [ main swap at compile ] with-variable\r
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
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 ;
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 ;
PRIVATE>
-MEMO: exactly-n ( parser n -- parser' )
+: exactly-n ( parser n -- parser' )
swap <repetition> seq ;
-MEMO: at-most-n ( parser n -- parser' )
+: at-most-n ( parser n -- parser' )
dup zero? [
2drop epsilon
] [
-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' )
] must-fail
{ "begin" "end" } [
- "beginend" "begin" token parse
+ "beginend" "begin" token (parse)
{ ast>> remaining>> } get-slots
>string
] unit-test
] 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
[
] 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
[
] 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
[
] 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
[
] 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
[
] 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
[
] 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
[
[ "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 )
[ 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 } [
] must-fail
{ CHAR: B } [
- "B" [ drop t ] satisfy [ 66 >= ] semantic parse ast>>
+ "B" [ drop t ] satisfy [ 66 >= ] semantic parse
] unit-test
: 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>> ;
+
<PRIVATE
SYMBOL: id
IN: peg.pl0.tests
{ t } [
- "CONST foo = 1;" "block" \ pl0 rule parse remaining>> 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 } [
! 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 -- )
[ 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 ;
projects / factor.git / commitdiff