From 3175ae85d62ff6f692b8cc127f56c6569041d788 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Mon, 1 May 2017 18:15:14 -0400
Subject: - WIP: Some initial implementations for some re-written
 infrastructure.

---
 new-luxc/source/luxc/env.lux | 106 +++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 106 insertions(+)
 create mode 100644 new-luxc/source/luxc/env.lux

(limited to 'new-luxc/source/luxc/env.lux')

diff --git a/new-luxc/source/luxc/env.lux b/new-luxc/source/luxc/env.lux
new file mode 100644
index 000000000..be68f84e9
--- /dev/null
+++ b/new-luxc/source/luxc/env.lux
@@ -0,0 +1,106 @@
+(;module:
+  lux
+  (lux (control monad)
+       (data [text "T/" Eq<Text>]
+             text/format
+             [maybe #+ Monad<Maybe> "Maybe/" Monad<Maybe>]
+             [product]
+             (coll [list "L/" Fold<List> Monoid<List>])))
+  (luxc ["&" base]))
+
+(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)))
+
+   (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])]))
+        ))))
-- 
cgit v1.2.3