steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix peg tests

db4
Chris Double 2008-07-04 14:20:19 +12:00
parent 4c1fe8f0b3
commit 72bd6b4dc8
8 changed files with 85 additions and 85 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
extra/peg/ebnf/ebnf-tests.factor
View File

@ -7,11 +7,11 @@ USING: kernel tools.test peg peg.ebnf words math math.parser
IN: peg.ebnf.tests IN: peg.ebnf.tests
{ T{ ebnf-non-terminal f "abc" } } [ { T{ ebnf-non-terminal f "abc" } } [
"abc" 'non-terminal' parse ast>> "abc" 'non-terminal' parse
] unit-test ] unit-test
{ T{ ebnf-terminal f "55" } } [ { T{ ebnf-terminal f "55" } } [
"'55'" 'terminal' parse ast>> "'55'" 'terminal' parse
] unit-test ] unit-test
{ {
@ -22,7 +22,7 @@ IN: peg.ebnf.tests
} }
} }
} [ } [
"digit = '1' | '2'" 'rule' parse ast>> "digit = '1' | '2'" 'rule' parse
] unit-test ] unit-test
{ {
@ -33,7 +33,7 @@ IN: peg.ebnf.tests
} }
} }
} [ } [
"digit = '1' '2'" 'rule' parse ast>> "digit = '1' '2'" 'rule' parse
] unit-test ] unit-test
{ {
@ -46,7 +46,7 @@ IN: peg.ebnf.tests
} }
} }
} [ } [
"one two | three" 'choice' parse ast>> "one two | three" 'choice' parse
] unit-test ] unit-test
{ {
@ -61,7 +61,7 @@ IN: peg.ebnf.tests
} }
} }
} [ } [
"one {two | three}" 'choice' parse ast>> "one {two | three}" 'choice' parse
] unit-test ] 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 ] unit-test
{ {
@ -93,23 +93,23 @@ IN: peg.ebnf.tests
} }
} }
} [ } [
"one ( two )? three" 'choice' parse ast>> "one ( two )? three" 'choice' parse
] unit-test ] unit-test
{ "foo" } [ { "foo" } [
"\"foo\"" 'identifier' parse ast>> "\"foo\"" 'identifier' parse
] unit-test ] unit-test
{ "foo" } [ { "foo" } [
"'foo'" 'identifier' parse ast>> "'foo'" 'identifier' parse
] unit-test ] unit-test
{ "foo" } [ { "foo" } [
"foo" 'non-terminal' parse ast>> ebnf-non-terminal-symbol "foo" 'non-terminal' parse ebnf-non-terminal-symbol
] unit-test ] unit-test
{ "foo" } [ { "foo" } [
"foo]" 'non-terminal' parse ast>> ebnf-non-terminal-symbol "foo]" 'non-terminal' parse ebnf-non-terminal-symbol
] unit-test ] unit-test
{ V{ "a" "b" } } [ { V{ "a" "b" } } [
@ -252,7 +252,7 @@ IN: peg.ebnf.tests
] unit-test ] unit-test
{ t } [ { t } [
"abcd='9' | ('8'):x => [[ x ]]" 'ebnf' parse parse-result-remaining empty? "abcd='9' | ('8'):x => [[ x ]]" 'ebnf' (parse) remaining>> empty?
] unit-test ] unit-test
EBNF: primary EBNF: primary
@ -385,29 +385,29 @@ main = Primary
] unit-test ] unit-test
{ t } [ { t } [
"number=(digit)+:n 'a'" 'ebnf' parse remaining>> length zero? "number=(digit)+:n 'a'" 'ebnf' (parse) remaining>> length zero?
] unit-test ] unit-test
{ t } [ { t } [
"number=(digit)+ 'a'" 'ebnf' parse remaining>> length zero? "number=(digit)+ 'a'" 'ebnf' (parse) remaining>> length zero?
] unit-test ] unit-test
{ t } [ { t } [
"number=digit+ 'a'" 'ebnf' parse remaining>> length zero? "number=digit+ 'a'" 'ebnf' (parse) remaining>> length zero?
] unit-test ] unit-test
{ t } [ { t } [
"number=digit+:n 'a'" 'ebnf' parse remaining>> length zero? "number=digit+:n 'a'" 'ebnf' (parse) remaining>> length zero?
] unit-test ] unit-test
{ t } [ { t } [
"foo=(name):n !(keyword) => [[ n ]]" 'rule' parse ast>> "foo=(name):n !(keyword) => [[ n ]]" 'rule' parse
"foo=name:n !(keyword) => [[ n ]]" 'rule' parse ast>> = "foo=name:n !(keyword) => [[ n ]]" 'rule' parse =
] unit-test ] unit-test
{ t } [ { t } [
"foo=!(keyword) (name):n => [[ n ]]" 'rule' parse ast>> "foo=!(keyword) (name):n => [[ n ]]" 'rule' parse
"foo=!(keyword) name:n => [[ n ]]" 'rule' parse ast>> = "foo=!(keyword) name:n => [[ n ]]" 'rule' parse =
] unit-test ] unit-test
<< <<
@ -455,7 +455,7 @@ foo=<foreign any-char> 'd'
{ t } [ { t } [
#! Rule lookup occurs in a namespace. This causes an incorrect duplicate rule #! 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. #! 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 ] unit-test
#! Tokenizer tests #! Tokenizer tests

4
extra/peg/ebnf/ebnf.factor
View File

@ -504,7 +504,7 @@ M: ebnf-non-terminal (transform) ( ast -- parser )
] [ ] make box ; ] [ ] make box ;
: transform-ebnf ( string -- object ) : transform-ebnf ( string -- object )
'ebnf' parse parse-result-ast transform ; 'ebnf' parse transform ;
: check-parse-result ( result -- result ) : check-parse-result ( result -- result )
dup [ dup [
@ -519,7 +519,7 @@ M: ebnf-non-terminal (transform) ( ast -- parser )
] if ; ] if ;
: parse-ebnf ( string -- hashtable ) : parse-ebnf ( string -- hashtable )
'ebnf' parse check-parse-result ast>> transform ; 'ebnf' (parse) check-parse-result ast>> transform ;
: ebnf>quot ( string -- hashtable quot ) : ebnf>quot ( string -- hashtable quot )
parse-ebnf dup dup parser [ main swap at compile ] with-variable parse-ebnf dup dup parser [ main swap at compile ] with-variable

