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

Fix peg.ebnf unit test failures

db4
Chris Double 2008-06-18 17:34:21 +12:00
parent 0841dbb4ad
commit f4f4ea7eb6
1 changed files with 43 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -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 )