diff options
Diffstat (limited to 'lux-jvm/source/luxc/lang/directive')
-rw-r--r-- | lux-jvm/source/luxc/lang/directive/jvm.lux | 140 |
1 files changed, 70 insertions, 70 deletions
diff --git a/lux-jvm/source/luxc/lang/directive/jvm.lux b/lux-jvm/source/luxc/lang/directive/jvm.lux index 8f1fab5e2..f73182c03 100644 --- a/lux-jvm/source/luxc/lang/directive/jvm.lux +++ b/lux-jvm/source/luxc/lang/directive/jvm.lux @@ -82,8 +82,8 @@ (..literal literal) )) -(def: (int-arithmetic instruction) - (-> /.Int-Arithmetic Inst) +(def: (int_arithmetic instruction) + (-> /.Int_Arithmetic Inst) (case instruction #/.IADD _.IADD #/.ISUB _.ISUB @@ -92,8 +92,8 @@ #/.IREM _.IREM #/.INEG _.INEG)) -(def: (long-arithmetic instruction) - (-> /.Long-Arithmetic Inst) +(def: (long_arithmetic instruction) + (-> /.Long_Arithmetic Inst) (case instruction #/.LADD _.LADD #/.LSUB _.LSUB @@ -102,8 +102,8 @@ #/.LREM _.LREM #/.LNEG _.LNEG)) -(def: (float-arithmetic instruction) - (-> /.Float-Arithmetic Inst) +(def: (float_arithmetic instruction) + (-> /.Float_Arithmetic Inst) (case instruction #/.FADD _.FADD #/.FSUB _.FSUB @@ -112,8 +112,8 @@ #/.FREM _.FREM #/.FNEG _.FNEG)) -(def: (double-arithmetic instruction) - (-> /.Double-Arithmetic Inst) +(def: (double_arithmetic instruction) + (-> /.Double_Arithmetic Inst) (case instruction #/.DADD _.DADD #/.DSUB _.DSUB @@ -125,20 +125,20 @@ (def: (arithmetic instruction) (-> /.Arithmetic Inst) (case instruction - (#/.Int-Arithmetic int-arithmetic) - (..int-arithmetic int-arithmetic) + (#/.Int_Arithmetic int_arithmetic) + (..int_arithmetic int_arithmetic) - (#/.Long-Arithmetic long-arithmetic) - (..long-arithmetic long-arithmetic) + (#/.Long_Arithmetic long_arithmetic) + (..long_arithmetic long_arithmetic) - (#/.Float-Arithmetic float-arithmetic) - (..float-arithmetic float-arithmetic) + (#/.Float_Arithmetic float_arithmetic) + (..float_arithmetic float_arithmetic) - (#/.Double-Arithmetic double-arithmetic) - (..double-arithmetic double-arithmetic))) + (#/.Double_Arithmetic double_arithmetic) + (..double_arithmetic double_arithmetic))) -(def: (int-bitwise instruction) - (-> /.Int-Bitwise Inst) +(def: (int_bitwise instruction) + (-> /.Int_Bitwise Inst) (case instruction #/.IOR _.IOR #/.IXOR _.IXOR @@ -147,8 +147,8 @@ #/.ISHR _.ISHR #/.IUSHR _.IUSHR)) -(def: (long-bitwise instruction) - (-> /.Long-Bitwise Inst) +(def: (long_bitwise instruction) + (-> /.Long_Bitwise Inst) (case instruction #/.LOR _.LOR #/.LXOR _.LXOR @@ -160,11 +160,11 @@ (def: (bitwise instruction) (-> /.Bitwise Inst) (case instruction - (#/.Int-Bitwise int-bitwise) - (..int-bitwise int-bitwise) + (#/.Int_Bitwise int_bitwise) + (..int_bitwise int_bitwise) - (#/.Long-Bitwise long-bitwise) - (..long-bitwise long-bitwise))) + (#/.Long_Bitwise long_bitwise) + (..long_bitwise long_bitwise))) (def: (conversion instruction) (-> /.Conversion Inst) @@ -224,8 +224,8 @@ (-> /.Object Inst) (case instruction (^template [<tag> <inst>] - [(<tag> class field-name field-type) - (<inst> class field-name field-type)]) + [(<tag> class field_name field_type) + (<inst> class field_name field_type)]) ([#/.GETSTATIC _.GETSTATIC] [#/.PUTSTATIC _.PUTSTATIC] [#/.GETFIELD _.GETFIELD] @@ -237,40 +237,40 @@ (#/.CHECKCAST type) (_.CHECKCAST type) (^template [<tag> <inst>] - [(<tag> class method-name method-type) - (<inst> class method-name method-type)]) + [(<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) +(def: (local_int instruction) + (-> /.Local_Int Inst) (case instruction (#/.ILOAD register) (_.ILOAD register) (#/.ISTORE register) (_.ISTORE register))) -(def: (local-long instruction) - (-> /.Local-Long Inst) +(def: (local_long instruction) + (-> /.Local_Long Inst) (case instruction (#/.LLOAD register) (_.LLOAD register) (#/.LSTORE register) (_.LSTORE register))) -(def: (local-float instruction) - (-> /.Local-Float Inst) +(def: (local_float instruction) + (-> /.Local_Float Inst) (case instruction (#/.FLOAD register) (_.FLOAD register) (#/.FSTORE register) (_.FSTORE register))) -(def: (local-double instruction) - (-> /.Local-Double Inst) +(def: (local_double instruction) + (-> /.Local_Double Inst) (case instruction (#/.DLOAD register) (_.DLOAD register) (#/.DSTORE register) (_.DSTORE register))) -(def: (local-object instruction) - (-> /.Local-Object Inst) +(def: (local_object instruction) + (-> /.Local_Object Inst) (case instruction (#/.ALOAD register) (_.ALOAD register) (#/.ASTORE register) (_.ASTORE register))) @@ -278,12 +278,12 @@ (def: (local instruction) (-> /.Local Inst) (case instruction - (#/.Local-Int instruction) (..local-int 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))) + (#/.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) @@ -385,12 +385,12 @@ (type: Mapping (Dictionary /.Label org/objectweb/asm/Label)) -(type: (Re-labeler context) +(type: (Re_labeler context) (-> [Mapping (context /.Label)] [Mapping (context org/objectweb/asm/Label)])) (def: (relabel [mapping label]) - (Re-labeler Identity) + (Re_labeler Identity) (case (dictionary.get label mapping) (#.Some label) [mapping label] @@ -399,8 +399,8 @@ (let [label' (org/objectweb/asm/Label::new)] [(dictionary.put label label' mapping) label']))) -(def: (relabel-branching [mapping instruction]) - (Re-labeler /.Branching) +(def: (relabel_branching [mapping instruction]) + (Re_labeler /.Branching) (case instruction (^template [<tag>] [(<tag> label) @@ -428,8 +428,8 @@ [mapping (#/.LOOKUPSWITCH default (list.reverse keys+labels))]) )) -(def: (relabel-exception [mapping instruction]) - (Re-labeler /.Exception) +(def: (relabel_exception [mapping instruction]) + (Re_labeler /.Exception) (case instruction (#/.Try start end handler exception) (let [[mapping start] (..relabel [mapping start]) @@ -441,16 +441,16 @@ [mapping #/.ATHROW] )) -(def: (relabel-control [mapping instruction]) - (Re-labeler /.Control) +(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]) + [#/.Branching ..relabel_branching] + [#/.Exception ..relabel_exception]) (^template [<tag>] [(<tag> instruction) @@ -458,8 +458,8 @@ ([#/.Concurrency] [#/.Return]) )) -(def: (relabel-instruction [mapping instruction]) - (Re-labeler /.Instruction) +(def: (relabel_instruction [mapping instruction]) + (Re_labeler /.Instruction) (case instruction #/.NOP [mapping #/.NOP] @@ -477,13 +477,13 @@ [#/.Comparison]) (#/.Control instruction) - (let [[mapping instruction] (..relabel-control [mapping instruction])] + (let [[mapping instruction] (..relabel_control [mapping instruction])] [mapping (#/.Control instruction)]))) -(def: (relabel-bytecode [mapping bytecode]) - (Re-labeler /.Bytecode) +(def: (relabel_bytecode [mapping bytecode]) + (Re_labeler /.Bytecode) (row@fold (function (_ input [mapping output]) - (let [[mapping input] (..relabel-instruction [mapping input])] + (let [[mapping input] (..relabel_instruction [mapping input])] [mapping (row.add input output)])) [mapping (row.row)] bytecode)) @@ -495,41 +495,41 @@ (def: bytecode (-> (/.Bytecode /.Label) jvm.Inst) (|>> [..fresh] - ..relabel-bytecode + ..relabel_bytecode product.right (row@map ..instruction) - row.to-list + row.to_list _.fuse)) (type: Handler (generation.Handler jvm.Anchor (/.Bytecode /.Label) jvm.Definition)) -(def: (true-handler extender pseudo) +(def: (true_handler extender pseudo) (-> jvm.Extender Any jvm.Handler) - (function (_ extension-name phase archive inputs) + (function (_ extension_name phase archive inputs) (do phase.monad - [bytecode ((extender pseudo) extension-name phase archive inputs)] + [bytecode ((extender pseudo) extension_name phase archive inputs)] (wrap (..bytecode (:coerce (/.Bytecode /.Label) bytecode)))))) (def: (def::generation extender) (-> jvm.Extender (directive.Handler jvm.Anchor jvm.Inst jvm.Definition)) - (function (handler extension-name phase archive inputsC+) + (function (handler extension_name phase archive inputsC+) (case inputsC+ (^ (list nameC valueC)) (do phase.monad [[_ _ name] (lux/.evaluate! archive Text nameC) [_ handlerV] (lux/.generator archive (:coerce Text name) ..Handler valueC) _ (|> handlerV - (..true-handler extender) + (..true_handler extender) (extension.install extender (:coerce Text name)) - directive.lift-generation) - _ (directive.lift-generation + directive.lift_generation) + _ (directive.lift_generation (generation.log! (format "Generation " (%.text (:coerce Text name)))))] - (wrap directive.no-requirements)) + (wrap directive.no_requirements)) _ - (phase.throw extension.invalid-syntax [extension-name %.code inputsC+])))) + (phase.throw extension.invalid_syntax [extension_name %.code inputsC+])))) (def: #export (bundle extender) (-> jvm.Extender |