diff options
author | Eduardo Julian | 2017-09-08 19:20:08 -0400 |
---|---|---|
committer | Eduardo Julian | 2017-09-08 19:20:08 -0400 |
commit | be53e45ca4d75fa87a9029f84b95958e19a4b4fa (patch) | |
tree | 2312f9bf7adf028a08460264b0c6dcbc1f110b91 /new-luxc/source/luxc/scope.lux | |
parent | 06713336cdfd09db3eba26eda2c04db05bcd71e4 (diff) |
- Re-named luxc/env to luxc/scope.
Diffstat (limited to 'new-luxc/source/luxc/scope.lux')
-rw-r--r-- | new-luxc/source/luxc/scope.lux | 158 |
1 files changed, 158 insertions, 0 deletions
diff --git a/new-luxc/source/luxc/scope.lux b/new-luxc/source/luxc/scope.lux new file mode 100644 index 000000000..e15e01130 --- /dev/null +++ b/new-luxc/source/luxc/scope.lux @@ -0,0 +1,158 @@ +(;module: + lux + (lux (control monad) + (data [text "T/" Eq<Text>] + text/format + [maybe #+ Monad<Maybe> "Maybe/" Monad<Maybe>] + [product] + ["R" result] + (coll [list "L/" Fold<List> Monoid<List>])) + [macro]) + (luxc ["&" base])) + +(type: Locals (Bindings Text [Type Nat])) +(type: Captured (Bindings Text [Type Ref])) + +(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])])) + )))) + +(def: #export (with-local [name type] action) + (All [a] (-> [Text Type] (Lux a) (Lux a))) + (function [compiler] + (case (get@ #;scopes compiler) + (#;Cons head tail) + (let [old-mappings (get@ [#;locals #;mappings] head) + new-var-id (get@ [#;locals #;counter] head) + new-head (update@ #;locals + (: (-> Locals Locals) + (|>. (update@ #;counter n.inc) + (update@ #;mappings (&;pl-put name [type new-var-id])))) + head)] + (case (macro;run' (set@ #;scopes (#;Cons new-head tail) compiler) + action) + (#R;Success [compiler' output]) + (case (get@ #;scopes compiler') + (#;Cons head' tail') + (let [scopes' (#;Cons (set@ #;locals (get@ #;locals head) head') + tail')] + (#R;Success [(set@ #;scopes scopes' compiler') + output])) + + _ + (error! "Invalid scope alteration.")) + + (#R;Error error) + (#R;Error error))) + + _ + (#R;Error "Cannot create local binding without a scope.")) + )) + +(do-template [<name> <val-type>] + [(def: <name> + (Bindings Text [Type <val-type>]) + {#;counter +0 + #;mappings (list)})] + + [init-locals Nat] + [init-captured Ref] + ) + +(def: (scope parent-name child-name) + (-> (List Text) Text Scope) + {#;name (list& child-name parent-name) + #;inner +0 + #;locals init-locals + #;captured init-captured}) + +(def: #export (with-scope name action) + (All [a] (-> Text (Lux a) (Lux a))) + (function [compiler] + (let [parent-name (case (get@ #;scopes compiler) + #;Nil + (list) + + (#;Cons top _) + (get@ #;name top))] + (case (action (update@ #;scopes + (|>. (#;Cons (scope parent-name name))) + compiler)) + (#R;Error error) + (#R;Error error) + + (#R;Success [compiler' output]) + (#R;Success [(update@ #;scopes + (|>. list;tail (default (list))) + compiler') + output]) + )) + )) + +(def: #export next-local + (Lux Nat) + (function [compiler] + (case (get@ #;scopes compiler) + #;Nil + (#R;Error "Cannot get next reference when there is no scope.") + + (#;Cons top _) + (#R;Success [compiler (get@ [#;locals #;counter] top)])))) |