From a79927892174c3564c83a0e741e5cc0aaaeeb37c Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 30 Jun 2017 18:43:07 -0400 Subject: - WIP: Added generation for common procedures. --- new-luxc/source/luxc/generator/host/jvm/def.lux | 146 ++++++++++++++++++++++-- 1 file changed, 138 insertions(+), 8 deletions(-) (limited to 'new-luxc/source/luxc/generator/host/jvm/def.lux') diff --git a/new-luxc/source/luxc/generator/host/jvm/def.lux b/new-luxc/source/luxc/generator/host/jvm/def.lux index 1fd87caea..39fab2f2a 100644 --- a/new-luxc/source/luxc/generator/host/jvm/def.lux +++ b/new-luxc/source/luxc/generator/host/jvm/def.lux @@ -1,6 +1,8 @@ (;module: lux - (lux (data (coll ["a" array] + (lux (data [text] + text/format + (coll ["a" array] [list "L/" Functor])) [host #+ jvm-import do-to]) ["$" ..] @@ -15,13 +17,26 @@ (#static ACC_PROTECTED int) (#static ACC_PRIVATE int) + (#static ACC_TRANSIENT int) + (#static ACC_VOLATILE 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)) + (#static ACC_SUPER int) + (#static ACC_INTERFACE int) + + (#static V1_1 int) + (#static V1_2 int) + (#static V1_3 int) + (#static V1_4 int) + (#static V1_5 int) + (#static V1_6 int) + (#static V1_7 int) + (#static V1_8 int) + ) (jvm-import org.objectweb.asm.FieldVisitor (visitEnd [] void)) @@ -41,15 +56,32 @@ (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))] +(def: (string-array values) + (-> (List Text) (a;Array Text)) + (let [output (host;array String (list;size values))] (exec (L/map (function [[idx value]] (host;array-store idx value output)) - (list;enumerate exs)) + (list;enumerate values)) output))) +(def: exceptions-array + (-> $;Method (a;Array Text)) + (|>. (get@ #$;exceptions) + (L/map (|>. #$;Generic $t;descriptor)) + string-array)) + +(def: (version-flag version) + (-> $;Version Int) + (case version + #$;V1.1 Opcodes.V1_1 + #$;V1.2 Opcodes.V1_2 + #$;V1.3 Opcodes.V1_3 + #$;V1.4 Opcodes.V1_4 + #$;V1.5 Opcodes.V1_5 + #$;V1.6 Opcodes.V1_6 + #$;V1.7 Opcodes.V1_7 + #$;V1.8 Opcodes.V1_8)) + (def: (visibility-flag visibility) (-> $;Visibility Int) (case visibility @@ -58,6 +90,11 @@ #$;Private Opcodes.ACC_PRIVATE #$;Default 0)) +(def: (class-flag config) + (-> $;Class-Config Int) + ($_ i.+ + (if (get@ #$;finalC config) Opcodes.ACC_FINAL 0))) + (def: (method-flag config) (-> $;Method-Config Int) ($_ i.+ @@ -73,6 +110,87 @@ (if (get@ #$;transientF config) Opcodes.ACC_TRANSIENT 0) (if (get@ #$;volatileF config) Opcodes.ACC_VOLATILE 0))) +(def: class-to-type + (-> $;Class $;Type) + (|>. #$;Class #$;Generic)) + +(def: param-signature + (-> $;Class Text) + (|>. class-to-type $t;signature (format ":"))) + +(def: (formal-param [name super interfaces]) + (-> $;Parameter Text) + (format name + (param-signature super) + (|> interfaces + (L/map param-signature) + (text;join-with "")))) + +(def: (parameters-signature parameters super interfaces) + (-> (List $;Parameter) $;Class (List $;Class) + Text) + (let [formal-params (if (list;empty? parameters) + "" + (format "<" + (|> parameters + (L/map formal-param) + (text;join-with "")) + ">"))] + (format formal-params + (|> super class-to-type $t;signature) + (|> interfaces + (L/map (|>. class-to-type $t;signature)) + (text;join-with ""))))) + +(do-template [ ] + [(def: #export ( version visibility config name parameters super interfaces + definitions) + (-> $;Version $;Visibility $;Class-Config Text (List $;Parameter) $;Class (List $;Class) $;Def + host;Byte-Array) + (let [writer (|> (do-to (ClassWriter.new ClassWriter.COMPUTE_MAXS) + (ClassWriter.visit [(version-flag version) + ($_ i.+ + Opcodes.ACC_SUPER + + (visibility-flag visibility) + (class-flag config)) + name + (parameters-signature parameters super interfaces) + (|> super class-to-type $t;descriptor) + (|> interfaces + (L/map (|>. class-to-type $t;descriptor)) + string-array)])) + definitions) + _ (ClassWriter.visitEnd [] writer)] + (ClassWriter.toByteArray [] writer)))] + + [class 0] + [abstract Opcodes.ACC_ABSTRACT] + ) + +(def: $Object $;Class ["java.lang.Object" (list)]) + +(def: #export (interface version visibility config name parameters interfaces + definitions) + (-> $;Version $;Visibility $;Class-Config Text (List $;Parameter) (List $;Class) $;Def + host;Byte-Array) + (let [writer (|> (do-to (ClassWriter.new ClassWriter.COMPUTE_MAXS) + (ClassWriter.visit [(version-flag version) + ($_ i.+ + Opcodes.ACC_SUPER + Opcodes.ACC_INTERFACE + (visibility-flag visibility) + (class-flag config)) + name + (parameters-signature parameters $Object interfaces) + (|> $Object class-to-type $t;descriptor) + (|> interfaces + (L/map (|>. class-to-type $t;descriptor)) + string-array)])) + definitions) + _ (ClassWriter.visitEnd [] writer)] + (ClassWriter.toByteArray [] writer))) + (def: #export (method visibility config name type then) (-> $;Visibility $;Method-Config Text $;Method $;Inst $;Def) @@ -140,3 +258,15 @@ [char-field Char $t;char id] [string-field Text ($t;class "java.lang.String" (list)) id] ) + +(def: #export (fuse defs) + (-> (List $;Def) $;Def) + (case defs + #;Nil + id + + (#;Cons singleton #;Nil) + singleton + + (#;Cons head tail) + (. head (fuse tail)))) -- cgit v1.2.3