peg: some cleanup.

basis/peg/debugger/debugger.factor

@@ -13,5 +13,6 @@ M: parse-error error.
     ] tri ;
 
 M: parse-failed error.
-    "The " write dup word>> pprint " word could not parse the following input:" print nl
+    "The " write dup word>> pprint
+    " word could not parse the following input:" print nl
     input>> . ;

basis/peg/parsers/parsers.factor

@@ -1,7 +1,10 @@
 ! Copyright (C) 2007, 2008 Chris Double, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel make math math.parser math.ranges peg
+
-peg.private peg.search sequences strings unicode vectors ;
+USING: accessors kernel literals make math math.parser
+math.ranges peg peg.private peg.search sequences strings unicode
+vectors ;
+
 IN: peg.parsers
 
 TUPLE: just-parser p1 ;
@@ -31,9 +34,9 @@ M: just-parser (compile) ( parser -- quot )
 : list-of-many ( items separator -- parser )
     hide t (list-of) ;
 
-: epsilon ( -- parser ) V{ } token ;
+CONSTANT: epsilon $[ V{ } token ]
 
-: any-char ( -- parser ) [ drop t ] satisfy ;
+CONSTANT: any-char $[ [ drop t ] satisfy ]
 
 <PRIVATE
 

basis/peg/peg.factor

@@ -1,9 +1,12 @@
 ! Copyright (C) 2007, 2008 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
+
 USING: accessors arrays assocs classes combinators
 combinators.short-circuit compiler.units effects.parser fry
 generalizations kernel locals make math math.order namespaces
-quotations sequences sets splitting unicode vectors words ;
+quotations sequences sets splitting unicode vectors
+vocabs.loader words ;
+
 IN: peg
 
 TUPLE: parse-result remaining ast ;
@@ -134,8 +137,7 @@ TUPLE: peg-head rule-id involved-set eval-set ;
     swap >>ans pos get >>pos drop ;
 
 : stop-growth? ( ast m -- ? )
-    [ failed? pos get ] dip
+    [ failed? pos get ] dip pos>> <= or ;
-    pos>> <= or ;
 
 : setup-growth ( h p -- )
     pos namespaces:set dup involved-set>> clone >>eval-set drop ;
@@ -324,9 +326,7 @@ SYMBOL: delayed
     ! Wrap a parser tuple around the peg object.
     ! Look for an existing parser tuple for that
     ! peg object.
-    peg-cache [
+    peg-cache [ f next-id parser boa ] cache ;
-        f next-id parser boa
-    ] cache ;
 
 TUPLE: token-parser symbol ;
 
@@ -343,11 +343,9 @@ M: token-parser (compile) ( peg -- quot )
 
 TUPLE: satisfy-parser quot ;
 
-: parse-satisfy ( input quot -- result )
+:: parse-satisfy ( input quot -- result/f )
-    swap [
+    input [ f ] [
-        drop f
+        unclip-slice dup quot call [
-    ] [
-        unclip-slice dup roll call [
             <parse-result>
         ] [
             2drop f
@@ -359,29 +357,24 @@ M: satisfy-parser (compile)
 
 TUPLE: range-parser min max ;
 
-: parse-range ( input min max -- result )
+:: parse-range ( input min max -- result/f )
-    pick empty? [
+    input [ f ] [
-        3drop f
+        dup first min max between? [
-    ] [
-        [ dup first ] 2dip between? [
             unclip-slice <parse-result>
         ] [
             drop f
         ] if
-    ] if ;
+    ] if-empty ;
 
 M: range-parser (compile)
     [ min>> ] [ max>> ] bi '[ input-slice _ _ parse-range ] ;
 
 TUPLE: seq-parser parsers ;
 
-: ignore? ( ast -- bool )
-    ignore = ;
-
 : calc-seq-result ( prev-result current-result -- next-result )
     [
         [ remaining>> swap remaining<< ] 2keep
-        ast>> dup ignore? [
+        ast>> dup ignore = [
             drop
         ] [
             swap [ ast>> push ] keep
@@ -391,11 +384,7 @@ TUPLE: seq-parser parsers ;
     ] if* ;
 
 : parse-seq-element ( result quot -- result )
-    over [
+    '[ @ calc-seq-result ] [ f ] if* ; inline
-        call calc-seq-result
-    ] [
-        2drop f
-    ] if ; inline
 
 M: seq-parser (compile)
     [
@@ -435,11 +424,7 @@ M: repeat0-parser (compile)
 TUPLE: repeat1-parser parser ;
 
 : repeat1-empty-check ( result -- result )
-    [
+    [ dup ast>> empty? [ drop f ] when ] [ f ] if* ;
-        dup ast>> empty? [ drop f ] when
-    ] [
-        f
-    ] if* ;
 
 M: repeat1-parser (compile)
     parser>> compile-parser-quot '[
@@ -458,11 +443,7 @@ M: optional-parser (compile)
 TUPLE: semantic-parser parser quot ;
 
 : check-semantic ( result quot -- result )
-    over [
+    dupd '[ dup ast>> @ [ drop f ] unless ] when ; inline
-        over ast>> swap call [ drop f ] unless
-    ] [
-        drop
-    ] if ; inline
 
 M: semantic-parser (compile)
     [ parser>> compile-parser-quot ] [ quot>> ] bi
@@ -487,14 +468,11 @@ M: ensure-not-parser (compile)
 TUPLE: action-parser parser quot ;
 
 : check-action ( result quot -- result )
-    over [
+    dupd '[ [ _ call( ast -- ast ) ] change-ast ] when ;
-        over ast>> swap call( ast -- ast ) >>ast
-    ] [
-        drop
-    ] if ;
 
 M: action-parser (compile)
-    [ parser>> compile-parser-quot ] [ quot>> ] bi '[ @ _ check-action ] ;
+    [ parser>> compile-parser-quot ] [ quot>> ] bi
+    '[ @ _ check-action ] ;
 
 TUPLE: sp-parser parser ;
 
@@ -613,15 +591,12 @@ SYNTAX: PEG:
         [
             [
                 def call compile :> compiled-def
-                [
+                word [
                     dup compiled-def compiled-parse
                     [ ast>> ] [ word parse-failed ] ?if
-                ]
+                ] effect define-declared
-                word swap effect define-declared
             ] with-compilation-unit
         ] append!
     ] ;
 
-USE: vocabs.loader
-
 { "debugger" "peg" } "peg.debugger" require-when

basis/peg/search/search.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2006 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: combinators continuations io io.streams.string kernel
-math memoize namespaces peg sequences strings ;
+literals math namespaces peg sequences strings ;
 IN: peg.search
 
 : stream-tree-write ( object stream -- )
@@ -15,15 +15,18 @@ IN: peg.search
 : tree-write ( object -- )
     output-stream get stream-tree-write ;
 
-MEMO: any-char-parser ( -- parser )
+<PRIVATE
-    [ drop t ] satisfy ;
+
+CONSTANT: any-char-parser $[ [ drop t ] satisfy ]
+
+PRIVATE>
 
 : search ( string parser -- seq )
     any-char-parser [ drop f ] action 2choice repeat0
     [ parse sift ] [ 3drop { } ] recover ;
 
-: (replace) ( string parser -- seq )
-    any-char-parser 2choice repeat0 parse sift ;
-
 : replace ( string parser -- result )
-    [ (replace) tree-write ] with-string-writer ;
+    [
+        any-char-parser 2choice repeat0
+        parse sift tree-write
+    ] with-string-writer ;