diff options
Diffstat (limited to '')
-rw-r--r-- | new-luxc/source/luxc/env.lux | 106 |
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])])) + )))) |