aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/directive/jvm.lux537
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/inst.lux73
-rw-r--r--new-luxc/source/program.lux10
-rw-r--r--stdlib/source/lux/target/jvm.lux282
-rw-r--r--stdlib/source/lux/tool/compiler/phase/extension/directive/lux.lux2
-rw-r--r--stdlib/source/spec/compositor/common.lux20
-rw-r--r--stdlib/source/test/lux/extension.lux65
7 files changed, 942 insertions, 47 deletions
diff --git a/new-luxc/source/luxc/lang/directive/jvm.lux b/new-luxc/source/luxc/lang/directive/jvm.lux
new file mode 100644
index 000000000..821ee7605
--- /dev/null
+++ b/new-luxc/source/luxc/lang/directive/jvm.lux
@@ -0,0 +1,537 @@
+(.module:
+ [lux #*
+ [host (#+ import:)]
+ [type (#+ :share)]
+ [abstract
+ ["." monad (#+ do)]]
+ [control
+ ["." try (#+ Try)]]
+ [target
+ ["/" jvm]]
+ [data
+ [identity (#+ Identity)]
+ ["." product]
+ [number
+ ["." nat]]
+ [text
+ ["%" format (#+ format)]]
+ [collection
+ ["." list ("#@." fold)]
+ ["." dictionary (#+ Dictionary)]
+ ["." row (#+ Row) ("#@." functor fold)]]]
+ [tool
+ [compiler
+ [synthesis (#+ Synthesis)]
+ ["." directive]
+ ["." phase
+ ["." generation]
+ ["." extension (#+ Extender)
+ ["." bundle]
+ [directive
+ ["./" lux]]]]]]]
+ [///
+ [host
+ ["." jvm (#+ Inst)
+ ["_" inst]]]])
+
+(import: #long org/objectweb/asm/Label
+ (new []))
+
+(def: (literal literal)
+ (-> /.Literal Inst)
+ (case literal
+ (#/.Boolean value) (_.boolean value)
+ (#/.Int value) (_.int value)
+ (#/.Long value) (_.long value)
+ (#/.Double value) (_.double value)
+ (#/.Char value) (_.char value)
+ (#/.String value) (_.string value)))
+
+(def: (constant instruction)
+ (-> /.Constant Inst)
+ (case instruction
+ (#/.BIPUSH constant) (_.BIPUSH constant)
+
+ (#/.SIPUSH constant) (_.SIPUSH constant)
+
+ #/.ICONST_M1 _.ICONST_M1
+ #/.ICONST_0 _.ICONST_0
+ #/.ICONST_1 _.ICONST_1
+ #/.ICONST_2 _.ICONST_2
+ #/.ICONST_3 _.ICONST_3
+ #/.ICONST_4 _.ICONST_4
+ #/.ICONST_5 _.ICONST_5
+
+ #/.LCONST_0 _.LCONST_0
+ #/.LCONST_1 _.LCONST_1
+
+ #/.FCONST_0 _.FCONST_0
+ #/.FCONST_1 _.FCONST_1
+ #/.FCONST_2 _.FCONST_2
+
+ #/.DCONST_0 _.DCONST_0
+ #/.DCONST_1 _.DCONST_1
+
+ #/.ACONST_NULL _.NULL
+
+ (#/.LDC literal)
+ (..literal literal)
+ ))
+
+(def: (int-arithmetic instruction)
+ (-> /.Int-Arithmetic Inst)
+ (case instruction
+ #/.IADD _.IADD
+ #/.ISUB _.ISUB
+ #/.IMUL _.IMUL
+ #/.IDIV _.IDIV
+ #/.IREM _.IREM
+ #/.INEG _.INEG))
+
+(def: (long-arithmetic instruction)
+ (-> /.Long-Arithmetic Inst)
+ (case instruction
+ #/.LADD _.LADD
+ #/.LSUB _.LSUB
+ #/.LMUL _.LMUL
+ #/.LDIV _.LDIV
+ #/.LREM _.LREM
+ #/.LNEG _.LNEG))
+
+(def: (float-arithmetic instruction)
+ (-> /.Float-Arithmetic Inst)
+ (case instruction
+ #/.FADD _.FADD
+ #/.FSUB _.FSUB
+ #/.FMUL _.FMUL
+ #/.FDIV _.FDIV
+ #/.FREM _.FREM
+ #/.FNEG _.FNEG))
+
+(def: (double-arithmetic instruction)
+ (-> /.Double-Arithmetic Inst)
+ (case instruction
+ #/.DADD _.DADD
+ #/.DSUB _.DSUB
+ #/.DMUL _.DMUL
+ #/.DDIV _.DDIV
+ #/.DREM _.DREM
+ #/.DNEG _.DNEG))
+
+(def: (arithmetic instruction)
+ (-> /.Arithmetic Inst)
+ (case instruction
+ (#/.Int-Arithmetic int-arithmetic)
+ (..int-arithmetic int-arithmetic)
+
+ (#/.Long-Arithmetic long-arithmetic)
+ (..long-arithmetic long-arithmetic)
+
+ (#/.Float-Arithmetic float-arithmetic)
+ (..float-arithmetic float-arithmetic)
+
+ (#/.Double-Arithmetic double-arithmetic)
+ (..double-arithmetic double-arithmetic)))
+
+(def: (int-bitwise instruction)
+ (-> /.Int-Bitwise Inst)
+ (case instruction
+ #/.IOR _.IOR
+ #/.IXOR _.IXOR
+ #/.IAND _.IAND
+ #/.ISHL _.ISHL
+ #/.ISHR _.ISHR
+ #/.IUSHR _.IUSHR))
+
+(def: (long-bitwise instruction)
+ (-> /.Long-Bitwise Inst)
+ (case instruction
+ #/.LOR _.LOR
+ #/.LXOR _.LXOR
+ #/.LAND _.LAND
+ #/.LSHL _.LSHL
+ #/.LSHR _.LSHR
+ #/.LUSHR _.LUSHR))
+
+(def: (bitwise instruction)
+ (-> /.Bitwise Inst)
+ (case instruction
+ (#/.Int-Bitwise int-bitwise)
+ (..int-bitwise int-bitwise)
+
+ (#/.Long-Bitwise long-bitwise)
+ (..long-bitwise long-bitwise)))
+
+(def: (conversion instruction)
+ (-> /.Conversion Inst)
+ (case instruction
+ #/.I2B _.I2B
+ #/.I2S _.I2S
+ #/.I2L _.I2L
+ #/.I2F _.I2F
+ #/.I2D _.I2D
+ #/.I2C _.I2C
+
+ #/.L2I _.L2I
+ #/.L2F _.L2F
+ #/.L2D _.L2D
+
+ #/.F2I _.F2I
+ #/.F2L _.F2L
+ #/.F2D _.F2D
+
+ #/.D2I _.D2I
+ #/.D2L _.D2L
+ #/.D2F _.D2F))
+
+(def: (array instruction)
+ (-> /.Array Inst)
+ (case instruction
+ #/.ARRAYLENGTH _.ARRAYLENGTH
+
+ (#/.NEWARRAY type) (_.NEWARRAY type)
+ (#/.ANEWARRAY type) (_.ANEWARRAY type)
+
+ #/.BALOAD _.BALOAD
+ #/.BASTORE _.BASTORE
+
+ #/.SALOAD _.SALOAD
+ #/.SASTORE _.SASTORE
+
+ #/.IALOAD _.IALOAD
+ #/.IASTORE _.IASTORE
+
+ #/.LALOAD _.LALOAD
+ #/.LASTORE _.LASTORE
+
+ #/.FALOAD _.FALOAD
+ #/.FASTORE _.FASTORE
+
+ #/.DALOAD _.DALOAD
+ #/.DASTORE _.DASTORE
+
+ #/.CALOAD _.CALOAD
+ #/.CASTORE _.CASTORE
+
+ #/.AALOAD _.AALOAD
+ #/.AASTORE _.AASTORE))
+
+(def: (object instruction)
+ (-> /.Object Inst)
+ (case instruction
+ (^template [<tag> <inst>]
+ (<tag> class field-name field-type)
+ (<inst> class field-name field-type))
+ ([#/.GETSTATIC _.GETSTATIC]
+ [#/.PUTSTATIC _.PUTSTATIC]
+ [#/.GETFIELD _.GETFIELD]
+ [#/.PUTFIELD _.PUTFIELD])
+
+ (#/.NEW type) (_.NEW type)
+
+ (#/.INSTANCEOF type) (_.INSTANCEOF type)
+ (#/.CHECKCAST type) (_.CHECKCAST type)
+
+ (^template [<tag> <inst>]
+ (<tag> class method-name method-type)
+ (<inst> class method-name method-type))
+ ([#/.INVOKEINTERFACE _.INVOKEINTERFACE]
+ [#/.INVOKESPECIAL _.INVOKESPECIAL]
+ [#/.INVOKESTATIC _.INVOKESTATIC]
+ [#/.INVOKEVIRTUAL _.INVOKEVIRTUAL])
+ ))
+
+(def: (local-int instruction)
+ (-> /.Local-Int Inst)
+ (case instruction
+ (#/.ILOAD register) (_.ILOAD register)
+ (#/.ISTORE register) (_.ISTORE register)))
+
+(def: (local-long instruction)
+ (-> /.Local-Long Inst)
+ (case instruction
+ (#/.LLOAD register) (_.LLOAD register)
+ (#/.LSTORE register) (_.LSTORE register)))
+
+(def: (local-float instruction)
+ (-> /.Local-Float Inst)
+ (case instruction
+ (#/.FLOAD register) (_.FLOAD register)
+ (#/.FSTORE register) (_.FSTORE register)))
+
+(def: (local-double instruction)
+ (-> /.Local-Double Inst)
+ (case instruction
+ (#/.DLOAD register) (_.DLOAD register)
+ (#/.DSTORE register) (_.DSTORE register)))
+
+(def: (local-object instruction)
+ (-> /.Local-Object Inst)
+ (case instruction
+ (#/.ALOAD register) (_.ALOAD register)
+ (#/.ASTORE register) (_.ASTORE register)))
+
+(def: (local instruction)
+ (-> /.Local Inst)
+ (case instruction
+ (#/.Local-Int instruction) (..local-int instruction)
+ (#/.IINC register) (_.IINC register)
+ (#/.Local-Long instruction) (..local-long instruction)
+ (#/.Local-Float instruction) (..local-float instruction)
+ (#/.Local-Double instruction) (..local-double instruction)
+ (#/.Local-Object instruction) (..local-object instruction)))
+
+(def: (stack instruction)
+ (-> /.Stack Inst)
+ (case instruction
+ #/.DUP _.DUP
+ #/.DUP_X1 _.DUP_X1
+ #/.DUP_X2 _.DUP_X2
+ #/.DUP2 _.DUP2
+ #/.DUP2_X1 _.DUP2_X1
+ #/.DUP2_X2 _.DUP2_X2
+ #/.SWAP _.SWAP
+ #/.POP _.POP
+ #/.POP2 _.POP2))
+
+(def: (comparison instruction)
+ (-> /.Comparison Inst)
+ (case instruction
+ #/.LCMP _.LCMP
+
+ #/.FCMPG _.FCMPG
+ #/.FCMPL _.FCMPL
+
+ #/.DCMPG _.DCMPG
+ #/.DCMPL _.DCMPL))
+
+(def: (branching instruction)
+ (-> (/.Branching org/objectweb/asm/Label) Inst)
+ (case instruction
+ (#/.IF_ICMPEQ label) (_.IF_ICMPEQ label)
+ (#/.IF_ICMPGE label) (_.IF_ICMPGE label)
+ (#/.IF_ICMPGT label) (_.IF_ICMPGT label)
+ (#/.IF_ICMPLE label) (_.IF_ICMPLE label)
+ (#/.IF_ICMPLT label) (_.IF_ICMPLT label)
+ (#/.IF_ICMPNE label) (_.IF_ICMPNE label)
+ (#/.IFEQ label) (_.IFEQ label)
+ (#/.IFGE label) (_.IFGE label)
+ (#/.IFGT label) (_.IFGT label)
+ (#/.IFLE label) (_.IFLE label)
+ (#/.IFLT label) (_.IFLT label)
+ (#/.IFNE label) (_.IFNE label)
+
+ (#/.TABLESWITCH min max default labels)
+ (_.TABLESWITCH min max default labels)
+
+ (#/.LOOKUPSWITCH default keys+labels)
+ (_.LOOKUPSWITCH default keys+labels)
+
+ (#/.IF_ACMPEQ label) (_.IF_ACMPEQ label)
+ (#/.IF_ACMPNE label) (_.IF_ACMPNE label)
+ (#/.IFNONNULL label) (_.IFNONNULL label)
+ (#/.IFNULL label) (_.IFNULL label)))
+
+(def: (exception instruction)
+ (-> (/.Exception org/objectweb/asm/Label) Inst)
+ (case instruction
+ (#/.Try start end handler exception) (_.try start end handler exception)
+ #/.ATHROW _.ATHROW))
+
+(def: (concurrency instruction)
+ (-> /.Concurrency Inst)
+ (case instruction
+ #/.MONITORENTER _.MONITORENTER
+ #/.MONITOREXIT _.MONITOREXIT))
+
+(def: (return instruction)
+ (-> /.Return Inst)
+ (case instruction
+ #/.RETURN _.RETURN
+ #/.IRETURN _.IRETURN
+ #/.LRETURN _.LRETURN
+ #/.FRETURN _.FRETURN
+ #/.DRETURN _.DRETURN
+ #/.ARETURN _.ARETURN))
+
+(def: (control instruction)
+ (-> (/.Control org/objectweb/asm/Label) Inst)
+ (case instruction
+ (#/.GOTO label) (_.GOTO label)
+ (#/.Branching instruction) (..branching instruction)
+ (#/.Exception instruction) (..exception instruction)
+ (#/.Concurrency instruction) (..concurrency instruction)
+ (#/.Return instruction) (..return instruction)))
+
+(def: (instruction instruction)
+ (-> (/.Instruction org/objectweb/asm/Label) Inst)
+ (case instruction
+ #/.NOP _.NOP
+ (#/.Constant instruction) (..constant instruction)
+ (#/.Arithmetic instruction) (..arithmetic instruction)
+ (#/.Bitwise instruction) (..bitwise instruction)
+ (#/.Conversion instruction) (..conversion instruction)
+ (#/.Array instruction) (..array instruction)
+ (#/.Object instruction) (..object instruction)
+ (#/.Local instruction) (..local instruction)
+ (#/.Stack instruction) (..stack instruction)
+ (#/.Comparison instruction) (..comparison instruction)
+ (#/.Control instruction) (..control instruction)))
+
+(type: Mapping
+ (Dictionary /.Label org/objectweb/asm/Label))
+
+(type: (Re-labeler context)
+ (-> [Mapping (context /.Label)]
+ [Mapping (context org/objectweb/asm/Label)]))
+
+(def: (relabel [mapping label])
+ (Re-labeler Identity)
+ (case (dictionary.get label mapping)
+ (#.Some label)
+ [mapping label]
+
+ #.None
+ (let [label' (org/objectweb/asm/Label::new)]
+ [(dictionary.put label label' mapping) label'])))
+
+(def: (relabel-branching [mapping instruction])
+ (Re-labeler /.Branching)
+ (case instruction
+ (^template [<tag>]
+ (<tag> label)
+ (let [[mapping label] (..relabel [mapping label])]
+ [mapping (<tag> label)]))
+ ([#/.IF_ICMPEQ] [#/.IF_ICMPGE] [#/.IF_ICMPGT] [#/.IF_ICMPLE] [#/.IF_ICMPLT] [#/.IF_ICMPNE]
+ [#/.IFEQ] [#/.IFNE] [#/.IFGE] [#/.IFGT] [#/.IFLE] [#/.IFLT]
+
+ [#/.IF_ACMPEQ] [#/.IF_ACMPNE] [#/.IFNONNULL] [#/.IFNULL])
+
+ (#/.TABLESWITCH min max default labels)
+ (let [[mapping default] (..relabel [mapping default])
+ [mapping labels] (list@fold (function (_ input [mapping output])
+ (let [[mapping input] (..relabel [mapping input])]
+ [mapping (list& input output)]))
+ [mapping (list)] labels)]
+ [mapping (#/.TABLESWITCH min max default (list.reverse labels))])
+
+ (#/.LOOKUPSWITCH default keys+labels)
+ (let [[mapping default] (..relabel [mapping default])
+ [mapping keys+labels] (list@fold (function (_ [expected input] [mapping output])
+ (let [[mapping input] (..relabel [mapping input])]
+ [mapping (list& [expected input] output)]))
+ [mapping (list)] keys+labels)]
+ [mapping (#/.LOOKUPSWITCH default (list.reverse keys+labels))])
+ ))
+
+(def: (relabel-exception [mapping instruction])
+ (Re-labeler /.Exception)
+ (case instruction
+ (#/.Try start end handler exception)
+ (let [[mapping start] (..relabel [mapping start])
+ [mapping end] (..relabel [mapping end])
+ [mapping handler] (..relabel [mapping handler])]
+ [mapping (#/.Try start end handler exception)])
+
+ #/.ATHROW
+ [mapping #/.ATHROW]
+ ))
+
+(def: (relabel-control [mapping instruction])
+ (Re-labeler /.Control)
+ (case instruction
+ (^template [<tag> <relabel>]
+ (<tag> instruction)
+ (let [[mapping instruction] (<relabel> [mapping instruction])]
+ [mapping (<tag> instruction)]))
+ ([#/.GOTO ..relabel]
+ [#/.Branching ..relabel-branching]
+ [#/.Exception ..relabel-exception])
+
+ (^template [<tag>]
+ (<tag> instruction)
+ [mapping (<tag> instruction)])
+ ([#/.Concurrency] [#/.Return])
+ ))
+
+(def: (relabel-instruction [mapping instruction])
+ (Re-labeler /.Instruction)
+ (case instruction
+ #/.NOP [mapping #/.NOP]
+
+ (^template [<tag>]
+ (<tag> instruction)
+ [mapping (<tag> instruction)])
+ ([#/.Constant]
+ [#/.Arithmetic]
+ [#/.Bitwise]
+ [#/.Conversion]
+ [#/.Array]
+ [#/.Object]
+ [#/.Local]
+ [#/.Stack]
+ [#/.Comparison])
+
+ (#/.Control instruction)
+ (let [[mapping instruction] (..relabel-control [mapping instruction])]
+ [mapping (#/.Control instruction)])))
+
+(def: (relabel-bytecode [mapping bytecode])
+ (Re-labeler /.Bytecode)
+ (row@fold (function (_ input [mapping output])
+ (let [[mapping input] (..relabel-instruction [mapping input])]
+ [mapping (row.add input output)]))
+ [mapping (row.row)]
+ bytecode))
+
+(def: fresh
+ Mapping
+ (dictionary.new nat.hash))
+
+(def: bytecode
+ (-> (/.Bytecode /.Label) Inst)
+ (|>> [..fresh]
+ ..relabel-bytecode
+ product.right
+ (row@map ..instruction)
+ row.to-list
+ _.fuse))
+
+(type: Pseudo-Handler
+ (-> Text (List Synthesis) (Try (/.Bytecode /.Label))))
+
+(def: (true-handler pseudo)
+ (-> Pseudo-Handler jvm.Handler)
+ (function (_ extension-name phase inputs)
+ (|> (pseudo extension-name inputs)
+ (:: try.monad map ..bytecode)
+ phase.lift)))
+
+(def: (def::generation extender)
+ (All [anchor expression directive]
+ (-> Extender (directive.Handler anchor expression directive)))
+ (function (handler extension-name phase inputsC+)
+ (case inputsC+
+ (^ (list nameC valueC))
+ (do phase.monad
+ [[_ _ name] (lux/.evaluate! Text nameC)
+ [_ _ pseudo-handlerV] (lux/.evaluate! ..Pseudo-Handler valueC)
+ _ (<| directive.lift-generation
+ (extension.install extender (:coerce Text name))
+ (:share [anchor expression directive]
+ {(directive.Handler anchor expression directive)
+ handler}
+ {(generation.Handler anchor expression directive)
+ (<| ..true-handler
+ (:coerce ..Pseudo-Handler)
+ pseudo-handlerV)}))
+ #let [_ (log! (format "Generation " (%.text (:coerce Text name))))]]
+ (wrap directive.no-requirements))
+
+ _
+ (phase.throw extension.invalid-syntax [extension-name %.code inputsC+]))))
+
+(def: #export (bundle extender)
+ (-> Extender directive.Bundle)
+ (|> bundle.empty
+ (dictionary.put "lux def generation" (..def::generation extender))))
diff --git a/new-luxc/source/luxc/lang/host/jvm/inst.lux b/new-luxc/source/luxc/lang/host/jvm/inst.lux
index e52d11d9b..b673c7d7e 100644
--- a/new-luxc/source/luxc/lang/host/jvm/inst.lux
+++ b/new-luxc/source/luxc/lang/host/jvm/inst.lux
@@ -72,21 +72,27 @@
## Jump
(~~ (declare IF_ICMPEQ IF_ICMPGT IF_ICMPLT
IF_ICMPNE IF_ICMPGE IF_ICMPLE
- IF_ACMPEQ IFNULL
+ IF_ACMPEQ IF_ACMPNE IFNULL IFNONNULL
IFEQ IFNE IFLT IFLE IFGT IFGE
GOTO))
+ (~~ (declare BIPUSH SIPUSH))
+ (~~ (declare ICONST_M1 ICONST_0 ICONST_1 ICONST_2 ICONST_3 ICONST_4 ICONST_5
+ LCONST_0 LCONST_1
+ FCONST_0 FCONST_1 FCONST_2
+ DCONST_0 DCONST_1))
(#static ACONST_NULL int)
## Var
- (~~ (declare ILOAD LLOAD DLOAD ALOAD
- ISTORE LSTORE ASTORE))
+ (~~ (declare IINC
+ ILOAD LLOAD FLOAD DLOAD ALOAD
+ ISTORE LSTORE FSTORE DSTORE ASTORE))
## Arithmetic
- (~~ (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 IADD ISUB IMUL IDIV IREM INEG
+ LADD LSUB LMUL LDIV LREM LNEG LCMP
+ FADD FSUB FMUL FDIV FREM FNEG FCMPG FCMPL
+ DADD DSUB DMUL DDIV DREM DNEG DCMPG DCMPL))
## Bit-wise
(~~ (declare IAND IOR IXOR ISHL ISHR IUSHR
@@ -162,21 +168,45 @@
[string Text function.identity]
)
-(template: (prefix short)
+(template: (!prefix short)
(`` ((~~ (template.identifier ["org/objectweb/asm/Opcodes::" short])))))
+(template [<constant>]
+ [(def: #export <constant>
+ Inst
+ (function (_ visitor)
+ (do-to visitor
+ (org/objectweb/asm/MethodVisitor::visitInsn (!prefix <constant>)))))]
+
+ [ICONST_M1] [ICONST_0] [ICONST_1] [ICONST_2] [ICONST_3] [ICONST_4] [ICONST_5]
+ [LCONST_0] [LCONST_1]
+ [FCONST_0] [FCONST_1] [FCONST_2]
+ [DCONST_0] [DCONST_1]
+ )
+
(def: #export NULL
Inst
(function (_ visitor)
(do-to visitor
- (org/objectweb/asm/MethodVisitor::visitInsn (prefix ACONST_NULL)))))
+ (org/objectweb/asm/MethodVisitor::visitInsn (!prefix ACONST_NULL)))))
+
+(template [<constant>]
+ [(def: #export (<constant> constant)
+ (-> Int Inst)
+ (function (_ visitor)
+ (do-to visitor
+ (org/objectweb/asm/MethodVisitor::visitIntInsn (!prefix <constant>) constant))))]
+
+ [BIPUSH]
+ [SIPUSH]
+ )
(template [<name>]
[(def: #export <name>
Inst
(function (_ visitor)
(do-to visitor
- (org/objectweb/asm/MethodVisitor::visitInsn (prefix <name>)))))]
+ (org/objectweb/asm/MethodVisitor::visitInsn (!prefix <name>)))))]
[NOP]
@@ -192,23 +222,23 @@
[L2D] [L2F] [L2I]
## Integer arithmetic
- [IADD] [ISUB] [IMUL] [IDIV] [IREM]
+ [IADD] [ISUB] [IMUL] [IDIV] [IREM] [INEG]
## Integer bitwise
[IAND] [IOR] [IXOR] [ISHL] [ISHR] [IUSHR]
## Long arithmetic
- [LADD] [LSUB] [LMUL] [LDIV] [LREM]
+ [LADD] [LSUB] [LMUL] [LDIV] [LREM] [LNEG]
[LCMP]
## Long bitwise
[LAND] [LOR] [LXOR] [LSHL] [LSHR] [LUSHR]
## Float arithmetic
- [FADD] [FSUB] [FMUL] [FDIV] [FREM] [FCMPG] [FCMPL]
+ [FADD] [FSUB] [FMUL] [FDIV] [FREM] [FNEG] [FCMPG] [FCMPL]
## Double arithmetic
- [DADD] [DSUB] [DMUL] [DDIV] [DREM]
+ [DADD] [DSUB] [DMUL] [DDIV] [DREM] [DNEG]
[DCMPG] [DCMPL]
## Array
@@ -232,15 +262,18 @@
[RETURN] [IRETURN] [LRETURN] [FRETURN] [DRETURN] [ARETURN]
)
+(type: #export Register Nat)
+
(template [<name>]
[(def: #export (<name> register)
- (-> Nat Inst)
+ (-> Register Inst)
(function (_ visitor)
(do-to visitor
- (org/objectweb/asm/MethodVisitor::visitVarInsn (prefix <name>) (.int register)))))]
+ (org/objectweb/asm/MethodVisitor::visitVarInsn (!prefix <name>) (.int register)))))]
- [ILOAD] [LLOAD] [DLOAD] [ALOAD]
- [ISTORE] [LSTORE] [ASTORE]
+ [IINC]
+ [ILOAD] [LLOAD] [FLOAD] [DLOAD] [ALOAD]
+ [ISTORE] [LSTORE] [FSTORE] [DSTORE] [ASTORE]
)
(template [<name> <inst>]
@@ -317,11 +350,11 @@
(-> //.Label Inst)
(function (_ visitor)
(do-to visitor
- (org/objectweb/asm/MethodVisitor::visitJumpInsn (prefix <name>) @where))))]
+ (org/objectweb/asm/MethodVisitor::visitJumpInsn (!prefix <name>) @where))))]
[IF_ICMPEQ] [IF_ICMPGT] [IF_ICMPLT]
[IF_ICMPNE] [IF_ICMPGE] [IF_ICMPLE]
- [IF_ACMPEQ] [IFNULL]
+ [IF_ACMPEQ] [IF_ACMPNE] [IFNULL] [IFNONNULL]
[IFEQ] [IFNE] [IFLT] [IFLE] [IFGT] [IFGE]
[GOTO]
)
diff --git a/new-luxc/source/program.lux b/new-luxc/source/program.lux
index d802f7f32..51f817b6f 100644
--- a/new-luxc/source/program.lux
+++ b/new-luxc/source/program.lux
@@ -25,11 +25,11 @@
[phase
["." macro (#+ Expander)]
[extension (#+ Phase Bundle Operation Handler Extender)
- ["." bundle]
["." analysis #_
["#" jvm]]
- ["." directive #_
- ["#" jvm]]]
+ ## ["." directive #_
+ ## ["#" jvm]]
+ ]
["." generation #_
["#" jvm/extension]
["." jvm #_
@@ -46,6 +46,8 @@
[lang
[host
["_" jvm]]
+ ["." directive #_
+ ["#" jvm]]
[translation
["." jvm
["." runtime]
@@ -149,7 +151,7 @@
..platform
## generation.bundle
translation.bundle
- bundle.empty
+ (directive.bundle extender)
jvm/program.program
..extender
service
diff --git a/stdlib/source/lux/target/jvm.lux b/stdlib/source/lux/target/jvm.lux
new file mode 100644
index 000000000..4998f0f05
--- /dev/null
+++ b/stdlib/source/lux/target/jvm.lux
@@ -0,0 +1,282 @@
+(.module:
+ [lux (#- Type)
+ [data
+ [collection
+ [row (#+ Row)]]]
+ [target
+ [jvm
+ [type (#+ Type)
+ ["." category (#+ Primitive Class Value Method)]]]]])
+
+(type: #export Literal
+ (#Boolean Bit)
+ (#Int Int)
+ (#Long Int)
+ (#Double Frac)
+ (#Char Nat)
+ (#String Text))
+
+(type: #export Constant
+ (#BIPUSH Int)
+
+ (#SIPUSH Int)
+
+ #ICONST_M1
+ #ICONST_0
+ #ICONST_1
+ #ICONST_2
+ #ICONST_3
+ #ICONST_4
+ #ICONST_5
+
+ #LCONST_0
+ #LCONST_1
+
+ #FCONST_0
+ #FCONST_1
+ #FCONST_2
+
+ #DCONST_0
+ #DCONST_1
+
+ #ACONST_NULL
+
+ (#LDC Literal))
+
+(type: #export Int-Arithmetic
+ #IADD
+ #ISUB
+ #IMUL
+ #IDIV
+ #IREM
+ #INEG)
+
+(type: #export Long-Arithmetic
+ #LADD
+ #LSUB
+ #LMUL
+ #LDIV
+ #LREM
+ #LNEG)
+
+(type: #export Float-Arithmetic
+ #FADD
+ #FSUB
+ #FMUL
+ #FDIV
+ #FREM
+ #FNEG)
+
+(type: #export Double-Arithmetic
+ #DADD
+ #DSUB
+ #DMUL
+ #DDIV
+ #DREM
+ #DNEG)
+
+(type: #export Arithmetic
+ (#Int-Arithmetic Int-Arithmetic)
+ (#Long-Arithmetic Long-Arithmetic)
+ (#Float-Arithmetic Float-Arithmetic)
+ (#Double-Arithmetic Double-Arithmetic))
+
+(type: #export Int-Bitwise
+ #IOR
+ #IXOR
+ #IAND
+ #ISHL
+ #ISHR
+ #IUSHR)
+
+(type: #export Long-Bitwise
+ #LOR
+ #LXOR
+ #LAND
+ #LSHL
+ #LSHR
+ #LUSHR)
+
+(type: #export Bitwise
+ (#Int-Bitwise Int-Bitwise)
+ (#Long-Bitwise Long-Bitwise))
+
+(type: #export Conversion
+ #I2B
+ #I2S
+ #I2L
+ #I2F
+ #I2D
+ #I2C
+
+ #L2I
+ #L2F
+ #L2D
+
+ #F2I
+ #F2L
+ #F2D
+
+ #D2I
+ #D2L
+ #D2F)
+
+(type: #export Array
+ #ARRAYLENGTH
+
+ (#NEWARRAY (Type Primitive))
+ (#ANEWARRAY (Type category.Object))
+
+ #BALOAD
+ #BASTORE
+
+ #SALOAD
+ #SASTORE
+
+ #IALOAD
+ #IASTORE
+
+ #LALOAD
+ #LASTORE
+
+ #FALOAD
+ #FASTORE
+
+ #DALOAD
+ #DASTORE
+
+ #CALOAD
+ #CASTORE
+
+ #AALOAD
+ #AASTORE)
+
+(type: #export Object
+ (#GETSTATIC (Type Class) Text (Type Value))
+ (#PUTSTATIC (Type Class) Text (Type Value))
+
+ (#NEW (Type Class))
+
+ (#INSTANCEOF (Type Class))
+ (#CHECKCAST (Type category.Object))
+
+ (#GETFIELD (Type Class) Text (Type Value))
+ (#PUTFIELD (Type Class) Text (Type Value))
+
+ (#INVOKEINTERFACE (Type Class) Text (Type Method))
+ (#INVOKESPECIAL (Type Class) Text (Type Method))
+ (#INVOKESTATIC (Type Class) Text (Type Method))
+ (#INVOKEVIRTUAL (Type Class) Text (Type Method)))
+
+(type: #export Register Nat)
+
+(type: #export Local-Int
+ (#ILOAD Register)
+ (#ISTORE Register))
+
+(type: #export Local-Long
+ (#LLOAD Register)
+ (#LSTORE Register))
+
+(type: #export Local-Float
+ (#FLOAD Register)
+ (#FSTORE Register))
+
+(type: #export Local-Double
+ (#DLOAD Register)
+ (#DSTORE Register))
+
+(type: #export Local-Object
+ (#ALOAD Register)
+ (#ASTORE Register))
+
+(type: #export Local
+ (#Local-Int Local-Int)
+ (#IINC Register)
+ (#Local-Long Local-Long)
+ (#Local-Float Local-Float)
+ (#Local-Double Local-Double)
+ (#Local-Object Local-Object))
+
+(type: #export Stack
+ #DUP
+ #DUP_X1
+ #DUP_X2
+ #DUP2
+ #DUP2_X1
+ #DUP2_X2
+ #SWAP
+ #POP
+ #POP2)
+
+(type: #export Comparison
+ #LCMP
+
+ #FCMPG
+ #FCMPL
+
+ #DCMPG
+ #DCMPL)
+
+(type: #export Label Nat)
+
+(type: #export (Branching label)
+ (#IF_ICMPEQ label)
+ (#IF_ICMPGE label)
+ (#IF_ICMPGT label)
+ (#IF_ICMPLE label)
+ (#IF_ICMPLT label)
+ (#IF_ICMPNE label)
+ (#IFEQ label)
+ (#IFNE label)
+ (#IFGE label)
+ (#IFGT label)
+ (#IFLE label)
+ (#IFLT label)
+
+ (#TABLESWITCH Int Int label (List label))
+ (#LOOKUPSWITCH label (List [Int label]))
+
+ (#IF_ACMPEQ label)
+ (#IF_ACMPNE label)
+ (#IFNONNULL label)
+ (#IFNULL label))
+
+(type: #export (Exception label)
+ (#Try label label label (Type Class))
+ #ATHROW)
+
+(type: #export Concurrency
+ #MONITORENTER
+ #MONITOREXIT)
+
+(type: #export Return
+ #RETURN
+ #IRETURN
+ #LRETURN
+ #FRETURN
+ #DRETURN
+ #ARETURN)
+
+(type: #export (Control label)
+ (#GOTO label)
+ (#Branching (Branching label))
+ (#Exception (Exception label))
+ (#Concurrency Concurrency)
+ (#Return Return))
+
+(type: #export (Instruction label)
+ #NOP
+ (#Constant Constant)
+ (#Arithmetic Arithmetic)
+ (#Bitwise Bitwise)
+ (#Conversion Conversion)
+ (#Array Array)
+ (#Object Object)
+ (#Local Local)
+ (#Stack Stack)
+ (#Comparison Comparison)
+ (#Control (Control label)))
+
+(type: #export (Bytecode label)
+ (Row (Instruction label)))
diff --git a/stdlib/source/lux/tool/compiler/phase/extension/directive/lux.lux b/stdlib/source/lux/tool/compiler/phase/extension/directive/lux.lux
index ccf8c8d96..856648097 100644
--- a/stdlib/source/lux/tool/compiler/phase/extension/directive/lux.lux
+++ b/stdlib/source/lux/tool/compiler/phase/extension/directive/lux.lux
@@ -65,7 +65,7 @@
codeV (////generation.evaluate! (format "evaluate" (%.nat id)) codeT)]
(wrap [code//type codeT codeV]))))
-(def: (evaluate! type codeC)
+(def: #export (evaluate! type codeC)
(All [anchor expression directive]
(-> Type Code (Operation anchor expression directive [Type expression Any])))
(do ////.monad
diff --git a/stdlib/source/spec/compositor/common.lux b/stdlib/source/spec/compositor/common.lux
index 05fbe7fc2..df351c008 100644
--- a/stdlib/source/spec/compositor/common.lux
+++ b/stdlib/source/spec/compositor/common.lux
@@ -8,12 +8,13 @@
[tool
[compiler
["." reference]
+ ["." analysis]
["." synthesis (#+ Synthesis)]
["." directive]
["." phase
["." macro (#+ Expander)]
- ["." generation (#+ Operation Bundle)]
- [extension
+ ["." generation (#+ Operation)]
+ [extension (#+ Extender)
["." bundle]]]
[default
["." platform (#+ Platform)]]]]])
@@ -53,17 +54,20 @@
(phase (synthesis.constant lux-name))))]
(:: host evaluate! "definer" definitionG))))
-(def: #export (executors platform bundle expander program)
+(def: #export (executors target expander platform
+ analysis-bundle generation-bundle directive-bundle
+ program extender)
(All [anchor expression directive]
- (-> (Platform IO anchor expression directive)
- (Bundle anchor expression directive)
- Expander
- (-> expression directive)
+ (-> Text Expander (Platform IO anchor expression directive)
+ analysis.Bundle
+ (generation.Bundle anchor expression directive)
+ (directive.Bundle anchor expression directive)
+ (-> expression directive) Extender
(IO (Try [(directive.State+ anchor expression directive)
Runner
Definer]))))
(do io.monad
- [?state (platform.initialize expander platform bundle program)]
+ [?state (platform.initialize target expander analysis-bundle platform generation-bundle directive-bundle program extender)]
(wrap (do try.monad
[[directive-bundle directive-state] ?state
#let [generation-state (get@ [#directive.generation
diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux
index 7b2d9ffd5..23c33c620 100644
--- a/stdlib/source/test/lux/extension.lux
+++ b/stdlib/source/test/lux/extension.lux
@@ -1,9 +1,11 @@
(.module:
[lux #*
- ["@" target]
+ ["@" target
+ ["." jvm]]
[abstract
[monad (#+ do)]]
[control
+ ["." try]
["<>" parser
["<c>" code]
["<a>" analysis]]]
@@ -20,33 +22,68 @@
["." type]]]]]
["_" test (#+ Test)]]
{1
- ["." / (#+ analysis: synthesis: directive:)]})
+ ["." / (#+ analysis: synthesis: generation: directive:)]})
-(def: my-extension "example YOLO")
+(def: my-analysis "my analysis")
+(def: my-synthesis "my synthesis")
+(def: my-generation "my generation")
+(def: my-directive "my directive")
(`` (for {(~~ (static @.old))
- (as-is)}
- (as-is (analysis: (..my-extension self phase {parameters (<>.some <c>.any)})
+ (as-is)
+
+ (~~ (static @.jvm))
+ (as-is (generation: (..my-generation self phase {parameters (<>.some <a>.any)})
+ (#try.Success (#jvm.Constant (#jvm.LDC (#jvm.String Text))))))}
+ (as-is (analysis: (..my-analysis self phase {parameters (<>.some <c>.any)})
+ (do @
+ [_ (type.infer .Text)]
+ (wrap (#analysis.Text self))))
+
+ ## Synthesis
+ (analysis: (..my-synthesis self phase {parameters (<>.some <c>.any)})
(do @
[_ (type.infer .Text)]
(wrap (#analysis.Extension self (list)))))
- (synthesis: (..my-extension self phase {parameters (<>.some <a>.any)})
+ (synthesis: (..my-synthesis self phase {parameters (<>.some <a>.any)})
(wrap (synthesis.text self)))
+
+ ## Generation
+ (analysis: (..my-generation self phase {parameters (<>.some <c>.any)})
+ (do @
+ [_ (type.infer .Text)]
+ (wrap (#analysis.Extension self (list)))))
+
+ (synthesis: (..my-generation self phase {parameters (<>.some <a>.any)})
+ (wrap (#synthesis.Extension self (list))))
- (directive: (..my-extension self phase {parameters (<>.some <c>.any)})
+ ## Directive
+ (directive: (..my-directive self phase {parameters (<>.some <c>.any)})
(do @
- [#let [_ (log! (format "directive: " (%.text self)))]]
+ [#let [_ (log! (format "Successfully installed directive " (%.text self) "!"))]]
(wrap directive.no-requirements)))
- ("example YOLO")
+ (`` ((~~ (static ..my-directive))))
)))
(def: #export test
Test
(<| (_.context (%.name (name-of /._)))
- (_.test "Can define and use analysis & synthesis extensions."
- (`` (for {(~~ (static @.old))
- false}
- (text@= ("example YOLO")
- "example YOLO"))))))
+ ($_ _.and
+ (_.test "Can define and use analysis extensions."
+ (`` (for {(~~ (static @.old))
+ false}
+ (text@= ((~~ (static ..my-analysis)))
+ ..my-analysis))))
+ (_.test "Can define and use synthesis extensions."
+ (`` (for {(~~ (static @.old))
+ false}
+ (text@= ((~~ (static ..my-synthesis)))
+ ..my-synthesis))))
+ (_.test "Can define and use generation extensions."
+ (`` (for {(~~ (static @.old))
+ false}
+ (text@= ((~~ (static ..my-generation)))
+ ..my-generation))))
+ )))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 09:43:03 +0000