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/host.jvm.lux | 55 ++++++++++++++++++++++++++++++++++++---
 1 file changed, 52 insertions(+), 3 deletions(-)

(limited to 'new-luxc/source/luxc/host.jvm.lux')

diff --git a/new-luxc/source/luxc/host.jvm.lux b/new-luxc/source/luxc/host.jvm.lux
index 2cbdf5883..b2bf07d32 100644
--- a/new-luxc/source/luxc/host.jvm.lux
+++ b/new-luxc/source/luxc/host.jvm.lux
@@ -1,6 +1,7 @@
 (;module:
   lux
-  (lux (control [monad #+ do])
+  (lux (control [monad #+ do]
+                pipe)
        (concurrency ["A" atom])
        (data ["e" error]
              [text]
@@ -83,8 +84,56 @@
                         (A;atom (dict;new text;Hash<Text>)))]
            {#commonT;loader (memory-class-loader store)
             #commonT;store store
-            #commonT;function-class #;None
-            #commonT;artifacts (dict;new text;Hash<Text>)})))
+            #commonT;artifacts (dict;new text;Hash<Text>)
+            #commonT;context ["" +0]})))
+
+(def: #export (with-context name expr)
+  (All [a] (-> Text (Meta a) (Meta a)))
+  (;function [compiler]
+    (let [old (:! commonT;Host (get@ #;host compiler))]
+      (case (expr (set@ #;host
+                        (:! Void (set@ #commonT;context [name +0] old))
+                        compiler))
+        (#e;Success [compiler' output])
+        (#e;Success [(update@ #;host
+                              (|>. (:! commonT;Host)
+                                   (set@ #commonT;context (get@ #commonT;context old))
+                                   (:! Void))
+                              compiler')
+                     output])
+
+        (#e;Error error)
+        (#e;Error error)))))
+
+(def: #export (with-sub-context expr)
+  (All [a] (-> (Meta a) (Meta [Text a])))
+  (;function [compiler]
+    (let [old (:! commonT;Host (get@ #;host compiler))
+          [old-name old-sub] (get@ #commonT;context old)
+          new-name (format old-name "/" (%n old-sub))]
+      (case (expr (set@ #;host
+                        (:! Void (set@ #commonT;context [new-name +0] old))
+                        compiler))
+        (#e;Success [compiler' output])
+        (#e;Success [(update@ #;host
+                              (|>. (:! commonT;Host)
+                                   (set@ #commonT;context [old-name (n.inc old-sub)])
+                                   (:! Void))
+                              compiler')
+                     [new-name output]])
+
+        (#e;Error error)
+        (#e;Error error)))))
+
+(def: #export context
+  (Meta Text)
+  (;function [compiler]
+    (#e;Success [compiler
+                 (|> (get@ #;host compiler)
+                     (:! commonT;Host)
+                     (get@ #commonT;context)
+                     (let> [name sub]
+                           name))])))
 
 (def: #export class-loader
   (Meta ClassLoader)
-- 
cgit v1.2.3