diff options
Diffstat (limited to 'lux-jvm/source/luxc/lang/host')
| -rw-r--r-- | lux-jvm/source/luxc/lang/host/jvm.lux | 150 | ||||
| -rw-r--r-- | lux-jvm/source/luxc/lang/host/jvm/def.lux | 306 | ||||
| -rw-r--r-- | lux-jvm/source/luxc/lang/host/jvm/inst.lux | 472 |
3 files changed, 0 insertions, 928 deletions
diff --git a/lux-jvm/source/luxc/lang/host/jvm.lux b/lux-jvm/source/luxc/lang/host/jvm.lux deleted file mode 100644 index 22d901d51..000000000 --- a/lux-jvm/source/luxc/lang/host/jvm.lux +++ /dev/null @@ -1,150 +0,0 @@ -(.using - [library - [lux {"-" Definition Type Label} - [ffi {"+" import:}] - [abstract - monad] - [control - ["<>" parser - ["<[0]>" code]]] - [data - [binary {"+" Binary}] - [text - ["%" format {"+" format}]] - [collection - ["[0]" list ("[1]#[0]" monad)]]] - [macro - ["[0]" code] - [syntax {"+" syntax:}]] - [target - [jvm - ["[0]" type {"+" Type} - [category {"+" Class}]]]] - [tool - [compiler - [reference - [variable {"+" Register}]] - [language - [lux - ["[0]" generation]]] - [meta - [archive {"+" Archive}]]]]]]) - -(import: org/objectweb/asm/MethodVisitor - "[1]::[0]") - -(import: org/objectweb/asm/ClassWriter - "[1]::[0]") - -(import: org/objectweb/asm/Label - "[1]::[0]" - (new [])) - -(type: .public Def - (-> org/objectweb/asm/ClassWriter org/objectweb/asm/ClassWriter)) - -(type: .public Inst - (-> org/objectweb/asm/MethodVisitor org/objectweb/asm/MethodVisitor)) - -(type: .public Label - org/objectweb/asm/Label) - -(type: .public Visibility - (Variant - {#Public} - {#Protected} - {#Private} - {#Default})) - -(type: .public Version - (Variant - {#V1_1} - {#V1_2} - {#V1_3} - {#V1_4} - {#V1_5} - {#V1_6} - {#V1_7} - {#V1_8})) - -(type: .public ByteCode - Binary) - -(type: .public Definition - [Text ByteCode]) - -(type: .public Anchor - [Label Register]) - -(type: .public Host - (generation.Host Inst Definition)) - -(template [<name> <base>] - [(type: .public <name> - (<base> ..Anchor ..Inst ..Definition))] - - [State generation.State] - [Operation generation.Operation] - [Phase generation.Phase] - [Handler generation.Handler] - [Bundle generation.Bundle] - [Extender generation.Extender] - ) - -(type: .public (Generator i) - (-> Phase Archive i (Operation Inst))) - -(syntax: (config: [type <code>.local - none <code>.local - ++ <code>.local - options (<code>.tuple (<>.many <code>.local))]) - (let [g!type (code.local type) - g!none (code.local none) - g!tags+ (list#each (|>> (format "#") code.local) options) - g!_left (code.local "_left") - g!_right (code.local "_right") - g!options+ (list#each (function (_ option) - (` (def: .public (~ (code.local option)) - (~ g!type) - (|> (~ g!none) - (has (~ (code.local (format "#" option))) #1))))) - options)] - (in (list& (` (type: .public (~ g!type) - (.Record - (~ (|> g!tags+ - (list#each (function (_ tag) - (list tag (` .Bit)))) - list#conjoint - code.tuple))))) - - (` (def: .public (~ g!none) - (~ g!type) - (~ (|> g!tags+ - (list#each (function (_ tag) - (list tag (` #0)))) - list#conjoint - code.tuple)))) - - (` (def: .public ((~ (code.local ++)) (~ g!_left) (~ g!_right)) - (-> (~ g!type) (~ g!type) (~ g!type)) - (~ (|> g!tags+ - (list#each (function (_ tag) - (list tag (` (or (the (~ tag) (~ g!_left)) - (the (~ tag) (~ g!_right))))))) - list#conjoint - code.tuple)))) - - g!options+)))) - -(config: Class_Config noneC ++C [finalC]) -(config: Method_Config noneM ++M [finalM staticM synchronizedM strictM]) -(config: Field_Config noneF ++F [finalF staticF transientF volatileF]) - -(def: .public new_label - (-> Any Label) - (function (_ _) - (org/objectweb/asm/Label::new))) - -(def: .public (simple_class name) - (-> Text (Type Class)) - (type.class name (list))) diff --git a/lux-jvm/source/luxc/lang/host/jvm/def.lux b/lux-jvm/source/luxc/lang/host/jvm/def.lux deleted file mode 100644 index fd79d2119..000000000 --- a/lux-jvm/source/luxc/lang/host/jvm/def.lux +++ /dev/null @@ -1,306 +0,0 @@ -(.using - [library - [lux {"-" Type} - ["[0]" ffi {"+" import: do_to}] - [control - ["[0]" function]] - [data - ["[0]" product] - ["[0]" text - ["%" format {"+" format}]] - [collection - ["[0]" array {"+" Array}] - ["[0]" list ("[1]@[0]" functor)]]] - [math - [number - ["i" int]]] - [target - [jvm - [encoding - ["[0]" name]] - ["[0]" type {"+" Type Constraint} - [category {"+" Class Value Method}] - ["[0]" signature] - ["[0]" descriptor]]]]]] - ["[0]" //]) - -(def: signature (|>> type.signature signature.signature)) -(def: descriptor (|>> type.descriptor descriptor.descriptor)) -(def: class_name (|>> type.descriptor descriptor.class_name name.read)) - -(import: java/lang/Object - "[1]::[0]") - -(import: java/lang/String - "[1]::[0]") - -(import: org/objectweb/asm/Opcodes - "[1]::[0]" - ("static" ACC_PUBLIC int) - ("static" ACC_PROTECTED int) - ("static" ACC_PRIVATE int) - - ("static" ACC_TRANSIENT int) - ("static" ACC_VOLATILE int) - - ("static" ACC_ABSTRACT int) - ("static" ACC_FINAL int) - ("static" ACC_STATIC int) - ("static" ACC_SYNCHRONIZED int) - ("static" ACC_STRICT int) - - ("static" ACC_SUPER int) - ("static" ACC_INTERFACE int) - - ("static" V1_1 int) - ("static" V1_2 int) - ("static" V1_3 int) - ("static" V1_4 int) - ("static" V1_5 int) - ("static" V1_6 int) - ("static" V1_7 int) - ("static" V1_8 int)) - -(import: org/objectweb/asm/FieldVisitor - "[1]::[0]" - (visitEnd [] void)) - -(import: org/objectweb/asm/MethodVisitor - "[1]::[0]" - (visitCode [] void) - (visitMaxs [int int] void) - (visitEnd [] void)) - -(import: org/objectweb/asm/ClassWriter - "[1]::[0]" - ("static" COMPUTE_MAXS int) - ("static" COMPUTE_FRAMES int) - (new [int]) - (visit [int int java/lang/String java/lang/String java/lang/String [java/lang/String]] void) - (visitEnd [] void) - (visitField [int java/lang/String java/lang/String java/lang/String java/lang/Object] org/objectweb/asm/FieldVisitor) - (visitMethod [int java/lang/String java/lang/String java/lang/String [java/lang/String]] org/objectweb/asm/MethodVisitor) - (toByteArray [] [byte])) - -(def: (string_array values) - (-> (List Text) (Array Text)) - (let [output (ffi.array java/lang/String (list.size values))] - (exec (list@each (function (_ [idx value]) - (ffi.write! idx value output)) - (list.enumeration values)) - output))) - -(def: (version_flag version) - (-> //.Version Int) - (case version - {//.#V1_1} (org/objectweb/asm/Opcodes::V1_1) - {//.#V1_2} (org/objectweb/asm/Opcodes::V1_2) - {//.#V1_3} (org/objectweb/asm/Opcodes::V1_3) - {//.#V1_4} (org/objectweb/asm/Opcodes::V1_4) - {//.#V1_5} (org/objectweb/asm/Opcodes::V1_5) - {//.#V1_6} (org/objectweb/asm/Opcodes::V1_6) - {//.#V1_7} (org/objectweb/asm/Opcodes::V1_7) - {//.#V1_8} (org/objectweb/asm/Opcodes::V1_8))) - -(def: (visibility_flag visibility) - (-> //.Visibility Int) - (case visibility - {//.#Public} (org/objectweb/asm/Opcodes::ACC_PUBLIC) - {//.#Protected} (org/objectweb/asm/Opcodes::ACC_PROTECTED) - {//.#Private} (org/objectweb/asm/Opcodes::ACC_PRIVATE) - {//.#Default} +0)) - -(def: (class_flags config) - (-> //.Class_Config Int) - ($_ i.+ - (if (the //.#finalC config) (org/objectweb/asm/Opcodes::ACC_FINAL) +0))) - -(def: (method_flags config) - (-> //.Method_Config Int) - ($_ i.+ - (if (the //.#staticM config) (org/objectweb/asm/Opcodes::ACC_STATIC) +0) - (if (the //.#finalM config) (org/objectweb/asm/Opcodes::ACC_FINAL) +0) - (if (the //.#synchronizedM config) (org/objectweb/asm/Opcodes::ACC_SYNCHRONIZED) +0) - (if (the //.#strictM config) (org/objectweb/asm/Opcodes::ACC_STRICT) +0))) - -(def: (field_flags config) - (-> //.Field_Config Int) - ($_ i.+ - (if (the //.#staticF config) (org/objectweb/asm/Opcodes::ACC_STATIC) +0) - (if (the //.#finalF config) (org/objectweb/asm/Opcodes::ACC_FINAL) +0) - (if (the //.#transientF config) (org/objectweb/asm/Opcodes::ACC_TRANSIENT) +0) - (if (the //.#volatileF config) (org/objectweb/asm/Opcodes::ACC_VOLATILE) +0))) - -(def: param_signature - (-> (Type Class) Text) - (|>> ..signature (format ":"))) - -(def: (formal_param [name super interfaces]) - (-> Constraint Text) - (format name - (param_signature super) - (|> interfaces - (list@each param_signature) - (text.interposed "")))) - -(def: (constraints_signature constraints super interfaces) - (-> (List Constraint) (Type Class) (List (Type Class)) - Text) - (let [formal_params (if (list.empty? constraints) - "" - (format "<" - (|> constraints - (list@each formal_param) - (text.interposed "")) - ">"))] - (format formal_params - (..signature super) - (|> interfaces - (list@each ..signature) - (text.interposed ""))))) - -(def: class_computes - Int - ($_ i.+ - (org/objectweb/asm/ClassWriter::COMPUTE_MAXS) - ... (org/objectweb/asm/ClassWriter::COMPUTE_FRAMES) - )) - -(def: binary_name (|>> name.internal name.read)) - -(template [<name> <flag>] - [(def: .public (<name> version visibility config name constraints super interfaces - definitions) - (-> //.Version //.Visibility //.Class_Config Text (List Constraint) (Type Class) (List (Type Class)) //.Def - (ffi.type [byte])) - (let [writer (|> (do_to (org/objectweb/asm/ClassWriter::new class_computes) - (org/objectweb/asm/ClassWriter::visit (version_flag version) - ($_ i.+ - (org/objectweb/asm/Opcodes::ACC_SUPER) - <flag> - (visibility_flag visibility) - (class_flags config)) - (..binary_name name) - (constraints_signature constraints super interfaces) - (..class_name super) - (|> interfaces - (list@each ..class_name) - string_array))) - definitions) - _ (org/objectweb/asm/ClassWriter::visitEnd writer)] - (org/objectweb/asm/ClassWriter::toByteArray writer)))] - - [class +0] - [abstract (org/objectweb/asm/Opcodes::ACC_ABSTRACT)] - ) - -(def: $Object - (Type Class) - (type.class "java.lang.Object" (list))) - -(def: .public (interface version visibility config name constraints interfaces - definitions) - (-> //.Version //.Visibility //.Class_Config Text (List Constraint) (List (Type Class)) //.Def - (ffi.type [byte])) - (let [writer (|> (do_to (org/objectweb/asm/ClassWriter::new class_computes) - (org/objectweb/asm/ClassWriter::visit (version_flag version) - ($_ i.+ - (org/objectweb/asm/Opcodes::ACC_ABSTRACT) - (org/objectweb/asm/Opcodes::ACC_INTERFACE) - (visibility_flag visibility) - (class_flags config)) - (..binary_name name) - (constraints_signature constraints $Object interfaces) - (..class_name $Object) - (|> interfaces - (list@each ..class_name) - string_array))) - definitions) - _ (org/objectweb/asm/ClassWriter::visitEnd writer)] - (org/objectweb/asm/ClassWriter::toByteArray writer))) - -(def: .public (method visibility config name type then) - (-> //.Visibility //.Method_Config Text (Type Method) //.Inst - //.Def) - (function (_ writer) - (let [=method (org/objectweb/asm/ClassWriter::visitMethod ($_ i.+ - (visibility_flag visibility) - (method_flags config)) - (..binary_name name) - (..descriptor type) - (..signature type) - (string_array (list)) - writer) - _ (org/objectweb/asm/MethodVisitor::visitCode =method) - _ (then =method) - _ (org/objectweb/asm/MethodVisitor::visitMaxs +0 +0 =method) - _ (org/objectweb/asm/MethodVisitor::visitEnd =method)] - writer))) - -(def: .public (abstract_method visibility config name type) - (-> //.Visibility //.Method_Config Text (Type Method) - //.Def) - (function (_ writer) - (let [=method (org/objectweb/asm/ClassWriter::visitMethod ($_ i.+ - (visibility_flag visibility) - (method_flags config) - (org/objectweb/asm/Opcodes::ACC_ABSTRACT)) - (..binary_name name) - (..descriptor type) - (..signature type) - (string_array (list)) - writer) - _ (org/objectweb/asm/MethodVisitor::visitEnd =method)] - writer))) - -(def: .public (field visibility config name type) - (-> //.Visibility //.Field_Config Text (Type Value) //.Def) - (function (_ writer) - (let [=field (do_to (org/objectweb/asm/ClassWriter::visitField ($_ i.+ - (visibility_flag visibility) - (field_flags config)) - (..binary_name name) - (..descriptor type) - (..signature type) - (ffi.null) - writer) - (org/objectweb/asm/FieldVisitor::visitEnd))] - writer))) - -(template [<name> <lux_type> <jvm_type> <prepare>] - [(def: .public (<name> visibility config name value) - (-> //.Visibility //.Field_Config Text <lux_type> //.Def) - (function (_ writer) - (let [=field (do_to (org/objectweb/asm/ClassWriter::visitField ($_ i.+ - (visibility_flag visibility) - (field_flags config)) - (..binary_name name) - (..descriptor <jvm_type>) - (..signature <jvm_type>) - (<prepare> value) - writer) - (org/objectweb/asm/FieldVisitor::visitEnd))] - writer)))] - - [boolean_field Bit type.boolean function.identity] - [byte_field Int type.byte ffi.long_to_byte] - [short_field Int type.short ffi.long_to_short] - [int_field Int type.int ffi.long_to_int] - [long_field Int type.long function.identity] - [float_field Frac type.float ffi.double_to_float] - [double_field Frac type.double function.identity] - [char_field Nat type.char (|>> .int ffi.long_to_int ffi.int_to_char)] - [string_field Text (type.class "java.lang.String" (list)) function.identity] - ) - -(def: .public (fuse defs) - (-> (List //.Def) //.Def) - (case defs - {.#End} - function.identity - - {.#Item singleton {.#End}} - singleton - - {.#Item head tail} - (function.composite (fuse tail) head))) diff --git a/lux-jvm/source/luxc/lang/host/jvm/inst.lux b/lux-jvm/source/luxc/lang/host/jvm/inst.lux deleted file mode 100644 index 77acf5b35..000000000 --- a/lux-jvm/source/luxc/lang/host/jvm/inst.lux +++ /dev/null @@ -1,472 +0,0 @@ -(.using - [library - [lux {"-" Type Primitive int char try} - ["[0]" ffi {"+" import: do_to}] - [abstract - [monad {"+" do}]] - [control - ["[0]" function] - ["[0]" maybe] - ["[0]" try] - ["p" parser - ["s" code]]] - [data - ["[0]" product] - [collection - ["[0]" list ("[1]@[0]" functor)]]] - [macro - [syntax {"+" syntax:}] - ["[0]" code] - ["[0]" template]] - [math - [number - ["n" nat] - ["i" int]]] - [target - [jvm - [encoding - ["[0]" name {"+" External}]] - ["[0]" type {"+" Type} ("[1]@[0]" equivalence) - [category {"+" Void Value Return Method Primitive Object Class Array Var Parameter}] - ["[0]" box] - ["[0]" descriptor] - ["[0]" reflection]]]] - [tool - [compiler - [phase {"+" Operation}]]]]] - ["[0]" // {"+" Inst}]) - -(def: class_name (|>> type.descriptor descriptor.class_name name.read)) -(def: descriptor (|>> type.descriptor descriptor.descriptor)) -(def: reflection (|>> type.reflection reflection.reflection)) - -... [Host] -(import: java/lang/Object - "[1]::[0]") - -(import: java/lang/String - "[1]::[0]") - -(syntax: (declare [codes (p.many s.local)]) - (|> codes - (list@each (function (_ code) (` ((~' "static") (~ (code.local code)) (~' int))))) - in)) - -(`` (import: org/objectweb/asm/Opcodes - "[1]::[0]" - ("static" NOP int) - - ... 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)) - - ... Class - (~~ (declare CHECKCAST NEW INSTANCEOF)) - - ... Stack - (~~ (declare DUP DUP_X1 DUP_X2 - DUP2 DUP2_X1 DUP2_X2 - POP POP2 - SWAP)) - - ... Jump - (~~ (declare IF_ICMPEQ IF_ICMPGT IF_ICMPLT - IF_ICMPNE IF_ICMPGE IF_ICMPLE - 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 IINC - ILOAD LLOAD FLOAD DLOAD ALOAD - ISTORE LSTORE FSTORE DSTORE ASTORE)) - - ... Arithmetic - (~~ (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 - LAND LOR LXOR LSHL LSHR LUSHR)) - - ... Array - (~~ (declare ARRAYLENGTH NEWARRAY ANEWARRAY - AALOAD AASTORE - BALOAD BASTORE - SALOAD SASTORE - IALOAD IASTORE - LALOAD LASTORE - FALOAD FASTORE - DALOAD DASTORE - CALOAD CASTORE)) - - ... Member - (~~ (declare GETSTATIC PUTSTATIC GETFIELD PUTFIELD - INVOKESTATIC INVOKESPECIAL INVOKEVIRTUAL INVOKEINTERFACE)) - - ("static" ATHROW int) - - ... Concurrency - (~~ (declare MONITORENTER MONITOREXIT)) - - ... Return - (~~ (declare RETURN IRETURN LRETURN FRETURN DRETURN ARETURN)) - )) - -(import: org/objectweb/asm/Label - "[1]::[0]" - (new [])) - -(import: org/objectweb/asm/MethodVisitor - "[1]::[0]" - (visitCode [] void) - (visitMaxs [int int] void) - (visitEnd [] void) - (visitInsn [int] void) - (visitLdcInsn [java/lang/Object] void) - (visitFieldInsn [int java/lang/String java/lang/String java/lang/String] void) - (visitTypeInsn [int java/lang/String] void) - (visitVarInsn [int int] void) - (visitIntInsn [int int] void) - (visitMethodInsn [int java/lang/String java/lang/String java/lang/String boolean] void) - (visitLabel [org/objectweb/asm/Label] void) - (visitJumpInsn [int org/objectweb/asm/Label] void) - (visitTryCatchBlock [org/objectweb/asm/Label org/objectweb/asm/Label org/objectweb/asm/Label java/lang/String] void) - (visitLookupSwitchInsn [org/objectweb/asm/Label [int] [org/objectweb/asm/Label]] void) - (visitTableSwitchInsn [int int org/objectweb/asm/Label [org/objectweb/asm/Label]] void) - ) - -... [Insts] -(def: .public make_label - (All (_ s) (Operation s org/objectweb/asm/Label)) - (function (_ state) - {try.#Success [state (org/objectweb/asm/Label::new)]})) - -(def: .public (with_label action) - (All (_ a) (-> (-> org/objectweb/asm/Label a) a)) - (action (org/objectweb/asm/Label::new))) - -(template [<name> <type> <prepare>] - [(def: .public (<name> value) - (-> <type> Inst) - (function (_ visitor) - (do_to visitor - (org/objectweb/asm/MethodVisitor::visitLdcInsn (<prepare> value)))))] - - [boolean Bit function.identity] - [int Int ffi.long_to_int] - [long Int function.identity] - [double Frac function.identity] - [char Nat (|>> .int ffi.long_to_int ffi.int_to_char)] - [string Text function.identity] - ) - -(template: (!prefix short) - [(`` ((~~ (template.symbol ["org/objectweb/asm/Opcodes::" short]))))]) - -(template [<constant>] - [(def: .public <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: .public NULL - Inst - (function (_ visitor) - (do_to visitor - (org/objectweb/asm/MethodVisitor::visitInsn (!prefix ACONST_NULL))))) - -(template [<constant>] - [(def: .public (<constant> constant) - (-> Int Inst) - (function (_ visitor) - (do_to visitor - (org/objectweb/asm/MethodVisitor::visitIntInsn (!prefix <constant>) constant))))] - - [BIPUSH] - [SIPUSH] - ) - -(template [<name>] - [(def: .public <name> - Inst - (function (_ visitor) - (do_to visitor - (org/objectweb/asm/MethodVisitor::visitInsn (!prefix <name>)))))] - - [NOP] - - ... Stack - [DUP] [DUP_X1] [DUP_X2] [DUP2] [DUP2_X1] [DUP2_X2] - [POP] [POP2] - [SWAP] - - ... Conversions - [D2F] [D2I] [D2L] - [F2D] [F2I] [F2L] - [I2B] [I2C] [I2D] [I2F] [I2L] [I2S] - [L2D] [L2F] [L2I] - - ... Integer arithmetic - [IADD] [ISUB] [IMUL] [IDIV] [IREM] [INEG] - - ... Integer bitwise - [IAND] [IOR] [IXOR] [ISHL] [ISHR] [IUSHR] - - ... Long arithmetic - [LADD] [LSUB] [LMUL] [LDIV] [LREM] [LNEG] - [LCMP] - - ... Long bitwise - [LAND] [LOR] [LXOR] [LSHL] [LSHR] [LUSHR] - - ... Float arithmetic - [FADD] [FSUB] [FMUL] [FDIV] [FREM] [FNEG] [FCMPG] [FCMPL] - - ... Double arithmetic - [DADD] [DSUB] [DMUL] [DDIV] [DREM] [DNEG] - [DCMPG] [DCMPL] - - ... Array - [ARRAYLENGTH] - [AALOAD] [AASTORE] - [BALOAD] [BASTORE] - [SALOAD] [SASTORE] - [IALOAD] [IASTORE] - [LALOAD] [LASTORE] - [FALOAD] [FASTORE] - [DALOAD] [DASTORE] - [CALOAD] [CASTORE] - - ... Exceptions - [ATHROW] - - ... Concurrency - [MONITORENTER] [MONITOREXIT] - - ... Return - [RETURN] [IRETURN] [LRETURN] [FRETURN] [DRETURN] [ARETURN] - ) - -(type: .public Register Nat) - -(template [<name>] - [(def: .public (<name> register) - (-> Register Inst) - (function (_ visitor) - (do_to visitor - (org/objectweb/asm/MethodVisitor::visitVarInsn (!prefix <name>) (.int register)))))] - - [IINC] - [ILOAD] [LLOAD] [FLOAD] [DLOAD] [ALOAD] - [ISTORE] [LSTORE] [FSTORE] [DSTORE] [ASTORE] - ) - -(template [<name> <inst>] - [(def: .public (<name> class field type) - (-> (Type Class) Text (Type Value) Inst) - (function (_ visitor) - (do_to visitor - (org/objectweb/asm/MethodVisitor::visitFieldInsn (<inst>) (..class_name class) field (..descriptor type)))))] - - [GETSTATIC org/objectweb/asm/Opcodes::GETSTATIC] - [PUTSTATIC org/objectweb/asm/Opcodes::PUTSTATIC] - - [PUTFIELD org/objectweb/asm/Opcodes::PUTFIELD] - [GETFIELD org/objectweb/asm/Opcodes::GETFIELD] - ) - -(template [<category> <instructions>+] - [(`` (template [<name> <inst>] - [(def: .public (<name> class) - (-> (Type <category>) Inst) - (function (_ visitor) - (do_to visitor - (org/objectweb/asm/MethodVisitor::visitTypeInsn (<inst>) (..class_name class)))))] - - (~~ (template.spliced <instructions>+))))] - - [Object - [[CHECKCAST org/objectweb/asm/Opcodes::CHECKCAST] - [ANEWARRAY org/objectweb/asm/Opcodes::ANEWARRAY]]] - - [Class - [[NEW org/objectweb/asm/Opcodes::NEW] - [INSTANCEOF org/objectweb/asm/Opcodes::INSTANCEOF]]] - ) - -(def: .public (NEWARRAY type) - (-> (Type Primitive) Inst) - (function (_ visitor) - (do_to visitor - (org/objectweb/asm/MethodVisitor::visitIntInsn (org/objectweb/asm/Opcodes::NEWARRAY) - (`` (cond (~~ (template [<descriptor> <opcode>] - [(type@= <descriptor> type) (<opcode>)] - - [type.boolean org/objectweb/asm/Opcodes::T_BOOLEAN] - [type.byte org/objectweb/asm/Opcodes::T_BYTE] - [type.short org/objectweb/asm/Opcodes::T_SHORT] - [type.int org/objectweb/asm/Opcodes::T_INT] - [type.long org/objectweb/asm/Opcodes::T_LONG] - [type.float org/objectweb/asm/Opcodes::T_FLOAT] - [type.double org/objectweb/asm/Opcodes::T_DOUBLE] - [type.char org/objectweb/asm/Opcodes::T_CHAR])) - ... else - (undefined))))))) - -(template [<name> <inst> <interface?>] - [(def: .public (<name> class method_name method) - (-> (Type Class) Text (Type Method) Inst) - (function (_ visitor) - (do_to visitor - (org/objectweb/asm/MethodVisitor::visitMethodInsn (<inst>) - (..class_name class) - method_name - (|> method type.descriptor descriptor.descriptor) - <interface?>))))] - - [INVOKESTATIC org/objectweb/asm/Opcodes::INVOKESTATIC false] - [INVOKEVIRTUAL org/objectweb/asm/Opcodes::INVOKEVIRTUAL false] - [INVOKESPECIAL org/objectweb/asm/Opcodes::INVOKESPECIAL false] - [INVOKEINTERFACE org/objectweb/asm/Opcodes::INVOKEINTERFACE true] - ) - -(template [<name>] - [(def: .public (<name> @where) - (-> //.Label Inst) - (function (_ visitor) - (do_to visitor - (org/objectweb/asm/MethodVisitor::visitJumpInsn (!prefix <name>) @where))))] - - [IF_ICMPEQ] [IF_ICMPGT] [IF_ICMPLT] - [IF_ICMPNE] [IF_ICMPGE] [IF_ICMPLE] - [IF_ACMPEQ] [IF_ACMPNE] [IFNULL] [IFNONNULL] - [IFEQ] [IFNE] [IFLT] [IFLE] [IFGT] [IFGE] - [GOTO] - ) - -(def: .public (LOOKUPSWITCH default keys+labels) - (-> //.Label (List [Int //.Label]) Inst) - (function (_ visitor) - (let [keys+labels (list.sorted (function (_ left right) - (i.< (product.left left) (product.left right))) - keys+labels) - array_size (list.size keys+labels) - keys_array (ffi.array int array_size) - labels_array (ffi.array org/objectweb/asm/Label array_size) - _ (loop (again [idx 0]) - (if (n.< array_size idx) - (let [[key label] (maybe.trusted (list.item idx keys+labels))] - (exec - (ffi.write! idx (ffi.long_to_int key) keys_array) - (ffi.write! idx label labels_array) - (again (++ idx)))) - []))] - (do_to visitor - (org/objectweb/asm/MethodVisitor::visitLookupSwitchInsn default keys_array labels_array))))) - -(def: .public (TABLESWITCH min max default labels) - (-> Int Int //.Label (List //.Label) Inst) - (function (_ visitor) - (let [num_labels (list.size labels) - labels_array (ffi.array org/objectweb/asm/Label num_labels) - _ (loop (again [idx 0]) - (if (n.< num_labels idx) - (exec (ffi.write! idx - (maybe.trusted (list.item idx labels)) - labels_array) - (again (++ idx))) - []))] - (do_to visitor - (org/objectweb/asm/MethodVisitor::visitTableSwitchInsn min max default labels_array))))) - -(def: .public (try @from @to @handler exception) - (-> //.Label //.Label //.Label (Type Class) Inst) - (function (_ visitor) - (do_to visitor - (org/objectweb/asm/MethodVisitor::visitTryCatchBlock @from @to @handler (..class_name exception))))) - -(def: .public (label @label) - (-> //.Label Inst) - (function (_ visitor) - (do_to visitor - (org/objectweb/asm/MethodVisitor::visitLabel @label)))) - -(def: .public (array elementT) - (-> (Type Value) Inst) - (case (type.primitive? elementT) - {.#Left elementT} - (ANEWARRAY elementT) - - {.#Right elementT} - (NEWARRAY elementT))) - -(template [<name> <boolean> <byte> <short> <int> <long> <float> <double> <char>] - [(def: (<name> type) - (-> (Type Primitive) Text) - (`` (cond (~~ (template [<descriptor> <output>] - [(type@= <descriptor> type) <output>] - - [type.boolean <boolean>] - [type.byte <byte>] - [type.short <short>] - [type.int <int>] - [type.long <long>] - [type.float <float>] - [type.double <double>] - [type.char <char>])) - ... else - (undefined))))] - - [primitive_wrapper - box.boolean box.byte box.short box.int - box.long box.float box.double box.char] - [primitive_unwrap - "booleanValue" "byteValue" "shortValue" "intValue" - "longValue" "floatValue" "doubleValue" "charValue"] - ) - -(def: .public (wrap type) - (-> (Type Primitive) Inst) - (let [wrapper (type.class (primitive_wrapper type) (list))] - (INVOKESTATIC wrapper "valueOf" (type.method [(list) (list type) wrapper (list)])))) - -(def: .public (unwrap type) - (-> (Type Primitive) Inst) - (let [wrapper (type.class (primitive_wrapper type) (list))] - (|>> (CHECKCAST wrapper) - (INVOKEVIRTUAL wrapper (primitive_unwrap type) (type.method [(list) (list) type (list)]))))) - -(def: .public (fuse insts) - (-> (List Inst) Inst) - (case insts - {.#End} - function.identity - - {.#Item singleton {.#End}} - singleton - - {.#Item head tail} - (function.composite (fuse tail) head))) |