- Compilation and tests for primitive conversions.

6 files changed, 252 insertions, 26 deletions

diff --git a/new-luxc/source/luxc/generator/host/jvm/inst.lux b/new-luxc/source/luxc/generator/host/jvm/inst.lux
index aa9a852dd..ebf12023f 100644
--- a/new-luxc/source/luxc/generator/host/jvm/inst.lux
+++ b/new-luxc/source/luxc/generator/host/jvm/inst.lux
@@ -22,7 +22,11 @@
       (L/map (function [code] (` ((~' #static) (~ (code;local-symbol code)) (~' int)))))
       wrap))
 
-(with-expansions [<primitive> (declare T_BOOLEAN T_CHAR T_FLOAT T_DOUBLE
+(with-expansions [<conversion> (declare D2F D2I D2L
+                                        F2D F2I F2L
+                                        I2B I2C I2D I2F I2L I2S
+                                        L2D L2F L2I)
+                  <primitive> (declare T_BOOLEAN T_CHAR T_FLOAT T_DOUBLE
                                        T_BYTE T_SHORT T_INT T_LONG)
                   <stack> (declare DUP DUP2 DUP2_X1 DUP2_X2
                                    POP POP2
@@ -39,6 +43,9 @@
                                          DCMPG DCMPL)
                   <return> (declare RETURN IRETURN LRETURN DRETURN ARETURN)]
   (host;import org.objectweb.asm.Opcodes
+    (#static NOP int)
+    
+    <conversion>
     <primitive>
 
     (#static CHECKCAST int)
@@ -62,12 +69,6 @@
 
     <arithmethic>
 
-    (#static I2L int)
-    (#static L2I int)
-    (#static L2D int)
-    (#static D2L int)
-    (#static I2C int)
-
     (#static AALOAD int)
     (#static AASTORE int)
     (#static ARRAYLENGTH int)
@@ -150,9 +151,17 @@
        (do-to visitor
          (MethodVisitor.visitInsn [(prefix <name>)]))))]
 
+  [NOP]
+  
   ## Stack
   [DUP] [DUP2] [DUP2_X1] [DUP2_X2] [POP] [POP2] [SWAP]
 
+  ## Conversions
+  [D2F] [D2I] [D2L]
+  [F2D] [F2I] [F2L]
+  [I2B] [I2C] [I2D] [I2F] [I2L] [I2S]
+  [L2D] [L2F] [L2I]
+  
   ## Long bitwise
   [LAND] [LOR] [LXOR] [LSHL] [LSHR] [LUSHR]
 
@@ -167,9 +176,6 @@
   [DADD] [DSUB] [DMUL] [DDIV] [DREM]
   [DCMPG] [DCMPL]
 
-  ## Conversions
-  [I2L] [L2I] [L2D] [D2L] [I2C]
-
   ## Array
   [AALOAD] [AASTORE] [ARRAYLENGTH]
 
diff --git a/new-luxc/source/luxc/generator/procedure.jvm.lux b/new-luxc/source/luxc/generator/procedure.jvm.lux
index 524513eb5..c564a668a 100644
--- a/new-luxc/source/luxc/generator/procedure.jvm.lux
+++ b/new-luxc/source/luxc/generator/procedure.jvm.lux
@@ -4,16 +4,22 @@
   (lux (control [monad #+ do])
        (data [maybe]
              text/format
-             (coll ["d" dict])))
+             (coll [dict])))
   (luxc ["&" base]
         (lang ["ls" synthesis])
-        (generator (procedure ["&&;" common])
-                   (host ["$" jvm]))))
+        (generator (host ["$" jvm])))
+  (. ["./;" common]
+     ["./;" host]))
+
+(def: procedures
+  ./common;Bundle
+  (|> ./common;procedures
+      (dict;merge ./host;procedures)))
 
 (def: #export (generate-procedure generate name args)
   (-> (-> ls;Synthesis (Lux $;Inst)) Text (List ls;Synthesis)
       (Lux $;Inst))
   (<| (maybe;default (&;fail (format "Unknown procedure: " (%t name))))
       (do maybe;Monad<Maybe>
-        [proc (d;get name &&common;procedures)]
+        [proc (dict;get name procedures)]
         (wrap (proc generate args)))))
diff --git a/new-luxc/source/luxc/generator/procedure/common.jvm.lux b/new-luxc/source/luxc/generator/procedure/common.jvm.lux
index ffbe69708..70f38f962 100644
--- a/new-luxc/source/luxc/generator/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/generator/procedure/common.jvm.lux
@@ -34,22 +34,22 @@
   (#static NEGATIVE_INFINITY Double))
 
 ## [Types]
-(type: Generator
+(type: #export Generator
   (-> ls;Synthesis (Lux $;Inst)))
 
-(type: Proc
+(type: #export Proc
   (-> Generator (List ls;Synthesis) (Lux $;Inst)))
 
-(type: Bundle
+(type: #export Bundle
   (Dict Text Proc))
 
 (syntax: (Vector [size s;nat] elemT)
   (wrap (list (` [(~@ (list;repeat size elemT))]))))
 
