From 7319dd5165a02a70db3ef995e48374ddbaa95247 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Tue, 29 Apr 2008 12:37:26 +1200 Subject: [PATCH 1/3] Add ~ grouping operator to ignore whitespace between elements in group --- extra/peg/ebnf/ebnf-tests.factor | 28 ++++++++++++++++++++++++++++ extra/peg/ebnf/ebnf.factor | 27 +++++++++++++++++++++++++-- 2 files changed, 53 insertions(+), 2 deletions(-) diff --git a/extra/peg/ebnf/ebnf-tests.factor b/extra/peg/ebnf/ebnf-tests.factor index 0292a88ad9..1545b175b2 100644 --- a/extra/peg/ebnf/ebnf-tests.factor +++ b/extra/peg/ebnf/ebnf-tests.factor @@ -297,3 +297,31 @@ main = Primary ] unit-test 'ebnf' compile must-infer + +{ V{ V{ "a" "b" } "c" } } [ + "abc" [EBNF a="a" "b" foo=(a "c") EBNF] call parse-result-ast +] 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 + +{ f } [ + "a b c" [EBNF a="a" "b" foo=(a "c") EBNF] call +] unit-test + +{ V{ V{ "a" "b" } "c" } } [ + "abc" [EBNF a="a" "b" foo=(a "c")~ EBNF] call parse-result-ast +] unit-test + +{ V{ V{ "a" "b" } "c" } } [ + "ab c" [EBNF a="a" "b" foo=(a "c")~ EBNF] call parse-result-ast +] unit-test + +{ f } [ + "a bc" [EBNF a="a" "b" foo=(a "c")~ EBNF] call +] unit-test diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor index 57851812ef..ac731a1628 100644 --- a/extra/peg/ebnf/ebnf.factor +++ b/extra/peg/ebnf/ebnf.factor @@ -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 C: ebnf-repeat0 C: ebnf-repeat1 C: ebnf-optional +C: ebnf-whitespace C: ebnf-rule C: ebnf-action C: ebnf-var @@ -84,6 +86,7 @@ C: ebnf [ dup CHAR: + = ] [ dup CHAR: ? = ] [ dup CHAR: : = ] + [ dup CHAR: ~ = ] } || not nip ] satisfy repeat1 [ >string ] action ; @@ -144,6 +147,7 @@ DEFER: 'choice' "*" token sp ensure-not , "+" token sp ensure-not , "?" token sp ensure-not , + "~" token sp ensure-not , ] seq* hide grouped ; : 'repeat0' ( -- parser ) @@ -155,6 +159,9 @@ DEFER: 'choice' : 'optional' ( -- parser ) [ ] "?" syntax grouped ; +: 'whitespace' ( -- parser ) + [ ] "~" syntax grouped ; + : 'factor-code' ( -- parser ) [ "]]" token ensure-not , @@ -191,6 +198,7 @@ DEFER: 'choice' 'repeat0' sp , 'repeat1' sp , 'optional' sp , + 'whitespace' sp , ] choice* ; : 'action' ( -- parser ) @@ -238,9 +246,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 +266,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 +302,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 ) From c671ccce996b131d9d78668ffa355f0a6bad4dc2 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Tue, 29 Apr 2008 14:15:05 +1200 Subject: [PATCH 2/3] { ... } whitespace grouping --- extra/peg/ebnf/ebnf-tests.factor | 65 +++++++++++++++++++++++++------- extra/peg/ebnf/ebnf.factor | 17 +++++---- extra/peg/pl0/pl0.factor | 62 ++++++++---------------------- 3 files changed, 77 insertions(+), 67 deletions(-) diff --git a/extra/peg/ebnf/ebnf-tests.factor b/extra/peg/ebnf/ebnf-tests.factor index 1545b175b2..e202360a4b 100644 --- a/extra/peg/ebnf/ebnf-tests.factor +++ b/extra/peg/ebnf/ebnf-tests.factor @@ -51,13 +51,15 @@ IN: peg.ebnf.tests 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 parse-result-ast ] unit-test { @@ -302,26 +304,63 @@ main = Primary "abc" [EBNF a="a" "b" foo=(a "c") EBNF] call parse-result-ast ] unit-test +{ V{ V{ "a" "b" } "c" } } [ + "abc" [EBNF a="a" "b" foo={a "c"} EBNF] call parse-result-ast +] unit-test + +{ V{ V{ "a" "b" } "c" } } [ + "abc" [EBNF a="a" "b" foo=a "c" EBNF] call parse-result-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 parse-result-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 - -{ V{ V{ "a" "b" } "c" } } [ - "abc" [EBNF a="a" "b" foo=(a "c")~ EBNF] call parse-result-ast -] unit-test - -{ V{ V{ "a" "b" } "c" } } [ - "ab c" [EBNF a="a" "b" foo=(a "c")~ EBNF] call parse-result-ast + "a b c" [EBNF a="a" "b" foo=a "c" EBNF] call ] unit-test { f } [ - "a bc" [EBNF a="a" "b" foo=(a "c")~ EBNF] call + "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 parse-result-ast +] unit-test + +{ V{ } } [ + "ab cab c" [EBNF a="a" "b" foo=(a "c")* EBNF] call parse-result-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 parse-result-ast +] unit-test + +{ V{ } } [ + "ab c ab c" [EBNF a="a" "b" foo=(a "c")* EBNF] call parse-result-ast +] unit-test + diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor index ac731a1628..0ee7bf515f 100644 --- a/extra/peg/ebnf/ebnf.factor +++ b/extra/peg/ebnf/ebnf.factor @@ -137,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 ] rot compose action , + ] choice* ; : 'group' ( -- parser ) #! A grouping with no suffix. Used for precedence. @@ -147,7 +153,6 @@ DEFER: 'choice' "*" token sp ensure-not , "+" token sp ensure-not , "?" token sp ensure-not , - "~" token sp ensure-not , ] seq* hide grouped ; : 'repeat0' ( -- parser ) @@ -159,9 +164,6 @@ DEFER: 'choice' : 'optional' ( -- parser ) [ ] "?" syntax grouped ; -: 'whitespace' ( -- parser ) - [ ] "~" syntax grouped ; - : 'factor-code' ( -- parser ) [ "]]" token ensure-not , @@ -198,7 +200,6 @@ DEFER: 'choice' 'repeat0' sp , 'repeat1' sp , 'optional' sp , - 'whitespace' sp , ] choice* ; : 'action' ( -- parser ) diff --git a/extra/peg/pl0/pl0.factor b/extra/peg/pl0/pl0.factor index 1b97814ca7..eff923dc01 100644 --- a/extra/peg/pl0/pl0.factor +++ b/extra/peg/pl0/pl0.factor @@ -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 From e1f82caf83e254ee8ea564daecec61d30484bd0a Mon Sep 17 00:00:00 2001 From: Chris Double Date: Tue, 29 Apr 2008 14:19:14 +1200 Subject: [PATCH 3/3] Use accessors in places for peg --- extra/peg/ebnf/ebnf-tests.factor | 107 ++++++++++++++++--------------- extra/peg/expr/expr.factor | 4 +- extra/peg/peg-tests.factor | 49 +++++++------- extra/peg/pl0/pl0-tests.factor | 25 ++++---- 4 files changed, 94 insertions(+), 91 deletions(-) diff --git a/extra/peg/ebnf/ebnf-tests.factor b/extra/peg/ebnf/ebnf-tests.factor index e202360a4b..faaa63f4bd 100644 --- a/extra/peg/ebnf/ebnf-tests.factor +++ b/extra/peg/ebnf/ebnf-tests.factor @@ -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,7 +45,7 @@ IN: peg.ebnf.tests } } } [ - "one two | three" 'choice' parse parse-result-ast + "one two | three" 'choice' parse ast>> ] unit-test { @@ -59,7 +60,7 @@ IN: peg.ebnf.tests } } } [ - "one {two | three}" 'choice' parse parse-result-ast + "one {two | three}" 'choice' parse ast>> ] unit-test { @@ -79,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 { @@ -91,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 } [ @@ -135,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 } [ @@ -147,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 } [ @@ -179,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 } [ @@ -187,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 } [ @@ -234,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 } [ @@ -279,37 +280,37 @@ 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 parse-result-ast + "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 parse-result-ast + "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 parse-result-ast + "abc" [EBNF a="a" "b" foo=a "c" EBNF] call ast>> ] unit-test { f } [ @@ -329,7 +330,7 @@ main = Primary ] unit-test { V{ V{ "a" "b" } "c" } } [ - "ab c" [EBNF a="a" "b" foo={a "c"} EBNF] call parse-result-ast + "ab c" [EBNF a="a" "b" foo={a "c"} EBNF] call ast>> ] unit-test { f } [ @@ -349,18 +350,18 @@ main = Primary ] 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 parse-result-ast + "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 parse-result-ast + "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 parse-result-ast + "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 parse-result-ast + "ab c ab c" [EBNF a="a" "b" foo=(a "c")* EBNF] call ast>> ] unit-test diff --git a/extra/peg/expr/expr.factor b/extra/peg/expr/expr.factor index e16d9db0a7..e2df60ea9a 100644 --- a/extra/peg/expr/expr.factor +++ b/extra/peg/expr/expr.factor @@ -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>> ; diff --git a/extra/peg/peg-tests.factor b/extra/peg/peg-tests.factor index fcec33f7c2..1beeb51678 100644 --- a/extra/peg/peg-tests.factor +++ b/extra/peg/peg-tests.factor @@ -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 diff --git a/extra/peg/pl0/pl0-tests.factor b/extra/peg/pl0/pl0-tests.factor index 88993c354b..e1d97bdef9 100644 --- a/extra/peg/pl0/pl0-tests.factor +++ b/extra/peg/pl0/pl0-tests.factor @@ -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 \ No newline at end of file