Refactor semantic peg parser

db4
Chris Double 2008-04-05 18:19:11 +13:00
parent 3123654a84
commit 796981e192
1 changed files with 8 additions and 10 deletions

View File

@ -392,18 +392,16 @@ MATCH-VARS: ?quot ;
MATCH-VARS: ?parser ; MATCH-VARS: ?parser ;
: semantic-pattern ( -- quot ) : check-semantic ( result quot -- result )
[ over [
?parser [ over ast>> swap call [ drop f ] unless
dup parse-result-ast ?quot call [ drop f ] unless ] [
] [ drop
f ] if ; inline
] if*
] ;
M: semantic-parser (compile) ( parser -- quot ) M: semantic-parser (compile) ( parser -- quot )
[ p1>> compiled-parser ] [ quot>> ] bi [ p1>> compiled-parser 1quotation ] [ quot>> ] bi
2array { ?parser ?quot } semantic-pattern match-replace ; '[ @ , check-semantic ] ;
TUPLE: ensure-parser p1 ; TUPLE: ensure-parser p1 ;