diff options
Diffstat (limited to '')
| -rw-r--r-- | new-luxc/source/luxc/generator/host/jvm/inst.lux | 26 | ||||
| -rw-r--r-- | new-luxc/source/luxc/generator/procedure.jvm.lux | 14 | ||||
| -rw-r--r-- | new-luxc/source/luxc/generator/procedure/common.jvm.lux | 29 | ||||
| -rw-r--r-- | new-luxc/source/luxc/generator/procedure/host.jvm.lux | 106 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/generator/procedure/host.jvm.lux | 100 | ||||
| -rw-r--r-- | new-luxc/test/tests.lux | 3 |
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])) )) ) |