aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/env.lux
diff options
context:
space:
mode:
authorEduardo Julian2017-09-08 19:20:08 -0400
committerEduardo Julian2017-09-08 19:20:08 -0400
commitbe53e45ca4d75fa87a9029f84b95958e19a4b4fa (patch)
tree2312f9bf7adf028a08460264b0c6dcbc1f110b91 /new-luxc/source/luxc/env.lux
parent06713336cdfd09db3eba26eda2c04db05bcd71e4 (diff)
- Re-named luxc/env to luxc/scope.
Diffstat (limited to 'new-luxc/source/luxc/env.lux')
-rw-r--r--new-luxc/source/luxc/env.lux158
1 files changed, 0 insertions, 158 deletions
diff --git a/new-luxc/source/luxc/env.lux b/new-luxc/source/luxc/env.lux
deleted file mode 100644
index e15e01130..000000000
--- a/new-luxc/source/luxc/env.lux
+++ /dev/null
@@ -1,158 +0,0 @@
-(;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)]))))