From f3acc0d67e6cd4e7245c1e169a3c0469da4373a3 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Thu, 12 Oct 2017 01:27:48 -0400
Subject: - Compilation and tests for primitive conversions.

---
 .../source/luxc/generator/procedure/common.jvm.lux |  29 +++---
 .../source/luxc/generator/procedure/host.jvm.lux   | 106 +++++++++++++++++++++
 2 files changed, 124 insertions(+), 11 deletions(-)
 create mode 100644 new-luxc/source/luxc/generator/procedure/host.jvm.lux

(limited to 'new-luxc/source/luxc/generator/procedure')

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)
+          )))
-- 
cgit v1.2.3