- WIP: Migrated synthesis to stdlib.

3 files changed, 0 insertions, 419 deletions

diff --git a/new-luxc/source/luxc/lang/synthesis/expression.lux b/new-luxc/source/luxc/lang/synthesis/expression.lux
deleted file mode 100644
index 3fa594086..000000000
--- a/new-luxc/source/luxc/lang/synthesis/expression.lux
+++ /dev/null
@@ -1,202 +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>]
-                   (dictionary ["dict" unordered #+ Dict])))
-       (macro [code]
-              ["s" syntax]))
-  (luxc (lang ["la" analysis]
-              ["ls" synthesis]
-              [".L" extension #+ Syntheses]
-              (synthesis [".S" case]
-                         [".S" function]
-                         [".S" loop])
-              [".L" variable #+ Variable])
-        ))
-
-(def: init-env (List Variable) (list))
-(def: init-resolver (Dict Int Int) (dict.new number.Hash<Int>))
-
-(def: (prepare-body inner-arity arity body)
-  (-> ls.Arity ls.Arity ls.Synthesis ls.Synthesis)
-  (if (functionS.nested? inner-arity)
-    body
-    (loopS.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 arity num-locals synthesize inputA branchesA)
-  (-> ls.Arity Nat (-> Nat la.Analysis ls.Synthesis)
-      la.Analysis (List [la.Pattern la.Analysis])
-      ls.Synthesis)
-  (let [inputS (synthesize num-locals inputA)]
-    (case (list.reverse branchesA)
-      (^multi (^ (list [(^code ("lux case bind" (~ [_ (#.Nat input-register)])))
-                        (^code ((~ [_ (#.Int var)])))]))
-              (not (variableL.captured? var))
-              (n/= input-register (variableL.local-register var)))
-      inputS
-
-      (^ (list [(^code ("lux case bind" (~ [_ (#.Nat register)]))) bodyA]))
-      (let$ (if (functionS.nested? arity)
-              (n/+ (n/dec arity) register)
-              register)
-            inputS
-            (synthesize (n/inc num-locals) bodyA))
-      
-      (^or (^ (list [(^code true) thenA] [(^code false) elseA]))
-           (^ (list [(^code false) elseA] [(^code true) thenA])))
-      (if$ inputS (synthesize num-locals thenA) (synthesize num-locals elseA))
-
-      (#.Cons [lastP lastA] prevsPA)
-      (let [transform-branch (: (-> la.Pattern la.Analysis ls.Path)
-                                (caseS.path arity num-locals synthesize))
-            pathS (list/fold caseS.weave
-                             (transform-branch lastP lastA)
-                             (list/map (product.uncurry transform-branch) prevsPA))]
-        (` ("lux case" (~ inputS) (~ pathS))))
-
-      _
-      (undefined)
-      )))
-
-(def: (synthesize-apply synthesize num-locals exprA)
-  (-> (-> la.Analysis ls.Synthesis) Nat la.Analysis ls.Synthesis)
-  (let [[funcA argsA] (functionS.unfold-apply exprA)
-        funcS (synthesize funcA)
-        argsS (list/map synthesize argsA)]
-    (case funcS
-      (^multi (^code ("lux function" (~ [_ (#.Nat _arity)]) [(~+ _env)] (~ _bodyS)))
-              (and (n/= _arity (list.size argsS))
-                   (not (loopS.contains-self-reference? _bodyS)))
-              [(s.run _env (p.some s.int)) (#e.Success _env)])
-      (` ("lux loop" (~ (code.nat (n/inc num-locals))) [(~+ argsS)]
-          (~ (loopS.adjust _env num-locals _bodyS))))
-
-      (^code ("lux call" (~ funcS') (~+ argsS')))
-      (call$ funcS' (list/compose argsS' argsS))
-
-      _
-      (call$ funcS argsS))))
-
-(def: #export (synthesize extensions expressionA)
-  (-> Syntheses la.Analysis ls.Synthesis)
-  (loop [arity +0
-         resolver init-resolver
-         direct? false
-         num-locals +0
-         expressionA expressionA]
-    (case expressionA
-      (^code [(~ _left) (~ _right)])
-      (` [(~+ (list/map (recur arity resolver false num-locals)
-                        (la.unfold-tuple expressionA)))])
-
-      (^or (^code ("lux sum left" (~ _)))
-           (^code ("lux sum right" (~ _))))
-      (let [[tag last? value] (maybe.assume (la.unfold-variant expressionA))]
-        (variant$ tag last? (recur arity resolver false num-locals value)))
-
-      (^code ((~ [_ (#.Int var)])))
-      (if (variableL.local? var)
-        (if (functionS.nested? arity)
-          (if (variableL.self? var)
-            (call$ (var$ 0) (|> (list.n/range +1 (n/dec arity))
-                                (list/map (|>> variableL.local code.int (~) () (`)))))
-            (var$ (functionS.adjust-var arity var)))
-          (var$ var))
-        (var$ (maybe.default var (dict.get var resolver))))
-
-      (^code ("lux case" (~ inputA) (~ [_ (#.Record branchesA)])))
-      (synthesize-case arity num-locals (recur arity resolver false) inputA branchesA)
-
-      (^multi (^code ("lux function" [(~+ scope)] (~ bodyA)))
-              [(s.run scope (p.some s.int)) (#e.Success raw-env)])
-      (let [function-arity (if direct?
-                             (n/inc arity)
-                             +1)
-            env (list/map (function (_ closure)
-                            (case (dict.get closure resolver)
-                              (#.Some resolved)
-                              (if (and (variableL.local? resolved)
-                                       (functionS.nested? arity)
-                                       (|> resolved variableL.local-register (n/>= arity)))
-                                (functionS.adjust-var arity resolved)
-                                resolved)
-
-                              #.None
-                              (if (and (variableL.local? closure)
-                                       (functionS.nested? arity))
-                                (functionS.adjust-var arity closure)
-                                closure)))
-                          raw-env)
-            env-vars (: (List Variable)
-                        (case raw-env
-                          #.Nil (list)
-                          _ (|> (list.size raw-env) n/dec (list.n/range +0) (list/map variableL.captured))))
-            resolver' (if (and (functionS.nested? function-arity)
-                               direct?)
-                        (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 function-arity resolver' true function-arity bodyA)
-          (^ [_ (#.Form (list [_ (#.Text "lux function")] [_ (#.Nat unmerged-arity)] env' bodyS'))])
-          (let [merged-arity (n/inc unmerged-arity)]
-            (function$ merged-arity env
-                       (prepare-body function-arity merged-arity bodyS')))
-
-          bodyS
-          (function$ +1 env (prepare-body function-arity +1 bodyS))))
-
-      (^code ("lux apply" (~+ _)))
-      (synthesize-apply (recur arity resolver false num-locals) num-locals expressionA)
-
-      (^code ((~ [_ (#.Text name)]) (~+ args)))
-      (case (dict.get name extensions)
-        #.None
-        (procedure$ name (list/map (recur arity resolver false num-locals) args))
-        
-        (#.Some extension)
-        (extension (recur arity resolver false num-locals) args))
-
-      _
-      expressionA)))
diff --git a/new-luxc/source/luxc/lang/synthesis/function.lux b/new-luxc/source/luxc/lang/synthesis/function.lux
deleted file mode 100644
index 25dd75aff..000000000
--- a/new-luxc/source/luxc/lang/synthesis/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/lang/synthesis/loop.lux b/new-luxc/source/luxc/lang/synthesis/loop.lux
deleted file mode 100644
index c00d5626b..000000000
--- a/new-luxc/source/luxc/lang/synthesis/loop.lux
+++ /dev/null
@@ -1,188 +0,0 @@
-(.module:
-  lux
-  (lux (control [monad #+ do]
-                ["p" parser])
-       (data [maybe]
-             (coll [list "list/" Functor<List>]))
-       (macro [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 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
-        (^code ((~ [_ (#.Nat tag)]) (~ last?) (~ valueS)))
-        (` ((~ (code.nat tag)) (~ last?) (~ (recur valueS))))
-        
-        (^code [(~+ members)])
-        (` [(~+ (list/map recur members))])
-
-        (^code ("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"])
-
-                     (^code ("lux case bind" (~ [_ (#.Nat register)])))
-                     (` ("lux case bind" (~ (code.nat (n/+ offset register)))))
-
-                     (^ [_ (#.Form (list [_ (#.Text "lux case exec")] bodyS))])
-                     (` ("lux case exec" (~ (adjust' bodyS))))
-                     
-                     _
-                     pathS))))))
-
-        (^code ("lux function" (~ arity) [(~+ environment)] (~ bodyS)))
-        (` ("lux function" (~ arity)
-            [(~+ (list/map (function (_ _var)
-                             (case _var
-                               (^ [_ (#.Form (list [_ (#.Int var)]))])
-                               (` ((~ (code.int (resolve-captured var)))))
-
-                               _
-                               _var))
-                           environment))]
-            (~ 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))))
-        
-        (^code ("lux let" (~ [_ (#.Nat register)]) (~ inputS) (~ bodyS)))
-        (` ("lux let" (~ (code.nat (n/+ 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 loop-offset)] [_ (#.Tuple initsS)] bodyS))])
-        (` ("lux loop" (~ (code.nat (n/+ offset loop-offset)))
-            [(~+ (list/map recur initsS))]
-            (~ (recur bodyS))))
-
-        (^ [_ (#.Form (list [_ (#.Int var)]))])
-        (if (variableL.captured? var)
-          (` ((~ (code.int (resolve-captured var)))))
-          (` ((~ (code.int (|> offset nat-to-int (i/+ var)))))))
-
-        (^ [_ (#.Form (list& [_ (#.Text procedure)] argsS))])
-        (` ((~ (code.text procedure)) (~+ (list/map recur argsS))))
-
-        _
-        exprS
-        ))))