From 4480e41e949ba3ba0c9bceeed43e3f144f82103b Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Tue, 6 Jun 2017 20:23:15 -0400
Subject: - Now optimizing functions.

---
 new-luxc/source/luxc/synthesizer/function.lux  | 55 ++++++++++++++++++++++++++
 new-luxc/source/luxc/synthesizer/structure.lux | 28 +++++++++++++
 2 files changed, 83 insertions(+)
 create mode 100644 new-luxc/source/luxc/synthesizer/function.lux
 create mode 100644 new-luxc/source/luxc/synthesizer/structure.lux

(limited to 'new-luxc/source/luxc/synthesizer')

diff --git a/new-luxc/source/luxc/synthesizer/function.lux b/new-luxc/source/luxc/synthesizer/function.lux
new file mode 100644
index 000000000..be6a74da0
--- /dev/null
+++ b/new-luxc/source/luxc/synthesizer/function.lux
@@ -0,0 +1,55 @@
+(;module:
+  lux
+  (lux (data (coll [list "L/" Functor<List> Fold<List>])))
+  (luxc (lang ["la" analysis]
+              ["ls" synthesis])))
+
+(def: #export (environment scope)
+  (-> Scope (List ls;Variable))
+  (|> scope
+      (get@ [#;captured #;mappings])
+      (L/map (function [[_ _ ref]]
+               (case ref
+                 (#;Local idx)
+                 (nat-to-int idx)
+                 
+                 (#;Captured idx)
+                 (|> idx n.inc nat-to-int (i.* -1))
+                 )))))
+
+(do-template [<name> <comp>]
+  [(def: #export (<name> var)
+     (-> ls;Variable Bool)
+     (<comp> 0 var))]
+
+  [function-var? i.=]
+  [local-var?    i.>]
+  [captured-var? i.<]
+  )
+
+(def: #export (nested-function? scope-args)
+  (-> Nat Bool)
+  (n.> +1 scope-args))
+
+(def: #export (adjust-var scope-args var)
+  (-> Nat ls;Variable ls;Variable)
+  (|> scope-args n.dec nat-to-int (i.+ var)))
+
+(def: #export (to-captured idx)
+  (-> Nat Int)
+  (|> idx n.inc nat-to-int (i.* -1)))
+
+(def: #export (to-local idx)
+  (-> Nat Int)
+  (nat-to-int idx))
+
+(def: #export (unfold-apply apply)
+  (-> la;Analysis [la;Analysis (List la;Analysis)])
+  (loop [apply apply
+         args (list)]
+    (case apply
+      (#la;Apply arg func)
+      (recur func (#;Cons arg args))
+
+      _
+      [apply args])))
diff --git a/new-luxc/source/luxc/synthesizer/structure.lux b/new-luxc/source/luxc/synthesizer/structure.lux
new file mode 100644
index 000000000..403817c53
--- /dev/null
+++ b/new-luxc/source/luxc/synthesizer/structure.lux
@@ -0,0 +1,28 @@
+(;module:
+  lux
+  (luxc (lang ["la" analysis])))
+
+(def: #export (unfold-tuple tuple)
+  (-> la;Analysis (List la;Analysis))
+  (case tuple
+    (#la;Product left right)
+    (#;Cons left (unfold-tuple right))
+
+    _
+    (list tuple)))
+
+(def: #export (unfold-variant variant)
+  (-> (Either la;Analysis la;Analysis) [Nat Bool la;Analysis])
+  (loop [so-far +0
+         variantA variant]
+    (case variantA
+      (#;Left valueA)
+      (case valueA
+        (#la;Sum choice)
+        (recur (n.inc so-far) choice)
+
+        _
+        [so-far false valueA])
+      
+      (#;Right valueA)
+      [(n.inc so-far) true valueA])))
-- 
cgit v1.2.3