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

peg: some cleanup.

db4
John Benediktsson 2015-09-02 13:12:14 -07:00
parent b3de115e3c
commit 2435307fb3
2 changed files with 50 additions and 84 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
basis/peg/ebnf/ebnf.factor
View File

@ -1,10 +1,10 @@
! Copyright (C) 2007 Chris Double. ! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs combinators USING: accessors assocs combinators combinators.short-circuit
combinators.short-circuit effects io.streams.string kernel make effects kernel make math.parser multiline namespaces parser peg
math.parser multiline namespaces parser peg peg.parsers peg.parsers quotations sequences sequences.deep splitting
peg.search quotations sequences sequences.deep splitting stack-checker strings stack-checker strings strings.parser summary unicode.categories
strings.parser summary unicode.categories words ; words ;
FROM: vocabs.parser => search ; FROM: vocabs.parser => search ;
FROM: peg.search => replace ; FROM: peg.search => replace ;
IN: peg.ebnf IN: peg.ebnf
@ -42,15 +42,6 @@ TUPLE: tokenizer-tuple any one many ;
: reset-tokenizer ( -- ) : reset-tokenizer ( -- )
default-tokenizer \ tokenizer set-global ; default-tokenizer \ tokenizer set-global ;
ERROR: no-tokenizer name ;
M: no-tokenizer summary
drop "Tokenizer not found" ;
SYNTAX: TOKENIZER:
scan-word-name dup search [ nip ] [ no-tokenizer ] if*
execute( -- tokenizer ) \ tokenizer set-global ;
TUPLE: ebnf-non-terminal symbol ; TUPLE: ebnf-non-terminal symbol ;
TUPLE: ebnf-terminal symbol ; TUPLE: ebnf-terminal symbol ;
TUPLE: ebnf-foreign word rule ; TUPLE: ebnf-foreign word rule ;
@ -122,11 +113,11 @@ C: <ebnf> ebnf
[ [
[ [
[ CHAR: \ = ] satisfy [ CHAR: \ = ] satisfy
[ [ CHAR: " = ] [ CHAR: \ = ] bi or ] satisfy 2seq , [ "\"\\" member? ] satisfy 2seq ,
[ CHAR: " = not ] satisfy , [ CHAR: " = not ] satisfy ,
] choice* repeat1 "\"" "\"" surrounded-by , ] choice* repeat1 "\"" "\"" surrounded-by ,
[ CHAR: ' = not ] satisfy repeat1 "'" "'" surrounded-by , [ CHAR: ' = not ] satisfy repeat1 "'" "'" surrounded-by ,
] choice* [ flatten >string unescape-string ] action ; ] choice* [ "" flatten-as unescape-string ] action ;
: non-terminal-parser ( -- parser ) : non-terminal-parser ( -- parser )
#! A non-terminal is the name of another rule. It can #! A non-terminal is the name of another rule. It can
@ -135,26 +126,7 @@ C: <ebnf> ebnf
[ [
{ {
[ blank? ] [ blank? ]
[ CHAR: " = ] [ "\"'|{}=)(][.!&*+?:~<>" member? ]
[ CHAR: ' = ]
[ CHAR: | = ]
[ CHAR: { = ]
[ CHAR: } = ]
[ CHAR: = = ]
[ CHAR: ) = ]
[ CHAR: ( = ]
[ CHAR: ] = ]
[ CHAR: [ = ]
[ CHAR: . = ]
[ CHAR: ! = ]
[ CHAR: & = ]
[ CHAR: * = ]
[ CHAR: + = ]
[ CHAR: ? = ]
[ CHAR: : = ]
[ CHAR: ~ = ]
[ CHAR: < = ]
[ CHAR: > = ]
} 1|| not } 1|| not
] satisfy repeat1 [ >string <ebnf-non-terminal> ] action ; ] satisfy repeat1 [ >string <ebnf-non-terminal> ] action ;

72
basis/peg/peg.factor
View File

@ -313,15 +313,9 @@ SYMBOL: delayed
<PRIVATE <PRIVATE
SYMBOL: id
: next-id ( -- n ) : next-id ( -- n )
#! Return the next unique id for a parser #! Return the next unique id for a parser
id get-global [ \ next-id counter ;
dup 1 + id set-global
] [
1 id set-global 0
] if* ;
: wrap-peg ( peg -- parser ) : wrap-peg ( peg -- parser )
#! Wrap a parser tuple around the peg object. #! Wrap a parser tuple around the peg object.
@ -357,8 +351,7 @@ TUPLE: satisfy-parser quot ;
] if ] if
] if ; inline ] if ; inline
M: satisfy-parser (compile)
M: satisfy-parser (compile) ( peg -- quot )
quot>> '[ input-slice _ parse-satisfy ] ; quot>> '[ input-slice _ parse-satisfy ] ;
TUPLE: range-parser min max ; TUPLE: range-parser min max ;
@ -374,7 +367,7 @@ TUPLE: range-parser min max ;
] if ] if
] if ; ] if ;
M: range-parser (compile) ( peg -- quot ) M: range-parser (compile)
[ min>> ] [ max>> ] bi '[ input-slice _ _ parse-range ] ; [ min>> ] [ max>> ] bi '[ input-slice _ _ parse-range ] ;
TUPLE: seq-parser parsers ; TUPLE: seq-parser parsers ;
@ -401,7 +394,7 @@ TUPLE: seq-parser parsers ;
2drop f 2drop f
] if ; inline ] if ; inline
M: seq-parser (compile) ( peg -- quot ) M: seq-parser (compile)
[ [
[ input-slice V{ } clone <parse-result> ] % [ input-slice V{ } clone <parse-result> ] %
[ [
@ -412,7 +405,7 @@ M: seq-parser (compile) ( peg -- quot )
TUPLE: choice-parser parsers ; TUPLE: choice-parser parsers ;
M: choice-parser (compile) ( peg -- quot ) M: choice-parser (compile)
[ [
[ [
parsers>> [ compile-parser-quot ] map parsers>> [ compile-parser-quot ] map
@ -420,7 +413,7 @@ M: choice-parser (compile) ( peg -- quot )
] { } make , \ 0|| , ] { } make , \ 0|| ,
] [ ] make ; ] [ ] make ;
TUPLE: repeat0-parser p1 ; TUPLE: repeat0-parser parser ;
: (repeat) ( quot: ( -- result ) result -- result ) : (repeat) ( quot: ( -- result ) result -- result )
over call [ over call [
@ -431,12 +424,12 @@ TUPLE: repeat0-parser p1 ;
nip nip
] if* ; inline recursive ] if* ; inline recursive
M: repeat0-parser (compile) ( peg -- quot ) M: repeat0-parser (compile)
p1>> compile-parser-quot '[ parser>> compile-parser-quot '[
input-slice V{ } clone <parse-result> _ swap (repeat) input-slice V{ } clone <parse-result> _ swap (repeat)
] ; ] ;
TUPLE: repeat1-parser p1 ; TUPLE: repeat1-parser parser ;
: repeat1-empty-check ( result -- result ) : repeat1-empty-check ( result -- result )
[ [
@ -445,20 +438,21 @@ TUPLE: repeat1-parser p1 ;
f f
] if* ; ] if* ;
M: repeat1-parser (compile) ( peg -- quot ) M: repeat1-parser (compile)
p1>> compile-parser-quot '[ parser>> compile-parser-quot '[
input-slice V{ } clone <parse-result> _ swap (repeat) repeat1-empty-check input-slice V{ } clone <parse-result> _ swap (repeat)
repeat1-empty-check
] ; ] ;
TUPLE: optional-parser p1 ; TUPLE: optional-parser parser ;
: check-optional ( result -- result ) : check-optional ( result -- result )
[ input-slice f <parse-result> ] unless* ; [ input-slice f <parse-result> ] unless* ;
M: optional-parser (compile) ( peg -- quot ) M: optional-parser (compile)
p1>> compile-parser-quot '[ @ check-optional ] ; parser>> compile-parser-quot '[ @ check-optional ] ;
TUPLE: semantic-parser p1 quot ; TUPLE: semantic-parser parser quot ;
: check-semantic ( result quot -- result ) : check-semantic ( result quot -- result )
over [ over [
@ -467,27 +461,27 @@ TUPLE: semantic-parser p1 quot ;
drop drop
] if ; inline ] if ; inline
M: semantic-parser (compile) ( peg -- quot ) M: semantic-parser (compile)
[ p1>> compile-parser-quot ] [ quot>> ] bi [ parser>> compile-parser-quot ] [ quot>> ] bi
'[ @ _ check-semantic ] ; '[ @ _ check-semantic ] ;
TUPLE: ensure-parser p1 ; TUPLE: ensure-parser parser ;
: check-ensure ( old-input result -- result ) : check-ensure ( old-input result -- result )
[ ignore <parse-result> ] [ drop f ] if ; [ ignore <parse-result> ] [ drop f ] if ;
M: ensure-parser (compile) ( peg -- quot ) M: ensure-parser (compile)
p1>> compile-parser-quot '[ input-slice @ check-ensure ] ; parser>> compile-parser-quot '[ input-slice @ check-ensure ] ;
TUPLE: ensure-not-parser p1 ; TUPLE: ensure-not-parser parser ;
: check-ensure-not ( old-input result -- result ) : check-ensure-not ( old-input result -- result )
[ drop f ] [ ignore <parse-result> ] if ; [ drop f ] [ ignore <parse-result> ] if ;
M: ensure-not-parser (compile) ( peg -- quot ) M: ensure-not-parser (compile)
p1>> compile-parser-quot '[ input-slice @ check-ensure-not ] ; parser>> compile-parser-quot '[ input-slice @ check-ensure-not ] ;
TUPLE: action-parser p1 quot ; TUPLE: action-parser parser quot ;
: check-action ( result quot -- result ) : check-action ( result quot -- result )
over [ over [
@ -496,19 +490,19 @@ TUPLE: action-parser p1 quot ;
drop drop
] if ; ] if ;
M: action-parser (compile) ( peg -- quot ) M: action-parser (compile)
[ p1>> compile-parser-quot ] [ quot>> ] bi '[ @ _ check-action ] ; [ parser>> compile-parser-quot ] [ quot>> ] bi '[ @ _ check-action ] ;
TUPLE: sp-parser p1 ; TUPLE: sp-parser parser ;
M: sp-parser (compile) ( peg -- quot ) M: sp-parser (compile)
p1>> compile-parser-quot '[ parser>> compile-parser-quot '[
input-slice [ blank? ] trim-head-slice input-from pos set @ input-slice [ blank? ] trim-head-slice input-from pos set @
] ; ] ;
TUPLE: delay-parser quot ; TUPLE: delay-parser quot ;
M: delay-parser (compile) ( peg -- quot ) M: delay-parser (compile)
#! For efficiency we memoize the quotation. #! For efficiency we memoize the quotation.
#! This way it is run only once and the #! This way it is run only once and the
#! parser constructed once at run time. #! parser constructed once at run time.
@ -516,7 +510,7 @@ M: delay-parser (compile) ( peg -- quot )
TUPLE: box-parser quot ; TUPLE: box-parser quot ;
M: box-parser (compile) ( peg -- quot ) M: box-parser (compile)
#! Calls the quotation at compile time #! Calls the quotation at compile time
#! 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