- Moved "luxc/lang/syntax" to "lux/lang/syntax".

- Minor refactoring.

2 files changed, 234 insertions, 0 deletions

diff --git a/stdlib/test/test/lux/lang/syntax.lux b/stdlib/test/test/lux/lang/syntax.lux
new file mode 100644
index 000000000..4db181cae
--- /dev/null
+++ b/stdlib/test/test/lux/lang/syntax.lux
@@ -0,0 +1,233 @@
+(;module:
+  lux
+  (lux [io]
+       (control [monad #+ do])
+       (data [number]
+             ["e" error]
+             [text]
+             (text format
+                   ["l" lexer])
+             (coll [list]))
+       ["r" math/random "r/" Monad<Random>]
+       (meta [code])
+       (lang ["&" syntax])
+       test))
+
+(def: default-cursor
+  Cursor
+  {#;module ""
+   #;line   +0
+   #;column +0})
+
+(def: ident-part^
+  (r;Random Text)
+  (do r;Monad<Random>
+    [#let [digits "0123456789"
+           delimiters "()[]{}#;\""
+           space "\t\v \n\r\f"
+           invalid-range (format digits delimiters space)
+           char-gen (|> r;nat
+                        (r;filter (function [sample]
+                                    (not (text;contains? (text;from-code sample)
+                                                         invalid-range)))))]
+     size (|> r;nat (:: @ map (|>. (n.% +20) (n.max +1))))]
+    (r;text' char-gen size)))
+
+(def: ident^
+  (r;Random Ident)
+  (r;seq ident-part^ ident-part^))
+
+(def: code^
+  (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])))))
+        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])))))
+        simple^ (: (r;Random Code)
+                   ($_ r;either
+                       numeric^
+                       textual^))]
+    (r;rec
+     (function [code^]
+       (let [multi^ (do r;Monad<Random>
+                      [size (|> r;nat (r/map (n.% +3)))]
+                      (r;list size code^))
+             composite^ (: (r;Random Code)
+                           ($_ r;either
+                               (|> multi^ (r/map (|>. #;Form [default-cursor])))
+                               (|> multi^ (r/map (|>. #;Tuple [default-cursor])))
+                               (do r;Monad<Random>
+                                 [size (|> r;nat (r/map (n.% +3)))]
+                                 (|> (r;list size (r;seq code^ code^))
+                                     (r/map (|>. #;Record [default-cursor]))))))]
+         (r;either simple^
+                   composite^))))))
+
+(context: "Lux code syntax."
+  (<| (times +100)
+      (do @
+        [sample code^
+         other code^]
+        ($_ seq
+            (test "Can parse Lux code."
+                  (case (&;parse "" [default-cursor +0 (code;to-text sample)])
+                    (#e;Error error)
+                    false
+
+                    (#e;Success [_ parsed])
+                    (:: code;Eq<Code> = parsed sample)))
+            (test "Can parse Lux multiple code nodes."
+                  (case (&;parse "" [default-cursor +0 (format (code;to-text sample) " "
+                                                               (code;to-text other))])
+                    (#e;Error error)
+                    false
+
+                    (#e;Success [remaining =sample])
+                    (case (&;parse "" remaining)
+                      (#e;Error error)
+                      false
+
+                      (#e;Success [_ =other])
+                      (and (:: code;Eq<Code> = sample =sample)
+                           (:: code;Eq<Code> = other =other)))))
+            ))))
+
+(def: nat-to-frac
+  (-> Nat Frac)
+  (|>. nat-to-int int-to-frac))
+
+(context: "Frac special syntax."
+  (<| (times +100)
+      (do @
+        [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 +0
+                                 (format (if signed? "-" "")
+                                         (%i (frac-to-int numerator))
+                                         "/"
+                                         (%i (frac-to-int denominator)))])
+                (#e;Success [_ [_ (#;Frac actual)]])
+                (f.= expected actual)
+
+                _
+                false)
+              ))))
+
+(context: "Nat special syntax."
+  (<| (times +100)
+      (do @
+        [expected (|> r;nat (:: @ map (n.% +1_000)))]
+        (test "Can parse nat char syntax."
+              (case (&;parse "" [default-cursor +0
+                                 (format "#" (%t (text;from-code expected)) "")])
+                (#e;Success [_ [_ (#;Nat actual)]])
+                (n.= expected actual)
+
+                _
+                false)
+              ))))
+
+(def: comment-text^
+  (r;Random Text)
+  (let [char-gen (|> r;nat (r;filter (function [value]
+                                       (not (or (text;space? value)
+                                                (n.= (char "#") value)
+                                                (n.= (char "(") value)
+                                                (n.= (char ")") value))))))]
+    (do r;Monad<Random>
+      [size (|> r;nat (r/map (n.% +20)))]
+      (r;text' char-gen size))))
+
+(def: comment^
+  (r;Random Text)
+  (r;either (do r;Monad<Random>
+              [comment comment-text^]
+              (wrap (format "## " comment "\n")))
+            (r;rec (function [nested^]
+                     (do r;Monad<Random>
+                       [comment (r;either comment-text^
+                                          nested^)]
+                       (wrap (format "#( " comment " )#")))))))
+
+(context: "Multi-line text & comments."
+  (<| (times +100)
+      (do @
+        [#let [char-gen (|> r;nat (r;filter (function [value]
+                                              (not (or (text;space? value)
+                                                       (n.= (char "\"") value))))))]
+         x char-gen
+         y char-gen
+         z char-gen
+         offset-size (|> r;nat (r/map (|>. (n.% +10) (n.max +1))))
+         #let [offset (text;join-with "" (list;repeat offset-size " "))]
+         sample code^
+         comment comment^
+         unbalanced-comment comment-text^]
+        ($_ seq
+            (test "Will reject invalid multi-line text."
+                  (let [bad-match (format (text;from-code x) "\n"
+                                          (text;from-code y) "\n"
+                                          (text;from-code z))]
+                    (case (&;parse "" [default-cursor +0
+                                       (format "\"" bad-match "\"")])
+                      (#e;Error error)
+                      true
+
+                      (#e;Success [_ parsed])
+                      false)))
+            (test "Will accept valid multi-line text"
+                  (let [good-input (format (text;from-code x) "\n"
+                                           offset (text;from-code y) "\n"
+                                           offset (text;from-code z))
+                        good-output (format (text;from-code x) "\n"
+                                            (text;from-code y) "\n"
+                                            (text;from-code z))]
+                    (case (&;parse "" [(|> default-cursor (update@ #;column (n.+ (n.dec offset-size))))
+                                       +0
+                                       (format "\"" good-input "\"")])
+                      (#e;Error error)
+                      false
+
+                      (#e;Success [_ parsed])
+                      (:: code;Eq<Code> =
+                          parsed
+                          (code;text good-output)))))
+            (test "Can handle comments."
+                  (case (&;parse "" [default-cursor +0
+                                     (format comment (code;to-text sample))])
+                    (#e;Error error)
+                    false
+
+                    (#e;Success [_ parsed])
+                    (:: code;Eq<Code> = parsed sample)))
+            (test "Will reject unbalanced multi-line comments."
+                  (and (case (&;parse "" [default-cursor +0
+                                          (format "#(" "#(" unbalanced-comment ")#"
+                                                  (code;to-text sample))])
+                         (#e;Error error)
+                         true
+
+                         (#e;Success [_ parsed])
+                         false)
+                       (case (&;parse "" [default-cursor +0
+                                          (format "#(" unbalanced-comment ")#" ")#"
+                                                  (code;to-text sample))])
+                         (#e;Error error)
+                         true
+
+                         (#e;Success [_ parsed])
+                         false)))
+            ))))
diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux
index aa816c4d3..ea0aa72f7 100644
--- a/stdlib/test/tests.lux
+++ b/stdlib/test/tests.lux
@@ -70,6 +70,7 @@
                    (type ["_;" check]
                          ["_;" auto]
                          ["_;" object]))
+             (lang ["lang_;" syntax])
              (world ["_;" blob]
                     ["_;" file]
                     (net ["_;" tcp]