aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/compiler')
-rw-r--r--new-luxc/source/luxc/compiler/common.jvm.lux65
-rw-r--r--new-luxc/source/luxc/compiler/expr.jvm.lux57
-rw-r--r--new-luxc/source/luxc/compiler/runtime.jvm.lux6
3 files changed, 110 insertions, 18 deletions
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)))