Improvements to parsing machinery.

6 files changed, 179 insertions, 155 deletions

diff --git a/stdlib/source/lux/control/parser.lux b/stdlib/source/lux/control/parser.lux
index 84f63c548..9bc53d149 100644
--- a/stdlib/source/lux/control/parser.lux
+++ b/stdlib/source/lux/control/parser.lux
@@ -7,7 +7,7 @@
     [codec (#+ Codec)]]
    [data
     [collection
-     ["." list ("#;." functor monoid)]]
+     ["." list ("#@." functor monoid)]]
     ["." product]
     ["." error (#+ Error)]]])
 
@@ -168,7 +168,7 @@
   (do ..monad
     [min (exactly n p)
      extra (some p)]
-    (wrap (list;compose min extra))))
+    (wrap (list@compose min extra))))
 
 (def: #export (at-most n p)
   {#.doc "Parse at most N times."}
@@ -207,7 +207,7 @@
       (#.Some x)
       (do @
         [xs' (some (..and sep p))]
-        (wrap (#.Cons x (list;map product.right xs'))))
+        (wrap (#.Cons x (list@map product.right xs'))))
       )))
 
 (def: #export (not p)
@@ -277,6 +277,16 @@
      _ (assert "Constraint failed." (test output))]
     (wrap output)))
 
+(def: #export (parses? parser)
+  (All [s a] (-> (Parser s a) (Parser s Bit)))
+  (function (_ input)
+    (case (parser input)
+      (#error.Failure error)
+      (#error.Success [input false])
+
+      (#error.Success [input' _])
+      (#error.Success [input' true]))))
+
 (def: #export (codec Codec<a,z> parser)
   (All [s a z] (-> (Codec a z) (Parser s a) (Parser s z)))
   (function (_ input)
diff --git a/stdlib/source/lux/control/parser/code.lux b/stdlib/source/lux/control/parser/code.lux
index 56cbe5bc2..1e1287467 100644
--- a/stdlib/source/lux/control/parser/code.lux
+++ b/stdlib/source/lux/control/parser/code.lux
@@ -41,44 +41,42 @@
       #.Nil                (#error.Failure "There are no tokens to parse!")
       (#.Cons [t tokens']) (#error.Success [tokens' t]))))
 
-(template [<get-name> <type> <tag> <eq> <desc>]
-  [(def: #export <get-name>
-     {#.doc (code.text ($_ text@compose "Parses the next " <desc> " input Code."))}
-     (Parser <type>)
-     (function (_ tokens)
-       (case tokens
-         (#.Cons [[_ (<tag> x)] tokens'])
-         (#error.Success [tokens' x])
-
-         _
-         (#error.Failure ($_ text@compose "Cannot parse " <desc> (remaining-inputs tokens))))))]
-
-  [   bit     Bit  #.Bit        bit.equivalence  "bit"]
-  [   nat     Nat  #.Nat        nat.equivalence  "nat"]
-  [   int     Int  #.Int        int.equivalence  "int"]
-  [   rev     Rev  #.Rev        rev.equivalence  "rev"]
-  [  frac     Frac #.Frac       frac.equivalence "frac"]
-  [  text     Text #.Text       text.equivalence "text"]
-  [identifier Name #.Identifier name.equivalence "identifier"]
-  [   tag     Name #.Tag        name.equivalence "tag"]
+(template [<query> <assertion> <type> <tag> <eq> <desc>]
+  [(with-expansions [<error> (as-is (#error.Failure ($_ text@compose "Cannot parse " <desc> (remaining-inputs tokens))))]
+     (def: #export <query>
+       {#.doc (code.text ($_ text@compose "Parses the next " <desc> " input."))}
+       (Parser <type>)
+       (function (_ tokens)
+         (case tokens
+           (#.Cons [[_ (<tag> x)] tokens'])
+           (#error.Success [tokens' x])
+
+           _
+           <error>)))
+
+     (def: #export (<assertion> expected)
+       (-> <type> (Parser Any))
+       (function (_ tokens)
+         (case tokens
+           (#.Cons [[_ (<tag> actual)] tokens'])
+           (if (:: <eq> = expected actual)
+             (#error.Success [tokens' []])
+             <error>)
+
+           _
+           <error>))))]
+
+  [bit        bit!        Bit  #.Bit        bit.equivalence  "bit"]
+  [nat        nat!        Nat  #.Nat        nat.equivalence  "nat"]
+  [int        int!        Int  #.Int        int.equivalence  "int"]
+  [rev        rev!        Rev  #.Rev        rev.equivalence  "rev"]
+  [frac       frac!       Frac #.Frac       frac.equivalence "frac"]
+  [text       text!       Text #.Text       text.equivalence "text"]
+  [identifier identifier! Name #.Identifier name.equivalence "identifier"]
+  [tag        tag!        Name #.Tag        name.equivalence "tag"]
   )
 
-(def: #export (this? ast)
-  {#.doc "Asks if the given Code is the next input."}
-  (-> Code (Parser Bit))
-  (function (_ tokens)
-    (case tokens
-      (#.Cons [token tokens'])
-      (let [is-it? (code@= ast token)
-            remaining (if is-it?
-                        tokens'
-                        tokens)]
-        (#error.Success [remaining is-it?]))
-
-      _
-      (#error.Success [tokens #0]))))
-
-(def: #export (this ast)
+(def: #export (this! ast)
   {#.doc "Ensures the given Code is the next input."}
   (-> Code (Parser Any))
   (function (_ tokens)
diff --git a/stdlib/source/lux/control/parser/synthesis.lux b/stdlib/source/lux/control/parser/synthesis.lux
index f08159848..c36c61601 100644
--- a/stdlib/source/lux/control/parser/synthesis.lux
+++ b/stdlib/source/lux/control/parser/synthesis.lux
@@ -6,7 +6,13 @@
     ["." exception (#+ exception:)]]
    [data
     ["." error (#+ Error)]
-    [text
+    ["." bit]
+    ["." name]
+    [number
+     ["." i64]
+     ["." frac]
+     ["." nat]]
+    ["." text
      format]]
    [tool
     [compiler
@@ -56,8 +62,8 @@
       (#.Cons [head tail])
       (#error.Success [tail head]))))
 
-(template [<name> <tag> <type>]
-  [(def: #export <name>
+(template [<query> <assertion> <tag> <type> <eq>]
+  [(def: #export <query>
      (Parser <type>)
      (.function (_ input)
        (case input
@@ -65,17 +71,27 @@
          (#error.Success [input' x])
 
          _
+         (exception.throw ..cannot-parse input))))
+
+   (def: #export (<assertion> expected)
+     (-> <type> (Parser Any))
+     (.function (_ input)
+       (case input
+         (^ (list& (<tag> actual) input'))
+         (if (:: <eq> = expected actual)
+           (#error.Success [input' []])
+           (exception.throw ..cannot-parse input))
+
+         _
          (exception.throw ..cannot-parse input))))]
 
-  [bit /.bit Bit]
-  [i64 /.i64 (I64 Any)]
-  [f64 /.f64 Frac]
-  [text /.text Text]
-  [variant /.variant (Variant Synthesis)]
-  [local /.variable/local Nat]
-  [foreign /.variable/foreign Nat]
-  [constant /.constant Name]
-  [abstraction /.function/abstraction Abstraction]
+  [bit bit! /.bit Bit bit.equivalence]
+  [i64 i64! /.i64 (I64 Any) i64.equivalence]
+  [f64 f64! /.f64 Frac frac.equivalence]
+  [text text! /.text Text text.equivalence]
+  [local local! /.variable/local Nat nat.equivalence]
+  [foreign foreign! /.variable/foreign Nat nat.equivalence]
+  [constant constant! /.constant Name name.equivalence]
   )
 
 (def: #export (tuple parser)
diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux
index fa0979cb1..fc96f4367 100644
--- a/stdlib/source/lux/host.jvm.lux
+++ b/stdlib/source/lux/host.jvm.lux
@@ -135,8 +135,8 @@
 (def: member-separator "::")
 
 (type: BoundKind
-  #UpperBound
-  #LowerBound)
+  #LowerBound
+  #UpperBound)
 
 (type: #rec GenericType
   (#GenericTypeVar Text)
@@ -585,14 +585,14 @@
   (-> Text Text (Parser Code))
   (do p.monad
     [#let [dotted-name (format "::" field-name)]
-     _ (s.this (code.identifier ["" dotted-name]))]
+     _ (s.this! (code.identifier ["" dotted-name]))]
     (wrap (get-static-field class-name field-name))))
 
 (def: (make-get-var-parser class-name field-name)
   (-> Text Text (Parser Code))
   (do p.monad
     [#let [dotted-name (format "::" field-name)]
-     _ (s.this (code.identifier ["" dotted-name]))]
+     _ (s.this! (code.identifier ["" dotted-name]))]
     (wrap (get-virtual-field class-name field-name (' _jvm_this)))))
 
 (def: (make-put-var-parser class-name field-name)
@@ -600,7 +600,7 @@
   (do p.monad
     [#let [dotted-name (format "::" field-name)]
      [_ _ value] (: (Parser [Any Any Code])
-                    (s.form ($_ p.and (s.this (' :=)) (s.this (code.identifier ["" dotted-name])) s.any)))]
+                    (s.form ($_ p.and (s.this! (' :=)) (s.this! (code.identifier ["" dotted-name])) s.any)))]
     (wrap (`' ((~ (code.text (format "jvm putfield" ":" class-name ":" field-name))) _jvm_this (~ value))))))
 
 (def: (pre-walk-replace f input)
@@ -649,7 +649,7 @@
   (-> (List Type-Paramameter) Text (List ArgDecl) (Parser Code))
   (do p.monad
     [args (: (Parser (List Code))
-             (s.form (p.after (s.this (' ::new!))
+             (s.form (p.after (s.this! (' ::new!))
                               (s.tuple (p.exactly (list.size arg-decls) s.any)))))
      #let [arg-decls' (: (List Text) (list@map (|>> product.right (simple-class$ params)) arg-decls))]]
     (wrap (` ("jvm member invoke constructor" (~ (code.text class-name))
@@ -662,7 +662,7 @@
   (do p.monad
     [#let [dotted-name (format "::" method-name "!")]
      args (: (Parser (List Code))
-             (s.form (p.after (s.this (code.identifier ["" dotted-name]))
+             (s.form (p.after (s.this! (code.identifier ["" dotted-name]))
                               (s.tuple (p.exactly (list.size arg-decls) s.any)))))
      #let [arg-decls' (: (List Text) (list@map (|>> product.right (simple-class$ params)) arg-decls))]]
     (wrap (` ("jvm member invoke static" (~ (code.text class-name)) (~ (code.text method-name))
@@ -676,7 +676,7 @@
      (do p.monad
        [#let [dotted-name (format "::" method-name "!")]
         args (: (Parser (List Code))
-                (s.form (p.after (s.this (code.identifier ["" dotted-name]))
+                (s.form (p.after (s.this! (code.identifier ["" dotted-name]))
                                  (s.tuple (p.exactly (list.size arg-decls) s.any)))))
         #let [arg-decls' (: (List Text) (list@map (|>> product.right (simple-class$ params)) arg-decls))]]
        (wrap (` (<jvm-op> (~ (code.text class-name)) (~ (code.text method-name))
@@ -718,23 +718,23 @@
   (Parser PrivacyModifier)
   (let [(^open ".") p.monad]
     ($_ p.or
-        (s.this (' #public))
-        (s.this (' #private))
-        (s.this (' #protected))
+        (s.this! (' #public))
+        (s.this! (' #private))
+        (s.this! (' #protected))
         (wrap []))))
 
 (def: inheritance-modifier^
   (Parser InheritanceModifier)
   (let [(^open ".") p.monad]
     ($_ p.or
-        (s.this (' #final))
-        (s.this (' #abstract))
+        (s.this! (' #final))
+        (s.this! (' #abstract))
         (wrap []))))
 
 (def: bound-kind^
   (Parser BoundKind)
-  (p.or (s.this (' <))
-        (s.this (' >))))
+  (p.or (s.this! (' >))
+        (s.this! (' <))))
 
 (def: (assert-no-periods name)
   (-> Text (Parser Any))
@@ -745,10 +745,10 @@
   (-> Class-Imports (List Type-Paramameter) (Parser GenericType))
   ($_ p.either
       (do p.monad
-        [_ (s.this (' ?))]
+        [_ (s.this! (' ?))]
         (wrap (#GenericWildcard #.None)))
       (s.tuple (do p.monad
-                 [_ (s.this (' ?))
+                 [_ (s.this! (' ?))
                   bound-kind bound-kind^
                   bound (generic-type^ imports type-vars)]
                  (wrap (#GenericWildcard (#.Some [bound-kind bound])))))
@@ -759,7 +759,7 @@
           (wrap (#GenericTypeVar name))
           (wrap (#GenericClass name (list)))))
       (s.form (do p.monad
-                [name (s.this (' Array))
+                [name (s.this! (' Array))
                  component (generic-type^ imports type-vars)]
                 (case component
                   (^template [<class> <name>]
@@ -792,7 +792,7 @@
               (wrap [param-name (list)]))
             (s.tuple (do p.monad
                        [param-name s.local-identifier
-                        _ (s.this (' <))
+                        _ (s.this! (' <))
                         bounds (p.many (generic-type^ imports (list)))]
                        (wrap [param-name bounds])))))
 
@@ -840,7 +840,7 @@
 (def: (annotations^' imports)
   (-> Class-Imports (Parser (List Annotation)))
   (do p.monad
-    [_ (s.this (' #ann))]
+    [_ (s.this! (' #ann))]
     (s.tuple (p.some (annotation^ imports)))))
 
 (def: (annotations^ imports)
@@ -852,7 +852,7 @@
 (def: (throws-decl'^ imports type-vars)
   (-> Class-Imports (List Type-Paramameter) (Parser (List GenericType)))
   (do p.monad
-    [_ (s.this (' #throws))]
+    [_ (s.this! (' #throws))]
     (s.tuple (p.some (generic-type^ imports type-vars)))))
 
 (def: (throws-decl^ imports type-vars)
@@ -878,14 +878,14 @@
 (def: state-modifier^
   (Parser StateModifier)
   ($_ p.or
-      (s.this (' #volatile))
-      (s.this (' #final))
+      (s.this! (' #volatile))
+      (s.this! (' #final))
       (:: p.monad wrap [])))
 
 (def: (field-decl^ imports type-vars)
   (-> Class-Imports (List Type-Paramameter) (Parser [Member-Declaration FieldDecl]))
   (p.either (s.form (do p.monad
-                      [_ (s.this (' #const))
+                      [_ (s.this! (' #const))
                        name s.local-identifier
                        anns (annotations^ imports)
                        type (generic-type^ imports type-vars)
@@ -920,10 +920,10 @@
   (-> Class-Imports (List Type-Paramameter) (Parser [Member-Declaration Method-Definition]))
   (s.form (do p.monad
             [pm privacy-modifier^
-             strict-fp? (s.this? (' #strict))
+             strict-fp? (p.parses? (s.this! (' #strict)))
              method-vars (p.default (list) (type-params^ imports))
              #let [total-vars (list@compose class-vars method-vars)]
-             [_ arg-decls] (s.form (p.and (s.this (' new))
+             [_ arg-decls] (s.form (p.and (s.this! (' new))
                                           (arg-decls^ imports total-vars)))
              constructor-args (constructor-args^ imports total-vars)
              exs (throws-decl^ imports total-vars)
@@ -938,8 +938,8 @@
   (-> Class-Imports (List Type-Paramameter) (Parser [Member-Declaration Method-Definition]))
   (s.form (do p.monad
             [pm privacy-modifier^
-             strict-fp? (s.this? (' #strict))
-             final? (s.this? (' #final))
+             strict-fp? (p.parses? (s.this! (' #strict)))
+             final? (p.parses? (s.this! (' #final)))
              method-vars (p.default (list) (type-params^ imports))
              #let [total-vars (list@compose class-vars method-vars)]
              [name self-name arg-decls] (s.form ($_ p.and
@@ -958,7 +958,7 @@
 (def: (overriden-method-def^ imports)
   (-> Class-Imports (Parser [Member-Declaration Method-Definition]))
   (s.form (do p.monad
-            [strict-fp? (s.this? (' #strict))
+            [strict-fp? (p.parses? (s.this! (' #strict)))
              owner-class (class-decl^ imports)
              method-vars (p.default (list) (type-params^ imports))
              #let [total-vars (list@compose (product.right owner-class) method-vars)]
@@ -979,8 +979,8 @@
   (-> Class-Imports (Parser [Member-Declaration Method-Definition]))
   (s.form (do p.monad
             [pm privacy-modifier^
-             strict-fp? (s.this? (' #strict))
-             _ (s.this (' #static))
+             strict-fp? (p.parses? (s.this! (' #strict)))
+             _ (s.this! (' #static))
              method-vars (p.default (list) (type-params^ imports))
              #let [total-vars method-vars]
              [name arg-decls] (s.form (p.and s.local-identifier
@@ -998,7 +998,7 @@
   (-> Class-Imports (Parser [Member-Declaration Method-Definition]))
   (s.form (do p.monad
             [pm privacy-modifier^
-             _ (s.this (' #abstract))
+             _ (s.this! (' #abstract))
              method-vars (p.default (list) (type-params^ imports))
              #let [total-vars method-vars]
              [name arg-decls] (s.form (p.and s.local-identifier
@@ -1015,7 +1015,7 @@
   (-> Class-Imports (Parser [Member-Declaration Method-Definition]))
   (s.form (do p.monad
             [pm privacy-modifier^
-             _ (s.this (' #native))
+             _ (s.this! (' #native))
              method-vars (p.default (list) (type-params^ imports))
              #let [total-vars method-vars]
              [name arg-decls] (s.form (p.and s.local-identifier
@@ -1045,42 +1045,42 @@
 (def: class-kind^
   (Parser Class-Kind)
   (p.either (do p.monad
-              [_ (s.this (' #class))]
+              [_ (s.this! (' #class))]
               (wrap #Class))
             (do p.monad
-              [_ (s.this (' #interface))]
+              [_ (s.this! (' #interface))]
               (wrap #Interface))
             ))
 
 (def: import-member-alias^
   (Parser (Maybe Text))
   (p.maybe (do p.monad
-             [_ (s.this (' #as))]
+             [_ (s.this! (' #as))]
              s.local-identifier)))
 
 (def: (import-member-args^ imports type-vars)
   (-> Class-Imports (List Type-Paramameter) (Parser (List [Bit GenericType])))
-  (s.tuple (p.some (p.and (s.this? (' #?)) (generic-type^ imports type-vars)))))
+  (s.tuple (p.some (p.and (p.parses? (s.this! (' #?))) (generic-type^ imports type-vars)))))
 
 (def: import-member-return-flags^
   (Parser [Bit Bit Bit])
-  ($_ p.and (s.this? (' #io)) (s.this? (' #try)) (s.this? (' #?))))
+  ($_ p.and (p.parses? (s.this! (' #io))) (p.parses? (s.this! (' #try))) (p.parses? (s.this! (' #?)))))
 
 (def: primitive-mode^
   (Parser Primitive-Mode)
-  (p.or (s.this (' #manual))
-        (s.this (' #auto))))
+  (p.or (s.this! (' #manual))
+        (s.this! (' #auto))))
 
 (def: (import-member-decl^ imports owner-vars)
   (-> Class-Imports (List Type-Paramameter) (Parser Import-Member-Declaration))
   ($_ p.either
       (s.form (do p.monad
-                [_ (s.this (' #enum))
+                [_ (s.this! (' #enum))
                  enum-members (p.some s.local-identifier)]
                 (wrap (#EnumDecl enum-members))))
       (s.form (do p.monad
                 [tvars (p.default (list) (type-params^ imports))
-                 _ (s.this (' new))
+                 _ (s.this! (' new))
                  ?alias import-member-alias^
                  #let [total-vars (list@compose owner-vars tvars)]
                  ?prim-mode (p.maybe primitive-mode^)
@@ -1098,7 +1098,7 @@
                 ))
       (s.form (do p.monad
                 [kind (: (Parser ImportMethodKind)
-                         (p.or (s.this (' #static))
+                         (p.or (s.this! (' #static))
                                (wrap [])))
                  tvars (p.default (list) (type-params^ imports))
                  name s.local-identifier
@@ -1120,12 +1120,12 @@
                                      #import-method-return  return
                                      }]))))
       (s.form (do p.monad
-                [static? (s.this? (' #static))
+                [static? (p.parses? (s.this! (' #static)))
                  name s.local-identifier
                  ?prim-mode (p.maybe primitive-mode^)
                  gtype (generic-type^ imports owner-vars)
-                 maybe? (s.this? (' #?))
-                 setter? (s.this? (' #!))]
+                 maybe? (p.parses? (s.this! (' #?)))
+                 setter? (p.parses? (s.this! (' #!)))]
                 (wrap (#FieldAccessDecl {#import-field-mode    (maybe.default #AutoPrM ?prim-mode)
                                          #import-field-name    name
                                          #import-field-static? static?
@@ -1160,8 +1160,8 @@
 (def: (bound-kind$ kind)
   (-> BoundKind Code)
   (case kind
-    #UpperBound (' "<")
-    #LowerBound (' ">")))
+    #LowerBound (' ">")
+    #UpperBound (' "<")))
 
 (def: (generic-type$ gtype)
   (-> GenericType Code)
@@ -1270,7 +1270,7 @@
     
     (#OverridenMethod strict-fp? class-decl type-vars self-name arg-decls return-type body exs)
     (let [super-replacer (parser->replacer (s.form (do p.monad
-                                                     [_ (s.this (' ::super!))
+                                                     [_ (s.this! (' ::super!))
                                                       args (s.tuple (p.exactly (list.size arg-decls) s.any))
                                                       #let [arg-decls' (: (List Text)
                                                                           (list@map (|>> product.right (simple-class$ (list)))
@@ -1891,7 +1891,7 @@
 
 (syntax: #export (import:
                    {#let [imports (class-imports *compiler*)]}
-                   {long-name? (s.this? (' #long))}
+                   {long-name? (p.parses? (s.this! (' #long)))}
                    {class-decl (class-decl^ imports)}
                    {#let [full-class-name (product.left class-decl)
                           imports (add-import [(short-class-name full-class-name) full-class-name]
diff --git a/stdlib/source/lux/host.old.lux b/stdlib/source/lux/host.old.lux
index 39fe0034c..4c12d8774 100644
--- a/stdlib/source/lux/host.old.lux
+++ b/stdlib/source/lux/host.old.lux
@@ -521,14 +521,14 @@
   (-> Text Text (Parser Code))
   (do p.monad
     [#let [dotted-name (format "::" field-name)]
-     _ (s.this (code.identifier ["" dotted-name]))]
+     _ (s.this! (code.identifier ["" dotted-name]))]
     (wrap (`' ((~ (code.text (format "jvm getstatic" ":" class-name ":" field-name))))))))
 
 (def: (make-get-var-parser class-name field-name)
   (-> Text Text (Parser Code))
   (do p.monad
     [#let [dotted-name (format "::" field-name)]
-     _ (s.this (code.identifier ["" dotted-name]))]
+     _ (s.this! (code.identifier ["" dotted-name]))]
     (wrap (`' ((~ (code.text (format "jvm getfield" ":" class-name ":" field-name))) _jvm_this)))))
 
 (def: (make-put-var-parser class-name field-name)
@@ -536,7 +536,7 @@
   (do p.monad
     [#let [dotted-name (format "::" field-name)]
      [_ _ value] (: (Parser [Any Any Code])
-                    (s.form ($_ p.and (s.this (' :=)) (s.this (code.identifier ["" dotted-name])) s.any)))]
+                    (s.form ($_ p.and (s.this! (' :=)) (s.this! (code.identifier ["" dotted-name])) s.any)))]
     (wrap (`' ((~ (code.text (format "jvm putfield" ":" class-name ":" field-name))) _jvm_this (~ value))))))
 
 (def: (pre-walk-replace f input)
@@ -581,7 +581,7 @@
   (-> (List Type-Paramameter) Text (List ArgDecl) (Parser Code))
   (do p.monad
     [args (: (Parser (List Code))
-             (s.form (p.after (s.this (' ::new!))
+             (s.form (p.after (s.this! (' ::new!))
                               (s.tuple (p.exactly (list.size arg-decls) s.any)))))
      #let [arg-decls' (: (List Text) (list@map (|>> product.right (simple-class$ params)) arg-decls))]]
     (wrap (` ((~ (code.text (format "jvm new" ":" class-name ":" (text.join-with "," arg-decls'))))
@@ -592,7 +592,7 @@
   (do p.monad
     [#let [dotted-name (format "::" method-name "!")]
      args (: (Parser (List Code))
-             (s.form (p.after (s.this (code.identifier ["" dotted-name]))
+             (s.form (p.after (s.this! (code.identifier ["" dotted-name]))
                               (s.tuple (p.exactly (list.size arg-decls) s.any)))))
      #let [arg-decls' (: (List Text) (list@map (|>> product.right (simple-class$ params)) arg-decls))]]
     (wrap (`' ((~ (code.text (format "jvm invokestatic" ":" class-name ":" method-name ":" (text.join-with "," arg-decls'))))
@@ -604,7 +604,7 @@
      (do p.monad
        [#let [dotted-name (format "::" method-name "!")]
         args (: (Parser (List Code))
-                (s.form (p.after (s.this (code.identifier ["" dotted-name]))
+                (s.form (p.after (s.this! (code.identifier ["" dotted-name]))
                                  (s.tuple (p.exactly (list.size arg-decls) s.any)))))
         #let [arg-decls' (: (List Text) (list@map (|>> product.right (simple-class$ params)) arg-decls))]]
        (wrap (`' ((~ (code.text (format <jvm-op> ":" class-name ":" method-name ":" (text.join-with "," arg-decls'))))
@@ -644,23 +644,23 @@
   (Parser PrivacyModifier)
   (let [(^open ".") p.monad]
     ($_ p.or
-        (s.this (' #public))
-        (s.this (' #private))
-        (s.this (' #protected))
+        (s.this! (' #public))
+        (s.this! (' #private))
+        (s.this! (' #protected))
         (wrap []))))
 
 (def: inheritance-modifier^
   (Parser InheritanceModifier)
   (let [(^open ".") p.monad]
     ($_ p.or
-        (s.this (' #final))
-        (s.this (' #abstract))
+        (s.this! (' #final))
+        (s.this! (' #abstract))
         (wrap []))))
 
 (def: bound-kind^
   (Parser BoundKind)
-  (p.or (s.this (' <))
-        (s.this (' >))))
+  (p.or (s.this! (' <))
+        (s.this! (' >))))
 
 (def: (assert-no-periods name)
   (-> Text (Parser Any))
@@ -671,10 +671,10 @@
   (-> Class-Imports (List Type-Paramameter) (Parser GenericType))
   ($_ p.either
       (do p.monad
-        [_ (s.this (' ?))]
+        [_ (s.this! (' ?))]
         (wrap (#GenericWildcard #.None)))
       (s.tuple (do p.monad
-                 [_ (s.this (' ?))
+                 [_ (s.this! (' ?))
                   bound-kind bound-kind^
                   bound (generic-type^ imports type-vars)]
                  (wrap (#GenericWildcard (#.Some [bound-kind bound])))))
@@ -685,7 +685,7 @@
           (wrap (#GenericTypeVar name))
           (wrap (#GenericClass name (list)))))
       (s.form (do p.monad
-                [name (s.this (' Array))
+                [name (s.this! (' Array))
                  component (generic-type^ imports type-vars)]
                 (case component
                   (^template [<class> <name>]
@@ -718,7 +718,7 @@
               (wrap [param-name (list)]))
             (s.tuple (do p.monad
                        [param-name s.local-identifier
-                        _ (s.this (' <))
+                        _ (s.this! (' <))
                         bounds (p.many (generic-type^ imports (list)))]
                        (wrap [param-name bounds])))))
 
@@ -766,7 +766,7 @@
 (def: (annotations^' imports)
   (-> Class-Imports (Parser (List Annotation)))
   (do p.monad
-    [_ (s.this (' #ann))]
+    [_ (s.this! (' #ann))]
     (s.tuple (p.some (annotation^ imports)))))
 
 (def: (annotations^ imports)
@@ -778,7 +778,7 @@
 (def: (throws-decl'^ imports type-vars)
   (-> Class-Imports (List Type-Paramameter) (Parser (List GenericType)))
   (do p.monad
-    [_ (s.this (' #throws))]
+    [_ (s.this! (' #throws))]
     (s.tuple (p.some (generic-type^ imports type-vars)))))
 
 (def: (throws-decl^ imports type-vars)
@@ -804,14 +804,14 @@
 (def: state-modifier^
   (Parser StateModifier)
   ($_ p.or
-      (s.this (' #volatile))
-      (s.this (' #final))
+      (s.this! (' #volatile))
+      (s.this! (' #final))
       (:: p.monad wrap [])))
 
 (def: (field-decl^ imports type-vars)
   (-> Class-Imports (List Type-Paramameter) (Parser [Member-Declaration FieldDecl]))
   (p.either (s.form (do p.monad
-                      [_ (s.this (' #const))
+                      [_ (s.this! (' #const))
                        name s.local-identifier
                        anns (annotations^ imports)
                        type (generic-type^ imports type-vars)
@@ -846,10 +846,10 @@
   (-> Class-Imports (List Type-Paramameter) (Parser [Member-Declaration Method-Definition]))
   (s.form (do p.monad
             [pm privacy-modifier^
-             strict-fp? (s.this? (' #strict))
+             strict-fp? (p.parses? (s.this! (' #strict)))
              method-vars (p.default (list) (type-params^ imports))
              #let [total-vars (list@compose class-vars method-vars)]
-             [_ arg-decls] (s.form (p.and (s.this (' new))
+             [_ arg-decls] (s.form (p.and (s.this! (' new))
                                           (arg-decls^ imports total-vars)))
              constructor-args (constructor-args^ imports total-vars)
              exs (throws-decl^ imports total-vars)
@@ -864,8 +864,8 @@
   (-> Class-Imports (List Type-Paramameter) (Parser [Member-Declaration Method-Definition]))
   (s.form (do p.monad
             [pm privacy-modifier^
-             strict-fp? (s.this? (' #strict))
-             final? (s.this? (' #final))
+             strict-fp? (p.parses? (s.this! (' #strict)))
+             final? (p.parses? (s.this! (' #final)))
              method-vars (p.default (list) (type-params^ imports))
              #let [total-vars (list@compose class-vars method-vars)]
              [name this-name arg-decls] (s.form ($_ p.and
@@ -887,7 +887,7 @@
 (def: (overriden-method-def^ imports)
   (-> Class-Imports (Parser [Member-Declaration Method-Definition]))
   (s.form (do p.monad
-            [strict-fp? (s.this? (' #strict))
+            [strict-fp? (p.parses? (s.this! (' #strict)))
              owner-class (class-decl^ imports)
              method-vars (p.default (list) (type-params^ imports))
              #let [total-vars (list@compose (product.right owner-class) method-vars)]
@@ -911,8 +911,8 @@
   (-> Class-Imports (Parser [Member-Declaration Method-Definition]))
   (s.form (do p.monad
             [pm privacy-modifier^
-             strict-fp? (s.this? (' #strict))
-             _ (s.this (' #static))
+             strict-fp? (p.parses? (s.this! (' #strict)))
+             _ (s.this! (' #static))
              method-vars (p.default (list) (type-params^ imports))
              #let [total-vars method-vars]
              [name arg-decls] (s.form (p.and s.local-identifier
@@ -930,7 +930,7 @@
   (-> Class-Imports (Parser [Member-Declaration Method-Definition]))
   (s.form (do p.monad
             [pm privacy-modifier^
-             _ (s.this (' #abstract))
+             _ (s.this! (' #abstract))
              method-vars (p.default (list) (type-params^ imports))
              #let [total-vars method-vars]
              [name arg-decls] (s.form (p.and s.local-identifier
@@ -947,7 +947,7 @@
   (-> Class-Imports (Parser [Member-Declaration Method-Definition]))
   (s.form (do p.monad
             [pm privacy-modifier^
-             _ (s.this (' #native))
+             _ (s.this! (' #native))
              method-vars (p.default (list) (type-params^ imports))
              #let [total-vars method-vars]
              [name arg-decls] (s.form (p.and s.local-identifier
@@ -977,42 +977,42 @@
 (def: class-kind^
   (Parser Class-Kind)
   (p.either (do p.monad
-              [_ (s.this (' #class))]
+              [_ (s.this! (' #class))]
               (wrap #Class))
             (do p.monad
-              [_ (s.this (' #interface))]
+              [_ (s.this! (' #interface))]
               (wrap #Interface))
             ))
 
 (def: import-member-alias^
   (Parser (Maybe Text))
   (p.maybe (do p.monad
-             [_ (s.this (' #as))]
+             [_ (s.this! (' #as))]
              s.local-identifier)))
 
 (def: (import-member-args^ imports type-vars)
   (-> Class-Imports (List Type-Paramameter) (Parser (List [Bit GenericType])))
-  (s.tuple (p.some (p.and (s.this? (' #?)) (generic-type^ imports type-vars)))))
+  (s.tuple (p.some (p.and (p.parses? (s.this! (' #?))) (generic-type^ imports type-vars)))))
 
 (def: import-member-return-flags^
   (Parser [Bit Bit Bit])
-  ($_ p.and (s.this? (' #io)) (s.this? (' #try)) (s.this? (' #?))))
+  ($_ p.and (p.parses? (s.this! (' #io))) (p.parses? (s.this! (' #try))) (p.parses? (s.this! (' #?)))))
 
 (def: primitive-mode^
   (Parser Primitive-Mode)
-  (p.or (s.this (' #manual))
-        (s.this (' #auto))))
+  (p.or (s.this! (' #manual))
+        (s.this! (' #auto))))
 
 (def: (import-member-decl^ imports owner-vars)
   (-> Class-Imports (List Type-Paramameter) (Parser Import-Member-Declaration))
   ($_ p.either
       (s.form (do p.monad
-                [_ (s.this (' #enum))
+                [_ (s.this! (' #enum))
                  enum-members (p.some s.local-identifier)]
                 (wrap (#EnumDecl enum-members))))
       (s.form (do p.monad
                 [tvars (p.default (list) (type-params^ imports))
-                 _ (s.this (' new))
+                 _ (s.this! (' new))
                  ?alias import-member-alias^
                  #let [total-vars (list@compose owner-vars tvars)]
                  ?prim-mode (p.maybe primitive-mode^)
@@ -1030,7 +1030,7 @@
                 ))
       (s.form (do p.monad
                 [kind (: (Parser ImportMethodKind)
-                         (p.or (s.this (' #static))
+                         (p.or (s.this! (' #static))
                                (wrap [])))
                  tvars (p.default (list) (type-params^ imports))
                  name s.local-identifier
@@ -1052,12 +1052,12 @@
                                      #import-method-return  return
                                      }]))))
       (s.form (do p.monad
-                [static? (s.this? (' #static))
+                [static? (p.parses? (s.this! (' #static)))
                  name s.local-identifier
                  ?prim-mode (p.maybe primitive-mode^)
                  gtype (generic-type^ imports owner-vars)
-                 maybe? (s.this? (' #?))
-                 setter? (s.this? (' #!))]
+                 maybe? (p.parses? (s.this! (' #?)))
+                 setter? (p.parses? (s.this! (' #!)))]
                 (wrap (#FieldAccessDecl {#import-field-mode    (maybe.default #AutoPrM ?prim-mode)
                                          #import-field-name    name
                                          #import-field-static? static?
@@ -1221,7 +1221,7 @@
     
     (#OverridenMethod strict-fp? class-decl type-vars this-name arg-decls return-type body exs)
     (let [super-replacer (parser->replacer (s.form (do p.monad
-                                                     [_ (s.this (' ::super!))
+                                                     [_ (s.this! (' ::super!))
                                                       args (s.tuple (p.exactly (list.size arg-decls) s.any))
                                                       #let [arg-decls' (: (List Text) (list@map (|>> product.right (simple-class$ (list)))
                                                                                                 arg-decls))]]
@@ -1797,7 +1797,7 @@
 
 (syntax: #export (import:
                    {#let [imports (class-imports *compiler*)]}
-                   {long-name? (s.this? (' #long))}
+                   {long-name? (p.parses? (s.this! (' #long)))}
                    {class-decl (class-decl^ imports)}
                    {#let [full-class-name (product.left class-decl)
                           imports (add-import [(short-class-name full-class-name) full-class-name]
diff --git a/stdlib/source/lux/macro/syntax/common/reader.lux b/stdlib/source/lux/macro/syntax/common/reader.lux
index 069bf1cf0..d57e4bcde 100644
--- a/stdlib/source/lux/macro/syntax/common/reader.lux
+++ b/stdlib/source/lux/macro/syntax/common/reader.lux
@@ -17,7 +17,7 @@
 
 (def: #export export
   (Parser Bit)
-  (p.either (p.after (s.this (' #export)) (p@wrap #1))
+  (p.either (p.after (s.tag! (name-of #export)) (p@wrap #1))
             (p@wrap #0)))
 
 (def: #export declaration
@@ -39,7 +39,7 @@
 (def: check^
   (Parser [(Maybe Code) Code])
   (p.either (s.form (do p.monad
-                      [_ (s.this (' "lux check"))
+                      [_ (s.text! "lux check")
                        type s.any
                        value s.any]
                       (wrap [(#.Some type) value])))
@@ -52,9 +52,9 @@
 
 (def: (_definition-anns^ _)
   (-> Any (Parser //.Annotations))
-  (p.or (s.this (' #.Nil))
+  (p.or (s.tag! (name-of #.Nil))
         (s.form (do p.monad
-                  [_ (s.this (' #.Cons))
+                  [_ (s.tag! (name-of #.Cons))
                    [head tail] (p.and (s.tuple (p.and _definition-anns-tag^ s.any))
                                       (_definition-anns^ []))]
                   (wrap [head tail])))
@@ -63,10 +63,10 @@
 (def: (flat-list^ _)
   (-> Any (Parser (List Code)))
   (p.either (do p.monad
-              [_ (s.this (' #.Nil))]
+              [_ (s.tag! (name-of #.Nil))]
               (wrap (list)))
             (s.form (do p.monad
-                      [_ (s.this (' #.Cons))
+                      [_ (s.tag! (name-of #.Cons))
                        [head tail] (s.tuple (p.and s.any s.any))
                        tail (s.local (list tail) (flat-list^ []))]
                       (wrap (#.Cons head tail))))))
@@ -78,7 +78,7 @@
          (p.after s.any)
          s.form
          (do p.monad
-           [_ (s.this (' <tag>))]
+           [_ (s.tag! (name-of <tag>))]
            <then>)))]
 
   [tuple-meta^ (List Code) #.Tuple (flat-list^ [])]
@@ -111,7 +111,7 @@
                            s.lift)]
     (s.local me-definition-raw
              (s.form (do @
-                       [_ (s.this (' "lux def"))
+                       [_ (s.text! "lux def")
                         definition-name s.local-identifier
                         [?definition-type definition-value] check^
                         definition-anns s.any