- Now storing the type-variables created during type-checking for the sake of reference later on in definitions.

4 files changed, 93 insertions, 48 deletions

diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 0bfa647e5..1844aab3d 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -122,8 +122,10 @@
 
                 (&/$UnivQ _)
                 (|do [$var &type/existential
+                      :let [(&/$ExT $var-id) $var]
                       exo-type** (&type/apply-type exo-type* $var)
-                      [[tuple-type tuple-cursor] tuple-analysis] (&&/cap-1 (analyse-tuple analyse (&/$Right exo-type**) ?elems))]
+                      [[tuple-type tuple-cursor] tuple-analysis] (&/with-scope-type-var $var-id
+                                                                   (&&/cap-1 (analyse-tuple analyse (&/$Right exo-type**) ?elems)))]
                   (return (&/|list (&&/|meta exo-type tuple-cursor
                                              tuple-analysis))))
 
@@ -222,8 +224,10 @@
 
           (&/$UnivQ _)
           (|do [$var &type/existential
+                :let [(&/$ExT $var-id) $var]
                 exo-type** (&type/apply-type exo-type* $var)]
-            (analyse-variant analyse (&/$Right exo-type**) idx is-last? ?values))
+            (&/with-scope-type-var $var-id
+              (analyse-variant analyse (&/$Right exo-type**) idx is-last? ?values)))
 
           (&/$ExQ _)
           (&type/with-var
@@ -379,16 +383,18 @@
       (|do [[real-name [?type ?meta ?value]] (&&module/find-def ?module ?name)]
         (|case (&&meta/meta-get &&meta/macro?-tag ?meta)
           (&/$Some _)
-          (|do [macro-expansion (fn [state] (try (-> ?value (.apply ?args) (.apply state))
-                                             (catch java.lang.StackOverflowError e
-                                               (|let [[r-prefix r-name] real-name]
-                                                 (do (.printStackTrace e)
-                                                   (throw e))))))
+          (|do [macro-expansion (fn [state]
+                                  (|case (-> ?value (.apply ?args) (.apply state))
+                                    (&/$Right state* output)
+                                    (&/$Right (&/T [state* output]))
+
+                                    (&/$Left error)
+                                    ((&/fail-with-loc error) state)))
                 module-name &/get-module-name
                 ;; :let [[r-prefix r-name] real-name
-                ;;       _ (when (or (= "defsig" r-name)
-                ;;                   (= "deftype" r-name)
-                ;;                   (= "@type" r-name)
+                ;;       _ (when (or (= "defstruct" r-name)
+                ;;                   (= "struct" r-name)
+                ;;                   ;; (= "@type" r-name)
                 ;;                   )
                 ;;           (->> (&/|map &/show-ast macro-expansion)
                 ;;                (&/|interpose "\n")
@@ -493,8 +499,10 @@
         (|case exo-type
           (&/$UnivQ _)
           (|do [$var &type/existential
+                :let [(&/$ExT $var-id) $var]
                 exo-type** (&type/apply-type exo-type* $var)]
-            (analyse-lambda* analyse exo-type** ?self ?arg ?body))
+            (&/with-scope-type-var $var-id
+              (analyse-lambda* analyse exo-type** ?self ?arg ?body)))
 
           (&/$ExQ _)
           (&type/with-var
@@ -523,8 +531,10 @@
   (|case exo-type
     (&/$UnivQ _)
     (|do [$var &type/existential
+          :let [(&/$ExT $var-id) $var]
           exo-type* (&type/apply-type exo-type $var)
-          [_ _expr] (analyse-lambda** analyse exo-type* ?self ?arg ?body)
+          [_ _expr] (&/with-scope-type-var $var-id
+                      (analyse-lambda** analyse exo-type* ?self ?arg ?body))
           _cursor &/cursor]
       (return (&&/|meta exo-type _cursor _expr)))
     
diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj
index c15062783..3ee9d28d4 100644
--- a/src/lux/analyser/module.clj
+++ b/src/lux/analyser/module.clj
@@ -9,7 +9,7 @@
                      [template :refer [do-template]])
             clojure.core.match
             clojure.core.match.array
-            (lux [base :as & :refer [deftuple |let |do return return* fail fail* |case]]
+            (lux [base :as & :refer [deftuple |let |do return return* |case]]
                  [type :as &type]
                  [host :as &host])
             [lux.host.generics :as &host-generics]
@@ -42,7 +42,8 @@
   (|do [current-module &/get-module-name]
     (fn [state]
       (if (&/|member? module (->> state (&/get$ &/$modules) (&/|get current-module) (&/get$ $imports)))
-        (fail* (str "[Analyser Error] Can't import module " (pr-str module) " twice @ " current-module))
+        ((&/fail-with-loc (str "[Analyser Error] Can't import module " (pr-str module) " twice @ " current-module))
+         state)
         (return* (&/update$ &/$modules
                             (fn [ms]
                               (&/|update current-module
@@ -81,7 +82,8 @@
                nil)
       
       _
-      (fail* (str "[Analyser Error] Can't create a new global definition outside of a global environment: " module ";" name)))))
+      ((&/fail-with-loc (str "[Analyser Error] Can't create a new global definition outside of a global environment: " module ";" name))
+       state))))
 
 (defn def-type [module name]
   "(-> Text Text (Lux Type))"
@@ -90,8 +92,10 @@
       (if-let [$def (->> $module (&/get$ $defs) (&/|get name))]
         (|let [[?type ?meta ?value] $def]
           (return* state ?type))
-        (fail* (str "[Analyser Error] Unknown definition: " (str module ";" name))))
-      (fail* (str "[Analyser Error] Unknown module: " module)))))
+        ((&/fail-with-loc (str "[Analyser Error] Unknown definition: " (str module ";" name)))
+         state))
+      ((&/fail-with-loc (str "[Analyser Error] Unknown module: " module))
+       state))))
 
 (defn type-def [module name]
   "(-> Text Text (Lux [Bool Type]))"
@@ -110,9 +114,12 @@
                                  ?value]))
 
             _
-            (fail* (str "[Analyser Error] Not a type: " (&/ident->text (&/T [module name]))))))
-        (fail* (str "[Analyser Error] Unknown definition: " (&/ident->text (&/T [module name])))))
-      (fail* (str "[Analyser Error] Unknown module: " module)))))
+            ((&/fail-with-loc (str "[Analyser Error] Not a type: " (&/ident->text (&/T [module name]))))
+             state)))
+        ((&/fail-with-loc (str "[Analyser Error] Unknown definition: " (&/ident->text (&/T [module name]))))
+         state))
+      ((&/fail-with-loc (str "[Analyser Error] Unknown module: " module))
+       state))))
 
 (defn exists? [name]
   "(-> Text (Lux Bool))"
@@ -125,12 +132,14 @@
     (fn [state]
       (if-let [real-name (->> state (&/get$ &/$modules) (&/|get current-module) (&/get$ $module-aliases) (&/|get name))]
         (return* state real-name)
-        (fail* (str "[Analyser Error] Unknown alias: " name))))))
+        ((&/fail-with-loc (str "[Analyser Error] Unknown alias: " name))
+         state)))))
 
 (defn alias [module alias reference]
   (fn [state]
     (if-let [real-name (->> state (&/get$ &/$modules) (&/|get module) (&/get$ $module-aliases) (&/|get alias))]
-      (fail* (str "[Analyser Error] Can't re-use alias \"" alias "\" @ " module))
+      ((&/fail-with-loc (str "[Analyser Error] Can't re-use alias \"" alias "\" @ " module))
+       state)
       (return* (->> state
                     (&/update$ &/$modules
                                (fn [ms]
@@ -161,9 +170,12 @@
                 (return* state (&/T [(&/T [module name]) $def]))
 
                 _
-                (fail* (str "[Analyser Error] Can't use unexported definition: " (str module &/+name-separator+ name))))))
-          (fail* (str "[Analyser Error] Definition does not exist: " (str module &/+name-separator+ name))))
-        (fail* (str "[Analyser Error] Module doesn't exist: " module))))))
+                ((&/fail-with-loc (str "[Analyser Error] Can't use unexported definition: " (str module &/+name-separator+ name)))
+                 state))))
+          ((&/fail-with-loc (str "[Analyser Error] Definition does not exist: " (str module &/+name-separator+ name)))
+           state))
+        ((&/fail-with-loc (str "[Analyser Error] Module doesn't exist: " module))
+         state)))))
 
 (defn ensure-type-def [def-data]
   "(-> DefData (Lux Type))"
@@ -173,7 +185,7 @@
       (return ?type)
 
       _
-      (fail (str "[Analyser Error] Not a type definition: " (&/adt->text def-data))))))
+      (&/fail-with-loc (str "[Analyser Error] Not a type definition: " (&/adt->text def-data))))))
 
 (defn defined? [module name]
   (&/try-all% (&/|list (|do [_ (find-def module name)]
@@ -204,7 +216,8 @@
     (fn [state]
       (if-let [=module (->> state (&/get$ &/$modules) (&/|get module))]
         (return* state (&/get$ <tag> =module))
-        (fail* (str "[Lux Error] Unknown module: " module)))
+        ((&/fail-with-loc (str "[Lux Error] Unknown module: " module))
+         state))
       ))
 
   tags-by-module  $tags  "(-> Text (Lux (List (, Text (, Int (List Text) Type)))))"
@@ -215,7 +228,7 @@
   (|do [tags-table (tags-by-module module)
         _ (&/map% (fn [tag]
                     (if (&/|get tag tags-table)
-                      (fail (str "[Analyser Error] Can't re-declare tag: " (&/ident->text (&/T [module tag]))))
+                      (&/fail-with-loc (str "[Analyser Error] Can't re-declare tag: " (&/ident->text (&/T [module tag]))))
                       (return nil)))
                   tags)]
     (return nil)))
@@ -250,7 +263,8 @@
                                            =modules))
                               state)
                    nil))
