Refactor semantic peg parser
parent
3123654a84
commit
796981e192
|
@ -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 ;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue