Make peg compilation infer

db4
Slava Pestov 2009-03-14 00:34:04 -05:00
parent 4302e36424
commit 7ed56a3cef
4 changed files with 15 additions and 11 deletions

View File

@ -5,7 +5,7 @@ sequences quotations vectors namespaces make math assocs
continuations peg peg.parsers unicode.categories multiline continuations peg peg.parsers unicode.categories multiline
splitting accessors effects sequences.deep peg.search splitting accessors effects sequences.deep peg.search
combinators.short-circuit lexer io.streams.string stack-checker combinators.short-circuit lexer io.streams.string stack-checker
io combinators parser ; io combinators parser call ;
IN: peg.ebnf IN: peg.ebnf
: rule ( name word -- parser ) : rule ( name word -- parser )
@ -36,7 +36,7 @@ TUPLE: tokenizer any one many ;
: TOKENIZER: : TOKENIZER:
scan search [ "Tokenizer not found" throw ] unless* scan search [ "Tokenizer not found" throw ] unless*
execute \ tokenizer set-global ; parsing execute( -- tokenizer ) \ tokenizer set-global ; parsing
TUPLE: ebnf-non-terminal symbol ; TUPLE: ebnf-non-terminal symbol ;
TUPLE: ebnf-terminal symbol ; TUPLE: ebnf-terminal symbol ;
@ -391,7 +391,7 @@ M: ebnf-choice (transform) ( ast -- parser )
options>> [ (transform) ] map choice ; options>> [ (transform) ] map choice ;
M: ebnf-any-character (transform) ( ast -- parser ) M: ebnf-any-character (transform) ( ast -- parser )
drop tokenizer any>> call ; drop tokenizer any>> call( -- parser ) ;
M: ebnf-range (transform) ( ast -- parser ) M: ebnf-range (transform) ( ast -- parser )
pattern>> range-pattern ; pattern>> range-pattern ;
@ -469,17 +469,17 @@ ERROR: bad-effect quot effect ;
M: ebnf-action (transform) ( ast -- parser ) M: ebnf-action (transform) ( ast -- parser )
[ parser>> (transform) ] [ code>> insert-escapes ] [ parser>> ] tri build-locals [ parser>> (transform) ] [ code>> insert-escapes ] [ parser>> ] tri build-locals
string-lines parse-lines check-action-effect action ; [ string-lines parse-lines ] call( string -- quot ) check-action-effect action ;
M: ebnf-semantic (transform) ( ast -- parser ) M: ebnf-semantic (transform) ( ast -- parser )
[ parser>> (transform) ] [ code>> insert-escapes ] [ parser>> ] tri build-locals [ parser>> (transform) ] [ code>> insert-escapes ] [ parser>> ] tri build-locals
string-lines parse-lines semantic ; [ string-lines parse-lines ] call( string -- quot ) semantic ;
M: ebnf-var (transform) ( ast -- parser ) M: ebnf-var (transform) ( ast -- parser )
parser>> (transform) ; parser>> (transform) ;
M: ebnf-terminal (transform) ( ast -- parser ) M: ebnf-terminal (transform) ( ast -- parser )
symbol>> tokenizer one>> call ; symbol>> tokenizer one>> call( symbol -- parser ) ;
M: ebnf-foreign (transform) ( ast -- parser ) M: ebnf-foreign (transform) ( ast -- parser )
dup word>> search dup word>> search
@ -487,7 +487,7 @@ M: ebnf-foreign (transform) ( ast -- parser )
swap rule>> [ main ] unless* over rule [ swap rule>> [ main ] unless* over rule [
nip nip
] [ ] [
execute execute( -- parser )
] if* ; ] if* ;
: parser-not-found ( name -- * ) : parser-not-found ( name -- * )

View File

@ -5,6 +5,8 @@ USING: kernel tools.test strings namespaces make arrays sequences
peg peg.private peg.parsers accessors words math accessors ; peg peg.private peg.parsers accessors words math accessors ;
IN: peg.tests IN: peg.tests
\ parse must-infer
[ ] [ reset-pegs ] unit-test [ ] [ reset-pegs ] unit-test
[ [

View File

@ -4,7 +4,7 @@ USING: kernel sequences strings fry namespaces make math assocs
io vectors arrays math.parser math.order vectors combinators io vectors arrays math.parser math.order vectors combinators
classes sets unicode.categories compiler.units parser words classes sets unicode.categories compiler.units parser words
quotations effects memoize accessors locals effects splitting quotations effects memoize accessors locals effects splitting
combinators.short-circuit generalizations ; combinators.short-circuit generalizations call ;
IN: peg IN: peg
TUPLE: parse-result remaining ast ; TUPLE: parse-result remaining ast ;
@ -298,7 +298,7 @@ SYMBOL: delayed
#! Work through all delayed parsers and recompile their #! Work through all delayed parsers and recompile their
#! words to have the correct bodies. #! words to have the correct bodies.
delayed get [ delayed get [
call compile-parser 1quotation (( -- result )) define-declared call( -- parser ) compile-parser 1quotation (( -- result )) define-declared
] assoc-each ; ] assoc-each ;
: compile ( parser -- word ) : compile ( parser -- word )
@ -309,7 +309,7 @@ SYMBOL: delayed
] with-compilation-unit ; ] with-compilation-unit ;
: compiled-parse ( state word -- result ) : compiled-parse ( state word -- result )
swap [ execute [ error-stack get first throw ] unless* ] with-packrat ; inline swap [ execute( -- result ) [ error-stack get first throw ] unless* ] with-packrat ;
: (parse) ( input parser -- result ) : (parse) ( input parser -- result )
dup word? [ compile ] unless compiled-parse ; dup word? [ compile ] unless compiled-parse ;
@ -527,7 +527,7 @@ M: box-parser (compile) ( peg -- quot )
#! to produce the parser to be compiled. #! to produce the parser to be compiled.
#! This differs from 'delay' which calls #! This differs from 'delay' which calls
#! it at run time. #! it at run time.
quot>> call compile-parser 1quotation ; quot>> call( -- parser ) compile-parser 1quotation ;
PRIVATE> PRIVATE>

View File

@ -17,3 +17,5 @@ IN: peg.search.tests
"abc 123 def 456" 'integer' [ 2 * number>string ] action replace "abc 123 def 456" 'integer' [ 2 * number>string ] action replace
] unit-test ] unit-test
\ search must-infer
\ replace must-infer