From c0acd75d41ed0e927ec318d4b12c0ec4f5f2e1d3 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sun, 2 Jul 2017 15:52:36 -0400
Subject: - Adjusted compiler to the new lack of Char type. - WIP: PM/case
 synthesis.

---
 new-luxc/source/luxc/synthesizer/variable.lux | 100 ++++++++++++++++++++++++++
 1 file changed, 100 insertions(+)
 create mode 100644 new-luxc/source/luxc/synthesizer/variable.lux

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

diff --git a/new-luxc/source/luxc/synthesizer/variable.lux b/new-luxc/source/luxc/synthesizer/variable.lux
new file mode 100644
index 000000000..3a48cb3f2
--- /dev/null
+++ b/new-luxc/source/luxc/synthesizer/variable.lux
@@ -0,0 +1,100 @@
+(;module:
+  lux
+  (lux (data [bool "B/" Eq<Bool>]
+             [text "T/" Eq<Text>]
+             [number]
+             (coll [list "L/" Functor<List> Fold<List> Monoid<List>]
+                   ["s" set])))
+  (luxc (lang ["la" analysis]
+              ["ls" synthesis])
+        (synthesizer ["&;" function])))
+
+(def: (bound-vars path)
+  (-> ls;Path (List ls;Variable))
+  (case path
+    (#ls;BindP register)
+    (list (nat-to-int register))
+
+    (^or (#ls;SeqP pre post) (#ls;AltP pre post))
+    (L/append (bound-vars pre) (bound-vars post))
+    
+    _
+    (list)))
+
+(def: (path-bodies path)
+  (-> ls;Path (List ls;Synthesis))
+  (case path
+    (#ls;ExecP body)
+    (list body)
+
+    (#ls;SeqP pre post)
+    (path-bodies post)
+
+    (#ls;AltP pre post)
+    (L/append (path-bodies pre) (path-bodies post))
+    
+    _
+    (list)))
+
+(def: (non-arg? arity var)
+  (-> ls;Arity ls;Variable Bool)
+  (and (&function;local? var)
+       (n.> arity (int-to-nat var))))
+
+(type: Tracker (s;Set ls;Variable))
+
+(def: init-tracker Tracker (s;new number;Hash<Int>))
+
+(def: (unused-vars current-arity bound exprS)
+  (-> ls;Arity (List ls;Variable) ls;Synthesis (List ls;Variable))
+  (let [tracker (loop [exprS exprS
+                       tracker (L/fold s;add init-tracker bound)]
+                  (case exprS
+                    (#ls;Variable var)
+                    (if (non-arg? current-arity var)
+                      (s;remove var tracker)
+                      tracker)
+                    
+                    (#ls;Variant tag last? memberS)
+                    (recur memberS tracker)
+
+                    (#ls;Tuple membersS)
+                    (L/fold recur tracker membersS)
+
+                    (#ls;Call funcS argsS)
+                    (L/fold recur (recur funcS tracker) argsS)
+                    
+                    (^or (#ls;Recur argsS)
+                         (#ls;Procedure name argsS))
+                    (L/fold recur tracker argsS)
+
+                    (#ls;Let offset inputS outputS)
+                    (|> tracker (recur inputS) (recur outputS))
+
+                    (#ls;If testS thenS elseS)
+                    (|> tracker (recur testS) (recur thenS) (recur elseS))
+
+                    (#ls;Loop offset initsS bodyS)
+                    (recur bodyS (L/fold recur tracker initsS))
+
+                    (#ls;Case inputS outputPS)
+                    (let [tracker' (L/fold s;add
+                                           (recur inputS tracker)
+                                           (bound-vars outputPS))]
+                      (L/fold recur tracker' (path-bodies outputPS)))
+
+                    (#ls;Function arity env bodyS)
+                    (L/fold s;remove tracker env)
+
+                    _
+                    tracker
+                    ))]
+    (s;to-list tracker)))
+
+## (def: (optimize-register-use current-arity [pathS bodyS])
+##   (-> ls;Arity [ls;Path ls;Synthesis] [ls;Path ls;Synthesis])
+##   (let [bound (bound-vars pathS)
+##         unused (unused-vars current-arity bound bodyS)
+##         adjusted (adjust-vars unused bound)]
+##     [(|> pathS (clean-pattern adjusted) simplify-pattern)
+##      (clean-expression adjusted bodyS)]))
-- 
cgit v1.2.3