Add ~ grouping operator to ignore whitespace between elements in group
parent
1c2d252ffd
commit
7319dd5165
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
@ -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 )
|
||||
[ <ebnf-optional> ] "?" syntax grouped ;
|
||||
|
||||
: 'whitespace' ( -- parser )
|
||||
[ <ebnf-whitespace> ] "~" 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 )
|
||||
|
|
Loading…
Reference in New Issue