aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/host.jvm.lux
diff options
context:
space:
mode:
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)