diff options
author | Eduardo Julian | 2017-06-12 21:14:55 -0400 |
---|---|---|
committer | Eduardo Julian | 2017-06-12 21:14:55 -0400 |
commit | 9cd2927a4f6175784e081d6b512d3e900c8069e7 (patch) | |
tree | d1fe512bc84ea1e3a50ad86eeb3265771edd23c6 /new-luxc/source/luxc/generator/common.jvm.lux | |
parent | c50667a431a5ca67328a230f0c59956dc6ff43fa (diff) |
- Renamed the "compilation" phase as the "generation" phase.
- Implemented compilation of primitives.
- Implemented compilation of structures.
Diffstat (limited to '')
-rw-r--r-- | new-luxc/source/luxc/generator/common.jvm.lux | 130 |
1 files changed, 130 insertions, 0 deletions
diff --git a/new-luxc/source/luxc/generator/common.jvm.lux b/new-luxc/source/luxc/generator/common.jvm.lux new file mode 100644 index 000000000..e5d3552c4 --- /dev/null +++ b/new-luxc/source/luxc/generator/common.jvm.lux @@ -0,0 +1,130 @@ +(;module: + lux + (lux [io] + (concurrency ["A" atom]) + (data ["R" result] + (coll ["d" dict]) + text/format) + [macro #+ Monad<Lux>] + [host #+ jvm-import do-to])) + +## [Host] +(jvm-import org.objectweb.asm.Opcodes + (#static V1_6 int) + (#static CHECKCAST int) + (#static INVOKESTATIC int) + (#static INVOKEVIRTUAL int)) + +(jvm-import org.objectweb.asm.MethodVisitor + (visitLdcInsn [Object] void) + (visitTypeInsn [int String] void) + (visitMethodInsn [int String String String boolean] void)) + +(jvm-import java.lang.Object + (toString [] String)) + +(jvm-import (java.lang.Class a)) + +(jvm-import java.lang.ClassLoader + (loadClass [String] (Class Object))) + +## [Types] +(type: #export Bytecode host;Byte-Array) + +(type: #export Class-Store (A;Atom (d;Dict Text Bytecode))) + +(type: #export Host + {#visitor (Maybe MethodVisitor) + #loader ClassLoader + #store Class-Store}) + +(def: #export unit Text "\u0000") + +(def: (visitor::get compiler) + (-> Compiler (Maybe MethodVisitor)) + (|> (get@ #;host compiler) + (:! Host) + (get@ #visitor))) + +(def: (visitor::put ?visitor compiler) + (-> (Maybe MethodVisitor) Compiler Compiler) + (update@ #;host + (function [host] + (|> host + (:! Host) + (set@ #visitor ?visitor) + (:! Void))) + compiler)) + +(def: #export get-visitor + (Lux MethodVisitor) + (function [compiler] + (case (visitor::get compiler) + #;None + (#R;Error "No visitor has been set.") + + (#;Some visitor) + (#R;Success [compiler visitor])))) + +(def: #export (with-visitor visitor body) + (All [a] (-> MethodVisitor (Lux a) (Lux a))) + (function [compiler] + (case (macro;run' (visitor::put (#;Some visitor) compiler) body) + (#R;Error error) + (#R;Error error) + + (#R;Success [compiler' output]) + (#R;Success [(visitor::put (visitor::get compiler) compiler') + output])))) + +(def: #export (store-class name byte-code) + (-> Text Bytecode (Lux Unit)) + (function [compiler] + (let [store (|> (get@ #;host compiler) + (:! Host) + (get@ #store))] + (if (d;contains? name (|> store A;get io;run)) + (#R;Error (format "Cannot store class that already exists: " name)) + (#R;Success [compiler (io;run (A;update (d;put name byte-code) store))]) + )))) + +(def: #export (load-class name) + (-> Text (Lux (Class Object))) + (function [compiler] + (let [host (:! Host (get@ #;host compiler)) + store (|> host (get@ #store) A;get io;run)] + (if (d;contains? name store) + (#R;Success [compiler (ClassLoader.loadClass [name] (get@ #loader host))]) + (#R;Error (format "Unknown class: " name)))))) + + +(do-template [<wrap> <unwrap> <class> <unwrap-method> <prim> <dup>] + [(def: #export (<wrap> writer) + (-> MethodVisitor MethodVisitor) + (do-to writer + (MethodVisitor.visitMethodInsn [Opcodes.INVOKESTATIC + <class> "valueOf" (format "(" <prim> ")" "L" <class> ";") + false]))) + (def: #export (<unwrap> writer) + (-> MethodVisitor MethodVisitor) + (do-to writer + (MethodVisitor.visitTypeInsn [Opcodes.CHECKCAST <class>]) + (MethodVisitor.visitMethodInsn [Opcodes.INVOKEVIRTUAL + <class> <unwrap-method> (format "()" <prim>) + false])))] + + [wrap-boolean unwrap-boolean "java/lang/Boolean" "booleanValue" "Z" Opcodes.DUP_X1] + [wrap-byte unwrap-byte "java/lang/Byte" "byteValue" "B" Opcodes.DUP_X1] + [wrap-short unwrap-short "java/lang/Short" "shortValue" "S" Opcodes.DUP_X1] + [wrap-int unwrap-int "java/lang/Integer" "intValue" "I" Opcodes.DUP_X1] + [wrap-long unwrap-long "java/lang/Long" "longValue" "J" Opcodes.DUP_X2] + [wrap-float unwrap-float "java/lang/Float" "floatValue" "F" Opcodes.DUP_X1] + [wrap-double unwrap-double "java/lang/Double" "doubleValue" "D" Opcodes.DUP_X2] + [wrap-char unwrap-char "java/lang/Character" "charValue" "C" Opcodes.DUP_X1] + ) + +(type: #export Flags Int) +(type: #export Descriptor Text) + +(def: #export bytecode-version Flags Opcodes.V1_6) +(def: #export runtime-class-name Text "LuxRT") |