From 4369bd0ee320d85590efa9c71db591200fb54cd2 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Wed, 21 Feb 2018 22:31:08 -0400
Subject: - Fixed the failing simple tests.

---
 .../lang/translation/js/procedure/common.jvm.lux   | 405 +++++++++++++++++++++
 .../lang/translation/jvm/procedure/common.jvm.lux  |   4 +-
 2 files changed, 407 insertions(+), 2 deletions(-)
 create mode 100644 new-luxc/test/test/luxc/lang/translation/js/procedure/common.jvm.lux

(limited to 'new-luxc/test')

diff --git a/new-luxc/test/test/luxc/lang/translation/js/procedure/common.jvm.lux b/new-luxc/test/test/luxc/lang/translation/js/procedure/common.jvm.lux
new file mode 100644
index 000000000..1c52d9e7b
--- /dev/null
+++ b/new-luxc/test/test/luxc/lang/translation/js/procedure/common.jvm.lux
@@ -0,0 +1,405 @@
+(.module:
+  lux
+  (lux [io]
+       (control [monad #+ do]
+                pipe)
+       (data text/format
+             [bit]
+             ["e" error]
+             [bool "bool/" Eq<Bool>]
+             [text "text/" Eq<Text>]
+             [number "nat/" Interval<Nat> "int/" Number<Int> Interval<Int> "frac/" Number<Frac> Interval<Frac> "deg/" Interval<Deg>]
+             (coll ["a" array]
+                   [list]))
+       ["r" math/random]
+       [macro]
+       (macro [code])
+       [host]
+       test)
+  (luxc [lang]
+        (lang ["ls" synthesis]
+              (translation (js [".T" expression]
+                               [".T" eval]
+                               [".T" runtime]))))
+  (test/luxc common))
+
+(context: "Bit procedures"
+  (<| (times +100)
+      (do @
+        [param r.nat
+         subject r.nat]
+        (with-expansions [<binary> (do-template [<name> <reference> <param-expr>]
+                                     [(test <name>
+                                            (|> (do macro.Monad<Meta>
+                                                  [_ runtimeT.translate
+                                                   sampleJS (expressionT.translate (` (<name> (~ (code.nat subject))
+                                                                                              (~ (code.nat param)))))]
+                                                  (evalT.eval sampleJS))
+                                                (lang.with-current-module "")
+                                                (macro.run (init-js []))
+                                                (case> (#e.Success valueT)
+                                                       (n/= (<reference> param subject) (:! Nat valueT))
+
+                                                       (#e.Error error)
+                                                       false)
+                                                (let [param <param-expr>])))]
+
+                                     ["lux bit and"                  bit.and param]
+                                     ["lux bit or"                   bit.or param]
+                                     ["lux bit xor"                  bit.xor param]
+                                     ["lux bit shift-left"           bit.shift-left (n/% +64 param)]
+                                     ["lux bit unsigned-shift-right" bit.shift-right (n/% +64 param)]
+                                     )]
+          ($_ seq
+              (test "lux bit count"
+                    (|> (do macro.Monad<Meta>
+                          [_ runtimeT.translate
+                           sampleJS (expressionT.translate (` ("lux bit count" (~ (code.nat subject)))))]
+                          (evalT.eval sampleJS))
+                        (lang.with-current-module "")
+                        (macro.run (init-js []))
+                        (case> (#e.Success valueT)
+                               (n/= (bit.count subject) (:! Nat valueT))
+
+                               (#e.Error error)
+                               false)))
+
+              <binary>
+              (test "lux bit shift-right"
+                    (|> (do macro.Monad<Meta>
+                          [_ runtimeT.translate
+                           sampleJS (expressionT.translate (` ("lux bit shift-right"
+                                                               (~ (code.int (nat-to-int subject)))
+                                                               (~ (code.nat param)))))]
+                          (evalT.eval sampleJS))
+                        (lang.with-current-module "")
+                        (macro.run (init-js []))
+                        (case> (#e.Success valueT)
+                               (i/= (bit.signed-shift-right param (nat-to-int subject))
+                                    (:! Int valueT))
+
+                               (#e.Error error)
+                               false)
+                        (let [param (n/% +64 param)])))
+              )))))
+
+(context: "Nat procedures"
+  (<| (times +100)
+      (do @
+        [param (|> r.nat (r.filter (|>> (n/= +0) not)))
+         subject r.nat]
+        (`` ($_ seq
+                (~~ (do-template [<name> <reference>]
+                      [(test <name>
+                             (|> (do macro.Monad<Meta>
+                                   [_ runtimeT.translate
+                                    sampleJS (expressionT.translate (` (<name>)))]
+                                   (evalT.eval sampleJS))
+                                 (lang.with-current-module "")
+                                 (macro.run (init-js []))
+                                 (case> (#e.Success valueT)
+                                        (n/= <reference> (:! Nat valueT))
+
+                                        (#e.Error error)
+                                        false)))]
+
+                      ["lux nat min" nat/bottom]
+                      ["lux nat max" nat/top]
+                      ))
+                (~~ (do-template [<name> <type> <prepare> <comp> <subject-expr>]
+                      [(test <name>
+                             (|> (do macro.Monad<Meta>
+                                   [_ runtimeT.translate
+                                    sampleJS (expressionT.translate (` (<name> (~ (code.nat subject)))))]
+                                   (evalT.eval sampleJS))
+                                 (lang.with-current-module "")
+                                 (macro.run (init-js []))
+                                 (case> (#e.Success valueT)
+                                        (<comp> (<prepare> subject) (:! <type> valueT))
+
+                                        (#e.Error error)
+                                        false)
+                                 (let [subject <subject-expr>])))]
+
+                      ["lux nat to-int" Int  nat-to-int     i/=    subject]
+                      ["lux nat char"   Text text.from-code text/= (n/% (bit.shift-left +32 +1) subject)]
+                      ))
+                (~~ (do-template [<name> <reference> <outputT> <comp>]
+                      [(test <name>
+                             (|> (do macro.Monad<Meta>
+                                   [_ runtimeT.translate
+                                    sampleJS (expressionT.translate (` (<name> (~ (code.nat subject)) (~ (code.nat param)))))]
+                                   (evalT.eval sampleJS))
+                                 (lang.with-current-module "")
+                                 (macro.run (init-js []))
+                                 (case> (#e.Success valueT)
+                                        (<comp> (<reference> param subject) (:! <outputT> valueT))
+
+                                        _
+                                        false)))]
+
+                      ["lux nat +" n/+ Nat  n/=]
+                      ["lux nat -" n/- Nat  n/=]
+                      ["lux nat *" n/* Nat  n/=]
+                      ["lux nat /" n// Nat  n/=]
+                      ["lux nat %" n/% Nat  n/=]
+                      ["lux nat =" n/= Bool bool/=]
+                      ["lux nat <" n/< Bool bool/=]
+                      ))
+                )))))
+
+(context: "Int procedures"
+  (<| (times +100)
+      (do @
+        [param (|> r.int (r.filter (|>> (i/= 0) not)))
+         subject r.int]
+        (with-expansions [<nullary> (do-template [<name> <reference>]
+                                      [(test <name>
+                                             (|> (do macro.Monad<Meta>
+                                                   [_ runtimeT.translate
+                                                    sampleJS (expressionT.translate (` (<name>)))]
+                                                   (evalT.eval sampleJS))
+                                                 (lang.with-current-module "")
+                                                 (macro.run (init-js []))
+                                                 (case> (#e.Success valueT)
+                                                        (i/= <reference> (:! Int valueT))
+
+                                                        (#e.Error error)
+                                                        false)))]
+
+                                      ["lux int min" int/bottom]
+                                      ["lux int max" int/top]
+                                      )
+                          <unary> (do-template [<name> <type> <prepare> <comp>]
+                                    [(test <name>
+                                           (|> (do macro.Monad<Meta>
+                                                 [_ runtimeT.translate
+                                                  sampleJS (expressionT.translate (` (<name> (~ (code.int subject)))))]
+                                                 (evalT.eval sampleJS))
+                                               (lang.with-current-module "")
+                                               (macro.run (init-js []))
+                                               (case> (#e.Success valueT)
+                                                      (<comp> (<prepare> subject) (:! <type> valueT))
+
+                                                      (#e.Error error)
+                                                      false)))]
+
+                                    ["lux int to-nat"  Nat  int-to-nat  n/=]
+                                    ["lux int to-frac" Frac int-to-frac f/=]
+                                    )
+                          <binary> (do-template [<name> <reference> <outputT> <comp>]
+                                     [(test <name>
+                                            (|> (do macro.Monad<Meta>
+                                                  [_ runtimeT.translate
+                                                   sampleJS (expressionT.translate (` (<name> (~ (code.int subject)) (~ (code.int param)))))]
+                                                  (evalT.eval sampleJS))
+                                                (lang.with-current-module "")
+                                                (macro.run (init-js []))
+                                                (case> (#e.Success valueT)
+                                                       (<comp> (<reference> param subject) (:! <outputT> valueT))
+
+                                                       _
+                                                       false)))]
+
+                                     ["lux int +" i/+ Int  i/=]
+                                     ["lux int -" i/- Int  i/=]
+                                     ["lux int *" i/* Int  i/=]
+                                     ["lux int /" i// Int  i/=]
+                                     ["lux int %" i/% Int  i/=]
+                                     ["lux int =" i/= Bool bool/=]
+                                     ["lux int <" i/< Bool bool/=]
+                                     )]
+          ($_ seq
+              <nullary>
+              <unary>
+              <binary>
+              )))))
+
+(context: "Frac procedures [Part 1]"
+  (<| (times +100)
+      (do @
+        [param (|> r.frac (r.filter (|>> (f/= 0.0) not)))
+         subject r.frac]
+        (with-expansions [<binary> (do-template [<name> <reference> <outputT> <comp>]
+                                     [(test <name>
+                                            (|> (do macro.Monad<Meta>
+                                                  [_ runtimeT.translate
+                                                   sampleJS (expressionT.translate (` (<name> (~ (code.frac subject)) (~ (code.frac param)))))]
+                                                  (evalT.eval sampleJS))
+                                                (lang.with-current-module "")
+                                                (macro.run (init-js []))
+                                                (case> (#e.Success valueT)
+                                                       (<comp> (<reference> param subject) (:! <outputT> valueT))
+
+                                                       _
+                                                       false)))]
+
+                                     ["lux frac +" f/+ Frac f/=]
+                                     ["lux frac -" f/- Frac f/=]
+                                     ["lux frac *" f/* Frac f/=]
+                                     ["lux frac /" f// Frac f/=]
+                                     ["lux frac %" f/% Frac f/=]
+                                     ["lux frac =" f/= Bool bool/=]
+                                     ["lux frac <" f/< Bool bool/=]
+                                     )]
+          ($_ seq
+              <binary>
+              )))))
+
+(context: "Frac procedures [Part 2]"
+  (<| (times +100)
+      (do @
+        [param (|> r.frac (r.filter (|>> (f/= 0.0) not)))
+         subject r.frac]
+        (with-expansions [<nullary> (do-template [<name> <test>]
+                                      [(test <name>
+                                             (|> (do macro.Monad<Meta>
+                                                   [_ runtimeT.translate
+                                                    sampleJS (expressionT.translate (` (<name>)))]
+                                                   (evalT.eval sampleJS))
+                                                 (lang.with-current-module "")
+                                                 (macro.run (init-js []))
+                                                 (case> (#e.Success valueT)
+                                                        (<test> (:! Frac valueT))
+
+                                                        _
+                                                        false)))]
+
+                                      ["lux frac min" (f/= frac/bottom)]
+                                      ["lux frac max" (f/= frac/top)]
+                                      ["lux frac not-a-number" number.not-a-number?]
+                                      ["lux frac positive-infinity" (f/= number.positive-infinity)]
+                                      ["lux frac negative-infinity" (f/= number.negative-infinity)]
+                                      ["lux frac smallest" (f/= ("lux frac smallest"))]
+                                      )
+                          <unary> (do-template [<forward> <backward> <test>]
+                                    [(test <forward>
+                                           (|> (do macro.Monad<Meta>
+                                                 [_ runtimeT.translate
+                                                  sampleJS (expressionT.translate (` (<backward> (<forward> (~ (code.frac subject))))))]
+                                                 (evalT.eval sampleJS))
+                                               (lang.with-current-module "")
+                                               (macro.run (init-js []))
+                                               (case> (#e.Success valueT)
+                                                      (|> valueT (:! Frac) (f/- subject) frac/abs <test>)
+                                                      
+                                                      (#e.Error error)
+                                                      false)))]
+
+                                    ["lux frac to-int" "lux int to-frac" (f/< 1.0)]
+                                    ["lux frac to-deg" "lux deg to-frac" (f/<= 0.000000001)])]
+          ($_ seq
+              <nullary>
+              <unary>
+              (test "frac encode|decode"
+                    (|> (do macro.Monad<Meta>
+                          [_ runtimeT.translate
+                           sampleJS (expressionT.translate (` ("lux frac decode" ("lux frac encode" (~ (code.frac subject))))))]
+                          (evalT.eval sampleJS))
+                        (lang.with-current-module "")
+                        (macro.run (init-js []))
+                        (case> (^multi (#e.Success valueT)
+                                       [(:! (Maybe Frac) valueT) (#.Some value)])
+                               (f/= subject value)
+
+                               _
+                               false)))
+              )))))
+
+(def: deg-threshold
+  {#.doc "1/(2^30)"}
+  Deg
+  .000000001)
+
+(def: (above-threshold value)
+  (-> Deg Deg)
+  (if (d/< deg-threshold value)
+    (d/+ deg-threshold value)
+    value))
+
+(def: (deg-difference reference sample)
+  (-> Deg Deg Deg)
+  (if (d/> reference sample)
+    (d/- reference sample)
+    (d/- sample reference)))
+
+(context: "Deg procedures"
+  (<| (times +100)
+      (do @
+        [param (|> r.deg (:: @ map above-threshold))
+         special r.nat
+         subject (|> r.deg (:: @ map above-threshold))]
+        (`` ($_ seq
+                (~~ (do-template [<name> <reference>]
+                      [(test <name>
+                             (|> (do macro.Monad<Meta>
+                                   [_ runtimeT.translate
+                                    sampleJS (expressionT.translate (` (<name>)))]
+                                   (evalT.eval sampleJS))
+                                 (lang.with-current-module "")
+                                 (macro.run (init-js []))
+                                 (case> (#e.Success valueT)
+                                        (d/= <reference> (:! Deg valueT))
+
+                                        _
+                                        false)))]
+
+                      ["lux deg min" deg/bottom]
+                      ["lux deg max" deg/top]
+                      ))
+                (~~ (do-template [<forward> <backward> <type>]
+                      [(test <forward>
+                             (|> (do macro.Monad<Meta>
+                                   [_ runtimeT.translate
+                                    sampleJS (expressionT.translate (` (<backward> (<forward> (~ (code.deg subject))))))]
+                                   (evalT.eval sampleJS))
+                                 (lang.with-current-module "")
+                                 (macro.run (init-js []))
+                                 (case> (#e.Success valueV)
+                                        (d/<= deg-threshold (deg-difference subject (:! <type> valueV)))
+
+                                        _
+                                        false)))]
+
+                      ["lux deg to-frac" "lux frac to-deg" Deg]
+                      ))
+                (~~ (do-template [<name> <reference> <outputT> <comp>]
+                      [(test <name>
+                             (|> (do macro.Monad<Meta>
+                                   [_ runtimeT.translate
+                                    sampleJS (expressionT.translate (` (<name> (~ (code.deg subject)) (~ (code.deg param)))))]
+                                   (evalT.eval sampleJS))
+                                 (lang.with-current-module "")
+                                 (macro.run (init-js []))
+                                 (case> (#e.Success valueT)
+                                        (<comp> (<reference> param subject) (:! <outputT> valueT))
+
+                                        _
+                                        false)))]
+
+                      ["lux deg +" d/+ Deg  d/=]
+                      ["lux deg -" d/- Deg  d/=]
+                      ["lux deg *" d/* Deg  d/=]
+                      ["lux deg /" d// Deg  d/=]
+                      ["lux deg %" d/% Deg  d/=]
+                      ["lux deg =" d/= Bool bool/=]
+                      ["lux deg <" d/< Bool bool/=]
+                      ))
+                (~~ (do-template [<name> <reference> <outputT> <comp>]
+                      [(test <name>
+                             (|> (do macro.Monad<Meta>
+                                   [_ runtimeT.translate
+                                    sampleJS (expressionT.translate (` (<name> (~ (code.deg subject)) (~ (code.nat special)))))]
+                                   (evalT.eval sampleJS))
+                                 (lang.with-current-module "")
+                                 (macro.run (init-js []))
+                                 (case> (#e.Success valueT)
+                                        (<comp> (<reference> special subject) (:! <outputT> valueT))
+
+                                        _
+                                        false)))]
+
+                      ["lux deg scale"      d/scale      Deg d/=]
+                      ["lux deg reciprocal" d/reciprocal Deg d/=]
+                      ))
+                )))))
diff --git a/new-luxc/test/test/luxc/lang/translation/jvm/procedure/common.jvm.lux b/new-luxc/test/test/luxc/lang/translation/jvm/procedure/common.jvm.lux
index 8e4fd362f..d81058e17 100644
--- a/new-luxc/test/test/luxc/lang/translation/jvm/procedure/common.jvm.lux
+++ b/new-luxc/test/test/luxc/lang/translation/jvm/procedure/common.jvm.lux
@@ -50,7 +50,7 @@
                                      ["lux bit unsigned-shift-right" bit.shift-right]
                                      )]
           ($_ seq
-              (test "bit count"
+              (test "lux bit count"
                     (|> (do macro.Monad<Meta>
                           [sampleI (expressionT.translate (` ("lux bit count" (~ (code.nat subject)))))]
                           (@eval.eval sampleI))
@@ -63,7 +63,7 @@
                                false)))
 
               <binary>
-              (test "bit shift-right"
+              (test "lux bit shift-right"
                     (|> (do macro.Monad<Meta>
                           [sampleI (expressionT.translate (` ("lux bit shift-right"
                                                               (~ (code.int (nat-to-int subject)))
-- 
cgit v1.2.3