- Reimplemented module-aliasing.

4 files changed, 108 insertions, 59 deletions

diff --git a/source/lux.lux b/source/lux.lux
index 2a4cc8660..10abcb88a 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -244,10 +244,24 @@
                              #Nil])])))
 (_lux_export LuxVar)
 
+## (deftype (Module Compiler)
+##   (& #aliases (List (, Text Text))
+##      #defs (List (, Text (, Bool (DefData' (-> (List Syntax) (StateE Compiler (List Syntax)))))))))
+(_lux_def Module
+  (#AllT [(#Some #Nil) "lux;Module" "Compiler"
+          (#RecordT (#Cons [["lux;aliases" (#AppT [List (#TupleT (#Cons [Text (#Cons [Text #Nil])]))])]
+                            (#Cons [["lux;defs" (#AppT [List (#TupleT (#Cons [Text
+                                                                              (#Cons [(#TupleT (#Cons [Bool (#Cons [(#AppT [DefData' (#LambdaT [SyntaxList
+                                                                                                                                                (#AppT [(#AppT [StateE (#BoundT "Compiler")])
+                                                                                                                                                        SyntaxList])])])
+                                                                                                                    #Nil])]))
+                                                                                      #Nil])]))])]
+                                    #Nil])]))]))
+(_lux_export Module)
+
 ## (deftype #rec Compiler
 ##   (& #source         Reader
-##      #modules        (List (, Text (List (, Text (, Bool (DefData' (-> (List Syntax) (StateE Compiler (List Syntax)))))))))
-##      #module-aliases (List Void)
+##      #modules        (List (, Text (Module Compiler)))
 ##      #envs           (List (Env Text (, LuxVar Type)))
 ##      #types          (Bindings Int Type)
 ##      #host           HostState))
