From 1acc9f4cdd7b7cff29351594fa603c3b6fa4c666 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 12 Oct 2017 15:22:25 -0400 Subject: - Compilation and tests for arithmetic, bit-wise operations and order. --- .../source/luxc/analyser/procedure/host.jvm.lux | 9 +- new-luxc/source/luxc/generator/host/jvm/inst.lux | 33 ++-- .../source/luxc/generator/procedure/host.jvm.lux | 168 +++++++++++++++++++++ .../test/test/luxc/analyser/procedure/host.jvm.lux | 3 - .../test/luxc/generator/procedure/host.jvm.lux | 135 +++++++++++++++++ 5 files changed, 322 insertions(+), 26 deletions(-) (limited to 'new-luxc') 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 )) (@;install "=" (@;binary Boolean)) (@;install "<" (@;binary Boolean)) - (@;install ">" (@;binary Boolean)) (@;install "and" (@;binary )) (@;install "or" (@;binary )) (@;install "xor" (@;binary )) @@ -117,7 +116,6 @@ (@;install "%" (@;binary )) (@;install "=" (@;binary Boolean)) (@;install "<" (@;binary Boolean)) - (@;install ">" (@;binary Boolean)) )))] [float-procs "float" Float] @@ -130,7 +128,6 @@ (|> (dict;new text;Hash) (@;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) (@;install "get" static-get) - (@;install "put" static-put) - ))) + (@;install "put" static-put)))) (dict;merge (<| (@;prefix "virtual") (|> (dict;new text;Hash) (@;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) (declare ILOAD LLOAD DLOAD ALOAD ISTORE LSTORE ASTORE) - (declare IADD ISUB - LADD LSUB LMUL LDIV LREM - LCMP - DADD DSUB DMUL DDIV DREM - DCMPG DCMPL) + (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) + (declare IAND IOR IXOR ISHL ISHR IUSHR + LAND LOR LXOR LSHL LSHR LUSHR) (declare RETURN IRETURN LRETURN DRETURN ARETURN)] (host;import org.objectweb.asm.Opcodes (#static NOP int) @@ -60,14 +61,8 @@ - (#static LAND int) - (#static LOR int) - (#static LXOR int) - (#static LSHL int) - (#static LSHR int) - (#static LUSHR int) - + (#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 [ ] + [(def: ( [xI yI]) + @;Binary + (|>. xI ($i;unwrap ) + yI ($i;unwrap ) + ($i;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 [ ] + [(def: ( [xI yI]) + @;Binary + (<| $i;with-label (function [@then]) + $i;with-label (function [@end]) + (|>. xI ($i;unwrap ) + yI ($i;unwrap ) + ( @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 [ ] + [(def: ( [xI yI]) + @;Binary + (<| $i;with-label (function [@then]) + $i;with-label (function [@end]) + (|>. xI ($i;unwrap ) + yI ($i;unwrap ) + + ($i;int ) + ($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) + (@;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) + (@;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) + (@;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) + (@;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) + (@;install "=" (@;binary char//=)) + (@;install "<" (@;binary char//<)) + ))) + (def: #export procedures @;Bundle (<| (@;prefix "jvm") (|> (dict;new text;Hash) (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 " " =") @host;Boolean] [(format "jvm " " <") @host;Boolean] - [(format "jvm " " >") @host;Boolean] )] ($_ seq @@ -207,7 +206,6 @@ [(format "jvm " " =") @host;Boolean] [(format "jvm " " <") @host;Boolean] - [(format "jvm " " >") @host;Boolean] )] ($_ seq @@ -229,7 +227,6 @@ [(format "jvm " " =") @host;Boolean] [(format "jvm " " <") @host;Boolean] - [(format "jvm " " >") @host;Boolean] )] ($_ seq 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] [number "int/" Number] text/format) ["r" math/random "r/" Monad] @@ -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 [ <+> <-> <*> <%> 
 ]
+  [(context: (format "Arithmetic ["  "]")
+     [param 
+      #let [subject ( param)]]
+     (with-expansions [ (do-template [ ]
+                                 [(test 
+                                        (|> (do macro;Monad
+                                              [sampleI (@;generate ( (#ls;Procedure  (list (
 ( subject))
+                                                                                                            (
 ( param))))))]
+                                              (@eval;eval sampleI))
+                                            (macro;run (init-compiler []))
+                                            (case> (#R;Success valueG)
+                                                   ( ( param subject)
+                                                           (:!  valueG))
+
+                                                   (#R;Error error)
+                                                   false)))]
+
+                                 [(format "jvm "  " +") <+>]
+                                 [(format "jvm "  " -") <->]
+                                 [(format "jvm "  " *") <*>]
+                                 [(format "jvm "  " /") ]
+                                 [(format "jvm "  " %") <%>]
+                                 )]
+       ($_ seq
+           
+           )))]
+
+  ["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 [  ]
+  [(context: (format "Bit-wise ["  "]")
+     [param gen-nat
+      subject gen-nat
+      #let [shift (n.% +10 param)]]
+     (with-expansions [ (do-template [ ]
+                                     [(test 
+                                            (|> (do macro;Monad
+                                                  [sampleI (@;generate ( (#ls;Procedure  (list ( (#ls;Nat subject))
+                                                                                                                ( (#ls;Nat param))))))]
+                                                  (@eval;eval sampleI))
+                                                (macro;run (init-compiler []))
+                                                (case> (#R;Success valueG)
+                                                       (n.= ( param subject)
+                                                            (:! Nat valueG))
+
+                                                       (#R;Error error)
+                                                       false)))]
+
+                                     [(format "jvm "  " and") bit;and]
+                                     [(format "jvm "  " or") bit;or]
+                                     [(format "jvm "  " xor") bit;xor]
+                                     )
+                        (do-template [     
]
+                                    [(test 
+                                           (|> (do macro;Monad
+                                                 [sampleI (@;generate ( (#ls;Procedure  (list ( (
 subject))
+                                                                                                               (|> (#ls;Nat shift)
+                                                                                                                   (list)
+                                                                                                                   (#ls;Procedure "jvm convert long-to-int"))))))]
+                                                 (@eval;eval sampleI))
+                                               (macro;run (init-compiler []))
+                                               (case> (#R;Success valueG)
+                                                      ( ( shift ( subject))
+                                                              (:!  valueG))
+
+                                                      (#R;Error error)
+                                                      false)))]
+
+                                    [(format "jvm "  " shl") bit;shift-left Nat n.= id #ls;Nat]
+                                    [(format "jvm "  " shr") bit;signed-shift-right Int i.= nat-to-int (|>. nat-to-int #ls;Int)]
+                                    [(format "jvm "  " ushr") bit;shift-right Nat n.= id #ls;Nat]
+                                    )]
+       ($_ seq
+           
+           
+           )))]
+
+  ["int" (|>. (list) (#ls;Procedure "jvm convert int-to-long")) (|>. (list) (#ls;Procedure "jvm convert long-to-int"))]
+  ["long" id id]
+  )
+
+(do-template [   <=> <<> 
]
+  [(context: (format "Order ["  "]")
+     [param 
+      subject ]
+     (with-expansions [ (do-template [ ]
+                                 [(test 
+                                        (|> (do macro;Monad
+                                              [sampleI (@;generate (#ls;Procedure  (list (
 ( subject))
+                                                                                                    (
 ( param)))))]
+                                              (@eval;eval sampleI))
+                                            (macro;run (init-compiler []))
+                                            (case> (#R;Success valueG)
+                                                   (bool/= ( param subject)
+                                                           (:! Bool valueG))
+
+                                                   (#R;Error error)
+                                                   false)))]
+
+                                 [(format "jvm "  " =") <=>]
+                                 [(format "jvm "  " <") <<>]
+                                 )]
+       ($_ seq
+           
+           )))]
+
+  ["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"))]
+  )
-- 
cgit v1.2.3