- More refactorings.

- Changed the place where module-compilation-state was being stored.
- No longer keeping the compiler's name as part of the compiler's state.

7 files changed, 98 insertions, 101 deletions

diff --git a/luxc/src/lux/analyser.clj b/luxc/src/lux/analyser.clj
index 614bc0a34..50edefac4 100644
--- a/luxc/src/lux/analyser.clj
+++ b/luxc/src/lux/analyser.clj
@@ -59,7 +59,8 @@
 (defn ^:private analyse-ast [optimize eval! compile-module compilers exo-type ?token]
   (|let [analyse (partial analyse-ast optimize eval! compile-module compilers)
          [cursor token] ?token
-         [compile-def compile-program compile-class compile-interface] compilers]
+         compile-def (aget compilers 0)
+         compile-program (aget compilers 1)]
     (|case token
       ;; Standard special forms
       (&/$BoolS ?value)
diff --git a/luxc/src/lux/analyser/lux.clj b/luxc/src/lux/analyser/lux.clj
index 5f3626900..27f4ee11e 100644
--- a/luxc/src/lux/analyser/lux.clj
+++ b/luxc/src/lux/analyser/lux.clj
@@ -560,7 +560,7 @@
         module-name &/get-module-name
         ? (&&module/defined? module-name ?name)]
     (if ?
-      (&/fail-with-loc (str "[Analyser Error] Can't redefine " (str module-name ";" ?name)))
+      (&/fail-with-loc (str "[Analyser Error] Can't re-define " (str module-name ";" ?name)))
       (|do [=value (&/without-repl-closure
                     (&/with-scope ?name
                       (&&/analyse-1+ analyse ?value)))
@@ -572,24 +572,23 @@
         (return &/$Nil))
       )))
 
-(defn ^:private merge-hosts
+(defn ^:private merge-module-states
   "(-> Host Host Host)"
   [new old]
-  (|let [merged-module-states (&/fold (fn [total m-state]
-                                        (|let [[_name _state] m-state]
-                                          (|case _state
-                                            (&/$Cached)
-                                            (&/|put _name _state total)
+  (|let [merged-module-states (&/fold (fn [total new-module]
+                                        (|let [[_name _module] new-module]
+                                          (|case (&/get$ &&module/$module-state _module)
+                                            (&&module/$Cached)
+                                            (&/|put _name _module total)
                                             
-                                            (&/$Compiled)
-                                            (&/|put _name _state total)
+                                            (&&module/$Compiled)
+                                            (&/|put _name _module total)
 
                                             _
                                             total)))
-                                      (&/get$ &/$module-states old)
-                                      (&/get$ &/$module-states new))]
-    (->> old
-         (&/set$ &/$module-states merged-module-states))))
+                                      (&/get$ &/$modules old)
+                                      (&/get$ &/$modules new))]
+    (&/set$ &/$modules merged-module-states old)))
 
 (defn ^:private merge-modules
   "(-> Text Module Module Module)"
@@ -618,8 +617,7 @@
                                          (&/get$ &/$modules old)))
        (&/set$ &/$seed (max (&/get$ &/$seed new)
                             (&/get$ &/$seed old)))
-       (&/set$ &/$host (merge-hosts (&/get$ &/$host new)
-                                    (&/get$ &/$host old)))))
+       (merge-module-states new)))
 
 (def ^:private get-compiler
   (fn [compiler]
@@ -645,7 +643,7 @@
                                         (&/fail-with-loc (str "[Analyser Error] Module can't import itself: " path))
                                         (return nil))
                                     already-compiled? (&&module/exists? path)
-                                    active? (&/active-module? path)
+                                    active? (&&module/active-module? path)
                                     _ (&/assert! (not active?)
                                                  (str "[Analyser Error] Can't import a module that is mid-compilation: " path " @ " current-module))
                                     _ (&&module/add-import path)
diff --git a/luxc/src/lux/analyser/module.clj b/luxc/src/lux/analyser/module.clj
index 3ccb887ff..9df1054c8 100644
--- a/luxc/src/lux/analyser/module.clj
+++ b/luxc/src/lux/analyser/module.clj
@@ -4,13 +4,20 @@
                      [template :refer [do-template]])
             clojure.core.match
             clojure.core.match.array
