- Added tests for some kinds of analysis.

- WIP: Porting more code.

4 files changed, 187 insertions, 28 deletions

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!")]]
diff --git a/new-luxc/source/luxc/compiler/common.jvm.lux b/new-luxc/source/luxc/compiler/common.jvm.lux
new file mode 100644
index 000000000..d7abc1ff1
--- /dev/null
+++ b/new-luxc/source/luxc/compiler/common.jvm.lux
@@ -0,0 +1,65 @@
+(;module:
+  lux
+  (lux (concurrency ["A" atom])
+       (data ["E" error]
+             (coll ["D" dict]))
+       [macro]
+       [host #+ jvm-import]))
+
+## [Host]
+(jvm-import org.objectweb.asm.MethodVisitor
+  (visitLdcInsn [Object] void))
+
+(jvm-import java.lang.ClassLoader)
+
+## [Types]
+(type: #export Compiled
+  Unit)
+
+(type: #export Blob host;Byte-Array)
+
+(type: #export Class-Store (A;Atom (D;Dict Text Blob)))
+
+(type: #export Host
+  {#visitor (Maybe MethodVisitor)
+   #loader ClassLoader
+   #store Class-Store})
+
+(def: #export unit-value Text "\u0000unit\u0000")
+
+(def: (visitor::get compiler)
+  (-> Compiler (Maybe MethodVisitor))
+  (|> (get@ #;host compiler)
+      (:! Host)
+      (get@ #visitor)))
+
+(def: (visitor::put visitor compiler)
+  (-> MethodVisitor Compiler Compiler)
+  (update@ #;host
+           (function [host]
+             (|> host
+                 (:! Host)
+                 (set@ #visitor (#;Some visitor))
+                 (:! Void)))
+           compiler))
+
+(def: #export get-visitor
+  (Lux MethodVisitor)
+  (function [compiler]
+    (case (visitor::get compiler)
+      #;None
+      (#E;Error "No visitor has been set.")
+
+      (#;Some visitor)
+      (#E;Success [compiler visitor]))))
+
+(def: #export (with-visitor visitor body)
+  (All [a] (-> MethodVisitor (Lux a) (Lux a)))
+  (function [compiler]
+    (case (macro;run' (visitor::put visitor compiler) body)
+      (#E;Error error)
+      (#E;Error error)
+
+      (#E;Success [compiler' output])
+      (#E;Success [(visitor::put (visitor::get compiler) compiler')
+                   output]))))
diff --git a/new-luxc/source/luxc/compiler/expr.jvm.lux b/new-luxc/source/luxc/compiler/expr.jvm.lux
index f0508c0d2..33a41541b 100644
--- a/new-luxc/source/luxc/compiler/expr.jvm.lux
+++ b/new-luxc/source/luxc/compiler/expr.jvm.lux
@@ -2,29 +2,56 @@
   lux
   (lux (control monad)
        (data text/format)
-       [macro #+ Monad<Lux> "Lux/" Monad<Lux>])
+       [macro #+ Monad<Lux> "Lux/" Monad<Lux>]
+       [host #+ jvm-import])
   (luxc ["&" base]
-        lang
+        (lang ["ls" synthesis])
         ["&;" analyser]
-        ["&;" synthesizer]))
+        ["&;" synthesizer]
+        (compiler ["&;" common])))
 
-(type: #export JVM-Bytecode
-  Void)
+(jvm-import #long java.lang.Object)
 
-(type: #export Compiled
-  JVM-Bytecode)
+(jvm-import org.objectweb.asm.Opcodes)
+
+(jvm-import org.objectweb.asm.MethodVisitor
+  (visitLdcInsn [Object] void))
+
+(def: unit-value Text "\u0000unit\u0000")
+
+(def: (compiler-literal value)
+  (-> Top (Lux &common;Compiled))
+  (do Monad<Lux>
+    [visitor &common;get-visitor
+     #let [_ (MethodVisitor.visitLdcInsn [(:! java.lang.Object value)])]]
+    (wrap [])))
 
 (def: (compile-synthesis synthesis)
-  (-> Synthesis Compiled)
-  (undefined))
+  (-> ls;Synthesis (Lux &common;Compiled))
+  (case synthesis
+    #ls;Unit
+    (compiler-literal &common;unit-value)
+
+    (^template [<tag>]
+      (<tag> value)
+      (compiler-literal value))
+    ([#ls;Bool]
+     [#ls;Nat]
+     [#ls;Int]
+     [#ls;Deg]
+     [#ls;Real]
+     [#ls;Char]
+     [#ls;Text])
+    
+    _
+    (macro;fail "Unrecognized synthesis.")))
 
 (def: (eval type code)
-  Eval
+  &;Eval
   (undefined))
 
 (def: #export (compile input)
-  (-> Code (Lux Compiled))
-  (|> input
-      (&analyser;analyse eval)
-      (Lux/map &synthesizer;synthesize)
-      (Lux/map compile-synthesis)))
+  (-> Code (Lux &common;Compiled))
+  (do Monad<Lux>
+    [analysis (&analyser;analyse eval input)]
+    (compile-synthesis (&synthesizer;synthesize analysis))))
diff --git a/new-luxc/source/luxc/compiler/runtime.jvm.lux b/new-luxc/source/luxc/compiler/runtime.jvm.lux
index b6cebb193..4a5e44785 100644
--- a/new-luxc/source/luxc/compiler/runtime.jvm.lux
+++ b/new-luxc/source/luxc/compiler/runtime.jvm.lux
@@ -6,6 +6,6 @@
              ["E" error]))
   (luxc ["&" base]))
 
-(def: #export (compile-runtime _)
-  (-> Top (P;Promise (E;Error Unit)))
-  (P/wrap (#E;Success [])))
+(def: #export (compile-runtime compiler)
+  (-> Compiler (P;Promise (E;Error Compiler)))
+  (P/wrap (#E;Success compiler)))