diff options
author | Eduardo Julian | 2017-11-29 22:49:56 -0400 |
---|---|---|
committer | Eduardo Julian | 2017-11-29 22:49:56 -0400 |
commit | 4433c9bcd6c6cac44c018aad2e21a5b4d7cc4896 (patch) | |
tree | 0c166db6e01b41dfadd01801b5242967f2363b7d /new-luxc/source/luxc/lang/host/jvm/inst.lux | |
parent | 77c113a3455cdbc4bb485a94f67f392480cdcfbf (diff) |
- Adapted main codebase to the latest syntatic changes.
Diffstat (limited to 'new-luxc/source/luxc/lang/host/jvm/inst.lux')
-rw-r--r-- | new-luxc/source/luxc/lang/host/jvm/inst.lux | 212 |
1 files changed, 105 insertions, 107 deletions
diff --git a/new-luxc/source/luxc/lang/host/jvm/inst.lux b/new-luxc/source/luxc/lang/host/jvm/inst.lux index e0c10feca..5f3711bbd 100644 --- a/new-luxc/source/luxc/lang/host/jvm/inst.lux +++ b/new-luxc/source/luxc/lang/host/jvm/inst.lux @@ -1,28 +1,29 @@ -(;module: +(.module: [lux #- char] (lux (control monad ["p" parser]) (data [maybe] ["e" error] text/format - (coll [list "L/" Functor<List>])) + (coll [list "list/" Functor<List>])) [host #+ do-to] [macro] (macro [code] - ["s" syntax #+ syntax:])) + ["s" syntax #+ syntax:]) + [function]) ["$" //] (// ["$t" type])) ## [Host] -(host;import #long java.lang.Object) -(host;import #long java.lang.String) +(host.import #long java/lang/Object) +(host.import #long java/lang/String) -(syntax: (declare [codes (p;many s;local-symbol)]) +(syntax: (declare [codes (p.many s.local-symbol)]) (|> codes - (L/map (function [code] (` ((~' #static) (~ (code;local-symbol code)) (~' int))))) + (list/map (function [code] (` ((~' #static) (~ (code.local-symbol code)) (~' int))))) wrap)) -(`` (host;import org.objectweb.asm.Opcodes +(`` (host.import org/objectweb/asm/Opcodes (#static NOP int) ## Conversion @@ -89,13 +90,10 @@ (~~ (declare RETURN IRETURN LRETURN DRETURN ARETURN)) )) -(host;import org.objectweb.asm.FieldVisitor - (visitEnd [] void)) - -(host;import org.objectweb.asm.Label +(host.import org/objectweb/asm/Label (new [])) -(host;import org.objectweb.asm.MethodVisitor +(host.import org/objectweb/asm/MethodVisitor (visitCode [] void) (visitMaxs [int int] void) (visitEnd [] void) @@ -116,42 +114,42 @@ (def: #export make-label (Meta Label) (function [compiler] - (#e;Success [compiler (Label.new [])]))) + (#e.Success [compiler (Label::new [])]))) (def: #export (with-label action) - (-> (-> Label $;Inst) $;Inst) - (action (Label.new []))) + (-> (-> Label $.Inst) $.Inst) + (action (Label::new []))) (do-template [<name> <type> <prepare>] [(def: #export (<name> value) - (-> <type> $;Inst) + (-> <type> $.Inst) (function [visitor] (do-to visitor - (MethodVisitor.visitLdcInsn [(<prepare> value)]))))] + (MethodVisitor::visitLdcInsn [(<prepare> value)]))))] [boolean Bool id] - [int Int host;l2i] + [int Int host.l2i] [long Int id] [double Frac id] - [char Nat (|>. nat-to-int host;l2i host;i2c)] + [char Nat (|>> nat-to-int host.l2i host.i2c)] [string Text id] ) -(syntax: (prefix [base s;local-symbol]) - (wrap (list (code;local-symbol (format "Opcodes." base))))) +(syntax: (prefix [base s.local-symbol]) + (wrap (list (code.local-symbol (format "Opcodes::" base))))) (def: #export NULL - $;Inst + $.Inst (function [visitor] (do-to visitor - (MethodVisitor.visitInsn [(prefix ACONST_NULL)])))) + (MethodVisitor::visitInsn [(prefix ACONST_NULL)])))) (do-template [<name>] [(def: #export <name> - $;Inst + $.Inst (function [visitor] (do-to visitor - (MethodVisitor.visitInsn [(prefix <name>)]))))] + (MethodVisitor::visitInsn [(prefix <name>)]))))] [NOP] @@ -209,10 +207,10 @@ (do-template [<name>] [(def: #export (<name> register) - (-> Nat $;Inst) + (-> Nat $.Inst) (function [visitor] (do-to visitor - (MethodVisitor.visitVarInsn [(prefix <name>) (nat-to-int register)]))))] + (MethodVisitor::visitVarInsn [(prefix <name>) (nat-to-int register)]))))] [ILOAD] [LLOAD] [DLOAD] [ALOAD] [ISTORE] [LSTORE] [ASTORE] @@ -220,64 +218,64 @@ (do-template [<name> <inst>] [(def: #export (<name> class field type) - (-> Text Text $;Type $;Inst) + (-> Text Text $.Type $.Inst) (function [visitor] (do-to visitor - (MethodVisitor.visitFieldInsn [<inst> ($t;binary-name class) field ($t;descriptor type)]))))] + (MethodVisitor::visitFieldInsn [<inst> ($t.binary-name class) field ($t.descriptor type)]))))] - [GETSTATIC Opcodes.GETSTATIC] - [PUTSTATIC Opcodes.PUTSTATIC] + [GETSTATIC Opcodes::GETSTATIC] + [PUTSTATIC Opcodes::PUTSTATIC] - [PUTFIELD Opcodes.PUTFIELD] - [GETFIELD Opcodes.GETFIELD] + [PUTFIELD Opcodes::PUTFIELD] + [GETFIELD Opcodes::GETFIELD] ) (do-template [<name> <inst>] [(def: #export (<name> class) - (-> Text $;Inst) + (-> Text $.Inst) (function [visitor] (do-to visitor - (MethodVisitor.visitTypeInsn [<inst> ($t;binary-name class)]))))] + (MethodVisitor::visitTypeInsn [<inst> ($t.binary-name class)]))))] - [CHECKCAST Opcodes.CHECKCAST] - [NEW Opcodes.NEW] - [INSTANCEOF Opcodes.INSTANCEOF] - [ANEWARRAY Opcodes.ANEWARRAY] + [CHECKCAST Opcodes::CHECKCAST] + [NEW Opcodes::NEW] + [INSTANCEOF Opcodes::INSTANCEOF] + [ANEWARRAY Opcodes::ANEWARRAY] ) (def: #export (NEWARRAY type) - (-> $;Primitive $;Inst) + (-> $.Primitive $.Inst) (function [visitor] (do-to visitor - (MethodVisitor.visitIntInsn [Opcodes.NEWARRAY (case type - #$;Boolean Opcodes.T_BOOLEAN - #$;Byte Opcodes.T_BYTE - #$;Short Opcodes.T_SHORT - #$;Int Opcodes.T_INT - #$;Long Opcodes.T_LONG - #$;Float Opcodes.T_FLOAT - #$;Double Opcodes.T_DOUBLE - #$;Char Opcodes.T_CHAR)])))) + (MethodVisitor::visitIntInsn [Opcodes::NEWARRAY (case type + #$.Boolean Opcodes::T_BOOLEAN + #$.Byte Opcodes::T_BYTE + #$.Short Opcodes::T_SHORT + #$.Int Opcodes::T_INT + #$.Long Opcodes::T_LONG + #$.Float Opcodes::T_FLOAT + #$.Double Opcodes::T_DOUBLE + #$.Char Opcodes::T_CHAR)])))) (do-template [<name> <inst>] [(def: #export (<name> class method-name method-signature interface?) - (-> Text Text $;Method Bool $;Inst) + (-> Text Text $.Method Bool $.Inst) (function [visitor] (do-to visitor - (MethodVisitor.visitMethodInsn [<inst> ($t;binary-name class) method-name ($t;method-descriptor method-signature) interface?]))))] + (MethodVisitor::visitMethodInsn [<inst> ($t.binary-name class) method-name ($t.method-descriptor method-signature) interface?]))))] - [INVOKESTATIC Opcodes.INVOKESTATIC] - [INVOKEVIRTUAL Opcodes.INVOKEVIRTUAL] - [INVOKESPECIAL Opcodes.INVOKESPECIAL] - [INVOKEINTERFACE Opcodes.INVOKEINTERFACE] + [INVOKESTATIC Opcodes::INVOKESTATIC] + [INVOKEVIRTUAL Opcodes::INVOKEVIRTUAL] + [INVOKESPECIAL Opcodes::INVOKESPECIAL] + [INVOKEINTERFACE Opcodes::INVOKEINTERFACE] ) (do-template [<name>] [(def: #export (<name> @where) - (-> $;Label $;Inst) + (-> $.Label $.Inst) (function [visitor] (do-to visitor - (MethodVisitor.visitJumpInsn [(prefix <name>) @where]))))] + (MethodVisitor::visitJumpInsn [(prefix <name>) @where]))))] [IF_ICMPEQ] [IF_ICMPGT] [IF_ICMPLT] [IF_ACMPEQ] [IFNULL] [IFEQ] [IFNE] [IFLT] [IFLE] [IFGT] [IFGE] @@ -285,99 +283,99 @@ ) (def: #export (TABLESWITCH min max default labels) - (-> Int Int $;Label (List $;Label) $;Inst) + (-> Int Int $.Label (List $.Label) $.Inst) (function [visitor] - (let [num-labels (list;size labels) - labels-array (host;array Label num-labels) + (let [num-labels (list.size labels) + labels-array (host.array Label num-labels) _ (loop [idx +0] - (if (n.< num-labels idx) - (exec (host;array-write idx - (maybe;assume (list;nth idx labels)) + (if (n/< num-labels idx) + (exec (host.array-write idx + (maybe.assume (list.nth idx labels)) labels-array) - (recur (n.inc idx))) + (recur (n/inc idx))) []))] (do-to visitor - (MethodVisitor.visitTableSwitchInsn [min max default labels-array]))))) + (MethodVisitor::visitTableSwitchInsn [min max default labels-array]))))) (def: #export (try @from @to @handler exception) - (-> $;Label $;Label $;Label Text $;Inst) + (-> $.Label $.Label $.Label Text $.Inst) (function [visitor] (do-to visitor - (MethodVisitor.visitTryCatchBlock [@from @to @handler ($t;binary-name exception)])))) + (MethodVisitor::visitTryCatchBlock [@from @to @handler ($t.binary-name exception)])))) (def: #export (label @label) - (-> $;Label $;Inst) + (-> $.Label $.Inst) (function [visitor] (do-to visitor - (MethodVisitor.visitLabel [@label])))) + (MethodVisitor::visitLabel [@label])))) (def: #export (array type) - (-> $;Type $;Inst) + (-> $.Type $.Inst) (case type - (#$;Primitive prim) + (#$.Primitive prim) (NEWARRAY prim) - (#$;Generic generic) + (#$.Generic generic) (let [elem-class (case generic - (#$;Class class params) - ($t;binary-name class) + (#$.Class class params) + ($t.binary-name class) _ - ($t;binary-name "java.lang.Object"))] + ($t.binary-name "java.lang.Object"))] (ANEWARRAY elem-class)) _ - (ANEWARRAY ($t;descriptor type)))) + (ANEWARRAY ($t.descriptor type)))) (def: (primitive-wrapper type) - (-> $;Primitive Text) + (-> $.Primitive Text) (case type - #$;Boolean "java.lang.Boolean" - #$;Byte "java.lang.Byte" - #$;Short "java.lang.Short" - #$;Int "java.lang.Integer" - #$;Long "java.lang.Long" - #$;Float "java.lang.Float" - #$;Double "java.lang.Double" - #$;Char "java.lang.Character")) + #$.Boolean "java.lang.Boolean" + #$.Byte "java.lang.Byte" + #$.Short "java.lang.Short" + #$.Int "java.lang.Integer" + #$.Long "java.lang.Long" + #$.Float "java.lang.Float" + #$.Double "java.lang.Double" + #$.Char "java.lang.Character")) (def: (primitive-unwrap type) - (-> $;Primitive Text) + (-> $.Primitive Text) (case type - #$;Boolean "booleanValue" - #$;Byte "byteValue" - #$;Short "shortValue" - #$;Int "intValue" - #$;Long "longValue" - #$;Float "floatValue" - #$;Double "doubleValue" - #$;Char "charValue")) + #$.Boolean "booleanValue" + #$.Byte "byteValue" + #$.Short "shortValue" + #$.Int "intValue" + #$.Long "longValue" + #$.Float "floatValue" + #$.Double "doubleValue" + #$.Char "charValue")) (def: #export (wrap type) - (-> $;Primitive $;Inst) + (-> $.Primitive $.Inst) (let [class (primitive-wrapper type)] - (|>. (INVOKESTATIC class "valueOf" - ($t;method (list (#$;Primitive type)) - (#;Some ($t;class class (list))) + (|>> (INVOKESTATIC class "valueOf" + ($t.method (list (#$.Primitive type)) + (#.Some ($t.class class (list))) (list)) false)))) (def: #export (unwrap type) - (-> $;Primitive $;Inst) + (-> $.Primitive $.Inst) (let [class (primitive-wrapper type)] - (|>. (CHECKCAST class) + (|>> (CHECKCAST class) (INVOKEVIRTUAL class (primitive-unwrap type) - ($t;method (list) (#;Some (#$;Primitive type)) (list)) + ($t.method (list) (#.Some (#$.Primitive type)) (list)) false)))) (def: #export (fuse insts) - (-> (List $;Inst) $;Inst) + (-> (List $.Inst) $.Inst) (case insts - #;Nil + #.Nil id - (#;Cons singleton #;Nil) + (#.Cons singleton #.Nil) singleton - (#;Cons head tail) - (. (fuse tail) head))) + (#.Cons head tail) + (function.compose (fuse tail) head))) |