- Type-vars no longer get deleted.

- Fixed some bugs.

11 files changed, 110 insertions, 102 deletions

diff --git a/new-luxc/source/luxc/base.lux b/new-luxc/source/luxc/base.lux
index 580f5593f..c7768cd8c 100644
--- a/new-luxc/source/luxc/base.lux
+++ b/new-luxc/source/luxc/base.lux
@@ -63,6 +63,18 @@
       (#e;Success [(set@ #;type-context context' compiler)
                    output]))))
 
+(def: #export (with-fresh-type-env action)
+  (All [a] (-> (Meta a) (Meta a)))
+  (function [compiler]
+    (let [old (get@ #;type-context compiler)]
+      (case (action (set@ #;type-context tc;fresh-context compiler))
+        (#e;Success [compiler' output])
+        (#e;Success [(set@ #;type-context old compiler')
+                     output])
+
+        output
+        output))))
+
 (def: #export (infer actualT)
   (-> Type (Meta Unit))
   (do meta;Monad<Meta>
diff --git a/new-luxc/source/luxc/lang/analysis/case.lux b/new-luxc/source/luxc/lang/analysis/case.lux
index f68733d7f..5f8ed344f 100644
--- a/new-luxc/source/luxc/lang/analysis/case.lux
+++ b/new-luxc/source/luxc/lang/analysis/case.lux
@@ -46,7 +46,7 @@
     (#;Var id)
     (do meta;Monad<Meta>
       [? (&;with-type-env
-           (tc;bound? id))]
+           (tc;concrete? id))]
       (if ?
         (do @
           [type' (&;with-type-env
diff --git a/new-luxc/source/luxc/lang/analysis/common.lux b/new-luxc/source/luxc/lang/analysis/common.lux
index 4cbf5aedf..4d16e4ae6 100644
--- a/new-luxc/source/luxc/lang/analysis/common.lux
+++ b/new-luxc/source/luxc/lang/analysis/common.lux
@@ -1,7 +1,7 @@
 (;module:
   lux
   (lux (control monad
-                pipe)
+                ["ex" exception #+ exception:])
        (data text/format
              [product])
        [meta #+ Monad<Meta>]
@@ -14,28 +14,25 @@
   (All [a] (-> (Meta Analysis) (Meta [Type Analysis])))
   (do Monad<Meta>
     [[var-id var-type] (&;with-type-env
-                         tc;create)
+                         tc;var)
      analysis (&;with-expected-type var-type
                 action)
      analysis-type (&;with-type-env
-                     (tc;clean var-id var-type))
-     _ (&;with-type-env
-         (tc;delete var-id))]
+                     (tc;clean var-id var-type))]
     (wrap [analysis-type analysis])))
 
 (def: #export (with-var body)
   (All [a] (-> (-> [Nat Type] (Meta a)) (Meta a)))
   (do Monad<Meta>
     [[id var] (&;with-type-env
-                tc;create)
-     output (body [id var])
-     _ (&;with-type-env
-         (tc;delete id))]
-    (wrap output)))
+                tc;var)]
+    (body [id var])))
+
+(exception: #export Variant-Tag-Out-Of-Bounds)
 
 (def: #export (variant-out-of-bounds-error type size tag)
   (All [a] (-> Type Nat Nat (Meta a)))
-  (&;fail (format "Trying to create variant with tag beyond type's limitations." "\n"
-                  " Tag: " (%i (nat-to-int tag)) "\n"
-                  "Size: " (%i (nat-to-int size)) "\n"
-                  "Type: " (%type type))))
+  (&;throw Variant-Tag-Out-Of-Bounds
+           (format "         Tag: " (%n tag) "\n"
+                   "Variant Size: " (%n size) "\n"
+                   "Variant Type: " (%type type))))
diff --git a/new-luxc/source/luxc/lang/analysis/function.lux b/new-luxc/source/luxc/lang/analysis/function.lux
index 5a6df4d3e..42a021577 100644
--- a/new-luxc/source/luxc/lang/analysis/function.lux
+++ b/new-luxc/source/luxc/lang/analysis/function.lux
@@ -108,8 +108,5 @@
                                                                   (format "\n  " (%n idx) " " (%code argC))))
                                                       (text;join-with "")))))
     (do meta;Monad<Meta>
-      [expectedT meta;expected-type
-       [applyT argsA] (&inference;apply-function analyse funcT args)
-       _ (&;with-type-env
-           (tc;check expectedT applyT))]
+      [[applyT argsA] (&inference;apply-function analyse funcT args)]
       (wrap (la;apply argsA funcA)))))
