aboutsummaryrefslogtreecommitdiff
path: root/lux-jvm/source/luxc/lang/directive
diff options
context:
space:
mode:
Diffstat (limited to 'lux-jvm/source/luxc/lang/directive')
-rw-r--r--lux-jvm/source/luxc/lang/directive/jvm.lux140
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
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 18:30:34 +0000