From 8b4f0ded7bddaa42cf432f74523bfd6aa1e76fed Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 18 Jul 2018 23:44:29 -0400 Subject: WIP: Fix new-luxc's JVM back-end. --- new-luxc/source/luxc/lang/host/jvm/def.lux | 26 +++---- new-luxc/source/luxc/lang/host/jvm/inst.lux | 110 +++++++++++++++------------- new-luxc/source/luxc/lang/host/jvm/type.lux | 14 ++-- 3 files changed, 79 insertions(+), 71 deletions(-) (limited to 'new-luxc/source/luxc/lang/host/jvm') diff --git a/new-luxc/source/luxc/lang/host/jvm/def.lux b/new-luxc/source/luxc/lang/host/jvm/def.lux index 4c19f38f6..3d3f8d80d 100644 --- a/new-luxc/source/luxc/lang/host/jvm/def.lux +++ b/new-luxc/source/luxc/lang/host/jvm/def.lux @@ -1,16 +1,17 @@ (.module: - lux - (lux (data [text] - text/format - [product] - (coll ["a" array] - [list "list/" Functor])) - [host #+ do-to] - [function]) - ["$" //] - (// ["$t" type])) - -## [Host] + [lux #* + [data + ["." text + format] + ["." product] + [collection + ["a" array] + [list ("list/" Functor)]]] + [host (#+ do-to)] + [function]] + ["$" // + ["$t" type]]) + (host.import: #long java/lang/Object) (host.import: #long java/lang/String) @@ -59,7 +60,6 @@ (visitMethod [int String String String (Array String)] MethodVisitor) (toByteArray [] (Array byte))) -## [Defs] (def: (string-array values) (-> (List Text) (Array Text)) (let [output (host.array String (list.size values))] diff --git a/new-luxc/source/luxc/lang/host/jvm/inst.lux b/new-luxc/source/luxc/lang/host/jvm/inst.lux index 393200a28..9426fabe3 100644 --- a/new-luxc/source/luxc/lang/host/jvm/inst.lux +++ b/new-luxc/source/luxc/lang/host/jvm/inst.lux @@ -1,29 +1,35 @@ (.module: - [lux #- int char] - (lux (control monad - ["p" parser]) - (data [maybe] - ["e" error] - text/format - (coll [list "list/" Functor])) - [host #+ do-to] - [macro] - (macro [code] - ["s" syntax #+ syntax:]) - [function]) - [//] - [//type]) + [lux (#- int char) + [control + [monad (#+ do)] + ["p" parser]] + [data + ["." maybe] + ["." error] + [text + format] + [collection + ["." list ("list/" Functor)]]] + [host (#+ import: do-to)] + [macro + ["." code] + ["s" syntax (#+ syntax:)]] + [function] + [language + [compiler (#+ Operation)]]] + ["." // (#+ Primitive Inst) + ["." type]]) ## [Host] -(host.import: #long java/lang/Object) -(host.import: #long java/lang/String) +(import: #long java/lang/Object) +(import: #long java/lang/String) (syntax: (declare {codes (p.many s.local-symbol)}) (|> codes (list/map (function (_ code) (` ((~' #static) (~ (code.local-symbol code)) (~' int))))) wrap)) -(`` (host.import: org/objectweb/asm/Opcodes +(`` (import: org/objectweb/asm/Opcodes (#static NOP int) ## Conversion @@ -90,10 +96,10 @@ (~~ (declare RETURN IRETURN LRETURN DRETURN ARETURN)) )) -(host.import: org/objectweb/asm/Label +(import: org/objectweb/asm/Label (new [])) -(host.import: org/objectweb/asm/MethodVisitor +(import: org/objectweb/asm/MethodVisitor (visitCode [] void) (visitMaxs [int int] void) (visitEnd [] void) @@ -112,17 +118,17 @@ ## [Insts] (def: #export make-label - (Meta Label) - (function (_ compiler) - (#e.Success [compiler (Label::new [])]))) + (All [s] (Operation s Label)) + (function (_ state) + (#error.Success [state (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)]))))] @@ -139,14 +145,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,7 +213,7 @@ (do-template [] [(def: #export ( register) - (-> Nat //.Inst) + (-> Nat Inst) (function (_ visitor) (do-to visitor (MethodVisitor::visitVarInsn [(prefix ) (.int register)]))))] @@ -218,10 +224,10 @@ (do-template [ ] [(def: #export ( class field type) - (-> Text Text //.Type //.Inst) + (-> Text Text //.Type Inst) (function (_ visitor) (do-to visitor - (MethodVisitor::visitFieldInsn [ (//type.binary-name class) field (//type.descriptor type)]))))] + (MethodVisitor::visitFieldInsn [ (type.binary-name class) field (type.descriptor type)]))))] [GETSTATIC Opcodes::GETSTATIC] [PUTSTATIC Opcodes::PUTSTATIC] @@ -232,10 +238,10 @@ (do-template [ ] [(def: #export ( class) - (-> Text //.Inst) + (-> Text Inst) (function (_ visitor) (do-to visitor - (MethodVisitor::visitTypeInsn [ (//type.binary-name class)]))))] + (MethodVisitor::visitTypeInsn [ (type.binary-name class)]))))] [CHECKCAST Opcodes::CHECKCAST] [NEW Opcodes::NEW] @@ -244,7 +250,7 @@ ) (def: #export (NEWARRAY type) - (-> //.Primitive //.Inst) + (-> Primitive Inst) (function (_ visitor) (do-to visitor (MethodVisitor::visitIntInsn [Opcodes::NEWARRAY (case type @@ -259,10 +265,10 @@ (do-template [ ] [(def: #export ( class method-name method-signature interface?) - (-> Text Text //.Method Bit //.Inst) + (-> Text Text //.Method Bit Inst) (function (_ visitor) (do-to visitor - (MethodVisitor::visitMethodInsn [ (//type.binary-name class) method-name (//type.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 +278,7 @@ (do-template [] [(def: #export ( @where) - (-> //.Label //.Inst) + (-> //.Label Inst) (function (_ visitor) (do-to visitor (MethodVisitor::visitJumpInsn [(prefix ) @where]))))] @@ -283,7 +289,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) @@ -298,19 +304,19 @@ (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 (//type.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) (NEWARRAY prim) @@ -318,17 +324,17 @@ (#//.Generic generic) (let [elem-class (case generic (#//.Class class params) - (//type.binary-name class) + (type.binary-name class) _ - (//type.binary-name "java.lang.Object"))] + (type.binary-name "java.lang.Object"))] (ANEWARRAY elem-class)) _ - (ANEWARRAY (//type.descriptor type)))) + (ANEWARRAY (type.descriptor type)))) (def: (primitive-wrapper type) - (-> //.Primitive Text) + (-> Primitive Text) (case type #//.Boolean "java.lang.Boolean" #//.Byte "java.lang.Byte" @@ -340,7 +346,7 @@ #//.Char "java.lang.Character")) (def: (primitive-unwrap type) - (-> //.Primitive Text) + (-> Primitive Text) (case type #//.Boolean "booleanValue" #//.Byte "byteValue" @@ -352,24 +358,24 @@ #//.Char "charValue")) (def: #export (wrap type) - (-> //.Primitive //.Inst) + (-> Primitive Inst) (let [class (primitive-wrapper type)] (|>> (INVOKESTATIC class "valueOf" - (//type.method (list (#//.Primitive type)) - (#.Some (//type.class class (list))) - (list)) + (type.method (list (#//.Primitive type)) + (#.Some (type.class class (list))) + (list)) #0)))) (def: #export (unwrap type) - (-> //.Primitive //.Inst) + (-> Primitive Inst) (let [class (primitive-wrapper type)] (|>> (CHECKCAST class) (INVOKEVIRTUAL class (primitive-unwrap type) - (//type.method (list) (#.Some (#//.Primitive type)) (list)) + (type.method (list) (#.Some (#//.Primitive type)) (list)) #0)))) (def: #export (fuse insts) - (-> (List //.Inst) //.Inst) + (-> (List Inst) Inst) (case insts #.Nil id diff --git a/new-luxc/source/luxc/lang/host/jvm/type.lux b/new-luxc/source/luxc/lang/host/jvm/type.lux index 0c36e6799..f9a956b86 100644 --- a/new-luxc/source/luxc/lang/host/jvm/type.lux +++ b/new-luxc/source/luxc/lang/host/jvm/type.lux @@ -1,8 +1,10 @@ (.module: - [lux #- int char] - (lux (data [text] - text/format - (coll [list "list/" Functor]))) + [lux (#- int char) + [data + ["." text + format] + [collection + [list ("list/" Functor)]]]] [//]) ## Types @@ -37,9 +39,9 @@ +0 elemT _ (#//.Array (array (dec depth) elemT)))) -(def: #export (binary-name class) +(def: #export binary-name (-> Text Text) - (text.replace-all "." "/" class)) + (text.replace-all "." "/")) (def: #export (descriptor type) (-> //.Type Text) -- cgit v1.2.3