-(type: Nullary (-> (Vector +0 $;Inst) $;Inst))
-(type: Unary   (-> (Vector +1 $;Inst) $;Inst))
-(type: Binary  (-> (Vector +2 $;Inst) $;Inst))
-(type: Trinary (-> (Vector +3 $;Inst) $;Inst))
+(type: #export Nullary (-> (Vector +0 $;Inst) $;Inst))
+(type: #export Unary   (-> (Vector +1 $;Inst) $;Inst))
+(type: #export Binary  (-> (Vector +2 $;Inst) $;Inst))
+(type: #export Trinary (-> (Vector +3 $;Inst) $;Inst))
 
 ## [Utils]
 (def: $Object $;Type ($t;class "java.lang.Object" (list)))
@@ -58,12 +58,19 @@
 (def: $CharSequence $;Type ($t;class "java.lang.CharSequence" (list)))
 (def: $Function $;Type ($t;class &runtime;function-class (list)))
 
-(def: (install name unnamed)
+(def: #export (install name unnamed)
   (-> Text (-> Text Proc)
       (-> Bundle Bundle))
   (dict;put name (unnamed name)))
 
-(def: (wrong-amount-error proc expected actual)
+(def: #export (prefix prefix bundle)
+  (-> Text Bundle Bundle)
+  (|> bundle
+      dict;entries
+      (list/map (function [[key val]] [(format prefix " " key) val]))
+      (dict;from-list text;Hash<Text>)))
+
+(def: (wrong-arity proc expected actual)
   (-> Text Nat Nat Text)
   (format "Wrong number of arguments for " (%t proc) "\n"
           "Expected: " (|> expected nat-to-int %i) "\n"
@@ -73,7 +80,7 @@
   (with-gensyms [g!proc g!name g!generate g!inputs]
     (do @
       [g!input+ (monad;seq @ (list;repeat arity (macro;gensym "input")))]
-      (wrap (list (` (def: ((~ (code;local-symbol name)) (~ g!proc))
+      (wrap (list (` (def: #export ((~ (code;local-symbol name)) (~ g!proc))
                        (-> (-> (Vector (~ (code;nat arity)) $;Inst) $;Inst)
                            (-> Text Proc))
                        (function [(~ g!name)]
@@ -88,7 +95,7 @@
                                ((~' wrap) ((~ g!proc) [(~@ g!input+)])))
 
                              (~' _)
-                             (macro;fail (wrong-amount-error (~ g!name) +1 (list;size (~ g!inputs))))))))))))))
+                             (macro;fail (wrong-arity (~ g!name) +1 (list;size (~ g!inputs))))))))))))))
 
 (arity: nullary +0)
 (arity: unary +1)
