- Added optional "char" syntax for nats.

2 files changed, 55 insertions, 5 deletions

diff --git a/new-luxc/source/luxc/parser.lux b/new-luxc/source/luxc/parser.lux
index bc70dfe91..2e8ad1fd5 100644
--- a/new-luxc/source/luxc/parser.lux
+++ b/new-luxc/source/luxc/parser.lux
@@ -221,11 +221,6 @@
    (p;either (marker^ "true") (marker^ "false"))
    bool;Codec<Text,Bool>]
   
-  [nat #;Nat
-   (l;seq (l;one-of "+")
-          rich-digits^)
-   number;Codec<Text,Nat>]
-  
   [int #;Int
    (l;seq (p;default "" (l;one-of "-"))
           rich-digits^)
@@ -237,6 +232,49 @@
    number;Codec<Text,Deg>]
   )
 
+(def: (nat-char where)
+  (-> Cursor (l;Lexer [Cursor Code]))
+  (do p;Monad<Parser>
+    [_ (l;this "#\"")
+     [where' char] (: (l;Lexer [Cursor Text])
+                      ($_ p;either
+                          ## Normal text characters.
+                          (do @
+                            [normal (l;none-of "\\\"\n")]
+                            (wrap [(|> where
+                                       (update@ #;column n.inc))
+                                   normal]))
+                          ## Must handle escaped
+                          ## chars separately.
+                          (do @
+                            [[chars-consumed char] escaped-char^]
+                            (wrap [(|> where
+                                       (update@ #;column (n.+ chars-consumed)))
+                                   char]))))
+     _ (l;this "\"")
+     #let [char (assume (text;nth +0 char))]]
+    (wrap [(|> where'
+               (update@ #;column n.inc))
+           [where (#;Nat char)]])))
+
+(def: (normal-nat where)
+  (-> Cursor (l;Lexer [Cursor Code]))
+  (do p;Monad<Parser>
+    [chunk (l;seq (l;one-of "+")
+                  rich-digits^)]
+    (case (:: number;Codec<Text,Nat> decode chunk)
+      (#;Left error)
+      (p;fail error)
+
+      (#;Right value)
+      (wrap [(update@ #;column (n.+ (text;size chunk)) where)
+             [where (#;Nat value)]]))))
+
+(def: #export (nat where)
+  (-> Cursor (l;Lexer [Cursor Code]))
+  (p;either (normal-nat where)
+            (nat-char where)))
+
 (def: (normal-frac where)
   (-> Cursor (l;Lexer [Cursor Code]))
   (do p;Monad<Parser>
diff --git a/new-luxc/test/test/luxc/parser.lux b/new-luxc/test/test/luxc/parser.lux
index 4c1b65584..247850e2b 100644
--- a/new-luxc/test/test/luxc/parser.lux
+++ b/new-luxc/test/test/luxc/parser.lux
@@ -106,6 +106,18 @@
           false)
         ))
 
+(context: "Nat special syntax."
+  [expected (|> r;nat (:: @ map (n.% +1_000)))]
+  (test "Can parse nat char syntax."
+        (case (&;parse [default-cursor
+                        (format "#\"" (text;from-code expected) "\"")])
+          (#R;Success [_ [_ (#;Nat actual)]])
+          (n.= expected actual)
+
+          _
+          false)
+        ))
+
 (def: comment-text^
   (r;Random Text)
   (let [char-gen (|> r;nat (r;filter (function [value]