diff options
Diffstat (limited to 'new-luxc/source/luxc/lang/scope.lux')
| -rw-r--r-- | new-luxc/source/luxc/lang/scope.lux | 173 |
1 files changed, 0 insertions, 173 deletions
diff --git a/new-luxc/source/luxc/lang/scope.lux b/new-luxc/source/luxc/lang/scope.lux deleted file mode 100644 index 82d7803e2..000000000 --- a/new-luxc/source/luxc/lang/scope.lux +++ /dev/null @@ -1,173 +0,0 @@ -(.module: - lux - (lux (control monad) - (data [text "text/" Eq<Text>] - text/format - [maybe "maybe/" Monad<Maybe>] - [product] - ["e" error] - (coll [list "list/" Functor<List> Fold<List> Monoid<List>])) - [macro]) - (luxc ["&" lang] - (lang [".L" variable #+ Variable]))) - -(type: Locals (Bindings Text [Type Nat])) -(type: Captured (Bindings Text [Type Ref])) - -(def: (is-local? name scope) - (-> Text Scope Bool) - (|> scope - (get@ [#.locals #.mappings]) - (&.pl-contains? name))) - -(def: (get-local name scope) - (-> Text Scope (Maybe [Type Ref])) - (|> scope - (get@ [#.locals #.mappings]) - (&.pl-get name) - (maybe/map (function (_ [type value]) - [type (#.Local value)])))) - -(def: (is-captured? name scope) - (-> Text Scope Bool) - (|> scope - (get@ [#.captured #.mappings]) - (&.pl-contains? name))) - -(def: (get-captured name scope) - (-> Text Scope (Maybe [Type Ref])) - (loop [idx +0 - mappings (get@ [#.captured #.mappings] scope)] - (case mappings - #.Nil - #.None - - (#.Cons [_name [_source-type _source-ref]] mappings') - (if (text/= name _name) - (#.Some [_source-type (#.Captured idx)]) - (recur (n/inc idx) mappings'))))) - -(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 (Meta (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] (maybe.default (undefined) - (get-ref name top-outer)) - [ref inner'] (list/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 (product.left ref+inner)])))) - scope) - (product.right ref+inner))])) - [init-ref #.Nil] - (list.reverse inner)) - scopes (list/compose inner' outer)] - (#.Right [(set@ #.scopes scopes compiler) - (#.Some [ref-type ref])])) - )))) - -(def: #export (with-local [name type] action) - (All [a] (-> [Text Type] (Meta a) (Meta 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) - (#e.Success [compiler' output]) - (case (get@ #.scopes compiler') - (#.Cons head' tail') - (let [scopes' (#.Cons (set@ #.locals (get@ #.locals head) head') - tail')] - (#e.Success [(set@ #.scopes scopes' compiler') - output])) - - _ - (error! "Invalid scope alteration/")) - - (#e.Error error) - (#e.Error error))) - - _ - (#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 (Meta a) (Meta 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 (maybe.default (list))) - compiler') - output]) - )) - )) - -(def: #export next-local - (Meta Nat) - (function (_ compiler) - (case (get@ #.scopes compiler) - #.Nil - (#e.Error "Cannot get next reference when there is no scope.") - - (#.Cons top _) - (#e.Success [compiler (get@ [#.locals #.counter] top)])))) |