diff --git a/basis/peg/ebnf/ebnf.factor b/basis/peg/ebnf/ebnf.factor index d48e0649ba..784d9d507b 100644 --- a/basis/peg/ebnf/ebnf.factor +++ b/basis/peg/ebnf/ebnf.factor @@ -1,10 +1,10 @@ ! Copyright (C) 2007 Chris Double. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays assocs combinators -combinators.short-circuit effects io.streams.string kernel make -math.parser multiline namespaces parser peg peg.parsers -peg.search quotations sequences sequences.deep splitting stack-checker strings -strings.parser summary unicode.categories words ; +USING: accessors assocs combinators combinators.short-circuit +effects kernel make math.parser multiline namespaces parser peg +peg.parsers quotations sequences sequences.deep splitting +stack-checker strings strings.parser summary unicode.categories +words ; FROM: vocabs.parser => search ; FROM: peg.search => replace ; IN: peg.ebnf @@ -42,15 +42,6 @@ TUPLE: tokenizer-tuple any one many ; : reset-tokenizer ( -- ) 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-terminal symbol ; TUPLE: ebnf-foreign word rule ; @@ -122,11 +113,11 @@ C: ebnf [ [ [ CHAR: \ = ] satisfy - [ [ CHAR: " = ] [ CHAR: \ = ] bi or ] satisfy 2seq , + [ "\"\\" member? ] satisfy 2seq , [ CHAR: " = not ] satisfy , ] choice* 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 ) #! A non-terminal is the name of another rule. It can @@ -134,27 +125,8 @@ C: ebnf #! in the EBNF syntax itself. [ { - [ blank? ] - [ CHAR: " = ] - [ CHAR: ' = ] - [ CHAR: | = ] - [ CHAR: { = ] - [ CHAR: } = ] - [ CHAR: = = ] - [ CHAR: ) = ] - [ CHAR: ( = ] - [ CHAR: ] = ] - [ CHAR: [ = ] - [ CHAR: . = ] - [ CHAR: ! = ] - [ CHAR: & = ] - [ CHAR: * = ] - [ CHAR: + = ] - [ CHAR: ? = ] - [ CHAR: : = ] - [ CHAR: ~ = ] - [ CHAR: < = ] - [ CHAR: > = ] + [ blank? ] + [ "\"'|{}=)(][.!&*+?:~<>" member? ] } 1|| not ] satisfy repeat1 [ >string ] action ; @@ -167,7 +139,7 @@ C: ebnf #! Parse a valid foreign parser name [ { - [ blank? ] + [ blank? ] [ CHAR: > = ] } 1|| not ] satisfy repeat1 [ >string ] action ; diff --git a/basis/peg/peg.factor b/basis/peg/peg.factor index f08f0359f9..b822b30ad7 100644 --- a/basis/peg/peg.factor +++ b/basis/peg/peg.factor @@ -313,15 +313,9 @@ SYMBOL: delayed > '[ input-slice _ parse-satisfy ] ; TUPLE: range-parser min max ; @@ -374,7 +367,7 @@ TUPLE: range-parser min max ; ] if ] if ; -M: range-parser (compile) ( peg -- quot ) +M: range-parser (compile) [ min>> ] [ max>> ] bi '[ input-slice _ _ parse-range ] ; TUPLE: seq-parser parsers ; @@ -401,7 +394,7 @@ TUPLE: seq-parser parsers ; 2drop f ] if ; inline -M: seq-parser (compile) ( peg -- quot ) +M: seq-parser (compile) [ [ input-slice V{ } clone ] % [ @@ -412,7 +405,7 @@ M: seq-parser (compile) ( peg -- quot ) TUPLE: choice-parser parsers ; -M: choice-parser (compile) ( peg -- quot ) +M: choice-parser (compile) [ [ parsers>> [ compile-parser-quot ] map @@ -420,7 +413,7 @@ M: choice-parser (compile) ( peg -- quot ) ] { } make , \ 0|| , ] [ ] make ; -TUPLE: repeat0-parser p1 ; +TUPLE: repeat0-parser parser ; : (repeat) ( quot: ( -- result ) result -- result ) over call [ @@ -431,12 +424,12 @@ TUPLE: repeat0-parser p1 ; nip ] if* ; inline recursive -M: repeat0-parser (compile) ( peg -- quot ) - p1>> compile-parser-quot '[ +M: repeat0-parser (compile) + parser>> compile-parser-quot '[ input-slice V{ } clone _ swap (repeat) ] ; -TUPLE: repeat1-parser p1 ; +TUPLE: repeat1-parser parser ; : repeat1-empty-check ( result -- result ) [ @@ -445,20 +438,21 @@ TUPLE: repeat1-parser p1 ; f ] if* ; -M: repeat1-parser (compile) ( peg -- quot ) - p1>> compile-parser-quot '[ - input-slice V{ } clone _ swap (repeat) repeat1-empty-check +M: repeat1-parser (compile) + parser>> compile-parser-quot '[ + input-slice V{ } clone _ swap (repeat) + repeat1-empty-check ] ; -TUPLE: optional-parser p1 ; +TUPLE: optional-parser parser ; : check-optional ( result -- result ) [ input-slice f ] unless* ; -M: optional-parser (compile) ( peg -- quot ) - p1>> compile-parser-quot '[ @ check-optional ] ; +M: optional-parser (compile) + parser>> compile-parser-quot '[ @ check-optional ] ; -TUPLE: semantic-parser p1 quot ; +TUPLE: semantic-parser parser quot ; : check-semantic ( result quot -- result ) over [ @@ -467,27 +461,27 @@ TUPLE: semantic-parser p1 quot ; drop ] if ; inline -M: semantic-parser (compile) ( peg -- quot ) - [ p1>> compile-parser-quot ] [ quot>> ] bi +M: semantic-parser (compile) + [ parser>> compile-parser-quot ] [ quot>> ] bi '[ @ _ check-semantic ] ; -TUPLE: ensure-parser p1 ; +TUPLE: ensure-parser parser ; : check-ensure ( old-input result -- result ) [ ignore ] [ drop f ] if ; -M: ensure-parser (compile) ( peg -- quot ) - p1>> compile-parser-quot '[ input-slice @ check-ensure ] ; +M: ensure-parser (compile) + 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 ) [ drop f ] [ ignore ] if ; -M: ensure-not-parser (compile) ( peg -- quot ) - p1>> compile-parser-quot '[ input-slice @ check-ensure-not ] ; +M: ensure-not-parser (compile) + parser>> compile-parser-quot '[ input-slice @ check-ensure-not ] ; -TUPLE: action-parser p1 quot ; +TUPLE: action-parser parser quot ; : check-action ( result quot -- result ) over [ @@ -496,19 +490,19 @@ TUPLE: action-parser p1 quot ; drop ] if ; -M: action-parser (compile) ( peg -- quot ) - [ p1>> compile-parser-quot ] [ quot>> ] bi '[ @ _ check-action ] ; +M: action-parser (compile) + [ parser>> compile-parser-quot ] [ quot>> ] bi '[ @ _ check-action ] ; -TUPLE: sp-parser p1 ; +TUPLE: sp-parser parser ; -M: sp-parser (compile) ( peg -- quot ) - p1>> compile-parser-quot '[ +M: sp-parser (compile) + parser>> compile-parser-quot '[ input-slice [ blank? ] trim-head-slice input-from pos set @ ] ; TUPLE: delay-parser quot ; -M: delay-parser (compile) ( peg -- quot ) +M: delay-parser (compile) #! For efficiency we memoize the quotation. #! This way it is run only once and the #! parser constructed once at run time. @@ -516,7 +510,7 @@ M: delay-parser (compile) ( peg -- quot ) TUPLE: box-parser quot ; -M: box-parser (compile) ( peg -- quot ) +M: box-parser (compile) #! Calls the quotation at compile time #! to produce the parser to be compiled. #! This differs from 'delay' which calls @@ -614,14 +608,14 @@ SYNTAX: PEG: [let (:) :> ( word def effect ) [ - [ - def call compile :> compiled-def [ - dup compiled-def compiled-parse - [ ast>> ] [ word parse-failed ] ?if - ] - word swap effect define-declared - ] with-compilation-unit + def call compile :> compiled-def + [ + dup compiled-def compiled-parse + [ ast>> ] [ word parse-failed ] ?if + ] + word swap effect define-declared + ] with-compilation-unit ] append! ] ;