diff options
Diffstat (limited to 'lux-jvm/source/luxc/lang/host/jvm')
| -rw-r--r-- | lux-jvm/source/luxc/lang/host/jvm/def.lux | 156 | ||||
| -rw-r--r-- | lux-jvm/source/luxc/lang/host/jvm/inst.lux | 144 |
2 files changed, 150 insertions, 150 deletions
diff --git a/lux-jvm/source/luxc/lang/host/jvm/def.lux b/lux-jvm/source/luxc/lang/host/jvm/def.lux index a9003b485..12e2fe412 100644 --- a/lux-jvm/source/luxc/lang/host/jvm/def.lux +++ b/lux-jvm/source/luxc/lang/host/jvm/def.lux @@ -1,6 +1,6 @@ (.module: [lux (#- Type) - ["." host (#+ import: do-to)] + ["." host (#+ import: do_to)] [control ["." function]] [data @@ -24,7 +24,7 @@ (def: signature (|>> type.signature signature.signature)) (def: descriptor (|>> type.descriptor descriptor.descriptor)) -(def: class-name (|>> type.descriptor descriptor.class-name name.read)) +(def: class_name (|>> type.descriptor descriptor.class_name name.read)) (import: java/lang/Object) (import: java/lang/String) @@ -77,15 +77,15 @@ (visitMethod [int java/lang/String java/lang/String java/lang/String [java/lang/String]] org/objectweb/asm/MethodVisitor) (toByteArray [] [byte])]) -(def: (string-array values) +(def: (string_array values) (-> (List Text) (Array Text)) (let [output (host.array java/lang/String (list.size values))] (exec (list@map (function (_ [idx value]) - (host.array-write idx value output)) + (host.array_write idx value output)) (list.enumeration values)) output))) -(def: (version-flag version) +(def: (version_flag version) (-> //.Version Int) (case version #//.V1_1 (org/objectweb/asm/Opcodes::V1_1) @@ -97,7 +97,7 @@ #//.V1_7 (org/objectweb/asm/Opcodes::V1_7) #//.V1_8 (org/objectweb/asm/Opcodes::V1_8))) -(def: (visibility-flag visibility) +(def: (visibility_flag visibility) (-> //.Visibility Int) (case visibility #//.Public (org/objectweb/asm/Opcodes::ACC_PUBLIC) @@ -105,82 +105,82 @@ #//.Private (org/objectweb/asm/Opcodes::ACC_PRIVATE) #//.Default +0)) -(def: (class-flags config) - (-> //.Class-Config Int) +(def: (class_flags config) + (-> //.Class_Config Int) ($_ i.+ (if (get@ #//.finalC config) (org/objectweb/asm/Opcodes::ACC_FINAL) +0))) -(def: (method-flags config) - (-> //.Method-Config Int) +(def: (method_flags config) + (-> //.Method_Config Int) ($_ i.+ (if (get@ #//.staticM config) (org/objectweb/asm/Opcodes::ACC_STATIC) +0) (if (get@ #//.finalM config) (org/objectweb/asm/Opcodes::ACC_FINAL) +0) (if (get@ #//.synchronizedM config) (org/objectweb/asm/Opcodes::ACC_SYNCHRONIZED) +0) (if (get@ #//.strictM config) (org/objectweb/asm/Opcodes::ACC_STRICT) +0))) -(def: (field-flags config) - (-> //.Field-Config Int) +(def: (field_flags config) + (-> //.Field_Config Int) ($_ i.+ (if (get@ #//.staticF config) (org/objectweb/asm/Opcodes::ACC_STATIC) +0) (if (get@ #//.finalF config) (org/objectweb/asm/Opcodes::ACC_FINAL) +0) (if (get@ #//.transientF config) (org/objectweb/asm/Opcodes::ACC_TRANSIENT) +0) (if (get@ #//.volatileF config) (org/objectweb/asm/Opcodes::ACC_VOLATILE) +0))) -(def: param-signature +(def: param_signature (-> (Type Class) Text) (|>> ..signature (format ":"))) -(def: (formal-param [name super interfaces]) +(def: (formal_param [name super interfaces]) (-> Constraint Text) (format name - (param-signature super) + (param_signature super) (|> interfaces - (list@map param-signature) - (text.join-with "")))) + (list@map param_signature) + (text.join_with "")))) -(def: (constraints-signature constraints super interfaces) +(def: (constraints_signature constraints super interfaces) (-> (List Constraint) (Type Class) (List (Type Class)) Text) - (let [formal-params (if (list.empty? constraints) + (let [formal_params (if (list.empty? constraints) "" (format "<" (|> constraints - (list@map formal-param) - (text.join-with "")) + (list@map formal_param) + (text.join_with "")) ">"))] - (format formal-params + (format formal_params (..signature super) (|> interfaces (list@map ..signature) - (text.join-with ""))))) + (text.join_with ""))))) -(def: class-computes +(def: class_computes Int ($_ i.+ (org/objectweb/asm/ClassWriter::COMPUTE_MAXS) ## (org/objectweb/asm/ClassWriter::COMPUTE_FRAMES) )) -(def: binary-name (|>> name.internal name.read)) +(def: binary_name (|>> name.internal name.read)) (template [<name> <flag>] [(def: #export (<name> version visibility config name constraints super interfaces definitions) - (-> //.Version //.Visibility //.Class-Config Text (List Constraint) (Type Class) (List (Type Class)) //.Def + (-> //.Version //.Visibility //.Class_Config Text (List Constraint) (Type Class) (List (Type Class)) //.Def (host.type [byte])) - (let [writer (|> (do-to (org/objectweb/asm/ClassWriter::new class-computes) - (org/objectweb/asm/ClassWriter::visit (version-flag version) + (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) + (visibility_flag visibility) + (class_flags config)) + (..binary_name name) + (constraints_signature constraints super interfaces) + (..class_name super) (|> interfaces - (list@map ..class-name) - string-array))) + (list@map ..class_name) + string_array))) definitions) _ (org/objectweb/asm/ClassWriter::visitEnd writer)] (org/objectweb/asm/ClassWriter::toByteArray writer)))] @@ -195,36 +195,36 @@ (def: #export (interface version visibility config name constraints interfaces definitions) - (-> //.Version //.Visibility //.Class-Config Text (List Constraint) (List (Type Class)) //.Def + (-> //.Version //.Visibility //.Class_Config Text (List Constraint) (List (Type Class)) //.Def (host.type [byte])) - (let [writer (|> (do-to (org/objectweb/asm/ClassWriter::new class-computes) - (org/objectweb/asm/ClassWriter::visit (version-flag version) + (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) (org/objectweb/asm/Opcodes::ACC_INTERFACE) - (visibility-flag visibility) - (class-flags config)) - (..binary-name name) - (constraints-signature constraints $Object interfaces) - (..class-name $Object) + (visibility_flag visibility) + (class_flags config)) + (..binary_name name) + (constraints_signature constraints $Object interfaces) + (..class_name $Object) (|> interfaces - (list@map ..class-name) - string-array))) + (list@map ..class_name) + string_array))) definitions) _ (org/objectweb/asm/ClassWriter::visitEnd writer)] (org/objectweb/asm/ClassWriter::toByteArray writer))) (def: #export (method visibility config name type then) - (-> //.Visibility //.Method-Config Text (Type Method) //.Inst + (-> //.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) + (visibility_flag visibility) + (method_flags config)) + (..binary_name name) (..descriptor type) (..signature type) - (string-array (list)) + (string_array (list)) writer) _ (org/objectweb/asm/MethodVisitor::visitCode =method) _ (then =method) @@ -232,29 +232,29 @@ _ (org/objectweb/asm/MethodVisitor::visitEnd =method)] writer))) -(def: #export (abstract-method visibility config name type) - (-> //.Visibility //.Method-Config Text (Type Method) +(def: #export (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) + (visibility_flag visibility) + (method_flags config) (org/objectweb/asm/Opcodes::ACC_ABSTRACT)) - (..binary-name name) + (..binary_name name) (..descriptor type) (..signature type) - (string-array (list)) + (string_array (list)) writer) _ (org/objectweb/asm/MethodVisitor::visitEnd =method)] writer))) (def: #export (field visibility config name type) - (-> //.Visibility //.Field-Config Text (Type Value) //.Def) + (-> //.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) + (let [=field (do_to (org/objectweb/asm/ClassWriter::visitField ($_ i.+ + (visibility_flag visibility) + (field_flags config)) + (..binary_name name) (..descriptor type) (..signature type) (host.null) @@ -262,30 +262,30 @@ (org/objectweb/asm/FieldVisitor::visitEnd))] writer))) -(template [<name> <lux-type> <jvm-type> <prepare>] +(template [<name> <lux_type> <jvm_type> <prepare>] [(def: #export (<name> visibility config name value) - (-> //.Visibility //.Field-Config Text <lux-type> //.Def) + (-> //.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>) + (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 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] + [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) diff --git a/lux-jvm/source/luxc/lang/host/jvm/inst.lux b/lux-jvm/source/luxc/lang/host/jvm/inst.lux index 9d51a15bb..341ded0e4 100644 --- a/lux-jvm/source/luxc/lang/host/jvm/inst.lux +++ b/lux-jvm/source/luxc/lang/host/jvm/inst.lux @@ -1,6 +1,6 @@ (.module: [lux (#- Type int char) - ["." host (#+ import: do-to)] + ["." host (#+ import: do_to)] [abstract [monad (#+ do)]] [control @@ -34,7 +34,7 @@ [phase (#+ Operation)]]]] ["." // (#+ Inst)]) -(def: class-name (|>> type.descriptor descriptor.class-name name.read)) +(def: class_name (|>> type.descriptor descriptor.class_name name.read)) (def: descriptor (|>> type.descriptor descriptor.descriptor)) (def: reflection (|>> type.reflection reflection.reflection)) @@ -42,9 +42,9 @@ (import: java/lang/Object) (import: java/lang/String) -(syntax: (declare {codes (p.many s.local-identifier)}) +(syntax: (declare {codes (p.many s.local_identifier)}) (|> codes - (list@map (function (_ code) (` ((~' #static) (~ (code.local-identifier code)) (~' int))))) + (list@map (function (_ code) (` ((~' #static) (~ (code.local_identifier code)) (~' int))))) wrap)) (`` (import: org/objectweb/asm/Opcodes @@ -147,12 +147,12 @@ ]) ## [Insts] -(def: #export make-label +(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) +(def: #export (with_label action) (All [a] (-> (-> org/objectweb/asm/Label a) a)) (action (org/objectweb/asm/Label::new))) @@ -160,14 +160,14 @@ [(def: #export (<name> value) (-> <type> Inst) (function (_ visitor) - (do-to visitor - (org/objectweb/asm/MethodVisitor::visitLdcInsn (<prepare> value)))))] + (do_to visitor + (org/objectweb/asm/MethodVisitor::visitLdcInsn (<prepare> value)))))] [boolean Bit function.identity] - [int Int host.long-to-int] + [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)] + [char Nat (|>> .int host.long_to_int host.int_to_char)] [string Text function.identity] ) @@ -178,8 +178,8 @@ [(def: #export <constant> Inst (function (_ visitor) - (do-to visitor - (org/objectweb/asm/MethodVisitor::visitInsn (!prefix <constant>)))))] + (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] @@ -190,15 +190,15 @@ (def: #export NULL Inst (function (_ visitor) - (do-to visitor - (org/objectweb/asm/MethodVisitor::visitInsn (!prefix ACONST_NULL))))) + (do_to visitor + (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))))] + (do_to visitor + (org/objectweb/asm/MethodVisitor::visitIntInsn (!prefix <constant>) constant))))] [BIPUSH] [SIPUSH] @@ -208,8 +208,8 @@ [(def: #export <name> Inst (function (_ visitor) - (do-to visitor - (org/objectweb/asm/MethodVisitor::visitInsn (!prefix <name>)))))] + (do_to visitor + (org/objectweb/asm/MethodVisitor::visitInsn (!prefix <name>)))))] [NOP] @@ -271,8 +271,8 @@ [(def: #export (<name> register) (-> Register Inst) (function (_ visitor) - (do-to visitor - (org/objectweb/asm/MethodVisitor::visitVarInsn (!prefix <name>) (.int register)))))] + (do_to visitor + (org/objectweb/asm/MethodVisitor::visitVarInsn (!prefix <name>) (.int register)))))] [IINC] [ILOAD] [LLOAD] [FLOAD] [DLOAD] [ALOAD] @@ -283,8 +283,8 @@ [(def: #export (<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)))))] + (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] @@ -298,8 +298,8 @@ [(def: #export (<name> class) (-> (Type <category>) Inst) (function (_ visitor) - (do-to visitor - (org/objectweb/asm/MethodVisitor::visitTypeInsn (<inst>) (..class-name class)))))] + (do_to visitor + (org/objectweb/asm/MethodVisitor::visitTypeInsn (<inst>) (..class_name class)))))] (~~ (template.splice <instructions>+))))] @@ -315,32 +315,32 @@ (def: #export (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))))))) + (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: #export (<name> class method-name method) + [(def: #export (<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?>))))] + (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] @@ -352,8 +352,8 @@ [(def: #export (<name> @where) (-> //.Label Inst) (function (_ visitor) - (do-to visitor - (org/objectweb/asm/MethodVisitor::visitJumpInsn (!prefix <name>) @where))))] + (do_to visitor + (org/objectweb/asm/MethodVisitor::visitJumpInsn (!prefix <name>) @where))))] [IF_ICMPEQ] [IF_ICMPGT] [IF_ICMPLT] [IF_ICMPNE] [IF_ICMPGE] [IF_ICMPLE] @@ -368,46 +368,46 @@ (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) + 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) + (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) + (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))))) + (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) + (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 + (if (n.< num_labels idx) + (exec (host.array_write idx (maybe.assume (list.nth idx labels)) - labels-array) + labels_array) (recur (inc idx))) []))] - (do-to visitor - (org/objectweb/asm/MethodVisitor::visitTableSwitchInsn min max default labels-array))))) + (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))))) + (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)))) + (do_to visitor + (org/objectweb/asm/MethodVisitor::visitLabel @label)))) (def: #export (array elementT) (-> (Type Value) Inst) @@ -435,24 +435,24 @@ ## else (undefined))))] - [primitive-wrapper + [primitive_wrapper box.boolean box.byte box.short box.int box.long box.float box.double box.char] - [primitive-unwrap + [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))] + (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))] + (let [wrapper (type.class (primitive_wrapper type) (list))] (|>> (CHECKCAST wrapper) - (INVOKEVIRTUAL wrapper (primitive-unwrap type) (type.method [(list) type (list)]))))) + (INVOKEVIRTUAL wrapper (primitive_unwrap type) (type.method [(list) type (list)]))))) (def: #export (fuse insts) (-> (List Inst) Inst) |