aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/generator/host
diff options
context:
space:
mode:
authorEduardo Julian2017-09-17 00:38:24 -0400
committerEduardo Julian2017-09-17 00:38:24 -0400
commitc95fa2cc7db042fdde7250479727650f43b087a1 (patch)
treecf4cc5a1829fa717b4dad17683251af56c54afa3 /new-luxc/source/luxc/generator/host
parent18fa9ac1ded14e8e6b96609ff1fb6f98af47580f (diff)
- Added pattern-matching compilation.
Diffstat (limited to 'new-luxc/source/luxc/generator/host')
-rw-r--r--new-luxc/source/luxc/generator/host/jvm/inst.lux49
1 files changed, 38 insertions, 11 deletions
diff --git a/new-luxc/source/luxc/generator/host/jvm/inst.lux b/new-luxc/source/luxc/generator/host/jvm/inst.lux
index 6085ff72b..0f947925c 100644
--- a/new-luxc/source/luxc/generator/host/jvm/inst.lux
+++ b/new-luxc/source/luxc/generator/host/jvm/inst.lux
@@ -3,6 +3,7 @@
(lux (control monad
["p" parser])
(data text/format
+ ["R" result]
(coll [list "L/" Functor<List>]))
[host #+ do-to]
[macro]
@@ -25,14 +26,16 @@
<stack> (declare DUP DUP2 DUP2_X1 DUP2_X2
POP POP2
SWAP)
- <jump> (declare IF_ICMPEQ IF_ACMPEQ IFNULL
- IFEQ IFLT IFLE IFGT IFGE
+ <jump> (declare IF_ICMPEQ IF_ICMPGT IF_ICMPLT IF_ACMPEQ IFNULL
+ IFEQ IFNE IFLT IFLE IFGT IFGE
GOTO)
<var> (declare ILOAD LLOAD DLOAD ALOAD
- ISTORE LSTORE)
+ ISTORE LSTORE ASTORE)
<arithmethic> (declare IADD ISUB
- LADD LSUB LMUL LDIV LREM LCMP
- DADD DSUB DMUL DDIV DREM DCMPG)
+ LADD LSUB LMUL LDIV LREM
+ LCMP
+ DADD DSUB DMUL DDIV DREM
+ DCMPG DCMPL)
<return> (declare RETURN IRETURN LRETURN DRETURN ARETURN)]
(host;import org.objectweb.asm.Opcodes
<primitive>
@@ -101,9 +104,16 @@
(visitMethodInsn [int String String String boolean] void)
(visitLabel [Label] void)
(visitJumpInsn [int Label] void)
- (visitTryCatchBlock [Label Label Label String] void))
+ (visitTryCatchBlock [Label Label Label String] void)
+ (visitTableSwitchInsn [int int Label (Array Label)] void)
+ )
## [Insts]
+(def: #export make-label
+ (Lux Label)
+ (function [compiler]
+ (#R;Success [compiler (Label.new [])])))
+
(def: #export (with-label action)
(-> (-> Label $;Inst) $;Inst)
(action (Label.new [])))
@@ -149,10 +159,12 @@
[IADD] [ISUB]
## Long arithmethic
- [LADD] [LSUB] [LMUL] [LDIV] [LREM] [LCMP]
+ [LADD] [LSUB] [LMUL] [LDIV] [LREM]
+ [LCMP]
## Double arithmetic
- [DADD] [DSUB] [DMUL] [DDIV] [DREM] [DCMPG]
+ [DADD] [DSUB] [DMUL] [DDIV] [DREM]
+ [DCMPG] [DCMPL]
## Conversions
[I2L] [L2I] [L2D] [D2L] [I2C]
@@ -175,7 +187,7 @@
(MethodVisitor.visitVarInsn [(prefix <name>) (nat-to-int register)]))))]
[ILOAD] [LLOAD] [DLOAD] [ALOAD]
- [ISTORE] [LSTORE]
+ [ISTORE] [LSTORE] [ASTORE]
)
(do-template [<name> <inst>]
@@ -237,11 +249,26 @@
(do-to visitor
(MethodVisitor.visitJumpInsn [(prefix <name>) @where]))))]
- [IF_ICMPEQ] [IF_ACMPEQ] [IFNULL]
- [IFEQ] [IFLT] [IFLE] [IFGT] [IFGE]
+ [IF_ICMPEQ] [IF_ICMPGT] [IF_ICMPLT] [IF_ACMPEQ] [IFNULL]
+ [IFEQ] [IFNE] [IFLT] [IFLE] [IFGT] [IFGE]
[GOTO]
)
+(def: #export (TABLESWITCH min max default labels)
+ (-> Int Int $;Label (List $;Label) $;Inst)
+ (function [visitor]
+ (let [num-labels (list;size labels)
+ labels-array (host;array Label num-labels)
+ _ (loop [idx +0]
+ (if (n.< num-labels idx)
+ (exec (host;array-write idx
+ (assume (list;nth idx labels))
+ labels-array)
+ (recur (n.inc idx)))
+ []))]
+ (do-to visitor
+ (MethodVisitor.visitTableSwitchInsn [min max default labels-array])))))
+
(def: #export (try @from @to @handler exception)
(-> $;Label $;Label $;Label Text $;Inst)
(function [visitor]