- Re-organized synthesis.

4 files changed, 0 insertions, 382 deletions

diff --git a/new-luxc/source/luxc/synthesizer/case.lux b/new-luxc/source/luxc/synthesizer/case.lux
deleted file mode 100644
index 15cb6eca3..000000000
--- a/new-luxc/source/luxc/synthesizer/case.lux
+++ /dev/null
@@ -1,70 +0,0 @@
-(;module:
-  lux
-  (lux (data [bool "bool/" Eq<Bool>]
-             [text "text/" Eq<Text>]
-             [number]
-             (coll [list "list/" Fold<List>]))
-       (meta [code "code/" Eq<Code>]))
-  (luxc (lang ["la" analysis]
-              ["ls" synthesis])))
-
-(def: #export (path pattern)
-  (-> la;Pattern ls;Path)
-  (case pattern
-    (^code [(~@ membersP)])
-    (case (list;reverse membersP)
-      #;Nil
-      (' ("lux case pop"))
-
-      (#;Cons singletonP #;Nil)
-      (path singletonP)
-
-      (#;Cons lastP prevsP)
-      (let [length (list;size membersP)
-            last-idx (n.dec length)
-            [_ tuple-path] (list/fold (function [current-pattern [current-idx next-path]]
-                                        [(n.dec current-idx)
-                                         (` ("lux case seq"
-                                             ("lux case tuple left" (~ (code;nat current-idx)) (~ (path current-pattern)))
-                                             (~ next-path)))])
-                                      [(n.dec last-idx)
-                                       (` ("lux case tuple right" (~ (code;nat last-idx)) (~ (path lastP))))]
-                                      prevsP)]
-        tuple-path))
-
-    (^code ((~ [_ (#;Nat tag)]) (~ [_ (#;Nat num-tags)]) (~ memberP)))
-    (if (n.= (n.dec num-tags) tag)
-      (` ("lux case variant right" (~ (code;nat tag)) (~ (path memberP))))
-      (` ("lux case variant left" (~ (code;nat tag)) (~ (path memberP)))))
-
-    _
-    pattern))
-
-(def: #export (weave leftP rightP)
-  (-> ls;Path ls;Path ls;Path)
-  (with-expansions [<default> (as-is (` ("lux case alt" (~ leftP) (~ rightP))))]
-    (case [leftP rightP]
-      (^template [<special>]
-        (^ [[_ (#;Form (list [_ (#;Text <special>)] [_ (#;Nat left-idx)] left-then))]
-            [_ (#;Form (list [_ (#;Text <special>)] [_ (#;Nat right-idx)] right-then))]])
-        (if (n.= left-idx right-idx)
-          (` (<special> (~ (code;nat left-idx)) (~ (weave left-then right-then))))
-          <default>))
-      (["lux case tuple left"]
-       ["lux case tuple right"]
-       ["lux case variant left"]
-       ["lux case variant right"])
-
-      (^ [[_ (#;Form (list [_ (#;Text "lux case seq")] left-pre left-post))]
-          [_ (#;Form (list [_ (#;Text "lux case seq")] right-pre right-post))]])
-      (case (weave left-pre right-pre)
-        (^ [_ (#;Form (list [_ (#;Text "lux case alt")] _ _))])
-        <default>
-
-        weavedP
-        (` ("lux case seq" (~ weavedP) (~ (weave left-post right-post)))))
-
-      _
-      (if (code/= leftP rightP)
-        leftP
-        <default>))))
diff --git a/new-luxc/source/luxc/synthesizer/function.lux b/new-luxc/source/luxc/synthesizer/function.lux
deleted file mode 100644
index 52aee9a49..000000000
--- a/new-luxc/source/luxc/synthesizer/function.lux
+++ /dev/null
@@ -1,29 +0,0 @@
-(;module:
-  lux
-  (luxc (lang ["la" analysis]
-              ["ls" synthesis]
-              [";L" variable #+ Variable])))
-
-(do-template [<name> <comp> <ref>]
-  [(def: #export (<name> arity)
-     (-> ls;Arity Bool)
-     (<comp> <ref> arity))]
-
-  [nested? n.> +1]
-  [top?    n.= +0]
-  )
-
-(def: #export (adjust-var outer var)
-  (-> ls;Arity Variable Variable)
-  (|> outer n.dec nat-to-int (i.+ var)))
-
-(def: #export (unfold-apply apply)
-  (-> la;Analysis [la;Analysis (List la;Analysis)])
-  (loop [apply apply
-         args (list)]
-    (case apply
-      (^code ("lux apply" (~ arg) (~ func)))
-      (recur func (#;Cons arg args))
-
-      _
-      [apply args])))
diff --git a/new-luxc/source/luxc/synthesizer/loop.lux b/new-luxc/source/luxc/synthesizer/loop.lux
deleted file mode 100644
index 0070fcd5d..000000000
--- a/new-luxc/source/luxc/synthesizer/loop.lux
+++ /dev/null
@@ -1,185 +0,0 @@
-(;module:
-  lux
-  (lux (control [monad #+ do]
-                ["p" parser])
-       (data [maybe]
-             (coll [list "list/" Functor<List>]))
-       (meta [code]
-             [syntax]))
-  (luxc (lang ["ls" synthesis]
-              [";L" variable #+ Variable Register])))
-
-(def: #export (contains-self-reference? exprS)
-  (-> ls;Synthesis Bool)
-  (case exprS
-    (^ [_ (#;Form (list [_ (#;Nat tag)] [_ (#;Bool last?)] memberS))])
-    (contains-self-reference? memberS)
-
-    [_ (#;Tuple membersS)]
-    (list;any? contains-self-reference? membersS)
-
-    (^ [_ (#;Form (list [_ (#;Int var)]))])
-    (variableL;self? var)
-
-    (^ [_ (#;Form (list [_ (#;Text "lux case")] inputS pathS))])
-    (or (contains-self-reference? inputS)
-        (loop [pathS pathS]
-          (case pathS
-            (^or (^ [_ (#;Form (list [_ (#;Text "lux case alt")] leftS rightS))])
-                 (^ [_ (#;Form (list [_ (#;Text "lux case seq")] leftS rightS))]))
-            (or (recur leftS)
-                (recur rightS))
-
-            (^ [_ (#;Form (list [_ (#;Text "lux case exec")] bodyS))])
-            (contains-self-reference? bodyS)
-            
-            _
-            false)))
-
-    (^ [_ (#;Form (list [_ (#;Text "lux function")] arity [_ (#;Tuple environment)] bodyS))])
-    (list;any? (function [captured]
-                 (case captured
-                   (^ [_ (#;Form (list [_ (#;Int var)]))])
-                   (variableL;self? var)
-
-                   _
-                   false))
-               environment)
-
-    (^ [_ (#;Form (list& [_ (#;Text "lux call")] funcS argsS))])
-    (or (contains-self-reference? funcS)
-        (list;any? contains-self-reference? argsS))
-
-    (^ [_ (#;Form (list [_ (#;Text "lux let")] register inputS bodyS))])
-    (or (contains-self-reference? inputS)
-        (contains-self-reference? bodyS))
-
-    (^ [_ (#;Form (list [_ (#;Text "lux if")] inputS thenS elseS))])
-    (or (contains-self-reference? inputS)
-        (contains-self-reference? thenS)
-        (contains-self-reference? elseS))
-
-    (^ [_ (#;Form (list [_ (#;Text "lux loop")] offset [_ (#;Tuple initsS)] bodyS))])
-    (or (list;any? contains-self-reference? initsS)
-        (contains-self-reference? bodyS))
-    
-    (^or (^ [_ (#;Form (list& [_ (#;Text "lux recur")] argsS))])
-         (^ [_ (#;Form (list& [_ (#;Text procedure)] argsS))]))
-    (list;any? contains-self-reference? argsS)
-
-    _
-    false
-    ))
-
-(def: #export (reify-recursion arity exprS)
-  (-> Nat ls;Synthesis ls;Synthesis)
-  (loop [exprS exprS]
-    (case exprS
-      (^ [_ (#;Form (list [_ (#;Text "lux case")] inputS pathS))])
-      (` ("lux case" (~ inputS)
-          (~ (let [reify-recursion' recur]
-               (loop [pathS pathS]
-                 (case pathS
-                   (^ [_ (#;Form (list [_ (#;Text "lux case alt")] leftS rightS))])
-                   (` ("lux case alt" (~ (recur leftS)) (~ (recur rightS))))
-
-                   (^ [_ (#;Form (list [_ (#;Text "lux case seq")] leftS rightS))])
-                   (` ("lux case seq" (~ leftS) (~ (recur rightS))))
-                   
-                   (^ [_ (#;Form (list [_ (#;Text "lux case exec")] bodyS))])
-                   (` ("lux case exec" (~ (reify-recursion' bodyS))))
-                   
-                   _
-                   pathS))))))
-
-      (^multi (^ [_ (#;Form (list& [_ (#;Text "lux call")]
-                                   [_ (#;Form (list [_ (#;Int 0)]))]
-                                   argsS))])
-              (n.= arity (list;size argsS)))
-      (` ("lux recur" (~@ argsS)))
-
-      (^ [_ (#;Form (list [_ (#;Text "lux let")] register inputS bodyS))])
-      (` ("lux let" (~ register) (~ inputS) (~ (recur bodyS))))
-
-      (^ [_ (#;Form (list [_ (#;Text "lux if")] inputS thenS elseS))])
-      (` ("lux if" (~ inputS) (~ (recur thenS)) (~ (recur elseS))))
-
-      _
-      exprS
-      )))
-
-(def: #export (adjust env outer-offset exprS)
-  (-> (List Variable) Register ls;Synthesis ls;Synthesis)
-  (let [resolve-captured (: (-> Variable Variable)
-                            (function [var]
-                              (let [idx (|> var (i.* -1) int-to-nat n.dec)]
-                                (|> env (list;nth idx) maybe;assume))))]
-    (loop [exprS exprS]
-      (case exprS
-        (^ [_ (#;Form (list [_ (#;Nat tag)] last? valueS))])
-        (` ((~ (code;nat tag)) (~ last?) (~ (recur valueS))))
-        
-        [_ (#;Tuple members)]
-        [_ (#;Tuple (list/map recur members))]
-
-        (^ [_ (#;Form (list [_ (#;Text "lux case")] inputS pathS))])
-        (` ("lux case" (~ (recur inputS))
-            (~ (let [adjust' recur]
-                 (loop [pathS pathS]
-                   (case pathS
-                     (^template [<pattern>]
-                       (^ [_ (#;Form (list [_ (#;Text <pattern>)] leftS rightS))])
-                       (` (<pattern> (~ (recur leftS)) (~ (recur rightS)))))
-                     (["lux case alt"]
-                      ["lux case seq"])
-
-                     (^ [_ (#;Form (list [_ (#;Text "lux case exec")] bodyS))])
-                     (` ("lux case exec" (~ (adjust' bodyS))))
-                     
-                     _
-                     pathS))))))
-
-        (^ [_ (#;Form (list [_ (#;Text "lux function")] arity [_ (#;Tuple environment)] bodyS))])
-        (` ("lux function" (~ arity)
-            (~ [_ (#;Tuple (list/map (function [_var]
-                                       (case _var
-                                         (^ [_ (#;Form (list [_ (#;Int var)]))])
-                                         (` ((~ (code;int (resolve-captured var)))))
-
-                                         _
-                                         _var))
-                                     environment))])
-            (~ (recur bodyS))))
-
-        (^ [_ (#;Form (list& [_ (#;Text "lux call")] funcS argsS))])
-        (` ("lux call" (~ (recur funcS)) (~@ (list/map recur argsS))))
-
-        (^ [_ (#;Form (list& [_ (#;Text "lux recur")] argsS))])
-        (` ("lux recur" (~@ (list/map recur argsS))))
-        
-        (^ [_ (#;Form (list& [_ (#;Text procedure)] argsS))])
-        (` ((~ (code;text procedure)) (~@ (list/map recur argsS))))
-
-        (^ [_ (#;Form (list [_ (#;Int var)]))])
-        (if (variableL;captured? var)
-          (` ((~ (code;int (resolve-captured var)))))
-          (` ((~ (code;int (|> outer-offset nat-to-int (i.+ var)))))))
-
-        (^ [_ (#;Form (list [_ (#;Text "lux let")] [_ (#;Nat register)] inputS bodyS))])
-        (` ("lux let" (~ (code;nat (n.+ outer-offset register)))
-            (~ (recur inputS))
-            (~ (recur bodyS))))
-
-        (^ [_ (#;Form (list [_ (#;Text "lux if")] inputS thenS elseS))])
-        (` ("lux if" (~ (recur inputS))
-            (~ (recur thenS))
-            (~ (recur elseS))))
-
-        (^ [_ (#;Form (list [_ (#;Text "lux loop")] [_ (#;Nat inner-offset)] [_ (#;Tuple initsS)] bodyS))])
-        (` ("lux loop" (~ (code;nat (n.+ outer-offset inner-offset)))
-            [(~@ (list/map recur initsS))]
-            (~ (recur bodyS))))
-
-        _
-        exprS
-        ))))
diff --git a/new-luxc/source/luxc/synthesizer/variable.lux b/new-luxc/source/luxc/synthesizer/variable.lux
deleted file mode 100644
index 3ce9f2678..000000000
--- a/new-luxc/source/luxc/synthesizer/variable.lux
+++ /dev/null
@@ -1,98 +0,0 @@
-(;module:
-  lux
-  (lux (data [number]
-             (coll [list "list/" Fold<List> Monoid<List>]
-                   ["s" set])))
-  (luxc (lang ["la" analysis]
-              ["ls" synthesis]
-              [";L" variable #+ Variable])))
-
-(def: (bound-vars path)
-  (-> ls;Path (List Variable))
-  (case path
-    (#ls;BindP register)
-    (list (nat-to-int register))
-
-    (^or (#ls;SeqP pre post) (#ls;AltP pre post))
-    (list/compose (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)
-    (list/compose (path-bodies pre) (path-bodies post))
-    
-    _
-    (list)))
-
-(def: (non-arg? arity var)
-  (-> ls;Arity Variable Bool)
-  (and (variableL;local? var)
-       (n.> arity (int-to-nat var))))
-
-(type: Tracker (s;Set Variable))
-
-(def: init-tracker Tracker (s;new number;Hash<Int>))
-
-(def: (unused-vars current-arity bound exprS)
-  (-> ls;Arity (List Variable) ls;Synthesis (List Variable))
-  (let [tracker (loop [exprS exprS
-                       tracker (list/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)
-                    (list/fold recur tracker membersS)
-
-                    (#ls;Call funcS argsS)
-                    (list/fold recur (recur funcS tracker) argsS)
-                    
-                    (^or (#ls;Recur argsS)
-                         (#ls;Procedure name argsS))
-                    (list/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 (list/fold recur tracker initsS))
-
-                    (#ls;Case inputS outputPS)
-                    (let [tracker' (list/fold s;add
-                                              (recur inputS tracker)
-                                              (bound-vars outputPS))]
-                      (list/fold recur tracker' (path-bodies outputPS)))
-
-                    (#ls;Function arity env bodyS)
-                    (list/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)]))