Fix peg.ebnf unit test failures
parent
0841dbb4ad
commit
f4f4ea7eb6
|
@ -49,6 +49,10 @@ C: <ebnf-var> ebnf-var
|
||||||
C: <ebnf-semantic> ebnf-semantic
|
C: <ebnf-semantic> ebnf-semantic
|
||||||
C: <ebnf> ebnf
|
C: <ebnf> ebnf
|
||||||
|
|
||||||
|
: filter-hidden ( seq -- seq )
|
||||||
|
#! Remove elements that produce no AST from sequence
|
||||||
|
[ ebnf-ensure-not? not ] filter [ ebnf-ensure? not ] filter ;
|
||||||
|
|
||||||
: syntax ( string -- parser )
|
: syntax ( string -- parser )
|
||||||
#! Parses the string, ignoring white space, and
|
#! Parses the string, ignoring white space, and
|
||||||
#! does not put the result in the AST.
|
#! does not put the result in the AST.
|
||||||
|
@ -140,12 +144,18 @@ C: <ebnf> ebnf
|
||||||
#! The latter indicates that it is the beginning of a
|
#! The latter indicates that it is the beginning of a
|
||||||
#! new rule.
|
#! new rule.
|
||||||
[
|
[
|
||||||
[
|
[
|
||||||
'non-terminal' ,
|
[
|
||||||
'terminal' ,
|
'non-terminal' ,
|
||||||
'foreign' ,
|
'terminal' ,
|
||||||
'range-parser' ,
|
'foreign' ,
|
||||||
'any-character' ,
|
'range-parser' ,
|
||||||
|
'any-character' ,
|
||||||
|
] choice*
|
||||||
|
[ dup , "*" token hide , ] seq* [ first <ebnf-repeat0> ] action ,
|
||||||
|
[ dup , "+" token hide , ] seq* [ first <ebnf-repeat1> ] action ,
|
||||||
|
[ dup , "?[" token ensure-not , "?" token hide , ] seq* [ first <ebnf-optional> ] action ,
|
||||||
|
,
|
||||||
] choice* ,
|
] choice* ,
|
||||||
[
|
[
|
||||||
"=" syntax ensure-not ,
|
"=" syntax ensure-not ,
|
||||||
|
@ -153,6 +163,8 @@ C: <ebnf> ebnf
|
||||||
] choice* ,
|
] choice* ,
|
||||||
] seq* [ first ] action ;
|
] seq* [ first ] action ;
|
||||||
|
|
||||||
|
DEFER: 'action'
|
||||||
|
|
||||||
: 'element' ( -- parser )
|
: 'element' ( -- parser )
|
||||||
[
|
[
|
||||||
[ ('element') , ":" syntax , "a-zA-Z" range-pattern repeat1 [ >string ] action , ] seq* [ first2 <ebnf-var> ] action ,
|
[ ('element') , ":" syntax , "a-zA-Z" range-pattern repeat1 [ >string ] action , ] seq* [ first2 <ebnf-var> ] action ,
|
||||||
|
@ -256,7 +268,7 @@ DEFER: 'choice'
|
||||||
] choice* ;
|
] choice* ;
|
||||||
|
|
||||||
: 'choice' ( -- parser )
|
: 'choice' ( -- parser )
|
||||||
'actioned-sequence' sp "|" token sp list-of [
|
'actioned-sequence' sp repeat1 [ dup length 1 = [ first ] [ <ebnf-sequence> ] if ] action "|" token sp list-of [
|
||||||
dup length 1 = [ first ] [ <ebnf-choice> ] if
|
dup length 1 = [ first ] [ <ebnf-choice> ] if
|
||||||
] action ;
|
] action ;
|
||||||
|
|
||||||
|
@ -337,23 +349,29 @@ M: ebnf-whitespace (transform) ( ast -- parser )
|
||||||
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 )
|
||||||
elements>> dup [ ebnf-var? ] filter empty? [
|
#! Note the need to filter out this ebnf items that
|
||||||
drop
|
#! leave nothing in the AST
|
||||||
] [
|
elements>> filter-hidden dup length 1 = [
|
||||||
[
|
first build-locals
|
||||||
"USING: locals sequences ; [let* | " %
|
] [
|
||||||
dup length swap [
|
dup [ ebnf-var? ] filter empty? [
|
||||||
dup ebnf-var? [
|
drop
|
||||||
name>> %
|
] [
|
||||||
" [ " % # " over nth ] " %
|
[
|
||||||
] [
|
"USING: locals sequences ; [let* | " %
|
||||||
2drop
|
dup length swap [
|
||||||
] if
|
dup ebnf-var? [
|
||||||
] 2each
|
name>> %
|
||||||
" | " %
|
" [ " % # " over nth ] " %
|
||||||
%
|
] [
|
||||||
" nip ]" %
|
2drop
|
||||||
] "" make
|
] if
|
||||||
|
] 2each
|
||||||
|
" | " %
|
||||||
|
%
|
||||||
|
" nip ]" %
|
||||||
|
] "" make
|
||||||
|
] if
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
M: ebnf-var build-locals ( code ast -- )
|
M: ebnf-var build-locals ( code ast -- )
|
||||||
|
@ -381,7 +399,7 @@ M: object build-locals ( code ast -- )
|
||||||
} cond ;
|
} cond ;
|
||||||
|
|
||||||
M: ebnf-action (transform) ( ast -- parser )
|
M: ebnf-action (transform) ( ast -- parser )
|
||||||
[ parser>> (transform) ] [ code>> ] [ parser>> ] tri build-locals
|
[ parser>> (transform) ] [ code>> ] [ parser>> ] tri build-locals
|
||||||
string-lines parse-lines check-action-effect action ;
|
string-lines parse-lines check-action-effect action ;
|
||||||
|
|
||||||
M: ebnf-semantic (transform) ( ast -- parser )
|
M: ebnf-semantic (transform) ( ast -- parser )
|
||||||
|
|
Loading…
Reference in New Issue