From cab9451961fa25fd6683c1c7bd836941bd84e48b Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Mon, 6 Nov 2017 18:34:51 -0400
Subject: - Fixed some bugs.

---
 new-luxc/source/luxc/lang/translation/case.jvm.lux |  3 +-
 .../source/luxc/lang/translation/common.jvm.lux    | 36 ++--------------------
 .../source/luxc/lang/translation/function.jvm.lux  | 15 ++++-----
 .../source/luxc/lang/translation/reference.jvm.lux |  8 +++--
 4 files changed, 16 insertions(+), 46 deletions(-)

(limited to 'new-luxc/source/luxc/lang/translation')

diff --git a/new-luxc/source/luxc/lang/translation/case.jvm.lux b/new-luxc/source/luxc/lang/translation/case.jvm.lux
index 3858627ff..09ffae328 100644
--- a/new-luxc/source/luxc/lang/translation/case.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/case.jvm.lux
@@ -70,8 +70,7 @@
 
     (^ [_ (#;Form (list [_ (#;Text "lux case bind")] [_ (#;Nat register)]))])
     (meta/wrap (|>. peekI
-                    ($i;ASTORE register)
-                    popI))
+                    ($i;ASTORE register)))
 
     [_ (#;Bool value)]
     (meta/wrap (let [jumpI (if value $i;IFEQ $i;IFNE)]
diff --git a/new-luxc/source/luxc/lang/translation/common.jvm.lux b/new-luxc/source/luxc/lang/translation/common.jvm.lux
index 1870530c2..f9825614a 100644
--- a/new-luxc/source/luxc/lang/translation/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/common.jvm.lux
@@ -33,8 +33,8 @@
 (type: #export Host
   {#loader ClassLoader
    #store Class-Store
-   #function-class (Maybe Text)
-   #artifacts Artifacts})
+   #artifacts Artifacts
+   #context [Text Nat]})
 
 (exception: Unknown-Class)
 (exception: Class-Already-Stored)
@@ -93,38 +93,6 @@
         (#e;Success [compiler (ClassLoader.loadClass [name] (get@ #loader host))])
         (ex;throw Unknown-Class name)))))
 
-(def: #export (with-function class expr)
-  (All [a] (-> Text (Meta a) (Meta a)))
-  (;function [compiler]
-    (let [host (:! Host (get@ #;host compiler))
-          old-function-class (get@ #function-class host)]
-      (case (expr (set@ #;host
-                        (:! Void (set@ #function-class
-                                       (#;Some class)
-                                       host))
-                        compiler))
-        (#e;Success [compiler' output])
-        (#e;Success [(update@ #;host
-                              (|>. (:! Host)
-                                   (set@ #function-class old-function-class)
-                                   (:! Void))
-                              compiler')
-                     output])
-
-        (#e;Error error)
-        (#e;Error error)))))
-
-(def: #export function
-  (Meta Text)
-  (;function [compiler]
-    (let [host (:! Host (get@ #;host compiler))]
-      (case (get@ #function-class host)
-        #;None
-        (ex;throw No-Function-Being-Compiled "")
-        
-        (#;Some function-class)
-        (#e;Success [compiler function-class])))))
-
 (def: #export bytecode-version Int Opcodes.V1_6)
 
 (def: #export value-field Text "_value")
diff --git a/new-luxc/source/luxc/lang/translation/function.jvm.lux b/new-luxc/source/luxc/lang/translation/function.jvm.lux
index ebdb28853..1b7f6267b 100644
--- a/new-luxc/source/luxc/lang/translation/function.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/function.jvm.lux
@@ -1,7 +1,8 @@
 (;module:
   lux
   (lux (control [monad #+ do])
-       (data text/format
+       (data [text]
+             text/format
              (coll [list "list/" Functor<List> Monoid<List>]))
        [meta])
   (luxc ["&" base]
@@ -266,13 +267,11 @@
                     $i;ARETURN
                     ))))
 
-(def: #export (with-function translate class env arity body)
-  (-> (-> ls;Synthesis (Meta $;Inst))
-      Text (List Variable) ls;Arity ls;Synthesis
+(def: #export (with-function class env arity bodyI)
+  (-> Text (List Variable) ls;Arity $;Inst
       (Meta [$;Def $;Inst]))
   (do meta;Monad<Meta>
     [@begin $i;make-label
-     bodyI (commonT;with-function class (translate body))
      #let [env-size (list;size env)
            applyD (: $;Def
                      (if (poly-arg? arity)
@@ -300,8 +299,10 @@
       (List Variable) ls;Arity ls;Synthesis
       (Meta $;Inst))
   (do meta;Monad<Meta>
-    [function-class (:: @ map %code (meta;gensym "function"))
-     [functionD instanceI] (with-function translate function-class env arity body)
+    [[context bodyI] (hostL;with-sub-context
+                       (translate body))
+     #let [function-class (text;replace-all "/+" "$" context)]
+     [functionD instanceI] (with-function 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 da86dd5b9..57336f27c 100644
--- a/new-luxc/source/luxc/lang/translation/reference.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/reference.jvm.lux
@@ -1,9 +1,11 @@
 (;module:
   lux
   (lux (control [monad #+ do])
-       (data text/format)
+       (data [text]
+             text/format)
        [meta "meta/" Monad<Meta>])
   (luxc ["&" base]
+        [";L" host]
         (host ["$" jvm]
               (jvm ["$t" type]
                    ["$i" inst]))
@@ -15,9 +17,9 @@
 (def: #export (translate-captured variable)
   (-> Variable (Meta $;Inst))
   (do meta;Monad<Meta>
-    [function-class commonT;function]
+    [function-class hostL;context]
     (wrap (|>. ($i;ALOAD +0)
-               ($i;GETFIELD function-class
+               ($i;GETFIELD (text;replace-all "/+" "$" function-class)
                             (|> variable i.inc (i.* -1) int-to-nat functionT;captured)
                             commonT;$Object)))))
 
-- 
cgit v1.2.3