diff --git a/new-luxc/source/luxc/lang/analysis/inference.lux b/new-luxc/source/luxc/lang/analysis/inference.lux
index fea685024..e2866ac87 100644
--- a/new-luxc/source/luxc/lang/analysis/inference.lux
+++ b/new-luxc/source/luxc/lang/analysis/inference.lux
@@ -99,7 +99,9 @@
   (-> &;Analyser Type (List Code) (Meta [Type (List Analysis)]))
   (case args
     #;Nil
-    (:: Monad<Meta> wrap [inferT (list)])
+    (do Monad<Meta>
+      [_ (&;infer inferT)]
+      (wrap [inferT (list)]))
     
     (#;Cons argC args')
     (case inferT
@@ -113,7 +115,7 @@
             [[outputT argsA] (apply-function analyse (maybe;assume (type;apply (list varT) inferT)) args)]
             (do @
               [? (&;with-type-env
-                   (tc;bound? var-id))
+                   (tc;concrete? var-id))
                ## Quantify over the type if genericity/parametricity
                ## is discovered.
                outputT' (if ?
@@ -145,13 +147,13 @@
       ## things together more easily.
       (#;Function inputT outputT)
       (do Monad<Meta>
-        [argA (&;with-stacked-errors
+        [[outputT' args'A] (apply-function analyse outputT args')
+         argA (&;with-stacked-errors
                 (function [_] (Cannot-Infer-Argument
                                (format "Inferred Type: " (%type inputT) "\n"
                                        "     Argument: " (%code argC))))
                 (&;with-expected-type inputT
-                  (analyse argC)))
-         [outputT' args'A] (apply-function analyse outputT args')]
+                  (analyse argC)))]
         (wrap [outputT' (list& argA args'A)]))
 
       _
diff --git a/new-luxc/source/luxc/lang/analysis/structure.lux b/new-luxc/source/luxc/lang/analysis/structure.lux
index 5cac1a0d3..9308fcfef 100644
--- a/new-luxc/source/luxc/lang/analysis/structure.lux
+++ b/new-luxc/source/luxc/lang/analysis/structure.lux
@@ -64,9 +64,9 @@
 
         (#;Var id)
         (do @
-          [bound? (&;with-type-env
-                    (tc;bound? id))]
-          (if bound?
+          [concrete? (&;with-type-env
+                       (tc;concrete? id))]
+          (if concrete?
             (do @
               [expectedT' (&;with-type-env
                             (tc;read id))]
@@ -171,9 +171,9 @@
 
         (#;Var id)
         (do @
-          [bound? (&;with-type-env
-                    (tc;bound? id))]
-          (if bound?
+          [concrete? (&;with-type-env
+                       (tc;concrete? id))]
+          (if concrete?
             (do @
               [expectedT' (&;with-type-env
                             (tc;read id))]
@@ -227,8 +227,6 @@
         [#let [case-size (list;size group)]
          inferenceT (&inference;variant idx case-size variantT)
          [inferredT valueA+] (&inference;apply-function analyse inferenceT (list valueC))
-         _ (&;with-type-env
-             (tc;check expectedT inferredT))
          temp &scope;next-local]
         (wrap (la;sum idx case-size temp (|> valueA+ list;head maybe;assume))))
 
@@ -308,9 +306,7 @@
       (#;Var _)
       (do @
         [inferenceT (&inference;record recordT)
-         [inferredT membersA] (&inference;apply-function analyse inferenceT membersC)
-         _ (&;with-type-env
-             (tc;check expectedT inferredT))]
+         [inferredT membersA] (&inference;apply-function analyse inferenceT membersC)]
         (wrap (la;product membersA)))
 
       _
diff --git a/new-luxc/source/luxc/lang/analysis/type.lux b/new-luxc/source/luxc/lang/analysis/type.lux
index 74bb712f4..0a8abd76b 100644
--- a/new-luxc/source/luxc/lang/analysis/type.lux
+++ b/new-luxc/source/luxc/lang/analysis/type.lux
@@ -1,8 +1,8 @@
 (;module:
   lux
   (lux (control monad)
-       [meta #+ Monad<Meta>]
-       (meta (type ["TC" check])))
+       [meta]
+       (meta (type ["tc" check])))
   (luxc ["&" base]
         (lang ["la" analysis #+ Analysis])))
 
@@ -11,21 +11,21 @@
 ## computing Lux type values.
 (def: #export (analyse-check analyse eval type value)
   (-> &;Analyser &;Eval Code Code (Meta Analysis))
-  (do Monad<Meta>
+  (do meta;Monad<Meta>
     [actualT (eval Type type)
      #let [actualT (:! Type actualT)]
      expectedT meta;expected-type
      _ (&;with-type-env
-         (TC;check expectedT actualT))]
+         (tc;check expectedT actualT))]
     (&;with-expected-type actualT
       (analyse value))))
 
 (def: #export (analyse-coerce analyse eval type value)
   (-> &;Analyser &;Eval Code Code (Meta Analysis))
-  (do Monad<Meta>
+  (do meta;Monad<Meta>
     [actualT (eval Type type)
      expectedT meta;expected-type
      _ (&;with-type-env
-         (TC;check expectedT (:! Type actualT)))]
+         (tc;check expectedT (:! Type actualT)))]
     (&;with-expected-type Top
       (analyse value))))
diff --git a/new-luxc/source/luxc/lang/translation.lux b/new-luxc/source/luxc/lang/translation.lux
index 779cb92fd..c4ebf3642 100644
--- a/new-luxc/source/luxc/lang/translation.lux
+++ b/new-luxc/source/luxc/lang/translation.lux
@@ -39,24 +39,25 @@
   (case code
     (^code ("lux def" (~ [_ (#;Symbol ["" def-name])]) (~ valueC) (~ metaC)))
     (hostL;with-context def-name
-      (do meta;Monad<Meta>
-        [[_ metaA] (&;with-scope
-                     (&;with-expected-type Code
-                       (analyse metaC)))
-         metaI (expressionT;translate (expressionS;synthesize metaA))
-         metaV (evalT;eval metaI)
-         [_ valueT valueA] (&;with-scope
-                             (if (meta;type? (:! Code metaV))
-                               (&;with-expected-type Type
+      (&;with-fresh-type-env
+        (do meta;Monad<Meta>
+          [[_ metaA] (&;with-scope
+                       (&;with-expected-type Code
+                         (analyse metaC)))
+           metaI (expressionT;translate (expressionS;synthesize metaA))
+           metaV (evalT;eval metaI)
+           [_ valueT valueA] (&;with-scope
+                               (if (meta;type? (:! Code metaV))
                                  (do @
-                                   [valueA (analyse valueC)]
-                                   (wrap [Type valueA])))
-                               (commonA;with-unknown-type
-                                 (analyse valueC))))
-         valueI (expressionT;translate (expressionS;synthesize valueA))
-         _ (&;with-scope
-             (statementT;translate-def def-name valueT valueI metaI (:! Code metaV)))]
-        (wrap [])))
+                                   [valueA (&;with-expected-type Type
+                                             (analyse valueC))]
+                                   (wrap [Type valueA]))
+                                 (commonA;with-unknown-type
+                                   (analyse valueC))))
+           valueI (expressionT;translate (expressionS;synthesize valueA))
+           _ (&;with-scope
+               (statementT;translate-def def-name valueT valueI metaI (:! Code metaV)))]
+          (wrap []))))
 
     (^code ("lux program" (~ [_ (#;Symbol ["" program-args])]) (~ programC)))
     (do meta;Monad<Meta>
diff --git a/new-luxc/source/luxc/lang/translation/expression.jvm.lux b/new-luxc/source/luxc/lang/translation/expression.jvm.lux
index 81cdc1261..fa5f54647 100644
--- a/new-luxc/source/luxc/lang/translation/expression.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/expression.jvm.lux
@@ -50,7 +50,7 @@
     (^ [_ (#;Form (list [_ (#;Int var)]))])
     (if (variableL;captured? var)
       (referenceT;translate-captured var)
-      (referenceT;translate-variable var))
+      (referenceT;translate-local var))
 
     [_ (#;Symbol definition)]
     (referenceT;translate-definition definition)
diff --git a/new-luxc/source/luxc/lang/translation/function.jvm.lux b/new-luxc/source/luxc/lang/translation/function.jvm.lux
index bbf295d18..ea6d371fa 100644
--- a/new-luxc/source/luxc/lang/translation/function.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/function.jvm.lux
@@ -14,22 +14,14 @@
         (lang ["la" analysis]
               ["ls" synthesis]
               (translation [";T" common]
-                           [";T" runtime])
+                           [";T" runtime]
+                           [";T" reference])
               [";L" variable #+ Variable])))
 
 
 (def: arity-field Text "arity")
 (def: $Object $;Type ($t;class "java.lang.Object" (list)))
 
-(do-template [<name> <prefix>]
-  [(def: #export (<name> idx)
-     (-> Nat Text)
-     (|> idx nat-to-int %i (format <prefix>)))]
-
-  [captured "c"]
-  [partial  "p"]
-  )
-
 (def: (poly-arg? arity)
   (-> ls;Arity Bool)
   (n.> +1 arity))
@@ -97,7 +89,7 @@
   (-> (List Variable) $;Def)
   (|> (list;enumerate env)
       (list/map (function [[env-idx env-source]]
-                  ($d;field #$;Private $;finalF (captured env-idx) $Object)))
+                  ($d;field #$;Private $;finalF (referenceT;captured env-idx) $Object)))
       $d;fuse))
 
 (def: (with-partial arity)
@@ -105,28 +97,24 @@
   (if (poly-arg? arity)
     (|> (list;n.range +0 (n.- +2 arity))
         (list/map (function [idx]
-                    ($d;field #$;Private $;finalF (partial idx) $Object)))
+                    ($d;field #$;Private $;finalF (referenceT;partial idx) $Object)))
         $d;fuse)
     id))
 
 (def: (instance class arity env)
-  (-> Text ls;Arity (List Variable) $;Inst)
-  (let [captureI (|> env
-                     (list/map (function [source]
-                                 (if (variableL;captured? source)
-                                   ($i;GETFIELD class (captured (variableL;captured-register source)) $Object)
-                                   ($i;ALOAD (int-to-nat source)))))
-                     $i;fuse)
-        argsI (if (poly-arg? arity)
-                (|> (nullsI (n.dec arity))
-                    (list ($i;int 0))
-                    $i;fuse)
-                id)]
-    (|>. ($i;NEW class)
-         $i;DUP
-         captureI
-         argsI
-         ($i;INVOKESPECIAL class "<init>" (init-method env arity) false))))
+  (-> Text ls;Arity (List Variable) (Meta $;Inst))
+  (do meta;Monad<Meta>
+    [captureI+ (monad;map @ referenceT;translate-variable env)
+     #let [argsI (if (poly-arg? arity)
+                   (|> (nullsI (n.dec arity))
+                       (list ($i;int 0))
+                       $i;fuse)
+                   id)]]
+    (wrap (|>. ($i;NEW class)
+               $i;DUP
+               ($i;fuse captureI+)
+               argsI
+               ($i;INVOKESPECIAL class "<init>" (init-method env arity) false)))))
 
 (def: (with-reset class arity env)
   (-> Text ls;Arity (List Variable) $;Def)
@@ -138,7 +126,7 @@
                                     _ (list;n.range +0 (n.dec env-size)))
                                   (list/map (function [source]
                                               (|>. ($i;ALOAD +0)
-                                                   ($i;GETFIELD class (captured source) $Object))))
+                                                   ($i;GETFIELD class (referenceT;captured source) $Object))))
                                   $i;fuse)
                      argsI (|> (nullsI (n.dec arity))
                                (list ($i;int 0))
@@ -182,7 +170,7 @@
                             (list/map (function [register]
                                         (|>. ($i;ALOAD +0)
                                              ($i;ALOAD (n.inc register))
-                                             ($i;PUTFIELD class (captured register) $Object))))
+                                             ($i;PUTFIELD class (referenceT;captured register) $Object))))
                             $i;fuse)
         store-partialI (if (poly-arg? arity)
                          (|> (list;n.range +0 (n.- +2 arity))
@@ -190,7 +178,7 @@
                                          (let [register (offset-partial idx)]
                                            (|>. ($i;ALOAD +0)
                                                 ($i;ALOAD (n.inc register))
-                                                ($i;PUTFIELD class (partial idx) $Object)))))
+                                                ($i;PUTFIELD class (referenceT;partial idx) $Object)))))
                              $i;fuse)
                          id)]
     ($d;method #$;Public $;noneM "<init>" (init-method env arity)
@@ -212,7 +200,7 @@
                    (list/map (function [[stage @label]]
                                (let [load-partialsI (if (n.> +0 stage)
                                                       (|> (list;n.range +0 (n.dec stage))
-                                                          (list/map (|>. partial (load-fieldI class)))
+                                                          (list/map (|>. referenceT;partial (load-fieldI class)))
                                                           $i;fuse)
                                                       id)]
                                  (cond (i.= arity-over-extent (nat-to-int stage))
@@ -242,7 +230,7 @@
                                              load-capturedI (|> (case env-size
                                                                   +0 (list)
                                                                   _ (list;n.range +0 (n.dec env-size)))
-                                                                (list/map (|>. captured (load-fieldI class)))
+                                                                (list/map (|>. referenceT;captured (load-fieldI class)))
                                                                 $i;fuse)]
                                          (|>. ($i;label @label)
                                               ($i;NEW class)
@@ -269,7 +257,7 @@
 
 (def: #export (with-function @begin class env arity bodyI)
   (-> $;Label Text (List Variable) ls;Arity $;Inst
-      [$;Def $;Inst])
+      (Meta [$;Def $;Inst]))
   (let [env-size (list;size env)
         applyD (: $;Def
                   (if (poly-arg? arity)
@@ -289,9 +277,10 @@
                           (with-init class env arity)
                           (with-reset class arity env)
                           applyD
-                          ))
-        instanceI (instance class arity env)]
-    [functionD instanceI]))
+                          ))]
+    (do meta;Monad<Meta>
+      [instanceI (instance class arity env)]
+      (wrap [functionD instanceI]))))
 
 (def: #export (translate-function translate env arity bodyS)
   (-> (-> ls;Synthesis (Meta $;Inst))
@@ -302,7 +291,7 @@
      [function-class bodyI] (hostL;with-sub-context
                               (hostL;with-anchor [@begin +1]
                                 (translate bodyS)))
-     #let [[functionD instanceI] (with-function @begin function-class env arity bodyI)]
+     [functionD instanceI] (with-function @begin function-class env arity bodyI)
      _ (commonT;store-class function-class
                             ($d;class #$;V1.6 #$;Public $;finalC
                                       function-class (list)
diff --git a/new-luxc/source/luxc/lang/translation/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/reference.jvm.lux
index 3e835f8e1..8e229af9c 100644
--- a/new-luxc/source/luxc/lang/translation/reference.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/reference.jvm.lux
@@ -11,8 +11,16 @@
                    ["$i" inst]))
         (lang ["ls" synthesis]
               [";L" variable #+ Variable]
-              (translation [";T" common]
-                           [";T" function]))))
+              (translation [";T" common]))))
+
+(do-template [<name> <prefix>]
+  [(def: #export (<name> idx)
+     (-> Nat Text)
+     (|> idx nat-to-int %i (format <prefix>)))]
+
+  [captured "c"]
+  [partial  "p"]
+  )
 
 (def: #export (translate-captured variable)
   (-> Variable (Meta $;Inst))
@@ -20,13 +28,19 @@
     [function-class hostL;context]
     (wrap (|>. ($i;ALOAD +0)
                ($i;GETFIELD function-class
-                            (|> variable i.inc (i.* -1) int-to-nat functionT;captured)
+                            (|> variable i.inc (i.* -1) int-to-nat captured)
                             commonT;$Object)))))
 
-(def: #export (translate-variable variable)
+(def: #export (translate-local variable)
   (-> Variable (Meta $;Inst))
   (meta/wrap ($i;ALOAD (int-to-nat variable))))
 
+(def: #export (translate-variable variable)
+  (-> Variable (Meta $;Inst))
+  (if (variableL;captured? variable)
+    (translate-captured variable)
+    (translate-local variable)))
+
 (def: #export (translate-definition [def-module def-name])
   (-> Ident (Meta $;Inst))
   (let [bytecode-name (format def-module "/" (&;normalize-name def-name))]