aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--lux-mode/lux-mode.el5
-rw-r--r--new-luxc/source/luxc/parser.lux123
-rw-r--r--new-luxc/test/test/luxc/parser.lux22
3 files changed, 108 insertions, 42 deletions
diff --git a/lux-mode/lux-mode.el b/lux-mode/lux-mode.el
index c26c2f77e..c6f7e4b58 100644
--- a/lux-mode/lux-mode.el
+++ b/lux-mode/lux-mode.el
@@ -252,8 +252,11 @@ Called by `imenu--generic-function'."
0 font-lock-constant-face)
; Nat literals
("\\<\\+\\(0\\|[1-9][0-9_]*\\)\\>" 0 font-lock-constant-face)
- ; Int|Real literals
+ ; Int|Frac literals
("\\<-?\\(0\\|[1-9][0-9_]*\\)\\(\\.[0-9_]+\\)?\\>" 0 font-lock-constant-face)
+ ("\\<-?\\(0\\|[1-9][0-9_]*\\)\\(\\.[0-9_]+\\(\\(e\\|E\\)\\(-\\|\\+\\)?[1-9][0-9_]*\\)?\\)?\\>" 0 font-lock-constant-face)
+ ; Frac "ratio" literals
+ ("\\<-?\\(0\\|[1-9][0-9_]*\\)/[1-9][0-9_]*\\>" 0 font-lock-constant-face)
; Deg literals
("\\<\\(\\.[0-9_]+\\)\\>" 0 font-lock-constant-face)
; Tags
diff --git a/new-luxc/source/luxc/parser.lux b/new-luxc/source/luxc/parser.lux
index d061fdda5..bc70dfe91 100644
--- a/new-luxc/source/luxc/parser.lux
+++ b/new-luxc/source/luxc/parser.lux
@@ -24,7 +24,6 @@
## Lux Code nodes/tokens are annotated with cursor meta-data
## (file-name, line, column) to keep track of their provenance and
## location, which is helpful for documentation and debugging.
-
(;module:
lux
(lux (control monad
@@ -218,42 +217,84 @@
(wrap [(update@ #;column (n.+ (text;size chunk)) where)
[where (<tag> value)]]))))]
- [parse-bool #;Bool
+ [bool #;Bool
(p;either (marker^ "true") (marker^ "false"))
bool;Codec<Text,Bool>]
- [parse-nat #;Nat
+ [nat #;Nat
(l;seq (l;one-of "+")
rich-digits^)
number;Codec<Text,Nat>]
- [parse-int #;Int
+ [int #;Int
(l;seq (p;default "" (l;one-of "-"))
rich-digits^)
number;Codec<Text,Int>]
- [parse-frac #;Frac
- ($_ l;seq
- (p;default "" (l;one-of "-"))
- rich-digits^
- (l;one-of ".")
- rich-digits^
- (p;default ""
- ($_ l;seq
- (l;one-of "eE")
- (p;default "" (l;one-of "+-"))
- (l;many l;decimal))))
- number;Codec<Text,Frac>]
-
- [parse-deg #;Deg
+ [deg #;Deg
(l;seq (l;one-of ".")
rich-digits^)
number;Codec<Text,Deg>]
)
+(def: (normal-frac where)
+ (-> Cursor (l;Lexer [Cursor Code]))
+ (do p;Monad<Parser>
+ [chunk ($_ l;seq
+ (p;default "" (l;one-of "-"))
+ rich-digits^
+ (l;one-of ".")
+ rich-digits^
+ (p;default ""
+ ($_ l;seq
+ (l;one-of "eE")
+ (p;default "" (l;one-of "+-"))
+ rich-digits^)))]
+ (case (:: number;Codec<Text,Frac> decode chunk)
+ (#;Left error)
+ (p;fail error)
+
+ (#;Right value)
+ (wrap [(update@ #;column (n.+ (text;size chunk)) where)
+ [where (#;Frac value)]]))))
+
+(def: frac-ratio-fragment
+ (l;Lexer Frac)
+ (<| (p;codec number;Codec<Text,Frac>)
+ (:: p;Monad<Parser> map (function [digits]
+ (format digits ".0")))
+ rich-digits^))
+
+(def: (ratio-frac where)
+ (-> Cursor (l;Lexer [Cursor Code]))
+ (do p;Monad<Parser>
+ [chunk ($_ l;seq
+ (p;default "" (l;one-of "-"))
+ rich-digits^
+ (l;one-of "/")
+ rich-digits^)
+ value (l;local chunk
+ (do @
+ [signed? (l;this? "-")
+ numerator frac-ratio-fragment
+ _ (l;this? "/")
+ denominator frac-ratio-fragment
+ _ (p;assert "Denominator cannot be 0."
+ (not (f.= 0.0 denominator)))]
+ (wrap (|> numerator
+ (f.* (if signed? -1.0 1.0))
+ (f./ denominator)))))]
+ (wrap [(update@ #;column (n.+ (text;size chunk)) where)
+ [where (#;Frac value)]])))
+
+(def: #export (frac where)
+ (-> Cursor (l;Lexer [Cursor Code]))
+ (p;either (normal-frac where)
+ (ratio-frac where)))
+
## This parser looks so complex because text in Lux can be multi-line
## and there are rules regarding how this is handled.
-(def: #export (parse-text where)
+(def: #export (text where)
(-> Cursor (l;Lexer [Cursor Code]))
(do p;Monad<Parser>
[## Lux text "is delimited by double-quotes", as usual in most
@@ -343,7 +384,7 @@
## delimiters involved.
## They may have an arbitrary number of arbitrary Code nodes as elements.
(do-template [<name> <tag> <open> <close>]
- [(def: (<name> where parse-ast)
+ [(def: (<name> where ast)
(-> Cursor
(-> Cursor (l;Lexer [Cursor Code]))
(l;Lexer [Cursor Code]))
@@ -355,7 +396,7 @@
(p;either (do @
[## Must update the cursor as I
## go along, to keep things accurate.
- [where' elem] (parse-ast where)]
+ [where' elem] (ast where)]
(recur (V;add elem elems)
where'))
(do @
@@ -369,8 +410,8 @@
(wrap [where'
[where (<tag> elems)]])))]
- [parse-form #;Form "(" ")"]
- [parse-tuple #;Tuple "[" "]"]
+ [form #;Form "(" ")"]
+ [tuple #;Tuple "[" "]"]
)
## Records are almost (syntactically) the same as forms and tuples,
@@ -382,7 +423,7 @@
## Code node, however, record Code nodes allow any Code node to occupy
## this position, since it may be useful when processing Code syntax in
## macros.
-(def: (parse-record where parse-ast)
+(def: (record where ast)
(-> Cursor
(-> Cursor (l;Lexer [Cursor Code]))
(l;Lexer [Cursor Code]))
@@ -392,8 +433,8 @@
V;empty)
where where]
(p;either (do @
- [[where' key] (parse-ast where)
- [where' val] (parse-ast where')]
+ [[where' key] (ast where)
+ [where' val] (ast where')]
(recur (V;add [key val] elems)
where'))
(do @
@@ -498,31 +539,31 @@
(wrap [(update@ #;column (|>. ($_ n.+ <extra> length)) where)
[where (<tag> value)]])))]
- [parse-symbol #;Symbol ident^ +0]
- [parse-tag #;Tag (p;after (l;this "#") ident^) +1]
+ [symbol #;Symbol ident^ +0]
+ [tag #;Tag (p;after (l;this "#") ident^) +1]
)
-(def: (parse-ast where)
+(def: (ast where)
(-> Cursor (l;Lexer [Cursor Code]))
(do p;Monad<Parser>
[where (left-padding^ where)]
($_ p;either
- (parse-form where parse-ast)
- (parse-tuple where parse-ast)
- (parse-record where parse-ast)
- (parse-bool where)
- (parse-nat where)
- (parse-frac where)
- (parse-int where)
- (parse-deg where)
- (parse-symbol where)
- (parse-tag where)
- (parse-text where)
+ (form where ast)
+ (tuple where ast)
+ (record where ast)
+ (bool where)
+ (nat where)
+ (frac where)
+ (int where)
+ (deg where)
+ (symbol where)
+ (tag where)
+ (text where)
)))
(def: #export (parse [where code])
(-> [Cursor Text] (R;Result [[Cursor Text] Code]))
- (case (p;run [+0 code] (parse-ast where))
+ (case (p;run [+0 code] (ast where))
(#R;Error error)
(#R;Error error)
diff --git a/new-luxc/test/test/luxc/parser.lux b/new-luxc/test/test/luxc/parser.lux
index 7a0b2c278..4c1b65584 100644
--- a/new-luxc/test/test/luxc/parser.lux
+++ b/new-luxc/test/test/luxc/parser.lux
@@ -84,6 +84,28 @@
(:: code;Eq<Code> = parsed sample))
))
+(def: nat-to-frac
+ (-> Nat Frac)
+ (|>. nat-to-int int-to-frac))
+
+(context: "Frac special syntax."
+ [numerator (|> r;nat (:: @ map (|>. (n.% +100) nat-to-frac)))
+ denominator (|> r;nat (:: @ map (|>. (n.% +100) (n.max +1) nat-to-frac)))
+ signed? r;bool
+ #let [expected (|> numerator (f./ denominator) (f.* (if signed? -1.0 1.0)))]]
+ (test "Can parse frac ratio syntax."
+ (case (&;parse [default-cursor
+ (format (if signed? "-" "")
+ (%i (frac-to-int numerator))
+ "/"
+ (%i (frac-to-int denominator)))])
+ (#R;Success [_ [_ (#;Frac actual)]])
+ (f.= expected actual)
+
+ _
+ false)
+ ))
+
(def: comment-text^
(r;Random Text)
(let [char-gen (|> r;nat (r;filter (function [value]
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-26 00:50:29 +0000