Declare stack effects for compiled parsers

db4
Chris Double 2008-03-30 23:24:02 +13:00
parent 78633e03a0
commit bb8198d3d0
2 changed files with 6 additions and 6 deletions

View File

@ -3,7 +3,7 @@
USING: kernel compiler.units parser words arrays strings math.parser sequences USING: kernel compiler.units parser words arrays strings math.parser sequences
quotations vectors namespaces math assocs continuations peg quotations vectors namespaces math assocs continuations peg
peg.parsers unicode.categories multiline combinators.lib peg.parsers unicode.categories multiline combinators.lib
splitting accessors ; splitting accessors effects ;
IN: peg.ebnf IN: peg.ebnf
TUPLE: ebnf-non-terminal symbol ; TUPLE: ebnf-non-terminal symbol ;
@ -310,5 +310,5 @@ M: ebnf-non-terminal (transform) ( ast -- parser )
: EBNF: : EBNF:
CREATE-WORD dup CREATE-WORD dup
";EBNF" parse-multiline-string ";EBNF" parse-multiline-string
ebnf>quot swapd define "ebnf-parser" set-word-prop ; parsing ebnf>quot swapd 1 1 <effect> define-declared "ebnf-parser" set-word-prop ; parsing

View File

@ -3,7 +3,7 @@
USING: kernel sequences strings namespaces math assocs shuffle USING: kernel sequences strings namespaces math assocs shuffle
vectors arrays combinators.lib math.parser match vectors arrays combinators.lib math.parser match
unicode.categories sequences.lib compiler.units parser unicode.categories sequences.lib compiler.units parser
words quotations effects memoize accessors locals ; words quotations effects memoize accessors locals effects ;
IN: peg IN: peg
USE: prettyprint USE: prettyprint
@ -206,7 +206,7 @@ GENERIC: (compile) ( parser -- quot )
:: parser-body ( parser -- quot ) :: parser-body ( parser -- quot )
#! Return the body of the word that is the compiled version #! Return the body of the word that is the compiled version
#! of the parser. #! of the parser.
[let* | rule [ parser (compile) define-temp dup parser "peg" set-word-prop ] [let* | rule [ gensym dup parser (compile) 0 1 <effect> define-declared dup parser "peg" set-word-prop ]
| |
[ [
rule pos get apply-rule dup fail = [ rule pos get apply-rule dup fail = [
@ -227,7 +227,7 @@ GENERIC: (compile) ( parser -- quot )
dup compiled>> [ dup compiled>> [
nip nip
] [ ] [
gensym tuck >>compiled 2dup parser-body define dupd "peg" set-word-prop gensym tuck >>compiled 2dup parser-body 0 1 <effect> define-declared dupd "peg" set-word-prop
] if* ; ] if* ;
: compile ( parser -- word ) : compile ( parser -- word )