From 70152bea7b43320cf5f7f0c4d136664245f25039 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Wed, 15 Aug 2018 21:29:58 -0400
Subject: Fixes for function synthesis.

---
 stdlib/source/lux/compiler/default/evaluation.lux  |   2 +-
 stdlib/source/lux/compiler/default/init.lux        |   2 +-
 .../source/lux/compiler/default/phase/analysis.lux |  22 +-
 .../lux/compiler/default/phase/synthesis.lux       | 234 +++++++++++++----
 .../lux/compiler/default/phase/synthesis/case.lux  |  15 +-
 .../default/phase/synthesis/expression.lux         |  59 ++---
 .../compiler/default/phase/synthesis/function.lux  | 277 ++++++++++++++-------
 .../default/phase/translation/scheme/case.jvm.lux  |   2 +-
 .../lux/compiler/default/phase/synthesis/case.lux  |   6 +-
 .../compiler/default/phase/synthesis/function.lux  |  17 +-
 .../compiler/default/phase/synthesis/primitive.lux |   2 +-
 .../compiler/default/phase/synthesis/structure.lux |   4 +-
 12 files changed, 427 insertions(+), 215 deletions(-)

diff --git a/stdlib/source/lux/compiler/default/evaluation.lux b/stdlib/source/lux/compiler/default/evaluation.lux
index 3fb1a9984..ea76624df 100644
--- a/stdlib/source/lux/compiler/default/evaluation.lux
+++ b/stdlib/source/lux/compiler/default/evaluation.lux
@@ -29,7 +29,7 @@
       [exprA (type.with-type type
                (expressionA.compile exprC))]
       (phase.lift (do error.Monad<Error>
-                    [exprS (|> exprA expressionS.synthesize (phase.run synthesis-state))]
+                    [exprS (|> exprA expressionS.phase (phase.run synthesis-state))]
                     (phase.run translation-state
                                (do phase.Monad<Operation>
                                  [exprO (translate exprS)]
diff --git a/stdlib/source/lux/compiler/default/init.lux b/stdlib/source/lux/compiler/default/init.lux
index 947dc9d4b..96464ed2a 100644
--- a/stdlib/source/lux/compiler/default/init.lux
+++ b/stdlib/source/lux/compiler/default/init.lux
@@ -85,7 +85,7 @@
      {#statement.analysis {#statement.state analysis-state
                            #statement.phase expressionA.compile}
       #statement.synthesis {#statement.state synthesis-state
-                            #statement.phase expressionS.synthesize}
+                            #statement.phase expressionS.phase}
       #statement.translation {#statement.state translation-state
                               #statement.phase translate}}]))
 
diff --git a/stdlib/source/lux/compiler/default/phase/analysis.lux b/stdlib/source/lux/compiler/default/phase/analysis.lux
index 7663f6950..dde9f4e9a 100644
--- a/stdlib/source/lux/compiler/default/phase/analysis.lux
+++ b/stdlib/source/lux/compiler/default/phase/analysis.lux
@@ -112,19 +112,23 @@
       (#..Function (list))
       (#..Apply value)))
 
-(def: #export (apply [func args])
+(def: #export (apply [abstraction inputs])
   (-> (Application Analysis) Analysis)
-  (list/fold (function (_ arg func) (#Apply arg func)) func args))
+  (list/fold (function (_ input abstraction')
+               (#Apply input abstraction'))
+             abstraction
+             inputs))
 
 (def: #export (application analysis)
   (-> Analysis (Application Analysis))
-  (case analysis
-    (#Apply head func)
-    (let [[func' tail] (application func)]
-      [func' (#.Cons head tail)])
-
-    _
-    [analysis (list)]))
+  (loop [abstraction analysis
+         inputs (list)]
+    (case abstraction
+      (#Apply input next)
+      (recur next (#.Cons input inputs))
+
+      _
+      [abstraction inputs])))
 
 (do-template [<name> <tag>]
   [(template: #export (<name> content)
diff --git a/stdlib/source/lux/compiler/default/phase/synthesis.lux b/stdlib/source/lux/compiler/default/phase/synthesis.lux
index bf60c9798..da5cad094 100644
--- a/stdlib/source/lux/compiler/default/phase/synthesis.lux
+++ b/stdlib/source/lux/compiler/default/phase/synthesis.lux
@@ -1,15 +1,18 @@
 (.module:
   [lux (#- i64 Scope)
-   [control [monad (#+ do)]]
+   [control
+    [monad (#+ do)]
+    [equivalence (#+ Equivalence)]
+    ["ex" exception (#+ exception:)]]
    [data
-    [error (#+ Error)]
-    ["." text
+    [bit ("bit/." Equivalence<Bit>)]
+    ["." text ("text/." Equivalence<Text>)
      format]
     [collection
      [list ("list/." Functor<List>)]
      ["." dictionary (#+ Dictionary)]]]]
   ["." //
-   ["." analysis (#+ Environment Arity Analysis)]
+   ["." analysis (#+ Environment Arity Composite Analysis)]
    ["." extension (#+ Extension)]
    [//
     ["." reference (#+ Register Variable Reference)]]])
@@ -17,10 +20,7 @@
 (type: #export Resolver (Dictionary Variable Variable))
 
 (type: #export State
-  {#scope-arity Arity
-   #resolver Resolver
-   #direct? Bit
-   #locals Nat})
+  {#locals Nat})
 
 (def: #export fresh-resolver
   Resolver
@@ -28,10 +28,7 @@
 
 (def: #export init
   State
-  {#scope-arity 0
-   #resolver fresh-resolver
-   #direct? #0
-   #locals 0})
+  {#locals 0})
 
 (type: #export Primitive
   (#Bit Bit)
@@ -39,10 +36,6 @@
   (#F64 Frac)
   (#Text Text))
 
-(type: #export (Structure a)
-  (#Variant (analysis.Variant a))
-  (#Tuple (analysis.Tuple a)))
-
 (type: #export Side
   (Either Nat Nat))
 
@@ -96,7 +89,7 @@
 
 (type: #export #rec Synthesis
   (#Primitive Primitive)
-  (#Structure (Structure Synthesis))
+  (#Structure (Composite Synthesis))
   (#Reference Reference)
   (#Control (Control Synthesis))
   (#Extension (Extension Synthesis)))
@@ -157,9 +150,15 @@
      (<tag> content))]
 
   [path/bind #..Bind]
+  [path/then #..Then]
+  )
+
+(do-template [<name> <tag>]
+  [(template: #export (<name> left right)
+     (<tag> [left right]))]
+
   [path/alt  #..Alt]
   [path/seq  #..Seq]
-  [path/then #..Then]
   )
 
 (type: #export Abstraction
@@ -170,41 +169,24 @@
 
 (def: #export unit Text "")
 
-(do-template [<name> <value>]
-  [(def: #export <name>
-     (All [a] (-> (Operation a) (Operation a)))
-     (extension.temporary (set@ #direct? <value>)))]
-
-  [indirectly #0]
-  [directly   #1]
-  )
-
 (do-template [<name> <type> <tag>]
   [(def: #export (<name> value)
      (-> <type> (All [a] (-> (Operation a) (Operation a))))
      (extension.temporary (set@ <tag> value)))]
 
-  [with-scope-arity Arity    #scope-arity]
-  [with-resolver    Resolver #resolver]
   [with-locals      Nat      #locals]
   )
 
 (def: #export (with-abstraction arity resolver)
   (-> Arity Resolver
       (All [a] (-> (Operation a) (Operation a))))
-  (extension.with-state {#scope-arity arity
-                         #resolver resolver
-                         #direct? #1
-                         #locals arity}))
+  (extension.with-state {#locals arity}))
 
 (do-template [<name> <tag> <type>]
   [(def: #export <name>
      (Operation <type>)
      (extension.read (get@ <tag>)))]
 
-  [scope-arity #scope-arity Arity]
-  [resolver    #resolver    Resolver]
-  [direct?     #direct?     Bit]
   [locals      #locals      Nat]
   )
 
@@ -230,8 +212,8 @@
          <tag>
          content))]
 
-  [variant #..Variant]
-  [tuple   #..Tuple]
+  [variant #analysis.Variant]
+  [tuple   #analysis.Tuple]
   )
 
 (do-template [<name> <tag>]
@@ -272,6 +254,59 @@
   [function/apply       #..Function #..Apply]
   )
 
+(def: #export (%path' %then value)
+  (All [a] (-> (Format a) (Format (Path' a))))
+  (case value
+    #Pop
+    "_"
+    
+    (#Test primitive)
+    (format "(? "
+            (case primitive
+              (#Bit value)
+              (%b value)
+              
+              (#I64 value)
+              (%i (.int value))
+              
+              (#F64 value)
+              (%f value)
+              
+              (#Text value)
+              (%t value))
+            ")")
+    
+    (#Access access)
+    (case access
+      (#Side side)
+      (case side
+        (#.Left lefts)
+        (format "(" (%n lefts) " #0" ")")
+        
+        (#.Right lefts)
+        (format "(" (%n lefts) " #1" ")"))
+      
+      (#Member member)
+      (case member
+        (#.Left lefts)
+        (format "[" (%n lefts) " #0" "]")
+        
+        (#.Right lefts)
+        (format "[" (%n lefts) " #1" "]")))
+    
+    (#Bind register)
+    (format "(@ " (%n register) ")")
+    
+    (#Alt left right)
+    (format "(| " (%path' %then left) " " (%path' %then right) ")")
+    
+    (#Seq left right)
+    (format "(& " (%path' %then left) " " (%path' %then right) ")")
+    
+    (#Then then)
+    (|> (%then then)
+        (text.enclose ["(! " ")"]))))
+
 (def: #export (%synthesis value)
   (Format Synthesis)
   (case value
@@ -283,7 +318,7 @@
      [..text %t])
     
     (^ (..i64 value))
-    (%n (.nat value))
+    (%i (.int value))
 
     (^ (..variant [lefts right? content]))
     (|> (%synthesis content)
@@ -295,6 +330,121 @@
         (list/map %synthesis)
         (text.join-with " ")
         (text.enclose ["[" "]"]))
-    
-    _
-    "???"))
+
+    (#Reference reference)
+    (reference.%reference reference)
+
+    (#Control control)
+    (case control
+      (#Function function)
+      (case function
+        (#Abstraction [environment arity body])
+        (|> (%synthesis body)
+            (format (%n arity) " ")
+            (format (|> environment
+                        (list/map reference.%variable)
+                        (text.join-with " ")
+                        (text.enclose ["[" "]"]))
+                    " ")
+            (text.enclose ["(" ")"]))
+        
+        (#Apply func args)
+        (|> (list/map %synthesis args)
+            (text.join-with " ")
+            (format (%synthesis func) " ")
+            (text.enclose ["(" ")"])))
+
+      ## (%path' %synthesis ...)
+      ## (#Branch branch)
+      ## (#Loop loop)
+      _
+      "???")
+
+    (#Extension [name args])
+    (|> (list/map %synthesis args)
+        (text.join-with " ")
+        (format (%t name))
+        (text.enclose ["(" ")"]))))
+
+(def: #export %path
+  (Format Path)
+  (%path' %synthesis))
+
+(structure: #export _ (Equivalence Primitive)
+  (def: (= reference sample)
+    (case [reference sample]
+      (^template [<tag> <eq> <format>]
+        [(<tag> reference') (<tag> sample')]
+        (<eq> reference' sample'))
+      ([#Bit  bit/=  %b]
+       [#F64  f/=    %f]
+       [#Text text/= %t])
+
+      [(#I64 reference') (#I64 sample')]
+      (i/= (.int reference') (.int sample'))
+
+      _
+      false)))
+
+(structure: #export _ (Equivalence Access)
+  (def: (= reference sample)
+    (case [reference sample]
+      (^template [<tag>]
+        [(<tag> reference') (<tag> sample')]
+        (case [reference' sample']
+          (^template [<side>]
+            [(<side> reference'') (<side> sample'')]
+            (n/= reference'' sample''))
+          ([#.Left]
+           [#.Right])
+          
+          _
+          false))
+      ([#Side]
+       [#Member])
+
+      _
+      false)))
+
+(structure: #export (Equivalence<Path'> Equivalence<a>)
+  (All [a] (-> (Equivalence a) (Equivalence (Path' a))))
+
+  (def: (= reference sample)
+    (case [reference sample]
+      [#Pop #Pop]
+      true
+
+      (^template [<tag> <equivalence>]
+        [(<tag> reference') (<tag> sample')]
+        (:: <equivalence> = reference' sample'))
+      ([#Test   Equivalence<Primitive>]
+       [#Access Equivalence<Access>]
+       [#Then   Equivalence<a>])
+      
+      [(#Bind reference') (#Bind sample')]
+      (n/= reference' sample')
+
+      (^template [<tag>]
+        [(<tag> leftR rightR) (<tag> leftS rightS)]
+        (and (= leftR leftS)
+             (= rightR rightS)))
+      ([#Alt]
+       [#Seq])
+
+      _
+      false)))
+
+(structure: #export _ (Equivalence Synthesis)
+  (def: (= reference sample)
+    (case [reference sample]
+      (^template [<tag> <equivalence>]
+        [(<tag> reference') (<tag> sample')]
+        (:: <equivalence> = reference' sample'))
+      ([#Primitive Equivalence<Primitive>])
+
+      _
+      false)))
+
+(def: #export Equivalence<Path>
+  (Equivalence Path)
+  (Equivalence<Path'> Equivalence<Synthesis>))
diff --git a/stdlib/source/lux/compiler/default/phase/synthesis/case.lux b/stdlib/source/lux/compiler/default/phase/synthesis/case.lux
index c9de46ac9..e9e941a30 100644
--- a/stdlib/source/lux/compiler/default/phase/synthesis/case.lux
+++ b/stdlib/source/lux/compiler/default/phase/synthesis/case.lux
@@ -43,11 +43,7 @@
        [#analysis.Text #//.Text]))
     
     (#analysis.Bind register)
-    (<| (do ///.Monad<Operation>
-          [arity //.scope-arity])
-        (:: @ map (|>> (#//.Seq (#//.Bind (if (function.nested? arity)
-                                            (n/+ (dec arity) register)
-                                            register)))))
+    (<| (:: ///.Monad<Operation> map (|>> (#//.Seq (#//.Bind register))))
         //.with-new-local
         thenC)
 
@@ -140,14 +136,9 @@
 
                                _
                                (do @
-                                 [arity //.scope-arity
-                                  headB/bodyS (//.with-new-local
+                                 [headB/bodyS (//.with-new-local
                                                 (synthesize^ headB/bodyA))]
-                                 (wrap (//.branch/let [inputS
-                                                       (if (function.nested? arity)
-                                                         (n/+ (dec arity) inputR)
-                                                         inputR)
-                                                       headB/bodyS])))))
+                                 (wrap (//.branch/let [inputS inputR headB/bodyS])))))
 
                       <if>
                       (as-is (^or (^ [[(analysis.pattern/bit #1) thenA]
diff --git a/stdlib/source/lux/compiler/default/phase/synthesis/expression.lux b/stdlib/source/lux/compiler/default/phase/synthesis/expression.lux
index 4a5f2979c..6cdd9b6fc 100644
--- a/stdlib/source/lux/compiler/default/phase/synthesis/expression.lux
+++ b/stdlib/source/lux/compiler/default/phase/synthesis/expression.lux
@@ -6,7 +6,7 @@
     ["." maybe]
     [collection
      ["." list ("list/." Functor<List>)]
-     ["dict" dictionary (#+ Dictionary)]]]]
+     ["." dictionary (#+ Dictionary)]]]]
   ["." // (#+ Synthesis Phase)
    ["." function]
    ["." case]
@@ -36,62 +36,39 @@
      [#analysis.Int #//.I64]
      [#analysis.Rev #//.I64])))
 
-(def: #export (synthesize analysis)
+(def: #export (phase analysis)
   Phase
   (case analysis
     (#analysis.Primitive analysis')
     (operation/wrap (#//.Primitive (..primitive analysis')))
 
-    (#analysis.Structure composite)
-    (case (analysis.variant analysis)
-      (#.Some variant)
+    (#analysis.Structure structure)
+    (case structure
+      (#analysis.Variant variant)
       (do ///.Monad<Operation>
-        [valueS (synthesize (get@ #analysis.value variant))]
-        (wrap (#//.Structure (#//.Variant (set@ #analysis.value valueS variant)))))
-
-      _
-      (do ///.Monad<Operation>
-        [tupleS (monad.map @ synthesize (analysis.tuple analysis))]
-        (wrap (#//.Structure (#//.Tuple tupleS)))))
+        [valueS (phase (get@ #analysis.value variant))]
+        (wrap (//.variant (set@ #analysis.value valueS variant))))
 
+      (#analysis.Tuple tuple)
+      (|> tuple
+          (monad.map ///.Monad<Operation> phase)
+          (:: ///.Monad<Operation> map (|>> //.tuple))))
+    
     (#analysis.Reference reference)
-    (case reference
-      (#reference.Constant constant)
-      (operation/wrap (#//.Reference reference))
-
-      (#reference.Variable var)
-      (do ///.Monad<Operation>
-        [resolver //.resolver]
-        (case var
-          (#reference.Local register)
-          (do @
-            [arity //.scope-arity]
-            (wrap (if (function.nested? arity)
-                    (if (n/= 0 register)
-                      (|> (dec arity)
-                          (list.n/range 1)
-                          (list/map (|>> //.variable/local))
-                          [(//.variable/local 0)]
-                          //.function/apply)
-                      (#//.Reference (#reference.Variable (function.adjust arity #0 var))))
-                    (#//.Reference (#reference.Variable var)))))
-          
-          (#reference.Foreign register)
-          (wrap (|> resolver (dict.get var) (maybe.default var) #reference.Variable #//.Reference)))))
+    (operation/wrap (#//.Reference reference))
 
     (#analysis.Case inputA branchesAB+)
-    (case.synthesize (|>> synthesize //.indirectly) inputA branchesAB+)
+    (case.synthesize phase inputA branchesAB+)
 
     (^ (analysis.no-op value))
-    (synthesize value)
+    (phase value)
 
     (#analysis.Apply _)
-    (function.apply (|>> synthesize //.indirectly) analysis)
+    (function.apply phase analysis)
 
     (#analysis.Function environmentA bodyA)
-    (function.function synthesize environmentA bodyA)
+    (function.abstraction phase environmentA bodyA)
 
     (#analysis.Extension name args)
-    (extension.apply (|>> synthesize //.indirectly)
-                     [name args])
+    (extension.apply phase [name args])
     ))
diff --git a/stdlib/source/lux/compiler/default/phase/synthesis/function.lux b/stdlib/source/lux/compiler/default/phase/synthesis/function.lux
index 3c89ae063..196d959ed 100644
--- a/stdlib/source/lux/compiler/default/phase/synthesis/function.lux
+++ b/stdlib/source/lux/compiler/default/phase/synthesis/function.lux
@@ -1,120 +1,211 @@
 (.module:
-  [lux (#- function)
+  [lux #*
    [control
-    ["." monad (#+ do)]]
+    ["." monad (#+ do)]
+    ["ex" exception (#+ exception:)]]
    [data
     ["." maybe]
+    ["." text
+     format]
     [collection
      ["." list ("list/." Functor<List> Monoid<List> Fold<List>)]
      ["dict" dictionary (#+ Dictionary)]]]]
-  ["." // (#+ Synthesis Operation Phase)
+  ["." // (#+ Path Synthesis Operation Phase)
    ["." loop (#+ Transform)]
-   ["/." //
+   ["/." // ("operation/." Monad<Operation>)
     ["." analysis (#+ Environment Arity Analysis)]
     [//
-     ["." reference (#+ Variable)]]]])
+     ["." reference (#+ Register Variable)]]]])
 
-(def: #export nested?
-  (-> Arity Bit)
-  (n/> 1))
+(exception: #export (cannot-find-foreign-variable-in-environment {foreign Register} {environment Environment})
+  (ex.report ["Foreign" (%n foreign)]
+             ["Environment" (|> environment
+                                (list/map reference.%variable)
+                                (text.join-with " "))]))
 
-(def: #export (adjust up-arity after? var)
-  (-> Arity Bit Variable Variable)
-  (case var
-    (#reference.Local register)
-    (if (and after? (n/>= up-arity register))
-      (#reference.Local (n/+ (dec up-arity) register))
-      var)
+(def: arity-arguments
+  (-> Arity (List Synthesis))
+  (|>> dec
+       (list.n/range 1)
+       (list/map (|>> //.variable/local))))
 
-    _
-    var))
-
-(def: (unfold apply)
-  (-> Analysis [Analysis (List Analysis)])
-  (loop [apply apply
-         args (list)]
-    (case apply
-      (#analysis.Apply arg func)
-      (recur func (#.Cons arg args))
+(template: #export (self-reference)
+  (//.variable/local 0))
 
-      _
-      [apply args])))
+(def: (expanded-nested-self-reference arity)
+  (-> Arity Synthesis)
+  (//.function/apply [(..self-reference) (arity-arguments arity)]))
 
-(def: #export (apply synthesize)
+(def: #export (apply phase)
   (-> Phase Phase)
-  (.function (_ exprA)
-    (let [[funcA argsA] (unfold exprA)]
+  (function (_ exprA)
+    (let [[funcA argsA] (analysis.application exprA)]
       (do ///.Monad<Operation>
-        [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]))))
+        [funcS (phase funcA)
+         argsS (monad.map @ phase argsA)
+         ## locals //.locals
+         ]
+        (with-expansions [<apply> (as-is (//.function/apply [funcS argsS]))]
+          (case funcS
+            ## (^ (//.function/abstraction functionS))
+            ## (wrap (|> functionS
+            ##           (loop.loop (get@ #//.environment functionS) locals argsS)
+            ##           (maybe.default <apply>)))
+
+            (^ (//.function/apply [funcS' argsS']))
+            (wrap (//.function/apply [funcS' (list/compose argsS' argsS)]))
 
-          (^ (//.function/apply [funcS' argsS']))
-          (wrap (//.function/apply [funcS' (list/compose argsS' argsS)]))
+            _
+            (wrap <apply>)))))))
 
+(def: (find-foreign environment register)
+  (-> Environment Register (Operation Variable))
+  (case (list.nth register environment)
+    (#.Some aliased)
+    (operation/wrap aliased)
+
+    #.None
+    (///.throw cannot-find-foreign-variable-in-environment [register environment])))
+
+(def: (grow-path grow path)
+  (-> (-> Synthesis (Operation Synthesis)) Path (Operation Path))
+  (case path
+    (#//.Bind register)
+    (operation/wrap (#//.Bind (inc register)))
+
+    (^template [<tag>]
+      (<tag> left right)
+      (do ///.Monad<Operation>
+        [left' (grow-path grow left)
+         right' (grow-path grow right)]
+        (wrap (<tag> left' right'))))
+    ([#//.Alt] [#//.Alt])
+    
+    (#//.Then thenS)
+    (|> thenS
+        grow
+        (operation/map (|>> #//.Then)))
+
+    _
+    (operation/wrap path)))
+
+(def: (grow-sub-environment super sub)
+  (-> Environment Environment (Operation Environment))
+  (monad.map ///.Monad<Operation>
+             (function (_ variable)
+               (case variable
+                 (#reference.Local register)
+                 (operation/wrap variable)
+                 
+                 (#reference.Foreign register)
+                 (find-foreign super register)))
+             sub))
+
+(def: (grow environment expression)
+  (-> Environment Synthesis (Operation Synthesis))
+  (case expression
+    (#//.Structure structure)
+    (case structure
+      (#analysis.Variant [lefts right? subS])
+      (|> subS
+          (grow environment)
+          (operation/map (|>> [lefts right?] //.variant)))
+      
+      (#analysis.Tuple membersS+)
+      (|> membersS+
+          (monad.map ///.Monad<Operation> (grow environment))
+          (operation/map (|>> //.tuple))))
+
+    (^ (..self-reference))
+    (operation/wrap (//.function/apply [expression (list (//.variable/local 1))]))
+    
+    (#//.Reference reference)
+    (case reference
+      (#reference.Variable variable)
+      (case variable
+        (#reference.Local register)
+        (operation/wrap (//.variable/local (inc register)))
+        
+        (#reference.Foreign register)
+        (|> register
+            (find-foreign environment)
+            (operation/map (|>> //.variable))))
+      
+      (#reference.Constant constant)
+      (operation/wrap expression))
+    
+    (#//.Control control)
+    (case control
+      (#//.Branch branch)
+      (case branch
+        (#//.Let [inputS register bodyS])
+        (do ///.Monad<Operation>
+          [inputS' (grow environment inputS)
+           bodyS' (grow environment bodyS)]
+          (wrap (//.branch/let [inputS' (inc register) bodyS'])))
+        
+        (#//.If [testS thenS elseS])
+        (do ///.Monad<Operation>
+          [testS' (grow environment testS)
+           thenS' (grow environment thenS)
+           elseS' (grow environment elseS)]
+          (wrap (//.branch/if [testS' thenS' elseS'])))
+        
+        (#//.Case [inputS pathS])
+        (do ///.Monad<Operation>
+          [inputS' (grow environment inputS)
+           pathS' (grow-path (grow environment) pathS)]
+          (wrap (//.branch/case [inputS' pathS']))))
+      
+      (#//.Loop loop)
+      (case loop
+        (#//.Scope [start initsS+ iterationS])
+        (do ///.Monad<Operation>
+          [initsS+' (monad.map @ (grow environment) initsS+)
+           iterationS' (grow environment iterationS)]
+          (wrap (//.loop/scope [start initsS+' iterationS'])))
+        
+        (#//.Recur argumentsS+)
+        (|> argumentsS+
+            (monad.map ///.Monad<Operation> (grow environment))
+            (operation/map (|>> //.loop/recur))))
+      
+      (#//.Function function)
+      (case function
+        (#//.Abstraction [_env _arity _body])
+        (do ///.Monad<Operation>
+          [_env' (grow-sub-environment environment _env)]
+          (wrap (//.function/abstraction [_env' _arity _body])))
+        
+        (#//.Apply funcS argsS+)
+        (case funcS
+          (^ (//.function/apply [(..self-reference) pre-argsS+]))
+          (operation/wrap (//.function/apply [(..self-reference)
+                                              (list/compose pre-argsS+ argsS+)]))
+          
           _
-          (wrap (//.function/apply [funcS argsS])))))))
+          (do ///.Monad<Operation>
+            [funcS' (grow environment funcS)
+             argsS+' (monad.map @ (grow environment) argsS+)]
+            (wrap (//.function/apply [funcS' argsS+']))))))
+    
+    (#//.Extension name argumentsS+)
+    (|> argumentsS+
+        (monad.map ///.Monad<Operation> (grow environment))
+        (operation/map (|>> (#//.Extension name))))
 
-(def: (prepare up down body)
-  (-> Arity Arity Synthesis Synthesis)
-  (if (nested? up)
-    body
-    (maybe.default body (loop.recursion down body))))
+    _
+    (operation/wrap expression)))
 
-(def: #export (function synthesize environment body)
+(def: #export (abstraction phase environment bodyA)
   (-> Phase Environment Analysis (Operation Synthesis))
   (do ///.Monad<Operation>
-    [direct? //.direct?
-     arity //.scope-arity
-     resolver //.resolver
-     #let [function-arity (if direct?
-                            (inc arity)
-                            1)
-           up-environment (if (nested? arity)
-                            (list/map (.function (_ closure)
-                                        (case (dict.get closure resolver)
-                                          (#.Some resolved)
-                                          (adjust arity #1 resolved)
-
-                                          #.None
-                                          (adjust arity #0 closure)))
-                                      environment)
-                            environment)
-           down-environment (: (List Variable)
-                               (case environment
-                                 #.Nil
-                                 (list)
-                                 
-                                 _
-                                 (|> environment
-                                     list.size
-                                     list.indices
-                                     (list/map (|>> #reference.Foreign)))))
-           resolver' (if (and (nested? function-arity)
-                              direct?)
-                       (list/fold (.function (_ [from to] resolver')
-                                    (dict.put from to resolver'))
-                                  //.fresh-resolver
-                                  (list.zip2 down-environment up-environment))
-                       (list/fold (.function (_ var resolver')
-                                    (dict.put var var resolver'))
-                                  //.fresh-resolver
-                                  down-environment))]
-     bodyS (//.with-abstraction function-arity resolver'
-             (synthesize body))]
+    [bodyS (phase bodyA)]
     (case bodyS
       (^ (//.function/abstraction [env' down-arity' bodyS']))
-      (let [arity' (inc down-arity')]
-        (|> (prepare function-arity arity' bodyS')
-            [up-environment arity'] //.function/abstraction
-            wrap))
-
+      (|> bodyS'
+          (grow env')
+          (:: @ map (|>> [environment (inc down-arity')] //.function/abstraction)))
+      
       _
-      (|> (prepare function-arity 1 bodyS)
-          [up-environment 1] //.function/abstraction
-          wrap))))
+      (wrap (//.function/abstraction [environment 1 bodyS])))))
diff --git a/stdlib/source/lux/compiler/default/phase/translation/scheme/case.jvm.lux b/stdlib/source/lux/compiler/default/phase/translation/scheme/case.jvm.lux
index 1d9415a99..4a963d507 100644
--- a/stdlib/source/lux/compiler/default/phase/translation/scheme/case.jvm.lux
+++ b/stdlib/source/lux/compiler/default/phase/translation/scheme/case.jvm.lux
@@ -142,7 +142,7 @@
      [synthesis.member/right runtime.product//right inc])
 
     (^template [<tag> <computation>]
-      (^ (<tag> [leftP rightP]))
+      (^ (<tag> leftP rightP))
       (do ////.Monad<Operation>
         [leftO (pattern-matching' translate leftP)
          rightO (pattern-matching' translate rightP)]
diff --git a/stdlib/test/test/lux/compiler/default/phase/synthesis/case.lux b/stdlib/test/test/lux/compiler/default/phase/synthesis/case.lux
index f3c3b9d2e..2084ee46b 100644
--- a/stdlib/test/test/lux/compiler/default/phase/synthesis/case.lux
+++ b/stdlib/test/test/lux/compiler/default/phase/synthesis/case.lux
@@ -31,7 +31,7 @@
                         (list)]])]]
         (test "Dummy variables created to mask expressions get eliminated during synthesis."
               (|> maskA
-                  expression.synthesize
+                  expression.phase
                   (phase.run [bundle.empty //.init])
                   (error/map (//primitive.corresponds? maskedA))
                   (error.default #0))))))
@@ -49,7 +49,7 @@
                        (list)]])]]
         (test "Can detect and reify simple 'let' expressions."
               (|> letA
-                  expression.synthesize
+                  expression.phase
                   (phase.run [bundle.empty //.init])
                   (case> (^ (#error.Success (//.branch/let [inputS registerS outputS])))
                          (and (n/= registerA registerS)
@@ -77,7 +77,7 @@
                      (analysis.control/case [inputA [elseB (list thenB)]]))]]
         (test "Can detect and reify simple 'if' expressions."
               (|> ifA
-                  expression.synthesize
+                  expression.phase
                   (phase.run [bundle.empty //.init])
                   (case> (^ (#error.Success (//.branch/if [inputS thenS elseS])))
                          (and (//primitive.corresponds? inputA inputS)
diff --git a/stdlib/test/test/lux/compiler/default/phase/synthesis/function.lux b/stdlib/test/test/lux/compiler/default/phase/synthesis/function.lux
index fae0e0fdf..133048936 100644
--- a/stdlib/test/test/lux/compiler/default/phase/synthesis/function.lux
+++ b/stdlib/test/test/lux/compiler/default/phase/synthesis/function.lux
@@ -105,9 +105,8 @@
                (#analysis.Reference (reference.local chosen))
                (|> chosen (n/+ (dec arity)) #reference.Local)])))))
 
-(context: "Function definition."
-  (<| (seed 13007429814532219492)
-      ## (times 100)
+(context: "Abstraction."
+  (<| (times 100)
       (do @
         [[arity//constant function//constant prediction//constant] constant-function
          [arity//environment function//environment prediction//environment] function-with-environment
@@ -115,7 +114,7 @@
         ($_ seq
             (test "Nested functions will get folded together."
                   (|> function//constant
-                      expression.synthesize
+                      expression.phase
                       (phase.run [bundle.empty //.init])
                       (case> (^ (#error.Success (//.function/abstraction [environment arity output])))
                              (and (n/= arity//constant arity)
@@ -125,7 +124,7 @@
                              (n/= 0 arity//constant))))
             (test "Folded functions provide direct access to environment variables."
                   (|> function//environment
-                      expression.synthesize
+                      expression.phase
                       (phase.run [bundle.empty //.init])
                       (case> (^ (#error.Success (//.function/abstraction [environment arity (#//.Reference (reference.variable output))])))
                              (and (n/= arity//environment arity)
@@ -135,7 +134,7 @@
                              #0)))
             (test "Folded functions properly offset local variables."
                   (|> function//local
-                      expression.synthesize
+                      expression.phase
                       (phase.run [bundle.empty //.init])
                       (case> (^ (#error.Success (//.function/abstraction [environment arity (#//.Reference (reference.variable output))])))
                              (and (n/= arity//local arity)
@@ -145,7 +144,7 @@
                              #0)))
             ))))
 
-(context: "Function application."
+(context: "Application."
   (<| (times 100)
       (do @
         [arity (|> r.nat (:: @ map (|>> (n/% 10) (n/max 1))))
@@ -154,7 +153,7 @@
         ($_ seq
             (test "Can synthesize function application."
                   (|> (analysis.apply [funcA argsA])
-                      expression.synthesize
+                      expression.phase
                       (phase.run [bundle.empty //.init])
                       (case> (^ (#error.Success (//.function/apply [funcS argsS])))
                              (and (//primitive.corresponds? funcA funcS)
@@ -165,7 +164,7 @@
                              #0)))
             (test "Function application on no arguments just synthesizes to the function itself."
                   (|> (analysis.apply [funcA (list)])
-                      expression.synthesize
+                      expression.phase
                       (phase.run [bundle.empty //.init])
                       (case> (#error.Success funcS)
                              (//primitive.corresponds? funcA funcS)
diff --git a/stdlib/test/test/lux/compiler/default/phase/synthesis/primitive.lux b/stdlib/test/test/lux/compiler/default/phase/synthesis/primitive.lux
index fbe190a93..0a55fbcf6 100644
--- a/stdlib/test/test/lux/compiler/default/phase/synthesis/primitive.lux
+++ b/stdlib/test/test/lux/compiler/default/phase/synthesis/primitive.lux
@@ -80,7 +80,7 @@
                 (~~ (do-template [<desc> <analysis> <synthesis> <sample>]
                       [(test (format "Can synthesize " <desc> ".")
                              (|> (#analysis.Primitive (<analysis> <sample>))
-                                 expression.synthesize
+                                 expression.phase
                                  (phase.run [bundle.empty //.init])
                                  (case> (#error.Success (#//.Primitive (<synthesis> value)))
                                         (is? <sample> value)
diff --git a/stdlib/test/test/lux/compiler/default/phase/synthesis/structure.lux b/stdlib/test/test/lux/compiler/default/phase/synthesis/structure.lux
index 90fd155b0..a78aa1a09 100644
--- a/stdlib/test/test/lux/compiler/default/phase/synthesis/structure.lux
+++ b/stdlib/test/test/lux/compiler/default/phase/synthesis/structure.lux
@@ -31,7 +31,7 @@
         ($_ seq
             (test "Can synthesize variants."
                   (|> (analysis.sum-analysis size tagA memberA)
-                      expression.synthesize
+                      expression.phase
                       (phase.run [bundle.empty //.init])
                       (case> (#error.Success (#//.Structure (#//.Variant [leftsS right?S valueS])))
                              (let [tagS (if right?S (inc leftsS) leftsS)]
@@ -51,7 +51,7 @@
         ($_ seq
             (test "Can synthesize tuple."
                   (|> (analysis.product-analysis membersA)
-                      expression.synthesize
+                      expression.phase
                       (phase.run [bundle.empty //.init])
                       (case> (#error.Success (#//.Structure (#//.Tuple membersS)))
                              (and (n/= size (list.size membersS))
-- 
cgit v1.2.3