1 files changed, 143 insertions, 0 deletions
diff --git a/new-luxc/test/test/luxc/lang/translation/structure.lux b/new-luxc/test/test/luxc/lang/translation/structure.lux
new file mode 100644
index 000000000..7443c3317
--- /dev/null
+++ b/new-luxc/test/test/luxc/lang/translation/structure.lux
@@ -0,0 +1,143 @@
+(.module:
+  lux
+  (lux [io #+ IO]
+       (control [monad #+ do]
+                pipe)
+       (data ["e" error]
+             [maybe]
+             [bool "bool/" Eq<Bool>]
+             [text "text/" Eq<Text>]
+             text/format
+             (coll [array]
+                   [list]))
+       ["r" math/random "r/" Monad<Random>]
+       [macro]
+       (macro [code])
+       [host]
+       test)
+  (luxc [lang]
+        (lang [".L" host]
+              ["ls" synthesis]
+              (translation (jvm [".T_jvm" expression]
+                                [".T_jvm" runtime]
+                                [".T_jvm" eval])
+                           (js [".T_js" expression]
+                               [".T_js" runtime]
+                               [".T_js" eval]))))
+  (test/luxc common))
+
+(host.import java/lang/Integer)
+(host.import java/lang/Long)
+
+(def: gen-primitive
+  (r.Random ls.Synthesis)
+  (r.either (r.either (r.either (r/wrap (' []))
+                                (r/map code.bool r.bool))
+                      (r.either (r/map code.nat r.nat)
+                                (r/map code.int r.int)))
+            (r.either (r.either (r/map code.deg r.deg)
+                                (r/map code.frac r.frac))
+                      (r/map code.text (r.text +5)))))
+
+(def: (corresponds? [prediction sample])
+  (-> [ls.Synthesis Top] Bool)
+  (case prediction
+    [_ (#.Tuple #.Nil)]
+    (text/= hostL.unit (:! Text sample))
+
+    (^template [<tag> <type> <test>]
+      [_ (<tag> prediction')]
+      (case (host.try (<test> prediction' (:! <type> sample)))
+        (#e.Success result)
+        result
+
+        (#e.Error error)
+        false))
+    ([#.Bool Bool bool/=]
+     [#.Nat  Nat n/=]
+     [#.Int  Int i/=]
+     [#.Deg  Deg d/=]
+     [#.Frac Frac f/=]
+     [#.Text Text text/=])
+
+    _
+    false
+    ))
+
+(def: (tuples-spec translate-expression eval translate-runtime init)
+  (All [a]
+    (-> (-> ls.Synthesis (Meta a))
+        (-> a (Meta Top))
+        (Meta Top)
+        (IO Compiler)
+        Test))
+  (do r.Monad<Random>
+    [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2))))
+     members (r.list size gen-primitive)]
+    (test "Can translate tuple."
+          (|> (do macro.Monad<Meta>
+                [_ translate-runtime
+                 sampleO (translate-expression (code.tuple members))]
+                (eval sampleO))
+              (lang.with-current-module "")
+              (macro.run (io.run init))
+              (case> (#e.Success valueT)
+                     (let [valueT (:! (Array Top) valueT)]
+                       (and (n/= size (array.size valueT))
+                            (list.every? corresponds? (list.zip2 members (array.to-list valueT)))))
+
+                     (#e.Error error)
+                     false)))))
+
+(def: (variants-spec translate-expression eval translate-runtime init)
+  (All [a]
+    (-> (-> ls.Synthesis (Meta a))
+        (-> a (Meta Top))
+        (Meta Top)
+        (IO Compiler)
+        Test))
+  (do r.Monad<Random>
+    [num-tags (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2))))
+     tag (|> r.nat (:: @ map (n/% num-tags)))
+     #let [last? (n/= (n/dec num-tags) tag)]
+     member gen-primitive]
+    (test "Can translate variant."
+          (|> (do macro.Monad<Meta>
+                [_ translate-runtime
+                 sampleO (translate-expression (` ((~ (code.nat tag)) (~ (code.bool last?)) (~ member))))]
+                (eval sampleO))
+              (lang.with-current-module "")
+              (macro.run (io.run init))
+              (case> (#e.Success valueT)
+                     (let [valueT (:! (Array Top) valueT)]
+                       (and (n/= +3 (array.size valueT))
+                            (let [_tag (:! Integer (maybe.assume (array.read +0 valueT)))
+                                  _last? (array.read +1 valueT)
+                                  _value (:! Top (maybe.assume (array.read +2 valueT)))]
+                              (and (n/= tag (|> _tag host.int-to-long (:! Nat)))
+                                   (case _last?
+                                     (#.Some _last?')
+                                     (and last? (text/= "" (:! Text _last?')))
+
+                                     #.None
+                                     (not last?))
+                                   (corresponds? [member _value])))))
+
+                     (#e.Error error)
+                     false)))))
+
+(context: "[JVM] Tuples."
+  (<| (times +100)
+      (tuples-spec expressionT_jvm.translate evalT_jvm.eval runtimeT_jvm.translate init-jvm)))
+
+(context: "[JVM] Variants."
+  (<| (times +100)
+      (variants-spec expressionT_jvm.translate evalT_jvm.eval runtimeT_jvm.translate init-jvm)))
+
+(context: "[JS] Tuples."
+  (<| (times +100)
+      (tuples-spec expressionT_js.translate evalT_js.eval runtimeT_js.translate init-js)))
+
+(context: "[JS] Variants."
+  (<| (times +100)
+      (variants-spec expressionT_js.translate evalT_js.eval runtimeT_js.translate init-js)))