aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2017-09-05 20:04:23 -0400
committerEduardo Julian2017-09-05 20:04:23 -0400
commit0550e3e263eb7e15b83756976a6cc2c5e18022a7 (patch)
treee829b6cde0adade146a4bd70df9df1d9293019f4
parent223ce32a52276f9a85fdd7918a46b58b4223738c (diff)
- Added optional "char" syntax for nats.
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/parser.lux48
-rw-r--r--new-luxc/test/test/luxc/parser.lux12
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]