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 | |
parent | c50667a431a5ca67328a230f0c59956dc6ff43fa (diff) |
- Renamed the "compilation" phase as the "generation" phase.
- Implemented compilation of primitives.
- Implemented compilation of structures.
Diffstat (limited to 'new-luxc/source/luxc/generator')
-rw-r--r-- | new-luxc/source/luxc/generator/base.jvm.lux | 29 | ||||
-rw-r--r-- | new-luxc/source/luxc/generator/common.jvm.lux | 130 | ||||
-rw-r--r-- | new-luxc/source/luxc/generator/eval.jvm.lux | 89 | ||||
-rw-r--r-- | new-luxc/source/luxc/generator/expr.jvm.lux | 55 | ||||
-rw-r--r-- | new-luxc/source/luxc/generator/primitive.jvm.lux | 44 | ||||
-rw-r--r-- | new-luxc/source/luxc/generator/runtime.jvm.lux | 126 | ||||
-rw-r--r-- | new-luxc/source/luxc/generator/statement.jvm.lux | 25 | ||||
-rw-r--r-- | new-luxc/source/luxc/generator/structure.jvm.lux | 70 |
8 files changed, 568 insertions, 0 deletions
diff --git a/new-luxc/source/luxc/generator/base.jvm.lux b/new-luxc/source/luxc/generator/base.jvm.lux new file mode 100644 index 000000000..01a97aec4 --- /dev/null +++ b/new-luxc/source/luxc/generator/base.jvm.lux @@ -0,0 +1,29 @@ +(;module: + lux + (lux (control monad) + [io #- run] + (concurrency ["A" atom]) + (data [text] + text/format) + host) + (luxc ["&" base])) + +(jvm-import java.lang.Class) +(jvm-import java.lang.ClassLoader) +(jvm-import org.objectweb.asm.MethodVisitor) + +(type: Blob Byte-Array) + +(type: JVM-State + {#visitor (Maybe MethodVisitor) + #loader ClassLoader + #store (A;Atom (D;Dict Text Blob)) + }) + +(def: host-state + JVM-State + (let [store (A;new (D;new text;Hash<Text>))] + {#visitor #;None + #loader (memory-class-loader store) + #store store + })) 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") diff --git a/new-luxc/source/luxc/generator/eval.jvm.lux b/new-luxc/source/luxc/generator/eval.jvm.lux new file mode 100644 index 000000000..5fcf0b288 --- /dev/null +++ b/new-luxc/source/luxc/generator/eval.jvm.lux @@ -0,0 +1,89 @@ +(;module: + lux + (lux (control monad) + (data ["R" result] + text/format) + [macro #+ Monad<Lux> "Lux/" Monad<Lux>] + [host #+ jvm-import do-to]) + (luxc ["&" base] + (lang ["la" analysis] + ["ls" synthesis]) + ["&;" analyser] + ["&;" synthesizer] + (generator ["&;" common]))) + +(jvm-import java.lang.Object) +(jvm-import java.lang.String) + +(jvm-import java.lang.reflect.Field + (get [Object] Object)) + +(jvm-import (java.lang.Class a) + (getField [String] Field)) + +(jvm-import org.objectweb.asm.Opcodes + (#static ACC_PUBLIC int) + (#static ACC_SUPER int) + (#static ACC_FINAL int) + (#static ACC_STATIC int) + (#static PUTSTATIC int) + (#static RETURN int) + (#static V1_6 int) + ) + +(jvm-import org.objectweb.asm.MethodVisitor + (visitCode [] void) + (visitEnd [] void) + (visitLdcInsn [Object] void) + (visitFieldInsn [int String String String] void) + (visitInsn [int] void) + (visitMaxs [int int] void)) + +(jvm-import org.objectweb.asm.FieldVisitor + (visitEnd [] void)) + +(jvm-import org.objectweb.asm.ClassWriter + (#static COMPUTE_MAXS int) + (new [int]) + (visit [int int String String String (Array String)] void) + (visitEnd [] void) + (visitField [int String String String Object] FieldVisitor) + (visitMethod [int String String String (Array String)] MethodVisitor) + (toByteArray [] Byte-Array)) + +(def: (make-field flags name descriptor writer) + (-> &common;Flags Text &common;Descriptor ClassWriter FieldVisitor) + (do-to (ClassWriter.visitField [flags name descriptor (host;null) (host;null)] writer) + (FieldVisitor.visitEnd []))) + +(def: eval-field-name Text "_value") +(def: eval-field-desc Text "Ljava/lang/Object;") + +(def: #export (eval generator) + (-> (Lux Unit) (Lux Top)) + (do Monad<Lux> + [class-name (:: @ map %code (macro;gensym "eval")) + #let [writer (do-to (ClassWriter.new ClassWriter.COMPUTE_MAXS) + (ClassWriter.visit [&common;bytecode-version + (i.+ Opcodes.ACC_PUBLIC Opcodes.ACC_SUPER) + class-name + (host;null) + "java/lang/Object" + (host;null)])) + value-field (make-field ($_ i.+ Opcodes.ACC_PUBLIC Opcodes.ACC_STATIC Opcodes.ACC_FINAL) + eval-field-name eval-field-desc + writer) + visitor (do-to (ClassWriter.visitMethod [Opcodes.ACC_STATIC "<clinit>" "()V" (host;null) (host;null)] writer) + (MethodVisitor.visitCode []))] + _ (&common;with-visitor visitor generator) + #let [_ (do-to visitor + (MethodVisitor.visitFieldInsn [Opcodes.PUTSTATIC class-name eval-field-name eval-field-desc]) + (MethodVisitor.visitInsn [Opcodes.RETURN]) + (MethodVisitor.visitMaxs [0 0]) + (MethodVisitor.visitEnd [])) + bytecode (ClassWriter.toByteArray [] (do-to writer (ClassWriter.visitEnd [])))] + _ (&common;store-class class-name bytecode) + class (&common;load-class class-name)] + (wrap (|> class + (Class.getField [eval-field-name]) + (Field.get (host;null)))))) diff --git a/new-luxc/source/luxc/generator/expr.jvm.lux b/new-luxc/source/luxc/generator/expr.jvm.lux new file mode 100644 index 000000000..4b038378a --- /dev/null +++ b/new-luxc/source/luxc/generator/expr.jvm.lux @@ -0,0 +1,55 @@ +(;module: + lux + (lux (control monad) + (data text/format) + [macro #+ Monad<Lux> "Lux/" Monad<Lux>] + [host #+ jvm-import]) + (luxc ["&" base] + (lang ["la" analysis] + ["ls" synthesis]) + ["&;" analyser] + ["&;" synthesizer] + (generator ["&;" common] + ["&;" primitive] + ["&;" structure]))) + +(def: #export (generate synthesis) + (-> ls;Synthesis (Lux Unit)) + (case synthesis + #ls;Unit + &primitive;generate-unit + + (^template [<tag> <generator>] + (<tag> value) + (<generator> value)) + ([#ls;Bool &primitive;generate-bool] + [#ls;Nat &primitive;generate-nat] + [#ls;Int &primitive;generate-int] + [#ls;Deg &primitive;generate-deg] + [#ls;Real &primitive;generate-real] + [#ls;Char &primitive;generate-char] + [#ls;Text &primitive;generate-text]) + + (#ls;Variant tag tail? member) + (&structure;generate-variant generate tag tail? member) + + (#ls;Tuple members) + (&structure;generate-tuple generate members) + + _ + (macro;fail "Unrecognized synthesis."))) + +## (def: (eval type code) +## &;Eval +## (undefined)) + +## (def: analyse +## &;Analyser +## (&analyser;analyser eval)) + +## (def: #export (generate input) +## (-> Code (Lux Unit)) +## (do Monad<Lux> +## [analysis (analyse input) +## #let [synthesis (&synthesizer;synthesize analysis)]] +## (generate-synthesis synthesis))) diff --git a/new-luxc/source/luxc/generator/primitive.jvm.lux b/new-luxc/source/luxc/generator/primitive.jvm.lux new file mode 100644 index 000000000..2c879dd48 --- /dev/null +++ b/new-luxc/source/luxc/generator/primitive.jvm.lux @@ -0,0 +1,44 @@ +(;module: + lux + (lux (control monad) + (data text/format) + [macro #+ Monad<Lux> "Lux/" Monad<Lux>] + [host #+ jvm-import]) + (luxc ["&" base] + (lang ["la" analysis] + ["ls" synthesis]) + ["&;" analyser] + ["&;" synthesizer] + (generator ["&;" common]))) + +(jvm-import #long java.lang.Object) + +(jvm-import org.objectweb.asm.Opcodes) + +(jvm-import org.objectweb.asm.MethodVisitor + (visitLdcInsn [Object] void)) + +(def: #export generate-unit + (Lux Unit) + (do Monad<Lux> + [visitor &common;get-visitor + #let [_ (MethodVisitor.visitLdcInsn [(:! java.lang.Object &common;unit)] visitor)]] + (wrap []))) + +(do-template [<name> <type> <wrap>] + [(def: #export (<name> value) + (-> <type> (Lux Unit)) + (do Monad<Lux> + [visitor &common;get-visitor + #let [_ (MethodVisitor.visitLdcInsn [(:! java.lang.Object value)] visitor) + _ (<wrap> visitor)]] + (wrap [])))] + + [generate-bool Bool &common;wrap-boolean] + [generate-nat Nat &common;wrap-long] + [generate-int Int &common;wrap-long] + [generate-deg Deg &common;wrap-long] + [generate-real Real &common;wrap-double] + [generate-char Char &common;wrap-char] + [generate-text Text id] + ) diff --git a/new-luxc/source/luxc/generator/runtime.jvm.lux b/new-luxc/source/luxc/generator/runtime.jvm.lux new file mode 100644 index 000000000..e8831d005 --- /dev/null +++ b/new-luxc/source/luxc/generator/runtime.jvm.lux @@ -0,0 +1,126 @@ +(;module: + lux + (lux (control monad) + (data ["R" result] + text/format) + [macro #+ Monad<Lux> "Lux/" Monad<Lux>] + [host #+ jvm-import do-to]) + (luxc ["&" base] + (lang ["la" analysis] + ["ls" synthesis]) + ["&;" analyser] + ["&;" synthesizer] + (generator ["&;" common]))) + +(jvm-import java.lang.Object) +(jvm-import java.lang.String) + +(jvm-import java.lang.reflect.Field + (get [Object] #try Object)) + +(jvm-import (java.lang.Class a) + (getField [String] Field)) + +(type: Flags Int) +(type: Descriptor Text) + +(jvm-import org.objectweb.asm.Opcodes + (#static ACC_PUBLIC int) + (#static ACC_SUPER int) + (#static ACC_FINAL int) + (#static ACC_STATIC int) + (#static DUP int) + (#static PUTSTATIC int) + (#static ILOAD int) + (#static ALOAD int) + (#static ANEWARRAY int) + (#static AASTORE int) + (#static RETURN int) + (#static ARETURN int) + (#static V1_6 int) + ) + +(jvm-import org.objectweb.asm.MethodVisitor + (visitCode [] void) + (visitEnd [] void) + (visitInsn [int] void) + (visitLdcInsn [Object] void) + (visitFieldInsn [int String String String] void) + (visitVarInsn [int int] void) + (visitTypeInsn [int String] void) + (visitMaxs [int int] void)) + +(jvm-import org.objectweb.asm.FieldVisitor + (visitEnd [] void)) + +(jvm-import org.objectweb.asm.ClassWriter + (#static COMPUTE_MAXS int) + (new [int]) + (visit [int int String String String (Array String)] void) + (visitEnd [] void) + (visitField [int String String String Object] FieldVisitor) + (visitMethod [int String String String (Array String)] MethodVisitor) + (toByteArray [] Byte-Array)) + +(def: (generate-adt-methods writer) + (-> ClassWriter ClassWriter) + (let [## I commented-out some parts because a null-check was + ## done to ensure variants were never created with null + ## values (this would interfere later with + ## pattern-matching). + ## Since Lux itself does not have null values as part of + ## the language, the burden of ensuring non-nulls was + ## shifted to library code dealing with host-interop, to + ## ensure variant-making was as fast as possible. + ## The null-checking code was left as comments in case I + ## ever change my mind. + _ (let [## $is-null (new Label) + visitor (ClassWriter.visitMethod [(i.+ Opcodes.ACC_PUBLIC Opcodes.ACC_STATIC) + "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;" + (host;null) (host;null)] + writer) + _ (do-to visitor + (MethodVisitor.visitCode []) + ## (MethodVisitor.visitVarInsn [Opcodes.ALOAD 2]) + ## (MethodVisitor.visitJumpInsn [Opcodes.IFNULL $is-null]) + (MethodVisitor.visitLdcInsn [(host;l2i 3)]) + (MethodVisitor.visitTypeInsn [Opcodes.ANEWARRAY "java/lang/Object"]) + (MethodVisitor.visitInsn [Opcodes.DUP]) + (MethodVisitor.visitLdcInsn [(host;l2i 0)]) + (MethodVisitor.visitVarInsn [Opcodes.ILOAD 0])) + _ (&common;wrap-int visitor) + _ (do-to visitor + (MethodVisitor.visitInsn [Opcodes.AASTORE]) + (MethodVisitor.visitInsn [Opcodes.DUP]) + (MethodVisitor.visitLdcInsn [(host;l2i 1)]) + (MethodVisitor.visitVarInsn [Opcodes.ALOAD 1]) + (MethodVisitor.visitInsn [Opcodes.AASTORE]) + (MethodVisitor.visitInsn [Opcodes.DUP]) + (MethodVisitor.visitLdcInsn [(host;l2i 2)]) + (MethodVisitor.visitVarInsn [Opcodes.ALOAD 2]) + (MethodVisitor.visitInsn [Opcodes.AASTORE]) + (MethodVisitor.visitInsn [Opcodes.ARETURN]) + ## (MethodVisitor.visitLabel [$is-null]) + ## (MethodVisitor.visitTypeInsn [Opcodes.NEW "java/lang/IllegalStateException"]) + ## (MethodVisitor.visitInsn [Opcodes.DUP]) + ## (MethodVisitor.visitLdcInsn ["Cannot create variant for null pointer"]) + ## (MethodVisitor.visitMethodInsn [Opcodes.INVOKESPECIAL "java/lang/IllegalStateException" "<init>" "(Ljava/lang/String;)V"]) + ## (MethodVisitor.visitInsn [Opcodes.ATHROW]) + (MethodVisitor.visitMaxs [0 0]) + (MethodVisitor.visitEnd []))] + [])] + writer)) + +(def: #export generate + (Lux &common;Bytecode) + (do Monad<Lux> + [_ (wrap []) + #let [writer (|> (do-to (ClassWriter.new ClassWriter.COMPUTE_MAXS) + (ClassWriter.visit [&common;bytecode-version + ($_ i.+ Opcodes.ACC_PUBLIC Opcodes.ACC_FINAL Opcodes.ACC_SUPER) + &common;runtime-class-name (host;null) + "java/lang/Object" (host;null)])) + generate-adt-methods) + bytecode (ClassWriter.toByteArray [] (do-to writer (ClassWriter.visitEnd [])))] + _ (&common;store-class &common;runtime-class-name bytecode)] + (wrap bytecode))) diff --git a/new-luxc/source/luxc/generator/statement.jvm.lux b/new-luxc/source/luxc/generator/statement.jvm.lux new file mode 100644 index 000000000..96263181f --- /dev/null +++ b/new-luxc/source/luxc/generator/statement.jvm.lux @@ -0,0 +1,25 @@ +(;module: + lux + (lux (control monad) + [io #- run] + (data [text "T/" Eq<Text>] + text/format) + [macro #+ Monad<Lux>]) + (luxc ["&" base] + ["&;" module] + ["&;" env] + (compiler ["&;" expr]))) + +(def: #export (compile-def def-name def-value def-meta) + (-> Text Code Code (Lux Unit)) + (do Monad<Lux> + [=def-value (&expr;compile def-value) + =def-meta (&expr;compile def-meta)] + (undefined))) + +(def: #export (compile-program prog-args prog-body) + (-> Text Code (Lux Unit)) + (do Monad<Lux> + [=prog-body (&env;with-local [prog-args (type (List Text))] + (&expr;compile prog-body))] + (undefined))) diff --git a/new-luxc/source/luxc/generator/structure.jvm.lux b/new-luxc/source/luxc/generator/structure.jvm.lux new file mode 100644 index 000000000..1584cb170 --- /dev/null +++ b/new-luxc/source/luxc/generator/structure.jvm.lux @@ -0,0 +1,70 @@ +(;module: + lux + (lux (control monad) + (data text/format + (coll [list])) + [macro #+ Monad<Lux> "Lux/" Monad<Lux>] + [host #+ jvm-import do-to]) + (luxc ["&" base] + (lang ["la" analysis] + ["ls" synthesis]) + ["&;" analyser] + ["&;" synthesizer] + (generator ["&;" common]))) + +(jvm-import #long java.lang.Object) + +(jvm-import org.objectweb.asm.Opcodes + (#static ANEWARRAY int) + (#static DUP int) + (#static AASTORE int) + (#static ACONST_NULL int) + (#static INVOKESTATIC int)) + +(jvm-import org.objectweb.asm.MethodVisitor + (visitInsn [int] void) + (visitLdcInsn [Object] void) + (visitTypeInsn [int String] void) + (visitMethodInsn [int String String String boolean] void)) + +(def: #export (generate-tuple generate members) + (-> (-> ls;Synthesis (Lux Unit)) (List ls;Synthesis) (Lux Unit)) + (do Monad<Lux> + [#let [size (list;size members)] + _ (&;assert "Cannot generate tuples with less than 2 elements." + (n.>= +2 size)) + visitor &common;get-visitor + #let [_ (do-to visitor + (MethodVisitor.visitLdcInsn [(|> size nat-to-int host;l2i (:! java.lang.Object))]) + (MethodVisitor.visitTypeInsn [Opcodes.ANEWARRAY "java/lang/Object"]))] + _ (mapM @ (function [[idx member]] + (do @ + [#let [_ (do-to visitor + (MethodVisitor.visitInsn [Opcodes.DUP]) + (MethodVisitor.visitLdcInsn [(|> idx nat-to-int host;l2i (:! java.lang.Object))]))] + _ (generate member) + #let [_ (MethodVisitor.visitInsn [Opcodes.AASTORE] visitor)]] + (wrap []))) + (list;enumerate members))] + (wrap []))) + +(def: (generate-variant-flag tail? visitor) + (-> Bool MethodVisitor MethodVisitor) + (if tail? + (do-to visitor (MethodVisitor.visitLdcInsn [(:! java.lang.Object "")])) + (do-to visitor (MethodVisitor.visitInsn [Opcodes.ACONST_NULL])))) + +(def: #export (generate-variant generate tag tail? member) + (-> (-> ls;Synthesis (Lux Unit)) Nat Bool ls;Synthesis (Lux Unit)) + (do Monad<Lux> + [visitor &common;get-visitor + #let [_ (do-to visitor + (MethodVisitor.visitLdcInsn [(|> tag nat-to-int host;l2i (:! java.lang.Object))])) + _ (generate-variant-flag tail? visitor)] + _ (generate member) + #let [_ (do-to visitor + (MethodVisitor.visitMethodInsn [Opcodes.INVOKESTATIC + &common;runtime-class-name + "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;" + false]))]] + (wrap []))) |