From dd5220e13b03c8f85972feac535a34ef64525222 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Tue, 9 May 2017 17:48:27 -0400
Subject: - Added tests for some kinds of analysis. - WIP: Porting more code.

---
 new-luxc/source/luxc/compiler.lux | 87 ++++++++++++++++++++++++++++++++++-----
 1 file changed, 77 insertions(+), 10 deletions(-)

(limited to 'new-luxc/source/luxc/compiler.lux')

diff --git a/new-luxc/source/luxc/compiler.lux b/new-luxc/source/luxc/compiler.lux
index 8d0ea8a2f..2af00b049 100644
--- a/new-luxc/source/luxc/compiler.lux
+++ b/new-luxc/source/luxc/compiler.lux
@@ -1,17 +1,23 @@
 (;module:
   lux
   (lux (control monad)
-       (concurrency ["P" promise])
+       (concurrency ["A" atom]
+                    ["P" promise])
        (data ["E" error]
              [text "T/" Hash<Text>]
-             text/format)
-       [macro #+ Monad<Lux>])
+             text/format
+             (coll ["D" dict]
+                   [array #+ Array]))
+       [macro #+ Monad<Lux>]
+       host
+       [io])
   (luxc ["&" base]
         ["&;" io]
         ["&;" module]
         ["&;" parser]
         (compiler ["&&;" runtime]
-                  ["&&;" statement])
+                  ["&&;" statement]
+                  ["&&;" common])
         ))
 
 (def: (compile ast)
@@ -101,9 +107,70 @@
       (#E;Error error)
       (wrap (#E;Error error)))))
 
-(type: Host Unit)
-
-(def: init-host Host [])
+(jvm-import org.objectweb.asm.MethodVisitor)
+
+(jvm-import java.lang.reflect.AccessibleObject
+  (setAccessible [boolean] void))
+
+(jvm-import java.lang.reflect.Method
+  (invoke [Object (Array Object)] #try Object))
+
+(jvm-import (java.lang.Class a)
+  (getDeclaredMethod [String (Array (Class Object))] #try Method))
+
+(jvm-import java.lang.Object
+  (getClass [] (Class Object)))
+
+(jvm-import java.lang.Integer
+  (#static TYPE (Class Integer)))
+
+(jvm-import java.lang.ClassLoader)
+
+(def: ClassLoader::defineClass
+  Method
+  (case (Class.getDeclaredMethod ["defineClass"
+                                  (|> (array (Class Object) +4)
+                                      (array-store +0 (:! (Class Object) (class-for String)))
+                                      (array-store +1 (Object.getClass [] (array byte +0)))
+                                      (array-store +2 (:! (Class Object) Integer.TYPE))
+                                      (array-store +3 (:! (Class Object) Integer.TYPE)))]
+                                 (class-for java.lang.ClassLoader))
+    (#E;Success method)
+    (do-to method
+      (AccessibleObject.setAccessible [true]))
+
+    (#E;Error error)
+    (error! error)))
+
+(def: (memory-class-loader store)
+  (-> &&common;Class-Store ClassLoader)
+  (object ClassLoader []
+    []
+    (ClassLoader (findClass [class-name String]) void
+                 (case (|> store A;get io;run (D;get class-name))
+                   (#;Some bytecode)
+                   (case (Method.invoke [(:! Object _jvm_this)
+                                         (array;from-list (list (:! Object class-name)
+                                                                (:! Object bytecode)
+                                                                (:! Object (l2i 0))
+                                                                (:! Object (l2i (nat-to-int (array-length bytecode))))))]
+                                        ClassLoader::defineClass)
+                     (#E;Success output)
+                     []
+                     
+                     (#E;Error error)
+                     (error! error))
+
+                   _
+                   (error! (format "Unknown class: " class-name))))))
+
+(def: (init-host _)
+  (-> Top &&common;Host)
+  (let [store (: &&common;Class-Store
+                 (A;atom (D;new text;Hash<Text>)))]
+    {#&&common;visitor #;None
+     #&&common;loader (memory-class-loader store)
+     #&&common;store store}))
 
 (def: init-cursor Cursor ["" +0 +0])
 
@@ -121,7 +188,7 @@
    #;compiler-mode    #;Build})
 
 (def: (init-compiler host)
-  (-> Host Compiler)
+  (-> &&common;Host Compiler)
   {#;info            init-compiler-info
    #;source          [init-cursor ""]
    #;cursor          init-cursor
@@ -147,8 +214,8 @@
 (def: #export (compile-program program target sources)
   (-> &;Path &;Path (List &;Path) (P;Promise Unit))
   (do P;Monad<Promise>
-    [#let [compiler (init-compiler init-host)]
-     _ (or-crash! (&&runtime;compile-runtime []))
+    [#let [compiler (init-compiler (init-host []))]
+     compiler (or-crash! (&&runtime;compile-runtime compiler))
      compiler (or-crash! (compile-module sources prelude compiler))
      compiler (or-crash! (compile-module sources program compiler))
      #let [_ (log! "Compilation complete!")]]
-- 
cgit v1.2.3