- Added all the missing tests for translation of common procedures.

- Implemented some missing process functionality in the JVM runtime.
- Minor bug fixes.

1 files changed, 458 insertions, 13 deletions

diff --git a/new-luxc/test/test/luxc/lang/translation/common.lux b/new-luxc/test/test/luxc/lang/translation/common.lux
index 7e46abfda..d3f1e9cf4 100644
--- a/new-luxc/test/test/luxc/lang/translation/common.lux
+++ b/new-luxc/test/test/luxc/lang/translation/common.lux
@@ -17,7 +17,7 @@
        [host]
        test)
   (luxc [lang]
-        (lang ["ls" synthesis]
+        (lang [synthesis #+ Synthesis]
               (translation (jvm [".T_jvm" eval]
                                 [".T_jvm" expression]
                                 [".T_jvm" runtime])
@@ -28,7 +28,7 @@
 
 (def: (bit-spec translate-expression eval translate-runtime init)
   (All [a]
-    (-> (-> ls.Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler)
+    (-> (-> Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler)
         Test))
   (do r.Monad<Random>
     [param r.nat
@@ -90,7 +90,7 @@
 
 (def: (nat-spec translate-expression eval translate-runtime init)
   (All [a]
-    (-> (-> ls.Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler)
+    (-> (-> Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler)
         Test))
   (do r.Monad<Random>
     [param (|> r.nat (r.filter (|>> (n/= +0) not)))
@@ -157,7 +157,7 @@
 
 (def: (int-spec translate-expression eval translate-runtime init)
   (All [a]
-    (-> (-> ls.Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler)
+    (-> (-> Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler)
         Test))
   (do r.Monad<Random>
     [param (|> r.int (r.filter (|>> (i/= 0) not)))
@@ -226,7 +226,7 @@
 
 (def: (frac-spec|0 translate-expression eval translate-runtime init)
   (All [a]
-    (-> (-> ls.Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler)
+    (-> (-> Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler)
         Test))
   (do r.Monad<Random>
     [param (|> r.frac (r.filter (|>> (f/= 0.0) not)))
@@ -259,7 +259,7 @@
 
 (def: (frac-spec|1 translate-expression eval translate-runtime init)
   (All [a]
-    (-> (-> ls.Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler)
+    (-> (-> Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler)
         Test))
   (do r.Monad<Random>
     [param (|> r.frac (r.filter (|>> (f/= 0.0) not)))
@@ -321,7 +321,7 @@
 
 (def: (frac-spec translate-expression eval translate-runtime init)
   (All [a]
-    (-> (-> ls.Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler)
+    (-> (-> Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler)
         Test))
   ($_ seq
       (frac-spec|0 translate-expression eval translate-runtime init)
@@ -346,7 +346,7 @@
 
 (def: (deg-spec translate-expression eval translate-runtime init)
   (All [a]
-    (-> (-> ls.Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler)
+    (-> (-> Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler)
         Test))
   (do r.Monad<Random>
     [param (|> r.deg (:: @ map above-threshold))
@@ -427,6 +427,387 @@
                   ))
             ))))
 
+(def: lower-alpha
+  (r.Random Nat)
+  (|> r.nat (:: r.Functor<Random> map (|>> (n/% +26) (n/+ +97)))))
+
+(def: upper-alpha
+  (r.Random Nat)
+  (|> r.nat (:: r.Functor<Random> map (|>> (n/% +26) (n/+ +65)))))
+
+(def: alpha
+  (r.Random Nat)
+  (r.either lower-alpha
+            upper-alpha))
+
+(def: (text-spec run)
+  (-> (-> Synthesis (e.Error Top)) Test)
+  (do r.Monad<Random>
+    [sample-size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1))))
+     sample0 (r.text' lower-alpha sample-size)
+     sample1 (r.text' upper-alpha sample-size)
+     sample2 (|> (r.text' alpha sample-size)
+                 (r.filter (|>> (text/= sample1) not)))
+     char-idx (|> r.nat (:: @ map (n/% sample-size)))
+     #let [sample0S (code.text sample0)
+           sample1S (code.text sample1)
+           sample2S (code.text sample2)
+           concatenatedS (` ("lux text concat" (~ sample0S) (~ sample1S)))
+           pre-rep-once (format sample0 sample1)
+           post-rep-once (format sample0 sample2)
+           pre-rep-all (|> (list.repeat sample-size sample0) (text.join-with sample1))
+           post-rep-all (|> (list.repeat sample-size sample0) (text.join-with sample2))]]
+    ($_ seq
+        (test "Can compare texts for equality."
+              (and (|> (run (` ("lux text =" (~ sample0S) (~ sample0S))))
+                       (case> (#e.Success valueV)
+                              (:! Bool valueV)
+
+                              _
+                              false))
+                   (|> (run (` ("lux text =" (~ sample0S) (~ sample1S))))
+                       (case> (#e.Success valueV)
+                              (not (:! Bool valueV))
+
+                              _
+                              false))))
+        (test "Can compare texts for order."
+              (|> (run (` ("lux text <" (~ sample1S) (~ sample0S))))
+                  (case> (#e.Success valueV)
+                         (:! Bool valueV)
+
+                         _
+                         false)))
+        (test "Can change case of text."
+              (and (|> (run (` ("lux text =" (~ sample0S) ("lux text upper" (~ sample0S)))))
+                       (case> (#e.Success valueV)
+                              (not (:! Bool valueV))
+
+                              _
+                              false))
+                   (|> (run (` ("lux text =" (~ sample0S) ("lux text lower" ("lux text upper" (~ sample0S))))))
+                       (case> (#e.Success valueV)
+                              (:! Bool valueV)
+
+                              _
+                              false))))
+        (test "Can get length of text."
+              (|> (run (` ("lux text size" (~ sample0S))))
+                  (case> (#e.Success valueV)
+                         (n/= sample-size (:! Nat valueV))
+
+                         _
+                         false)))
+        (test "Can concatenate text."
+              (|> (run (` ("lux text size" (~ concatenatedS))))
+                  (case> (#e.Success valueV)
+                         (n/= (n/* +2 sample-size) (:! Nat valueV))
+
+                         _
+                         false)))
+        (test "Can find index of sub-text."
+              (and (|> (run (` ("lux text index" (~ concatenatedS) (~ sample0S) +0)))
+                       (case> (^multi (#e.Success valueV)
+                                      [(:! (Maybe Nat) valueV) (#.Some valueV)])
+                              (n/= +0 valueV)
+
+                              _
+                              false))
+                   (|> (run (` ("lux text index" (~ concatenatedS) (~ sample1S) +0)))
+                       (case> (^multi (#e.Success valueV)
+                                      [(:! (Maybe Nat) valueV) (#.Some valueV)])
+                              (n/= sample-size valueV)
+
+                              _
+                              false))))
+        (test "Text hashing is consistent."
+              (|> (run (` ("lux nat =" ("lux text hash" (~ sample0S)) ("lux text hash" (~ sample0S)))))
+                  (case> (#e.Success valueV)
+                         (:! Bool valueV)
+                         
+                         _
+                         false)))
+        (test "Can replace sub-text once."
+              (|> (run (` ("lux text ="
+                           (~ (code.text post-rep-once))
+                           ("lux text replace-once"
+                            (~ (code.text pre-rep-once))
+                            (~ sample1S)
+                            (~ sample2S)))))
+                  (case> (#e.Success valueV)
+                         (:! Bool valueV)
+                         
+                         _
+                         false)))
+        (test "Can replace sub-text all times."
+              (|> (run (` ("lux text ="
+                           (~ (code.text post-rep-all))
+                           ("lux text replace-all"
+                            (~ (code.text pre-rep-all))
+                            (~ sample1S)
+                            (~ sample2S)))))
+                  (case> (#e.Success valueV)
+                         (:! Bool valueV)
+                         
+                         _
+                         false)))
+        (let [test-clip (function [from to expected]
+                          (|> (run (` ("lux text clip"
+                                       (~ concatenatedS)
+                                       (~ (code.nat from))
+                                       (~ (code.nat to)))))
+                              (case> (^multi (#e.Success valueV)
+                                             [(:! (Maybe Text) valueV) (#.Some valueV)])
+                                     (text/= expected valueV)
+
+                                     _
+                                     false)))]
+          (test "Can clip text to extract sub-text."
+                (and (test-clip +0 sample-size sample0)
+                     (test-clip sample-size (n/* +2 sample-size) sample1))))
+        (test "Can extract individual characters from text."
+              (|> (run (` ("lux text char"
+                           (~ sample0S)
+                           (~ (code.nat char-idx)))))
+                  (case> (^multi (#e.Success valueV)
+                                 [(:! (Maybe Nat) valueV) (#.Some valueV)])
+                         (text.contains? ("lux nat char" valueV)
+                                         sample0)
+
+                         _
+                         false)))
+        )))
+
+(def: (array-spec run)
+  (-> (-> Synthesis (e.Error Top)) Test)
+  (do r.Monad<Random>
+    [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1))))
+     idx (|> r.nat (:: @ map (n/% size)))
+     value r.nat
+     #let [array0S (` ("lux array new" (~ (code.nat size))))
+           array1S (` ("lux array put" (~ array0S) (~ (code.nat idx)) (~ (code.nat value))))]]
+    ($_ seq
+        (test "Can get size of array."
+              (|> (run (` ("lux array size" (~ array0S))))
+                  (case> (#e.Success valueV)
+                         (n/= size (:! Nat valueV))
+
+                         _
+                         false)))
+        (test "Can get element from array (if it exists)."
+              (and (|> (run (` ("lux array get" (~ array0S) (~ (code.nat idx)))))
+                       (case> (^multi (#e.Success valueV)
+                                      [(:! (Maybe Nat) valueV) #.None])
+                              true
+
+                              _
+                              false))
+                   (|> (run (` ("lux array get" (~ array1S) (~ (code.nat idx)))))
+                       (case> (^multi (#e.Success valueV)
+                                      [(:! (Maybe Nat) valueV) (#.Some valueV)])
+                              (n/= value valueV)
+
+                              _
+                              false))))
+        (test "Can remove element from array."
+              (|> (run (` ("lux array get"
+                           ("lux array remove" (~ array1S)
+                            (~ (code.nat idx)))
+                           (~ (code.nat idx)))))
+                  (case> (^multi (#e.Success valueV)
+                                 [(:! (Maybe Nat) valueV) #.None])
+                         true
+
+                         _
+                         false)))
+        )))
+
+(def: (math-spec run)
+  (-> (-> Synthesis (e.Error Top)) Test)
+  (do r.Monad<Random>
+    [subject r.frac
+     param r.frac]
+    (`` ($_ seq
+            (~~ (do-template [<name>]
+                  [(test (format "Can apply '" <name> "' procedure.")
+                         (|> (run (` (<name> (~ (code.frac subject)))))
+                             (case> (#e.Success valueV)
+                                    true
+
+                                    (#e.Error error)
+                                    false)))]
+
+                  ["lux math cos"]
+                  ["lux math sin"]
+                  ["lux math tan"]
+                  ["lux math acos"]
+                  ["lux math asin"]
+                  ["lux math atan"]
+                  ["lux math cosh"]
+                  ["lux math sinh"]
+                  ["lux math tanh"]
+                  ["lux math exp"]
+                  ["lux math log"]
+                  ["lux math root2"]
+                  ["lux math root3"]
+                  ["lux math ceil"]
+                  ["lux math floor"]
+                  ["lux math round"]))
+            (~~ (do-template [<name>]
+                  [(test (format "Can apply '" <name> "' procedure.")
+                         (|> (run (` (<name> (~ (code.frac subject)) (~ (code.frac param)))))
+                             (case> (#e.Success valueV)
+                                    true
+
+                                    (#e.Error error)
+                                    false)))]
+
+                  ["lux math atan2"]
+                  ["lux math pow"]))
+            ))))
+
+(def: (io-spec run)
+  (-> (-> Synthesis (e.Error Top)) Test)
+  (do r.Monad<Random>
+    [message (r.text +5)]
+    ($_ seq
+        (test "Can log messages."
+              (|> (run (` ("lux io log" (~ (code.text (format "LOG: " message))))))
+                  (case> (#e.Success valueV)
+                         true
+
+                         (#e.Error error)
+                         false)))
+        (test "Can throw runtime errors."
+              (and (|> (run (` ("lux try" ("lux function" +1 []
+                                           ("lux io error" (~ (code.text message)))))))
+                       (case> (^multi (#e.Success valueV)
+                                      [(:! (e.Error Text) valueV) (#e.Error error)])
+                              (text.contains? message error)
+
+                              _
+                              false))
+                   (|> (run (` ("lux try" ("lux function" +1 []
+                                           (~ (code.text message))))))
+                       (case> (^multi (#e.Success valueV)
+                                      [(:! (e.Error Text) valueV) (#e.Success valueV)])
+                              (text/= message valueV)
+
+                              _
+                              false))))
+        (test "Can obtain current time in milli-seconds."
+              (|> (run (` [("lux io current-time") ("lux io current-time")]))
+                  (case> (#e.Success valueV)
+                         (let [[pre post] (:! [Nat Nat] valueV)]
+                           (n/>= pre post))
+
+                         (#e.Error error)
+                         false)))
+        )))
+
+(def: (atom-spec run)
+  (-> (-> Synthesis (e.Error Top)) Test)
+  (do r.Monad<Random>
+    [pre r.nat
+     post (|> r.nat (r.filter (|>> (n/= pre) not)))
+     #let [preS (code.nat pre)
+           postS (code.nat post)
+           atomS (` ("lux atom new" (~ preS)))]]
+    ($_ seq
+        (test "Can read atoms."
+              (|> (run (` ("lux atom read" (~ atomS))))
+                  (case> (#e.Success valueV)
+                         (n/= pre (:! Nat valueV))
+
+                         (#e.Error error)
+                         false)))
+        (test "Can compare-and-swap atoms."
+              (and (|> (run (` ("lux let" +0 (~ preS)
+                                ("lux let" +1 ("lux atom new" (0))
+                                 [("lux atom compare-and-swap" (1) (0) (~ postS))
+                                  ("lux atom read" (1))]))))
+                       (case> (#e.Success valueV)
+                              (let [[swapped? current-value] (:! [Bool Nat] valueV)]
+                                (and swapped?
+                                     (n/= post current-value)))
+
+                              (#e.Error error)
+                              false))
+                   (|> (run (` ("lux let" +0 (~ preS)
+                                ("lux let" +1 ("lux atom new" (0))
+                                 [("lux atom compare-and-swap" (1) (~ postS) (~ postS))
+                                  ("lux atom read" (1))]))))
+                       (case> (#e.Success valueV)
+                              (let [[swapped? current-value] (:! [Bool Nat] valueV)]
+                                (and (not swapped?)
+                                     (n/= pre current-value)))
+
+                              (#e.Error error)
+                              false))))
+        )))
+
+(def: (box-spec run)
+  (-> (-> Synthesis (e.Error Top)) Test)
+  (do r.Monad<Random>
+    [pre r.nat
+     post (|> r.nat (r.filter (|>> (n/= pre) not)))
+     #let [preS (code.nat pre)
+           postS (code.nat post)
+           boxS (` ("lux box new" (~ preS)))]]
+    ($_ seq
+        (test "Can read boxes."
+              (|> (run (` ("lux box read" (~ boxS))))
+                  (case> (#e.Success valueV)
+                         (n/= pre (:! Nat valueV))
+
+                         (#e.Error error)
+                         false)))
+        (test "Can write boxes."
+              (|> (run (` ("lux let" +0 (~ boxS)
+                           ("lux let" +1 ("lux box write" (~ postS) (0))
+                            ("lux box read" (0))))))
+                  (case> (#e.Success valueV)
+                         (n/= post (:! Nat valueV))
+
+                         (#e.Error error)
+                         false)))
+        )))
+
+(def: (process-spec run)
+  (-> (-> Synthesis (e.Error Top)) Test)
+  ($_ seq
+      (test "Can query the concurrency level of the machine."
+            (|> (run (` ("lux process concurrency-level")))
+                (case> (#e.Success valueV)
+                       (n/>= +1 (:! Nat valueV))
+
+                       (#e.Error error)
+                       false)))
+      (do r.Monad<Random>
+        [delay (|> r.nat (:: @ map (n/% +10)))
+         message (r.text +5)]
+        ($_ seq
+            (test "Can execute I/O operations in parallel."
+                  (|> (run (` ("lux process future"
+                               ("lux function" +1 []
+                                ("lux io log" (~ (code.text (format "EXECUTE: " message))))))))
+                      (case> (#e.Success valueV)
+                             true
+
+                             (#e.Error error)
+                             false)))
+            (test "Can schedule I/O operations for future execution."
+                  (|> (run (` ("lux process schedule"
+                               (~ (code.nat delay))
+                               ("lux function" +1 []
+                                ("lux io log" (~ (code.text (format "SCHEDULE: " message))))))))
+                      (case> (#e.Success valueV)
+                             true
+
+                             (#e.Error error)
+                             false)))
+            ))))
+
 ## Bit
 (context: "[JVM] Bit procedures"
   (<| (times +100)
@@ -454,6 +835,15 @@
   (<| (times +100)
       (int-spec expressionT_js.translate evalT_js.eval runtimeT_js.translate init-js)))
 
+## Deg
+(context: "[JVM] Deg procedures"
+  (<| (times +100)
+      (deg-spec expressionT_jvm.translate evalT_jvm.eval runtimeT_jvm.translate init-jvm)))
+
+(context: "[JS] Deg procedures"
+  (<| (times +100)
+      (deg-spec expressionT_js.translate evalT_js.eval runtimeT_js.translate init-js)))
+
 ## Frac
 (context: "[JVM] Frac procedures"
   (<| (times +100)
@@ -463,11 +853,66 @@
   (<| (times +100)
       (frac-spec expressionT_js.translate evalT_js.eval runtimeT_js.translate init-js)))
 
-## Deg
-(context: "[JVM] Deg procedures"
+## Text
+(context: "[JVM] Text procedures"
+  (<| (seed +4439612689198907401)
+      ## (times +100)
+      (text-spec run-jvm)))
+
+(context: "[JS] Text procedures"
   (<| (times +100)
-      (deg-spec expressionT_jvm.translate evalT_jvm.eval runtimeT_jvm.translate init-jvm)))
+      (text-spec run-js)))
 
-(context: "[JS] Deg procedures"
+## Array
+(context: "[JVM] Array procedures"
   (<| (times +100)
-      (deg-spec expressionT_js.translate evalT_js.eval runtimeT_js.translate init-js)))
+      (array-spec run-jvm)))
+
+(context: "[JS] Array procedures"
+  (<| (times +100)
+      (array-spec run-js)))
+
+## Math
+(context: "[JVM] Math procedures"
+  (<| (times +100)
+      (math-spec run-jvm)))
+
+(context: "[JS] Math procedures"
+  (<| (times +100)
+      (math-spec run-js)))
+
+## I/O
+(context: "[JVM] I/O procedures"
+  (<| (times +100)
+      (io-spec run-jvm)))
+
+(context: "[JS] I/O procedures"
+  (<| (times +100)
+      (io-spec run-js)))
+
+## Atom
+(context: "[JVM] Atom procedures"
+  (<| (times +100)
+      (atom-spec run-jvm)))
+
+(context: "[JS] Atom procedures"
+  (<| (times +100)
+      (atom-spec run-js)))
+
+## Box
+(context: "[JVM] Box procedures"
+  (<| (times +100)
+      (box-spec run-jvm)))
+
+(context: "[JS] Box procedures"
+  (<| (times +100)
+      (box-spec run-js)))
+
+## Process
+(context: "[JVM] Process procedures"
+  (<| (times +100)
+      (process-spec run-jvm)))
+
+(context: "[JS] Process procedures"
+  (<| (times +100)
+      (process-spec run-js)))