Merge branch 'master' of git://double.co.nz/git/factor
Slava Pestov
commit
9c1f6f73ac
|
|
@ -1,15 +1,16 @@
|
|||
! Copyright (C) 2007 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
!
|
||||
USING: kernel tools.test peg peg.ebnf words math math.parser sequences ;
|
||||
USING: kernel tools.test peg peg.ebnf words math math.parser
|
||||
sequences accessors ;
|
||||
IN: peg.ebnf.tests
|
||||
|
||||
{ T{ ebnf-non-terminal f "abc" } } [
|
||||
"abc" 'non-terminal' parse parse-result-ast
|
||||
"abc" 'non-terminal' parse ast>>
|
||||
] unit-test
|
||||
|
||||
{ T{ ebnf-terminal f "55" } } [
|
||||
"'55'" 'terminal' parse parse-result-ast
|
||||
"'55'" 'terminal' parse ast>>
|
||||
] unit-test
|
||||
|
||||
{
|
||||
|
|
@ -20,7 +21,7 @@ IN: peg.ebnf.tests
|
|||
}
|
||||
}
|
||||
} [
|
||||
"digit = '1' | '2'" 'rule' parse parse-result-ast
|
||||
"digit = '1' | '2'" 'rule' parse ast>>
|
||||
] unit-test
|
||||
|
||||
{
|
||||
|
|
@ -31,7 +32,7 @@ IN: peg.ebnf.tests
|
|||
}
|
||||
}
|
||||
} [
|
||||
"digit = '1' '2'" 'rule' parse parse-result-ast
|
||||
"digit = '1' '2'" 'rule' parse ast>>
|
||||
] unit-test
|
||||
|
||||
{
|
||||
|
|
@ -44,20 +45,22 @@ IN: peg.ebnf.tests
|
|||
}
|
||||
}
|
||||
} [
|
||||
"one two | three" 'choice' parse parse-result-ast
|
||||
"one two | three" 'choice' parse ast>>
|
||||
] unit-test
|
||||
|
||||
{
|
||||
T{ ebnf-sequence f
|
||||
V{
|
||||
T{ ebnf-non-terminal f "one" }
|
||||
T{ ebnf-choice f
|
||||
V{ T{ ebnf-non-terminal f "two" } T{ ebnf-non-terminal f "three" } }
|
||||
T{ ebnf-whitespace f
|
||||
T{ ebnf-choice f
|
||||
V{ T{ ebnf-non-terminal f "two" } T{ ebnf-non-terminal f "three" } }
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
} [
|
||||
"one (two | three)" 'choice' parse parse-result-ast
|
||||
"one {two | three}" 'choice' parse ast>>
|
||||
] unit-test
|
||||
|
||||
{
|
||||
|
|
@ -77,7 +80,7 @@ IN: peg.ebnf.tests
|
|||
}
|
||||
}
|
||||
} [
|
||||
"one ((two | three) four)*" 'choice' parse parse-result-ast
|
||||
"one ((two | three) four)*" 'choice' parse ast>>
|
||||
] unit-test
|
||||
|
||||
{
|
||||
|
|
@ -89,43 +92,43 @@ IN: peg.ebnf.tests
|
|||
}
|
||||
}
|
||||
} [
|
||||
"one ( two )? three" 'choice' parse parse-result-ast
|
||||
"one ( two )? three" 'choice' parse ast>>
|
||||
] unit-test
|
||||
|
||||
{ "foo" } [
|
||||
"\"foo\"" 'identifier' parse parse-result-ast
|
||||
"\"foo\"" 'identifier' parse ast>>
|
||||
] unit-test
|
||||
|
||||
{ "foo" } [
|
||||
"'foo'" 'identifier' parse parse-result-ast
|
||||
"'foo'" 'identifier' parse ast>>
|
||||
] unit-test
|
||||
|
||||
{ "foo" } [
|
||||
"foo" 'non-terminal' parse parse-result-ast ebnf-non-terminal-symbol
|
||||
"foo" 'non-terminal' parse ast>> ebnf-non-terminal-symbol
|
||||
] unit-test
|
||||
|
||||
{ "foo" } [
|
||||
"foo]" 'non-terminal' parse parse-result-ast ebnf-non-terminal-symbol
|
||||
"foo]" 'non-terminal' parse ast>> ebnf-non-terminal-symbol
|
||||
] unit-test
|
||||
|
||||
{ V{ "a" "b" } } [
|
||||
"ab" [EBNF foo='a' 'b' EBNF] call parse-result-ast
|
||||
"ab" [EBNF foo='a' 'b' EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ V{ 1 "b" } } [
|
||||
"ab" [EBNF foo=('a')[[ drop 1 ]] 'b' EBNF] call parse-result-ast
|
||||
"ab" [EBNF foo=('a')[[ drop 1 ]] 'b' EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ V{ 1 2 } } [
|
||||
"ab" [EBNF foo=('a') [[ drop 1 ]] ('b') [[ drop 2 ]] EBNF] call parse-result-ast
|
||||
"ab" [EBNF foo=('a') [[ drop 1 ]] ('b') [[ drop 2 ]] EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ CHAR: A } [
|
||||
"A" [EBNF foo=[A-Z] EBNF] call parse-result-ast
|
||||
"A" [EBNF foo=[A-Z] EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ CHAR: Z } [
|
||||
"Z" [EBNF foo=[A-Z] EBNF] call parse-result-ast
|
||||
"Z" [EBNF foo=[A-Z] EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
|
|
@ -133,7 +136,7 @@ IN: peg.ebnf.tests
|
|||
] unit-test
|
||||
|
||||
{ CHAR: 0 } [
|
||||
"0" [EBNF foo=[^A-Z] EBNF] call parse-result-ast
|
||||
"0" [EBNF foo=[^A-Z] EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
|
|
@ -145,31 +148,31 @@ IN: peg.ebnf.tests
|
|||
] unit-test
|
||||
|
||||
{ V{ "1" "+" "foo" } } [
|
||||
"1+1" [EBNF foo='1' '+' '1' [[ drop "foo" ]] EBNF] call parse-result-ast
|
||||
"1+1" [EBNF foo='1' '+' '1' [[ drop "foo" ]] EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ "foo" } [
|
||||
"1+1" [EBNF foo='1' '+' '1' => [[ drop "foo" ]] EBNF] call parse-result-ast
|
||||
"1+1" [EBNF foo='1' '+' '1' => [[ drop "foo" ]] EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ "foo" } [
|
||||
"1+1" [EBNF foo='1' '+' '1' => [[ drop "foo" ]] | '1' '-' '1' => [[ drop "bar" ]] EBNF] call parse-result-ast
|
||||
"1+1" [EBNF foo='1' '+' '1' => [[ drop "foo" ]] | '1' '-' '1' => [[ drop "bar" ]] EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ "bar" } [
|
||||
"1-1" [EBNF foo='1' '+' '1' => [[ drop "foo" ]] | '1' '-' '1' => [[ drop "bar" ]] EBNF] call parse-result-ast
|
||||
"1-1" [EBNF foo='1' '+' '1' => [[ drop "foo" ]] | '1' '-' '1' => [[ drop "bar" ]] EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ 6 } [
|
||||
"4+2" [EBNF num=[0-9] => [[ digit> ]] foo=num:x '+' num:y => [[ drop x y + ]] EBNF] call parse-result-ast
|
||||
"4+2" [EBNF num=[0-9] => [[ digit> ]] foo=num:x '+' num:y => [[ drop x y + ]] EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ 6 } [
|
||||
"4+2" [EBNF foo=[0-9]:x '+' [0-9]:y => [[ drop x digit> y digit> + ]] EBNF] call parse-result-ast
|
||||
"4+2" [EBNF foo=[0-9]:x '+' [0-9]:y => [[ drop x digit> y digit> + ]] EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ 10 } [
|
||||
{ 1 2 3 4 } [EBNF num=. ?[ number? ]? list=list:x num:y => [[ drop x y + ]] | num EBNF] call parse-result-ast
|
||||
{ 1 2 3 4 } [EBNF num=. ?[ number? ]? list=list:x num:y => [[ drop x y + ]] | num EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
|
|
@ -177,7 +180,7 @@ IN: peg.ebnf.tests
|
|||
] unit-test
|
||||
|
||||
{ 3 } [
|
||||
{ 1 2 "a" 4 } [EBNF num=. ?[ number? ]? list=list:x num:y => [[ drop x y + ]] | num EBNF] call parse-result-ast
|
||||
{ 1 2 "a" 4 } [EBNF num=. ?[ number? ]? list=list:x num:y => [[ drop x y + ]] | num EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
|
|
@ -185,44 +188,44 @@ IN: peg.ebnf.tests
|
|||
] unit-test
|
||||
|
||||
{ V{ "a" " " "b" } } [
|
||||
"a b" [EBNF -=" " | "\t" | "\n" foo="a" - "b" EBNF] call parse-result-ast
|
||||
"a b" [EBNF -=" " | "\t" | "\n" foo="a" - "b" EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ V{ "a" "\t" "b" } } [
|
||||
"a\tb" [EBNF -=" " | "\t" | "\n" foo="a" - "b" EBNF] call parse-result-ast
|
||||
"a\tb" [EBNF -=" " | "\t" | "\n" foo="a" - "b" EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ V{ "a" "\n" "b" } } [
|
||||
"a\nb" [EBNF -=" " | "\t" | "\n" foo="a" - "b" EBNF] call parse-result-ast
|
||||
"a\nb" [EBNF -=" " | "\t" | "\n" foo="a" - "b" EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ V{ "a" f "b" } } [
|
||||
"ab" [EBNF -=" " | "\t" | "\n" foo="a" (-)? "b" EBNF] call parse-result-ast
|
||||
"ab" [EBNF -=" " | "\t" | "\n" foo="a" (-)? "b" EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ V{ "a" " " "b" } } [
|
||||
"a b" [EBNF -=" " | "\t" | "\n" foo="a" (-)? "b" EBNF] call parse-result-ast
|
||||
"a b" [EBNF -=" " | "\t" | "\n" foo="a" (-)? "b" EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
|
||||
{ V{ "a" "\t" "b" } } [
|
||||
"a\tb" [EBNF -=" " | "\t" | "\n" foo="a" (-)? "b" EBNF] call parse-result-ast
|
||||
"a\tb" [EBNF -=" " | "\t" | "\n" foo="a" (-)? "b" EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ V{ "a" "\n" "b" } } [
|
||||
"a\nb" [EBNF -=" " | "\t" | "\n" foo="a" (-)? "b" EBNF] call parse-result-ast
|
||||
"a\nb" [EBNF -=" " | "\t" | "\n" foo="a" (-)? "b" EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ V{ "a" "b" } } [
|
||||
"ab" [EBNF -=(" " | "\t" | "\n")? => [[ drop ignore ]] foo="a" - "b" EBNF] call parse-result-ast
|
||||
"ab" [EBNF -=(" " | "\t" | "\n")? => [[ drop ignore ]] foo="a" - "b" EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ V{ "a" "b" } } [
|
||||
"a\tb" [EBNF -=(" " | "\t" | "\n")? => [[ drop ignore ]] foo="a" - "b" EBNF] call parse-result-ast
|
||||
"a\tb" [EBNF -=(" " | "\t" | "\n")? => [[ drop ignore ]] foo="a" - "b" EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ V{ "a" "b" } } [
|
||||
"a\nb" [EBNF -=(" " | "\t" | "\n")? => [[ drop ignore ]] foo="a" - "b" EBNF] call parse-result-ast
|
||||
"a\nb" [EBNF -=(" " | "\t" | "\n")? => [[ drop ignore ]] foo="a" - "b" EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
|
|
@ -232,19 +235,19 @@ IN: peg.ebnf.tests
|
|||
{ V{ V{ 49 } "+" V{ 49 } } } [
|
||||
#! Test direct left recursion.
|
||||
#! Using packrat, so first part of expr fails, causing 2nd choice to be used
|
||||
"1+1" [EBNF num=([0-9])+ expr=expr "+" num | num EBNF] call parse-result-ast
|
||||
"1+1" [EBNF num=([0-9])+ expr=expr "+" num | num EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ V{ V{ V{ 49 } "+" V{ 49 } } "+" V{ 49 } } } [
|
||||
#! Test direct left recursion.
|
||||
#! Using packrat, so first part of expr fails, causing 2nd choice to be used
|
||||
"1+1+1" [EBNF num=([0-9])+ expr=expr "+" num | num EBNF] call parse-result-ast
|
||||
"1+1+1" [EBNF num=([0-9])+ expr=expr "+" num | num EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ V{ V{ V{ 49 } "+" V{ 49 } } "+" V{ 49 } } } [
|
||||
#! Test indirect left recursion.
|
||||
#! Using packrat, so first part of expr fails, causing 2nd choice to be used
|
||||
"1+1+1" [EBNF num=([0-9])+ x=expr expr=x "+" num | num EBNF] call parse-result-ast
|
||||
"1+1+1" [EBNF num=([0-9])+ x=expr expr=x "+" num | num EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ t } [
|
||||
|
|
@ -277,23 +280,88 @@ main = Primary
|
|||
;EBNF
|
||||
|
||||
{ "this" } [
|
||||
"this" primary parse-result-ast
|
||||
"this" primary ast>>
|
||||
] unit-test
|
||||
|
||||
{ V{ "this" "." "x" } } [
|
||||
"this.x" primary parse-result-ast
|
||||
"this.x" primary ast>>
|
||||
] unit-test
|
||||
|
||||
{ V{ V{ "this" "." "x" } "." "y" } } [
|
||||
"this.x.y" primary parse-result-ast
|
||||
"this.x.y" primary ast>>
|
||||
] unit-test
|
||||
|
||||
{ V{ V{ "this" "." "x" } "." "m" "(" ")" } } [
|
||||
"this.x.m()" primary parse-result-ast
|
||||
"this.x.m()" primary ast>>
|
||||
] unit-test
|
||||
|
||||
{ V{ V{ V{ "x" "[" "i" "]" } "[" "j" "]" } "." "y" } } [
|
||||
"x[i][j].y" primary parse-result-ast
|
||||
"x[i][j].y" primary ast>>
|
||||
] unit-test
|
||||
|
||||
'ebnf' compile must-infer
|
||||
|
||||
{ V{ V{ "a" "b" } "c" } } [
|
||||
"abc" [EBNF a="a" "b" foo=(a "c") EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ V{ V{ "a" "b" } "c" } } [
|
||||
"abc" [EBNF a="a" "b" foo={a "c"} EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ V{ V{ "a" "b" } "c" } } [
|
||||
"abc" [EBNF a="a" "b" foo=a "c" EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
"a bc" [EBNF a="a" "b" foo=(a "c") EBNF] call
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
"a bc" [EBNF a="a" "b" foo=a "c" EBNF] call
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
"a bc" [EBNF a="a" "b" foo={a "c"} EBNF] call
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
"ab c" [EBNF a="a" "b" foo=a "c" EBNF] call
|
||||
] unit-test
|
||||
|
||||
{ V{ V{ "a" "b" } "c" } } [
|
||||
"ab c" [EBNF a="a" "b" foo={a "c"} EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
"ab c" [EBNF a="a" "b" foo=(a "c") EBNF] call
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
"a b c" [EBNF a="a" "b" foo=a "c" EBNF] call
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
"a b c" [EBNF a="a" "b" foo=(a "c") EBNF] call
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
"a b c" [EBNF a="a" "b" foo={a "c"} EBNF] call
|
||||
] unit-test
|
||||
|
||||
{ V{ V{ V{ "a" "b" } "c" } V{ V{ "a" "b" } "c" } } } [
|
||||
"ab cab c" [EBNF a="a" "b" foo={a "c"}* EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ V{ } } [
|
||||
"ab cab c" [EBNF a="a" "b" foo=(a "c")* EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ V{ V{ V{ "a" "b" } "c" } V{ V{ "a" "b" } "c" } } } [
|
||||
"ab c ab c" [EBNF a="a" "b" foo={a "c"}* EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
{ V{ } } [
|
||||
"ab c ab c" [EBNF a="a" "b" foo=(a "c")* EBNF] call ast>>
|
||||
] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -17,6 +17,7 @@ TUPLE: ebnf-sequence elements ;
|
|||
TUPLE: ebnf-repeat0 group ;
|
||||
TUPLE: ebnf-repeat1 group ;
|
||||
TUPLE: ebnf-optional group ;
|
||||
TUPLE: ebnf-whitespace group ;
|
||||
TUPLE: ebnf-rule symbol elements ;
|
||||
TUPLE: ebnf-action parser code ;
|
||||
TUPLE: ebnf-var parser name ;
|
||||
|
|
@ -34,6 +35,7 @@ C: <ebnf-sequence> ebnf-sequence
|
|||
C: <ebnf-repeat0> ebnf-repeat0
|
||||
C: <ebnf-repeat1> ebnf-repeat1
|
||||
C: <ebnf-optional> ebnf-optional
|
||||
C: <ebnf-whitespace> ebnf-whitespace
|
||||
C: <ebnf-rule> ebnf-rule
|
||||
C: <ebnf-action> ebnf-action
|
||||
C: <ebnf-var> ebnf-var
|
||||
|
|
@ -84,6 +86,7 @@ C: <ebnf> ebnf
|
|||
[ dup CHAR: + = ]
|
||||
[ dup CHAR: ? = ]
|
||||
[ dup CHAR: : = ]
|
||||
[ dup CHAR: ~ = ]
|
||||
} || not nip
|
||||
] satisfy repeat1 [ >string <ebnf-non-terminal> ] action ;
|
||||
|
||||
|
|
@ -134,9 +137,15 @@ DEFER: 'choice'
|
|||
#! Parse a group of choices, with a suffix indicating
|
||||
#! the type of group (repeat0, repeat1, etc) and
|
||||
#! an quot that is the action that produces the AST.
|
||||
"(" [ 'choice' sp ] delay ")" syntax-pack
|
||||
swap 2seq
|
||||
[ first ] rot compose action ;
|
||||
2dup
|
||||
[
|
||||
"(" [ 'choice' sp ] delay ")" syntax-pack
|
||||
swap 2seq
|
||||
[ first ] rot compose action ,
|
||||
"{" [ 'choice' sp ] delay "}" syntax-pack
|
||||
swap 2seq
|
||||
[ first <ebnf-whitespace> ] rot compose action ,
|
||||
] choice* ;
|
||||
|
||||
: 'group' ( -- parser )
|
||||
#! A grouping with no suffix. Used for precedence.
|
||||
|
|
@ -238,9 +247,15 @@ GENERIC: (transform) ( ast -- parser )
|
|||
|
||||
SYMBOL: parser
|
||||
SYMBOL: main
|
||||
SYMBOL: ignore-ws
|
||||
|
||||
: transform ( ast -- object )
|
||||
H{ } clone dup dup [ parser set swap (transform) main set ] bind ;
|
||||
H{ } clone dup dup [
|
||||
f ignore-ws set
|
||||
parser set
|
||||
swap (transform)
|
||||
main set
|
||||
] bind ;
|
||||
|
||||
M: ebnf (transform) ( ast -- parser )
|
||||
rules>> [ (transform) ] map peek ;
|
||||
|
|
@ -252,7 +267,13 @@ M: ebnf-rule (transform) ( ast -- parser )
|
|||
] keep ;
|
||||
|
||||
M: ebnf-sequence (transform) ( ast -- parser )
|
||||
elements>> [ (transform) ] map seq [ dup length 1 = [ first ] when ] action ;
|
||||
#! If ignore-ws is set then each element of the sequence
|
||||
#! ignores leading whitespace. This is not inherited by
|
||||
#! subelements of the sequence.
|
||||
elements>> [
|
||||
f ignore-ws [ (transform) ] with-variable
|
||||
ignore-ws get [ sp ] when
|
||||
] map seq [ dup length 1 = [ first ] when ] action ;
|
||||
|
||||
M: ebnf-choice (transform) ( ast -- parser )
|
||||
options>> [ (transform) ] map choice ;
|
||||
|
|
@ -282,6 +303,9 @@ M: ebnf-repeat1 (transform) ( ast -- parser )
|
|||
M: ebnf-optional (transform) ( ast -- parser )
|
||||
transform-group optional ;
|
||||
|
||||
M: ebnf-whitespace (transform) ( ast -- parser )
|
||||
t ignore-ws [ transform-group ] with-variable ;
|
||||
|
||||
GENERIC: build-locals ( code ast -- code )
|
||||
|
||||
M: ebnf-sequence build-locals ( code ast -- code )
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2008 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel arrays strings math.parser sequences
|
||||
peg peg.ebnf peg.parsers memoize math ;
|
||||
peg peg.ebnf peg.parsers memoize math accessors ;
|
||||
IN: peg.expr
|
||||
|
||||
EBNF: expr
|
||||
|
|
@ -20,5 +20,5 @@ exp = exp "+" fac => [[ first3 nip + ]]
|
|||
;EBNF
|
||||
|
||||
: eval-expr ( string -- number )
|
||||
expr parse-result-ast ;
|
||||
expr ast>> ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,8 @@
|
|||
! Copyright (C) 2007 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
!
|
||||
USING: kernel tools.test strings namespaces arrays sequences peg peg.private accessors words math ;
|
||||
USING: kernel tools.test strings namespaces arrays sequences
|
||||
peg peg.private accessors words math accessors ;
|
||||
IN: peg.tests
|
||||
|
||||
{ f } [
|
||||
|
|
@ -10,7 +11,7 @@ IN: peg.tests
|
|||
|
||||
{ "begin" "end" } [
|
||||
"beginend" "begin" token parse
|
||||
{ parse-result-ast parse-result-remaining } get-slots
|
||||
{ ast>> remaining>> } get-slots
|
||||
>string
|
||||
] unit-test
|
||||
|
||||
|
|
@ -23,11 +24,11 @@ IN: peg.tests
|
|||
] unit-test
|
||||
|
||||
{ CHAR: a } [
|
||||
"abcd" CHAR: a CHAR: z range parse parse-result-ast
|
||||
"abcd" CHAR: a CHAR: z range parse ast>>
|
||||
] unit-test
|
||||
|
||||
{ CHAR: z } [
|
||||
"zbcd" CHAR: a CHAR: z range parse parse-result-ast
|
||||
"zbcd" CHAR: a CHAR: z range parse ast>>
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
|
|
@ -35,15 +36,15 @@ IN: peg.tests
|
|||
] unit-test
|
||||
|
||||
{ V{ "g" "o" } } [
|
||||
"good" "g" token "o" token 2array seq parse parse-result-ast
|
||||
"good" "g" token "o" token 2array seq parse ast>>
|
||||
] unit-test
|
||||
|
||||
{ "a" } [
|
||||
"abcd" "a" token "b" token 2array choice parse parse-result-ast
|
||||
"abcd" "a" token "b" token 2array choice parse ast>>
|
||||
] unit-test
|
||||
|
||||
{ "b" } [
|
||||
"bbcd" "a" token "b" token 2array choice parse parse-result-ast
|
||||
"bbcd" "a" token "b" token 2array choice parse ast>>
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
|
|
@ -55,15 +56,15 @@ IN: peg.tests
|
|||
] unit-test
|
||||
|
||||
{ 0 } [
|
||||
"" "a" token repeat0 parse parse-result-ast length
|
||||
"" "a" token repeat0 parse ast>> length
|
||||
] unit-test
|
||||
|
||||
{ 0 } [
|
||||
"b" "a" token repeat0 parse parse-result-ast length
|
||||
"b" "a" token repeat0 parse ast>> length
|
||||
] unit-test
|
||||
|
||||
{ V{ "a" "a" "a" } } [
|
||||
"aaab" "a" token repeat0 parse parse-result-ast
|
||||
"aaab" "a" token repeat0 parse ast>>
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
|
|
@ -75,15 +76,15 @@ IN: peg.tests
|
|||
] unit-test
|
||||
|
||||
{ V{ "a" "a" "a" } } [
|
||||
"aaab" "a" token repeat1 parse parse-result-ast
|
||||
"aaab" "a" token repeat1 parse ast>>
|
||||
] unit-test
|
||||
|
||||
{ V{ "a" "b" } } [
|
||||
"ab" "a" token optional "b" token 2array seq parse parse-result-ast
|
||||
"ab" "a" token optional "b" token 2array seq parse ast>>
|
||||
] unit-test
|
||||
|
||||
{ V{ f "b" } } [
|
||||
"b" "a" token optional "b" token 2array seq parse parse-result-ast
|
||||
"b" "a" token optional "b" token 2array seq parse ast>>
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
|
|
@ -91,7 +92,7 @@ IN: peg.tests
|
|||
] unit-test
|
||||
|
||||
{ V{ CHAR: a CHAR: b } } [
|
||||
"ab" "a" token ensure CHAR: a CHAR: z range dup 3array seq parse parse-result-ast
|
||||
"ab" "a" token ensure CHAR: a CHAR: z range dup 3array seq parse ast>>
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
|
|
@ -123,11 +124,11 @@ IN: peg.tests
|
|||
] unit-test
|
||||
|
||||
{ 1 } [
|
||||
"a" "a" token [ drop 1 ] action parse parse-result-ast
|
||||
"a" "a" token [ drop 1 ] action parse ast>>
|
||||
] unit-test
|
||||
|
||||
{ V{ 1 1 } } [
|
||||
"aa" "a" token [ drop 1 ] action dup 2array seq parse parse-result-ast
|
||||
"aa" "a" token [ drop 1 ] action dup 2array seq parse ast>>
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
|
|
@ -139,19 +140,19 @@ IN: peg.tests
|
|||
] unit-test
|
||||
|
||||
{ CHAR: a } [
|
||||
"a" [ CHAR: a = ] satisfy parse parse-result-ast
|
||||
"a" [ CHAR: a = ] satisfy parse ast>>
|
||||
] unit-test
|
||||
|
||||
{ "a" } [
|
||||
" a" "a" token sp parse parse-result-ast
|
||||
" a" "a" token sp parse ast>>
|
||||
] unit-test
|
||||
|
||||
{ "a" } [
|
||||
"a" "a" token sp parse parse-result-ast
|
||||
"a" "a" token sp parse ast>>
|
||||
] unit-test
|
||||
|
||||
{ V{ "a" } } [
|
||||
"[a]" "[" token hide "a" token "]" token hide 3array seq parse parse-result-ast
|
||||
"[a]" "[" token hide "a" token "]" token hide 3array seq parse ast>>
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
|
|
@ -164,8 +165,8 @@ IN: peg.tests
|
|||
[ "1" token , "-" token , "1" token , ] seq* ,
|
||||
[ "1" token , "+" token , "1" token , ] seq* ,
|
||||
] choice*
|
||||
"1-1" over parse parse-result-ast swap
|
||||
"1+1" swap parse parse-result-ast
|
||||
"1-1" over parse ast>> swap
|
||||
"1+1" swap parse ast>>
|
||||
] unit-test
|
||||
|
||||
: expr ( -- parser )
|
||||
|
|
@ -174,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 parse-result-ast
|
||||
"1+1+1" expr parse ast>>
|
||||
] unit-test
|
||||
|
||||
{ t } [
|
||||
|
|
@ -189,6 +190,6 @@ IN: peg.tests
|
|||
] unit-test
|
||||
|
||||
{ CHAR: B } [
|
||||
"B" [ drop t ] satisfy [ 66 >= ] semantic parse parse-result-ast
|
||||
"B" [ drop t ] satisfy [ 66 >= ] semantic parse ast>>
|
||||
] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -1,43 +1,44 @@
|
|||
! Copyright (C) 2007 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
!
|
||||
USING: kernel tools.test peg peg.ebnf peg.pl0 multiline sequences ;
|
||||
USING: kernel tools.test peg peg.ebnf peg.pl0
|
||||
multiline sequences accessors ;
|
||||
IN: peg.pl0.tests
|
||||
|
||||
{ t } [
|
||||
"CONST foo = 1;" "block" \ pl0 rule parse parse-result-remaining empty?
|
||||
"CONST foo = 1;" "block" \ pl0 rule parse remaining>> empty?
|
||||
] unit-test
|
||||
|
||||
{ t } [
|
||||
"VAR foo;" "block" \ pl0 rule parse parse-result-remaining empty?
|
||||
"VAR foo;" "block" \ pl0 rule parse remaining>> empty?
|
||||
] unit-test
|
||||
|
||||
{ t } [
|
||||
"VAR foo,bar , baz;" "block" \ pl0 rule parse parse-result-remaining empty?
|
||||
"VAR foo,bar , baz;" "block" \ pl0 rule parse remaining>> empty?
|
||||
] unit-test
|
||||
|
||||
{ t } [
|
||||
"foo := 5" "statement" \ pl0 rule parse parse-result-remaining empty?
|
||||
"foo := 5" "statement" \ pl0 rule parse remaining>> empty?
|
||||
] unit-test
|
||||
|
||||
{ t } [
|
||||
"BEGIN foo := 5 END" "statement" \ pl0 rule parse parse-result-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 parse-result-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 parse-result-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 parse-result-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 parse-result-remaining empty?
|
||||
"PROCEDURE square; BEGIN squ:=x*x END" "block" \ pl0 rule parse remaining>> empty?
|
||||
] unit-test
|
||||
|
||||
{ t } [
|
||||
|
|
@ -57,7 +58,7 @@ BEGIN
|
|||
x := x + 1;
|
||||
END
|
||||
END.
|
||||
"> pl0 parse-result-remaining empty?
|
||||
"> pl0 remaining>> empty?
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
|
|
@ -123,5 +124,5 @@ BEGIN
|
|||
y := 36;
|
||||
CALL gcd;
|
||||
END.
|
||||
"> pl0 parse-result-remaining empty?
|
||||
"> pl0 remaining>> empty?
|
||||
] unit-test
|
||||
|
|
@ -7,52 +7,22 @@ IN: peg.pl0
|
|||
#! Grammar for PL/0 based on http://en.wikipedia.org/wiki/PL/0
|
||||
|
||||
EBNF: pl0
|
||||
_ = (" " | "\t" | "\n")* => [[ drop ignore ]]
|
||||
|
||||
BEGIN = "BEGIN" _
|
||||
CALL = "CALL" _
|
||||
CONST = "CONST" _
|
||||
DO = "DO" _
|
||||
END = "END" _
|
||||
IF = "IF" _
|
||||
THEN = "THEN" _
|
||||
ODD = "ODD" _
|
||||
PROCEDURE = "PROCEDURE" _
|
||||
VAR = "VAR" _
|
||||
WHILE = "WHILE" _
|
||||
EQ = "=" _
|
||||
LTEQ = "<=" _
|
||||
LT = "<" _
|
||||
GT = ">" _
|
||||
GTEQ = ">=" _
|
||||
NEQ = "#" _
|
||||
COMMA = "," _
|
||||
SEMICOLON = ";" _
|
||||
ASSIGN = ":=" _
|
||||
|
||||
ADD = "+" _
|
||||
SUBTRACT = "-" _
|
||||
MULTIPLY = "*" _
|
||||
DIVIDE = "/" _
|
||||
|
||||
LPAREN = "(" _
|
||||
RPAREN = ")" _
|
||||
|
||||
block = ( CONST ident EQ number ( COMMA ident EQ number )* SEMICOLON )?
|
||||
( VAR ident ( COMMA ident )* SEMICOLON )?
|
||||
( PROCEDURE ident SEMICOLON ( block SEMICOLON )? )* statement
|
||||
statement = ( ident ASSIGN expression
|
||||
| CALL ident
|
||||
| BEGIN statement ( SEMICOLON statement )* END
|
||||
| IF condition THEN statement
|
||||
| WHILE condition DO statement )?
|
||||
condition = ODD expression
|
||||
| expression (EQ | NEQ | LTEQ | LT | GTEQ | GT) expression
|
||||
expression = (ADD | SUBTRACT)? term ( (ADD | SUBTRACT) term )* _
|
||||
term = factor ( (MULTIPLY | DIVIDE) factor )*
|
||||
factor = ident | number | LPAREN expression RPAREN
|
||||
ident = (([a-zA-Z])+) _ => [[ >string ]]
|
||||
block = { "CONST" ident "=" number { "," ident "=" number }* ";" }?
|
||||
{ "VAR" ident { "," ident }* ";" }?
|
||||
{ "PROCEDURE" ident ";" { block ";" }? }* statement
|
||||
statement = { ident ":=" expression
|
||||
| "CALL" ident
|
||||
| "BEGIN" statement { ";" statement }* "END"
|
||||
| "IF" condition "THEN" statement
|
||||
| "WHILE" condition "DO" statement }?
|
||||
condition = { "ODD" expression }
|
||||
| { expression ("=" | "#" | "<=" | "<" | ">=" | ">") expression }
|
||||
expression = {"+" | "-"}? term { {"+" | "-"} term }*
|
||||
term = factor { {"*" | "/"} factor }*
|
||||
factor = ident | number | "(" expression ")"
|
||||
ident = (([a-zA-Z])+) => [[ >string ]]
|
||||
digit = ([0-9]) => [[ digit> ]]
|
||||
number = ((digit)+) _ => [[ 10 digits>integer ]]
|
||||
program = _ block "."
|
||||
number = (digit)+ => [[ 10 digits>integer ]]
|
||||
program = { block "." }
|
||||
;EBNF
|
||||
|
|
|
|||
Loading…
Reference in New Issue