From bcd3d9ee8f6797f758a2abea98d5cb6a74cc7df0 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 15 Jun 2018 00:11:33 -0400 Subject: - WIP: Adjustments to new-luxc based on recent changes to stdlib. --- new-luxc/source/luxc/lang/host/jvm/inst.lux | 126 ++++++++++++++-------------- 1 file changed, 63 insertions(+), 63 deletions(-) (limited to 'new-luxc/source/luxc/lang/host/jvm/inst.lux') diff --git a/new-luxc/source/luxc/lang/host/jvm/inst.lux b/new-luxc/source/luxc/lang/host/jvm/inst.lux index d088c5324..671a2bb3c 100644 --- a/new-luxc/source/luxc/lang/host/jvm/inst.lux +++ b/new-luxc/source/luxc/lang/host/jvm/inst.lux @@ -1,5 +1,5 @@ (.module: - [lux #- char] + [lux #- int char] (lux (control monad ["p" parser]) (data [maybe] @@ -11,8 +11,8 @@ (macro [code] ["s" syntax #+ syntax:]) [function]) - ["$" //] - (// ["$t" type])) + [//] + [//type]) ## [Host] (host.import #long java/lang/Object) @@ -117,12 +117,12 @@ (#e.Success [compiler (Label::new [])]))) (def: #export (with-label action) - (-> (-> Label $.Inst) $.Inst) + (-> (-> Label //.Inst) //.Inst) (action (Label::new []))) (do-template [ ] [(def: #export ( value) - (-> $.Inst) + (-> //.Inst) (function (_ visitor) (do-to visitor (MethodVisitor::visitLdcInsn [( value)]))))] @@ -131,7 +131,7 @@ [int Int host.long-to-int] [long Int id] [double Frac id] - [char Nat (|>> nat-to-int host.long-to-int host.int-to-char)] + [char Nat (|>> .int host.long-to-int host.int-to-char)] [string Text id] ) @@ -139,14 +139,14 @@ (wrap (list (code.local-symbol (format "Opcodes::" base))))) (def: #export NULL - $.Inst + //.Inst (function (_ visitor) (do-to visitor (MethodVisitor::visitInsn [(prefix ACONST_NULL)])))) (do-template [] [(def: #export - $.Inst + //.Inst (function (_ visitor) (do-to visitor (MethodVisitor::visitInsn [(prefix )]))))] @@ -207,10 +207,10 @@ (do-template [] [(def: #export ( register) - (-> Nat $.Inst) + (-> Nat //.Inst) (function (_ visitor) (do-to visitor - (MethodVisitor::visitVarInsn [(prefix ) (nat-to-int register)]))))] + (MethodVisitor::visitVarInsn [(prefix ) (.int register)]))))] [ILOAD] [LLOAD] [DLOAD] [ALOAD] [ISTORE] [LSTORE] [ASTORE] @@ -218,10 +218,10 @@ (do-template [ ] [(def: #export ( class field type) - (-> Text Text $.Type $.Inst) + (-> Text Text //.Type //.Inst) (function (_ visitor) (do-to visitor - (MethodVisitor::visitFieldInsn [ ($t.binary-name class) field ($t.descriptor type)]))))] + (MethodVisitor::visitFieldInsn [ (//type.binary-name class) field (//type.descriptor type)]))))] [GETSTATIC Opcodes::GETSTATIC] [PUTSTATIC Opcodes::PUTSTATIC] @@ -232,10 +232,10 @@ (do-template [ ] [(def: #export ( class) - (-> Text $.Inst) + (-> Text //.Inst) (function (_ visitor) (do-to visitor - (MethodVisitor::visitTypeInsn [ ($t.binary-name class)]))))] + (MethodVisitor::visitTypeInsn [ (//type.binary-name class)]))))] [CHECKCAST Opcodes::CHECKCAST] [NEW Opcodes::NEW] @@ -244,25 +244,25 @@ ) (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)])))) + #//.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 [ ] [(def: #export ( class method-name method-signature interface?) - (-> Text Text $.Method Bool $.Inst) + (-> Text Text //.Method Bool //.Inst) (function (_ visitor) (do-to visitor - (MethodVisitor::visitMethodInsn [ ($t.binary-name class) method-name ($t.method-descriptor method-signature) interface?]))))] + (MethodVisitor::visitMethodInsn [ (//type.binary-name class) method-name (//type.method-descriptor method-signature) interface?]))))] [INVOKESTATIC Opcodes::INVOKESTATIC] [INVOKEVIRTUAL Opcodes::INVOKEVIRTUAL] @@ -272,7 +272,7 @@ (do-template [] [(def: #export ( @where) - (-> $.Label $.Inst) + (-> //.Label //.Inst) (function (_ visitor) (do-to visitor (MethodVisitor::visitJumpInsn [(prefix ) @where]))))] @@ -283,7 +283,7 @@ ) (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) @@ -292,84 +292,84 @@ (exec (host.array-write idx (maybe.assume (list.nth idx labels)) labels-array) - (recur (n/inc idx))) + (recur (inc idx))) []))] (do-to visitor (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 (//type.binary-name exception)])))) (def: #export (label @label) - (-> $.Label $.Inst) + (-> //.Label //.Inst) (function (_ visitor) (do-to visitor (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) + (//type.binary-name class) _ - ($t.binary-name "java.lang.Object"))] + (//type.binary-name "java.lang.Object"))] (ANEWARRAY elem-class)) _ - (ANEWARRAY ($t.descriptor type)))) + (ANEWARRAY (//type.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))) - (list)) + (//type.method (list (#//.Primitive type)) + (#.Some (//type.class class (list))) + (list)) false)))) (def: #export (unwrap type) - (-> $.Primitive $.Inst) + (-> //.Primitive //.Inst) (let [class (primitive-wrapper type)] (|>> (CHECKCAST class) (INVOKEVIRTUAL class (primitive-unwrap type) - ($t.method (list) (#.Some (#$.Primitive type)) (list)) + (//type.method (list) (#.Some (#//.Primitive type)) (list)) false)))) (def: #export (fuse insts) - (-> (List $.Inst) $.Inst) + (-> (List //.Inst) //.Inst) (case insts #.Nil id -- cgit v1.2.3