-        (fail* (str "[Lux Error] Unknown module: " module))))))
+        ((&/fail-with-loc (str "[Lux Error] Unknown module: " module))
+         state)))))
 
 (defn ensure-can-see-tag [module tag-name]
   "(-> Text Text (Lux Unit))"
@@ -262,9 +276,12 @@
             (if (or ?exported
                     (= module current-module))
               (return* state &/unit-tag)
-              (fail* (str "[Analyser Error] Can't access tag #" (&/ident->text (&/T [module tag-name])) " from module " current-module))))
-          (fail* (str "[Module Error] Unknown tag: " (&/ident->text (&/T [module tag-name])))))
-        (fail* (str "[Module Error] Unknown module: " module))))))
+              ((&/fail-with-loc (str "[Analyser Error] Can't access tag #" (&/ident->text (&/T [module tag-name])) " from module " current-module))
+               state)))
+          ((&/fail-with-loc (str "[Module Error] Unknown tag: " (&/ident->text (&/T [module tag-name]))))
+           state))
+        ((&/fail-with-loc (str "[Module Error] Unknown module: " module))
+         state)))))
 
 (do-template [<name> <part> <doc>]
   (defn <name> [module tag-name]
@@ -274,8 +291,10 @@
         (if-let [^objects idx+tags+exported+type (&/|get tag-name (&/get$ $tags =module))]
           (|let [[?idx ?tags ?exported ?type] idx+tags+exported+type]
             (return* state <part>))
-          (fail* (str "[Module Error] Unknown tag: " (&/ident->text (&/T [module tag-name])))))
-        (fail* (str "[Module Error] Unknown module: " module)))))
+          ((&/fail-with-loc (str "[Module Error] Unknown tag: " (&/ident->text (&/T [module tag-name]))))
+           state))
+        ((&/fail-with-loc (str "[Module Error] Unknown module: " module))
+         state))))
 
   tag-index ?idx  "(-> Text Text (Lux Int))"
   tag-group ?tags "(-> Text Text (Lux (List Ident)))"
