From 223ce32a52276f9a85fdd7918a46b58b4223738c Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 5 Sep 2017 19:43:22 -0400 Subject: - Added alternative syntax for Frac numbers, based on traditional ratio/fraction syntax. --- lux-mode/lux-mode.el | 5 +- new-luxc/source/luxc/parser.lux | 123 ++++++++++++++++++++++++------------- new-luxc/test/test/luxc/parser.lux | 22 +++++++ 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 ( value)]]))))] - [parse-bool #;Bool + [bool #;Bool (p;either (marker^ "true") (marker^ "false")) bool;Codec] - [parse-nat #;Nat + [nat #;Nat (l;seq (l;one-of "+") rich-digits^) number;Codec] - [parse-int #;Int + [int #;Int (l;seq (p;default "" (l;one-of "-")) rich-digits^) number;Codec] - [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] - - [parse-deg #;Deg + [deg #;Deg (l;seq (l;one-of ".") rich-digits^) number;Codec] ) +(def: (normal-frac where) + (-> Cursor (l;Lexer [Cursor Code])) + (do p;Monad + [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 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) + (:: p;Monad map (function [digits] + (format digits ".0"))) + rich-digits^)) + +(def: (ratio-frac where) + (-> Cursor (l;Lexer [Cursor Code])) + (do p;Monad + [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 [## 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 [ ] - [(def: ( where parse-ast) + [(def: ( 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 ( 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.+ length)) where) [where ( 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 [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 = 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] -- cgit v1.2.3