aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/scope.lux
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/lang/scope.lux')
-rw-r--r--new-luxc/source/luxc/lang/scope.lux173
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)]))))