-            (lux [base :as & :refer [deftuple |let |do return return* |case]]
+            (lux [base :as & :refer [defvariant deftuple |let |do return return* |case]]
                  [type :as &type]
                  [host :as &host])
             [lux.host.generics :as &host-generics]
             (lux.analyser [meta :as &meta])))
 
 ;; [Utils]
+;; ModuleState
+(defvariant
+  ("Active" 0)
+  ("Compiled" 0)
+  ("Cached" 0))
+
+;; Module
 (deftuple
   ["module-hash"
    "module-aliases"
@@ -18,7 +25,8 @@
    "imports"
    "tags"
    "types"
-   "module-anns"])
+   "module-anns"
+   "module-state"])
 
 (defn ^:private new-module [hash]
   (&/T [;; lux;module-hash
@@ -34,9 +42,38 @@
         ;; "lux;types"
         (&/|table)
         ;; module-anns
-        (&/|list)]
+        (&/|list)
+        ;; "module-state"
+        $Active]
        ))
 
+(do-template [<flagger> <asker> <tag>]
+  (do (defn <flagger> [module-name]
+        "(-> Text (Lux Unit))"
+        (fn [state]
+          (let [state* (&/update$ &/$modules
+                                  (fn [modules]
+                                    (&/|update module-name
+                                               (fn [=module]
+                                                 (&/set$ $module-state <tag> =module))
+                                               modules))
+                                  state)]
+            (&/$Right (&/T [state* &/unit-tag])))))
+    (defn <asker> [module-name]
+      "(-> Text (Lux Bool))"
+      (fn [state]
+        (if-let [=module (->> state (&/get$ &/$modules) (&/|get module-name))]
+          (&/$Right (&/T [state (|case (&/get$ $module-state =module)
+                                  (<tag>) true
+                                  _       false)]))
+          (&/$Right (&/T [state false])))
+        )))
+
+  flag-active-module   active-module?   $Active
+  flag-compiled-module compiled-module? $Compiled
+  flag-cached-module   cached-module?   $Cached
+  )
+
 ;; [Exports]
 (defn add-import
   "(-> Text (Lux Null))"
diff --git a/luxc/src/lux/base.clj b/luxc/src/lux/base.clj
index 9859db068..5e8c8c0d0 100644
--- a/luxc/src/lux/base.clj
+++ b/luxc/src/lux/base.clj
@@ -112,19 +112,12 @@
    "locals"
    "closure"])
 
-;; ModuleState
-(defvariant
-  ("Active" 0)
-  ("Compiled" 0)
-  ("Cached" 0))
-
 ;; Host
 (deftuple
   ["writer"
    "loader"
    "classes"
    "catching"
-   "module-states"
    "type-env"
    "dummy-mappings"
    ])
@@ -137,8 +130,7 @@
   ("REPL" 0))
 
 (deftuple
-  ["compiler-name"
-   "compiler-version"
+  ["compiler-version"
    "compiler-mode"])
 
 (deftuple
@@ -231,7 +223,6 @@
 (def ^:const module-class-name "_")
 (def ^:const +name-separator+ ";")
 
-(def ^:const ^String compiler-name "Lux/JVM")
 (def ^:const ^String compiler-version "0.6.0")
 
 ;; Constructors
@@ -718,41 +709,10 @@
       +init-bindings+]
      ))
 
-(let [define-class (doto (.getDeclaredMethod java.lang.ClassLoader "defineClass" (into-array [String
-                                                                                              (class (byte-array []))
-                                                                                              Integer/TYPE
-                                                                                              Integer/TYPE]))
-                     (.setAccessible true))]
-  (defn memory-class-loader [store]
-    (proxy [java.lang.ClassLoader]
-      []
-      (findClass [^String class-name]
-        (if-let [^bytes bytecode (get @store class-name)]
-          (.invoke define-class this (to-array [class-name bytecode (int 0) (int (alength bytecode))]))
-          (throw (IllegalStateException. (str "[Class Loader] Unknown class: " class-name))))))))
-
 (def loader
   (fn [state]
     (return* state (->> state (get$ $host) (get$ $loader)))))
 
