From 3b80f40384a8af8770a7c4f1be8b334ceb950a27 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Tue, 8 May 2018 23:07:21 -0400
Subject: - Improved the way Bool values are parsed.

---
 stdlib/source/lux/lang/syntax.lux    | 50 ++++++++++++++++--------------------
 stdlib/test/test/lux/lang/syntax.lux | 22 ++++++++--------
 2 files changed, 33 insertions(+), 39 deletions(-)

diff --git a/stdlib/source/lux/lang/syntax.lux b/stdlib/source/lux/lang/syntax.lux
index d30436533..6c7236f76 100644
--- a/stdlib/source/lux/lang/syntax.lux
+++ b/stdlib/source/lux/lang/syntax.lux
@@ -29,8 +29,7 @@
   (lux (control monad
                 ["p" parser "p/" Monad<Parser>]
                 ["ex" exception #+ exception:])
-       (data [bool]
-             ["e" error]
+       (data ["e" error]
              [number]
              [product]
              [maybe]
@@ -205,10 +204,6 @@
   (l.seq l.decimal
          (l.some rich-digit)))
 
-(def: (marker^ token)
-  (-> Text (l.Lexer Text))
-  (p.after (l.this token) (p/wrap token)))
-
 (do-template [<name> <tag> <lexer> <codec>]
   [(def: #export (<name> where)
      (-> Cursor (l.Lexer [Cursor Code]))
@@ -222,10 +217,6 @@
          (wrap [(update@ #.column (n/+ (text.size chunk)) where)
                 [where (<tag> value)]]))))]
 
-  [bool #.Bool
-   (p.either (marker^ "true") (marker^ "false"))
-   bool.Codec<Text,Bool>]
-  
   [int #.Int
    (l.seq (p.default "" (l.one-of "-"))
           rich-digits^)
@@ -570,24 +561,28 @@
                   (wrap [["" first-part]
                          (text.size first-part)])))))
 
-## The only (syntactic) difference between a symbol and a tag (both
-## being identifiers), is that tags must be prefixed with a hash-sign
-## (i.e. #).
-## Semantically, though, they are very different, with symbols being
-## used to refer to module definitions and local variables, while tags
-## provide the compiler with information related to data-structure
-## construction and de-structuring (during pattern-matching).
-(do-template [<name> <tag> <lexer> <extra>]
-  [(def: #export (<name> current-module aliases where)
-     (-> Text Aliases Cursor (l.Lexer [Cursor Code]))
-     (do p.Monad<Parser>
-       [[value length] <lexer>]
-       (wrap [(update@ #.column (|>> ($_ n/+ <extra> length)) where)
-              [where (<tag> value)]])))]
+(def: #export (tag current-module aliases where)
+  (-> Text Aliases Cursor (l.Lexer [Cursor Code]))
+  (do p.Monad<Parser>
+    [[value length] (p.after (l.this "#")
+                             (ident^ current-module aliases))]
+    (wrap [(update@ #.column (|>> ($_ n/+ +1 length)) where)
+           [where (#.Tag value)]])))
 
-  [symbol #.Symbol (ident^ current-module aliases)                        +0]
-  [tag    #.Tag    (p.after (l.this "#") (ident^ current-module aliases)) +1]
-  )
+(def: #export (symbol current-module aliases where)
+  (-> Text Aliases Cursor (l.Lexer [Cursor Code]))
+  (do p.Monad<Parser>
+    [[value length] (ident^ current-module aliases)]
+    (wrap [(update@ #.column (|>> (n/+ length)) where)
+           [where (case value
+                    (^template [<name> <value>]
+                      ["" <name>]
+                      (#.Bool <value>))
+                    (["true"  true]
+                     ["false" false])
+                    
+                    _
+                    (#.Symbol value))]])))
 
 (exception: #export (end-of-file {module Text})
   module)
@@ -607,7 +602,6 @@
              (form where ast')
              (tuple where ast')
              (record where ast')
-             (bool where)
              (nat where)
              (frac where)
              (int where)
diff --git a/stdlib/test/test/lux/lang/syntax.lux b/stdlib/test/test/lux/lang/syntax.lux
index 9d1f18ae5..68830f271 100644
--- a/stdlib/test/test/lux/lang/syntax.lux
+++ b/stdlib/test/test/lux/lang/syntax.lux
@@ -43,18 +43,18 @@
   (r.Random Code)
   (let [numeric^ (: (r.Random Code)
                     ($_ r.either
-                        (|> r.bool (r/map (|>> #.Bool [default-cursor])))
-                        (|> r.nat (r/map (|>> #.Nat [default-cursor])))
-                        (|> r.int (r/map (|>> #.Int [default-cursor])))
-                        (|> r.deg (r/map (|>> #.Deg [default-cursor])))
-                        (|> r.frac (r/map (|>> #.Frac [default-cursor])))))
+                        (|> r.bool (r/map code.bool))
+                        (|> r.nat (r/map code.nat))
+                        (|> r.int (r/map code.int))
+                        (|> r.deg (r/map code.deg))
+                        (|> r.frac (r/map code.frac))))
         textual^ (: (r.Random Code)
                     ($_ r.either
                         (do r.Monad<Random>
                           [size (|> r.nat (r/map (n/% +20)))]
-                          (|> (r.text size) (r/map (|>> #.Text [default-cursor]))))
-                        (|> ident^ (r/map (|>> #.Symbol [default-cursor])))
-                        (|> ident^ (r/map (|>> #.Tag [default-cursor])))))
+                          (|> (r.text size) (r/map code.text)))
+                        (|> ident^ (r/map code.symbol))
+                        (|> ident^ (r/map code.tag))))
         simple^ (: (r.Random Code)
                    ($_ r.either
                        numeric^
@@ -66,12 +66,12 @@
                       (r.list size code^))
              composite^ (: (r.Random Code)
                            ($_ r.either
-                               (|> multi^ (r/map (|>> #.Form [default-cursor])))
-                               (|> multi^ (r/map (|>> #.Tuple [default-cursor])))
+                               (|> multi^ (r/map code.form))
+                               (|> multi^ (r/map code.tuple))
                                (do r.Monad<Random>
                                  [size (|> r.nat (r/map (n/% +3)))]
                                  (|> (r.list size (r.seq code^ code^))
-                                     (r/map (|>> #.Record [default-cursor]))))))]
+                                     (r/map code.record)))))]
          (r.either simple^
                    composite^))))))
 
-- 
cgit v1.2.3