- Added a new piece of compiler state, just for storing the current-module.

8 files changed, 122 insertions, 131 deletions

diff --git a/luxc/src/lux/analyser/module.clj b/luxc/src/lux/analyser/module.clj
index 8c5a2d286..c8a263030 100644
--- a/luxc/src/lux/analyser/module.clj
+++ b/luxc/src/lux/analyser/module.clj
@@ -279,7 +279,8 @@
   (fn [state]
     (return* (->> state
                   (&/update$ &/$modules #(&/|put name (new-module hash) %))
-                  (&/set$ &/$scopes (&/|list (&/env name &/$Nil))))
+                  (&/set$ &/$scopes (&/|list (&/env name &/$Nil)))
+                  (&/set$ &/$current-module (&/$Some name)))
              nil)))
 
 (do-template [<name> <tag> <type>]
diff --git a/luxc/src/lux/base.clj b/luxc/src/lux/base.clj
index 3bf0eaf08..910bdfadf 100644
--- a/luxc/src/lux/base.clj
+++ b/luxc/src/lux/base.clj
@@ -151,6 +151,7 @@
   ["info"
    "source"
    "cursor"
+   "current-module"
    "modules"
    "scopes"
    "type-context"
@@ -819,6 +820,8 @@
       $Nil
       ;; "lux;cursor"
       (T ["" -1 -1])
+      ;; "current-module"
+      $None
       ;; "lux;modules"
       (|table)
       ;; "lux;scopes"
@@ -910,13 +913,13 @@
 
 (def get-module-name
   (fn [state]
-    (|case (|reverse (get$ $scopes state))
-      ($Nil)
+    (|case (get$ $current-module state)
+      ($None)
       ((fail-with-loc "[Analyser Error] Cannot get the module-name without a module.")
        state)
 
-      ($Cons ?global _)
-      (return* state (|head (get$ $name ?global))))))
+      ($Some module-name)
+      (return* state module-name))))
 
 (defn find-module [name]
   "(-> Text (Lux (Module Compiler)))"
diff --git a/new-luxc/source/luxc/base.lux b/new-luxc/source/luxc/base.lux
index 28b5437e9..bac16fd79 100644
--- a/new-luxc/source/luxc/base.lux
+++ b/new-luxc/source/luxc/base.lux
@@ -145,7 +145,7 @@
 
 (def: fresh-scope
   Scope
-  {#;name     (list "lux")
+  {#;name     (list)
    #;inner    +0
    #;locals   fresh-bindings
    #;captured fresh-bindings})
@@ -166,6 +166,19 @@
       (#e;Error error)
       (#e;Error error))))
 
+(def: #export (with-current-module name action)
+  (All [a] (-> Text (Meta a) (Meta a)))
+  (function [compiler]
+    (case (action (set@ #;current-module (#;Some name) compiler))
+      (#e;Success [compiler' output])
+      (#e;Success [(set@ #;current-module
+                         (get@ #;current-module compiler)
+                         compiler')
+                   output])
+
+      (#e;Error error)
+      (#e;Error error))))
+
 (def: #export (with-cursor cursor action)
   (All [a] (-> Cursor (Meta a) (Meta a)))
   (if (text/= "" (product;left cursor))
diff --git a/new-luxc/source/luxc/generator.lux b/new-luxc/source/luxc/generator.lux
index f64ca333e..4ac937402 100644
--- a/new-luxc/source/luxc/generator.lux
+++ b/new-luxc/source/luxc/generator.lux
@@ -158,6 +158,7 @@
   {#;info            init-info
    #;source          [init-cursor +0 ""]
    #;cursor          init-cursor
+   #;current-module  #;None
    #;modules         (list)
    #;scopes          (list)
    #;type-context    init-type-context
diff --git a/new-luxc/source/luxc/module.lux b/new-luxc/source/luxc/module.lux
index 39d3679e6..2bb7eedcd 100644
--- a/new-luxc/source/luxc/module.lux
+++ b/new-luxc/source/luxc/module.lux
@@ -56,7 +56,8 @@
   (All [a] (-> Nat Text (Meta a) (Meta [Module a])))
   (do Monad<Meta>
     [_ (create hash name)
-     output (&scope;with-scope name action)
+     output (&;with-current-module name
+              (&scope;with-scope name action))
      module (meta;find-module name)]
     (wrap [module output])))
 
diff --git a/new-luxc/test/test/luxc/common.lux b/new-luxc/test/test/luxc/common.lux
index 2e725be5d..5b6fed8ec 100644
--- a/new-luxc/test/test/luxc/common.lux
+++ b/new-luxc/test/test/luxc/common.lux
@@ -1,36 +1,9 @@
 (;module:
   lux
-  (lux (control pipe)
-       ["r" math/random "r/" Monad<Random>]
-       (data ["R" error])
-       [meta]
-       (meta [code])
-       [io])
-  (luxc ["&" base]
-        [analyser]
-        ["&;" host]))
-
-(def: init-info
-  Info
-  {#;target  "JVM"
-   #;version &;version
-   #;mode    #;Build})
-
-(def: init-type-context
-  Type-Context
-  {#;ex-counter +0
-   #;var-counter +0
-   #;var-bindings (list)})
+  (lux [io])
+  (luxc ["&;" host]
+        [";G" generator]))
 
 (def: #export (init-compiler _)
   (-> Top Compiler)
-  {#;info            init-info
-   #;source          [dummy-cursor +0 ""]
-   #;cursor          dummy-cursor
-   #;modules         (list)
-   #;scopes          (list)
-   #;type-context    init-type-context
-   #;expected        #;None
-   #;seed            +0
-   #;scope-type-vars (list)
-   #;host            (:! Void (io;run &host;init-host))})
+  (generatorG;init-compiler (io;run &host;init-host)))
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 9509c7ad5..7aa9a96a6 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -710,6 +710,7 @@
 ##   {#info            Info
 ##    #source          Source
 ##    #cursor          Cursor
+##    #current-module  (Maybe Text)
 ##    #modules         (List [Text Module])
 ##    #scopes          (List Scope)
 ##    #type-context    Type-Context
@@ -725,32 +726,35 @@
            Source
            (#Product ## "lux;cursor"
             Cursor
-            (#Product ## "lux;modules"
-             (#Apply (#Product Text Module) List)
-             (#Product ## "lux;scopes"
-              (#Apply Scope List)
-              (#Product ## "lux;type-context"
-               Type-Context
-               (#Product ## "lux;expected"
-                (#Apply Type Maybe)
-                (#Product ## "lux;seed"
-                 Nat
-                 (#Product ## scope-type-vars
-                  (#Apply Nat List)
-                  ## "lux;host"
-                  Void))))))))))
+            (#Product ## "lux;current-module"
+             (#Apply Text Maybe)
+             (#Product ## "lux;modules"
+              (#Apply (#Product Text Module) List)
+              (#Product ## "lux;scopes"
+               (#Apply Scope List)
+               (#Product ## "lux;type-context"
+                Type-Context
+                (#Product ## "lux;expected"
+                 (#Apply Type Maybe)
+                 (#Product ## "lux;seed"
+                  Nat
+                  (#Product ## scope-type-vars
+                   (#Apply Nat List)
+                   ## "lux;host"
+                   Void)))))))))))
  (record$ (#Cons [(tag$ ["lux" "tags"])
                   (tuple$ (#Cons (text$ "info")
                                  (#Cons (text$ "source")
                                         (#Cons (text$ "cursor")
-                                               (#Cons (text$ "modules")
-                                                      (#Cons (text$ "scopes")
-                                                             (#Cons (text$ "type-context")
-                                                                    (#Cons (text$ "expected")
-                                                                           (#Cons (text$ "seed")
-                                                                                  (#Cons (text$ "scope-type-vars")
-                                                                                         (#Cons (text$ "host")
-                                                                                                #Nil)))))))))))]
+                                               (#Cons (text$ "current-module")
+                                                      (#Cons (text$ "modules")
+                                                             (#Cons (text$ "scopes")
+                                                                    (#Cons (text$ "type-context")
+                                                                           (#Cons (text$ "expected")
+                                                                                  (#Cons (text$ "seed")
+                                                                                         (#Cons (text$ "scope-type-vars")
+                                                                                                (#Cons (text$ "host")
+                                                                                                       #Nil))))))))))))]
                  (#Cons [(tag$ ["lux" "doc"])
                          (text$ "Represents the state of the Lux compiler during a run.
 
@@ -1807,7 +1811,7 @@
   #Nil
   (-> Ident ($' Meta Ident))
   (let' [[module name] ident
-         {#info info #source    source   #modules modules
+         {#info info #source    source  #current-module _ #modules modules
           #scopes scopes #type-context types    #host    host
           #seed seed #expected  expected #cursor  cursor
           #scope-type-vars scope-type-vars} state]
@@ -1970,12 +1974,12 @@
   #Nil
   ($' Meta Text)
   ("lux case" state
-   {#info info #source    source   #modules modules
+   {#info info #source    source  #current-module current-module #modules modules
     #scopes scopes #type-context types    #host    host
     #seed seed #expected  expected #cursor  cursor
     #scope-type-vars scope-type-vars}
-   ("lux case" (reverse scopes)
-    (#Cons {#name (#;Cons module-name #Nil) #inner _ #locals _ #captured _} _)
+   ("lux case" current-module
+    (#;Some module-name)
     (#Right [state module-name])
 
     _
@@ -2440,7 +2444,7 @@
     (let' [[module name] ident]
           (function' [state]
                      ("lux case" state
-                      {#info info #source source #modules modules
+                      {#info info #source source #current-module _ #modules modules
                        #scopes   scopes   #type-context   types   #host host
                        #seed   seed #expected expected
                        #cursor cursor
@@ -2698,12 +2702,12 @@
   #Nil
   (-> Text ($' Meta Code))
   ("lux case" state
-   {#info info #source source #modules modules
+   {#info info #source source #current-module _ #modules modules
     #scopes   scopes   #type-context   types   #host host
     #seed   seed #expected expected
     #cursor cursor
     #scope-type-vars scope-type-vars}
-   (#Right {#info info #source source #modules modules
+   (#Right {#info info #source source #current-module _ #modules modules
             #scopes   scopes   #type-context   types   #host host
             #seed   (n.+ +1 seed) #expected expected
             #cursor cursor
@@ -3562,7 +3566,7 @@
 (def: (find-module name)
   (-> Text (Meta Module))
   (function [state]
-    (let [{#info info #source    source   #modules modules
+    (let [{#info info #source    source  #current-module _ #modules modules
            #scopes scopes #type-context types    #host    host
            #seed seed #expected  expected #cursor  cursor
            #scope-type-vars scope-type-vars} state]
@@ -3625,7 +3629,7 @@
 (def: get-expected-type
   (Meta Type)
   (function [state]
-    (let [{#info info #source    source   #modules modules
+    (let [{#info info #source    source  #current-module _ #modules modules
            #scopes scopes #type-context types    #host    host
            #seed seed #expected  expected #cursor  cursor
            #scope-type-vars scope-type-vars} state]
@@ -4145,7 +4149,7 @@
 (def: (exported-defs module state)
   (-> Text (Meta (List Text)))
   (let [modules (case state
-                  {#info info #source    source   #modules modules
+                  {#info info #source    source  #current-module _ #modules modules
                    #scopes scopes #type-context types    #host    host
                    #seed seed #expected  expected #cursor  cursor
                    #scope-type-vars scope-type-vars}
@@ -4200,7 +4204,7 @@
 (def: (find-in-env name state)
   (-> Text Compiler (Maybe Type))
   (case state
-    {#info info #source    source   #modules modules
+    {#info info #source    source  #current-module _ #modules modules
      #scopes scopes #type-context types    #host    host
      #seed seed #expected  expected #cursor  cursor
      #scope-type-vars scope-type-vars}
@@ -4223,7 +4227,7 @@
 (def: (find-def-type name state)
   (-> Ident Compiler (Maybe Type))
   (let [[v-prefix v-name] name
-        {#info info #source    source   #modules modules
+        {#info info #source    source  #current-module _ #modules modules
          #scopes scopes #type-context types    #host    host
          #seed seed #expected  expected #cursor  cursor
          #scope-type-vars scope-type-vars} state]
@@ -4242,7 +4246,7 @@
 (def: (find-def-value name state)
   (-> Ident (Meta [Type Top]))
   (let [[v-prefix v-name] name
-        {#info info #source    source   #modules modules
+        {#info info #source    source #current-module _  #modules modules
          #scopes scopes #type-context types    #host    host
          #seed seed #expected  expected #cursor  cursor
          #scope-type-vars scope-type-vars} state]
@@ -5609,7 +5613,7 @@
 (def: (get-scope-type-vars state)
   (Meta (List Nat))
   (case state
-    {#info info #source    source   #modules modules
+    {#info info #source    source #current-module _   #modules modules
      #scopes scopes #type-context types    #host    host
      #seed seed #expected  expected #cursor  cursor
      #scope-type-vars scope-type-vars}
diff --git a/stdlib/source/lux/meta.lux b/stdlib/source/lux/meta.lux
index 6f1fb2720..e65e09b58 100644
--- a/stdlib/source/lux/meta.lux
+++ b/stdlib/source/lux/meta.lux
@@ -7,44 +7,44 @@
              [product]
              [ident "ident/" Codec<Text,Ident> Eq<Ident>]
              [maybe]
-             ["E" error]
+             ["e" error]
              [text "text/" Monoid<Text> Eq<Text>]
              (coll [list "list/" Monoid<List> Monad<List>])))
   (. [code]))
 
 ## (type: (Meta a)
-##   (-> Compiler (E;Error [Compiler a])))
+##   (-> Compiler (e;Error [Compiler a])))
 
 (struct: #export _ (F;Functor Meta)
   (def: (map f fa)
     (function [state]
       (case (fa state)
-        (#E;Error msg)
-        (#E;Error msg)
+        (#e;Error msg)
+        (#e;Error msg)
 
-        (#E;Success [state' a])
-        (#E;Success [state' (f a)])))))
+        (#e;Success [state' a])
+        (#e;Success [state' (f a)])))))
 
 (struct: #export _ (A;Applicative Meta)
   (def: functor Functor<Meta>)
 
   (def: (wrap x)
     (function [state]
-      (#E;Success [state x])))
+      (#e;Success [state x])))
 
   (def: (apply ff fa)
     (function [state]
       (case (ff state)
-        (#E;Success [state' f])
+        (#e;Success [state' f])
         (case (fa state')
-          (#E;Success [state'' a])
-          (#E;Success [state'' (f a)])
+          (#e;Success [state'' a])
+          (#e;Success [state'' (f a)])
 
-          (#E;Error msg)
-          (#E;Error msg))
+          (#e;Error msg)
+          (#e;Error msg))
 
-        (#E;Error msg)
-        (#E;Error msg)))))
+        (#e;Error msg)
+        (#e;Error msg)))))
 
 (struct: #export _ (Monad Meta)
   (def: applicative Applicative<Meta>)
@@ -52,10 +52,10 @@
   (def: (join mma)
     (function [state]
       (case (mma state)
-        (#E;Error msg)
-        (#E;Error msg)
+        (#e;Error msg)
+        (#e;Error msg)
 
-        (#E;Success [state' ma])
+        (#e;Success [state' ma])
         (ma state')))))
 
 (def: (get k plist)
@@ -71,68 +71,63 @@
       (get k plist'))))
 
 (def: #export (run' compiler action)
-  (All [a] (-> Compiler (Meta a) (E;Error [Compiler a])))
+  (All [a] (-> Compiler (Meta a) (e;Error [Compiler a])))
   (action compiler))
 
 (def: #export (run compiler action)
-  (All [a] (-> Compiler (Meta a) (E;Error a)))
+  (All [a] (-> Compiler (Meta a) (e;Error a)))
   (case (action compiler)
-    (#E;Error error)
-    (#E;Error error)
+    (#e;Error error)
+    (#e;Error error)
 
-    (#E;Success [_ output])
-    (#E;Success output)))
+    (#e;Success [_ output])
+    (#e;Success output)))
 
 (def: #export (either left right)
   {#;doc "Pick whichever computation succeeds."}
   (All [a] (-> (Meta a) (Meta a) (Meta a)))
   (function [compiler]
     (case (left compiler)
-      (#E;Error error)
+      (#e;Error error)
       (right compiler)
 
-      (#E;Success [compiler' output])
-      (#E;Success [compiler' output]))))
+      (#e;Success [compiler' output])
+      (#e;Success [compiler' output]))))
 
 (def: #export (assert message test)
   {#;doc "Fails with the given message if the test is false."}
   (-> Text Bool (Meta Unit))
   (function [compiler]
     (if test
-      (#E;Success [compiler []])
-      (#E;Error message))))
+      (#e;Success [compiler []])
+      (#e;Error message))))
 
 (def: #export (fail msg)
   {#;doc "Fails with the given message."}
   (All [a]
     (-> Text (Meta a)))
   (function [_]
-    (#E;Error msg)))
+    (#e;Error msg)))
 
 (def: #export (find-module name)
   (-> Text (Meta Module))
   (function [state]
     (case (get name (get@ #;modules state))
       (#;Some module)
-      (#E;Success [state module])
+      (#e;Success [state module])
 
       _
-      (#E;Error ($_ text/compose "Unknown module: " name)))))
+      (#e;Error ($_ text/compose "Unknown module: " name)))))
 
 (def: #export current-module-name
   (Meta Text)
   (function [state]
-    (case (list;last (get@ #;scopes state))
-      (#;Some scope)
-      (case (get@ #;name scope)
-        (#;Cons m-name #;Nil)
-        (#E;Success [state m-name])
-
-        _
-        (#E;Error "Improper name for scope."))
+    (case (get@ #;current-module state)
+      (#;Some current-module)
+      (#e;Success [state current-module])
 
       _
-      (#E;Error "Empty environment!")
+      (#e;Error "No current module.")
       )))
 
 (def: #export current-module
@@ -262,7 +257,7 @@
     (let [[module name] ident]
       (: (Meta (Maybe Macro))
          (function [state]
-           (#E;Success [state (find-macro' (get@ #;modules state) this-module module name)]))))))
+           (#e;Success [state (find-macro' (get@ #;modules state) this-module module name)]))))))
 
 (def: #export (normalize ident)
   {#;doc "If given an identifier without a module prefix, gives it the current module's name as prefix.
@@ -361,7 +356,7 @@
           A prefix can be given (or just be empty text \"\") to better identify the code for debugging purposes."}
   (-> Text (Meta Code))
   (function [state]
-    (#E;Success [(update@ #;seed n.inc state)
+    (#e;Success [(update@ #;seed n.inc state)
                  (code;symbol ["" ($_ text/compose "__gensym__" prefix (:: number;Codec<Text,Nat> encode (get@ #;seed state)))])])))
 
 (def: (get-local-symbol ast)
@@ -412,7 +407,7 @@
 (def: #export (module-exists? module)
   (-> Text (Meta Bool))
   (function [state]
-    (#E;Success [state (case (get module (get@ #;modules state))
+    (#e;Success [state (case (get module (get@ #;modules state))
                          (#;Some _)
                          true
                          
@@ -446,10 +441,10 @@
                                          (get@ [#;captured #;mappings] scope)))]
               (wrap type))
         (#;Some var-type)
-        (#E;Success [state var-type])
+        (#e;Success [state var-type])
 
         #;None
-        (#E;Error ($_ text/compose "Unknown variable: " name))))))
+        (#e;Error ($_ text/compose "Unknown variable: " name))))))
 
 (def: #export (find-def name)
   {#;doc "Looks-up a definition's whole data in the available modules (including the current one)."}
@@ -461,10 +456,10 @@
                 (^slots [#;defs]) (get v-prefix (get@ #;modules state))]
                (get v-name defs)))
       (#;Some _anns)
-      (#E;Success [state _anns])
+      (#e;Success [state _anns])
 
       _
-      (#E;Error ($_ text/compose "Unknown definition: " (ident/encode name))))))
+      (#e;Error ($_ text/compose "Unknown definition: " (ident/encode name))))))
 
 (def: #export (find-def-type name)
   {#;doc "Looks-up a definition's type in the available modules (including the current one)."}
@@ -495,8 +490,8 @@
   (-> Text (Meta (List [Text Def])))
   (function [state]
     (case (get module-name (get@ #;modules state))
-      #;None          (#E;Error ($_ text/compose "Unknown module: " module-name))
-      (#;Some module) (#E;Success [state (get@ #;defs module)])
+      #;None          (#e;Error ($_ text/compose "Unknown module: " module-name))
+      (#;Some module) (#e;Success [state (get@ #;defs module)])
       )))
 
 (def: #export (exports module-name)
@@ -516,7 +511,7 @@
     (|> state
         (get@ #;modules)
         [state]
-        #E;Success)))
+        #e;Success)))
 
 (def: #export (tags-of type-name)
   {#;doc "All the tags associated with a type definition."}
@@ -535,7 +530,7 @@
   {#;doc "The cursor of the current expression being analyzed."}
   (Meta Cursor)
   (function [state]
-    (#E;Success [state (get@ #;cursor state)])))
+    (#e;Success [state (get@ #;cursor state)])))
 
 (def: #export expected-type
   {#;doc "The expected type of the current expression being analyzed."}
@@ -543,10 +538,10 @@
   (function [state]
     (case (get@ #;expected state)
       (#;Some type)
-      (#E;Success [state type])
+      (#e;Success [state type])
 
       #;None
-      (#E;Error "Not expecting any type."))))
+      (#e;Error "Not expecting any type."))))
 
 (def: #export (imported-modules module-name)
   {#;doc "All the modules imported by a specified module."}
@@ -591,10 +586,10 @@
   (function [state]
     (case (list;inits (get@ #;scopes state))
       #;None
-      (#E;Error "No local environment")
+      (#e;Error "No local environment")
 
       (#;Some scopes)
-      (#E;Success [state
+      (#e;Success [state
                    (list/map (|>. (get@ [#;locals #;mappings])
                                   (list/map (function [[name [type _]]]
                                               [name type])))
@@ -617,12 +612,12 @@
   {#;doc "Obtains the current state of the compiler."}
   (Meta Compiler)
   (function [compiler]
-    (#E;Success [compiler compiler])))
+    (#e;Success [compiler compiler])))
 
 (def: #export type-context
   (Meta Type-Context)
   (function [compiler]
-    (#E;Success [compiler (get@ #;type-context compiler)])))
+    (#e;Success [compiler (get@ #;type-context compiler)])))
 
 (do-template [<macro> <func> <desc>]
   [(macro: #export (<macro> tokens)