aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/env.lux
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/env.lux106
1 files changed, 106 insertions, 0 deletions
diff --git a/new-luxc/source/luxc/env.lux b/new-luxc/source/luxc/env.lux
new file mode 100644
index 000000000..be68f84e9
--- /dev/null
+++ b/new-luxc/source/luxc/env.lux
@@ -0,0 +1,106 @@
+(;module:
+ lux
+ (lux (control monad)
+ (data [text "T/" Eq<Text>]
+ text/format
+ [maybe #+ Monad<Maybe> "Maybe/" Monad<Maybe>]
+ [product]
+ (coll [list "L/" Fold<List> Monoid<List>])))
+ (luxc ["&" base]))
+
+(type: Captured (Bindings Text [Type Ref]))
+
+(def: (pl::contains? key mappings)
+ (All [a] (-> Text (List [Text a]) Bool))
+ (case mappings
+ #;Nil
+ false
+
+ (#;Cons [k v] mappings')
+ (or (T/= key k)
+ (pl::contains? key mappings'))))
+
+(def: (pl::get key mappings)
+ (All [a] (-> Text (List [Text a]) (Maybe a)))
+ (case mappings
+ #;Nil
+ #;None
+
+ (#;Cons [k v] mappings')
+ (if (T/= key k)
+ (#;Some v)
+ (pl::get key mappings'))))
+
+(def: (pl::put key value mappings)
+ (All [a] (-> Text a (List [Text a]) (List [Text a])))
+ (case mappings
+ #;Nil
+ (list [key value])
+
+ (#;Cons [k v] mappings')
+ (if (T/= key k)
+ (#;Cons [key value] mappings')
+ (#;Cons [k v]
+ (pl::put key value mappings')))))
+
+(do-template [<slot> <is> <get> <then>]
+ [(def: (<is> name scope)
+ (-> Text Scope Bool)
+ (|> scope
+ (get@ [<slot> #;mappings])
+ (pl::contains? name)))
+
+ (def: (<get> name scope)
+ (-> Text Scope (Maybe [Type Ref]))
+ (|> scope
+ (get@ [<slot> #;mappings])
+ (pl::get name)
+ (Maybe/map (function [[type value]]
+ [type (<then> value)]))))]
+
+ [#;locals is-local? get-local #;Local]
+ [#;captured is-captured? get-captured id]
+ )
+
+(def: (is-ref? name scope)
+ (-> Text Scope Bool)
+ (or (is-local? name scope)
+ (is-captured? name scope)))
+
+(def: (get-ref name scope)
+ (-> Text Scope (Maybe [Type Ref]))
+ (case (get-local name scope)
+ (#;Some type)
+ (#;Some type)
+
+ _
+ (get-captured name scope)))
+
+(def: #export (find name)
+ (-> Text (Lux (Maybe [Type Ref])))
+ (function [compiler]
+ (let [[inner outer] (|> compiler
+ (get@ #;scopes)
+ (list;split-with (|>. (is-ref? name) not)))]
+ (case outer
+ #;Nil
+ (#;Right [compiler #;None])
+
+ (#;Cons top-outer _)
+ (let [[ref-type init-ref] (default (undefined)
+ (get-ref name top-outer))
+ [ref inner'] (L/fold (: (-> Scope [Ref (List Scope)] [Ref (List Scope)])
+ (function [scope [ref inner]]
+ [(#;Captured (get@ [#;captured #;counter] scope))
+ (#;Cons (update@ #;captured
+ (: (-> Captured Captured)
+ (|>. (update@ #;counter n.inc)
+ (update@ #;mappings (pl::put name [ref-type ref]))))
+ scope)
+ inner)]))
+ [init-ref #;Nil]
+ (list;reverse inner))
+ scopes (L/append inner' outer)]
+ (#;Right [(set@ #;scopes scopes compiler)
+ (#;Some [ref-type ref])]))
+ ))))