diff options
author | Eduardo Julian | 2017-10-12 15:22:25 -0400 |
---|---|---|
committer | Eduardo Julian | 2017-10-12 15:22:25 -0400 |
commit | 1acc9f4cdd7b7cff29351594fa603c3b6fa4c666 (patch) | |
tree | 32db1b85c7972c564a0250cf46d11e0f98c49806 | |
parent | f3acc0d67e6cd4e7245c1e169a3c0469da4373a3 (diff) |
- Compilation and tests for arithmetic, bit-wise operations and order.
5 files changed, 322 insertions, 26 deletions
diff --git a/new-luxc/source/luxc/analyser/procedure/host.jvm.lux b/new-luxc/source/luxc/analyser/procedure/host.jvm.lux index 1dba7a5f8..e21281984 100644 --- a/new-luxc/source/luxc/analyser/procedure/host.jvm.lux +++ b/new-luxc/source/luxc/analyser/procedure/host.jvm.lux @@ -92,7 +92,6 @@ (@;install "%" (@;binary <type> <type> <type>)) (@;install "=" (@;binary <type> <type> Boolean)) (@;install "<" (@;binary <type> <type> Boolean)) - (@;install ">" (@;binary <type> <type> Boolean)) (@;install "and" (@;binary <type> <type> <type>)) (@;install "or" (@;binary <type> <type> <type>)) (@;install "xor" (@;binary <type> <type> <type>)) @@ -117,7 +116,6 @@ (@;install "%" (@;binary <type> <type> <type>)) (@;install "=" (@;binary <type> <type> Boolean)) (@;install "<" (@;binary <type> <type> Boolean)) - (@;install ">" (@;binary <type> <type> Boolean)) )))] [float-procs "float" Float] @@ -130,7 +128,6 @@ (|> (dict;new text;Hash<Text>) (@;install "=" (@;binary Character Character Boolean)) (@;install "<" (@;binary Character Character Boolean)) - (@;install ">" (@;binary Character Character Boolean)) ))) (def: #export boxes @@ -825,13 +822,11 @@ (dict;merge (<| (@;prefix "static") (|> (dict;new text;Hash<Text>) (@;install "get" static-get) - (@;install "put" static-put) - ))) + (@;install "put" static-put)))) (dict;merge (<| (@;prefix "virtual") (|> (dict;new text;Hash<Text>) (@;install "get" virtual-get) - (@;install "put" virtual-put) - ))) + (@;install "put" virtual-put)))) ))) (def: #export procedures diff --git a/new-luxc/source/luxc/generator/host/jvm/inst.lux b/new-luxc/source/luxc/generator/host/jvm/inst.lux index ebf12023f..7a6215804 100644 --- a/new-luxc/source/luxc/generator/host/jvm/inst.lux +++ b/new-luxc/source/luxc/generator/host/jvm/inst.lux @@ -36,11 +36,12 @@ GOTO) <var> (declare ILOAD LLOAD DLOAD ALOAD ISTORE LSTORE ASTORE) - <arithmethic> (declare IADD ISUB - LADD LSUB LMUL LDIV LREM - LCMP - DADD DSUB DMUL DDIV DREM - DCMPG DCMPL) + <arithmethic> (declare IADD ISUB IMUL IDIV IREM + LADD LSUB LMUL LDIV LREM LCMP + FADD FSUB FMUL FDIV FREM FCMPG FCMPL + DADD DSUB DMUL DDIV DREM DCMPG DCMPL) + <bit-wise> (declare IAND IOR IXOR ISHL ISHR IUSHR + LAND LOR LXOR LSHL LSHR LUSHR) <return> (declare RETURN IRETURN LRETURN DRETURN ARETURN)] (host;import org.objectweb.asm.Opcodes (#static NOP int) @@ -60,14 +61,8 @@ <var> - (#static LAND int) - (#static LOR int) - (#static LXOR int) - (#static LSHL int) - (#static LSHR int) - (#static LUSHR int) - <arithmethic> + <bit-wise> (#static AALOAD int) (#static AASTORE int) @@ -161,17 +156,23 @@ [F2D] [F2I] [F2L] [I2B] [I2C] [I2D] [I2F] [I2L] [I2S] [L2D] [L2F] [L2I] - - ## Long bitwise - [LAND] [LOR] [LXOR] [LSHL] [LSHR] [LUSHR] ## Integer arithmetic - [IADD] [ISUB] + [IADD] [ISUB] [IMUL] [IDIV] [IREM] + + ## Integer bitwise + [IAND] [IOR] [IXOR] [ISHL] [ISHR] [IUSHR] ## Long arithmethic [LADD] [LSUB] [LMUL] [LDIV] [LREM] [LCMP] + ## Long bitwise + [LAND] [LOR] [LXOR] [LSHL] [LSHR] [LUSHR] + + ## Float arithmetic + [FADD] [FSUB] [FMUL] [FDIV] [FREM] [FCMPG] [FCMPL] + ## Double arithmetic [DADD] [DSUB] [DMUL] [DDIV] [DREM] [DCMPG] [DCMPL] diff --git a/new-luxc/source/luxc/generator/procedure/host.jvm.lux b/new-luxc/source/luxc/generator/procedure/host.jvm.lux index 66b7bc77e..c99c23385 100644 --- a/new-luxc/source/luxc/generator/procedure/host.jvm.lux +++ b/new-luxc/source/luxc/generator/procedure/host.jvm.lux @@ -98,9 +98,177 @@ (@;install "short-to-long" (@;unary convert//short-to-long)) ))) +(do-template [<name> <op> <unwrapX> <unwrapY> <wrap>] + [(def: (<name> [xI yI]) + @;Binary + (|>. xI ($i;unwrap <unwrapX>) + yI ($i;unwrap <unwrapY>) + <op> ($i;wrap <wrap>)))] + + [int//+ $i;IADD #$;Int #$;Int #$;Int] + [int//- $i;ISUB #$;Int #$;Int #$;Int] + [int//* $i;IMUL #$;Int #$;Int #$;Int] + [int/// $i;IDIV #$;Int #$;Int #$;Int] + [int//% $i;IREM #$;Int #$;Int #$;Int] + [int//and $i;IAND #$;Int #$;Int #$;Int] + [int//or $i;IOR #$;Int #$;Int #$;Int] + [int//xor $i;IXOR #$;Int #$;Int #$;Int] + [int//shl $i;ISHL #$;Int #$;Int #$;Int] + [int//shr $i;ISHR #$;Int #$;Int #$;Int] + [int//ushr $i;IUSHR #$;Int #$;Int #$;Int] + + [long//+ $i;LADD #$;Long #$;Long #$;Long] + [long//- $i;LSUB #$;Long #$;Long #$;Long] + [long//* $i;LMUL #$;Long #$;Long #$;Long] + [long/// $i;LDIV #$;Long #$;Long #$;Long] + [long//% $i;LREM #$;Long #$;Long #$;Long] + [long//and $i;LAND #$;Long #$;Long #$;Long] + [long//or $i;LOR #$;Long #$;Long #$;Long] + [long//xor $i;LXOR #$;Long #$;Long #$;Long] + [long//shl $i;LSHL #$;Long #$;Int #$;Long] + [long//shr $i;LSHR #$;Long #$;Int #$;Long] + [long//ushr $i;LUSHR #$;Long #$;Int #$;Long] + + [float//+ $i;FADD #$;Float #$;Float #$;Float] + [float//- $i;FSUB #$;Float #$;Float #$;Float] + [float//* $i;FMUL #$;Float #$;Float #$;Float] + [float/// $i;FDIV #$;Float #$;Float #$;Float] + [float//% $i;FREM #$;Float #$;Float #$;Float] + + [double//+ $i;DADD #$;Double #$;Double #$;Double] + [double//- $i;DSUB #$;Double #$;Double #$;Double] + [double//* $i;DMUL #$;Double #$;Double #$;Double] + [double/// $i;DDIV #$;Double #$;Double #$;Double] + [double//% $i;DREM #$;Double #$;Double #$;Double] + ) + +(do-template [<name> <op> <unwrapX> <unwrapY> <wrap>] + [(def: (<name> [xI yI]) + @;Binary + (<| $i;with-label (function [@then]) + $i;with-label (function [@end]) + (|>. xI ($i;unwrap <unwrapX>) + yI ($i;unwrap <unwrapY>) + (<op> @then) + ($i;GETSTATIC "java.lang.Boolean" "FALSE" ($t;class "java.lang.Boolean" (list))) + ($i;GOTO @end) + ($i;label @then) + ($i;GETSTATIC "java.lang.Boolean" "TRUE" ($t;class "java.lang.Boolean" (list))) + ($i;label @end))))] + + [int//= $i;IF_ICMPEQ #$;Int #$;Int #$;Boolean] + [int//< $i;IF_ICMPLT #$;Int #$;Int #$;Boolean] + + [char//= $i;IF_ICMPEQ #$;Char #$;Char #$;Boolean] + [char//< $i;IF_ICMPLT #$;Char #$;Char #$;Boolean] + ) + +(do-template [<name> <op> <reference> <unwrapX> <unwrapY> <wrap>] + [(def: (<name> [xI yI]) + @;Binary + (<| $i;with-label (function [@then]) + $i;with-label (function [@end]) + (|>. xI ($i;unwrap <unwrapX>) + yI ($i;unwrap <unwrapY>) + <op> + ($i;int <reference>) + ($i;IF_ICMPEQ @then) + ($i;GETSTATIC "java.lang.Boolean" "FALSE" ($t;class "java.lang.Boolean" (list))) + ($i;GOTO @end) + ($i;label @then) + ($i;GETSTATIC "java.lang.Boolean" "TRUE" ($t;class "java.lang.Boolean" (list))) + ($i;label @end))))] + + [long//= $i;LCMP 0 #$;Long #$;Long #$;Boolean] + [long//< $i;LCMP -1 #$;Long #$;Long #$;Boolean] + + [float//= $i;FCMPG 0 #$;Float #$;Float #$;Boolean] + [float//< $i;FCMPG -1 #$;Float #$;Float #$;Boolean] + + [double//= $i;DCMPG 0 #$;Double #$;Double #$;Boolean] + [double//< $i;DCMPG -1 #$;Double #$;Double #$;Boolean] + ) + +(def: int-procs + @;Bundle + (<| (@;prefix "int") + (|> (dict;new text;Hash<Text>) + (@;install "+" (@;binary int//+)) + (@;install "-" (@;binary int//-)) + (@;install "*" (@;binary int//*)) + (@;install "/" (@;binary int///)) + (@;install "%" (@;binary int//%)) + (@;install "=" (@;binary int//=)) + (@;install "<" (@;binary int//<)) + (@;install "and" (@;binary int//and)) + (@;install "or" (@;binary int//or)) + (@;install "xor" (@;binary int//xor)) + (@;install "shl" (@;binary int//shl)) + (@;install "shr" (@;binary int//shr)) + (@;install "ushr" (@;binary int//ushr)) + ))) + +(def: long-procs + @;Bundle + (<| (@;prefix "long") + (|> (dict;new text;Hash<Text>) + (@;install "+" (@;binary long//+)) + (@;install "-" (@;binary long//-)) + (@;install "*" (@;binary long//*)) + (@;install "/" (@;binary long///)) + (@;install "%" (@;binary long//%)) + (@;install "=" (@;binary long//=)) + (@;install "<" (@;binary long//<)) + (@;install "and" (@;binary long//and)) + (@;install "or" (@;binary long//or)) + (@;install "xor" (@;binary long//xor)) + (@;install "shl" (@;binary long//shl)) + (@;install "shr" (@;binary long//shr)) + (@;install "ushr" (@;binary long//ushr)) + ))) + +(def: float-procs + @;Bundle + (<| (@;prefix "float") + (|> (dict;new text;Hash<Text>) + (@;install "+" (@;binary float//+)) + (@;install "-" (@;binary float//-)) + (@;install "*" (@;binary float//*)) + (@;install "/" (@;binary float///)) + (@;install "%" (@;binary float//%)) + (@;install "=" (@;binary float//=)) + (@;install "<" (@;binary float//<)) + ))) + +(def: double-procs + @;Bundle + (<| (@;prefix "double") + (|> (dict;new text;Hash<Text>) + (@;install "+" (@;binary double//+)) + (@;install "-" (@;binary double//-)) + (@;install "*" (@;binary double//*)) + (@;install "/" (@;binary double///)) + (@;install "%" (@;binary double//%)) + (@;install "=" (@;binary double//=)) + (@;install "<" (@;binary double//<)) + ))) + +(def: char-procs + @;Bundle + (<| (@;prefix "char") + (|> (dict;new text;Hash<Text>) + (@;install "=" (@;binary char//=)) + (@;install "<" (@;binary char//<)) + ))) + (def: #export procedures @;Bundle (<| (@;prefix "jvm") (|> (dict;new text;Hash<Text>) (dict;merge conversion-procs) + (dict;merge int-procs) + (dict;merge long-procs) + (dict;merge float-procs) + (dict;merge double-procs) + (dict;merge char-procs) ))) diff --git a/new-luxc/test/test/luxc/analyser/procedure/host.jvm.lux b/new-luxc/test/test/luxc/analyser/procedure/host.jvm.lux index c45143d5b..49d51eb3c 100644 --- a/new-luxc/test/test/luxc/analyser/procedure/host.jvm.lux +++ b/new-luxc/test/test/luxc/analyser/procedure/host.jvm.lux @@ -148,7 +148,6 @@ [(format "jvm " <domain> " =") <boxed> <boxed> @host;Boolean] [(format "jvm " <domain> " <") <boxed> <boxed> @host;Boolean] - [(format "jvm " <domain> " >") <boxed> <boxed> @host;Boolean] )] ($_ seq <instructions> @@ -207,7 +206,6 @@ [(format "jvm " <domain> " =") <boxed> <boxed> @host;Boolean] [(format "jvm " <domain> " <") <boxed> <boxed> @host;Boolean] - [(format "jvm " <domain> " >") <boxed> <boxed> @host;Boolean] )] ($_ seq <instructions> @@ -229,7 +227,6 @@ [(format "jvm " <domain> " =") <boxed> <boxed> @host;Boolean] [(format "jvm " <domain> " <") <boxed> <boxed> @host;Boolean] - [(format "jvm " <domain> " >") <boxed> <boxed> @host;Boolean] )] ($_ seq <instructions> diff --git a/new-luxc/test/test/luxc/generator/procedure/host.jvm.lux b/new-luxc/test/test/luxc/generator/procedure/host.jvm.lux index 1dd60bc76..67fbbceda 100644 --- a/new-luxc/test/test/luxc/generator/procedure/host.jvm.lux +++ b/new-luxc/test/test/luxc/generator/procedure/host.jvm.lux @@ -4,6 +4,8 @@ (control [monad #+ do] pipe) (data ["R" result] + [bit] + [bool "bool/" Eq<Bool>] [number "int/" Number<Int>] text/format) ["r" math/random "r/" Monad<Random>] @@ -98,3 +100,136 @@ <3step> <4step> ))) + +(def: gen-nat + (r;Random Nat) + (|> r;nat + (r/map (n.% +128)) + (r;filter (|>. (n.= +0) not)))) + +(def: gen-int + (r;Random Int) + (|> gen-nat (r/map nat-to-int))) + +(def: gen-frac + (r;Random Frac) + (|> gen-int (r/map int-to-frac))) + +(do-template [<domain> <generator> <tag> <type> <test> <augmentation> <+> <-> <*> </> <%> <pre> <post>] + [(context: (format "Arithmetic [" <domain> "]") + [param <generator> + #let [subject (<augmentation> param)]] + (with-expansions [<tests> (do-template [<procedure> <reference>] + [(test <procedure> + (|> (do macro;Monad<Lux> + [sampleI (@;generate (<post> (#ls;Procedure <procedure> (list (<pre> (<tag> subject)) + (<pre> (<tag> param))))))] + (@eval;eval sampleI)) + (macro;run (init-compiler [])) + (case> (#R;Success valueG) + (<test> (<reference> param subject) + (:! <type> valueG)) + + (#R;Error error) + false)))] + + [(format "jvm " <domain> " +") <+>] + [(format "jvm " <domain> " -") <->] + [(format "jvm " <domain> " *") <*>] + [(format "jvm " <domain> " /") </>] + [(format "jvm " <domain> " %") <%>] + )] + ($_ seq + <tests> + )))] + + ["int" gen-int #ls;Int Int i.= (i.* 10) i.+ i.- i.* i./ i.% (|>. (list) (#ls;Procedure "jvm convert long-to-int")) (|>. (list) (#ls;Procedure "jvm convert int-to-long"))] + ["long" gen-int #ls;Int Int i.= (i.* 10) i.+ i.- i.* i./ i.% id id] + ["float" gen-frac #ls;Frac Frac f.= (f.* 10.0) f.+ f.- f.* f./ f.% (|>. (list) (#ls;Procedure "jvm convert double-to-float")) (|>. (list) (#ls;Procedure "jvm convert float-to-double"))] + ["double" gen-frac #ls;Frac Frac f.= (f.* 10.0) f.+ f.- f.* f./ f.% id id] + ) + +(do-template [<domain> <post> <convert>] + [(context: (format "Bit-wise [" <domain> "]") + [param gen-nat + subject gen-nat + #let [shift (n.% +10 param)]] + (with-expansions [<combiners> (do-template [<procedure> <reference>] + [(test <procedure> + (|> (do macro;Monad<Lux> + [sampleI (@;generate (<post> (#ls;Procedure <procedure> (list (<convert> (#ls;Nat subject)) + (<convert> (#ls;Nat param))))))] + (@eval;eval sampleI)) + (macro;run (init-compiler [])) + (case> (#R;Success valueG) + (n.= (<reference> param subject) + (:! Nat valueG)) + + (#R;Error error) + false)))] + + [(format "jvm " <domain> " and") bit;and] + [(format "jvm " <domain> " or") bit;or] + [(format "jvm " <domain> " xor") bit;xor] + ) + <shifters> (do-template [<procedure> <reference> <type> <test> <pre-subject> <pre>] + [(test <procedure> + (|> (do macro;Monad<Lux> + [sampleI (@;generate (<post> (#ls;Procedure <procedure> (list (<convert> (<pre> subject)) + (|> (#ls;Nat shift) + (list) + (#ls;Procedure "jvm convert long-to-int"))))))] + (@eval;eval sampleI)) + (macro;run (init-compiler [])) + (case> (#R;Success valueG) + (<test> (<reference> shift (<pre-subject> subject)) + (:! <type> valueG)) + + (#R;Error error) + false)))] + + [(format "jvm " <domain> " shl") bit;shift-left Nat n.= id #ls;Nat] + [(format "jvm " <domain> " shr") bit;signed-shift-right Int i.= nat-to-int (|>. nat-to-int #ls;Int)] + [(format "jvm " <domain> " ushr") bit;shift-right Nat n.= id #ls;Nat] + )] + ($_ seq + <combiners> + <shifters> + )))] + + ["int" (|>. (list) (#ls;Procedure "jvm convert int-to-long")) (|>. (list) (#ls;Procedure "jvm convert long-to-int"))] + ["long" id id] + ) + +(do-template [<domain> <generator> <tag> <=> <<> <pre>] + [(context: (format "Order [" <domain> "]") + [param <generator> + subject <generator>] + (with-expansions [<tests> (do-template [<procedure> <reference>] + [(test <procedure> + (|> (do macro;Monad<Lux> + [sampleI (@;generate (#ls;Procedure <procedure> (list (<pre> (<tag> subject)) + (<pre> (<tag> param)))))] + (@eval;eval sampleI)) + (macro;run (init-compiler [])) + (case> (#R;Success valueG) + (bool/= (<reference> param subject) + (:! Bool valueG)) + + (#R;Error error) + false)))] + + [(format "jvm " <domain> " =") <=>] + [(format "jvm " <domain> " <") <<>] + )] + ($_ seq + <tests> + )))] + + ["int" gen-int #ls;Int i.= i.< (|>. (list) (#ls;Procedure "jvm convert long-to-int"))] + ["long" gen-int #ls;Int i.= i.< id] + ["float" gen-frac #ls;Frac f.= f.< (|>. (list) (#ls;Procedure "jvm convert double-to-float"))] + ["double" gen-frac #ls;Frac f.= f.< id] + ["char" gen-int #ls;Int i.= i.< (|>. (list) (#ls;Procedure "jvm convert long-to-int") + (list) (#ls;Procedure "jvm convert int-to-char"))] + ) |