From 9cd2927a4f6175784e081d6b512d3e900c8069e7 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Mon, 12 Jun 2017 21:14:55 -0400
Subject: - Renamed the "compilation" phase as the "generation" phase. -
 Implemented compilation of primitives. - Implemented compilation of
 structures.

---
 new-luxc/source/luxc/generator.lux | 158 +++++++++++++++++++++++++++++++++++++
 1 file changed, 158 insertions(+)
 create mode 100644 new-luxc/source/luxc/generator.lux

(limited to 'new-luxc/source/luxc/generator.lux')

diff --git a/new-luxc/source/luxc/generator.lux b/new-luxc/source/luxc/generator.lux
new file mode 100644
index 000000000..d095023ff
--- /dev/null
+++ b/new-luxc/source/luxc/generator.lux
@@ -0,0 +1,158 @@
+(;module:
+  lux
+  (lux (control monad)
+       (concurrency ["A" atom]
+                    ["P" promise])
+       (data ["R" result]
+             [text "T/" Hash<Text>]
+             text/format
+             (coll ["D" dict]
+                   [array #+ Array]))
+       [macro #+ Monad<Lux>]
+       host
+       [io])
+  (luxc ["&" base]
+        ["&;" io]
+        ["&;" module]
+        ["&;" parser]
+        ["&;" host]
+        (compiler ["&&;" runtime]
+                  ["&&;" statement]
+                  ["&&;" common])
+        ))
+
+(def: (compile ast)
+  (-> Code (Lux Unit))
+  (case ast
+    (^ [_ (#;Form (list [_ (#;Symbol ["" "_lux_def"])]
+                        [_ (#;Symbol ["" def-name])]
+                        def-value
+                        def-meta))])
+    (&&statement;compile-def def-name def-value def-meta)
+
+    (^ [_ (#;Form (list [_ (#;Symbol ["" "_lux_program"])]
+                        [_ (#;Symbol ["" prog-args])]
+                        prog-body))])
+    (&&statement;compile-program prog-args prog-body)
+
+    _
+    (&;fail (format "Unrecognized statement: " (%code ast)))))
+
+(def: (exhaust action)
+  (All [a] (-> (Lux a) (Lux Unit)))
+  (do Monad<Lux>
+    [result action]
+    (exhaust action)))
+
+(def: (ensure-new-module! file-hash module-name)
+  (-> Nat Text (Lux Unit))
+  (do Monad<Lux>
+    [module-exists? (macro;module-exists? module-name)
+     _ (: (Lux Unit)
+          (if module-exists?
+            (&;fail (format "Cannot re-define a module: " module-name))
+            (wrap [])))
+     _ (&module;create file-hash module-name)]
+    (wrap [])))
+
+(def: prelude Text "lux")
+
+(def: (with-active-compilation [module-name file-name source-code] action)
+  (All [a] (-> [Text Text Text] (Lux a) (Lux a)))
+  (do Monad<Lux>
+    [_ (ensure-new-module! (T/hash source-code) module-name)
+     #let [init-cursor [file-name +0 +0]]
+     output (&;with-source-code [init-cursor source-code]
+              action)
+     _ (&module;flag-compiled! module-name)]
+    (wrap output)))
+
+(def: parse
+  (Lux Code)
+  (function [compiler]
+    (case (&parser;parse (get@ #;source compiler))
+      (#R;Error error)
+      (#R;Error error)
+
+      (#R;Success [source' output])
+      (#R;Success [(set@ #;source source' compiler)
+                   output]))))
+
+(def: (compile-module source-dirs module-name compiler)
+  (-> (List &;Path) Text Compiler (P;Promise (R;Result Compiler)))
+  (do P;Monad<Promise>
+    [?input (&io;read-module source-dirs module-name)]
+    (case ?input
+      (#R;Success [file-name file-content])
+      (let [compilation (do Monad<Lux>
+                          [_ (with-active-compilation [module-name
+                                                       file-name
+                                                       file-content]
+                               (exhaust
+                                (do @
+                                  [ast parse]
+                                  (compile ast))))]
+                          (wrap [])
+                          ## (&module;generate-descriptor module-name)
+                          )]
+        (case (macro;run' compiler compilation)
+          (#R;Success [compiler module-descriptor])
+          (do @
+            [## _ (&io;write-module module-name module-descriptor)
+             ]
+            (wrap (#R;Success compiler)))
+          
+          (#R;Error error)
+          (wrap (#R;Error error))))
+
+      (#R;Error error)
+      (wrap (#R;Error error)))))
+
+(jvm-import org.objectweb.asm.MethodVisitor)
+
+(def: init-cursor Cursor ["" +0 +0])
+
+(def: init-type-context
+  Type-Context
+  {#;ex-counter +0
+   #;var-counter +0
+   #;var-bindings (list)})
+
+(def: init-compiler-info
+  Compiler-Info
+  {#;compiler-version &;compiler-version
+   #;compiler-mode    #;Build})
+
+(def: (init-compiler host)
+  (-> &&common;Host Compiler)
+  {#;info            init-compiler-info
+   #;source          [init-cursor ""]
+   #;cursor          init-cursor
+   #;modules         (list)
+   #;scopes          (list)
+   #;type-context    init-type-context
+   #;expected        #;None
+   #;seed            +0
+   #;scope-type-vars (list)
+   #;host            (:! Void host)})
+
+(def: (or-crash! action)
+  (All [a] (-> (P;Promise (R;Result a)) (P;Promise a)))
+  (do P;Monad<Promise>
+    [?output action]
+    (case ?output
+      (#R;Error error)
+      (error! error)
+
+      (#R;Success output)
+      (wrap output))))
+
+(def: #export (compile-program program target sources)
+  (-> &;Path &;Path (List &;Path) (P;Promise Unit))
+  (do P;Monad<Promise>
+    [#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))
+     #let [_ (log! "Compilation complete!")]]
+    (wrap [])))
-- 
cgit v1.2.3