@@ -302,7 +321,7 @@
     (|case (&meta/meta-get <tag> meta)
       (&/$Some (&/$BoolM true))
       (&/try-all% (&/|list (&type/check <type> type)
-                           (fail (str "[Analyser Error] Can't tag as lux;" <desc> "? if it's not a " <desc> ": " (str module ";" name)))))
+                           (&/fail-with-loc (str "[Analyser Error] Can't tag as lux;" <desc> "? if it's not a " <desc> ": " (str module ";" name)))))
 
       _
       (return nil)))
diff --git a/src/lux/analyser/record.clj b/src/lux/analyser/record.clj
index 335b46dbb..81332b34c 100644
--- a/src/lux/analyser/record.clj
+++ b/src/lux/analyser/record.clj
@@ -25,7 +25,7 @@
                                  (return (&/T [tags type])))
 
                                _
-                               (fail "[Analyser Error] Wrong syntax for records. Odd elements must be tags."))
+                               (&/fail-with-loc "[Analyser Error] Wrong syntax for records. Odd elements must be tags."))
         =pairs (&/map% (fn [kv]
                          (|case kv
                            [[_ (&/$TagS k)] v]
@@ -33,7 +33,7 @@
                              (return (&/T [(&/ident->text =k) v])))
 
                            _
-                           (fail "[Analyser Error] Wrong syntax for records. Odd elements must be tags.")))
+                           (&/fail-with-loc "[Analyser Error] Wrong syntax for records. Odd elements must be tags.")))
                        pairs)
         _ (let [num-expected (&/|length tag-group)
                 num-got (&/|length =pairs)]
@@ -42,6 +42,6 @@
         =members (&/map% (fn [tag]
                            (if-let [member (&/|get tag =pairs)]
                              (return member)
-                             (fail (str "[Analyser Error] Missing tag: " tag))))
+                             (&/fail-with-loc (str "[Analyser Error] Missing tag: " tag))))
                          (&/|map &/ident->text tag-group))]
     (return (&/T [=members tag-type]))))
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 54baf16bb..d9198885e 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -2,7 +2,6 @@
 ;;  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
 ;;  If a copy of the MPL was not distributed with this file,
 ;;  You can obtain one at http://mozilla.org/MPL/2.0/.
