Properly implemented and enabled loop optimization.

11 files changed, 971 insertions, 326 deletions

diff --git a/stdlib/source/lux/control/io.lux b/stdlib/source/lux/control/io.lux
index 533e321b9..ed28b338e 100644
--- a/stdlib/source/lux/control/io.lux
+++ b/stdlib/source/lux/control/io.lux
@@ -17,9 +17,9 @@
   {#.doc "A type that represents synchronous, effectful computations that may interact with the outside world."}
   (-> Any a)
 
-  (def: (label thunk)
+  (def: label
     (All [a] (-> (-> Any a) (IO a)))
-    (:abstraction thunk))
+    (|>> :abstraction))
 
   (template: (!io computation)
     (:abstraction (template.with-locals [g!func g!arg]
@@ -49,17 +49,23 @@
     (All [a] (-> (IO a) a))
     (|>> !run))
 
-  (structure: #export functor (Functor IO)
+  (structure: #export functor
+    (Functor IO)
+    
     (def: (map f)
       (|>> !run f !io)))
 
-  (structure: #export apply (Apply IO)
+  (structure: #export apply
+    (Apply IO)
+    
     (def: &functor ..functor)
 
     (def: (apply ff fa)
       (!io ((!run ff) (!run fa)))))
 
-  (structure: #export monad (Monad IO)
+  (structure: #export monad
+    (Monad IO)
+    
     (def: &functor ..functor)
 
     (def: wrap (|>> !io))
diff --git a/stdlib/source/lux/control/parser/binary.lux b/stdlib/source/lux/control/parser/binary.lux
index 3dc061940..ed698ccd1 100644
--- a/stdlib/source/lux/control/parser/binary.lux
+++ b/stdlib/source/lux/control/parser/binary.lux
@@ -50,6 +50,11 @@
   (function (_ (^@ input [offset data]))
     (#try.Success [input (n.= offset (/.size data))])))
 
+(def: #export offset
+  (Parser Offset)
+  (function (_ (^@ input [offset data]))
+    (#try.Success [input offset])))
+
 (def: #export remaining
   (Parser Nat)
   (function (_ (^@ input [offset data]))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/lux/tool/compiler/language/lux/analysis.lux
index c9bc95612..71009473a 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/analysis.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/analysis.lux
@@ -103,7 +103,7 @@
       _
       false)))
 
-(structure: (composite-equivalence (^open "/@."))
+(structure: #export (composite-equivalence (^open "/@."))
   (All [a] (-> (Equivalence a) (Equivalence (Composite a))))
   
   (def: (= reference sample)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux
index e34c78f71..890722aeb 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux
@@ -3,7 +3,8 @@
    [abstract
     ["." monad (#+ do)]]
    [control
-    ["ex" exception (#+ exception:)]]
+    [pipe (#+ case>)]
+    ["." exception (#+ exception:)]]
    [data
     ["." maybe]
     ["." text
@@ -22,10 +23,11 @@
      ["." phase ("#@." monad)]]]])
 
 (exception: #export (cannot-find-foreign-variable-in-environment {foreign Register} {environment Environment})
-  (ex.report ["Foreign" (%.nat foreign)]
-             ["Environment" (|> environment
-                                (list@map ////reference/variable.format)
-                                (text.join-with " "))]))
+  (exception.report
+   ["Foreign" (%.nat foreign)]
+   ["Environment" (|> environment
+                      (list@map ////reference/variable.format)
+                      (text.join-with " "))]))
 
 (def: arity-arguments
   (-> Arity (List Synthesis))
@@ -46,15 +48,15 @@
     (let [[funcA argsA] (////analysis.application exprA)]
       (do {@ phase.monad}
         [funcS (phase archive funcA)
-         argsS (monad.map @ (phase archive) argsA)
-         ## locals /.locals
-         ]
+         argsS (monad.map @ (phase archive) argsA)]
         (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/abstraction functionS))
+            (do @
+              [locals /.locals]
+              (wrap (|> functionS
+                        (//loop.optimization locals argsS)
+                        (maybe.default <apply>))))
 
             (^ (/.function/apply [funcS' argsS']))
             (wrap (/.function/apply [funcS' (list@compose argsS' argsS)]))
@@ -69,7 +71,7 @@
     (phase@wrap aliased)
 
     #.None
-    (phase.throw cannot-find-foreign-variable-in-environment [register environment])))
+    (phase.throw ..cannot-find-foreign-variable-in-environment [register environment])))
 
 (def: (grow-path grow path)
   (-> (-> Synthesis (Operation Synthesis)) Path (Operation Path))
@@ -172,7 +174,7 @@
         (do {@ phase.monad}
           [initsS+' (monad.map @ (grow environment) initsS+)
            iterationS' (grow environment iterationS)]
-          (wrap (/.loop/scope [start initsS+' iterationS'])))
+          (wrap (/.loop/scope [(inc start) initsS+' iterationS'])))
         
         (#/.Recur argumentsS+)
         (|> argumentsS+
@@ -209,7 +211,8 @@
 (def: #export (abstraction phase environment archive bodyA)
   (-> Phase Environment Phase)
   (do {@ phase.monad}
-    [bodyS (phase archive bodyA)]
+    [bodyS (/.with-locals 2
+             (phase archive bodyA))]
     (case bodyS
       (^ (/.function/abstraction [env' down-arity' bodyS']))
       (|> bodyS'
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux
index 5aa644e18..b4a43ce23 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux
@@ -1,303 +1,171 @@
 (.module:
-  [lux (#- loop)
+  [lux #*
    [abstract
     ["." monad (#+ do)]]
-   [control
-    ["p" parser]]
    [data
     ["." maybe ("#@." monad)]
     [number
      ["n" nat]]
     [collection
-     ["." list ("#@." functor)]]]
-   [macro
-    ["." code]
-    ["." syntax]]]
-  ["." /// #_
-   ## TODO: Remove the 'extension' import ASAP.
-   ["#." extension]
-   [//
-    ["#." analysis (#+ Environment)]
-    ["/" synthesis (#+ Path Abstraction Synthesis)]
-    [///
-     ["#." reference
-      ["#/." variable (#+ Register Variable)]]]]])
+     ["." list]]]]
+  [////
+   ["." analysis (#+ Environment)]
+   ["/" synthesis (#+ Path Abstraction Synthesis)]
+   [///
+    [arity (#+ Arity)]
+    ["." reference
+     ["." variable (#+ Register Variable)]]]])
 
 (type: #export (Transform a)
   (-> a (Maybe a)))
 
-(def: (some? maybe)
-  (All [a] (-> (Maybe a) Bit))
-  (case maybe
-    (#.Some _) #1
-    #.None     #0))
+(def: #export (register-optimization offset)
+  (-> Register (-> Register Register))
+  (|>> dec (n.+ offset)))
 
-(template: #export (self)
-  (#/.Reference (///reference.local 0)))
+(def: (variable-optimization offset environment variable)
+  (-> Register Environment (Transform Variable))
+  (case variable
+    (^ (variable.self))
+    #.None
+    
+    (#variable.Foreign register)
+    (list.nth register environment)
 
-(template: (recursive-apply args)
-  (#/.Apply (self) args))
+    (#variable.Local register)
+    (#.Some (#variable.Local (register-optimization offset register)))))
 
-(def: improper #0)
-(def: proper #1)
-
-(def: (proper? exprS)
-  (-> Synthesis Bit)
-  (case exprS
-    (^ (self))
-    ..improper
-
-    (#/.Structure structure)
-    (case structure
-      (#///analysis.Variant variantS)
-      (proper? (get@ #///analysis.value variantS))
-      
-      (#///analysis.Tuple membersS+)
-      (list.every? proper? membersS+))
-
-    (#/.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))
-
-                 (#/.Then bodyS)
-                 (proper? bodyS)
-                 
-                 _
-                 ..proper)))
-
-        (#/.Let inputS register bodyS)
-        (and (proper? inputS)
-             (proper? bodyS))
-
-        (#/.If inputS thenS elseS)
-        (and (proper? inputS)
-             (proper? thenS)
-             (proper? elseS))
-
-        (#/.Get members inputS)
-        (proper? inputS))
-
-      (#/.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? ///reference/variable.self? environment)
-
-        (#/.Apply funcS argsS)
-        (and (proper? funcS)
-             (list.every? proper? argsS))))
-
-    (#/.Extension [name 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))
-
-      (#/.Then bodyS)
-      (maybe@map (|>> #/.Then) (synthesis-recursion bodyS))
-      
-      _
-      #.None)))
-
-(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))
-
-          (#/.Get members inputS)
-          #.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
-      (#///reference/variable.Foreign register)
-      (list.nth register environment)
-
-      _
-      (#.Some variable))))
-
-(def: (adjust-path adjust-synthesis offset)
+(def: (path-optimization body-optimization offset)
   (-> (Transform Synthesis) Register (Transform Path))
-  (function (recur pathS)
-    (case pathS
+  (function (recur path)
+    (case path
       (#/.Bind register)
-      (#.Some (#/.Bind (n.+ offset register)))
+      (#.Some (#/.Bind (register-optimization offset register)))
 
       (^template [<tag>]
-        (<tag> leftS rightS)
+        (<tag> left right)
         (do maybe.monad
-          [leftS' (recur leftS)
-           rightS' (recur rightS)]
-          (wrap (<tag> leftS' rightS'))))
+          [left' (recur left)
+           right' (recur right)]
+          (wrap (<tag> left' right'))))
       ([#/.Alt] [#/.Seq])
       
-      (#/.Then bodyS)
-      (|> bodyS adjust-synthesis (maybe@map (|>> #/.Then)))
+      (#/.Then body)
+      (|> body
+          body-optimization
+          (maybe@map (|>> #/.Then)))
 
       _
-      (#.Some pathS))))
-
-(def: (adjust scope-environment offset)
-  (-> Environment Register (Transform Synthesis))
-  (function (recur exprS)
-    (case exprS
-      (#/.Structure structureS)
-      (case structureS
-        (#///analysis.Variant variantS)
+      (#.Some path))))
+
+(def: (body-optimization offset scope-environment arity expr)
+  (-> Register Environment Arity (Transform Synthesis))
+  (loop [return? true
+         expr expr]
+    (case expr
+      (#/.Primitive _)
+      (#.Some expr)
+
+      (#/.Structure structure)
+      (case structure
+        (#analysis.Variant variant)
         (do maybe.monad
-          [valueS' (|> variantS (get@ #///analysis.value) recur)]
-          (wrap (|> variantS
-                    (set@ #///analysis.value valueS')
-                    #///analysis.Variant
-                    #/.Structure)))
+          [value' (|> variant (get@ #analysis.value) (recur false))]
+          (wrap (|> variant
+                    (set@ #analysis.value value')
+                    /.variant)))
         
-        (#///analysis.Tuple membersS+)
-        (|> membersS+
-            (monad.map maybe.monad recur)
-            (maybe@map (|>> #///analysis.Tuple #/.Structure))))
+        (#analysis.Tuple tuple)
+        (|> tuple
+            (monad.map maybe.monad (recur false))
+            (maybe@map (|>> /.tuple))))
 
       (#/.Reference reference)
       (case reference
-        (^ (///reference.constant constant))
-        (#.Some exprS)
+        (^ (#reference.Variable (variable.self)))
+        #.None
+        
+        (^ (reference.constant constant))
+        (#.Some expr)
 
-        (^ (///reference.local register))
-        (#.Some (#/.Reference (///reference.local (n.+ offset register))))
+        (^ (reference.local register))
+        (#.Some (#/.Reference (reference.local (register-optimization offset register))))
 
-        (^ (///reference.foreign register))
+        (^ (reference.foreign register))
         (|> scope-environment
             (list.nth register)
-            (maybe@map (|>> #///reference.Variable #/.Reference))))
+            (maybe@map (|>> #reference.Variable #/.Reference))))
 
-      (^ (/.branch/case [inputS pathS]))
+      (^ (/.branch/case [input path]))
       (do maybe.monad
-        [inputS' (recur inputS)
-         pathS' (adjust-path recur offset pathS)]
-        (wrap (|> pathS' [inputS'] /.branch/case)))
+        [input' (recur false input)
+         path' (path-optimization (recur return?) offset path)]
+        (wrap (|> path' [input'] /.branch/case)))
 
-      (^ (/.branch/let [inputS register bodyS]))
+      (^ (/.branch/let [input register body]))
       (do maybe.monad
-        [inputS' (recur inputS)
-         bodyS' (recur bodyS)]
-        (wrap (/.branch/let [inputS' register bodyS'])))
+        [input' (recur false input)
+         body' (recur return? body)]
+        (wrap (/.branch/let [input' (register-optimization offset register) body'])))
 
-      (^ (/.branch/if [inputS thenS elseS]))
+      (^ (/.branch/if [input then else]))
       (do maybe.monad
-        [inputS' (recur inputS)
-         thenS' (recur thenS)
-         elseS' (recur elseS)]
-        (wrap (/.branch/if [inputS' thenS' elseS'])))
+        [input' (recur false input)
+         then' (recur return? then)
+         else' (recur return? else)]
+        (wrap (/.branch/if [input' then' else'])))
 
-      (^ (/.loop/scope scopeS))
+      (^ (/.branch/get [path record]))
       (do maybe.monad
-        [inits' (|> scopeS
+        [record (recur false record)]
+        (wrap (/.branch/get [path record])))
+
+      (^ (/.loop/scope scope))
+      (do {@ maybe.monad}
+        [inits' (|> scope
                     (get@ #/.inits)
-                    (monad.map maybe.monad recur))
-         iteration' (recur (get@ #/.iteration scopeS))]
-        (wrap (/.loop/scope {#/.start (|> scopeS (get@ #/.start) (n.+ offset))
+                    (monad.map @ (recur false)))
+         iteration' (recur return? (get@ #/.iteration scope))]
+        (wrap (/.loop/scope {#/.start (|> scope (get@ #/.start) (register-optimization offset))
                              #/.inits inits'
                              #/.iteration iteration'})))
 
-      (^ (/.loop/recur argsS))
-      (|> argsS
-          (monad.map maybe.monad recur)
+      (^ (/.loop/recur args))
+      (|> args
+          (monad.map maybe.monad (recur false))
           (maybe@map (|>> /.loop/recur)))
-      
 
-      (^ (/.function/abstraction [environment arity bodyS]))
-      (do maybe.monad
-        [environment' (monad.map maybe.monad
-                                 (resolve scope-environment)
+      (^ (/.function/abstraction [environment arity body]))
+      (do {@ maybe.monad}
+        [environment' (monad.map @ (variable-optimization offset scope-environment)
                                  environment)]
-        (wrap (/.function/abstraction [environment' arity bodyS])))
+        (wrap (/.function/abstraction [environment' arity body])))
       
-      (^ (/.function/apply [function arguments]))
-      (do maybe.monad
-        [function' (recur function)
-         arguments' (monad.map maybe.monad recur arguments)]
-        (wrap (/.function/apply [function' arguments'])))
-
-      (#/.Extension [name argsS])
-      (|> argsS
-          (monad.map maybe.monad recur)
-          (maybe@map (|>> [name] #/.Extension)))
-
-      _
-      (#.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)))
+      (^ (/.function/apply [abstraction arguments]))
+      (do {! maybe.monad}
+        [arguments' (monad.map maybe.monad (recur false) arguments)]
+        (case abstraction
+          (^ (#/.Reference (#reference.Variable (variable.self))))
+          (if (and return?
+                   (n.= arity (list.size arguments)))
+            (wrap (/.loop/recur arguments'))
+            #.None)
+          
+          _
+          (do !
+            [abstraction' (recur false abstraction)]
+            (wrap (/.function/apply [abstraction' arguments'])))))
+
+      (#/.Extension [name args])
+      (|> args
+          (monad.map maybe.monad (recur false))
+          (maybe@map (|>> [name] #/.Extension))))))
+
+(def: #export (optimization offset inits functionS)
+  (-> Register (List Synthesis) Abstraction (Maybe Synthesis))
+  (if (n.= (get@ #/.arity functionS)
+           (list.size inits))
+    (|> (get@ #/.body functionS)
+        (body-optimization offset (get@ #/.environment functionS) (get@ #/.arity functionS))
+        (maybe@map (|>> [offset inits] /.loop/scope)))
+    #.None))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/synthesis.lux b/stdlib/source/lux/tool/compiler/language/lux/synthesis.lux
index a88d986fc..06f84d90d 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/synthesis.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/synthesis.lux
@@ -4,8 +4,9 @@
     [monad (#+ do)]
     [equivalence (#+ Equivalence)]]
    [control
-    ["ex" exception (#+ exception:)]]
+    ["." exception (#+ exception:)]]
    [data
+    ["." sum]
     ["." bit ("#@." equivalence)]
     ["." text ("#@." equivalence)
      ["%" format (#+ Format format)]]
@@ -16,15 +17,15 @@
     [collection
      ["." list ("#@." functor)]
      ["." dictionary (#+ Dictionary)]]]]
-  ["." // #_
-   ["#." analysis (#+ Environment Composite Analysis)]
+  [//
+   ["." analysis (#+ Environment Composite Analysis)]
    [phase
     ["." extension (#+ Extension)]]
    [///
     [arity (#+ Arity)]
-    ["#." reference (#+ Reference)
-     ["#/." variable (#+ Register Variable)]]
-    ["#." phase]]])
+    ["." phase]
+    ["." reference (#+ Reference)
+     ["." variable (#+ Register Variable)]]]])
 
 (type: #export Resolver (Dictionary Variable Variable))
 
@@ -33,7 +34,7 @@
 
 (def: #export fresh-resolver
   Resolver
-  (dictionary.new //reference/variable.hash))
+  (dictionary.new variable.hash))
 
 (def: #export init
   State
@@ -202,7 +203,7 @@
 
 (def: #export with-new-local
   (All [a] (-> (Operation a) (Operation a)))
-  (<<| (do //phase.monad
+  (<<| (do phase.monad
          [locals ..locals])
        (..with-locals (inc locals))))
 
@@ -222,8 +223,8 @@
          <tag>
          content))]
 
-  [variant #//analysis.Variant]
-  [tuple   #//analysis.Tuple]
+  [variant #analysis.Variant]
+  [tuple   #analysis.Tuple]
   )
 
 (template [<name> <tag>]
@@ -232,10 +233,10 @@
           <tag>
           content))]
 
-  [variable         //reference.variable]
-  [constant         //reference.constant]
-  [variable/local   //reference.local]
-  [variable/foreign //reference.foreign]
+  [variable         reference.variable]
+  [constant         reference.constant]
+  [variable/local   reference.local]
+  [variable/foreign reference.foreign]
   )
 
 (template [<name> <family> <tag>]
@@ -327,36 +328,35 @@
 
     (#Structure structure)
     (case structure
-      (#//analysis.Variant [lefts right? content])
+      (#analysis.Variant [lefts right? content])
       (|> (%synthesis content)
           (format (%.nat lefts) " " (%.bit right?) " ")
           (text.enclose ["(" ")"]))
       
-      (#//analysis.Tuple members)
+      (#analysis.Tuple members)
       (|> members
           (list@map %synthesis)
           (text.join-with " ")
           (text.enclose ["[" "]"])))
 
     (#Reference reference)
-    (//reference.format reference)
+    (reference.format reference)
 
     (#Control control)
     (case control
       (#Function function)
       (case function
         (#Abstraction [environment arity body])
-        (|> (%synthesis body)
-            (format (%.nat arity) " ")
-            (format (|> environment
-                        (list@map //reference/variable.format)
-                        (text.join-with " ")
-                        (text.enclose ["[" "]"]))
-                    " ")
-            (text.enclose ["(" ")"]))
+        (let [environment' (|> environment
+                               (list@map variable.format)
+                               (text.join-with " ")
+                               (text.enclose ["[" "]"]))]
+          (|> (format environment' " " (%.nat arity) " " (%synthesis body))
+              (text.enclose ["(#function " ")"])))
         
         (#Apply func args)
-        (|> (list@map %synthesis args)
+        (|> args
+            (list@map %synthesis)
             (text.join-with " ")
             (format (%synthesis func) " ")
             (text.enclose ["(" ")"])))
@@ -364,7 +364,7 @@
       (#Branch branch)
       (case branch
         (#Let input register body)
-        (|> (format (%synthesis input) " " (%.nat register) " " (%synthesis body))
+        (|> (format (%.nat register) " " (%synthesis input) " " (%synthesis body))
             (text.enclose ["(#let " ")"]))
         
         (#If test then else)
@@ -381,9 +381,22 @@
         (|> (format (%synthesis input) " " (%path' %synthesis path))
             (text.enclose ["(#case " ")"])))
       
-      ## (#Loop loop)
-      _
-      "???")
+      (#Loop loop)
+      (case loop
+        (#Scope scope)
+        (|> (format (%.nat (get@ #start scope))
+                    " " (|> (get@ #inits scope)
+                            (list@map %synthesis)
+                            (text.join-with " ")
+                            (text.enclose ["[" "]"]))
+                    " " (%synthesis (get@ #iteration scope)))
+            (text.enclose ["(#loop " ")"]))
+        
+        (#Recur args)
+        (|> args
+            (list@map %synthesis)
+            (text.join-with " ")
+            (text.enclose ["(#recur " ")"]))))
 
     (#Extension [name args])
     (|> (list@map %synthesis args)
@@ -395,7 +408,9 @@
   (Format Path)
   (%path' %synthesis))
 
-(structure: #export primitive-equivalence (Equivalence Primitive)
+(structure: #export primitive-equivalence
+  (Equivalence Primitive)
+  
   (def: (= reference sample)
     (case [reference sample]
       (^template [<tag> <eq> <format>]
@@ -411,27 +426,29 @@
       _
       false)))
 
-(structure: #export access-equivalence (Equivalence Access)
+(def: side-equivalence
+  (Equivalence Side)
+  (sum.equivalence n.equivalence n.equivalence))
+
+(def: member-equivalence
+  (Equivalence Member)
+  (sum.equivalence n.equivalence n.equivalence))
+
+(structure: #export access-equivalence
+  (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])
+      (^template [<tag> <equivalence>]
+        [(<tag> reference) (<tag> sample)]
+        (:: <equivalence> = reference sample))
+      ([#Side ..side-equivalence]
+       [#Member ..member-equivalence])
 
       _
       false)))
 
-(structure: #export (path'-equivalence Equivalence<a>)
+(structure: #export (path'-equivalence equivalence)
   (All [a] (-> (Equivalence a) (Equivalence (Path' a))))
 
   (def: (= reference sample)
@@ -444,7 +461,7 @@
         (:: <equivalence> = reference' sample'))
       ([#Test   primitive-equivalence]
        [#Access access-equivalence]
-       [#Then   Equivalence<a>])
+       [#Then   equivalence])
       
       [(#Bind reference') (#Bind sample')]
       (n.= reference' sample')
@@ -459,13 +476,100 @@
       _
       false)))
 
-(structure: #export equivalence (Equivalence Synthesis)
+(structure: (branch-equivalence (^open "/@."))
+  (All [a] (-> (Equivalence a) (Equivalence (Branch a))))
+
+  (def: (= reference sample)
+    (case [reference sample]
+      [(#Let [reference-input reference-register reference-body])
+       (#Let [sample-input sample-register sample-body])]
+      (and (/@= reference-input sample-input)
+           (n.= reference-register sample-register)
+           (/@= reference-body sample-body))
+
+      [(#If [reference-test reference-then reference-else])
+       (#If [sample-test sample-then sample-else])]
+      (and (/@= reference-test sample-test)
+           (/@= reference-then sample-then)
+           (/@= reference-else sample-else))
+      
+      [(#Get [reference-path reference-record])
+       (#Get [sample-path sample-record])]
+      (and (:: (list.equivalence ..member-equivalence) = reference-path sample-path)
+           (/@= reference-record sample-record))
+      
+      [(#Case [reference-input reference-path])
+       (#Case [sample-input sample-path])]
+      (and (/@= reference-input sample-input)
+           (:: (path'-equivalence /@=) = reference-path sample-path))
+      
+      _
+      false)))
+
+(structure: (loop-equivalence (^open "/@."))
+  (All [a] (-> (Equivalence a) (Equivalence (Loop a))))
+
+  (def: (= reference sample)
+    (case [reference sample]
+      [(#Scope [reference-start reference-inits reference-iteration])
+       (#Scope [sample-start sample-inits sample-iteration])]
+      (and (n.= reference-start sample-start)
+           (:: (list.equivalence /@=) = reference-inits sample-inits)
+           (/@= reference-iteration sample-iteration))
+
+      [(#Recur reference) (#Recur sample)]
+      (:: (list.equivalence /@=) = reference sample)
+      
+      _
+      false)))
+
+(structure: (function-equivalence (^open "/@."))
+  (All [a] (-> (Equivalence a) (Equivalence (Function a))))
+
+  (def: (= reference sample)
+    (case [reference sample]
+      [(#Abstraction [reference-environment reference-arity reference-body])
+       (#Abstraction [sample-environment sample-arity sample-body])]
+      (and (:: (list.equivalence variable.equivalence) = reference-environment sample-environment)
+           (n.= reference-arity sample-arity)
+           (/@= reference-body sample-body))
+      
+      [(#Apply [reference-abstraction reference-arguments])
+       (#Apply [sample-abstraction sample-arguments])]
+      (and (/@= reference-abstraction sample-abstraction)
+           (:: (list.equivalence /@=) = reference-arguments sample-arguments))
+      
+      _
+      false)))
+
+(structure: (control-equivalence (^open "/@."))
+  (All [a] (-> (Equivalence a) (Equivalence (Control a))))
+
+  (def: (= reference sample)
+    (case [reference sample]
+      (^template [<tag> <equivalence>]
+        [(<tag> reference) (<tag> sample)]
+        (:: (<equivalence> /@=) = reference sample))
+      ([#Branch ..branch-equivalence]
+       [#Loop ..loop-equivalence]
+       [#Function ..function-equivalence])
+      
+      _
+      false)))
+
+(structure: #export equivalence
+  (Equivalence Synthesis)
+  
   (def: (= reference sample)
     (case [reference sample]
       (^template [<tag> <equivalence>]
         [(<tag> reference') (<tag> sample')]
         (:: <equivalence> = reference' sample'))
-      ([#Primitive primitive-equivalence])
+      ([#Primitive ..primitive-equivalence]
+       [#Structure (analysis.composite-equivalence =)]
+       [#Reference reference.equivalence]
+       [#Control (control-equivalence =)]
+       [#Extension (extension.equivalence =)])
 
       _
       false)))
diff --git a/stdlib/source/lux/tool/compiler/reference/variable.lux b/stdlib/source/lux/tool/compiler/reference/variable.lux
index 10c080c6e..e0c814e8d 100644
--- a/stdlib/source/lux/tool/compiler/reference/variable.lux
+++ b/stdlib/source/lux/tool/compiler/reference/variable.lux
@@ -42,9 +42,12 @@
                 (#Foreign register)
                 (|> register .int (i.* -1) .nat)))))
 
+(template: #export (self)
+  (#..Local 0))
+
 (def: #export self?
   (-> Variable Bit)
-  (|>> (case> (^ (#Local 0))
+  (|>> (case> (^ (..self))
               true
 
               _
diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux
index 7fc1c428d..29c34b430 100644
--- a/stdlib/source/test/lux/control.lux
+++ b/stdlib/source/test/lux/control.lux
@@ -21,6 +21,7 @@
    ["#." io]
    ["#." parser
     ["#/." analysis]
+    ["#/." binary]
     ["#/." text]
     ["#/." cli]]
    ["#." pipe]
@@ -59,6 +60,7 @@
   ($_ _.and
       /parser.test
       /parser/analysis.test
+      /parser/binary.test
       /parser/text.test
       /parser/cli.test
       ))
diff --git a/stdlib/source/test/lux/control/parser/binary.lux b/stdlib/source/test/lux/control/parser/binary.lux
new file mode 100644
index 000000000..d646852f3
--- /dev/null
+++ b/stdlib/source/test/lux/control/parser/binary.lux
@@ -0,0 +1,359 @@
+(.module:
+  [lux (#- primitive)
+   ["_" test (#+ Test)]
+   [abstract
+    [equivalence (#+ Equivalence)]
+    [monad (#+ do)]]
+   [control
+    ["." try]
+    ["." exception]
+    ["<>" parser]]
+   [data
+    ["." binary]
+    ["." sum]
+    ["." maybe]
+    ["." bit]
+    ["." name]
+    ["." text ("#@." equivalence)
+     ["." encoding]]
+    ["." format #_
+     ["#" binary]]
+    [number
+     ["." i64]
+     ["n" nat]
+     ["." int]
+     ["." rev]
+     ["." frac]]
+    [collection
+     ["." list]
+     ["." row]
+     ["." set]]]
+   [macro
+    ["." code]]
+   ["." type]
+   [math
+    ["." random (#+ Random)]]]
+  {1
+   ["." /]})
+
+(template: (!expect <expectation> <computation>)
+  (case <computation>
+    <expectation>
+    true
+
+    _
+    false))
+
+(def: segment-size 10)
+
+(def: random-name
+  (Random Name)
+  (random.and (random.unicode ..segment-size)
+              (random.unicode ..segment-size)))
+
+(structure: cursor-equivalence
+  (Equivalence Cursor)
+
+  (def: (= [expected-module expected-line expected-column]
+           [sample-module sample-line sample-column])
+    (and (text@= expected-module sample-module)
+         (n.= expected-line sample-line)
+         (n.= expected-column sample-column))))
+
+(def: random-cursor
+  (Random Cursor)
+  ($_ random.and
+      (random.unicode ..segment-size)
+      random.nat
+      random.nat))
+
+(def: random-code
+  (Random Code)
+  (random.rec
+   (function (_ recur)
+     (let [random-sequence (do {@ random.monad}
+                             [size (:: @ map (n.% 2) random.nat)]
+                             (random.list size recur))]
+       ($_ random.and
+           ..random-cursor
+           (: (Random (Code' (Ann Cursor)))
+              ($_ random.or
+                  random.bit
+                  random.nat
+                  random.int
+                  random.rev
+                  random.frac
+                  (random.unicode ..segment-size)
+                  ..random-name
+                  ..random-name
+                  random-sequence
+                  random-sequence
+                  (do {@ random.monad}
+                    [size (:: @ map (n.% 2) random.nat)]
+                    (random.list size (random.and recur recur)))
+                  )))))))
+
+(def: random-type
+  (Random Type)
+  (let [(^open ".") random.monad]
+    ($_ random.either
+        (wrap .Nat)
+        (wrap .List)
+        (wrap .Code)
+        (wrap .Type))))
+
+(def: size
+  Test
+  (<| (_.with-cover [/.Size])
+      (`` ($_ _.and
+              (~~ (template [<size> <parser> <format>]
+                    [(do {@ random.monad}
+                       [expected (:: @ map (i64.and (i64.mask <size>))
+                                     random.nat)]
+                       (_.cover [<size> <parser>]
+                                (|> (format.run <format> expected)
+                                    (/.run <parser>)
+                                    (!expect (^multi (#try.Success actual)
+                                                     (n.= (.nat expected)
+                                                          (.nat actual)))))))]
+
+                    [/.size/8 /.bits/8 format.bits/8]
+                    [/.size/16 /.bits/16 format.bits/16]
+                    [/.size/32 /.bits/32 format.bits/32]
+                    [/.size/64 /.bits/64 format.bits/64]
+                    ))))))
+
+(def: binary
+  Test
+  (`` ($_ _.and
+          (~~ (template [<parser> <format>]
+                [(do {@ random.monad}
+                   [expected (:: @ map encoding.to-utf8 (random.ascii ..segment-size))]
+                   (_.cover [<parser>]
+                            (|> (format.run <format> expected)
+                                (/.run <parser>)
+                                (!expect (^multi (#try.Success actual)
+                                                 (:: binary.equivalence = expected actual))))))]
+
+                [/.binary/8 format.binary/8]
+                [/.binary/16 format.binary/16]
+                [/.binary/32 format.binary/32]
+                [/.binary/64 format.binary/64]
+                )))))
+
+(def: utf8
+  Test
+  (`` ($_ _.and
+          (~~ (template [<parser> <format>]
+                [(do {@ random.monad}
+                   [expected (random.ascii ..segment-size)]
+                   (_.cover [<parser>]
+                            (|> (format.run <format> expected)
+                                (/.run <parser>)
+                                (!expect (^multi (#try.Success actual)
+                                                 (:: text.equivalence = expected actual))))))]
+
+                [/.utf8/8 format.utf8/8]
+                [/.utf8/16 format.utf8/16]
+                [/.utf8/32 format.utf8/32]
+                [/.utf8/64 format.utf8/64]
+                [/.text format.utf8/64]
+                )))))
+
+(def: row
+  Test
+  (`` ($_ _.and
+          (~~ (template [<parser> <format>]
+                [(do {@ random.monad}
+                   [expected (random.row ..segment-size random.nat)]
+                   (_.cover [<parser>]
+                            (|> expected
+                                (format.run (<format> format.nat))
+                                (/.run (<parser> /.nat))
+                                (!expect (^multi (#try.Success actual)
+                                                 (:: (row.equivalence n.equivalence) = expected actual))))))]
+
+                [/.row/8 format.row/8]
+                [/.row/16 format.row/16]
+                [/.row/32 format.row/32]
+                [/.row/64 format.row/64]
+                )))))
+
+(def: simple
+  Test
+  (`` ($_ _.and
+          (~~ (template [<parser> <format> <random> <equivalence>]
+                [(do {@ random.monad}
+                   [expected <random>]
+                   (_.cover [<parser>]
+                            (|> (format.run <format> expected)
+                                (/.run <parser>)
+                                (!expect (^multi (#try.Success actual)
+                                                 (:: <equivalence> = expected actual))))))]
+
+                [/.bit format.bit random.bit bit.equivalence]
+                [/.nat format.nat random.nat n.equivalence]
+                [/.int format.int random.int int.equivalence]
+                [/.rev format.rev random.rev rev.equivalence]
+                [/.frac format.frac random.frac frac.equivalence]
+                ))
+          (do {@ random.monad}
+            [expected (:: @ map (|>> (i64.and (i64.mask /.size/8))
+                                     (n.max 2))
+                          random.nat)]
+            (_.cover [/.not-a-bit]
+                     (|> expected
+                         (format.run format.bits/8)
+                         (/.run /.bit)
+                         (!expect (^multi (#try.Failure error)
+                                          (exception.match? /.not-a-bit error))))))
+          )))
+
+(def: complex
+  Test
+  (`` ($_ _.and
+          (~~ (template [<parser> <format> <random> <equivalence>]
+                [(do {@ random.monad}
+                   [expected <random>]
+                   (_.cover [<parser>]
+                            (|> (format.run <format> expected)
+                                (/.run <parser>)
+                                (!expect (^multi (#try.Success actual)
+                                                 (:: <equivalence> = expected actual))))))]
+
+                [/.cursor format.cursor random-cursor cursor-equivalence]
+                [/.code format.code random-code code.equivalence]
+                [/.type format.type random-type type.equivalence]
+                ))
+          (~~ (template [<cover> <parser> <format> <random> <equivalence>]
+                [(do {@ random.monad}
+                   [expected <random>]
+                   (_.cover [<cover>]
+                            (|> (format.run <format> expected)
+                                (/.run <parser>)
+                                (!expect (^multi (#try.Success actual)
+                                                 (:: <equivalence> = expected actual))))))]
+
+                [/.maybe (/.maybe /.nat) (format.maybe format.nat) (random.maybe random.nat) (maybe.equivalence n.equivalence)]
+                [/.list (/.list /.nat) (format.list format.nat) (random.list ..segment-size random.nat) (list.equivalence n.equivalence)]
+                [/.set (/.set n.hash /.nat) (format.set format.nat) (random.set n.hash ..segment-size random.nat) set.equivalence]
+                [/.name /.name format.name ..random-name name.equivalence]
+                ))
+          (do {@ random.monad}
+            [expected (:: @ map (list.repeat ..segment-size) random.nat)]
+            (_.cover [/.set-elements-are-not-unique]
+                     (|> expected
+                         (format.run (format.list format.nat))
+                         (/.run (/.set n.hash /.nat))
+                         (!expect (^multi (#try.Failure error)
+                                          (exception.match? /.set-elements-are-not-unique error))))))
+          (do {@ random.monad}
+            [expected (random.or random.bit random.nat)]
+            (_.cover [/.or]
+                     (|> expected
+                         (format.run (format.or format.bit format.nat))
+                         (/.run (: (/.Parser (Either Bit Nat))
+                                   (/.or /.bit /.nat)))
+                         (!expect (^multi (#try.Success actual)
+                                          (:: (sum.equivalence bit.equivalence n.equivalence) =
+                                              expected
+                                              actual))))))
+          (do {@ random.monad}
+            [tag (:: @ map (|>> (i64.and (i64.mask /.size/8))
+                                (n.max 2))
+                     random.nat)
+             value random.bit]
+            (_.cover [/.invalid-tag]
+                     (|> [tag value]
+                         (format.run (format.and format.bits/8 format.bit))
+                         (/.run (: (/.Parser (Either Bit Nat))
+                                   (/.or /.bit /.nat)))
+                         (!expect (^multi (#try.Failure error)
+                                          (exception.match? /.invalid-tag error))))))
+          (do {@ random.monad}
+            [expected (random.list ..segment-size random.nat)]
+            (_.cover [/.rec]
+                     (|> expected
+                         (format.run (format.list format.nat))
+                         (/.run (: (/.Parser (List Nat))
+                                   (/.rec
+                                    (function (_ recur)
+                                      (/.or /.any
+                                            (<>.and /.nat
+                                                    recur))))))
+                         (!expect (^multi (#try.Success actual)
+                                          (:: (list.equivalence n.equivalence) =
+                                              expected
+                                              actual))))))
+          )))
+
+(def: #export test
+  Test
+  (<| (_.covering /._)
+      (_.with-cover [/.Parser])
+      (`` ($_ _.and
+              (_.cover [/.run /.any]
+                       (|> (binary.create 0)
+                           (/.run /.any)
+                           (!expect (#try.Success _))))
+              (do {@ random.monad}
+                [data (:: @ map encoding.to-utf8 (random.ascii ..segment-size))]
+                (_.cover [/.binary-was-not-fully-read]
+                         (|> data
+                             (/.run /.any)
+                             (!expect (^multi (#try.Failure error)
+                                              (exception.match? /.binary-was-not-fully-read error))))))
+              (do {@ random.monad}
+                [expected (:: @ map encoding.to-utf8 (random.ascii ..segment-size))]
+                (_.cover [/.segment]
+                         (|> expected
+                             (/.run (/.segment ..segment-size))
+                             (!expect (^multi (#try.Success actual)
+                                              (:: binary.equivalence = expected actual))))))
+              (do {@ random.monad}
+                [data (:: @ map encoding.to-utf8 (random.ascii ..segment-size))]
+                (_.cover [/.end?]
+                         (|> data
+                             (/.run (do <>.monad
+                                      [pre /.end?
+                                       _ (/.segment ..segment-size)
+                                       post /.end?]
+                                      (wrap (and (not pre)
+                                                 post))))
+                             (!expect (#try.Success #1)))))
+              (do {@ random.monad}
+                [to-read (:: @ map (n.% (inc ..segment-size)) random.nat)
+                 data (:: @ map encoding.to-utf8 (random.ascii ..segment-size))]
+                (_.cover [/.Offset /.offset]
+                         (|> data
+                             (/.run (do <>.monad
+                                      [start /.offset
+                                       _ (/.segment to-read)
+                                       offset /.offset
+                                       _ (/.segment (n.- to-read ..segment-size))
+                                       nothing-left /.offset]
+                                      (wrap (and (n.= 0 start)
+                                                 (n.= to-read offset)
+                                                 (n.= ..segment-size nothing-left)))))
+                             (!expect (#try.Success #1)))))
+              (do {@ random.monad}
+                [to-read (:: @ map (n.% (inc ..segment-size)) random.nat)
+                 data (:: @ map encoding.to-utf8 (random.ascii ..segment-size))]
+                (_.cover [/.remaining]
+                         (|> data
+                             (/.run (do <>.monad
+                                      [_ (/.segment to-read)
+                                       remaining /.remaining
+                                       _ (/.segment (n.- to-read ..segment-size))
+                                       nothing-left /.remaining]
+                                      (wrap (and (n.= ..segment-size
+                                                      (n.+ to-read remaining))
+                                                 (n.= 0 nothing-left)))))
+                             (!expect (#try.Success #1)))))
+              ..size
+              ..binary
+              ..utf8
+              ..row
+              ..simple
+              ..complex
+              ))))
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis.lux
index da9937862..46291b311 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis.lux
@@ -5,7 +5,8 @@
    ["#." primitive]
    ["#." structure]
    ["#." case]
-   ["#." function]])
+   ["#." function]
+   ["#." loop]])
 
 (def: #export test
   Test
@@ -14,4 +15,5 @@
       /structure.test
       /case.test
       /function.test
+      /loop.test
       ))
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/loop.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/loop.lux
new file mode 100644
index 000000000..adb98ba3a
--- /dev/null
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/loop.lux
@@ -0,0 +1,293 @@
+(.module:
+  [lux (#- primitive structure loop function)
+   ["_" test (#+ Test)]
+   [abstract
+    [monad (#+ do)]]
+   [control
+    ["." try]
+    ["." exception]]
+   [data
+    [number
+     ["n" nat]]
+    [collection
+     ["." list ("#@." functor)]]]
+   [math
+    ["." random (#+ Random) ("#@." monad)]]]
+  {1
+   ["." /
+    [////
+     ["." analysis (#+ Environment)]
+     ["/#" synthesis (#+ Member Path Synthesis)]
+     [///
+      [arity (#+ Arity)]
+      ["." reference (#+ Constant)
+       ["." variable (#+ Register Variable)]]]]]})
+
+(type: (Scenario a)
+  (-> Register Arity Register (Random [Register [a a]])))
+
+(def: (primitive offset arity next)
+  (Scenario Synthesis)
+  (`` ($_ random.either
+          (~~ (template [<synthesis> <random>]
+                [(do {@ random.monad}
+                   [example (:: @ map (|>> <synthesis>) <random>)]
+                   (wrap [next
+                          [example
+                           example]]))]
+
+                [//.bit random.bit]
+                [//.i64 (:: @ map .i64 random.nat)]
+                [//.f64 random.frac]
+                [//.text (random.unicode 1)]
+                ))
+          )))
+
+(def: (constant offset arity next)
+  (Scenario Constant)
+  (do random.monad
+    [name (random.and (random.unicode 1)
+                      (random.unicode 1))]
+    (wrap [next
+           [name
+            name]])))
+
+(def: (variable offset arity next)
+  (Scenario Variable)
+  (let [local (do {@ random.monad}
+                [register (:: @ map (|>> (n.% arity) inc) random.nat)]
+                (wrap [next
+                       [(#variable.Local (/.register-optimization offset register))
+                        (#variable.Local register)]]))]
+    (case offset
+      0 local
+      _ ($_ random.either
+            local
+            (do {@ random.monad}
+              [foreign (:: @ map (n.% offset) random.nat)]
+              (wrap [next
+                     [(#variable.Local foreign)
+                      (#variable.Foreign foreign)]]))))))
+
+(def: (reference offset arity next)
+  (Scenario Synthesis)
+  (`` ($_ random.either
+          (~~ (template [<tag> <random>]
+                [(do {@ random.monad}
+                   [[next [exampleE exampleA]] (<random> offset arity next)]
+                   (wrap [next
+                          [(<tag> exampleE)
+                           (<tag> exampleA)]]))]
+
+                [//.constant ..constant]
+                [//.variable ..variable]
+                )))))
+
+(def: (structure offset arity next)
+  (Scenario Synthesis)
+  ($_ random.either
+      (do {@ random.monad}
+        [lefts random.nat
+         right? random.bit
+         [next [valueE valueA]] (..reference offset arity next)]
+        (wrap [next
+               [(//.variant
+                 {#analysis.lefts lefts
+                  #analysis.right? right?
+                  #analysis.value valueE})
+                (//.variant
+                 {#analysis.lefts lefts
+                  #analysis.right? right?
+                  #analysis.value valueA})]]))
+      (do {@ random.monad}
+        [[next [leftE leftA]] (..reference offset arity next)
+         [next [rightE rightA]] (..reference offset arity next)]
+        (wrap [next
+               [(//.tuple (list leftE rightE))
+                (//.tuple (list leftA rightA))]]))
+      ))
+
+(def: path
+  (Scenario Path)
+  (let [pattern (: (Scenario Path)
+                   (.function (recur offset arity next)
+                     (`` ($_ random.either
+                             (random@wrap [next
+                                           [//.path/pop
+                                            //.path/pop]])
+                             (~~ (template [<path> <random>]
+                                   [(do {@ random.monad}
+                                      [example (:: @ map (|>> <path>) <random>)]
+                                      (wrap [next
+                                             [example
+                                              example]]))]
+
+                                   [//.path/bit random.bit]
+                                   [//.path/i64 (:: @ map .i64 random.nat)]
+                                   [//.path/f64 random.frac]
+                                   [//.path/text (random.unicode 1)]
+                                   ))
+                             (~~ (template [<path>]
+                                   [(do {@ random.monad}
+                                      [example (:: @ map (|>> <path>)
+                                                   (random.or random.nat
+                                                              random.nat))]
+                                      (wrap [next
+                                             [example
+                                              example]]))]
+
+                                   [//.path/side]
+                                   [//.path/member]
+                                   ))
+                             (random@wrap [(inc next)
+                                           [(//.path/bind (/.register-optimization offset next))
+                                            (//.path/bind next)]])
+                             ))))
+        sequential (: (Scenario Path)
+                      (.function (recur offset arity next)
+                        (do random.monad
+                          [[next [patternE patternA]] (pattern offset arity next)
+                           [next [bodyE bodyA]] (..reference offset arity next)]
+                          (wrap [next
+                                 [(//.path/seq patternE (//.path/then bodyE))
+                                  (//.path/seq patternA (//.path/then bodyA))]]))))]
+    (.function (recur offset arity next)
+      (do random.monad
+        [[next [leftE leftA]] (sequential offset arity next)
+         [next [rightE rightA]] (sequential offset arity next)]
+        (wrap [next
+               [(//.path/alt leftE rightE)
+                (//.path/alt leftA rightA)]])))))
+
+(def: (branch offset arity next)
+  (Scenario Synthesis)
+  (let [random-member (: (Random Member)
+                         (random.or random.nat
+                                    random.nat))]
+    ($_ random.either
+        ($_ random.either
+            (do {@ random.monad}
+              [[next [inputE inputA]] (..reference offset arity next)
+               [next [bodyE bodyA]] (..reference offset arity next)]
+              (wrap [next
+                     [(//.branch/let [inputE (/.register-optimization offset next) bodyE])
+                      (//.branch/let [inputA next bodyA])]]))
+            (do {@ random.monad}
+              [[next [testE testA]] (..reference offset arity next)
+               [next [thenE thenA]] (..reference offset arity next)
+               [next [elseE elseA]] (..reference offset arity next)]
+              (wrap [next
+                     [(//.branch/if [testE thenE elseE])
+                      (//.branch/if [testA thenA elseA])]])))
+        ($_ random.either
+            (do {@ random.monad}
+              [[next [recordE recordA]] (..reference offset arity next)
+               path-length (:: @ map (|>> (n.% 5) inc) random.nat)
+               path (random.list path-length random-member)]
+              (wrap [next
+                     [(//.branch/get [path recordE])
+                      (//.branch/get [path recordA])]]))
+            (do {@ random.monad}
+              [[next [inputE inputA]] (..reference offset arity next)
+               [next [pathE pathA]] (..path offset arity next)]
+              (wrap [next
+                     [(//.branch/case [inputE pathE])
+                      (//.branch/case [inputA pathA])]])))
+        )))
+
+(def: (loop offset arity next)
+  (Scenario Synthesis)
+  ($_ random.either
+      (do random.monad
+        [[next [firstE firstA]] (..reference offset arity next)
+         [next [secondE secondA]] (..reference offset arity next)
+         [next [iterationE iterationA]] (..reference offset arity next)]
+        (wrap [next
+               [(//.loop/scope
+                 {#//.start (/.register-optimization offset next)
+                  #//.inits (list firstE secondE)
+                  #//.iteration iterationE})
+                (//.loop/scope
+                 {#//.start next
+                  #//.inits (list firstA secondA)
+                  #//.iteration iterationA})]]))
+      ))
+
+(def: (function offset arity next)
+  (Scenario Synthesis)
+  ($_ random.either
+      (do {@ random.monad}
+        [[next [firstE firstA]] (..variable offset arity next)
+         [next [secondE secondA]] (..variable offset arity next)
+         arity (:: @ map (n.max 1) random.nat)
+         [next [bodyE bodyA]] (..primitive 0 arity next)]
+        (wrap [next
+               [(//.function/abstraction
+                 {#//.environment (list firstE secondE)
+                  #//.arity arity
+                  #//.body bodyE})
+                (//.function/abstraction
+                 {#//.environment (list firstA secondA)
+                  #//.arity arity
+                  #//.body bodyA})]]))
+      ))
+
+(def: (control offset arity next)
+  (Scenario Synthesis)
+  ($_ random.either
+      (..branch offset arity next)
+      (..loop offset arity next)
+      (..function offset arity next)
+      ))
+
+(def: (extension offset arity next)
+  (Scenario Synthesis)
+  (do random.monad
+    [name (random.unicode 10)
+     [next [firstE firstA]] (..reference offset arity next)
+     [next [secondE secondA]] (..reference offset arity next)
+     [next [thirdE thirdA]] (..reference offset arity next)]
+    (wrap [next
+           [(#//.Extension name (list firstE secondE thirdE))
+            (#//.Extension name (list firstA secondA thirdA))]])))
+
+(def: (scenario offset arity next)
+  (Scenario Synthesis)
+  ($_ random.either
+      (..primitive offset arity next)
+      (..structure offset arity next)
+      (..reference offset arity next)
+      (..control offset arity next)
+      (..extension offset arity next)
+      ))
+
+(def: #export test
+  Test
+  (<| (_.covering /._)
+      ($_ _.and
+          (do {@ random.monad}
+            [expected-offset (:: @ map (|>> (n.% 5) (n.+ 2)) random.nat)
+             arity (:: @ map (|>> (n.% 5) inc) random.nat)
+             expected-inits (|> random.nat
+                                (:: @ map (|>> .i64 //.i64))
+                                (random.list arity))
+             [_ [expected iteration]] (..scenario expected-offset arity 0)]
+            (_.cover [/.Transform /.optimization /.register-optimization]
+                     (case (/.optimization expected-offset expected-inits
+                                           {#//.environment (|> expected-offset
+                                                                list.indices
+                                                                (list@map (|>> #variable.Local)))
+                                            #//.arity arity
+                                            #//.body iteration})
+                       (^ (#.Some (//.loop/scope [actual-offset actual-inits
+                                                  actual])))
+                       (and (n.= expected-offset
+                                 actual-offset)
+                            (:: (list.equivalence //.equivalence) =
+                                expected-inits
+                                actual-inits)
+                            (:: //.equivalence = expected actual))
+                       
+                       _
+                       false)))
+          )))