- 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.

8 files changed, 139 insertions, 123 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)
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 520e55434..19a7b4716 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -485,6 +485,26 @@
                            Text])]))
   default-def-meta-exported)
 
+## (type: Module-State
+##   #Active
+##   #Compiled
+##   #Cached)
+(_lux_def Module-State
+  (#NamedT ["lux" "Module-State"]
+           (#SumT
+            ## #Active
+            Unit
+            (#SumT
+             ## #Compiled
+             Unit
+             ## #Cached
+             Unit)))
+  (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "Active")
+                                        (#Cons (#TextA "Compiled")
+                                               (#Cons (#TextA "Cached")
+                                                      #Nil))))]
+         default-def-meta-exported))
+
 ## (type: Module
 ##   {#module-hash    Int
 ##    #module-aliases (List [Text Text])
@@ -493,6 +513,7 @@
 ##    #tags           (List [Text [Nat (List Ident) Bool Type]])
 ##    #types          (List [Text [(List Ident) Bool Type]])}
 ##    #module-anns    Anns
+##    #module-state   Module-State
 ##   )
 (_lux_def Module
   (#NamedT ["lux" "Module"]
@@ -518,8 +539,9 @@
                                 (#ProdT (#AppT List Ident)
                                         (#ProdT Bool
                                                 Type))))
-                 ## "lux;module-anns"
-                 Anns)
+                 (#ProdT ## "lux;module-anns"
+                  Anns
+                  Module-State))
                 ))))))
   (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "module-hash")
                                         (#Cons (#TextA "module-aliases")
@@ -528,7 +550,8 @@
                                                              (#Cons (#TextA "tags")
                                                                     (#Cons (#TextA "types")
                                                                            (#Cons (#TextA "module-anns")
-                                                                                  #Nil))))))))]
+                                                                                  (#Cons (#TextA "module-state")
+                                                                                         #Nil)))))))))]
          (#Cons [["lux" "doc"] (#TextA "All the information contained within a Lux module.")]
                 default-def-meta-exported)))
 
@@ -556,21 +579,17 @@
                 default-def-meta-exported)))
 
 ## (type: Compiler-Info
-##   {#compiler-name    Text
-##    #compiler-version Text
+##   {#compiler-version Text
 ##    #compiler-mode    Compiler-Mode})
 (_lux_def Compiler-Info
   (#NamedT ["lux" "Compiler-Info"]
-           (#ProdT ## "lux;compiler-name"
+           (#ProdT ## "lux;compiler-version"
             Text
-            (#ProdT ## "lux;compiler-version"
-             Text
-             ## "lux;compiler-mode"
-             Compiler-Mode)))
-  (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "compiler-name")
-                                        (#Cons (#TextA "compiler-version")
-                                               (#Cons (#TextA "compiler-mode")
-                                                      #Nil))))]
+            ## "lux;compiler-mode"
+            Compiler-Mode))
+  (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "compiler-version")
+                                        (#Cons (#TextA "compiler-mode")
+                                               #Nil)))]
          (#Cons [["lux" "doc"] (#TextA "Information about the current version and type of compiler that is running.")]
                 default-def-meta-exported)))
 
@@ -1697,7 +1716,7 @@
           #seed seed #expected  expected #cursor  cursor
           #scope-type-vars scope-type-vars} state]
         (_lux_case (get module modules)
-          (#Some {#module-hash _ #module-aliases _ #defs defs #imports _ #tags tags #types types #module-anns _})
+          (#Some {#module-hash _ #module-aliases _ #defs defs #imports _ #tags tags #types types #module-anns _ #module-state _})
           (_lux_case (get name defs)
             (#Some [def-type def-meta def-value])
             (_lux_case (get-meta ["lux" "alias"] def-meta)
@@ -2206,7 +2225,7 @@
       ($' Maybe Macro))
   (do Monad<Maybe>
     [$module (get module modules)
-     gdef (let' [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags #types types #module-anns _} (_lux_: Module $module)]
+     gdef (let' [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags #types types #module-anns _ #module-state _} (_lux_: Module $module)]
                 (get name bindings))]
     (let' [[def-type def-meta def-value] (_lux_: Def gdef)]
           (_lux_case (get-meta ["lux" "macro?"] def-meta)
@@ -3374,7 +3393,7 @@
   (-> Ident (Lux [Nat (List Ident) Bool Type]))
   (do Monad<Lux>
     [=module (find-module module)
-     #let [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags-table #types types #module-anns _} =module]]
+     #let [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags-table #types types #module-anns _ #module-state _} =module]]
     (case (get name tags-table)
       (#Some output)
       (return output)
@@ -3397,7 +3416,7 @@
     (#NamedT [module name] _)
     (do Monad<Lux>
       [=module (find-module module)
-       #let [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags #types types #module-anns _} =module]]
+       #let [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags #types types #module-anns _ #module-state _} =module]]
       (case (get name types)
         (#Some [tags exported? (#NamedT _ _type)])
         (case (resolve-struct-type _type)
@@ -3956,7 +3975,7 @@
 
                                  _
                                  (list))))
-                          (let [{#module-hash _ #module-aliases _ #defs defs #imports _ #tags tags #types types #module-anns _} =module]
+                          (let [{#module-hash _ #module-aliases _ #defs defs #imports _ #tags tags #types types #module-anns _ #module-state _} =module]
                             defs))]
         (#Right state (List/join to-alias)))
       
@@ -4022,7 +4041,7 @@
       #None
       #None
 
-      (#Some {#defs defs #module-hash _ #module-aliases _ #imports _ #tags tags #types types #module-anns _})
+      (#Some {#defs defs #module-hash _ #module-aliases _ #imports _ #tags tags #types types #module-anns _ #module-state _})
       (case (get v-name defs)
         #None
         #None
@@ -4041,7 +4060,7 @@
       #None
       (#Left (Text/append "Unknown definition: " (Ident/encode name)))
 
-      (#Some {#defs defs #module-hash _ #module-aliases _ #imports _ #tags tags #types types #module-anns _})
+      (#Some {#defs defs #module-hash _ #module-aliases _ #imports _ #tags tags #types types #module-anns _ #module-state _})
       (case (get v-name defs)
         #None
         (#Left (Text/append "Unknown definition: " (Ident/encode name)))
@@ -4344,7 +4363,7 @@
   (-> Text Text (Lux Bool))
   (do Monad<Lux>
     [module (find-module module-name)
-     #let [{#module-hash _ #module-aliases _ #defs _ #imports imports #tags _ #types _ #module-anns _} module]]
+     #let [{#module-hash _ #module-aliases _ #defs _ #imports imports #tags _ #types _ #module-anns _ #module-state _} module]]
     (wrap (is-member? imports import-name))))
 
 (macro: #export (default tokens state)