-
 (ns lux.base
   (:require (clojure [template :refer [do-template]])
             [clojure.core.match :as M :refer [matchv]]
@@ -149,6 +148,7 @@
    "type-vars"
    "expected"
    "seed"
+   "scope-type-vars"
    "host"])
 
 ;; Compiler
@@ -592,10 +592,20 @@
         $Nil
         xs))
 
+(defn add-loc [meta ^String msg]
+  (if (.startsWith msg "@")
+    msg
+    (|let [[file line col] meta]
+      (str "@ " file "," line "," col "\n" msg))))
+
+(defn fail-with-loc [msg]
+  (fn [state]
+    (fail* (add-loc (get$ $cursor state) msg))))
+
 (defn assert! [test message]
   (if test
     (return unit-tag)
-    (fail message)))
+    (fail-with-loc message)))
 
 (def get-state
   (fn [state]
@@ -764,6 +774,8 @@
       $None
       ;; "lux;seed"
       0
+      ;; scope-type-vars
+      $Nil
       ;; "lux;host"
       (host nil)]
      ))
@@ -1256,12 +1268,16 @@
 (defn |partition [n xs]
   (->> xs ->seq (partition-all n) (map ->list) ->list))
 
-(defn add-loc [meta ^String msg]
-  (if (.startsWith msg "@")
-    msg
-    (|let [[file line col] meta]
-      (str "@ " file "," line "," col "\n" msg))))
-
-(defn fail-with-loc [msg]
+(defn with-scope-type-var [id body]
   (fn [state]
-    (fail* (add-loc (get$ $cursor state) msg))))
+    (|case (body (set$ $scope-type-vars
+                       ($Cons id (get$ $scope-type-vars state))
+                       state))
+      ($Right [state* output])
+      ($Right (T [(set$ $scope-type-vars
+                        (get$ $scope-type-vars state)
+                        state*)
+                  output]))
+
+      ($Left msg)
+      ($Left msg))))