- WIP: Migrated synthesis to stdlib.

13 files changed, 784 insertions, 61 deletions

diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index b84b0d096..157208071 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -4757,41 +4757,59 @@
       (return (list (` ("lux def" (~ (symbol$ ["" (text/compose prefix name)])) (~ source+)
                         [(~ cursor-code) (#.Record #Nil)])))))))
 
-(macro: #export (open tokens)
+(macro: #export (open: tokens)
   {#.doc "## Opens a structure and generates a definition for each of its members (including nested members).
           ## For example:
-          (open Number<Int> \"i:\")
+          (open: \"i:\" Number<Int>)
           ## Will generate:
           (def: i:+ (:: Number<Int> +))
           (def: i:- (:: Number<Int> -))
           (def: i:* (:: Number<Int> *))
+          ...
+
+          ## However, the prefix is optional.
+          ## For example:
+          (open: Number<Int>)
+          ## Will generate:
+          (def: + (:: Number<Int> +))
+          (def: - (:: Number<Int> -))
+          (def: * (:: Number<Int> *))
           ..."}
-  (case tokens
-    (^ (list& [_ (#Symbol struct-name)] tokens'))
-    (do Monad<Meta>
-      [@module current-module-name
-       #let [prefix (case tokens'
-                      (^ (list [_ (#Text prefix)]))
-                      prefix
-                      
-                      _
-                      "")]
-       struct-type (find-type struct-name)
-       output (resolve-type-tags struct-type)
-       #let [source (symbol$ struct-name)]]
-      (case output
-        (#Some [tags members])
+  (let [[prefix tokens'] (case tokens
+                           (^ (list& [_ (#Text prefix)] tokens'))
+                           [prefix tokens']
+
+                           tokens'
+                           ["" tokens'])]
+    (case tokens'
+      (^ (list struct))
+      (case struct
+        [_ (#Symbol struct-name)]
         (do Monad<Meta>
-          [decls' (monad/map Monad<Meta> (: (-> [Ident Type] (Meta (List Code)))
-                                            (function (_ [sname stype]) (open-field prefix sname source stype)))
-                             (zip2 tags members))]
-          (return (list/join decls')))
+          [struct-type (find-type struct-name)
+           output (resolve-type-tags struct-type)
+           #let [source (symbol$ struct-name)]]
+          (case output
+            (#Some [tags members])
+            (do Monad<Meta>
+              [decls' (monad/map Monad<Meta> (: (-> [Ident Type] (Meta (List Code)))
+                                                (function (_ [sname stype])
+                                                  (open-field prefix sname source stype)))
+                                 (zip2 tags members))]
+              (return (list/join decls')))
+
+            _
+            (fail (text/compose "Can only \"open:\" structs: " (type/show struct-type)))))
 
         _
-        (fail (text/compose "Can only \"open\" structs: " (type/show struct-type)))))
+        (do Monad<Meta>
+          [g!struct (gensym "struct")]
+          (return (list (` ("lux def" (~ g!struct) (~ struct)
+                            [(~ cursor-code) (#.Record #Nil)]))
+                        (` (..open: (~ (text$ prefix)) (~ g!struct)))))))
 
-    _
-    (fail "Wrong syntax for open")))
+      _
+      (fail "Wrong syntax for open:"))))
 
 (macro: #export (|>> tokens)
   {#.doc "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it.
@@ -4897,7 +4915,8 @@
                           defs')
            openings (join-map (: (-> Openings (List Code))
                                  (function (_ [prefix structs])
-                                   (list/map (function (_ [_ name]) (` (open (~ (symbol$ [module-name name])) (~ (text$ prefix)))))
+                                   (list/map (function (_ [_ name])
+                                               (` (open: (~ (text$ prefix)) (~ (symbol$ [module-name name])))))
                                              structs)))
                               r-opens)]]
     (wrap (list/compose defs openings))
diff --git a/stdlib/source/lux/control/state.lux b/stdlib/source/lux/control/state.lux
index 296147e6b..be8844a0c 100644
--- a/stdlib/source/lux/control/state.lux
+++ b/stdlib/source/lux/control/state.lux
@@ -80,7 +80,7 @@
   (All [s a] (-> s (State s a) [s a]))
   (action state))
 
-(struct: (Functor<StateT> Functor<M>)
+(struct: (Functor<State'> Functor<M>)
   (All [M s] (-> (F.Functor M) (F.Functor (All [a] (-> s (M [s a]))))))
   
   (def: (map f sfa)
@@ -88,10 +88,10 @@
       (:: Functor<M> map (function (_ [s a]) [s (f a)])
           (sfa state)))))
 
-(struct: (Apply<StateT> Monad<M>)
+(struct: (Apply<State'> Monad<M>)
   (All [M s] (-> (Monad M) (A.Apply (All [a] (-> s (M [s a]))))))
   
-  (def: functor (Functor<StateT> (:: Monad<M> functor)))
+  (def: functor (Functor<State'> (:: Monad<M> functor)))
 
   (def: (apply sFf sFa)
     (function (_ state)
@@ -109,11 +109,11 @@
   (All [M s a] (-> s (State' M s a) (M [s a])))
   (action state))
 
-(struct: #export (StateT Monad<M>)
+(struct: #export (Monad<State'> Monad<M>)
   {#.doc "A monad transformer to create composite stateful computations."}
   (All [M s] (-> (Monad M) (Monad (State' M s))))
 
-  (def: functor (Functor<StateT> (:: Monad<M> functor)))
+  (def: functor (Functor<State'> (:: Monad<M> functor)))
 
   (def: (wrap a)
     (function (_ state)
diff --git a/stdlib/source/lux/data/coll/list.lux b/stdlib/source/lux/data/coll/list.lux
index 063e9648c..5f41b4381 100644
--- a/stdlib/source/lux/data/coll/list.lux
+++ b/stdlib/source/lux/data/coll/list.lux
@@ -25,7 +25,7 @@
       (#.Cons [x xs'])
       (fold f (f x init) xs'))))
 
-(open Fold<List>)
+(open: Fold<List>)
 
 (def: #export (reverse xs)
   (All [a]
@@ -258,7 +258,7 @@
       #.Nil          ys
       (#.Cons x xs') (#.Cons x (compose xs' ys)))))
 
-(open Monoid<List>)
+(open: Monoid<List>)
 
 (struct: #export _ (Functor List)
   (def: (map f ma)
@@ -266,7 +266,7 @@
       #.Nil          #.Nil
       (#.Cons a ma') (#.Cons (f a) (map f ma')))))
 
-(open Functor<List>)
+(open: Functor<List>)
 
 (struct: #export _ (Apply List)
   (def: functor Functor<List>)
diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux
index 6b259b49f..6d11bb9b0 100644
--- a/stdlib/source/lux/data/text.lux
+++ b/stdlib/source/lux/data/text.lux
@@ -150,7 +150,7 @@
   (def: (compose left right)
     ("lux text concat" left right)))
 
-(open Monoid<Text> "text/")
+(open: "text/" Monoid<Text>)
 
 (def: #export (encode original)
   (-> Text Text)
diff --git a/stdlib/source/lux/lang/analysis.lux b/stdlib/source/lux/lang/analysis.lux
index 324f12b3e..3cac8d7b2 100644
--- a/stdlib/source/lux/lang/analysis.lux
+++ b/stdlib/source/lux/lang/analysis.lux
@@ -1,6 +1,7 @@
 (.module:
   [lux #- nat int deg]
-  (lux [function]
+  (lux (control [equality #+ Eq])
+       [function]
        (data (coll [list "list/" Fold<List>]))))
 
 (type: #export #rec Primitive
@@ -29,6 +30,17 @@
   (#Local Register)
   (#Foreign Register))
 
+(struct: #export _ (Eq Variable)
+  (def: (= reference sample)
+    (case [reference sample]
+      (^template [<tag>]
+        [(<tag> reference') (<tag> sample')]
+        (n/= reference' sample'))
+      ([#Local] [#Foreign])
+
+      _
+      false)))
+
 (type: #export (Match p e)
   [[p e] (List [p e])])
 
@@ -36,16 +48,17 @@
   (List Variable))
 
 (type: #export (Special e)
-  [Text (List e)])
+  {#extension Text
+   #parameters (List e)})
 
 (type: #export #rec Analysis
   (#Primitive Primitive)
   (#Structure (Composite Analysis))
+  (#Variable Variable)
+  (#Constant Ident)
   (#Case Analysis (Match Pattern Analysis))
   (#Function Environment Analysis)
   (#Apply Analysis Analysis)
-  (#Variable Variable)
-  (#Constant Ident)
   (#Special (Special Analysis)))
 
 (do-template [<name> <type> <tag>]
@@ -169,3 +182,12 @@
 
     _
     [analysis (list)]))
+
+(def: #export (self? var)
+  (-> Variable Bool)
+  (case var
+    (#Local +0)
+    true
+    
+    _
+    false))
diff --git a/stdlib/source/lux/lang/analysis/case/coverage.lux b/stdlib/source/lux/lang/analysis/case/coverage.lux
index da256206f..a5958001f 100644
--- a/stdlib/source/lux/lang/analysis/case/coverage.lux
+++ b/stdlib/source/lux/lang/analysis/case/coverage.lux
@@ -172,7 +172,7 @@
       _
       false)))
 
-(open Eq<Coverage> "C/")
+(open: "C/" Eq<Coverage>)
 
 ## After determining the coverage of each individual pattern, it is
 ## necessary to merge them all to figure out if the entire
diff --git a/stdlib/source/lux/lang/extension.lux b/stdlib/source/lux/lang/extension.lux
index 03fd81d71..6da453148 100644
--- a/stdlib/source/lux/lang/extension.lux
+++ b/stdlib/source/lux/lang/extension.lux
@@ -8,7 +8,7 @@
        [macro])
   [// #+ Eval]
   (// [".L" analysis #+ Analyser]
-      [".L" synthesis]))
+      [".L" synthesis #+ Synthesizer]))
 
 (do-template [<name>]
   [(exception: #export (<name> {message Text})
@@ -29,7 +29,8 @@
   (-> Analyser Eval (List Code) (Meta analysisL.Analysis)))
 
 (type: #export Synthesis
-  (-> (-> analysisL.Analysis synthesisL.Synthesis) (List Code) Code))
+  (-> Synthesizer (List analysisL.Analysis)
+      (synthesisL.Operation synthesisL.Synthesis)))
 
 (type: #export Translation
   (-> (List Code) (Meta Code)))
@@ -83,17 +84,20 @@
   [find-statement   Statement   #statement   unknown-statement]
   )
 
-(do-template [<no> <all> <type> <category> <empty>]
-  [(def: #export <no>
-     <type>
-     <empty>)
+(def: #export empty
+  (All [e] (Extension e))
+  (dict.new text.Hash<Text>))
 
-   (def: #export <all>
-     (Meta <type>)
+(do-template [<all> <type> <category>]
+  [(def: #export <all>
+     (Meta (Extension <type>))
      (|> ..get
          (:: macro.Monad<Meta> map (get@ <category>))))]
 
-  [no-syntheses all-syntheses (Extension Synthesis) #synthesis (dict.new text.Hash<Text>)]
+  [all-analyses     Analysis    #analysis]
+  [all-syntheses    Synthesis   #synthesis]
+  [all-translations Translation #translation]
+  [all-statements   Statement   #statement]
   )
 
 (do-template [<name> <type> <category> <exception>]
diff --git a/stdlib/source/lux/lang/synthesis.lux b/stdlib/source/lux/lang/synthesis.lux
index 33c8aa063..4bb83ac5e 100644
--- a/stdlib/source/lux/lang/synthesis.lux
+++ b/stdlib/source/lux/lang/synthesis.lux
@@ -1,8 +1,152 @@
 (.module:
-  lux)
+  [lux #- Scope]
+  (lux (control [state]
+                ["ex" exception #+ Exception exception:])
+       (data [product]
+             [error #+ Error]
+             [number]
+             (coll (dictionary ["dict" unordered #+ Dict]))))
+  [//analysis #+ Register Variable Environment Special Analysis])
 
-(def: #export Arity Nat)
+(type: #export Arity Nat)
 
-(type: #export Synthesis Code)
+(type: #export Resolver (Dict Register Variable))
 
-(type: #export Path Code)
+(type: #export State
+  {#scope-arity Arity
+   #resolver Resolver
+   #direct? Bool
+   #locals Nat})
+
+(def: #export init
+  State
+  {#scope-arity +0
+   #resolver (dict.new number.Hash<Nat>)
+   #direct? false
+   #locals +0})
+
+(type: (Operation' s o)
+  (state.State' Error s o))
+
+(type: #export (Compiler s i o)
+  (-> i (Operation' ..State o)))
+
+(type: #export Primitive
+  (#Bool Bool)
+  (#I64 I64)
+  (#F64 Frac)
+  (#Text Text))
+
+(type: #export (Structure a)
+  (#Variant (//analysis.Variant a))
+  (#Tuple (//analysis.Tuple a)))
+
+(type: #export (Path' s)
+  (#Bind Register)
+  (#Alt (Path' s) (Path' s))
+  (#Seq (Path' s) (Path' s))
+  (#Exec s))
+
+(type: #export (Abstraction' s)
+  {#environment Environment
+   #arity Arity
+   #body s})
+
+(type: #export (Branch s)
+  (#Case s (Path' s))
+  (#Let s Register s)
+  (#If s s s))
+
+(type: #export (Scope s)
+  {#start Register
+   #inits (List s)
+   #iteration s})
+
+(type: #export (Loop s)
+  (#Scope (Scope s))
+  (#Recur (List s)))
+
+(type: #export (Function s)
+  (#Abstraction (Abstraction' s))
+  (#Apply s (List s)))
+
+(type: #export (Control s)
+  (#Branch (Branch s))
+  (#Loop (Loop s))
+  (#Function (Function s)))
+
+(type: #export #rec Synthesis
+  (#Primitive Primitive)
+  (#Structure (Structure Synthesis))
+  (#Variable Variable)
+  (#Control (Control Synthesis))
+  (#Special (Special Synthesis)))
+
+(type: #export Path
+  (Path' Synthesis))
+
+(type: #export Abstraction
+  (Abstraction' Synthesis))
+
+(type: #export (Operation a)
+  (Operation' ..State a))
+
+(def: #export unit Text "")
+
+(type: #export Synthesizer
+  (Compiler ..State Analysis Synthesis))
+
+(def: #export (throw exception parameters)
+  (All [e] (-> (Exception e) e Operation'))
+  (state.lift error.Monad<Error>
+              (ex.throw exception parameters)))
+
+(def: #export (run synthesizer analysis)
+  (-> Synthesizer Analysis (Error Synthesis))
+  (:: error.Monad<Error> map product.right
+      (synthesizer analysis ..init)))
+
+(def: (localized transform)
+  (-> (-> State State)
+      (-> Synthesizer Synthesizer))
+  (function (scope synthesizer)
+    (function (synthesize analysis state)
+      (case (synthesize analysis (transform state))
+        (#error.Error error)
+        (#error.Error error)
+
+        (#error.Success [state' output])
+        (#error.Success [state output])))))
+
+(def: #export indirectly
+  (-> Synthesizer Synthesizer)
+  (localized (set@ #direct? false)))
+
+(do-template [<name> <tag> <type>]
+  [(def: #export <name>
+     (Operation <type>)
+     (function (_ state)
+       (#error.Success [state (get@ <tag> state)])))]
+
+  [scope-arity #scope-arity Arity]
+  [direct?     #direct?     Bool]
+  [locals      #locals      Nat]
+  )
+
+(do-template [<name> <family> <tag>]
+  [(template: #export (<name> content)
+     (<| #..Control
+         <family>
+         <tag>
+         content))]
+
+  [branch/case          #..Branch   #..Case]
+  [branch/let           #..Branch   #..Let]
+  [branch/if            #..Branch   #..If]
+
+  [loop/scope           #..Loop     #..Scope]
+  [loop/recur           #..Loop     #..Recur]
+
+  [function/abstraction #..Function #..Abstraction]
+  [function/apply       #..Function #..Apply]
+  )
diff --git a/stdlib/source/lux/lang/synthesis/expression.lux b/stdlib/source/lux/lang/synthesis/expression.lux
new file mode 100644
index 000000000..1167e975a
--- /dev/null
+++ b/stdlib/source/lux/lang/synthesis/expression.lux
@@ -0,0 +1,210 @@
+(.module:
+  [lux #- primitive]
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:]
+                [state])
+       (data [maybe]
+             [error]
+             [number]
+             [product]
+             text/format
+             (coll [list "list/" Functor<List> Fold<List> Monoid<List>]
+                   (dictionary ["dict" unordered #+ Dict])))
+       (macro [code]
+              ["s" syntax])
+       [lang]
+       (lang [".L" analysis #+ Analysis]
+             [".L" extension #+ Extension]))
+  [// #+ Synthesis]
+  [//function]
+  ## (luxc (lang (synthesis [".S" case]
+  ##                        [".S" loop])
+  ##             [".L" variable #+ Variable])
+  ##       )
+  )
+
+(exception: #export (unknown-synthesis-extension {name Text})
+  name)
+
+## (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 Synthesis Synthesis)
+##   (if (//function.nested? inner-arity)
+##     body
+##     (loopS.reify-recursion arity body)))
+
+## (def: (let$ register inputS bodyS)
+##   (-> Nat Synthesis Synthesis Synthesis)
+##   (` ("lux let" (~ (code.nat register)) (~ inputS) (~ bodyS))))
+
+## (def: (if$ testS thenS elseS)
+##   (-> Synthesis Synthesis Synthesis Synthesis)
+##   (` ("lux if" (~ testS)
+##       (~ thenS)
+##       (~ elseS))))
+
+## (def: (variant$ tag last? valueS)
+##   (-> Nat Bool Synthesis Synthesis)
+##   (` ((~ (code.nat tag)) (~ (code.bool last?)) (~ valueS))))
+
+## (def: (var$ var)
+##   (-> Variable Synthesis)
+##   (` ((~ (code.int var)))))
+
+## (def: (procedure$ name argsS)
+##   (-> Text (List Synthesis) Synthesis)
+##   (` ((~ (code.text name)) (~+ argsS))))
+
+## (def: (call$ funcS argsS)
+##   (-> Synthesis (List Synthesis) Synthesis)
+##   (` ("lux call" (~ funcS) (~+ argsS))))
+
+## (def: (synthesize-case arity num-locals synthesize inputA branchesA)
+##   (-> ls.Arity Nat (-> Nat Analysis Synthesis)
+##       Analysis (List [la.Pattern Analysis])
+##       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 (//function.nested? arity)
+##               (n/+ (dec arity) register)
+##               register)
+##             inputS
+##             (synthesize (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 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: (primitive analysis)
+  (-> analysisL.Primitive //.Primitive)
+  (case analysis
+    #analysisL.Unit
+    (#//.Text //.unit)
+    
+    (^template [<analysis> <synthesis>]
+      (<analysis> value)
+      (<synthesis> value))
+    ([#analysisL.Bool #//.Bool]
+     [#analysisL.Frac #//.F64]
+     [#analysisL.Text #//.Text])
+
+    (^template [<analysis> <synthesis>]
+      (<analysis> value)
+      (<synthesis> (.i64 value)))
+    ([#analysisL.Nat #//.I64]
+     [#analysisL.Int #//.I64]
+     [#analysisL.Deg #//.I64])))
+
+(def: Compiler@Monad (state.Monad<State'> error.Monad<Error>))
+(open: "compiler/" Compiler@Monad)
+
+(def: #export (synthesizer extensions)
+  (-> (Extension extensionL.Synthesis) //.Synthesizer)
+  (function (synthesize analysis)
+    (case analysis
+      (#analysisL.Primitive analysis')
+      (compiler/wrap (#//.Primitive (..primitive analysis')))
+
+      (#analysisL.Structure composite)
+      (case (analysisL.variant analysis)
+        (#.Some variant)
+        (do Compiler@Monad
+          [valueS (synthesize (get@ #analysisL.value variant))]
+          (wrap (#//.Structure (#//.Variant (set@ #analysisL.value valueS variant)))))
+
+        _
+        (do Compiler@Monad
+          [tupleS (monad.map @ synthesize (analysisL.tuple analysis))]
+          (wrap (#//.Structure (#//.Tuple tupleS)))))
+
+      (#analysisL.Apply _)
+      (//function.apply (//.indirectly synthesize) analysis)
+
+      (#analysisL.Special name args)
+      (case (dict.get name extensions)
+        #.None
+        (//.throw unknown-synthesis-extension name)
+        
+        (#.Some extension)
+        (extension (//.indirectly synthesize) args))
+
+      _
+      (undefined)
+
+      ## (^code ((~ [_ (#.Int var)])))
+      ## (if (variableL.local? var)
+      ##   (if (//function.nested? arity)
+      ##     (if (variableL.self? var)
+      ##       (call$ (var$ 0) (|> (list.n/range +1 (dec arity))
+      ##                           (list/map (|>> variableL.local code.int (~) () (`)))))
+      ##       (var$ (//function.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 (//.indirectly synthesize) inputA branchesA)
+
+      ## (^multi (^code ("lux function" [(~+ scope)] (~ bodyA)))
+      ##         [(s.run scope (p.some s.int)) (#error.Success raw-env)])
+      ## (let [function-arity (if direct?
+      ##                        (inc arity)
+      ##                        +1)
+      ##       env (list/map (function (_ closure)
+      ##                       (case (dict.get closure resolver)
+      ##                         (#.Some resolved)
+      ##                         (if (and (variableL.local? resolved)
+      ##                                  (//function.nested? arity)
+      ##                                  (|> resolved variableL.local-register (n/>= arity)))
+      ##                           (//function.adjust-var arity resolved)
+      ##                           resolved)
+
+      ##                         #.None
+      ##                         (if (and (variableL.local? closure)
+      ##                                  (//function.nested? arity))
+      ##                           (//function.adjust-var arity closure)
+      ##                           closure)))
+      ##                     raw-env)
+      ##       env-vars (: (List Variable)
+      ##                   (case raw-env
+      ##                     #.Nil (list)
+      ##                     _ (|> (list.size raw-env) dec (list.n/range +0) (list/map variableL.captured))))
+      ##       resolver' (if (and (//function.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 (inc unmerged-arity)]
+      ##       (function$ merged-arity env
+      ##                  (prepare-body function-arity merged-arity bodyS')))
+
+      ##     bodyS
+      ##     (function$ +1 env (prepare-body function-arity +1 bodyS))))
+      )))
diff --git a/stdlib/source/lux/lang/synthesis/function.lux b/stdlib/source/lux/lang/synthesis/function.lux
new file mode 100644
index 000000000..7b989d975
--- /dev/null
+++ b/stdlib/source/lux/lang/synthesis/function.lux
@@ -0,0 +1,49 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]
+                [state])
+       (data [maybe]
+             [error]
+             (coll [list "list/" Monoid<List>]))
+       (lang [".L" analysis #+ Variable Analysis]))
+  [// #+ Arity Synthesizer]
+  [//loop])
+
+(def: nested?
+  (-> Arity Bool)
+  (n/> +1))
+
+## (def: (adjust-var outer var)
+##   (-> Arity Variable Variable)
+##   (|> outer dec .int (i/+ var)))
+
+(def: (unfold apply)
+  (-> Analysis [Analysis (List Analysis)])
+  (loop [apply apply
+         args (list)]
+    (case apply
+      (#analysisL.Apply arg func)
+      (recur func (#.Cons arg args))
+
+      _
+      [apply args])))
+
+(def: #export (apply synthesize)
+  (-> Synthesizer Synthesizer)
+  (function (_ exprA)
+    (let [[funcA argsA] (unfold exprA)]
+      (do (state.Monad<State'> error.Monad<Error>)
+        [funcS (synthesize funcA)
+         argsS (monad.map @ synthesize argsA)
+         locals //.locals]
+        (case funcS
+          (^ (//.function/abstraction functionS))
+          (wrap (|> functionS
+                    (//loop.loop (get@ #//.environment functionS) locals argsS)
+                    (maybe.default (//.function/apply [funcS argsS]))))
+
+          (^ (//.function/apply [funcS' argsS']))
+          (wrap (//.function/apply [funcS' (list/compose argsS' argsS)]))
+
+          _
+          (wrap (//.function/apply [funcS argsS])))))))
diff --git a/stdlib/source/lux/lang/synthesis/loop.lux b/stdlib/source/lux/lang/synthesis/loop.lux
new file mode 100644
index 000000000..476cf27b4
--- /dev/null
+++ b/stdlib/source/lux/lang/synthesis/loop.lux
@@ -0,0 +1,277 @@
+(.module:
+  [lux #- loop]
+  (lux (control [monad #+ do]
+                ["p" parser])
+       (data [maybe "maybe/" Monad<Maybe>]
+             (coll [list "list/" Functor<List>]))
+       (macro [code]
+              [syntax]))
+  [///analysis #+ Register Variable Environment]
+  [// #+ Path Abstraction Synthesis])
+
+(type: (Transform a)
+  (-> a (Maybe a)))
+
+(def: (some? maybe)
+  (All [a] (-> (Maybe a) Bool))
+  (case maybe
+    (#.Some _) true
+    #.None     false))
+
+(def: proper Bool true)
+
+(def: (proper? exprS)
+  (-> Synthesis Bool)
+  (case exprS
+    (#//.Structure structure)
+    (case structure
+      (#//.Variant variantS)
+      (proper? (get@ #///analysis.value variantS))
+      
+      (#//.Tuple membersS+)
+      (list.every? proper? membersS+))
+
+    (#//.Variable var)
+    (not (///analysis.self? var))
+
+    (#//.Control controlS)
+    (case controlS
+      (#//.Branch branchS)
+      (case branchS
+        (#//.Case inputS pathS)
+        (and (proper? inputS)
+             (.loop [pathS pathS]
+               (case pathS
+                 (^or (#//.Alt leftS rightS) (#//.Seq leftS rightS))
+                 (and (recur leftS) (recur rightS))
+
+                 (#//.Exec bodyS)
+                 (proper? bodyS)
+                 
+                 _
+                 proper)))
+
+        (#//.Let inputS register bodyS)
+        (and (proper? inputS)
+             (proper? bodyS))
+
+        (#//.If inputS thenS elseS)
+        (and (proper? inputS)
+             (proper? thenS)
+             (proper? elseS)))
+
+      (#//.Loop loopS)
+      (case loopS
+        (#//.Scope scopeS)
+        (and (list.every? proper? (get@ #//.inits scopeS))
+             (proper? (get@ #//.iteration scopeS)))
+
+        (#//.Recur argsS)
+        (list.every? proper? argsS))
+
+      (#//.Function functionS)
+      (case functionS
+        (#//.Abstraction environment arity bodyS)
+        (list.every? ///analysis.self? environment)
+
+        (#//.Apply funcS argsS)
+        (and (proper? funcS)
+             (list.every? proper? argsS))))
+
+    (#//.Special [special argsS])
+    (list.every? proper? argsS)
+
+    _
+    proper))
+
+(def: (path-recursion synthesis-recursion)
+  (-> (Transform Synthesis) (Transform Path))
+  (function (recur pathS)
+    (case pathS
+      (#//.Alt leftS rightS)
+      (let [leftS' (recur leftS)
+            rightS' (recur rightS)]
+        (if (or (some? leftS')
+                (some? rightS'))
+          (#.Some (#//.Alt (maybe.default leftS leftS')
+                           (maybe.default rightS rightS')))
+          #.None))
+      
+      (#//.Seq leftS rightS)
+      (maybe/map (|>> (#//.Seq leftS)) (recur rightS))
+
+      (#//.Exec bodyS)
+      (maybe/map (|>> #//.Exec) (synthesis-recursion bodyS))
+      
+      _
+      #.None)))
+
+(template: (recursive-apply args)
+  (#//.Apply (#//.Variable (#///analysis.Local +0))
+             args))
+
+(def: #export (recursion arity)
+  (-> Nat (Transform Synthesis))
+  (function (recur exprS)
+    (case exprS
+      (#//.Control controlS)
+      (case controlS
+        (#//.Branch branchS)
+        (case branchS
+          (#//.Case inputS pathS)
+          (|> pathS
+              (path-recursion recur)
+              (maybe/map (|>> (#//.Case inputS) #//.Branch #//.Control)))
+
+          (#//.Let inputS register bodyS)
+          (maybe/map (|>> (#//.Let inputS register) #//.Branch #//.Control)
+                     (recur bodyS))
+
+          (#//.If inputS thenS elseS)
+          (let [thenS' (recur thenS)
+                elseS' (recur elseS)]
+            (if (or (some? thenS')
+                    (some? elseS'))
+              (#.Some (|> (#//.If inputS
+                                  (maybe.default thenS thenS')
+                                  (maybe.default elseS elseS'))
+                          #//.Branch #//.Control))
+              #.None)))
+
+        (^ (#//.Function (recursive-apply argsS)))
+        (if (n/= arity (list.size argsS))
+          (#.Some (|> argsS #//.Recur #//.Loop #//.Control))
+          #.None)
+
+        _
+        #.None)
+
+      _
+      #.None)))
+
+(def: (resolve environment)
+  (-> Environment (Transform Variable))
+  (function (_ variable)
+    (case variable
+      (#///analysis.Foreign register)
+      (list.nth register environment)
+
+      _
+      (#.Some variable))))
+
+(def: (adjust-path adjust-synthesis offset)
+  (-> (Transform Synthesis) Register (Transform Path))
+  (function (recur pathS)
+    (case pathS
+      (#//.Bind register)
+      (#.Some (#//.Bind (n/+ offset register)))
+
+      (^template [<tag>]
+        (<tag> leftS rightS)
+        (do maybe.Monad<Maybe>
+          [leftS' (recur leftS)
+           rightS' (recur rightS)]
+          (wrap (<tag> leftS' rightS'))))
+      ([#//.Alt] [#//.Seq])
+      
+      (#//.Exec bodyS)
+      (|> bodyS adjust-synthesis (maybe/map (|>> #//.Exec)))
+
+      _
+      (#.Some pathS))))
+
+(def: (adjust scope-environment offset)
+  (-> Environment Register (Transform Synthesis))
+  (function (recur exprS)
+    (case exprS
+      (#//.Structure structureS)
+      (case structureS
+        (#//.Variant variantS)
+        (do maybe.Monad<Maybe>
+          [valueS' (|> variantS (get@ #///analysis.value) recur)]
+          (wrap (|> variantS
+                    (set@ #///analysis.value valueS')
+                    #//.Variant
+                    #//.Structure)))
+        
+        (#//.Tuple membersS+)
+        (|> membersS+
+            (monad.map maybe.Monad<Maybe> recur)
+            (maybe/map (|>> #//.Tuple #//.Structure))))
+
+      (#//.Variable variable)
+      (case variable
+        (#///analysis.Local register)
+        (#.Some (#//.Variable (#///analysis.Local (n/+ offset register))))
+        
+        (#///analysis.Foreign register)
+        (|> scope-environment
+            (list.nth register)
+            (maybe/map (|>> #//.Variable))))
+
+      (^ (//.branch/case [inputS pathS]))
+      (do maybe.Monad<Maybe>
+        [inputS' (recur inputS)
+         pathS' (adjust-path recur offset pathS)]
+        (wrap (|> pathS' [inputS'] //.branch/case)))
+
+      (^ (//.branch/let [inputS register bodyS]))
+      (do maybe.Monad<Maybe>
+        [inputS' (recur inputS)
+         bodyS' (recur bodyS)]
+        (wrap (//.branch/let [inputS' register bodyS'])))
+
+      (^ (//.branch/if [inputS thenS elseS]))
+      (do maybe.Monad<Maybe>
+        [inputS' (recur inputS)
+         thenS' (recur thenS)
+         elseS' (recur elseS)]
+        (wrap (//.branch/if [inputS' thenS' elseS'])))
+
+      (^ (//.loop/scope scopeS))
+      (do maybe.Monad<Maybe>
+        [inits' (|> scopeS
+                    (get@ #//.inits)
+                    (monad.map maybe.Monad<Maybe> recur))
+         iteration' (recur (get@ #//.iteration scopeS))]
+        (wrap (//.loop/scope {#//.start (|> scopeS (get@ #//.start) (n/+ offset))
+                              #//.inits inits'
+                              #//.iteration iteration'})))
+
+      (^ (//.loop/recur argsS))
+      (|> argsS
+          (monad.map maybe.Monad<Maybe> recur)
+          (maybe/map (|>> //.loop/recur)))
+      
+
+      (^ (//.function/abstraction [environment arity bodyS]))
+      (do maybe.Monad<Maybe>
+        [environment' (monad.map maybe.Monad<Maybe>
+                                 (resolve scope-environment)
+                                 environment)]
+        (wrap (//.function/abstraction [environment' arity bodyS])))
+      
+      (^ (//.function/apply [function arguments]))
+      (do maybe.Monad<Maybe>
+        [function' (recur function)
+         arguments' (monad.map maybe.Monad<Maybe> recur arguments)]
+        (wrap (//.function/apply [function' arguments'])))
+
+      (#//.Special [procedure argsS])
+      (|> argsS
+          (monad.map maybe.Monad<Maybe> recur)
+          (maybe/map (|>> [procedure] #//.Special)))
+
+      _
+      (#.Some exprS))))
+
+(def: #export (loop environment num-locals inits functionS)
+  (-> Environment Nat (List Synthesis) Abstraction (Maybe Synthesis))
+  (let [bodyS (get@ #//.body functionS)]
+    (if (and (n/= (list.size inits)
+                  (get@ #//.arity functionS))
+             (proper? bodyS))
+      (|> bodyS
+          (adjust environment num-locals)
+          (maybe/map (|>> [(inc num-locals) inits] //.loop/scope)))
+      #.None)))
diff --git a/stdlib/source/lux/lang/type/check.lux b/stdlib/source/lux/lang/type/check.lux
index 61001d8be..2e255d47c 100644
--- a/stdlib/source/lux/lang/type/check.lux
+++ b/stdlib/source/lux/lang/type/check.lux
@@ -24,15 +24,13 @@
   (type.to-text (#.Apply argT funcT)))
 
 (exception: #export (cannot-rebind-var {id Nat} {type Type} {bound Type})
-  ($_ text/compose
-      "         Var: " (nat/encode id) "\n"
-      " Wanted Type: " (type.to-text type) "\n"
-      "Current Type: " (type.to-text bound)))
+  (ex.report ["Var" (nat/encode id)]
+             ["Wanted Type" (type.to-text type)]
+             ["Current Type" (type.to-text bound)]))
 
 (exception: #export (type-check-failed {expected Type} {actual Type})
-  ($_ text/compose
-      "Expected: " (type.to-text expected) "\n\n"
-      "  Actual: " (type.to-text actual)))
+  (ex.report ["Expected" (type.to-text expected)]
+             ["Actual" (type.to-text actual)]))
 
 (type: #export Var Nat)
 
@@ -99,7 +97,7 @@
         )))
   )
 
-(open Monad<Check> "check/")
+(open: "check/" Monad<Check>)
 
 (def: (var::get id plist)
   (-> Var Type-Vars (Maybe (Maybe Type)))
diff --git a/stdlib/source/lux/world/console.lux b/stdlib/source/lux/world/console.lux
index 7bd7cfaca..b66dce4da 100644
--- a/stdlib/source/lux/world/console.lux
+++ b/stdlib/source/lux/world/console.lux
@@ -1,5 +1,5 @@
 (.module:
-  [lux #- open]
+  lux
   (lux (control [monad #+ do])
        (data ["e" error]
              [text])