28
extra/peg/parsers/parsers-tests.factor
View File

@ -2,50 +2,50 @@ USING: kernel peg peg.parsers tools.test accessors ;
IN: peg.parsers.tests IN: peg.parsers.tests
{ V{ "a" } } { 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" } } { 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 [ "a" "a" token "," token list-of-many parse ] must-fail
{ V{ "a" "a" "a" "a" } } { 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 [ "aaa" "a" token 4 exactly-n parse ] must-fail
{ V{ "a" "a" "a" "a" } } { 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 [ "aaa" "a" token 4 at-least-n parse ] must-fail
{ V{ "a" "a" "a" "a" } } { 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" } } { 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" } } { 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" } } { 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" } } { 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" } } { 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" } } { 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 } { 97 }
[ "a" any-char parse ast>> ] unit-test [ "a" any-char parse ] unit-test
{ V{ } } { V{ } }
[ "" epsilon parse ast>> ] unit-test [ "" epsilon parse ] unit-test
{ "a" } [ { "a" } [
"a" "a" token just parse ast>> "a" "a" token just parse
] unit-test ] unit-test

14
extra/peg/parsers/parsers.factor
View File

@ -3,7 +3,7 @@
USING: kernel sequences strings namespaces math assocs shuffle USING: kernel sequences strings namespaces math assocs shuffle
vectors arrays math.parser vectors arrays math.parser
unicode.categories sequences.deep peg peg.private unicode.categories sequences.deep peg peg.private
peg.search math.ranges words memoize ; peg.search math.ranges words ;
IN: peg.parsers IN: peg.parsers
TUPLE: just-parser p1 ; TUPLE: just-parser p1 ;
@ -19,7 +19,7 @@ TUPLE: just-parser p1 ;
M: just-parser (compile) ( parser -- quot ) M: just-parser (compile) ( parser -- quot )
just-parser-p1 compiled-parser just-pattern curry ; just-parser-p1 compiled-parser just-pattern curry ;
MEMO: just ( parser -- parser ) : just ( parser -- parser )
just-parser boa init-parser ; just-parser boa init-parser ;
: 1token ( ch -- parser ) 1string token ; : 1token ( ch -- parser ) 1string token ;
@ -45,10 +45,10 @@ MEMO: just ( parser -- parser )
PRIVATE> PRIVATE>
MEMO: exactly-n ( parser n -- parser' ) : exactly-n ( parser n -- parser' )
swap <repetition> seq ; swap <repetition> seq ;
MEMO: at-most-n ( parser n -- parser' ) : at-most-n ( parser n -- parser' )
dup zero? [ dup zero? [
2drop epsilon 2drop epsilon
] [ ] [
@ -56,15 +56,15 @@ MEMO: at-most-n ( parser n -- parser' )
-rot 1- at-most-n 2choice -rot 1- at-most-n 2choice
] if ; ] if ;
MEMO: at-least-n ( parser n -- parser' ) : at-least-n ( parser n -- parser' )
dupd exactly-n swap repeat0 2seq dupd exactly-n swap repeat0 2seq
[ flatten-vectors ] action ; [ 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 >r [ exactly-n ] 2keep r> swap - at-most-n 2seq
[ flatten-vectors ] action ; [ flatten-vectors ] action ;
MEMO: pack ( begin body end -- parser ) : pack ( begin body end -- parser )
>r >r hide r> r> hide 3seq [ first ] action ; >r >r hide r> r> hide 3seq [ first ] action ;
: surrounded-by ( parser begin end -- parser' ) : surrounded-by ( parser begin end -- parser' )

46
extra/peg/peg-tests.factor
View File

@ -10,7 +10,7 @@ IN: peg.tests
] must-fail ] must-fail
{ "begin" "end" } [ { "begin" "end" } [
"beginend" "begin" token parse "beginend" "begin" token (parse)
{ ast>> remaining>> } get-slots { ast>> remaining>> } get-slots
>string >string
] unit-test ] unit-test
@ -24,11 +24,11 @@ IN: peg.tests
] must-fail ] must-fail
{ CHAR: a } [ { CHAR: a } [
"abcd" CHAR: a CHAR: z range parse ast>> "abcd" CHAR: a CHAR: z range parse
] unit-test ] unit-test
{ CHAR: z } [ { CHAR: z } [
"zbcd" CHAR: a CHAR: z range parse ast>> "zbcd" CHAR: a CHAR: z range parse
] unit-test ] unit-test
[ [
@ -36,15 +36,15 @@ IN: peg.tests
] must-fail ] must-fail
{ V{ "g" "o" } } [ { V{ "g" "o" } } [
"good" "g" token "o" token 2array seq parse ast>> "good" "g" token "o" token 2array seq parse
] unit-test ] unit-test
{ "a" } [ { "a" } [
"abcd" "a" token "b" token 2array choice parse ast>> "abcd" "a" token "b" token 2array choice parse
] unit-test ] unit-test
{ "b" } [ { "b" } [
"bbcd" "a" token "b" token 2array choice parse ast>> "bbcd" "a" token "b" token 2array choice parse
] unit-test ] unit-test
[ [
@ -56,15 +56,15 @@ IN: peg.tests
] must-fail ] must-fail
{ 0 } [ { 0 } [
"" "a" token repeat0 parse ast>> length "" "a" token repeat0 parse length
] unit-test ] unit-test
{ 0 } [ { 0 } [
"b" "a" token repeat0 parse ast>> length "b" "a" token repeat0 parse length
] unit-test ] unit-test
{ V{ "a" "a" "a" } } [ { V{ "a" "a" "a" } } [
"aaab" "a" token repeat0 parse ast>> "aaab" "a" token repeat0 parse
] unit-test ] unit-test
[ [
@ -76,15 +76,15 @@ IN: peg.tests
] must-fail ] must-fail
{ V{ "a" "a" "a" } } [ { V{ "a" "a" "a" } } [
"aaab" "a" token repeat1 parse ast>> "aaab" "a" token repeat1 parse
] unit-test ] unit-test
{ V{ "a" "b" } } [ { V{ "a" "b" } } [
"ab" "a" token optional "b" token 2array seq parse ast>> "ab" "a" token optional "b" token 2array seq parse
] unit-test ] unit-test
{ V{ f "b" } } [ { V{ f "b" } } [
"b" "a" token optional "b" token 2array seq parse ast>> "b" "a" token optional "b" token 2array seq parse
] unit-test ] unit-test
[ [
@ -92,7 +92,7 @@ IN: peg.tests
] must-fail ] must-fail
{ V{ CHAR: a CHAR: b } } [ { 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 ] unit-test
[ [
@ -124,11 +124,11 @@ IN: peg.tests
] must-fail ] must-fail
{ 1 } [ { 1 } [
"a" "a" token [ drop 1 ] action parse ast>> "a" "a" token [ drop 1 ] action parse
] unit-test ] unit-test
{ V{ 1 1 } } [ { 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 ] unit-test
[ [
@ -140,19 +140,19 @@ IN: peg.tests
] must-fail ] must-fail
{ CHAR: a } [ { CHAR: a } [
"a" [ CHAR: a = ] satisfy parse ast>> "a" [ CHAR: a = ] satisfy parse
] unit-test ] unit-test
{ "a" } [ { "a" } [
" a" "a" token sp parse ast>> " a" "a" token sp parse
] unit-test ] unit-test
{ "a" } [ { "a" } [
"a" "a" token sp parse ast>> "a" "a" token sp parse
] unit-test ] unit-test
{ V{ "a" } } [ { 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 ] unit-test
[ [
@ -165,8 +165,8 @@ IN: peg.tests
[ "1" token , "-" token , "1" token , ] seq* , [ "1" token , "-" token , "1" token , ] seq* ,
[ "1" token , "+" token , "1" token , ] seq* , [ "1" token , "+" token , "1" token , ] seq* ,
] choice* ] choice*
"1-1" over parse ast>> swap "1-1" over parse swap
"1+1" swap parse ast>> "1+1" swap parse
] unit-test ] unit-test
: expr ( -- parser ) : expr ( -- parser )
@ -175,7 +175,7 @@ IN: peg.tests
[ expr ] delay "+" token "1" token 3seq "1" token 2choice ; [ expr ] delay "+" token "1" token 3seq "1" token 2choice ;
{ V{ V{ "1" "+" "1" } "+" "1" } } [ { V{ V{ "1" "+" "1" } "+" "1" } } [
"1+1+1" expr parse ast>> "1+1+1" expr parse
] unit-test ] unit-test
{ t } [ { t } [
@ -190,6 +190,6 @@ IN: peg.tests
] must-fail ] must-fail
{ CHAR: B } [ { CHAR: B } [
"B" [ drop t ] satisfy [ 66 >= ] semantic parse ast>> "B" [ drop t ] satisfy [ 66 >= ] semantic parse
] unit-test ] unit-test

5
extra/peg/peg.factor
View File

@ -286,9 +286,12 @@ SYMBOL: delayed
: compiled-parse ( state word -- result ) : compiled-parse ( state word -- result )
swap [ execute [ error-stack get first throw ] unless* ] with-packrat ; inline 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 ; dup word? [ compile ] unless compiled-parse ;
: parse ( input parser -- ast )
(parse) ast>> ;
<PRIVATE <PRIVATE
SYMBOL: id SYMBOL: id

18
extra/peg/pl0/pl0-tests.factor
View File

@ -6,39 +6,39 @@ USING: kernel tools.test peg peg.ebnf peg.pl0
IN: peg.pl0.tests IN: peg.pl0.tests
{ t } [ { t } [
"CONST foo = 1;" "block" \ pl0 rule parse remaining>> empty? "CONST foo = 1;" "block" \ pl0 rule (parse) remaining>> empty?
] unit-test ] unit-test
{ t } [ { t } [
"VAR foo;" "block" \ pl0 rule parse remaining>> empty? "VAR foo;" "block" \ pl0 rule (parse) remaining>> empty?
] unit-test ] unit-test
{ t } [ { t } [
"VAR foo,bar , baz;" "block" \ pl0 rule parse remaining>> empty? "VAR foo,bar , baz;" "block" \ pl0 rule (parse) remaining>> empty?
] unit-test ] unit-test
{ t } [ { t } [
"foo := 5" "statement" \ pl0 rule parse remaining>> empty? "foo := 5" "statement" \ pl0 rule (parse) remaining>> empty?
] unit-test ] unit-test
{ t } [ { t } [
"BEGIN foo := 5 END" "statement" \ pl0 rule parse remaining>> empty? "BEGIN foo := 5 END" "statement" \ pl0 rule (parse) remaining>> empty?
] unit-test ] unit-test
{ t } [ { 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 ] unit-test
{ t } [ { 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 ] unit-test
{ t } [ { 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 ] unit-test
{ t } [ { 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 ] unit-test
{ t } [ { t } [

11
extra/peg/search/search.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2006 Chris Double. ! Copyright (C) 2006 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel math io io.streams.string sequences strings USING: kernel math io io.streams.string sequences strings
combinators peg memoize arrays ; combinators peg memoize arrays continuations ;
IN: peg.search IN: peg.search
: tree-write ( object -- ) : tree-write ( object -- )
@ -16,15 +16,12 @@ MEMO: any-char-parser ( -- parser )
[ drop t ] satisfy ; [ drop t ] satisfy ;
: search ( string parser -- seq ) : search ( string parser -- seq )
any-char-parser [ drop f ] action 2array choice repeat0 parse dup [ any-char-parser [ drop f ] action 2array choice repeat0
parse-result-ast sift [ parse sift ] [ 3drop { } ] recover ;
] [
drop { }
] if ;
: (replace) ( string parser -- seq ) : (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 ( string parser -- result )
[ (replace) [ tree-write ] each ] with-string-writer ; [ (replace) [ tree-write ] each ] with-string-writer ;