Delete empty unit tests files, remove 1- and 1+, reorder IN: lines in a lot of places...

[factor.git] / basis / peg / parsers / parsers.factor

diff --git a/basis/peg/parsers/parsers.factor b/basis/peg/parsers/parsers.factor
old mode 100755 (executable)
new mode 100644 (file)
index 6342deb..850b585
--- a/basis/peg/parsers/parsers.factor
+++ b/basis/peg/parsers/parsers.factor
@@ -1,23 +1,22 @@
 ! Copyright (C) 2007, 2008 Chris Double, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences strings namespaces math assocs shuffle 
-     vectors arrays math.parser accessors
-     unicode.categories sequences.deep peg peg.private 
-     peg.search math.ranges words ;
+USING: kernel sequences strings namespaces make math assocs
+vectors arrays math.parser accessors unicode.categories
+sequences.deep peg peg.private peg.search math.ranges words ;
 IN: peg.parsers
 
 TUPLE: just-parser p1 ;
 
-: just-pattern
+CONSTANT: just-pattern
   [
-    execute dup [
+    dup [
       dup remaining>> empty? [ drop f ] unless
     ] when
-  ] ;
+  ]
 
 
 M: just-parser (compile) ( parser -- quot )
-  just-parser-p1 compile-parser just-pattern curry ;
+  p1>> compile-parser-quot just-pattern compose ;
 
 : just ( parser -- parser )
   just-parser boa wrap-peg ;
@@ -25,7 +24,7 @@ M: just-parser (compile) ( parser -- quot )
 : 1token ( ch -- parser ) 1string token ;
 
 : (list-of) ( items separator repeat1? -- parser )
-  >r over 2seq r> [ repeat1 ] [ repeat0 ] if [ concat ] action 2seq
+  [ over 2seq ] dip [ repeat1 ] [ repeat0 ] if [ concat ] action 2seq
   [ unclip 1vector swap first append ] action ;
 
 : list-of ( items separator -- parser )
@@ -52,8 +51,7 @@ PRIVATE>
   dup zero? [
     2drop epsilon
   ] [
-    2dup exactly-n
-    -rot 1- at-most-n 2choice
+    [ exactly-n ] [ 1 - at-most-n ] 2bi 2choice
   ] if ;
 
 : at-least-n ( parser n -- parser' )
@@ -61,11 +59,11 @@ PRIVATE>
   [ flatten-vectors ] action ;
 
 : from-m-to-n ( parser m n -- parser' )
-  >r [ exactly-n ] 2keep r> swap - at-most-n 2seq
+  [ [ exactly-n ] 2keep ] dip swap - at-most-n 2seq
   [ flatten-vectors ] action ;
 
 : pack ( begin body end -- parser )
-  >r >r hide r> r> hide 3seq [ first ] action ;
+  [ hide ] 2dip hide 3seq [ first ] action ;
 
 : surrounded-by ( parser begin end -- parser' )
   [ token ] bi@ swapd pack ;