aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/host
diff options
context:
space:
mode:
authorEduardo Julian2017-11-06 18:34:51 -0400
committerEduardo Julian2017-11-06 18:34:51 -0400
commitcab9451961fa25fd6683c1c7bd836941bd84e48b (patch)
treea03e681579ecc34a84881a2efd8efacea2420e9f /new-luxc/source/luxc/host
parent4e932a33ac56bb3cb1d7b49771e770e8c373bf8e (diff)
- Fixed some bugs.
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/host.jvm.lux55
1 files changed, 52 insertions, 3 deletions
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)