diff options
Diffstat (limited to 'new-luxc/source/luxc/compiler')
-rw-r--r-- | new-luxc/source/luxc/compiler/common.jvm.lux | 65 | ||||
-rw-r--r-- | new-luxc/source/luxc/compiler/expr.jvm.lux | 57 | ||||
-rw-r--r-- | new-luxc/source/luxc/compiler/runtime.jvm.lux | 6 |
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))) |