-(defn host [_]
-  (let [store (atom {})]
-    (T [;; "lux;writer"
-        $None
-        ;; "lux;loader"
-        (memory-class-loader store)
-        ;; "lux;classes"
-        store
-        ;; "lux;catching"
-        $Nil
-        ;; "lux;module-states"
-        (|table)
-        ;; lux;type-env
-        (|table)
-        ;; lux;dummy-mappings
-        (|table)
-        ])))
-
 (defn with-no-catches [body]
   "(All [a] (-> (Lux a) (Lux a)))"
   (fn [state]
@@ -765,15 +725,13 @@
         (fail* msg)))))
 
 (defn default-compiler-info [mode]
-  (T [;; compiler-name
-      compiler-name
-      ;; compiler-version
+  (T [;; compiler-version
       compiler-version
       ;; compiler-mode
       mode]
      ))
 
-(defn init-state [mode]
+(defn init-state [mode host-data]
   (T [;; "lux;info"
       (default-compiler-info mode)
       ;; "lux;source"
@@ -793,7 +751,7 @@
       ;; scope-type-vars
       $Nil
       ;; "lux;host"
-      (host nil)]
+      host-data]
      ))
 
 (defn save-module [body]
@@ -1342,32 +1300,6 @@
         ($Some xs**) ($Some ($Cons x xs**)))
       )))
 