diff --git a/new-luxc/source/luxc/generator/procedure/host.jvm.lux b/new-luxc/source/luxc/generator/procedure/host.jvm.lux
new file mode 100644
index 000000000..66b7bc77e
--- /dev/null
+++ b/new-luxc/source/luxc/generator/procedure/host.jvm.lux
@@ -0,0 +1,106 @@
+(;module:
+  lux
+  (lux (control [monad #+ do])
+       (data [text]
+             text/format
+             (coll [list "list/" Functor<List>]
+                   [dict #+ Dict]))
+       [macro #+ with-gensyms]
+       (macro [code]
+              ["s" syntax #+ syntax:])
+       [host])
+  (luxc ["&" base]
+        (lang ["la" analysis]
+              ["ls" synthesis])
+        ["&;" analyser]
+        ["&;" synthesizer]
+        (synthesizer [function])
+        (generator ["&;" common]
+                   ["&;" runtime]
+                   (host ["$" jvm]
+                         (jvm ["$t" type]
+                              ["$d" def]
+                              ["$i" inst]))))
+  ["@" ../common])
+
+(do-template [<name> <inst>]
+  [(def: <name>
+     $;Inst
+     <inst>)]
+
+  [L2S (|>. $i;L2I $i;I2S)]
+  [L2B (|>. $i;L2I $i;I2B)]
+  )
+
+(do-template [<name> <unwrap> <conversion> <wrap>]
+  [(def: (<name> inputI)
+     @;Unary
+     (if (is $i;NOP <conversion>)
+       (|>. inputI
+            ($i;unwrap <unwrap>)
+            ($i;wrap <wrap>))
+       (|>. inputI
+            ($i;unwrap <unwrap>)
+            <conversion>
+            ($i;wrap <wrap>))))]
+  
+  [convert//double-to-float #$;Double $i;D2F #$;Float]
+  [convert//double-to-int #$;Double $i;D2I #$;Int]
+  [convert//double-to-long #$;Double $i;D2L #$;Long]
+  [convert//float-to-double #$;Float $i;F2D #$;Double]
+  [convert//float-to-int #$;Float $i;F2I #$;Int]
+  [convert//float-to-long #$;Float $i;F2L #$;Long]
+  [convert//int-to-byte #$;Int $i;I2B #$;Byte]
+  [convert//int-to-char #$;Int $i;I2C #$;Char]
+  [convert//int-to-double #$;Int $i;I2D #$;Double]
+  [convert//int-to-float #$;Int $i;I2F #$;Float]
+  [convert//int-to-long #$;Int $i;I2L #$;Long]
+  [convert//int-to-short #$;Int $i;I2S #$;Short]
+  [convert//long-to-double #$;Long $i;L2D #$;Double]
+  [convert//long-to-float #$;Long $i;L2F #$;Float]
+  [convert//long-to-int #$;Long $i;L2I #$;Int]
+  [convert//long-to-short #$;Long L2S #$;Short]
+  [convert//long-to-byte #$;Long L2B #$;Byte]
+  [convert//char-to-byte #$;Char $i;I2B #$;Byte]
+  [convert//char-to-short #$;Char $i;I2S #$;Short]
+  [convert//char-to-int #$;Char $i;NOP #$;Int]
+  [convert//char-to-long #$;Char $i;I2L #$;Long]
+  [convert//byte-to-long #$;Byte $i;I2L #$;Long]
+  [convert//short-to-long #$;Short $i;I2L #$;Long]
+  )
+
+(def: conversion-procs
+  @;Bundle
+  (<| (@;prefix "convert")
+      (|> (dict;new text;Hash<Text>)
+          (@;install "double-to-float" (@;unary convert//double-to-float))
+          (@;install "double-to-int" (@;unary convert//double-to-int))
+          (@;install "double-to-long" (@;unary convert//double-to-long))
+          (@;install "float-to-double" (@;unary convert//float-to-double))
+          (@;install "float-to-int" (@;unary convert//float-to-int))
+          (@;install "float-to-long" (@;unary convert//float-to-long))
+          (@;install "int-to-byte" (@;unary convert//int-to-byte))
+          (@;install "int-to-char" (@;unary convert//int-to-char))
+          (@;install "int-to-double" (@;unary convert//int-to-double))
+          (@;install "int-to-float" (@;unary convert//int-to-float))
+          (@;install "int-to-long" (@;unary convert//int-to-long))
+          (@;install "int-to-short" (@;unary convert//int-to-short))
+          (@;install "long-to-double" (@;unary convert//long-to-double))
+          (@;install "long-to-float" (@;unary convert//long-to-float))
+          (@;install "long-to-int" (@;unary convert//long-to-int))
+          (@;install "long-to-short" (@;unary convert//long-to-short))
+          (@;install "long-to-byte" (@;unary convert//long-to-byte))
+          (@;install "char-to-byte" (@;unary convert//char-to-byte))
+          (@;install "char-to-short" (@;unary convert//char-to-short))
+          (@;install "char-to-int" (@;unary convert//char-to-int))
+          (@;install "char-to-long" (@;unary convert//char-to-long))
+          (@;install "byte-to-long" (@;unary convert//byte-to-long))
+          (@;install "short-to-long" (@;unary convert//short-to-long))
+          )))
+
+(def: #export procedures
+  @;Bundle
+  (<| (@;prefix "jvm")
+      (|> (dict;new text;Hash<Text>)
+          (dict;merge conversion-procs)
+          )))
diff --git a/new-luxc/test/test/luxc/generator/procedure/host.jvm.lux b/new-luxc/test/test/luxc/generator/procedure/host.jvm.lux
new file mode 100644
index 000000000..1dd60bc76
--- /dev/null
+++ b/new-luxc/test/test/luxc/generator/procedure/host.jvm.lux
@@ -0,0 +1,100 @@
+(;module:
+  lux
+  (lux [io]
+       (control [monad #+ do]
+                pipe)
+       (data ["R" result]
+             [number "int/" Number<Int>]
+             text/format)
+       ["r" math/random "r/" Monad<Random>]
+       [macro #+ Monad<Lux>]
+       [host]
+       test)
+  (luxc (lang ["ls" synthesis])
+        [analyser]
+        [synthesizer]
+        (generator ["@" expr]
+                   ["@;" eval]
+                   ["@;" runtime]
+                   ["@;" common]))
+  (test/luxc common))
+
+(context: "Conversions [Part 1]"
+  [int-sample (|> r;int (:: @ map (i.% 128)))
+   #let [frac-sample (int-to-frac int-sample)]]
+  (with-expansions [<2step> (do-template [<step1> <step2> <tag> <sample> <cast> <test>]
+                              [(test (format <step1> " / " <step2>)
+                                     (|> (do macro;Monad<Lux>
+                                           [sampleI (@;generate (|> (<tag> <sample>)
+                                                                    (list) (#ls;Procedure <step1>)
+                                                                    (list) (#ls;Procedure <step2>)))]
+                                           (@eval;eval sampleI))
+                                         (macro;run (init-compiler []))
+                                         (case> (#R;Success valueG)
+                                                (<test> <sample> (:! <cast> valueG))
+
+                                                (#R;Error error)
+                                                false)))]
+
+                              ["jvm convert double-to-float" "jvm convert float-to-double" #ls;Frac frac-sample Frac f.=]
+                              ["jvm convert double-to-int"   "jvm convert int-to-double" #ls;Frac frac-sample Frac f.=]
+                              ["jvm convert double-to-long"  "jvm convert long-to-double" #ls;Frac frac-sample Frac f.=]
+
+                              ["jvm convert long-to-float" "jvm convert float-to-long" #ls;Int int-sample Int i.=]
+                              ["jvm convert long-to-int" "jvm convert int-to-long" #ls;Int int-sample Int i.=]
+                              ["jvm convert long-to-short" "jvm convert short-to-long" #ls;Int int-sample Int i.=]
+                              ["jvm convert long-to-byte" "jvm convert byte-to-long" #ls;Int int-sample Int i.=]
+                              )]
+    ($_ seq
+        <2step>
+        )))
+
+(context: "Conversions [Part 2]"
+  [int-sample (|> r;int (:: @ map (|>. (i.% 128) int/abs)))
+   #let [frac-sample (int-to-frac int-sample)]]
+  (with-expansions [<3step> (do-template [<step1> <step2> <step3> <tag> <sample> <cast> <test>]
+                              [(test (format <step1> " / " <step2> " / " <step3>)
+                                     (|> (do macro;Monad<Lux>
+                                           [sampleI (@;generate (|> (<tag> <sample>)
+                                                                    (list) (#ls;Procedure <step1>)
+                                                                    (list) (#ls;Procedure <step2>)
+                                                                    (list) (#ls;Procedure <step3>)))]
+                                           (@eval;eval sampleI))
+                                         (macro;run (init-compiler []))
+                                         (case> (#R;Success valueG)
+                                                (<test> <sample> (:! <cast> valueG))
+
+                                                (#R;Error error)
+                                                false)))]
+
+                              ["jvm convert long-to-int" "jvm convert int-to-char" "jvm convert char-to-long" #ls;Int int-sample Int i.=]
+                              ["jvm convert long-to-int" "jvm convert int-to-byte" "jvm convert byte-to-long" #ls;Int int-sample Int i.=]
+                              ["jvm convert long-to-int" "jvm convert int-to-short" "jvm convert short-to-long" #ls;Int int-sample Int i.=]
+                              ["jvm convert long-to-float" "jvm convert float-to-int" "jvm convert int-to-long" #ls;Int int-sample Int i.=]
+                              ["jvm convert long-to-int" "jvm convert int-to-float" "jvm convert float-to-long" #ls;Int int-sample Int i.=]
+                              )
+                    <4step> (do-template [<step1> <step2> <step3> <step4> <tag> <sample> <cast> <test>]
+                              [(test (format <step1> " / " <step2> " / " <step3>)
+                                     (|> (do macro;Monad<Lux>
+                                           [sampleI (@;generate (|> (<tag> <sample>)
+                                                                    (list) (#ls;Procedure <step1>)
+                                                                    (list) (#ls;Procedure <step2>)
+                                                                    (list) (#ls;Procedure <step3>)
+                                                                    (list) (#ls;Procedure <step4>)))]
+                                           (@eval;eval sampleI))
+                                         (macro;run (init-compiler []))
+                                         (case> (#R;Success valueG)
+                                                (<test> <sample> (:! <cast> valueG))
+
+                                                (#R;Error error)
+                                                false)))]
+
+                              ["jvm convert long-to-int" "jvm convert int-to-char" "jvm convert char-to-byte" "jvm convert byte-to-long" #ls;Int int-sample Int i.=]
+                              ["jvm convert long-to-int" "jvm convert int-to-char" "jvm convert char-to-short" "jvm convert short-to-long" #ls;Int int-sample Int i.=]
+                              ["jvm convert long-to-int" "jvm convert int-to-char" "jvm convert char-to-int" "jvm convert int-to-long" #ls;Int int-sample Int i.=]
+                              )
+                    ]
+    ($_ seq
+        <3step>
+        <4step>
+        )))
diff --git a/new-luxc/test/tests.lux b/new-luxc/test/tests.lux
index 311b6666f..731667bdd 100644
--- a/new-luxc/test/tests.lux
+++ b/new-luxc/test/tests.lux
@@ -24,7 +24,8 @@
                          ["_;G" structure]
                          ["_;G" case]
                          ["_;G" function]
-                         (procedure ["_;G" common]))
+                         (procedure ["_;G" common]
+                                    ["_;G" host]))
               ))
   )