Basic pattern-matching optimizations.

1 files changed, 37 insertions, 21 deletions

diff --git a/stdlib/source/lux/control/parser/code.lux b/stdlib/source/lux/control/parser/code.lux
index 30344aaa0..ca0df7c9f 100644
--- a/stdlib/source/lux/control/parser/code.lux
+++ b/stdlib/source/lux/control/parser/code.lux
@@ -39,11 +39,14 @@
   (Parser Code)
   (function (_ tokens)
     (case tokens
-      #.Nil                (#try.Failure "There are no tokens to parse!")
-      (#.Cons [t tokens']) (#try.Success [tokens' t]))))
+      #.Nil
+      (#try.Failure "There are no tokens to parse!")
+      
+      (#.Cons [t tokens'])
+      (#try.Success [tokens' t]))))
 
-(template [<query> <assertion> <type> <tag> <eq> <desc>]
-  [(with-expansions [<error> (as-is (#try.Failure ($_ text@compose "Cannot parse " <desc> (remaining-inputs tokens))))]
+(template [<query> <check> <type> <tag> <eq> <desc>]
+  [(with-expansions [<failure> (as-is (#try.Failure ($_ text@compose "Cannot parse " <desc> (remaining-inputs tokens))))]
      (def: #export <query>
        {#.doc (code.text ($_ text@compose "Parses the next " <desc> " input."))}
        (Parser <type>)
@@ -53,19 +56,19 @@
            (#try.Success [tokens' x])
 
            _
-           <error>)))
+           <failure>)))
 
-     (def: #export (<assertion> expected)
+     (def: #export (<check> expected)
        (-> <type> (Parser Any))
        (function (_ tokens)
          (case tokens
            (#.Cons [[_ (<tag> actual)] tokens'])
            (if (:: <eq> = expected actual)
              (#try.Success [tokens' []])
-             <error>)
+             <failure>)
 
            _
-           <error>))))]
+           <failure>))))]
 
   [bit        bit!        Bit  #.Bit        bit.equivalence  "bit"]
   [nat        nat!        Nat  #.Nat        nat.equivalence  "nat"]
@@ -91,20 +94,33 @@
       _
       (#try.Failure "There are no tokens to parse!"))))
 
-(template [<name> <tag> <desc>]
-  [(def: #export <name>
-     {#.doc (code.text ($_ text@compose "Parse a local " <desc> " (a " <desc> " that has no module prefix)."))}
-     (Parser Text)
-     (function (_ tokens)
-       (case tokens
-         (#.Cons [[_ (<tag> ["" x])] tokens'])
-         (#try.Success [tokens' x])
+(template [<query> <check> <tag> <eq> <desc>]
+  [(with-expansions [<failure> (as-is (#try.Failure ($_ text@compose "Cannot parse " <desc> (remaining-inputs tokens))))]
+     (def: #export <query>
+       {#.doc (code.text ($_ text@compose "Parse a local " <desc> " (a " <desc> " that has no module prefix)."))}
+       (Parser Text)
+       (function (_ tokens)
+         (case tokens
+           (#.Cons [[_ (<tag> ["" x])] tokens'])
+           (#try.Success [tokens' x])
 
-         _
-         (#try.Failure ($_ text@compose "Cannot parse local " <desc> (remaining-inputs tokens))))))]
+           _
+           <failure>)))
+
+     (def: #export (<check> expected)
+       (-> Text (Parser Any))
+       (function (_ tokens)
+         (case tokens
+           (#.Cons [[_ (<tag> ["" actual])] tokens'])
+           (if (:: <eq> = expected actual)
+             (#try.Success [tokens' []])
+             <failure>)
+
+           _
+           <failure>))))]
 
-  [local-identifier #.Identifier "identifier"]
-  [   local-tag     #.Tag        "tag"]
+  [local-identifier local-identifier! #.Identifier text.equivalence "local identifier"]
+  [       local-tag        local-tag! #.Tag        text.equivalence "local tag"]
   )
 
 (template [<name> <tag> <desc>]
@@ -177,5 +193,5 @@
   (All [a] (-> (List Code) (Parser a) (Parser a)))
   (function (_ real)
     (do try.monad
-      [value (run syntax inputs)]
+      [value (..run syntax inputs)]
       (wrap [real value]))))