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 ++++++++++++++++++++++++
 1 file changed, 142 insertions(+)
 create mode 100644 new-luxc/source/luxc/generator/host/jvm/def.lux

(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
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<List>]))
+       [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 [<name> <lux-type> <jvm-type> <prepare>]
+  [(def: #export (<name> visibility config name value)
+     (-> $;Visibility $;Field-Config Text <lux-type> $;Def)
+     (function [writer]
+       (let [=field (do-to (ClassWriter.visitField [($_ i.+
+                                                        (visibility-flag visibility)
+                                                        (field-flag config))
+                                                    name ($t;descriptor <jvm-type>) ($t;signature <jvm-type>)
+                                                    (<prepare> 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]
+  )
-- 
cgit v1.2.3