peg: some cleanup.

slavapestov · Sep 2, 2015 · 2435307 · 2435307
1 parent b3de115
commit 2435307
Show file tree

Hide file tree

Showing 2 changed files with 50 additions and 84 deletions.
diff --git 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,39 +113,20 @@ C: <ebnf> 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
     #! be any non-blank character except for characters used
     #! 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 <ebnf-non-terminal> ] action ;
 
@@ -167,7 +139,7 @@ C: <ebnf> 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
@@ -313,15 +313,9 @@ SYMBOL: delayed
 
 <PRIVATE
 
-SYMBOL: id
-
 : next-id ( -- n )
     #! Return the next unique id for a parser
-    id get-global [
-        dup 1 + id set-global
-    ] [
-        1 id set-global 0
-    ] if* ;
+    \ next-id counter ;
 
 : wrap-peg ( peg -- parser )
     #! Wrap a parser tuple around the peg object.
@@ -357,8 +351,7 @@ TUPLE: satisfy-parser quot ;
         ] if
     ] if ; inline
 
-
-M: satisfy-parser (compile) ( peg -- quot )
+M: satisfy-parser (compile)
     quot>> '[ 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 <parse-result> ] %
         [
@@ -412,15 +405,15 @@ 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
             unclip , [ [ merge-errors ] compose , ] each
         ] { } 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 <parse-result> _ 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 <parse-result> _ swap (repeat) repeat1-empty-check
+M: repeat1-parser (compile)
+    parser>> compile-parser-quot '[
+        input-slice V{ } clone <parse-result> _ swap (repeat)
+        repeat1-empty-check
     ] ;
 
-TUPLE: optional-parser p1 ;
+TUPLE: optional-parser parser ;
 
 : check-optional ( result -- result )
       [ input-slice f <parse-result> ] 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 <parse-result> ] [ 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 <parse-result> ] 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,27 +490,27 @@ 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.
     quot>> gensym [ delayed get set-at ] keep 1quotation ;
 
 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!
     ] ;