aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/generator/host/jvm/inst.lux26
-rw-r--r--new-luxc/source/luxc/generator/procedure.jvm.lux14
-rw-r--r--new-luxc/source/luxc/generator/procedure/common.jvm.lux29
-rw-r--r--new-luxc/source/luxc/generator/procedure/host.jvm.lux106
-rw-r--r--new-luxc/test/test/luxc/generator/procedure/host.jvm.lux100
-rw-r--r--new-luxc/test/tests.lux3
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]))
))
)