-(do-template [<flagger> <asker> <tag>]
-  (do (defn <flagger> [module]
-        "(-> Text (Lux Unit))"
-        (fn [state]
-          (let [state* (update$ $host (fn [host]
-                                        (update$ $module-states
-                                                 (fn [module-states]
-                                                   (|put module <tag> module-states))
-                                                 host))
-                                state)]
-            ($Right (T [state* unit-tag])))))
-    (defn <asker> [module]
-      "(-> Text (Lux Bool))"
-      (fn [state]
-        (if-let [module-state (->> state (get$ $host) (get$ $module-states) (|get module))]
-          ($Right (T [state (|case module-state
-                              (<tag>) true
-                              _       false)]))
-          ($Right (T [state false])))
-        )))
-
-  flag-active-module   active-module?   $Active
-  flag-compiled-module compiled-module? $Compiled
-  flag-cached-module   cached-module?   $Cached
-  )
-
 (do-template [<name> <default> <op>]
   (defn <name> [p xs]
     "(All [a] (-> (-> a Bool) (List a) Bool))"
diff --git a/luxc/src/lux/compiler/jvm.clj b/luxc/src/lux/compiler/jvm.clj
index 5d787f5cd..bb333df57 100644
--- a/luxc/src/lux/compiler/jvm.clj
+++ b/luxc/src/lux/compiler/jvm.clj
@@ -178,7 +178,7 @@
                           (&/fail-with-loc "[Compiler Error] Can't re-define a module!")
                           (|do [_ (&&cache/delete name)
                                 _ (&a-module/create-module name file-hash)
-                                _ (&/flag-active-module name)
+                                _ (&a-module/flag-active-module name)
                                 :let [module-class-name (str (&host/->module-class name) "/_")
                                       =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
                                                (.visit &host/bytecode-version (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
@@ -199,7 +199,7 @@
                                       (&/set$ &/$source (&reader/from name file-content) state))
                                 (&/$Right ?state _)
                                 (&/run-state (|do [:let [_ (.visitEnd =class)]
-                                                   _ (&/flag-compiled-module name)
+                                                   _ (&a-module/flag-compiled-module name)
                                                    _ (&&/save-class! &/module-class-name (.toByteArray =class))
                                                    module-descriptor &&core/generate-module-descriptor
                                                    _ (&&core/write-module-descriptor! name module-descriptor)]
@@ -211,12 +211,43 @@
         )
       )))
 
+(let [define-class (doto (.getDeclaredMethod java.lang.ClassLoader "defineClass" (into-array [String
+                                                                                              (class (byte-array []))
+                                                                                              Integer/TYPE
+                                                                                              Integer/TYPE]))
+                     (.setAccessible true))]
+  (defn memory-class-loader [store]
+    (proxy [java.lang.ClassLoader]
+      []
+      (findClass [^String class-name]
+        (if-let [^bytes bytecode (get @store class-name)]
+          (.invoke define-class this (to-array [class-name bytecode (int 0) (int (alength bytecode))]))
+          (throw (IllegalStateException. (str "[Class Loader] Unknown class: " class-name))))))))
+
+(defn jvm-host []
+  (let [store (atom {})]
+    (&/T [;; "lux;writer"
+          &/$None
+          ;; "lux;loader"
+          (memory-class-loader store)
+          ;; "lux;classes"
+          store
+          ;; "lux;catching"
+          &/$Nil
+          ;; "lux;module-states"
+          (&/|table)
+          ;; lux;type-env
+          (&/|table)
+          ;; lux;dummy-mappings
+          (&/|table)
+          ])))
+
 (let [!err! *err*]
   (defn compile-program [mode program-module resources-dir source-dirs target-dir]
     (let [m-action (|do [_ (&&cache/pre-load-cache! source-dirs)
                          _ (compile-module source-dirs "lux")]
                      (compile-module source-dirs program-module))]
-      (|case (m-action (&/init-state mode))
+      (|case (m-action (&/init-state mode (jvm-host)))
         (&/$Right ?state _)
         (do (println "Compilation complete!")
           (&&cache/clean ?state))
diff --git a/luxc/src/lux/compiler/jvm/cache.clj b/luxc/src/lux/compiler/jvm/cache.clj
index 1746514bc..e75e09f1b 100644
--- a/luxc/src/lux/compiler/jvm/cache.clj
+++ b/luxc/src/lux/compiler/jvm/cache.clj
@@ -149,6 +149,7 @@
 
 (defn ^:private install-module [loader module module-hash imports tag-groups module-anns def-entries]
   (|do [_ (&a-module/create-module module module-hash)
+        _ (&a-module/flag-cached-module module)
         _ (&a-module/set-anns module-anns module)
         _ (&a-module/set-imports imports)
         _ (&/map% (partial process-def-entry loader module)
@@ -269,7 +270,6 @@
 (defn load [module-name]
   "(-> Text (Lux Null))"
   (if-let [module-struct (get @!pre-loaded-cache module-name)]
-    (|do [_ (inject-module module-name module-struct)
-          _ (&/flag-cached-module module-name)]
+    (|do [_ (inject-module module-name module-struct)]
       (return nil))
     (&/fail (str "[Cache Error] Module is not cached: " module-name))))
diff --git a/luxc/src/lux/compiler/jvm/lux.clj b/luxc/src/lux/compiler/jvm/lux.clj
index 591e490c4..64760bbb6 100644
--- a/luxc/src/lux/compiler/jvm/lux.clj
+++ b/luxc/src/lux/compiler/jvm/lux.clj
@@ -276,8 +276,7 @@
           (|let [[_ (&o/$function _ _arity _scope _captured ?body+)] (&o/shift-function-body (&/|tail __scope) __scope
                                                                                              false
                                                                                              (de-ann ?body))]
-            (|do [:let [=value-type (&a/expr-type* ?body)]
-                  [file-name _ _] &/cursor
+            (|do [[file-name _ _] &/cursor
                   :let [datum-sig "Ljava/lang/Object;"
                         def-name (&host/def-name ?name)
                         current-class (str (&host/->module-class module-name) "/" def-name)
@@ -347,8 +346,7 @@
               (return nil)))
 
           _
-          (|do [:let [=value-type (&a/expr-type* ?body)]
-                [file-name _ _] &/cursor
+          (|do [[file-name _ _] &/cursor
                 :let [datum-sig "Ljava/lang/Object;"
                       def-name (&host/def-name ?name)
                       current-class (str (&host/->module-class module-name) "/" def-name)