parser-combinators: make lazy where needed and fix tests

diff --git a/contrib/parser-combinators/load.factor b/contrib/parser-combinators/load.factor
index ffd019198a39c8ef2e986f7f41d63dad1f22fa60..6da97308092ea6e1e951076cec6d151fb20a42bb 100644 (file)
--- a/contrib/parser-combinators/load.factor
+++ b/contrib/parser-combinators/load.factor
@@ -1,4 +1,4 @@
-REQUIRES: contrib/lazy-lists ;
+REQUIRES: contrib/lazy-lists contrib/sequences ;
 PROVIDE: contrib/parser-combinators { 
     "parser-combinators.factor"
 } {

diff --git a/contrib/parser-combinators/parser-combinators.factor b/contrib/parser-combinators/parser-combinators.factor
index 916c1f3fa2c89482e51553cab269e08308a44007..67523b094cd6fcbb11a5b7f88e681d471e74038b 100644 (file)
--- a/contrib/parser-combinators/parser-combinators.factor
+++ b/contrib/parser-combinators/parser-combinators.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2004 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
 !
-USING: lazy-lists kernel sequences strings math io arrays errors namespaces ;
+USING: lazy-lists kernel sequences sequences-contrib strings math io arrays errors namespaces ;
 IN: parser-combinators
 
 ! Parser combinator protocol
@@ -10,24 +10,13 @@ GENERIC: (parse) ( input parser -- list )
 M: promise (parse) ( input parser -- list )
   force (parse) ;
 
-: parse ( input parser -- promise )
-  [ (parse) ] promise-with2 ;
+LAZY: parse ( input parser -- promise )
+  (parse) ;
 
 TUPLE: parse-result parsed unparsed ;
-
-: ?head-slice ( seq begin -- newseq ? )
-  2dup head? [ length tail-slice t ] [ drop f ] if ;
-
-: unclip-slice ( seq -- rest first )
-  dup 1 tail-slice swap first ;
-
-: h:t ( object -- head tail )
-  #! Return the head and tail of the object.
-  dup empty? [ dup first swap 1 tail ] unless ;
-
 TUPLE: token-parser string ;
 
-: token ( string -- parser )
+LAZY: token ( string -- parser )
   <token-parser> ;
 
 M: token-parser (parse) ( input parser -- list )
@@ -39,7 +28,7 @@ M: token-parser (parse) ( input parser -- list )
 
 TUPLE: satisfy-parser quot ;
 
-: satisfy ( quot -- parser )
+LAZY: satisfy ( quot -- parser )
   <satisfy-parser> ;
 
 M: satisfy-parser (parse) ( input parser -- list )
@@ -54,7 +43,7 @@ M: satisfy-parser (parse) ( input parser -- list )
 
 TUPLE: epsilon-parser ;
 
-: epsilon ( -- list )
+LAZY: epsilon ( -- parser )
   <epsilon-parser> ;
 
 M: epsilon-parser (parse) ( input parser -- list )
@@ -66,7 +55,7 @@ M: epsilon-parser (parse) ( input parser -- list )
 
 TUPLE: succeed-parser result ;
 
-: succeed ( result -- parser )
+LAZY: succeed ( result -- parser )
   <succeed-parser> ;
 
 M: succeed-parser (parse) ( input parser -- list )
@@ -76,7 +65,7 @@ M: succeed-parser (parse) ( input parser -- list )
 
 TUPLE: fail-parser ;
 
-: fail ( -- parser )
+LAZY: fail ( -- parser )
   <fail-parser> ;
 
 M: fail-parser (parse) ( input parser -- list )
@@ -86,7 +75,7 @@ M: fail-parser (parse) ( input parser -- list )
 
 TUPLE: and-parser p1 p2 ;
 
-: <&> ( parser1 parser2 -- parser )
+LAZY: <&> ( parser1 parser2 -- parser )
   <and-parser> ;
 
 M: and-parser (parse) ( input parser -- list )
@@ -105,7 +94,7 @@ M: and-parser (parse) ( input parser -- list )
 
 TUPLE: or-parser p1 p2 ;
 
-: <|> ( parser1 parser2 -- parser )
+LAZY: <|> ( parser1 parser2 -- parser )
   <or-parser> ;
 
 M: or-parser (parse) ( input parser1 -- list )
@@ -114,14 +103,14 @@ M: or-parser (parse) ( input parser1 -- list )
   #! input. This implements the choice parsing operator.
   [ or-parser-p1 ] keep or-parser-p2 >r dupd parse swap r> parse lappend ;
 
-: string-ltrim ( string -- string )
+: ltrim-slice ( string -- string )
   #! Return a new string without any leading whitespace
   #! from the original string.
-  dup first blank? [ 1 tail-slice string-ltrim ] when ;
+  dup first blank? [ 1 tail-slice ltrim-slice ] when ;
 
 TUPLE: sp-parser p1 ;
 
-: sp ( p1 -- parser )
+LAZY: sp ( p1 -- parser )
   #! Return a parser that first skips all whitespace before
   #! calling the original parser.
   <sp-parser> ;
@@ -129,11 +118,11 @@ TUPLE: sp-parser p1 ;
 M: sp-parser (parse) ( input parser -- list )
   #! Skip all leading whitespace from the input then call
   #! the parser on the remaining input.
-  >r string-ltrim r> sp-parser-p1 parse ;
+  >r ltrim-slice r> sp-parser-p1 parse ;
 
 TUPLE: just-parser p1 ;
 
-: just ( p1 -- parser )
+LAZY: just ( p1 -- parser )
   <just-parser> ;
 
 M: just-parser (parse) ( input parser -- result )
@@ -145,7 +134,7 @@ M: just-parser (parse) ( input parser -- result )
 
 TUPLE: apply-parser p1 quot ;
 
-: <@ ( parser quot -- parser )
+LAZY: <@ ( parser quot -- parser )
   <apply-parser> ;
 
 M: apply-parser (parse) ( input parser -- result )
@@ -162,7 +151,7 @@ M: apply-parser (parse) ( input parser -- result )
 
 TUPLE: some-parser p1 ;
 
-: some ( p1 -- parser )
+LAZY: some ( p1 -- parser )
   <some-parser> ;
 
 M: some-parser (parse) ( input parser -- result )
@@ -173,31 +162,31 @@ M: some-parser (parse) ( input parser -- result )
   some-parser-p1 just parse car parse-result-parsed ;
 
 
-: <& ( parser1 parser2 -- parser )
+LAZY: <& ( parser1 parser2 -- parser )
   #! Same as <&> except discard the results of the second parser.
   <&> [ first ] <@ ;
 
-: &> ( parser1 parser2 -- parser )
+LAZY: &> ( parser1 parser2 -- parser )
   #! Same as <&> except discard the results of the first parser.
   <&> [ second ] <@ ;
 
-: <:&> ( parser1 parser2 -- result )
+LAZY: <:&> ( parser1 parser2 -- result )
   #! Same as <&> except flatten the result.
   <&> [ dup second swap first [ % , ] { } make ] <@ ;
 
-: <&:> ( parser1 parser2 -- result )
+LAZY: <&:> ( parser1 parser2 -- result )
   #! Same as <&> except flatten the result.
   <&> [ dup second swap first [ , % ] { } make ] <@ ;
 
-: <*> ( parser -- parser )
-  [ dup <*> <&:> { } succeed <|> ] promise-with ;
+LAZY: <*> ( parser -- parser )
+  dup <*> <&:> { } succeed <|> ;
 
-: <+> ( parser -- parser )
+LAZY: <+> ( parser -- parser )
   #! Return a parser that accepts one or more occurences of the original
   #! parser.
   dup <*> <&:> ;
 
-: <?> ( parser -- parser )
+LAZY: <?> ( parser -- parser )
   #! Return a parser that optionally uses the parser
   #! if that parser would be successfull.
-  [ 1array ] <@ f succeed <|> ;
+  [ 1array ] <@ f succeed <|> ;
\ No newline at end of file

diff --git a/contrib/parser-combinators/tests.factor b/contrib/parser-combinators/tests.factor
index 9bb7db994ecabb342006a058cf4615a7b1845869..74b67370ecbe01cbca2cdfebf79e214eda0ca5f1 100644 (file)
--- a/contrib/parser-combinators/tests.factor
+++ b/contrib/parser-combinators/tests.factor
@@ -5,147 +5,147 @@ USING: kernel lazy-lists test errors strings parser math sequences parser-combin
 IN: scratchpad
 
 ! Testing <&>
-[ { T{ parse-result f { "a" "b" } T{ slice f "abcd" 2 4 } } }  ] [
+{ { T{ parse-result f { "a" "b" } T{ slice f "abcd" 2 4 } } }  } [
   "abcd" "a" token "b" token <&> parse list>array
 ] unit-test
 
-[ { T{ parse-result f { { "a" "b" } "c" } T{ slice f "abcd" 3 4 } } } ] [
+{ { T{ parse-result f { { "a" "b" } "c" } T{ slice f "abcd" 3 4 } } } } [
   "abcd" "a" token "b" token <&> "c" token <&> parse list>array
 ] unit-test
 
-[ { T{ parse-result f { "a" { "b" "c" } } T{ slice f "abcd" 3 4 }  } } ] [
+{ { T{ parse-result f { "a" { "b" "c" } } T{ slice f "abcd" 3 4 }  } } } [
   "abcd" "a" token "b" token "c" token <&> <&> parse list>array
 ] unit-test
 
-[ { } ] [
+{ { } } [
   "decd" "a" token "b" token <&> parse list>array
 ] unit-test
 
-[ { } ] [
+{ { } } [
   "dbcd" "a" token "b" token <&> parse list>array
 ] unit-test
 
-[ { } ] [
+{ { } } [
   "adcd" "a" token "b" token <&> parse list>array
 ] unit-test
 
 ! Testing <|>
-[ { T{ parse-result f "a" T{ slice f "abcd" 1 4 } } } ] [
+{ { T{ parse-result f "a" T{ slice f "abcd" 1 4 } } } } [
   "abcd" "a" token "b" token <|> parse list>array
 ] unit-test
 
-[ { T{ parse-result f "b" T{ slice f "bbcd" 1 4 } } }  ] [
+{ { T{ parse-result f "b" T{ slice f "bbcd" 1 4 } } }  } [
   "bbcd" "a" token "b" token <|> parse list>array
 ] unit-test
 
-[ { } ] [
+{ { } } [
   "cbcd" "a" token "b" token <|> parse list>array
 ] unit-test
 
 ! Testing sp
-[ { } ] [
+{ { } } [
   "  abcd" "a" token parse list>array 
 ] unit-test
 
-[ { T{ parse-result f "a" T{ slice f "  abcd" 3 6 } } }  ] [
+{ { T{ parse-result f "a" T{ slice f "  abcd" 3 6 } } }  } [
   "  abcd" "a" token sp parse list>array 
 ] unit-test
 
 ! Testing just
-[ { T{ parse-result f "abcd" T{ slice f "abcd" 4 4 } } T{ parse-result f "abc" T{ slice f "abcd" 3 4 } } } ] [
+{ { T{ parse-result f "abcd" T{ slice f "abcd" 4 4 } } T{ parse-result f "abc" T{ slice f "abcd" 3 4 } } } } [
   "abcd" "abcd" token "abc" token <|> parse list>array
 ] unit-test
 
-[ { T{ parse-result f "abcd" T{ slice f "abcd" 4 4 } } } ] [
+{ { T{ parse-result f "abcd" T{ slice f "abcd" 4 4 } } } } [
   "abcd" "abcd" token "abc" token <|> just parse list>array
 ] unit-test 
 
 ! Testing <@
-[ { T{ parse-result f 48 T{ slice f "01234" 1 5 } } } ] [
+{ { T{ parse-result f 48 T{ slice f "01234" 1 5 } } } } [
   "01234" [ digit? ] satisfy parse list>array 
 ] unit-test
 
-[ { T{ parse-result f 0 T{ slice f "01234" 1 5 } } } ] [
+{ { T{ parse-result f 0 T{ slice f "01234" 1 5 } } } } [
   "01234" [ digit? ] satisfy [ digit> ] <@ parse list>array 
 ] unit-test
 
 ! Testing some
-[ { T{ parse-result f "begin" T{ slice f "begin1" 5 6 } } } ] [
+{ { T{ parse-result f "begin" T{ slice f "begin1" 5 6 } } } } [
   "begin1" "begin" token parse list>array
 ] unit-test
 
 [
-  "begin1" "begin" token some parse 
+  "begin1" "begin" token some parse force
 ] unit-test-fails 
 
-[ "begin" ] [
-  "begin" "begin" token some parse 
+{ "begin" } [
+  "begin" "begin" token some parse force
 ] unit-test
 
 ! <& parser and &> parser
-[ { T{ parse-result f { "a" "b" } T{ slice f "abcd" 2 4 } } } ] [
+{ { T{ parse-result f { "a" "b" } T{ slice f "abcd" 2 4 } } } } [
   "abcd" "a" token "b" token <&> parse list>array
 ] unit-test
 
-[ { T{ parse-result f "a" T{ slice f "abcd" 2 4 } } } ] [
+{ { T{ parse-result f "a" T{ slice f "abcd" 2 4 } } } } [
   "abcd" "a" token "b" token <& parse list>array
 ] unit-test
 
-[ { T{ parse-result f "b" T{ slice f "abcd" 2 4 } } } ] [
+{ { T{ parse-result f "b" T{ slice f "abcd" 2 4 } } } } [
   "abcd" "a" token "b" token &> parse list>array
 ] unit-test
 
 ! Testing <*> and <:&>
-[ { T{ parse-result f { "1" } T{ slice f "1234" 1 4 } } T{ parse-result f [ ] "1234" } } } ] [
+{ { T{ parse-result f { "1" } T{ slice f "1234" 1 4 } } T{ parse-result f { } "1234" } } } [
   "1234" "1" token <*> parse list>array
 ] unit-test
 
-[ 
+{ 
   {
-    T{ parse-result f { "1" "1" "1" "1" } "234" }
-    T{ parse-result f { "1" "1" "1" } "1234" }
-    T{ parse-result f { "1" "1" } "11234" }
-    T{ parse-result f { "1" } "111234" }
-    T{ parse-result f [ ] "1111234" }
+    T{ parse-result f { "1" "1" "1" "1" } T{ slice f "1111234" 4 7 }  }
+    T{ parse-result f { "1" "1" "1" } T{ slice f "1111234" 3 7 } }
+    T{ parse-result f { "1" "1" } T{ slice f "1111234" 2 7 } }
+    T{ parse-result f { "1" } T{ slice f "1111234" 1 7 } }
+    T{ parse-result f { } "1111234" }
   }
 
-] [
+} [
   "1111234" "1" token <*> parse list>array
 ] unit-test
 
-[ 
+{ 
   {
-    T{ parse-result f { "1111" } "234" }
-    T{ parse-result f { "111" } "1234" }
-    T{ parse-result f { "11" } "11234" }
-    T{ parse-result f { "1" } "111234" }
-    T{ parse-result f { [ ] } "1111234" }
+    T{ parse-result f { "1111" } T{ slice f "1111234" 4 7 } }
+    T{ parse-result f { "111" } T{ slice f "1111234" 3 7 } }
+    T{ parse-result f { "11" } T{ slice f "1111234" 2 7 } }
+    T{ parse-result f { "1" } T{ slice f "1111234" 1 7 } }
+    T{ parse-result f { { } } "1111234" }
   }
-] [
+} [
   "1111234" "1" token <*> [ concat 1array ] <@ parse list>array
 ] unit-test
 
-[ { T{ parse-result f [ ] "234" } } ] [
+{ { T{ parse-result f { } "234" } } } [
   "234" "1" token <*> parse list>array
 ] unit-test
 
 ! Testing <+>
-[ { T{ parse-result f { "1" } "234" } } ] [
+{ { T{ parse-result f { "1" } T{ slice f "1234" 1 4 } } } } [
   "1234" "1" token <+> parse list>array
 ] unit-test
 
-[ 
+{ 
   {
-    T{ parse-result f { "1" "1" "1" "1" } "234" }
-    T{ parse-result f { "1" "1" "1" } "1234" }
-    T{ parse-result f { "1" "1" } "11234" }
-    T{ parse-result f { "1" } "111234" }
+    T{ parse-result f { "1" "1" "1" "1" } T{ slice f "1111234" 4 7 } }
+    T{ parse-result f { "1" "1" "1" }  T{ slice f "1111234" 3 7 } }
+    T{ parse-result f { "1" "1" }  T{ slice f "1111234" 2 7 } }
+    T{ parse-result f { "1" } T{ slice f "1111234" 1 7 } }
   }
-] [
+} [
   "1111234" "1" token <+> parse list>array
 ] unit-test
 
-[ { } ] [
+{ { } } [
   "234" "1" token <+> parse list>array
 ] unit-test