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/common.jvm.lux  | 65 +++++++++++++++++++++++++++
 new-luxc/source/luxc/compiler/expr.jvm.lux    | 57 ++++++++++++++++-------
 new-luxc/source/luxc/compiler/runtime.jvm.lux |  6 +--
 3 files changed, 110 insertions(+), 18 deletions(-)
 create mode 100644 new-luxc/source/luxc/compiler/common.jvm.lux

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

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)))
-- 
cgit v1.2.3