- WIP: Some initial implementations for some re-written infrastructure.

5 files changed, 184 insertions, 0 deletions

diff --git a/new-luxc/source/luxc/compiler.lux b/new-luxc/source/luxc/compiler.lux
new file mode 100644
index 000000000..205c62df0
--- /dev/null
+++ b/new-luxc/source/luxc/compiler.lux
@@ -0,0 +1,95 @@
+(;module:
+  lux
+  (lux (control monad)
+       [io #- run]
+       (data ["E" error]
+             [text "T/" Eq<Text>]
+             text/format)
+       [macro #+ Monad<Lux>])
+  (luxc ["&" base]
+        ["&;" io]
+        ["&;" module]
+        (compiler ["&&;" runtime]
+                  ["&&;" statement])
+        ))
+
+(def: (compile ast)
+  (-> AST (Lux Unit))
+  (case ast
+    (^ [_ (#;FormS (list [_ (#;SymbolS ["" "_lux_def"])]
+                         [_ (#;SymbolS ["" def-name])]
+                         def-value
+                         def-meta))])
+    (&&statement;compile-def def-name def-value def-meta)
+
+    (^ [_ (#;FormS (list [_ (#;SymbolS ["" "_lux_program"])]
+                         [_ (#;SymbolS ["" prog-args])]
+                         prog-body))])
+    (&&statement;compile-program prog-args prog-body)
+
+    _
+    (&;fail (format "Unrecognized statement: " (%ast ast)))))
+
+(def: (exhaust action)
+  (All [a] (-> (Lux a) (Lux Unit)))
+  (do Monad<Lux>
+    [result action]
+    (exhaust action)))
+
+(def: (compile-module source-dirs module-name compiler-state)
+  (-> (List &;Path) Text Compiler (IO (Error Compiler)))
+  (do Monad<IO>
+    [[file-name file-content] (&io;read-module source-dirs module-name)
+     #let [file-hash (T/hash file-content)]
+     #let [result (macro;run compiler-state
+                             (do Monad<Lux>
+                               [module-exists? (&module;exists? module-name)]
+                               (if module-exists?
+                                 (&;fail (format "Cannot re-define a module: " module-name))
+                                 (wrap []))))]]
+    (case result
+      (#E;Success [compiler-state _])
+      (let [result (macro;run compiler-state
+                              (do Monad<Lux>
+                                [_ (&module;create module-name file-hash)
+                                 _ (&module;flag-active module-name)
+                                 _ (if (T/= "lux" module-name)
+                                     &&runtime;compile-runtime
+                                     (wrap []))
+                                 _ (exhaust
+                                    (do @
+                                      [ast parse]
+                                      (compile ast)))
+                                 _ (&module;flag-compiled module-name)]
+                                (&module;generate-module file-hash module-name)))]
+        (case result
+          (#E;Success [compiler-state module-descriptor])
+          (do @
+            [_ (&io;write-module module-name module-descriptor)]
+            (wrap (#E;Success compiler-state)))
+
+          (#E;Error error)
+          (wrap (#E;Error error))))
+      
+      (#E;Error error)
+      (wrap (#E;Error error)))))
+
+(def: (or-crash! action)
+  (All [a] (-> (IO (E;Error a)) (IO a)))
+  (do Monad<IO>
+    [result action]
+    (case result
+      (#E;Success output)
+      (wrap output)
+
+      (#E;Error error)
+      (error! (format "Compilation failed:\n" error)))))
+
+(def: #export (compile-program mode program target sources)
+  (-> &;Mode &;Path &;Path (List &;Path) (IO Unit))
+  (do Monad<IO>
+    [#let [compiler-state (init-compiler-state mode host-state)]
+     compiler-state (or-crash! (compile-module source-dirs "lux" compiler-state))
+     compiler-state (or-crash! (compile-module source-dirs program compiler-state))
+     #let [_ (log! "Compilation complete!")]]
+    (wrap [])))
diff --git a/new-luxc/source/luxc/compiler/base.jvm.lux b/new-luxc/source/luxc/compiler/base.jvm.lux
new file mode 100644
index 000000000..f5784319a
--- /dev/null
+++ b/new-luxc/source/luxc/compiler/base.jvm.lux
@@ -0,0 +1,30 @@
+(;module:
+  lux
+  (lux (control monad)
+       [io #- run]
+       (concurrency ["A" atom])
+       (data ["E" error]
+             [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/compiler/expr.jvm.lux b/new-luxc/source/luxc/compiler/expr.jvm.lux
new file mode 100644
index 000000000..6655abd5f
--- /dev/null
+++ b/new-luxc/source/luxc/compiler/expr.jvm.lux
@@ -0,0 +1,27 @@
+(;module:
+  lux
+  (lux (control monad)
+       (data text/format)
+       [macro #+ Monad<Lux>])
+  (luxc ["&" base]
+        ["&;" module]
+        ["&;" env]
+        ["&;" analyser]
+        ["&;" synthesizer #+ Synthesis]))
+
+(type: #export JVM-Bytecode
+  Void)
+
+(type: Compiled
+  JVM-Bytecode)
+
+(def: (compile-synthesis synthesis)
+  (-> Synthesis Compiled)
+  (undefined))
+
+(def: #export (compile input)
+  (-> AST (Lux Compiled))
+  (|> input
+      &analyser;analyse
+      (Lux/map &synthesizer;synthesize)
+      (Lux/map compile-synthesis)))
diff --git a/new-luxc/source/luxc/compiler/runtime.jvm.lux b/new-luxc/source/luxc/compiler/runtime.jvm.lux
new file mode 100644
index 000000000..2d48b3617
--- /dev/null
+++ b/new-luxc/source/luxc/compiler/runtime.jvm.lux
@@ -0,0 +1,6 @@
+(;module:
+  lux
+  (lux (control monad)
+       (data text/format))
+  (luxc ["&" base]))
+
diff --git a/new-luxc/source/luxc/compiler/statement.jvm.lux b/new-luxc/source/luxc/compiler/statement.jvm.lux
new file mode 100644
index 000000000..c4c23746e
--- /dev/null
+++ b/new-luxc/source/luxc/compiler/statement.jvm.lux
@@ -0,0 +1,26 @@
+(;module:
+  lux
+  (lux (control monad)
+       [io #- run]
+       (data ["E" error]
+             [text "T/" Eq<Text>]
+             text/format)
+       [macro #+ Monad<Lux>])
+  (luxc ["&" base]
+        ["&;" module]
+        ["&;" env]
+        (compiler ["&;" expr])))
+
+(def: (compile-def def-name def-value def-meta)
+  (-> Text AST AST (Lux Unit))
+  (do Monad<Lux>
+    [=def-value (&expr;compile def-value)
+     =def-meta (&expr;compile def-meta)]
+    (undefined)))
+
+(def: (compile-program prog-args prog-body)
+  (-> Text AST (Lux Unit))
+  (do Monad<Lux>
+    [=prog-body (&env;with-local [prog-args (type (List Text))]
+                                 (&expr;compile prog-body))]
+    (undefined)))