- Re-organized synthesis.

1 files changed, 0 insertions, 184 deletions

diff --git a/new-luxc/source/luxc/synthesizer.lux b/new-luxc/source/luxc/synthesizer.lux
deleted file mode 100644
index c43958890..000000000
--- a/new-luxc/source/luxc/synthesizer.lux
+++ /dev/null
@@ -1,184 +0,0 @@
-(;module:
-  lux
-  (lux (control ["p" parser])
-       (data [maybe]
-             ["e" error]
-             [number]
-             [product]
-             text/format
-             (coll [list "list/" Functor<List> Fold<List> Monoid<List>]
-                   [dict #+ Dict]))
-       (meta [code]
-             ["s" syntax]))
-  (luxc ["&" base]
-        (lang ["la" analysis]
-              ["ls" synthesis]
-              [";L" variable #+ Variable])
-        (synthesizer ["&&;" case]
-                     ["&&;" function]
-                     ["&&;" loop])
-        ))
-
-(def: init-env (List Variable) (list))
-(def: init-resolver (Dict Int Int) (dict;new number;Hash<Int>))
-
-(def: (prepare-body inner-arity arity body)
-  (-> Nat Nat ls;Synthesis ls;Synthesis)
-  (if (&&function;nested? inner-arity)
-    body
-    (&&loop;reify-recursion arity body)))
-
-(def: (let$ register inputS bodyS)
-  (-> Nat ls;Synthesis ls;Synthesis ls;Synthesis)
-  (` ("lux let" (~ (code;nat register)) (~ inputS) (~ bodyS))))
-
-(def: (if$ testS thenS elseS)
-  (-> ls;Synthesis ls;Synthesis ls;Synthesis ls;Synthesis)
-  (` ("lux if" (~ testS)
-      (~ thenS)
-      (~ elseS))))
-
-(def: (function$ arity environment body)
-  (-> ls;Arity (List Variable) ls;Synthesis ls;Synthesis)
-  (` ("lux function" (~ (code;nat arity))
-      [(~@ (list/map code;int environment))]
-      (~ body))))
-
-(def: (variant$ tag last? valueS)
-  (-> Nat Bool ls;Synthesis ls;Synthesis)
-  (` ((~ (code;nat tag)) (~ (code;bool last?)) (~ valueS))))
-
-(def: (var$ var)
-  (-> Variable ls;Synthesis)
-  (` ((~ (code;int var)))))
-
-(def: (procedure$ name argsS)
-  (-> Text (List ls;Synthesis) ls;Synthesis)
-  (` ((~ (code;text name)) (~@ argsS))))
-
-(def: (call$ funcS argsS)
-  (-> ls;Synthesis (List ls;Synthesis) ls;Synthesis)
-  (` ("lux call" (~ funcS) (~@ argsS))))
-
-(def: (synthesize-case synthesize inputA branchesA)
-  (-> (-> la;Analysis ls;Synthesis)
-      la;Analysis (List [la;Pattern la;Analysis])
-      ls;Synthesis)
-  (let [inputS (synthesize inputA)]
-    (case (list;reverse branchesA)
-      (^multi (^ (list [(^code ("lux case bind" (~ [_ (#;Nat input-register)])))
-                        (^code ((~ [_ (#;Int var)])))]))
-              (not (variableL;captured? var))
-              (n.= input-register (int-to-nat var)))
-      inputS
-
-      (^ (list [(^code ("lux case bind" (~ [_ (#;Nat register)]))) bodyA]))
-      (let$ register inputS (synthesize bodyA))
-      
-      (^or (^ (list [(^code true) thenA] [(^code false) elseA]))
-           (^ (list [(^code false) elseA] [(^code true) thenA])))
-      (if$ inputS (synthesize thenA) (synthesize elseA))
-
-      (#;Cons [lastP lastA] prevsPA)
-      (let [transform-branch (: (-> la;Pattern la;Analysis ls;Path)
-                                (function [pattern expr]
-                                  (|> (synthesize expr)
-                                      (~) ("lux case exec")
-                                      ("lux case seq" (~ (&&case;path pattern)))
-                                      (`))))]
-        (` ("lux case" (~ inputS)
-            (~ (list/fold &&case;weave
-                          (transform-branch lastP lastA)
-                          (list/map (product;uncurry transform-branch) prevsPA))))))
-
-      _
-      (undefined)
-      )))
-
-(def: (synthesize-apply synthesize outer-arity num-locals exprA)
-  (-> (-> la;Analysis ls;Synthesis) ls;Arity Nat la;Analysis ls;Synthesis)
-  (let [[funcA argsA] (&&function;unfold-apply exprA)
-        funcS (synthesize funcA)
-        argsS (list/map synthesize argsA)]
-    (case funcS
-      (^multi (^ [_ (#;Form (list [_ (#;Text "lux function")] [_ (#;Nat _arity)] [_ (#;Tuple _env)] _bodyS))])
-              (and (n.= _arity (list;size argsS))
-                   (not (&&loop;contains-self-reference? _bodyS)))
-              [(s;run _env (p;some s;int)) (#e;Success _env)])
-      (let [register-offset (if (&&function;top? outer-arity)
-                              num-locals
-                              (|> outer-arity n.inc (n.+ num-locals)))]
-        (` ("lux loop" (~ (code;nat register-offset)) [(~@ argsS)]
-            (~ (&&loop;adjust _env register-offset _bodyS)))))
-
-      (^ [_ (#;Form (list& [_ (#;Text "lux call")] funcS' argsS'))])
-      (call$ funcS' (list/compose argsS' argsS))
-
-      _
-      (call$ funcS argsS))))
-
-(def: #export (synthesize analysis)
-  (-> la;Analysis ls;Synthesis)
-  (loop [outer-arity +0
-         resolver init-resolver
-         num-locals +0
-         exprA analysis]
-    (case exprA
-      (^code [(~ _left) (~ _right)])
-      (` [(~@ (list/map (recur +0 resolver num-locals) (la;unfold-tuple exprA)))])
-
-      (^or (^code ("lux sum left" (~ _)))
-           (^code ("lux sum right" (~ _))))
-      (let [[tag last? value] (maybe;assume (la;unfold-variant exprA))]
-        (variant$ tag last? (recur +0 resolver num-locals value)))
-
-      (^code ((~ [_ (#;Int var)])))
-      (if (variableL;local? var)
-        (let [register (variableL;local-register var)]
-          (if (&&function;nested? outer-arity)
-            (if (n.= +0 register)
-              (call$ (var$ 0) (|> (list;n.range +1 (n.dec outer-arity))
-                                  (list/map (|>. variableL;local code;int (~) () (`)))))
-              (var$ (&&function;adjust-var outer-arity (variableL;local register))))
-            (var$ (variableL;local register))))
-        (let [register (variableL;captured-register var)]
-          (var$ (let [var (variableL;captured register)]
-                  (maybe;default var (dict;get var resolver))))))
-
-      (^code ("lux case" (~ inputA) (~ [_ (#;Record branchesA)])))
-      (synthesize-case (recur +0 resolver num-locals) inputA branchesA)
-
-      (^multi (^code ("lux function" [(~@ scope)] (~ bodyA)))
-              [(s;run scope (p;some s;int)) (#e;Success raw-env)])
-      (let [inner-arity (n.inc outer-arity)
-            env (list/map (function [var] (maybe;default var (dict;get var resolver))) raw-env)
-            env-vars (let [env-size (list;size raw-env)]
-                       (: (List Variable)
-                          (case env-size
-                            +0 (list)
-                            _ (list/map variableL;captured (list;n.range +0 (n.dec env-size))))))
-            resolver' (if (&&function;nested? inner-arity)
-                        (list/fold (function [[from to] resolver']
-                                     (dict;put from to resolver'))
-                                   init-resolver
-                                   (list;zip2 env-vars env))
-                        (list/fold (function [var resolver']
-                                     (dict;put var var resolver'))
-                                   init-resolver
-                                   env-vars))]
-        (case (recur inner-arity resolver' +0 bodyA)
-          (^ [_ (#;Form (list [_ (#;Text "lux function")] [_ (#;Nat arity')] env' bodyS'))])
-          (let [arity (n.inc arity')]
-            (function$ arity env (prepare-body inner-arity arity bodyS')))
-
-          bodyS
-          (function$ +1 env (prepare-body inner-arity +1 bodyS))))
-
-      (^code ("lux apply" (~@ _)))
-      (synthesize-apply synthesize outer-arity num-locals exprA)
-
-      (^code ((~ [_ (#;Text name)]) (~@ args)))
-      (procedure$ name (list/map (recur +0 resolver num-locals) args))
-
-      _
-      exprA)))