diff options
author | Eduardo Julian | 2017-05-09 17:48:27 -0400 |
---|---|---|
committer | Eduardo Julian | 2017-05-09 17:48:27 -0400 |
commit | dd5220e13b03c8f85972feac535a34ef64525222 (patch) | |
tree | 2ac08a118eaa63f11c2397a08eaca74d199f2d1e /new-luxc/source/luxc/env.lux | |
parent | 7b74c1258f345d576b0c798303b0ed28f1734368 (diff) |
- Added tests for some kinds of analysis.
- WIP: Porting more code.
Diffstat (limited to 'new-luxc/source/luxc/env.lux')
-rw-r--r-- | new-luxc/source/luxc/env.lux | 81 |
1 files changed, 44 insertions, 37 deletions
diff --git a/new-luxc/source/luxc/env.lux b/new-luxc/source/luxc/env.lux index 338375a29..8c056f1c3 100644 --- a/new-luxc/source/luxc/env.lux +++ b/new-luxc/source/luxc/env.lux @@ -13,51 +13,18 @@ (type: Locals (Bindings Text [Type Nat])) (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))) + (&;pl-contains? name))) (def: (<get> name scope) (-> Text Scope (Maybe [Type Ref])) (|> scope (get@ [<slot> #;mappings]) - (pl::get name) + (&;pl-get name) (Maybe/map (function [[type value]] [type (<then> value)]))))] @@ -98,7 +65,7 @@ (#;Cons (update@ #;captured (: (-> Captured Captured) (|>. (update@ #;counter n.inc) - (update@ #;mappings (pl::put name [ref-type ref])))) + (update@ #;mappings (&;pl-put name [ref-type ref])))) scope) inner)])) [init-ref #;Nil] @@ -118,7 +85,7 @@ new-head (update@ #;locals (: (-> Locals Locals) (|>. (update@ #;counter n.inc) - (update@ #;mappings (pl::put name [type new-var-id])))) + (update@ #;mappings (&;pl-put name [type new-var-id])))) head)] (case (macro;run' (set@ #;scopes (#;Cons new-head tail) compiler) action) @@ -139,3 +106,43 @@ _ (#E;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)) + (#E;Error error) + (#E;Error error) + + (#E;Success [compiler' output]) + (#E;Success [(update@ #;scopes + (|>. list;tail (default (list))) + compiler') + output]) + )) + )) |