Clean up parser combinators

extra/parser-combinators/parser-combinators.factor

@@ -1,22 +1,23 @@
 ! Copyright (C) 2004 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: lazy-lists promises kernel sequences strings math io
-arrays namespaces splitting ;
+USING: lazy-lists promises kernel sequences strings math
+arrays splitting ;
 IN: parser-combinators
 
 ! Parser combinator protocol
-GENERIC: (parse) ( input parser -- list )
+GENERIC: parse ( input parser -- list )
 
-M: promise (parse) ( input parser -- list )
-  force (parse) ;
-
-: parse ( input parser -- promise )
-  (parse) ;
+M: promise parse ( input parser -- list )
+    force parse ;
 
 TUPLE: parse-result parsed unparsed ;
 
 : parse-1 ( input parser -- result )
-  parse car parse-result-parsed ;
+    parse dup nil? [
+        "Parse error" throw
+    ] [
+        car parse-result-parsed
+    ] if ;
 
 C: <parse-result> parse-result
 
@@ -24,7 +25,7 @@ TUPLE: token-parser string ;
 
 C: token token-parser ( string -- parser )
 
-M: token-parser (parse) ( input parser -- list )
+M: token-parser parse ( input parser -- list )
     token-parser-string swap over ?head-slice [
         <parse-result> 1list
     ] [
@@ -35,7 +36,7 @@ TUPLE: satisfy-parser quot ;
 
 C: satisfy satisfy-parser ( quot -- parser )
 
-M: satisfy-parser (parse) ( input parser -- list )
+M: satisfy-parser parse ( input parser -- list )
     #! A parser that succeeds if the predicate,
     #! when passed the first character in the input, returns
     #! true.
@@ -56,7 +57,7 @@ TUPLE: epsilon-parser ;
 
 C: epsilon epsilon-parser ( -- parser )
 
-M: epsilon-parser (parse) ( input parser -- list )
+M: epsilon-parser parse ( input parser -- list )
     #! A parser that parses the empty string. It
     #! does not consume any input and always returns
     #! an empty list as the parse tree with the
@@ -67,7 +68,7 @@ TUPLE: succeed-parser result ;
 
 C: succeed succeed-parser ( result -- parser )
 
-M: succeed-parser (parse) ( input parser -- list )
+M: succeed-parser parse ( input parser -- list )
     #! A parser that always returns 'result' as a
     #! successful parse with no input consumed.
     succeed-parser-result swap <parse-result> 1list ;
@@ -76,7 +77,7 @@ TUPLE: fail-parser ;
 
 C: fail fail-parser ( -- parser )
 
-M: fail-parser (parse) ( input parser -- list )
+M: fail-parser parse ( input parser -- list )
     #! A parser that always fails and returns
     #! an empty list of successes.
     2drop nil ;
@@ -88,7 +89,7 @@ TUPLE: and-parser parsers ;
         >r and-parser-parsers r> add
     ] [
         2array
-  ] if \ and-parser construct-boa ;
+    ] if and-parser construct-boa ;
 
 : and-parser-parse ( list p1  -- list )
     swap [
@@ -100,18 +101,19 @@ TUPLE: and-parser parsers ;
         ] lmap-with
     ] lmap-with lconcat ;
 
-M: and-parser (parse) ( input parser -- list )
+M: and-parser parse ( input parser -- list )
     #! Parse 'input' by sequentially combining the
     #! two parsers. First parser1 is applied to the
     #! input then parser2 is applied to the rest of
     #! the input strings from the first parser.
-  and-parser-parsers unclip swapd parse [ [ and-parser-parse ] reduce ] 2curry promise ;
+    and-parser-parsers unclip swapd parse
+    [ [ and-parser-parse ] reduce ] 2curry promise ;
 
 TUPLE: or-parser p1 p2 ;
 
 C: <|> or-parser ( parser1 parser2 -- parser )
 
-M: or-parser (parse) ( input parser1 -- list )
+M: or-parser parse ( input parser1 -- list )
     #! Return the combined list resulting from the parses
     #! of parser1 and parser2 being applied to the same
     #! input. This implements the choice parsing operator.
@@ -130,7 +132,7 @@ TUPLE: sp-parser p1 ;
 #! calling the original parser.
 C: sp sp-parser ( p1 -- parser )
 
-M: sp-parser (parse) ( input parser -- list )
+M: sp-parser parse ( input parser -- list )
     #! Skip all leading whitespace from the input then call
     #! the parser on the remaining input.
     >r left-trim-slice r> sp-parser-p1 parse ;
@@ -139,7 +141,7 @@ TUPLE: just-parser p1 ;
 
 C: just just-parser ( p1 -- parser )
 
-M: just-parser (parse) ( input parser -- result )
+M: just-parser parse ( input parser -- result )
     #! Calls the given parser on the input removes
     #! from the results anything where the remaining
     #! input to be parsed is not empty. So ensures a
@@ -150,7 +152,7 @@ TUPLE: apply-parser p1 quot ;
 
 C: <@ apply-parser ( parser quot -- parser )
 
-M: apply-parser (parse) ( input parser -- result )
+M: apply-parser parse ( input parser -- result )
     #! Calls the parser on the input. For each successfull
     #! parse the quot is call with the parse result on the stack.
     #! The result of that quotation then becomes the new parse result.
@@ -166,14 +168,13 @@ TUPLE: some-parser p1 ;
 
 C: some some-parser ( p1 -- parser )
 
-M: some-parser (parse) ( input parser -- result )
+M: some-parser parse ( input parser -- result )
     #! Calls the parser on the input, guarantees
     #! the parse is complete (the remaining input is empty),
     #! picks the first solution and only returns the parse
     #! tree since the remaining input is empty.
     some-parser-p1 just parse-1 ;
 
-
 : <& ( parser1 parser2 -- parser )
     #! Same as <&> except discard the results of the second parser.
     <&> [ first ] <@ ;
@@ -184,15 +185,15 @@ M: some-parser (parse) ( input parser -- result )
 
 : <:&> ( parser1 parser2 -- result )
     #! Same as <&> except flatten the result.
-  <&> [ dup second swap first [ % , ] { } make ] <@ ;
+    <&> [ first2 add ] <@ ;
 
 : <&:> ( parser1 parser2 -- result )
     #! Same as <&> except flatten the result.
-  <&> [ dup second swap first [ , % ] { } make ] <@ ;
+    <&> [ first2 swap add* ] <@ ;
 
 : <:&:> ( parser1 parser2 -- result )
     #! Same as <&> except flatten the result.
-  <&> [ dup second swap first [ % % ] { } make ] <@ ;
+    <&> [ first2 append ] <@ ;
 
 LAZY: <*> ( parser -- parser )
     dup <*> <&:> { } succeed <|> ;
@@ -208,10 +209,11 @@ LAZY: <?> ( parser -- parser )
     [ 1array ] <@ f succeed <|> ;
 
 TUPLE: only-first-parser p1 ;
-LAZY: only-first ( parser -- parser )
-  \ only-first-parser construct-boa ;
 
-M: only-first-parser (parse) ( input parser -- list )
+LAZY: only-first ( parser -- parser )
+    only-first-parser construct-boa ;
+
+M: only-first-parser parse ( input parser -- list )
     #! Transform a parser into a parser that only yields
     #! the first possibility.
     only-first-parser-p1 parse 1 swap ltake ;