From 65c182755954f64fd112284a5336ba05547a4283 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Mon, 3 Jul 2017 18:15:24 -0400
Subject: - Tested the compilation for "nat" procedures. - Expanded the
 runtime. - Some bug-fixes and refactorings.

---
 .../test/luxc/generator/procedure/common.jvm.lux   | 127 +++++++++++++++++++++
 new-luxc/test/tests.lux                            |   7 +-
 2 files changed, 133 insertions(+), 1 deletion(-)
 create mode 100644 new-luxc/test/test/luxc/generator/procedure/common.jvm.lux

(limited to 'new-luxc/test')

diff --git a/new-luxc/test/test/luxc/generator/procedure/common.jvm.lux b/new-luxc/test/test/luxc/generator/procedure/common.jvm.lux
new file mode 100644
index 000000000..96cf8ae97
--- /dev/null
+++ b/new-luxc/test/test/luxc/generator/procedure/common.jvm.lux
@@ -0,0 +1,127 @@
+(;module:
+  lux
+  (lux [io]
+       (control monad
+                pipe)
+       (data text/format
+             [bit]
+             ["R" result]
+             [bool "B/" Eq<Bool>]
+             [text "T/" Eq<Text>]
+             [number "n/" Interval<Nat>]
+             (coll ["a" array]
+                   [list]))
+       ["r" math/random "r/" Monad<Random>]
+       [macro #+ Monad<Lux>]
+       [host #+ jvm-import]
+       test)
+  (luxc (lang ["ls" synthesis])
+        [analyser]
+        [synthesizer]
+        (generator ["@" expr]
+                   ["@;" eval]
+                   ["@;" runtime]
+                   ["@;" common]))
+  (test/luxc common))
+
+(context: "Bit procedures"
+  [param r;nat
+   subject r;nat]
+  (with-expansions [<binary> (do-template [<name> <reference>]
+                               [(test <name>
+                                      (|> (@eval;eval (@;generate (#ls;Procedure <name>
+                                                                                 (list (#ls;Nat subject)
+                                                                                       (#ls;Nat param)))))
+                                          (macro;run (init-compiler []))
+                                          (case> (#R;Success valueG)
+                                                 (n.= (<reference> param subject) (:! Nat valueG))
+
+                                                 _
+                                                 false)))]
+
+                               ["bit and"                  bit;and]
+                               ["bit or"                   bit;or]
+                               ["bit xor"                  bit;xor]
+                               ["bit shift-left"           bit;shift-left]
+                               ["bit unsigned-shift-right" bit;unsigned-shift-right]
+                               )]
+    ($_ seq
+        (test "bit count"
+              (|> (@eval;eval (@;generate (#ls;Procedure "bit count" (list (#ls;Nat subject)))))
+                  (macro;run (init-compiler []))
+                  (case> (#R;Success valueG)
+                         (n.= (bit;count subject) (:! Nat valueG))
+
+                         _
+                         false)))
+
+        <binary>
+        (test "bit shift-right"
+              (|> (@eval;eval (@;generate (#ls;Procedure "bit shift-right"
+                                                         (list (#ls;Int (nat-to-int subject))
+                                                               (#ls;Nat param)))))
+                  (macro;run (init-compiler []))
+                  (case> (#R;Success valueG)
+                         (i.= (bit;shift-right param (nat-to-int subject))
+                              (:! Int valueG))
+
+                         _
+                         false)))
+        )))
+
+(context: "Nat procedures"
+  [param (|> r;nat (r;filter (|>. (n.= +0) not)))
+   subject r;nat]
+  (with-expansions [<nullary> (do-template [<name> <reference>]
+                                [(test <name>
+                                       (|> (@eval;eval (@;generate (#ls;Procedure <name> (list))))
+                                           (macro;run (init-compiler []))
+                                           (case> (#R;Success valueG)
+                                                  (n.= <reference> (:! Nat valueG))
+
+                                                  _
+                                                  false)))]
+
+                                ["nat min" n/bottom]
+                                ["nat max" n/top]
+                                )
+                    <unary> (do-template [<name> <type> <prepare> <comp>]
+                              [(test <name>
+                                     (|> (@eval;eval (@;generate (#ls;Procedure <name> (list (#ls;Nat subject)))))
+                                         (macro;run (init-compiler []))
+                                         (case> (#R;Success valueG)
+                                                (<comp> (<prepare> subject) (:! <type> valueG))
+
+                                                _
+                                                false)))]
+
+                              ["nat to-int"  Int  nat-to-int     i.=]
+                              ["nat to-char" Text text;from-code T/=]
+                              )
+                    <binary> (do-template [<name> <reference> <outputT> <comp>]
+                               [(test <name>
+                                      (|> (do Monad<Lux>
+                                            [runtime-bytecode @runtime;generate]
+                                            (@eval;eval (@;generate (#ls;Procedure <name>
+                                                                                   (list (#ls;Nat subject)
+                                                                                         (#ls;Nat param))))))
+                                          (macro;run (init-compiler []))
+                                          (case> (#R;Success valueG)
+                                                 (<comp> (<reference> param subject) (:! <outputT> valueG))
+
+                                                 _
+                                                 false)))]
+
+                               ["nat +" n.+ Nat  n.=]
+                               ["nat -" n.- Nat  n.=]
+                               ["nat *" n.* Nat  n.=]
+                               ["nat /" n./ Nat  n.=]
+                               ["nat %" n.% Nat  n.=]
+                               ["nat =" n.= Bool B/=]
+                               ["nat <" n.< Bool B/=]
+                               )]
+    ($_ seq
+        <nullary>
+        <unary>
+        <binary>
+        )))
diff --git a/new-luxc/test/tests.lux b/new-luxc/test/tests.lux
index 92644ff48..695c72174 100644
--- a/new-luxc/test/tests.lux
+++ b/new-luxc/test/tests.lux
@@ -20,7 +20,12 @@
                            ["_;S" procedure]
                            ["_;S" loop])
               (generator ["_;G" primitive]
-                         ["_;G" structure]))))
+                         ["_;G" structure]
+                         (procedure ["_;G" common]))
+              ))
+  ## (luxc (generator ["_;G" function])
+  ##       )
+  )
 
 ## [Program]
 (program: args
-- 
cgit v1.2.3