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 )