From 9cd2927a4f6175784e081d6b512d3e900c8069e7 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Mon, 12 Jun 2017 21:14:55 -0400
Subject: - Renamed the "compilation" phase as the "generation" phase. -
 Implemented compilation of primitives. - Implemented compilation of
 structures.

---
 new-luxc/source/luxc/generator/common.jvm.lux | 130 ++++++++++++++++++++++++++
 1 file changed, 130 insertions(+)
 create mode 100644 new-luxc/source/luxc/generator/common.jvm.lux

(limited to 'new-luxc/source/luxc/generator/common.jvm.lux')

diff --git a/new-luxc/source/luxc/generator/common.jvm.lux b/new-luxc/source/luxc/generator/common.jvm.lux
new file mode 100644
index 000000000..e5d3552c4
--- /dev/null
+++ b/new-luxc/source/luxc/generator/common.jvm.lux
@@ -0,0 +1,130 @@
+(;module:
+  lux
+  (lux [io]
+       (concurrency ["A" atom])
+       (data ["R" result]
+             (coll ["d" dict])
+             text/format)
+       [macro #+ Monad<Lux>]
+       [host #+ jvm-import do-to]))
+
+## [Host]
+(jvm-import org.objectweb.asm.Opcodes
+  (#static V1_6 int)
+  (#static CHECKCAST int)
+  (#static INVOKESTATIC int)
+  (#static INVOKEVIRTUAL int))
+
+(jvm-import org.objectweb.asm.MethodVisitor
+  (visitLdcInsn [Object] void)
+  (visitTypeInsn [int String] void)
+  (visitMethodInsn [int String String String boolean] void))
+
+(jvm-import java.lang.Object
+  (toString [] String))
+
+(jvm-import (java.lang.Class a))
+
+(jvm-import java.lang.ClassLoader
+  (loadClass [String] (Class Object)))
+
+## [Types]
+(type: #export Bytecode host;Byte-Array)
+
+(type: #export Class-Store (A;Atom (d;Dict Text Bytecode)))
+
+(type: #export Host
+  {#visitor (Maybe MethodVisitor)
+   #loader ClassLoader
+   #store Class-Store})
+
+(def: #export unit Text "\u0000")
+
+(def: (visitor::get compiler)
+  (-> Compiler (Maybe MethodVisitor))
+  (|> (get@ #;host compiler)
+      (:! Host)
+      (get@ #visitor)))
+
+(def: (visitor::put ?visitor compiler)
+  (-> (Maybe MethodVisitor) Compiler Compiler)
+  (update@ #;host
+           (function [host]
+             (|> host
+                 (:! Host)
+                 (set@ #visitor ?visitor)
+                 (:! Void)))
+           compiler))
+
+(def: #export get-visitor
+  (Lux MethodVisitor)
+  (function [compiler]
+    (case (visitor::get compiler)
+      #;None
+      (#R;Error "No visitor has been set.")
+
+      (#;Some visitor)
+      (#R;Success [compiler visitor]))))
+
+(def: #export (with-visitor visitor body)
+  (All [a] (-> MethodVisitor (Lux a) (Lux a)))
+  (function [compiler]
+    (case (macro;run' (visitor::put (#;Some visitor) compiler) body)
+      (#R;Error error)
+      (#R;Error error)
+
+      (#R;Success [compiler' output])
+      (#R;Success [(visitor::put (visitor::get compiler) compiler')
+                   output]))))
+
+(def: #export (store-class name byte-code)
+  (-> Text Bytecode (Lux Unit))
+  (function [compiler]
+    (let [store (|> (get@ #;host compiler)
+                    (:! Host)
+                    (get@ #store))]
+      (if (d;contains? name (|> store A;get io;run))
+        (#R;Error (format "Cannot store class that already exists: " name))
+        (#R;Success [compiler (io;run (A;update (d;put name byte-code) store))])
+        ))))
+
+(def: #export (load-class name)
+  (-> Text (Lux (Class Object)))
+  (function [compiler]
+    (let [host (:! Host (get@ #;host compiler))
+          store (|> host (get@ #store) A;get io;run)]
+      (if (d;contains? name store)
+        (#R;Success [compiler (ClassLoader.loadClass [name] (get@ #loader host))])
+        (#R;Error (format "Unknown class: " name))))))
+
+
+(do-template [<wrap> <unwrap> <class> <unwrap-method> <prim> <dup>]
+  [(def: #export (<wrap> writer)
+     (-> MethodVisitor MethodVisitor)
+     (do-to writer
+       (MethodVisitor.visitMethodInsn [Opcodes.INVOKESTATIC
+                                       <class> "valueOf" (format "(" <prim> ")" "L" <class> ";")
+                                       false])))
+   (def: #export (<unwrap> writer)
+     (-> MethodVisitor MethodVisitor)
+     (do-to writer
+       (MethodVisitor.visitTypeInsn [Opcodes.CHECKCAST <class>])
+       (MethodVisitor.visitMethodInsn [Opcodes.INVOKEVIRTUAL
+                                       <class> <unwrap-method> (format "()" <prim>)
+                                       false])))]
+
+  [wrap-boolean unwrap-boolean "java/lang/Boolean"   "booleanValue" "Z" Opcodes.DUP_X1]
+  [wrap-byte    unwrap-byte    "java/lang/Byte"      "byteValue"    "B" Opcodes.DUP_X1]
+  [wrap-short   unwrap-short   "java/lang/Short"     "shortValue"   "S" Opcodes.DUP_X1]
+  [wrap-int     unwrap-int     "java/lang/Integer"   "intValue"     "I" Opcodes.DUP_X1]
+  [wrap-long    unwrap-long    "java/lang/Long"      "longValue"    "J" Opcodes.DUP_X2]
+  [wrap-float   unwrap-float   "java/lang/Float"     "floatValue"   "F" Opcodes.DUP_X1]
+  [wrap-double  unwrap-double  "java/lang/Double"    "doubleValue"  "D" Opcodes.DUP_X2]
+  [wrap-char    unwrap-char    "java/lang/Character" "charValue"    "C" Opcodes.DUP_X1]
+  )
+
+(type: #export Flags Int)
+(type: #export Descriptor Text)
+
+(def: #export bytecode-version Flags Opcodes.V1_6)
+(def: #export runtime-class-name Text "LuxRT")
-- 
cgit v1.2.3