- Type-vars no longer get deleted.

- Fixed some bugs.

4 files changed, 65 insertions, 61 deletions

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))]