@@ -255,21 +269,14 @@
   (#AppT [(#AllT [(#Some #Nil) "lux;Compiler" ""
                   (#RecordT (#Cons [["lux;source" Reader]
                                     (#Cons [["lux;modules" (#AppT [List (#TupleT (#Cons [Text
-                                                                                         (#Cons [(#AppT [List (#TupleT (#Cons [Text
-                                                                                                                               (#Cons [(#TupleT (#Cons [Bool (#Cons [(#AppT [DefData' (#LambdaT [SyntaxList
-                                                                                                                                                                                                 (#AppT [(#AppT [StateE (#AppT [(#BoundT "lux;Compiler")
-                                                                                                                                                                                                                                (#BoundT "")])])
-                                                                                                                                                                                                         SyntaxList])])])
-                                                                                                                                                                     #Nil])]))
-                                                                                                                                       #Nil])]))])
+                                                                                         (#Cons [(#AppT [Module (#AppT [(#BoundT "lux;Compiler") (#BoundT "")])])
                                                                                                  #Nil])]))])]
-                                            (#Cons [["lux;module-aliases" (#AppT [List Void])]
-                                                    (#Cons [["lux;envs" (#AppT [List (#AppT [(#AppT [Env Text])
-                                                                                             (#TupleT (#Cons [LuxVar (#Cons [Type #Nil])]))])])]
-                                                            (#Cons [["lux;types" (#AppT [(#AppT [Bindings Int]) Type])]
-                                                                    (#Cons [["lux;host" HostState]
-                                                                            (#Cons [["lux;seed" Int]
-                                                                                    #Nil])])])])])])]))])
+                                            (#Cons [["lux;envs" (#AppT [List (#AppT [(#AppT [Env Text])
+                                                                                     (#TupleT (#Cons [LuxVar (#Cons [Type #Nil])]))])])]
+                                                    (#Cons [["lux;types" (#AppT [(#AppT [Bindings Int]) Type])]
+                                                            (#Cons [["lux;host" HostState]
+                                                                    (#Cons [["lux;seed" Int]
+                                                                            #Nil])])])])])]))])
           Void]))
 (_lux_export Compiler)
 
@@ -1293,7 +1300,7 @@
 (def'' #export (get-module-name state)
   ($' Lux Text)
   (_lux_case state
-    {#source source #modules modules #module-aliases module-aliases
+    {#source source #modules modules
      #envs   envs   #types   types   #host           host
      #seed   seed}
     (_lux_case (reverse envs)
@@ -1304,12 +1311,13 @@
       (#Right [state module-name]))))
 
 (def'' (find-macro' modules current-module module name)
-  (-> ($' List (, Text ($' List (, Text (, Bool ($' DefData' (-> ($' List Syntax) ($' StateE Compiler ($' List Syntax)))))))))
+  (-> ($' List (, Text ($' Module Compiler)))
       Text Text Text
       ($' Maybe Macro))
   (do Maybe:Monad
-    [bindings (get module modules)
-     gdef (get name bindings)]
+    [$module (get module modules)
+     gdef (let [{#aliases _ #defs bindings} (_lux_: ($' Module Compiler) $module)]
+            (get name bindings))]
     (_lux_case (_lux_: (, Bool ($' DefData' Macro)) gdef)
       [exported? (#MacroD macro')]
       (if exported?
@@ -1331,7 +1339,7 @@
     (let [[module name] ident]
       (lambda [state]
         (_lux_case state
-          {#source source #modules modules #module-aliases module-aliases
+          {#source source #modules modules
            #envs   envs   #types   types   #host           host
            #seed   seed}
           (#Right [state (find-macro' modules current-module module name)]))))))
@@ -1741,10 +1749,10 @@
 (def #export (gensym prefix state)
   (-> Text (Lux Syntax))
   (case state
-    {#source source #modules modules #module-aliases module-aliases
+    {#source source #modules modules
      #envs   envs   #types   types   #host           host
      #seed   seed}
-    (#Right [{#source source #modules modules #module-aliases module-aliases
+    (#Right [{#source source #modules modules
               #envs   envs   #types   types   #host           host
               #seed   (inc seed)}
              ($symbol ["__gensym__" (int:show seed)])])))
@@ -1950,7 +1958,7 @@
 
 (defmacro #export (lux tokens state)
   (case state
-    {#source source #modules modules #module-aliases module-aliases
+    {#source source #modules modules
      #envs   envs   #types   types   #host           host
      #seed   seed}
     (case (get "lux" modules)
@@ -1962,7 +1970,8 @@
                                  (if export?
                                    (list name)
                                    (list)))))
-                          lux)]
+                          (let [{#aliases _ #defs defs} lux]
+                            defs))]
         (#Right [state (: (List Syntax)
                           (map (: (-> Text Syntax)
                                   (lambda [name]
@@ -2044,7 +2053,7 @@
       (#Meta [_ (#SymbolS vname)])
       (let [vname' (ident->text vname)]
         (case state
-          {#source source #modules modules #module-aliases module-aliases
+          {#source source #modules modules
            #envs   envs   #types   types   #host           host
            #seed   seed}
           (let [?struct-type (some (: (-> (Env Text (, LuxVar Type)) (Maybe Type))
diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj
index f882f1275..cfa39f008 100644
--- a/src/lux/analyser/module.clj
+++ b/src/lux/analyser/module.clj
@@ -6,18 +6,31 @@
                  [host :as &host])
             [lux.analyser.base :as &&]))
 
+;; [Utils]
+(def ^:private $ALIASES 0)
+(def ^:private $DEFS 1)
+
 ;; [Exports]
 (def init-module
-  (&/|table))
+  (&/R ;; "lux;aliases"
+   (&/|table)
+   ;; "lux;defs"
+   (&/|table)
+   ))
 
 (defn define [module name def-data type]
   (fn [state]
     (matchv ::M/objects [(&/get$ &/$ENVS state)]
       [["lux;Cons" [?env ["lux;Nil" _]]]]
       (return* (->> state
-                    (&/update$ &/$MODULES (fn [ms]
-                                            (&/|update module #(&/|put name (&/T false def-data) %)
-                                                       ms)))
+                    (&/update$ &/$MODULES
+                               (fn [ms]
+                                 (&/|update module
+                                            (fn [m]
+                                              (&/update$ $DEFS
+                                                         #(&/|put name (&/T false def-data) %)
+                                                         m))
+                                            ms)))
                     (&/set$ &/$ENVS (&/|list (&/update$ &/$LOCALS (fn [locals]
                                                                     (&/update$ &/$MAPPINGS (fn [mappings]
                                                                                              (&/|put (str "" &/+name-separator+ name)
@@ -35,9 +48,14 @@
     (matchv ::M/objects [(&/get$ &/$ENVS state)]
       [["lux;Cons" [?env ["lux;Nil" _]]]]
       (return* (->> state
-                    (&/update$ &/$MODULES (fn [ms]
-                                            (&/|update a-module #(&/|put a-name (&/T false (&/V "lux;AliasD" (&/T r-module r-name))) %)
-                                                       ms)))
+                    (&/update$ &/$MODULES
+                               (fn [ms]
+                                 (&/|update a-module
+                                            (fn [m]
+                                              (&/update$ $DEFS
+                                                         #(&/|put a-name (&/T false (&/V "lux;AliasD" (&/T r-module r-name))) %)
+                                                         m))
+                                            ms)))
                     (&/set$ &/$ENVS (&/|list (&/update$ &/$LOCALS (fn [locals]
                                                                     (&/update$ &/$MAPPINGS (fn [mappings]
                                                                                              (&/|put (str "" &/+name-separator+ a-name)
@@ -55,16 +73,30 @@
     (return* state
              (->> state (&/get$ &/$MODULES) (&/|contains? name)))))
 
-(defn dealias [name]
+(defn alias-module [module reference alias]
   (fn [state]
-    (if-let [real-name (->> state (&/get$ &/$MODULE-ALIASES) (&/|get name))]
-      (return* state real-name)
-      (fail* (str "Unknown alias: " name)))))
+    (return* (->> state
+                  (&/update$ &/$MODULES
+                             (fn [ms]
+                               (&/|update module
+                                          #(&/update$ $ALIASES
+                                                      (fn [aliases]
+                                                        (&/|put alias reference aliases))
+                                                      %)
+                                          ms))))
+             nil)))
+
+(defn dealias [name]
+  (|do [current-module &/get-module-name]
+    (fn [state]
+      (if-let [real-name (->> state (&/get$ &/$MODULES) (&/|get current-module) (&/get$ $ALIASES) (&/|get name))]
+        (return* state real-name)
+        (fail* (str "Unknown alias: " name))))))
 
 (defn find-def [module name]
   (|do [current-module &/get-module-name]
     (fn [state]
-      (if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module))]
+      (if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module) (&/get$ $DEFS))]
         (if-let [$def (&/|get name $module)]
           (matchv ::M/objects [$def]
             [[exported? $$def]]
@@ -90,7 +122,7 @@
 
 (defn declare-macro [module name]
   (fn [state]
-    (if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module))]
+    (if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module) (&/get$ $DEFS))]
       (if-let [$def (&/|get name $module)]
         (matchv ::M/objects [$def]
           [[exported? ["lux;ValueD" ?type]]]
@@ -102,8 +134,12 @@
              (fn [state*]
                (return* (&/update$ &/$MODULES
                                    (fn [$modules]
-                                     (&/|put module (&/|put name (&/T exported? (&/V "lux;MacroD" macro)) $module)
-                                             $modules))
+                                     (&/|update module
+                                                (fn [m]
+                                                  (&/update$ $DEFS
+                                                             #(&/|put name (&/T exported? (&/V "lux;MacroD" macro)) %)
+                                                             m))
+                                                $modules))
                                    state*)
                         nil)))
            state)
@@ -120,7 +156,7 @@
   (fn [state]
     (matchv ::M/objects [(&/get$ &/$ENVS state)]
       [["lux;Cons" [?env ["lux;Nil" _]]]]
-      (if-let [$def (->> state (&/get$ &/$MODULES) (&/|get module) (&/|get name))]
+      (if-let [$def (->> state (&/get$ &/$MODULES) (&/|get module) (&/get$ $DEFS) (&/|get name))]
         (matchv ::M/objects [$def]
           [[true _]]
           (fail* (str "[Analyser Error] Definition has already been exported: " module ";" name))
@@ -128,7 +164,10 @@
           [[false ?data]]
           (return* (->> state
                         (&/update$ &/$MODULES (fn [ms]
-                                                (&/|update module #(&/|put name (&/T true ?data) %)
+                                                (&/|update module (fn [m]
+                                                                    (&/update$ $DEFS
+                                                                               #(&/|put name (&/T true ?data) %)
+                                                                               m))
                                                            ms))))
                    nil))
         (fail* (str "[Analyser Error] Can't export an inexistent definition: " module ";" name)))
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 57b25f47e..9087028bb 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -22,11 +22,10 @@
 ;; CompilerState
 (def $ENVS 0)
 (def $HOST 1)
-(def $MODULE-ALIASES 2)
-(def $MODULES 3)
-(def $SEED 4)
-(def $SOURCE 5)
-(def $TYPES 6)
+(def $MODULES 2)
+(def $SEED 3)
+(def $SOURCE 4)
+(def $TYPES 5)
 
 ;; [Exports]
 (def +name-separator+ ";")
@@ -473,8 +472,6 @@
    (|list)
    ;; "lux;host"
    (host nil)
-   ;; "lux;module-aliases"
-   (|table)
    ;; "lux;modules"
    (|table)
    ;; "lux;seed"
diff --git a/src/lux/type.clj b/src/lux/type.clj
index fa598daf1..d34433f01 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -143,21 +143,25 @@
   (&/V "lux;VariantT" (&/|list (&/T "lux;Local" Int)
                                (&/T "lux;Global" Ident))))
 
+(def $Module
+  (fAll "lux;$Module" "Compiler"
+        (&/V "lux;RecordT"
+             (&/|list (&/T "lux;aliases" (&/V "lux;AppT" (&/T List (&/V "lux;TupleT" (&/|list Text Text)))))
+                      (&/T "lux;defs" (&/V "lux;AppT" (&/T List (&/V "lux;TupleT"
+                                                                     (&/|list Text
+                                                                              (&/V "lux;TupleT" (&/|list Bool
+                                                                                                         (&/V "lux;AppT" (&/T DefData*
+                                                                                                                              (&/V "lux;LambdaT" (&/T SyntaxList
+                                                                                                                                                      (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T StateE (&/V "lux;BoundT" "Compiler")))
+                                                                                                                                                                           SyntaxList)))))))))))))))))
+
 (def $Compiler
   (&/V "lux;AppT" (&/T (fAll "lux;Compiler" ""
                              (&/V "lux;RecordT"
                                   (&/|list (&/T "lux;source" Reader)
                                            (&/T "lux;modules" (&/V "lux;AppT" (&/T List (&/V "lux;TupleT"
                                                                                              (&/|list Text
-                                                                                                      (&/V "lux;AppT" (&/T List (&/V "lux;TupleT"
-                                                                                                                                     (&/|list Text
-                                                                                                                                              (&/V "lux;TupleT" (&/|list Bool
-                                                                                                                                                                         (&/V "lux;AppT" (&/T DefData*
-                                                                                                                                                                                              (&/V "lux;LambdaT" (&/T SyntaxList
-                                                                                                                                                                                                                      (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T StateE (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "lux;Compiler")
-                                                                                                                                                                                                                                                                                            (&/V "lux;BoundT" "")))))
-                                                                                                                                                                                                                                           SyntaxList)))))))))))))))))
-                                           (&/T "lux;module-aliases" (&/V "lux;AppT" (&/T List $Void)))
+                                                                                                      (&/V "lux;AppT" (&/T $Module (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "lux;Compiler") (&/V "lux;BoundT" ""))))))))))
                                            (&/T "lux;envs" (&/V "lux;AppT" (&/T List
                                                                                 (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Env Text))
                                                                                                      (&/V "lux;TupleT" (&/|list LuxVar Type)))))))