aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc
diff options
context:
space:
mode:
authorEduardo Julian2017-06-12 21:14:55 -0400
committerEduardo Julian2017-06-12 21:14:55 -0400
commit9cd2927a4f6175784e081d6b512d3e900c8069e7 (patch)
treed1fe512bc84ea1e3a50ad86eeb3265771edd23c6 /new-luxc/source/luxc
parentc50667a431a5ca67328a230f0c59956dc6ff43fa (diff)
- Renamed the "compilation" phase as the "generation" phase.
- Implemented compilation of primitives. - Implemented compilation of structures.
Diffstat (limited to 'new-luxc/source/luxc')
-rw-r--r--new-luxc/source/luxc/base.lux8
-rw-r--r--new-luxc/source/luxc/compiler/common.jvm.lux65
-rw-r--r--new-luxc/source/luxc/compiler/expr.jvm.lux62
-rw-r--r--new-luxc/source/luxc/compiler/runtime.jvm.lux11
-rw-r--r--new-luxc/source/luxc/generator.lux (renamed from new-luxc/source/luxc/compiler.lux)70
-rw-r--r--new-luxc/source/luxc/generator/base.jvm.lux (renamed from new-luxc/source/luxc/compiler/base.jvm.lux)0
-rw-r--r--new-luxc/source/luxc/generator/common.jvm.lux130
-rw-r--r--new-luxc/source/luxc/generator/eval.jvm.lux89
-rw-r--r--new-luxc/source/luxc/generator/expr.jvm.lux55
-rw-r--r--new-luxc/source/luxc/generator/primitive.jvm.lux44
-rw-r--r--new-luxc/source/luxc/generator/runtime.jvm.lux126
-rw-r--r--new-luxc/source/luxc/generator/statement.jvm.lux (renamed from new-luxc/source/luxc/compiler/statement.jvm.lux)0
-rw-r--r--new-luxc/source/luxc/generator/structure.jvm.lux70
-rw-r--r--new-luxc/source/luxc/host.jvm.lux86
14 files changed, 611 insertions, 205 deletions
diff --git a/new-luxc/source/luxc/base.lux b/new-luxc/source/luxc/base.lux
index abd154190..bf9368abe 100644
--- a/new-luxc/source/luxc/base.lux
+++ b/new-luxc/source/luxc/base.lux
@@ -22,6 +22,8 @@
#Eval
#REPL)
+(def: #export compiler-version Text "0.6.0")
+
(def: #export (fail message)
(All [a] (-> Text (Lux a)))
(do Monad<Lux>
@@ -32,6 +34,12 @@
(macro;fail (format "@ " location
"\n" message))))
+(def: #export (assert message test)
+ (-> Text Bool (Lux Unit))
+ (if test
+ (:: Monad<Lux> wrap [])
+ (fail message)))
+
(def: #export (with-expected-type expected action)
(All [a] (-> Type (Lux a) (Lux a)))
(function [compiler]
diff --git a/new-luxc/source/luxc/compiler/common.jvm.lux b/new-luxc/source/luxc/compiler/common.jvm.lux
deleted file mode 100644
index bd5487ef6..000000000
--- a/new-luxc/source/luxc/compiler/common.jvm.lux
+++ /dev/null
@@ -1,65 +0,0 @@
-(;module:
- lux
- (lux (concurrency ["A" atom])
- (data ["R" result]
- (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)
- (-> (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]))))
diff --git a/new-luxc/source/luxc/compiler/expr.jvm.lux b/new-luxc/source/luxc/compiler/expr.jvm.lux
deleted file mode 100644
index b2e4923c4..000000000
--- a/new-luxc/source/luxc/compiler/expr.jvm.lux
+++ /dev/null
@@ -1,62 +0,0 @@
-(;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]
- (compiler ["&;" common])))
-
-(jvm-import #long java.lang.Object)
-
-(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)
- (-> 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
- (undefined))
-
-(def: analyse
- &;Analyser
- (&analyser;analyser eval))
-
-(def: #export (compile input)
- (-> Code (Lux &common;Compiled))
- (do Monad<Lux>
- [analysis (analyse 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
deleted file mode 100644
index 16e072194..000000000
--- a/new-luxc/source/luxc/compiler/runtime.jvm.lux
+++ /dev/null
@@ -1,11 +0,0 @@
-(;module:
- lux
- (lux (control monad)
- (concurrency ["P" promise "P/" Monad<Promise>])
- (data text/format
- ["R" result]))
- (luxc ["&" base]))
-
-(def: #export (compile-runtime compiler)
- (-> Compiler (P;Promise (R;Result Compiler)))
- (P/wrap (#R;Success compiler)))
diff --git a/new-luxc/source/luxc/compiler.lux b/new-luxc/source/luxc/generator.lux
index 55fe3c738..d095023ff 100644
--- a/new-luxc/source/luxc/compiler.lux
+++ b/new-luxc/source/luxc/generator.lux
@@ -15,6 +15,7 @@
["&;" io]
["&;" module]
["&;" parser]
+ ["&;" host]
(compiler ["&&;" runtime]
["&&;" statement]
["&&;" common])
@@ -109,69 +110,6 @@
(jvm-import org.objectweb.asm.MethodVisitor)
-(jvm-import java.lang.reflect.AccessibleObject
- (setAccessible [boolean] void))
-
-(jvm-import java.lang.reflect.Method
- (invoke [Object (Array Object)] #try Object))
-
-(jvm-import (java.lang.Class a)
- (getDeclaredMethod [String (Array (Class Object))] #try Method))
-
-(jvm-import java.lang.Object
- (getClass [] (Class Object)))
-
-(jvm-import java.lang.Integer
- (#static TYPE (Class Integer)))
-
-(jvm-import java.lang.ClassLoader)
-
-(def: ClassLoader::defineClass
- Method
- (case (Class.getDeclaredMethod ["defineClass"
- (|> (array (Class Object) +4)
- (array-store +0 (:! (Class Object) (class-for String)))
- (array-store +1 (Object.getClass [] (array byte +0)))
- (array-store +2 (:! (Class Object) Integer.TYPE))
- (array-store +3 (:! (Class Object) Integer.TYPE)))]
- (class-for java.lang.ClassLoader))
- (#R;Success method)
- (do-to method
- (AccessibleObject.setAccessible [true]))
-
- (#R;Error error)
- (error! error)))
-
-(def: (memory-class-loader store)
- (-> &&common;Class-Store ClassLoader)
- (object ClassLoader []
- []
- (ClassLoader (findClass [class-name String]) void
- (case (|> store A;get io;run (D;get class-name))
- (#;Some bytecode)
- (case (Method.invoke [(:! Object _jvm_this)
- (array;from-list (list (:! Object class-name)
- (:! Object bytecode)
- (:! Object (l2i 0))
- (:! Object (l2i (nat-to-int (array-length bytecode))))))]
- ClassLoader::defineClass)
- (#R;Success output)
- []
-
- (#R;Error error)
- (error! error))
-
- _
- (error! (format "Unknown class: " class-name))))))
-
-(def: (init-host _)
- (-> Top &&common;Host)
- (let [store (: &&common;Class-Store
- (A;atom (D;new text;Hash<Text>)))]
- {#&&common;visitor #;None
- #&&common;loader (memory-class-loader store)
- #&&common;store store}))
-
(def: init-cursor Cursor ["" +0 +0])
(def: init-type-context
@@ -180,11 +118,9 @@
#;var-counter +0
#;var-bindings (list)})
-(def: compiler-version Text "0.6.0")
-
(def: init-compiler-info
Compiler-Info
- {#;compiler-version compiler-version
+ {#;compiler-version &;compiler-version
#;compiler-mode #;Build})
(def: (init-compiler host)
@@ -214,7 +150,7 @@
(def: #export (compile-program program target sources)
(-> &;Path &;Path (List &;Path) (P;Promise Unit))
(do P;Monad<Promise>
- [#let [compiler (init-compiler (init-host []))]
+ [#let [compiler (init-compiler (&host;init-host []))]
compiler (or-crash! (&&runtime;compile-runtime compiler))
compiler (or-crash! (compile-module sources prelude compiler))
compiler (or-crash! (compile-module sources program compiler))
diff --git a/new-luxc/source/luxc/compiler/base.jvm.lux b/new-luxc/source/luxc/generator/base.jvm.lux
index 01a97aec4..01a97aec4 100644
--- a/new-luxc/source/luxc/compiler/base.jvm.lux
+++ b/new-luxc/source/luxc/generator/base.jvm.lux
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/compiler/statement.jvm.lux b/new-luxc/source/luxc/generator/statement.jvm.lux
index 96263181f..96263181f 100644
--- a/new-luxc/source/luxc/compiler/statement.jvm.lux
+++ b/new-luxc/source/luxc/generator/statement.jvm.lux
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 [])))
diff --git a/new-luxc/source/luxc/host.jvm.lux b/new-luxc/source/luxc/host.jvm.lux
new file mode 100644
index 000000000..c46e1cf1f
--- /dev/null
+++ b/new-luxc/source/luxc/host.jvm.lux
@@ -0,0 +1,86 @@
+(;module:
+ lux
+ (lux (control monad)
+ (concurrency ["A" atom])
+ (data ["R" result]
+ [text]
+ text/format
+ (coll ["d" dict]
+ [array #+ Array]))
+ [macro #+ Monad<Lux>]
+ host
+ [io])
+ (luxc ["&" base]
+ (generator ["&&;" common])
+ ))
+
+(jvm-import java.lang.reflect.AccessibleObject
+ (setAccessible [boolean] void))
+
+(jvm-import java.lang.reflect.Method
+ (invoke [Object (Array Object)] #try Object))
+
+(jvm-import (java.lang.Class a)
+ (getDeclaredMethod [String (Array (Class Object))] #try Method))
+
+(jvm-import java.lang.Object
+ (getClass [] (Class Object)))
+
+(jvm-import java.lang.Integer
+ (#static TYPE (Class Integer)))
+
+(jvm-import java.lang.ClassLoader)
+
+(def: ClassLoader::defineClass
+ Method
+ (case (Class.getDeclaredMethod ["defineClass"
+ (|> (array (Class Object) +4)
+ (array-store +0 (:! (Class Object) (class-for String)))
+ (array-store +1 (Object.getClass [] (array byte +0)))
+ (array-store +2 (:! (Class Object) Integer.TYPE))
+ (array-store +3 (:! (Class Object) Integer.TYPE)))]
+ (class-for java.lang.ClassLoader))
+ (#R;Success method)
+ (do-to method
+ (AccessibleObject.setAccessible [true]))
+
+ (#R;Error error)
+ (error! error)))
+
+(def: (define-class class-name byte-code loader)
+ (-> Text &&common;Bytecode ClassLoader (R;Result Object))
+ (Method.invoke [loader
+ (array;from-list (list (:! Object class-name)
+ (:! Object byte-code)
+ (:! Object (l2i 0))
+ (:! Object (l2i (nat-to-int (array-length byte-code))))))]
+ ClassLoader::defineClass))
+
+(def: (fetch-byte-code class-name store)
+ (-> Text &&common;Class-Store &&common;Bytecode)
+ (|> store A;get io;run (d;get class-name) assume))
+
+(def: (assume!! input)
+ (All [a] (-> (R;Result a) a))
+ (case input
+ (#R;Success output)
+ output
+
+ (#R;Error error)
+ (error! error)))
+
+(def: (memory-class-loader store)
+ (-> &&common;Class-Store ClassLoader)
+ (object ClassLoader []
+ []
+ (ClassLoader (findClass [class-name String]) Class
+ (:!! (assume!! (define-class class-name (fetch-byte-code class-name store) (:! ClassLoader _jvm_this))))
+ )))
+
+(def: #export (init-host _)
+ (-> Top &&common;Host)
+ (let [store (: &&common;Class-Store
+ (A;atom (d;new text;Hash<Text>)))]
+ {#&&common;visitor #;None
+ #&&common;loader (memory-class-loader store)
+ #&&common;store store}))