From b4d0eba7485caf0c6cf58de1193a9114fa273d8b Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 30 May 2020 15:19:28 -0400 Subject: Split new-luxc into lux-jvm and lux-r. --- lux-jvm/source/luxc/lang/host/jvm/def.lux | 298 ++++++++++++++++++ lux-jvm/source/luxc/lang/host/jvm/inst.lux | 464 +++++++++++++++++++++++++++++ 2 files changed, 762 insertions(+) create mode 100644 lux-jvm/source/luxc/lang/host/jvm/def.lux create mode 100644 lux-jvm/source/luxc/lang/host/jvm/inst.lux (limited to 'lux-jvm/source/luxc/lang/host/jvm') diff --git a/lux-jvm/source/luxc/lang/host/jvm/def.lux b/lux-jvm/source/luxc/lang/host/jvm/def.lux new file mode 100644 index 000000000..f274da61f --- /dev/null +++ b/lux-jvm/source/luxc/lang/host/jvm/def.lux @@ -0,0 +1,298 @@ +(.module: + [lux (#- Type) + ["." host (#+ import: do-to)] + [control + ["." function]] + [data + ["." product] + [number + ["i" int]] + ["." text + ["%" format (#+ format)]] + [collection + ["." array (#+ Array)] + ["." list ("#@." functor)]]] + [target + [jvm + [encoding + ["." name]] + ["." type (#+ Type Constraint) + [category (#+ Class Value Method)] + ["." signature] + ["." descriptor]]]]] + ["." //]) + +(def: signature (|>> type.signature signature.signature)) +(def: descriptor (|>> type.descriptor descriptor.descriptor)) +(def: class-name (|>> type.descriptor descriptor.class-name name.read)) + +(import: #long java/lang/Object) +(import: #long java/lang/String) + +(import: org/objectweb/asm/Opcodes + (#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 + (visitEnd [] void)) + +(import: org/objectweb/asm/MethodVisitor + (visitCode [] void) + (visitMaxs [int int] void) + (visitEnd [] void)) + +(import: org/objectweb/asm/ClassWriter + (#static COMPUTE_MAXS int) + (#static COMPUTE_FRAMES int) + (new [int]) + (visit [int int String String String [String]] void) + (visitEnd [] void) + (visitField [int String String String Object] FieldVisitor) + (visitMethod [int String String String [String]] MethodVisitor) + (toByteArray [] [byte])) + +(def: (string-array values) + (-> (List Text) (Array Text)) + (let [output (host.array String (list.size values))] + (exec (list@map (function (_ [idx value]) + (host.array-write idx value output)) + (list.enumerate values)) + output))) + +(def: (version-flag version) + (-> //.Version Int) + (case version + #//.V1_1 (Opcodes::V1_1) + #//.V1_2 (Opcodes::V1_2) + #//.V1_3 (Opcodes::V1_3) + #//.V1_4 (Opcodes::V1_4) + #//.V1_5 (Opcodes::V1_5) + #//.V1_6 (Opcodes::V1_6) + #//.V1_7 (Opcodes::V1_7) + #//.V1_8 (Opcodes::V1_8))) + +(def: (visibility-flag visibility) + (-> //.Visibility Int) + (case visibility + #//.Public (Opcodes::ACC_PUBLIC) + #//.Protected (Opcodes::ACC_PROTECTED) + #//.Private (Opcodes::ACC_PRIVATE) + #//.Default +0)) + +(def: (class-flags config) + (-> //.Class-Config Int) + ($_ i.+ + (if (get@ #//.finalC config) (Opcodes::ACC_FINAL) +0))) + +(def: (method-flags config) + (-> //.Method-Config Int) + ($_ i.+ + (if (get@ #//.staticM config) (Opcodes::ACC_STATIC) +0) + (if (get@ #//.finalM config) (Opcodes::ACC_FINAL) +0) + (if (get@ #//.synchronizedM config) (Opcodes::ACC_SYNCHRONIZED) +0) + (if (get@ #//.strictM config) (Opcodes::ACC_STRICT) +0))) + +(def: (field-flags config) + (-> //.Field-Config Int) + ($_ i.+ + (if (get@ #//.staticF config) (Opcodes::ACC_STATIC) +0) + (if (get@ #//.finalF config) (Opcodes::ACC_FINAL) +0) + (if (get@ #//.transientF config) (Opcodes::ACC_TRANSIENT) +0) + (if (get@ #//.volatileF config) (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@map param-signature) + (text.join-with "")))) + +(def: (constraints-signature constraints super interfaces) + (-> (List Constraint) (Type Class) (List (Type Class)) + Text) + (let [formal-params (if (list.empty? constraints) + "" + (format "<" + (|> constraints + (list@map formal-param) + (text.join-with "")) + ">"))] + (format formal-params + (..signature super) + (|> interfaces + (list@map ..signature) + (text.join-with ""))))) + +(def: class-computes + Int + ($_ i.+ + (ClassWriter::COMPUTE_MAXS) + ## (ClassWriter::COMPUTE_FRAMES) + )) + +(def: binary-name (|>> name.internal name.read)) + +(template [ ] + [(def: #export ( version visibility config name constraints super interfaces + definitions) + (-> //.Version //.Visibility //.Class-Config Text (List Constraint) (Type Class) (List (Type Class)) //.Def + (host.type [byte])) + (let [writer (|> (do-to (ClassWriter::new class-computes) + (ClassWriter::visit (version-flag version) + ($_ i.+ + (Opcodes::ACC_SUPER) + + (visibility-flag visibility) + (class-flags config)) + (..binary-name name) + (constraints-signature constraints super interfaces) + (..class-name super) + (|> interfaces + (list@map ..class-name) + string-array))) + definitions) + _ (ClassWriter::visitEnd writer)] + (ClassWriter::toByteArray writer)))] + + [class +0] + [abstract (Opcodes::ACC_ABSTRACT)] + ) + +(def: $Object + (Type Class) + (type.class "java.lang.Object" (list))) + +(def: #export (interface version visibility config name constraints interfaces + definitions) + (-> //.Version //.Visibility //.Class-Config Text (List Constraint) (List (Type Class)) //.Def + (host.type [byte])) + (let [writer (|> (do-to (ClassWriter::new class-computes) + (ClassWriter::visit (version-flag version) + ($_ i.+ + (Opcodes::ACC_SUPER) + (Opcodes::ACC_INTERFACE) + (visibility-flag visibility) + (class-flags config)) + (..binary-name name) + (constraints-signature constraints $Object interfaces) + (..class-name $Object) + (|> interfaces + (list@map ..class-name) + string-array))) + definitions) + _ (ClassWriter::visitEnd writer)] + (ClassWriter::toByteArray writer))) + +(def: #export (method visibility config name type then) + (-> //.Visibility //.Method-Config Text (Type Method) //.Inst + //.Def) + (function (_ writer) + (let [=method (ClassWriter::visitMethod ($_ i.+ + (visibility-flag visibility) + (method-flags config)) + (..binary-name name) + (..descriptor type) + (..signature type) + (string-array (list)) + writer) + _ (MethodVisitor::visitCode =method) + _ (then =method) + _ (MethodVisitor::visitMaxs +0 +0 =method) + _ (MethodVisitor::visitEnd =method)] + writer))) + +(def: #export (abstract-method visibility config name type) + (-> //.Visibility //.Method-Config Text (Type Method) + //.Def) + (function (_ writer) + (let [=method (ClassWriter::visitMethod ($_ i.+ + (visibility-flag visibility) + (method-flags config) + (Opcodes::ACC_ABSTRACT)) + (..binary-name name) + (..descriptor type) + (..signature type) + (string-array (list)) + writer) + _ (MethodVisitor::visitEnd =method)] + writer))) + +(def: #export (field visibility config name type) + (-> //.Visibility //.Field-Config Text (Type Value) //.Def) + (function (_ writer) + (let [=field (do-to (ClassWriter::visitField ($_ i.+ + (visibility-flag visibility) + (field-flags config)) + (..binary-name name) + (..descriptor type) + (..signature type) + (host.null) + writer) + (FieldVisitor::visitEnd))] + writer))) + +(template [ ] + [(def: #export ( visibility config name value) + (-> //.Visibility //.Field-Config Text //.Def) + (function (_ writer) + (let [=field (do-to (ClassWriter::visitField ($_ i.+ + (visibility-flag visibility) + (field-flags config)) + (..binary-name name) + (..descriptor ) + (..signature ) + ( value) + writer) + (FieldVisitor::visitEnd))] + writer)))] + + [boolean-field Bit type.boolean function.identity] + [byte-field Int type.byte host.long-to-byte] + [short-field Int type.short host.long-to-short] + [int-field Int type.int host.long-to-int] + [long-field Int type.long function.identity] + [float-field Frac type.float host.double-to-float] + [double-field Frac type.double function.identity] + [char-field Nat type.char (|>> .int host.long-to-int host.int-to-char)] + [string-field Text (type.class "java.lang.String" (list)) function.identity] + ) + +(def: #export (fuse defs) + (-> (List //.Def) //.Def) + (case defs + #.Nil + function.identity + + (#.Cons singleton #.Nil) + singleton + + (#.Cons head tail) + (function.compose (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 new file mode 100644 index 000000000..b673c7d7e --- /dev/null +++ b/lux-jvm/source/luxc/lang/host/jvm/inst.lux @@ -0,0 +1,464 @@ +(.module: + [lux (#- Type int char) + ["." host (#+ import: do-to)] + [abstract + [monad (#+ do)]] + [control + ["." function] + ["." try] + ["p" parser + ["s" code]]] + [data + ["." product] + ["." maybe] + [number + ["n" nat] + ["i" int]] + [collection + ["." list ("#@." functor)]]] + [macro + ["." code] + ["." template] + [syntax (#+ syntax:)]] + [target + [jvm + [encoding + ["." name (#+ External)]] + ["." type (#+ Type) ("#@." equivalence) + [category (#+ Void Value Return Method Primitive Object Class Array Var Parameter)] + ["." box] + ["." descriptor] + ["." reflection]]]] + [tool + [compiler + [phase (#+ Operation)]]]] + ["." // (#+ 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: #long java/lang/Object) +(import: #long java/lang/String) + +(syntax: (declare {codes (p.many s.local-identifier)}) + (|> codes + (list@map (function (_ code) (` ((~' #static) (~ (code.local-identifier code)) (~' int))))) + wrap)) + +(`` (import: #long org/objectweb/asm/Opcodes + (#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: #long org/objectweb/asm/Label + (new [])) + +(import: #long org/objectweb/asm/MethodVisitor + (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: #export make-label + (All [s] (Operation s org/objectweb/asm/Label)) + (function (_ state) + (#try.Success [state (org/objectweb/asm/Label::new)]))) + +(def: #export (with-label action) + (All [a] (-> (-> org/objectweb/asm/Label a) a)) + (action (org/objectweb/asm/Label::new))) + +(template [ ] + [(def: #export ( value) + (-> Inst) + (function (_ visitor) + (do-to visitor + (org/objectweb/asm/MethodVisitor::visitLdcInsn ( value)))))] + + [boolean Bit function.identity] + [int Int host.long-to-int] + [long Int function.identity] + [double Frac function.identity] + [char Nat (|>> .int host.long-to-int host.int-to-char)] + [string Text function.identity] + ) + +(template: (!prefix short) + (`` ((~~ (template.identifier ["org/objectweb/asm/Opcodes::" short]))))) + +(template [] + [(def: #export + Inst + (function (_ visitor) + (do-to visitor + (org/objectweb/asm/MethodVisitor::visitInsn (!prefix )))))] + + [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))))) + +(template [] + [(def: #export ( constant) + (-> Int Inst) + (function (_ visitor) + (do-to visitor + (org/objectweb/asm/MethodVisitor::visitIntInsn (!prefix ) constant))))] + + [BIPUSH] + [SIPUSH] + ) + +(template [] + [(def: #export + Inst + (function (_ visitor) + (do-to visitor + (org/objectweb/asm/MethodVisitor::visitInsn (!prefix )))))] + + [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: #export Register Nat) + +(template [] + [(def: #export ( register) + (-> Register Inst) + (function (_ visitor) + (do-to visitor + (org/objectweb/asm/MethodVisitor::visitVarInsn (!prefix ) (.int register)))))] + + [IINC] + [ILOAD] [LLOAD] [FLOAD] [DLOAD] [ALOAD] + [ISTORE] [LSTORE] [FSTORE] [DSTORE] [ASTORE] + ) + +(template [ ] + [(def: #export ( class field type) + (-> (Type Class) Text (Type Value) Inst) + (function (_ visitor) + (do-to visitor + (org/objectweb/asm/MethodVisitor::visitFieldInsn () (..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 [ +] + [(`` (template [ ] + [(def: #export ( class) + (-> (Type ) Inst) + (function (_ visitor) + (do-to visitor + (org/objectweb/asm/MethodVisitor::visitTypeInsn () (..class-name class)))))] + + (~~ (template.splice +))))] + + [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: #export (NEWARRAY type) + (-> (Type Primitive) Inst) + (function (_ visitor) + (do-to visitor + (org/objectweb/asm/MethodVisitor::visitIntInsn (org/objectweb/asm/Opcodes::NEWARRAY) + (`` (cond (~~ (template [ ] + [(type@= type) ()] + + [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 [ ] + [(def: #export ( class method-name method) + (-> (Type Class) Text (Type Method) Inst) + (function (_ visitor) + (do-to visitor + (org/objectweb/asm/MethodVisitor::visitMethodInsn () + (..class-name class) + method-name + (|> method type.descriptor descriptor.descriptor) + ))))] + + [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 [] + [(def: #export ( @where) + (-> //.Label Inst) + (function (_ visitor) + (do-to visitor + (org/objectweb/asm/MethodVisitor::visitJumpInsn (!prefix ) @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: #export (LOOKUPSWITCH default keys+labels) + (-> //.Label (List [Int //.Label]) Inst) + (function (_ visitor) + (let [keys+labels (list.sort (function (_ left right) + (i.< (product.left left) (product.left right))) + keys+labels) + array-size (list.size keys+labels) + keys-array (host.array int array-size) + labels-array (host.array org/objectweb/asm/Label array-size) + _ (loop [idx 0] + (if (n.< array-size idx) + (let [[key label] (maybe.assume (list.nth idx keys+labels))] + (exec + (host.array-write idx (host.long-to-int key) keys-array) + (host.array-write idx label labels-array) + (recur (inc idx)))) + []))] + (do-to visitor + (org/objectweb/asm/MethodVisitor::visitLookupSwitchInsn default keys-array labels-array))))) + +(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 org/objectweb/asm/Label num-labels) + _ (loop [idx 0] + (if (n.< num-labels idx) + (exec (host.array-write idx + (maybe.assume (list.nth idx labels)) + labels-array) + (recur (inc idx))) + []))] + (do-to visitor + (org/objectweb/asm/MethodVisitor::visitTableSwitchInsn min max default labels-array))))) + +(def: #export (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: #export (label @label) + (-> //.Label Inst) + (function (_ visitor) + (do-to visitor + (org/objectweb/asm/MethodVisitor::visitLabel @label)))) + +(def: #export (array elementT) + (-> (Type Value) Inst) + (case (type.primitive? elementT) + (#.Left elementT) + (ANEWARRAY elementT) + + (#.Right elementT) + (NEWARRAY elementT))) + +(template [ ] + [(def: ( type) + (-> (Type Primitive) Text) + (`` (cond (~~ (template [ ] + [(type@= type) ] + + [type.boolean ] + [type.byte ] + [type.short ] + [type.int ] + [type.long ] + [type.float ] + [type.double ] + [type.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: #export (wrap type) + (-> (Type Primitive) Inst) + (let [wrapper (type.class (primitive-wrapper type) (list))] + (INVOKESTATIC wrapper "valueOf" (type.method [(list type) wrapper (list)])))) + +(def: #export (unwrap type) + (-> (Type Primitive) Inst) + (let [wrapper (type.class (primitive-wrapper type) (list))] + (|>> (CHECKCAST wrapper) + (INVOKEVIRTUAL wrapper (primitive-unwrap type) (type.method [(list) type (list)]))))) + +(def: #export (fuse insts) + (-> (List Inst) Inst) + (case insts + #.Nil + function.identity + + (#.Cons singleton #.Nil) + singleton + + (#.Cons head tail) + (function.compose (fuse tail) head))) -- cgit v1.2.3