From c7e53036704b1a89b740c023c7b4bcc74b7e956a Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 14 Jun 2017 17:56:24 -0400 Subject: - Heavy refactoring. --- new-luxc/source/luxc/generator/host/jvm/def.lux | 142 +++++++++++++++++ new-luxc/source/luxc/generator/host/jvm/inst.lux | 195 +++++++++++++++++++++++ new-luxc/source/luxc/generator/host/jvm/type.lux | 138 ++++++++++++++++ 3 files changed, 475 insertions(+) create mode 100644 new-luxc/source/luxc/generator/host/jvm/def.lux create mode 100644 new-luxc/source/luxc/generator/host/jvm/inst.lux create mode 100644 new-luxc/source/luxc/generator/host/jvm/type.lux (limited to 'new-luxc/source/luxc/generator/host/jvm') diff --git a/new-luxc/source/luxc/generator/host/jvm/def.lux b/new-luxc/source/luxc/generator/host/jvm/def.lux new file mode 100644 index 000000000..1fd87caea --- /dev/null +++ b/new-luxc/source/luxc/generator/host/jvm/def.lux @@ -0,0 +1,142 @@ +(;module: + lux + (lux (data (coll ["a" array] + [list "L/" Functor])) + [host #+ jvm-import do-to]) + ["$" ..] + (.. ["$t" type])) + +## [Host] +(jvm-import #long java.lang.Object) +(jvm-import #long java.lang.String) + +(jvm-import org.objectweb.asm.Opcodes + (#static ACC_PUBLIC int) + (#static ACC_PROTECTED int) + (#static ACC_PRIVATE int) + + (#static ACC_ABSTRACT int) + (#static ACC_FINAL int) + (#static ACC_STATIC int) + (#static ACC_SYNCHRONIZED int) + + (#static ACC_TRANSIENT int) + (#static ACC_VOLATILE int)) + +(jvm-import org.objectweb.asm.FieldVisitor + (visitEnd [] void)) + +(jvm-import org.objectweb.asm.MethodVisitor + (visitCode [] void) + (visitMaxs [int int] void) + (visitEnd [] void)) + +(jvm-import org.objectweb.asm.ClassWriter + (#static COMPUTE_MAXS int) + (new [int]) + (visit [int int String String String (Array String)] void) + (visitEnd [] void) + (visitField [int String String String Object] FieldVisitor) + (visitMethod [int String String String (Array String)] MethodVisitor) + (toByteArray [] Byte-Array)) + +## [Defs] +(def: (exceptions-array type) + (-> $;Method (a;Array Text)) + (let [exs (|> type (get@ #$;exceptions) (L/map (|>. #$;Generic $t;descriptor))) + output (host;array String (list;size exs))] + (exec (L/map (function [[idx value]] + (host;array-store idx value output)) + (list;enumerate exs)) + output))) + +(def: (visibility-flag visibility) + (-> $;Visibility Int) + (case visibility + #$;Public Opcodes.ACC_PUBLIC + #$;Protected Opcodes.ACC_PROTECTED + #$;Private Opcodes.ACC_PRIVATE + #$;Default 0)) + +(def: (method-flag config) + (-> $;Method-Config Int) + ($_ i.+ + (if (get@ #$;staticM config) Opcodes.ACC_STATIC 0) + (if (get@ #$;finalM config) Opcodes.ACC_FINAL 0) + (if (get@ #$;synchronizedM config) Opcodes.ACC_SYNCHRONIZED 0))) + +(def: (field-flag config) + (-> $;Field-Config Int) + ($_ i.+ + (if (get@ #$;staticF config) Opcodes.ACC_STATIC 0) + (if (get@ #$;finalF config) Opcodes.ACC_FINAL 0) + (if (get@ #$;transientF config) Opcodes.ACC_TRANSIENT 0) + (if (get@ #$;volatileF config) Opcodes.ACC_VOLATILE 0))) + +(def: #export (method visibility config name type then) + (-> $;Visibility $;Method-Config Text $;Method $;Inst + $;Def) + (function [writer] + (let [=method (ClassWriter.visitMethod [($_ i.+ + (visibility-flag visibility) + (method-flag config)) + name + ($t;method-descriptor type) + ($t;method-signature type) + (exceptions-array type)] + writer) + _ (MethodVisitor.visitCode [] =method) + _ (then =method) + _ (MethodVisitor.visitMaxs [0 0] =method) + _ (MethodVisitor.visitEnd [] =method)] + writer))) + +(def: #export (abstract-method visibility config name type) + (-> $;Visibility $;Method-Config Text $;Method + $;Def) + (function [writer] + (let [=method (ClassWriter.visitMethod [($_ i.+ + (visibility-flag visibility) + (method-flag config) + Opcodes.ACC_ABSTRACT) + name + ($t;method-descriptor type) + ($t;method-signature type) + (exceptions-array type)] + writer) + _ (MethodVisitor.visitEnd [] =method)] + writer))) + +(def: #export (field visibility config name type) + (-> $;Visibility $;Field-Config Text $;Type $;Def) + (function [writer] + (let [=field (do-to (ClassWriter.visitField [($_ i.+ + (visibility-flag visibility) + (field-flag config)) + name ($t;descriptor type) ($t;signature type) (host;null)] writer) + (FieldVisitor.visitEnd []))] + writer))) + +(do-template [ ] + [(def: #export ( visibility config name value) + (-> $;Visibility $;Field-Config Text $;Def) + (function [writer] + (let [=field (do-to (ClassWriter.visitField [($_ i.+ + (visibility-flag visibility) + (field-flag config)) + name ($t;descriptor ) ($t;signature ) + ( value)] + writer) + (FieldVisitor.visitEnd []))] + writer)))] + + [boolean-field Bool $t;boolean id] + [byte-field Int $t;byte host;l2b] + [short-field Int $t;short host;l2s] + [int-field Int $t;int host;l2i] + [long-field Int $t;long id] + [float-field Real $t;float host;d2f] + [double-field Real $t;double id] + [char-field Char $t;char id] + [string-field Text ($t;class "java.lang.String" (list)) id] + ) diff --git a/new-luxc/source/luxc/generator/host/jvm/inst.lux b/new-luxc/source/luxc/generator/host/jvm/inst.lux new file mode 100644 index 000000000..f340be055 --- /dev/null +++ b/new-luxc/source/luxc/generator/host/jvm/inst.lux @@ -0,0 +1,195 @@ +(;module: + lux + (lux [host #+ jvm-import do-to]) + ["$" ..] + (.. ["$t" type])) + +## [Host] +(jvm-import #long java.lang.Object) +(jvm-import #long java.lang.String) + +(jvm-import org.objectweb.asm.Opcodes + (#static T_BOOLEAN int) + (#static T_CHAR int) + (#static T_FLOAT int) + (#static T_DOUBLE int) + (#static T_BYTE int) + (#static T_SHORT int) + (#static T_INT int) + (#static T_LONG int) + + (#static DUP int) + (#static RETURN int) + (#static ARETURN int) + (#static ACONST_NULL int) + (#static ILOAD int) + (#static ALOAD int) + (#static NEWARRAY int) + (#static ANEWARRAY int) + (#static AASTORE int) + (#static PUTSTATIC int) + (#static GETFIELD int) + (#static INVOKESTATIC int) + (#static INVOKEVIRTUAL int) + (#static INVOKESPECIAL int) + (#static CHECKCAST int)) + +(jvm-import org.objectweb.asm.FieldVisitor + (visitEnd [] void)) + +(jvm-import org.objectweb.asm.MethodVisitor + (visitCode [] void) + (visitMaxs [int int] void) + (visitEnd [] void) + (visitInsn [int] void) + (visitLdcInsn [Object] void) + (visitFieldInsn [int String String String] void) + (visitTypeInsn [int String] void) + (visitVarInsn [int int] void) + (visitIntInsn [int int] void) + (visitMethodInsn [int String String String boolean] void)) + +## [Insts] +(do-template [ ] + [(def: #export ( value) + (-> $;Inst) + (function [visitor] + (do-to visitor + (MethodVisitor.visitLdcInsn [( value)]))))] + + [boolean Bool id] + [int Int host;l2i] + [long Int id] + [double Real id] + [char Char id] + [string Text id] + ) + +(do-template [ ] + [(def: #export + $;Inst + (function [visitor] + (do-to visitor + (MethodVisitor.visitInsn []))))] + + [RETURN Opcodes.RETURN] + [ARETURN Opcodes.ARETURN] + [NULL Opcodes.ACONST_NULL] + [DUP Opcodes.DUP] + [AASTORE Opcodes.AASTORE] + ) + +(do-template [ ] + [(def: #export ( register) + (-> Nat $;Inst) + (function [visitor] + (do-to visitor + (MethodVisitor.visitVarInsn [ (nat-to-int register)]))))] + + [ALOAD Opcodes.ALOAD] + [ILOAD Opcodes.ILOAD] + ) + +(do-template [ ] + [(def: #export ( class field type) + (-> Text Text $;Type $;Inst) + (function [visitor] + (do-to visitor + (MethodVisitor.visitFieldInsn [ ($t;binary-name class) field ($t;descriptor type)]))))] + + [PUTSTATIC Opcodes.PUTSTATIC] + ) + +(do-template [ ] + [(def: #export ( class) + (-> Text $;Inst) + (function [visitor] + (do-to visitor + (MethodVisitor.visitTypeInsn [ ($t;binary-name class)]))))] + + [ANEWARRAY Opcodes.ANEWARRAY] + [CHECKCAST Opcodes.CHECKCAST] + ) + +(def: #export (NEWARRAY type) + (-> $;Primitive $;Inst) + (function [visitor] + (do-to visitor + (MethodVisitor.visitIntInsn [Opcodes.NEWARRAY (case type + #$;Boolean Opcodes.T_BOOLEAN + #$;Byte Opcodes.T_SHORT + #$;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) + (function [visitor] + (do-to visitor + (MethodVisitor.visitMethodInsn [ ($t;binary-name class) method-name ($t;method-descriptor method-signature) interface?]))))] + + [INVOKESTATIC Opcodes.INVOKESTATIC] + [INVOKEVIRTUAL Opcodes.INVOKEVIRTUAL] + ) + +(def: #export (array type size) + (-> $;Type Nat $;Inst) + (case type + (#$;Primitive prim) + (|>. (int (nat-to-int size)) + (NEWARRAY prim)) + + (#$;Generic generic) + (let [elem-class (case generic + (#$;Class class params) + ($t;binary-name class) + + _ + ($t;binary-name "java.lang.Object"))] + (|>. (int (nat-to-int size)) + (ANEWARRAY elem-class))) + + _ + (|>. (int (nat-to-int size)) + (ANEWARRAY ($t;descriptor type))))) + +(do-template [ ] + [(def: #export + $;Inst + (|>. (INVOKESTATIC "valueOf" + ($t;method (list ) + (#;Some ($t;class (list))) + (list)) + false))) + (def: #export + $;Inst + (|>. (CHECKCAST ) + (INVOKEVIRTUAL + ($t;method (list) (#;Some ) (list)) + false)))] + + [wrap-boolean unwrap-boolean "java.lang.Boolean" "booleanValue" $t;boolean] + [wrap-byte unwrap-byte "java.lang.Byte" "byteValue" $t;byte] + [wrap-short unwrap-short "java.lang.Short" "shortValue" $t;short] + [wrap-int unwrap-int "java.lang.Integer" "intValue" $t;int] + [wrap-long unwrap-long "java.lang.Long" "longValue" $t;long] + [wrap-float unwrap-float "java.lang.Float" "floatValue" $t;float] + [wrap-double unwrap-double "java.lang.Double" "doubleValue" $t;double] + [wrap-char unwrap-char "java.lang.Character" "charValue" $t;char] + ) + +(def: #export (fuse insts) + (-> (List $;Inst) $;Inst) + (case insts + #;Nil + id + + (#;Cons singleton #;Nil) + singleton + + (#;Cons head tail) + (. head (fuse tail)))) diff --git a/new-luxc/source/luxc/generator/host/jvm/type.lux b/new-luxc/source/luxc/generator/host/jvm/type.lux new file mode 100644 index 000000000..b457ac636 --- /dev/null +++ b/new-luxc/source/luxc/generator/host/jvm/type.lux @@ -0,0 +1,138 @@ +(;module: + lux + (lux (data [text] + text/format + (coll [list "L/" Functor]))) + ["$" ..]) + +## Types +(do-template [ ] + [(def: #export $;Type (#$;Primitive ))] + + [boolean #$;Boolean] + [byte #$;Byte] + [short #$;Short] + [int #$;Int] + [long #$;Long] + [float #$;Float] + [double #$;Double] + [char #$;Char] + ) + +(def: #export (class name params) + (-> Text (List $;Generic) $;Type) + (#$;Generic (#$;Class name params))) + +(def: #export (var name) + (-> Text $;Type) + (#$;Generic (#$;Var name))) + +(def: #export (wildcard bound) + (-> (Maybe [$;Bound $;Generic]) $;Type) + (#$;Generic (#$;Wildcard bound))) + +(def: #export (array depth elemT) + (-> Nat $;Type $;Type) + (case depth + +0 elemT + _ (#$;Array (array (n.dec depth) elemT)))) + +(def: #export (binary-name class) + (-> Text Text) + (text;replace-all "." "/" class)) + +(def: #export (descriptor type) + (-> $;Type Text) + (case type + (#$;Primitive prim) + (case prim + #$;Boolean "Z" + #$;Byte "B" + #$;Short "S" + #$;Int "I" + #$;Long "J" + #$;Float "F" + #$;Double "D" + #$;Char "C") + + (#$;Array sub) + (format "[" (descriptor sub)) + + (#$;Generic generic) + (case generic + (#$;Class class params) + (format "L" (binary-name class) ";") + + (^or (#$;Var name) (#$;Wildcard ?bound)) + (descriptor (#$;Generic (#$;Class "java.lang.Object" (list))))) + )) + +(def: #export (signature type) + (-> $;Type Text) + (case type + (#$;Primitive prim) + (case prim + #$;Boolean "Z" + #$;Byte "B" + #$;Short "S" + #$;Int "I" + #$;Long "J" + #$;Float "F" + #$;Double "D" + #$;Char "C") + + (#$;Array sub) + (format "[" (signature sub)) + + (#$;Generic generic) + (case generic + (#$;Class class params) + (let [=params (if (list;empty? params) + "" + (format "<" + (|> params + (L/map (|>. #$;Generic signature)) + (text;join-with "")) + ">"))] + (format "L" (binary-name class) =params ";")) + + (#$;Var name) + (format "T" name ";") + + (#$;Wildcard #;None) + "*" + + (^template [ ] + (#$;Wildcard (#;Some [ bound])) + (format (signature (#$;Generic bound)))) + ([#$;Upper "+"] + [#$;Lower "-"])) + )) + +## Methods +(def: #export (method args return exceptions) + (-> (List $;Type) (Maybe $;Type) (List $;Generic) $;Method) + {#$;args args #$;return return #$;exceptions exceptions}) + +(def: #export (method-descriptor method) + (-> $;Method Text) + (format "(" (text;join-with "" (L/map descriptor (get@ #$;args method))) ")" + (case (get@ #$;return method) + #;None + "V" + + (#;Some return) + (descriptor return)))) + +(def: #export (method-signature method) + (-> $;Method Text) + (format "(" (|> (get@ #$;args method) (L/map signature) (text;join-with "")) ")" + (case (get@ #$;return method) + #;None + "V" + + (#;Some return) + (signature return)) + (|> (get@ #$;exceptions method) + (L/map (|>. #$;Generic signature (format "^"))) + (text;join-with "")))) -- cgit v1.2.3