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

Merge branch 'master' of git://double.co.nz/git/factor

db4
Slava Pestov 2008-04-28 22:20:56 -05:00
parent 090a92b839 e1f82caf83
commit 9c1f6f73ac
6 changed files with 200 additions and 136 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,15 +1,16 @@
! Copyright (C) 2007 Chris Double. ! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! 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 IN: peg.ebnf.tests
{ T{ ebnf-non-terminal f "abc" } } [ { T{ ebnf-non-terminal f "abc" } } [
"abc" 'non-terminal' parse parse-result-ast "abc" 'non-terminal' parse ast>>
] unit-test ] unit-test
{ T{ ebnf-terminal f "55" } } [ { T{ ebnf-terminal f "55" } } [
"'55'" 'terminal' parse parse-result-ast "'55'" 'terminal' parse ast>>
] unit-test ] 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 ] 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 ] 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 ] unit-test
{ {
T{ ebnf-sequence f T{ ebnf-sequence f
V{ V{
T{ ebnf-non-terminal f "one" } T{ ebnf-non-terminal f "one" }
T{ ebnf-choice f T{ ebnf-whitespace f
V{ T{ ebnf-non-terminal f "two" } T{ ebnf-non-terminal f "three" } } 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 ] 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 ] 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 ] unit-test
{ "foo" } [ { "foo" } [
"\"foo\"" 'identifier' parse parse-result-ast "\"foo\"" 'identifier' parse ast>>
] unit-test ] unit-test
{ "foo" } [ { "foo" } [
"'foo'" 'identifier' parse parse-result-ast "'foo'" 'identifier' parse ast>>
] unit-test ] unit-test
{ "foo" } [ { "foo" } [
"foo" 'non-terminal' parse parse-result-ast ebnf-non-terminal-symbol "foo" 'non-terminal' parse ast>> ebnf-non-terminal-symbol
] unit-test ] unit-test
{ "foo" } [ { "foo" } [
"foo]" 'non-terminal' parse parse-result-ast ebnf-non-terminal-symbol "foo]" 'non-terminal' parse ast>> ebnf-non-terminal-symbol
] unit-test ] unit-test
{ V{ "a" "b" } } [ { V{ "a" "b" } } [
"ab" [EBNF foo='a' 'b' EBNF] call parse-result-ast "ab" [EBNF foo='a' 'b' EBNF] call ast>>
] unit-test ] unit-test
{ V{ 1 "b" } } [ { 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 ] unit-test
{ V{ 1 2 } } [ { 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 ] unit-test
{ CHAR: A } [ { CHAR: A } [
"A" [EBNF foo=[A-Z] EBNF] call parse-result-ast "A" [EBNF foo=[A-Z] EBNF] call ast>>
] unit-test ] unit-test
{ CHAR: Z } [ { CHAR: Z } [
"Z" [EBNF foo=[A-Z] EBNF] call parse-result-ast "Z" [EBNF foo=[A-Z] EBNF] call ast>>
] unit-test ] unit-test
{ f } [ { f } [
@ -133,7 +136,7 @@ IN: peg.ebnf.tests
] unit-test ] unit-test
{ CHAR: 0 } [ { CHAR: 0 } [
"0" [EBNF foo=[^A-Z] EBNF] call parse-result-ast "0" [EBNF foo=[^A-Z] EBNF] call ast>>
] unit-test ] unit-test
{ f } [ { f } [
@ -145,31 +148,31 @@ IN: peg.ebnf.tests
] unit-test ] unit-test
{ V{ "1" "+" "foo" } } [ { 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 ] unit-test
{ "foo" } [ { "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 ] unit-test
{ "foo" } [ { "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 ] unit-test
{ "bar" } [ { "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 ] unit-test
{ 6 } [ { 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 ] unit-test
{ 6 } [ { 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 ] unit-test
{ 10 } [ { 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 ] unit-test
{ f } [ { f } [
@ -177,7 +180,7 @@ IN: peg.ebnf.tests
] unit-test ] unit-test
{ 3 } [ { 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 ] unit-test
{ f } [ { f } [
@ -185,44 +188,44 @@ IN: peg.ebnf.tests
] unit-test ] unit-test
{ V{ "a" " " "b" } } [ { 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 ] unit-test
{ V{ "a" "\t" "b" } } [ { 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 ] unit-test
{ V{ "a" "\n" "b" } } [ { 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 ] unit-test
{ V{ "a" f "b" } } [ { 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 ] unit-test
{ V{ "a" " " "b" } } [ { 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 ] unit-test
{ V{ "a" "\t" "b" } } [ { 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 ] unit-test
{ V{ "a" "\n" "b" } } [ { 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 ] unit-test
{ V{ "a" "b" } } [ { 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 ] unit-test
{ V{ "a" "b" } } [ { 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 ] unit-test
{ V{ "a" "b" } } [ { 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 ] unit-test
{ f } [ { f } [
@ -232,19 +235,19 @@ IN: peg.ebnf.tests
{ V{ V{ 49 } "+" V{ 49 } } } [ { V{ V{ 49 } "+" V{ 49 } } } [
#! Test direct left recursion. #! Test direct left recursion.
#! Using packrat, so first part of expr fails, causing 2nd choice to be used #! 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 ] unit-test
{ V{ V{ V{ 49 } "+" V{ 49 } } "+" V{ 49 } } } [ { V{ V{ V{ 49 } "+" V{ 49 } } "+" V{ 49 } } } [
#! Test direct left recursion. #! Test direct left recursion.
#! Using packrat, so first part of expr fails, causing 2nd choice to be used #! 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 ] unit-test
{ V{ V{ V{ 49 } "+" V{ 49 } } "+" V{ 49 } } } [ { V{ V{ V{ 49 } "+" V{ 49 } } "+" V{ 49 } } } [
#! Test indirect left recursion. #! Test indirect left recursion.
#! Using packrat, so first part of expr fails, causing 2nd choice to be used #! 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 ] unit-test
{ t } [ { t } [
@ -277,23 +280,88 @@ main = Primary
;EBNF ;EBNF
{ "this" } [ { "this" } [
"this" primary parse-result-ast "this" primary ast>>
] unit-test ] unit-test
{ V{ "this" "." "x" } } [ { V{ "this" "." "x" } } [
"this.x" primary parse-result-ast "this.x" primary ast>>
] unit-test ] unit-test
{ V{ V{ "this" "." "x" } "." "y" } } [ { V{ V{ "this" "." "x" } "." "y" } } [
"this.x.y" primary parse-result-ast "this.x.y" primary ast>>
] unit-test ] unit-test
{ V{ V{ "this" "." "x" } "." "m" "(" ")" } } [ { V{ V{ "this" "." "x" } "." "m" "(" ")" } } [
"this.x.m()" primary parse-result-ast "this.x.m()" primary ast>>
] unit-test ] unit-test
{ V{ V{ V{ "x" "[" "i" "]" } "[" "j" "]" } "." "y" } } [ { V{ V{ V{ "x" "[" "i" "]" } "[" "j" "]" } "." "y" } } [
"x[i][j].y" primary parse-result-ast "x[i][j].y" primary ast>>
] unit-test ] unit-test
'ebnf' compile must-infer '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

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

@ -17,6 +17,7 @@ TUPLE: ebnf-sequence elements ;
TUPLE: ebnf-repeat0 group ; TUPLE: ebnf-repeat0 group ;
TUPLE: ebnf-repeat1 group ; TUPLE: ebnf-repeat1 group ;
TUPLE: ebnf-optional group ; TUPLE: ebnf-optional group ;
TUPLE: ebnf-whitespace group ;
TUPLE: ebnf-rule symbol elements ; TUPLE: ebnf-rule symbol elements ;
TUPLE: ebnf-action parser code ; TUPLE: ebnf-action parser code ;
TUPLE: ebnf-var parser name ; TUPLE: ebnf-var parser name ;
@ -34,6 +35,7 @@ C: <ebnf-sequence> ebnf-sequence
C: <ebnf-repeat0> ebnf-repeat0 C: <ebnf-repeat0> ebnf-repeat0
C: <ebnf-repeat1> ebnf-repeat1 C: <ebnf-repeat1> ebnf-repeat1
C: <ebnf-optional> ebnf-optional C: <ebnf-optional> ebnf-optional
C: <ebnf-whitespace> ebnf-whitespace
C: <ebnf-rule> ebnf-rule C: <ebnf-rule> ebnf-rule
C: <ebnf-action> ebnf-action C: <ebnf-action> ebnf-action
C: <ebnf-var> ebnf-var C: <ebnf-var> ebnf-var
@ -84,6 +86,7 @@ C: <ebnf> ebnf
[ dup CHAR: + = ] [ dup CHAR: + = ]
[ dup CHAR: ? = ] [ dup CHAR: ? = ]
[ dup CHAR: : = ] [ dup CHAR: : = ]
[ dup CHAR: ~ = ]
} || not nip } || not nip
] satisfy repeat1 [ >string <ebnf-non-terminal> ] action ; ] satisfy repeat1 [ >string <ebnf-non-terminal> ] action ;
@ -134,9 +137,15 @@ DEFER: 'choice'
#! Parse a group of choices, with a suffix indicating #! Parse a group of choices, with a suffix indicating
#! the type of group (repeat0, repeat1, etc) and #! the type of group (repeat0, repeat1, etc) and
#! an quot that is the action that produces the AST. #! an quot that is the action that produces the AST.
"(" [ 'choice' sp ] delay ")" syntax-pack 2dup
swap 2seq [
[ first ] rot compose action ; "(" [ '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 ) : 'group' ( -- parser )
#! A grouping with no suffix. Used for precedence. #! A grouping with no suffix. Used for precedence.
@ -238,9 +247,15 @@ GENERIC: (transform) ( ast -- parser )
SYMBOL: parser SYMBOL: parser
SYMBOL: main SYMBOL: main
SYMBOL: ignore-ws
: transform ( ast -- object ) : 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 ) M: ebnf (transform) ( ast -- parser )
rules>> [ (transform) ] map peek ; rules>> [ (transform) ] map peek ;
@ -252,7 +267,13 @@ M: ebnf-rule (transform) ( ast -- parser )
] keep ; ] keep ;
M: ebnf-sequence (transform) ( ast -- parser ) 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 ) M: ebnf-choice (transform) ( ast -- parser )
options>> [ (transform) ] map choice ; options>> [ (transform) ] map choice ;
@ -282,6 +303,9 @@ M: ebnf-repeat1 (transform) ( ast -- parser )
M: ebnf-optional (transform) ( ast -- parser ) M: ebnf-optional (transform) ( ast -- parser )
transform-group optional ; transform-group optional ;
M: ebnf-whitespace (transform) ( ast -- parser )
t ignore-ws [ transform-group ] with-variable ;
GENERIC: build-locals ( code ast -- code ) GENERIC: build-locals ( code ast -- code )
M: ebnf-sequence build-locals ( code ast -- code ) M: ebnf-sequence build-locals ( code ast -- code )

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

@ -1,7 +1,7 @@
! Copyright (C) 2008 Chris Double. ! Copyright (C) 2008 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel arrays strings math.parser sequences 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 IN: peg.expr
EBNF: expr EBNF: expr
@ -20,5 +20,5 @@ exp = exp "+" fac => [[ first3 nip + ]]
;EBNF ;EBNF
: eval-expr ( string -- number ) : eval-expr ( string -- number )
expr parse-result-ast ; expr ast>> ;

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

@ -1,7 +1,8 @@
! Copyright (C) 2007 Chris Double. ! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! 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 IN: peg.tests
{ f } [ { f } [
@ -10,7 +11,7 @@ IN: peg.tests
{ "begin" "end" } [ { "begin" "end" } [
"beginend" "begin" token parse "beginend" "begin" token parse
{ parse-result-ast parse-result-remaining } get-slots { ast>> remaining>> } get-slots
>string >string
] unit-test ] unit-test
@ -23,11 +24,11 @@ IN: peg.tests
] unit-test ] unit-test
{ CHAR: a } [ { CHAR: a } [
"abcd" CHAR: a CHAR: z range parse parse-result-ast "abcd" CHAR: a CHAR: z range parse ast>>
] unit-test ] unit-test
{ CHAR: z } [ { CHAR: z } [
"zbcd" CHAR: a CHAR: z range parse parse-result-ast "zbcd" CHAR: a CHAR: z range parse ast>>
] unit-test ] unit-test
{ f } [ { f } [
@ -35,15 +36,15 @@ IN: peg.tests
] unit-test ] unit-test
{ V{ "g" "o" } } [ { 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 ] unit-test
{ "a" } [ { "a" } [
"abcd" "a" token "b" token 2array choice parse parse-result-ast "abcd" "a" token "b" token 2array choice parse ast>>
] unit-test ] unit-test
{ "b" } [ { "b" } [
"bbcd" "a" token "b" token 2array choice parse parse-result-ast "bbcd" "a" token "b" token 2array choice parse ast>>
] unit-test ] unit-test
{ f } [ { f } [
@ -55,15 +56,15 @@ IN: peg.tests
] unit-test ] unit-test
{ 0 } [ { 0 } [
"" "a" token repeat0 parse parse-result-ast length "" "a" token repeat0 parse ast>> length
] unit-test ] unit-test
{ 0 } [ { 0 } [
"b" "a" token repeat0 parse parse-result-ast length "b" "a" token repeat0 parse ast>> length
] unit-test ] unit-test
{ V{ "a" "a" "a" } } [ { V{ "a" "a" "a" } } [
"aaab" "a" token repeat0 parse parse-result-ast "aaab" "a" token repeat0 parse ast>>
] unit-test ] unit-test
{ f } [ { f } [
@ -75,15 +76,15 @@ IN: peg.tests
] unit-test ] unit-test
{ V{ "a" "a" "a" } } [ { V{ "a" "a" "a" } } [
"aaab" "a" token repeat1 parse parse-result-ast "aaab" "a" token repeat1 parse ast>>
] unit-test ] unit-test
{ V{ "a" "b" } } [ { 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 ] unit-test
{ V{ f "b" } } [ { 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 ] unit-test
{ f } [ { f } [
@ -91,7 +92,7 @@ IN: peg.tests
] unit-test ] unit-test
{ V{ CHAR: a CHAR: b } } [ { 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 ] unit-test
{ f } [ { f } [
@ -123,11 +124,11 @@ IN: peg.tests
] unit-test ] unit-test
{ 1 } [ { 1 } [
"a" "a" token [ drop 1 ] action parse parse-result-ast "a" "a" token [ drop 1 ] action parse ast>>
] unit-test ] unit-test
{ V{ 1 1 } } [ { 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 ] unit-test
{ f } [ { f } [
@ -139,19 +140,19 @@ IN: peg.tests
] unit-test ] unit-test
{ CHAR: a } [ { CHAR: a } [
"a" [ CHAR: a = ] satisfy parse parse-result-ast "a" [ CHAR: a = ] satisfy parse ast>>
] unit-test ] unit-test
{ "a" } [ { "a" } [
" a" "a" token sp parse parse-result-ast " a" "a" token sp parse ast>>
] unit-test ] unit-test
{ "a" } [ { "a" } [
"a" "a" token sp parse parse-result-ast "a" "a" token sp parse ast>>
] unit-test ] unit-test
{ V{ "a" } } [ { 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 ] unit-test
{ f } [ { f } [
@ -164,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 parse-result-ast swap "1-1" over parse ast>> swap
"1+1" swap parse parse-result-ast "1+1" swap parse ast>>
] unit-test ] unit-test
: expr ( -- parser ) : expr ( -- parser )
@ -174,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 parse-result-ast "1+1+1" expr parse ast>>
] unit-test ] unit-test
{ t } [ { t } [
@ -189,6 +190,6 @@ IN: peg.tests
] unit-test ] unit-test
{ CHAR: B } [ { CHAR: B } [
"B" [ drop t ] satisfy [ 66 >= ] semantic parse parse-result-ast "B" [ drop t ] satisfy [ 66 >= ] semantic parse ast>>
] unit-test ] unit-test

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

@ -1,43 +1,44 @@
! Copyright (C) 2007 Chris Double. ! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! 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 IN: peg.pl0.tests
{ t } [ { t } [
"CONST foo = 1;" "block" \ pl0 rule parse parse-result-remaining empty? "CONST foo = 1;" "block" \ pl0 rule parse remaining>> empty?
] unit-test ] unit-test
{ t } [ { t } [
"VAR foo;" "block" \ pl0 rule parse parse-result-remaining empty? "VAR foo;" "block" \ pl0 rule parse remaining>> empty?
] unit-test ] unit-test
{ t } [ { 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 ] unit-test
{ t } [ { t } [
"foo := 5" "statement" \ pl0 rule parse parse-result-remaining empty? "foo := 5" "statement" \ pl0 rule parse remaining>> empty?
] unit-test ] unit-test
{ t } [ { 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 ] unit-test
{ t } [ { 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 ] unit-test
{ t } [ { 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 ] unit-test
{ t } [ { 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 ] unit-test
{ t } [ { 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 ] unit-test
{ t } [ { t } [
@ -57,7 +58,7 @@ BEGIN
x := x + 1; x := x + 1;
END END
END. END.
"> pl0 parse-result-remaining empty? "> pl0 remaining>> empty?
] unit-test ] unit-test
{ f } [ { f } [
@ -123,5 +124,5 @@ BEGIN
y := 36; y := 36;
CALL gcd; CALL gcd;
END. END.
"> pl0 parse-result-remaining empty? "> pl0 remaining>> empty?
] unit-test ] unit-test

62
extra/peg/pl0/pl0.factor
View File

@ -7,52 +7,22 @@ IN: peg.pl0
#! Grammar for PL/0 based on http://en.wikipedia.org/wiki/PL/0 #! Grammar for PL/0 based on http://en.wikipedia.org/wiki/PL/0
EBNF: pl0 EBNF: pl0
_ = (" " | "\t" | "\n")* => [[ drop ignore ]]
BEGIN = "BEGIN" _ block = { "CONST" ident "=" number { "," ident "=" number }* ";" }?
CALL = "CALL" _ { "VAR" ident { "," ident }* ";" }?
CONST = "CONST" _ { "PROCEDURE" ident ";" { block ";" }? }* statement
DO = "DO" _ statement = { ident ":=" expression
END = "END" _ | "CALL" ident
IF = "IF" _ | "BEGIN" statement { ";" statement }* "END"
THEN = "THEN" _ | "IF" condition "THEN" statement
ODD = "ODD" _ | "WHILE" condition "DO" statement }?
PROCEDURE = "PROCEDURE" _ condition = { "ODD" expression }
VAR = "VAR" _ | { expression ("=" | "#" | "<=" | "<" | ">=" | ">") expression }
WHILE = "WHILE" _ expression = {"+" | "-"}? term { {"+" | "-"} term }*
EQ = "=" _ term = factor { {"*" | "/"} factor }*
LTEQ = "<=" _ factor = ident | number | "(" expression ")"
LT = "<" _ ident = (([a-zA-Z])+) => [[ >string ]]
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 ]]
digit = ([0-9]) => [[ digit> ]] digit = ([0-9]) => [[ digit> ]]
number = ((digit)+) _ => [[ 10 digits>integer ]] number = (digit)+ => [[ 10 digits>integer ]]
program = _ block "." program = { block "." }
;EBNF ;EBNF