- Added loop synthesis.

- Some refactoring.

8 files changed, 404 insertions, 144 deletions

diff --git a/new-luxc/source/luxc/analyser/case/coverage.lux b/new-luxc/source/luxc/analyser/case/coverage.lux
index 754e555b2..5989952ee 100644
--- a/new-luxc/source/luxc/analyser/case/coverage.lux
+++ b/new-luxc/source/luxc/analyser/case/coverage.lux
@@ -271,13 +271,13 @@
           
           #;None
           (case (list;reverse possibilities)
-            #;Nil
-            (R;fail "{ This is not supposed to happen... }")
-            
             (#;Cons last prevs)
             (wrap (L/fold (function [left right] (#Alt left right))
                           last
-                          prevs))))))
+                          prevs))
+
+            #;Nil
+            (undefined)))))
 
     _
     (if (C/= so-far addition)
diff --git a/new-luxc/source/luxc/lang/synthesis.lux b/new-luxc/source/luxc/lang/synthesis.lux
index f5d3f9c33..b86f49fb2 100644
--- a/new-luxc/source/luxc/lang/synthesis.lux
+++ b/new-luxc/source/luxc/lang/synthesis.lux
@@ -1,6 +1,8 @@
 (;module:
   lux)
 
+(def: #export Arity Nat)
+(def: #export Register Nat)
 (def: #export Variable Int)
 
 (type: #export (Path' s)
@@ -31,14 +33,14 @@
   (#Variant Nat Bool Synthesis)
   (#Tuple (List Synthesis))
   (#Case Synthesis (Path' Synthesis))
-  (#Function Nat (List Variable) Synthesis)
+  (#Function Arity (List Variable) Synthesis)
   (#Call Synthesis (List Synthesis))
-  (#Recur Nat (List Synthesis))
+  (#Recur (List Synthesis))
   (#Procedure Text (List Synthesis))
   (#Variable Variable)
   (#Definition Ident)
-  (#Let Nat Synthesis Synthesis)
+  (#Let Register Synthesis Synthesis)
   (#If Synthesis Synthesis Synthesis)
-  (#Loop Nat (List Synthesis) Synthesis))
+  (#Loop Register (List Synthesis) Synthesis))
 
 (type: #export Path (Path' Synthesis))
diff --git a/new-luxc/source/luxc/synthesizer.lux b/new-luxc/source/luxc/synthesizer.lux
index 5dc4fa258..2f7344c6e 100644
--- a/new-luxc/source/luxc/synthesizer.lux
+++ b/new-luxc/source/luxc/synthesizer.lux
@@ -2,105 +2,30 @@
   lux
   (lux (data text/format
              [number]
-             (coll [list "L/" Functor<List> Fold<List>]
+             (coll [list "L/" Functor<List> Fold<List> Monoid<List>]
                    ["d" dict])))
   (luxc ["&" base]
         (lang ["la" analysis]
               ["ls" synthesis])
         (synthesizer ["&&;" structure]
-                     ["&&;" function])
+                     ["&&;" function]
+                     ["&&;" loop])
         ))
 
-## (def: (has-self-reference? exprS)
-##   (-> ls;Synthesis Bool)
-##   (case exprS
-##     (#ls;Tuple membersS)
-##     (list;any? has-self-reference? membersS)
-
-##     (#ls;Procedure name argsS)
-##     (list;any? has-self-reference? argsS)
-
-##     (#ls;Variant tag last? memberS)
-##     (has-self-reference? memberS)
-
-##     (#ls;Variable idx)
-##     (i.= 0 idx)
-
-##     (#ls;Recur offset argsS)
-##     (list;any? has-self-reference? argsS)
-
-##     (#ls;Call funcS argsS)
-##     (or (has-self-reference? funcS)
-##         (list;any? has-self-reference? argsS))
-
-##     (#ls;Let register inputS bodyS)
-##     (or (has-self-reference? inputS)
-##         (has-self-reference? bodyS))
-
-##     (#ls;If inputS thenS elseS)
-##     (or (has-self-reference? inputS)
-##         (has-self-reference? thenS)
-##         (has-self-reference? elseS))
-
-##     (#ls;Function num-args scope bodyS)
-##     (not (list;any? (i.= 0) scope))
-
-##     (#ls;Loop offset argsS bodyS)
-##     (or (list;any? has-self-reference? argsS)
-##         (has-self-reference? bodyS))
-
-##     _
-##     false
-##     ))
-
-## (def: (shift-loop-variables scope offset exprS)
-##   (-> (List Int) Nat ls;Synthesis ls;Synthesis)
-##   (loop [exprS exprS]
-##     (case exprS
-##       (#ls;Tuple members)
-##       (#ls;Tuple (L/map recur members))
-
-##       (#ls;Procedure name argsS)
-##       (#ls;Procedure name (L/map recur argsS))
-
-##       (#ls;Variant tag last? valueS)
-##       (#ls;Variant tag last? (recur valueS))
-
-##       (#ls;Variable idx)
-##       (if (captured-ref? idx)
-##         (let [scope-idx (|> idx (n.+ 1) (n.* -1) int-to-nat)]
-##           (|> scope (list;nth scope-idx) assume #ls;Variable))
-##         (#ls;Variable (i.+ idx (nat-to-int offset))))
-
-##       (#ls;Recur _offset argsS)
-##       (#ls;Recur (n.+ offset _offset) (L/map recur argsS))
-
-##       (#ls;Call funcS argsS)
-##       (#ls;Call (recur funcS) (L/map recur argsS))
-
-##       (#ls;Let register inputS bodyS)
-##       (#ls;Let (n.+ offset register) (recur inputS) (recur bodyS))
-
-##       (#ls;If inputS thenS elseS)
-##       (#ls;If (recur inputS) (recur thenS) (recur elseS))
-
-##       (#ls;Function _num-args _scope _bodyS)
-##       ...
-
-##       (#ls;Loop _offset _argsS _bodyS)
-##       (#ls;Loop (n.+ offset _offset) (L/map recur _argsS) (recur _bodyS))
-
-##       _
-##       exprS
-##       )))
-
 (def: init-env (List ls;Variable) (list))
 (def: init-resolver (d;Dict Int Int) (d;new number;Hash<Int>))
 
+(def: (prepare-body inner-arity arity body)
+  (-> Nat Nat ls;Synthesis ls;Synthesis)
+  (if (&&function;nested? inner-arity)
+    body
+    (&&loop;reify-recursion arity body)))
+
 (def: #export (synthesize analysis)
   (-> la;Analysis ls;Synthesis)
-  (loop [scope-args +0
+  (loop [outer-arity +0
          resolver init-resolver
+         num-locals +0
          exprA analysis]
     (case exprA
       (^template [<from> <to>]
@@ -117,34 +42,29 @@
        [#la;Absolute #ls;Definition])
 
       (#la;Product _)
-      (#ls;Tuple (L/map (recur +0 resolver) (&&structure;unfold-tuple exprA)))
+      (#ls;Tuple (L/map (recur +0 resolver num-locals) (&&structure;unfold-tuple exprA)))
 
       (#la;Sum choice)
       (let [[tag last? value] (&&structure;unfold-variant choice)]
-        (#ls;Variant tag last? (recur +0 resolver value)))
+        (#ls;Variant tag last? (recur +0 resolver num-locals value)))
 
       (#la;Relative ref)
-      (if (&&function;nested-function? scope-args)
-        (case ref
-          (#;Local local)
-          (if (n.= +0 local)
+      (case ref
+        (#;Local register)
+        (if (&&function;nested? outer-arity)
+          (if (n.= +0 register)
             (<| (#ls;Call (#ls;Variable 0))
-                (L/map (|>. nat-to-int #ls;Variable))
-                (list;n.range +1 (n.dec scope-args)))
-            (#ls;Variable (&&function;adjust-var scope-args (nat-to-int local))))
-          
-          (#;Captured register)
-          (#ls;Variable (default (&&function;to-captured register)
-                          (d;get (&&function;to-captured register) resolver))))
-        (case ref
-          (#;Local local)
-          (#ls;Variable (nat-to-int local))
-          
-          (#;Captured register)
-          (#ls;Variable (&&function;to-captured register))))
+                (L/map (|>. &&function;to-local #ls;Variable))
+                (list;n.range +1 (n.dec outer-arity)))
+            (#ls;Variable (&&function;adjust-var outer-arity (&&function;to-local register))))
+          (#ls;Variable (&&function;to-local register)))
+        
+        (#;Captured register)
+        (#ls;Variable (let [var (&&function;to-captured register)]
+                        (default var (d;get var resolver)))))
 
       (#la;Function scope bodyA)
-      (let [num-args (n.inc scope-args)
+      (let [inner-arity (n.inc outer-arity)
             raw-env (&&function;environment scope)
             env (L/map (function [var] (default var (d;get var resolver))) raw-env)
             env-vars (let [env-size (list;size raw-env)]
@@ -152,7 +72,7 @@
                           (case env-size
                             +0 (list)
                             _ (L/map &&function;to-captured (list;n.range +0 (n.dec env-size))))))
-            resolver' (if (&&function;nested-function? num-args)
+            resolver' (if (&&function;nested? inner-arity)
                         (L/fold (function [[from to] resolver']
                                   (d;put from to resolver'))
                                 init-resolver
@@ -161,33 +81,36 @@
                                   (d;put var var resolver'))
                                 init-resolver
                                 env-vars))]
-        (case (recur num-args resolver' bodyA)
-          (#ls;Function args' env' bodyS')
-          (#ls;Function (n.inc args') env bodyS')
+        (case (recur inner-arity resolver' +0 bodyA)
+          (#ls;Function arity' env' bodyS')
+          (let [arity (n.inc arity')]
+            (#ls;Function arity env (prepare-body inner-arity arity bodyS')))
 
           bodyS
-          (#ls;Function +1 env bodyS)))
-      
+          (#ls;Function +1 env (prepare-body inner-arity +1 bodyS))))
+
       (#la;Apply _)
       (let [[funcA argsA] (&&function;unfold-apply exprA)
-            funcS (recur +0 resolver funcA)
-            argsS (L/map (recur +0 resolver) argsA)]
+            funcS (recur +0 resolver num-locals funcA)
+            argsS (L/map (recur +0 resolver num-locals) argsA)]
         (case funcS
-          ## (^multi (#ls;Variable idx)
-          ##         (and (|> scope-args n.dec nat-to-int (i.* -1) (i.= idx))
-          ##              tail?))
-          ## (#ls;Recur +1 argsS)
-
-          ## (^multi (#ls;Function _scope-args _scope _bodyS)
-          ##         (and (n.= _scope-args (list;size argsS))
-          ##              (not (has-self-reference? _bodyS))))
-          ## (#ls;Loop local-offset argsS (shift-loop-variables local-offset _bodyS))
+          (^multi (#ls;Function _arity _env _bodyS)
+                  (and (n.= _arity (list;size argsS))
+                       (not (&&loop;contains-self-reference? _bodyS))))
+          (let [register-offset (if (&&function;top? outer-arity)
+                                  num-locals
+                                  (|> outer-arity n.inc (n.+ num-locals)))]
+            (#ls;Loop register-offset argsS
+                      (&&loop;adjust _env register-offset _bodyS)))
+
+          (#ls;Call funcS' argsS')
+          (#ls;Call funcS' (L/append argsS' argsS))
 
           _
           (#ls;Call funcS argsS)))
 
       (#la;Procedure name args)
-      (#ls;Procedure name (L/map (recur +0 resolver) args))
+      (#ls;Procedure name (L/map (recur +0 resolver num-locals) args))
 
       _
       (undefined)
diff --git a/new-luxc/source/luxc/synthesizer/function.lux b/new-luxc/source/luxc/synthesizer/function.lux
index be6a74da0..42aa7a6cd 100644
--- a/new-luxc/source/luxc/synthesizer/function.lux
+++ b/new-luxc/source/luxc/synthesizer/function.lux
@@ -22,18 +22,23 @@
      (-> ls;Variable Bool)
      (<comp> 0 var))]
 
-  [function-var? i.=]
-  [local-var?    i.>]
-  [captured-var? i.<]
+  [self?     i.=]
+  [local?    i.>]
+  [captured? i.<]
   )
 
-(def: #export (nested-function? scope-args)
-  (-> Nat Bool)
-  (n.> +1 scope-args))
+(do-template [<name> <comp> <ref>]
+  [(def: #export (<name> arity)
+     (-> ls;Arity Bool)
+     (<comp> <ref> arity))]
 
-(def: #export (adjust-var scope-args var)
-  (-> Nat ls;Variable ls;Variable)
-  (|> scope-args n.dec nat-to-int (i.+ var)))
+  [nested? n.> +1]
+  [top?    n.= +0]
+  )
+
+(def: #export (adjust-var outer var)
+  (-> ls;Arity ls;Variable ls;Variable)
+  (|> outer n.dec nat-to-int (i.+ var)))
 
 (def: #export (to-captured idx)
   (-> Nat Int)
diff --git a/new-luxc/source/luxc/synthesizer/loop.lux b/new-luxc/source/luxc/synthesizer/loop.lux
new file mode 100644
index 000000000..06b1d1bb0
--- /dev/null
+++ b/new-luxc/source/luxc/synthesizer/loop.lux
@@ -0,0 +1,166 @@
+(;module:
+  lux
+  (lux (data (coll [list "L/" Functor<List>])
+             text/format))
+  (luxc (lang ["ls" synthesis])
+        (synthesizer ["&&;" function])))
+
+(def: #export (contains-self-reference? exprS)
+  (-> ls;Synthesis Bool)
+  (case exprS
+    (#ls;Variant tag last? memberS)
+    (contains-self-reference? memberS)
+
+    (#ls;Tuple membersS)
+    (list;any? contains-self-reference? membersS)
+
+    (#ls;Case inputS pathS)
+    (or (contains-self-reference? inputS)
+        (loop [pathS pathS]
+          (case pathS
+            (^or (#ls;AltP leftS rightS)
+                 (#ls;SeqP leftS rightS))
+            (or (recur leftS)
+                (recur rightS))
+            
+            (#ls;ExecP bodyS)
+            (contains-self-reference? bodyS)
+            
+            _
+            false)))
+
+    (#ls;Function arity environment bodyS)
+    (list;any? &&function;self? environment)
+    
+    (#ls;Call funcS argsS)
+    (or (contains-self-reference? funcS)
+        (list;any? contains-self-reference? argsS))
+    
+    (^or (#ls;Recur argsS)
+         (#ls;Procedure name argsS))
+    (list;any? contains-self-reference? argsS)
+
+    (#ls;Variable idx)
+    (&&function;self? idx)
+
+    (#ls;Let register inputS bodyS)
+    (or (contains-self-reference? inputS)
+        (contains-self-reference? bodyS))
+
+    (#ls;If inputS thenS elseS)
+    (or (contains-self-reference? inputS)
+        (contains-self-reference? thenS)
+        (contains-self-reference? elseS))
+
+    (#ls;Loop offset argsS bodyS)
+    (or (list;any? contains-self-reference? argsS)
+        (contains-self-reference? bodyS))
+
+    _
+    false
+    ))
+
+(def: #export (reify-recursion arity exprS)
+  (-> Nat ls;Synthesis ls;Synthesis)
+  (loop [exprS exprS]
+    (case exprS
+      (#ls;Case inputS pathS)
+      (#ls;Case inputS
+                (let [reify-recursion' recur]
+                  (loop [pathS pathS]
+                    (case pathS
+                      (#ls;AltP leftS rightS)
+                      (#ls;AltP (recur leftS) (recur rightS))
+
+                      (#ls;SeqP leftS rightS)
+                      (#ls;SeqP leftS (recur rightS))
+                      
+                      (#ls;ExecP bodyS)
+                      (#ls;ExecP (reify-recursion' bodyS))
+                      
+                      _
+                      pathS))))
+
+      (^multi (#ls;Call (#ls;Variable 0) argsS)
+              (n.= arity (list;size argsS)))
+      (#ls;Recur argsS)
+
+      (#ls;Call (#ls;Variable var) argsS)
+      exprS
+
+      (#ls;Let register inputS bodyS)
+      (#ls;Let register inputS (recur bodyS))
+
+      (#ls;If inputS thenS elseS)
+      (#ls;If inputS
+              (recur thenS)
+              (recur elseS))
+
+      _
+      exprS
+      )))
+
+(def: #export (adjust env outer-offset exprS)
+  (-> (List ls;Variable) ls;Register ls;Synthesis ls;Synthesis)
+  (let [resolve-captured (: (-> ls;Variable ls;Variable)
+                            (function [var]
+                              (let [idx (|> var (i.* -1) int-to-nat n.dec)]
+                                (|> env (list;nth idx) assume))))]
+    (loop [exprS exprS]
+      (case exprS
+        (#ls;Variant tag last? valueS)
+        (#ls;Variant tag last? (recur valueS))
+        
+        (#ls;Tuple members)
+        (#ls;Tuple (L/map recur members))
+
+        (#ls;Case inputS pathS)
+        (#ls;Case (recur inputS)
+                  (let [adjust' recur]
+                    (loop [pathS pathS]
+                      (case pathS
+                        (^template [<tag>]
+                          (<tag> leftS rightS)
+                          (<tag> (recur leftS) (recur rightS)))
+                        ([#ls;AltP]
+                         [#ls;SeqP])
+                        
+                        (#ls;ExecP bodyS)
+                        (#ls;ExecP (adjust' bodyS))
+                        
+                        _
+                        pathS))))
+
+        (#ls;Function arity scope bodyS)
+        (#ls;Function arity
+                      (L/map resolve-captured scope)
+                      (recur bodyS))
+
+        (#ls;Call funcS argsS)
+        (#ls;Call (recur funcS) (L/map recur argsS))
+
+        (#ls;Recur argsS)
+        (#ls;Recur (L/map recur argsS))
+
+        (#ls;Procedure name argsS)
+        (#ls;Procedure name (L/map recur argsS))
+
+        (#ls;Variable var)
+        (if (&&function;captured? var)
+          (#ls;Variable (resolve-captured var))
+          (#ls;Variable (|> outer-offset nat-to-int (i.+ var))))
+
+        (#ls;Let register inputS bodyS)
+        (#ls;Let (n.+ outer-offset register) (recur inputS) (recur bodyS))
+
+        (#ls;If inputS thenS elseS)
+        (#ls;If (recur inputS) (recur thenS) (recur elseS))
+
+        (#ls;Loop inner-offset argsS bodyS)
+        (#ls;Loop (n.+ outer-offset inner-offset)
+                  (L/map recur argsS)
+                  (recur bodyS))
+
+        _
+        exprS
+        ))))
diff --git a/new-luxc/test/test/luxc/synthesizer/function.lux b/new-luxc/test/test/luxc/synthesizer/function.lux
index 7c4776727..6ad7ed634 100644
--- a/new-luxc/test/test/luxc/synthesizer/function.lux
+++ b/new-luxc/test/test/luxc/synthesizer/function.lux
@@ -13,14 +13,13 @@
        test)
   (luxc (lang ["la" analysis]
               ["ls" synthesis])
-        (analyser [";A" structure])
         [synthesizer]
         (synthesizer ["&&;" function]))
   (.. common))
 
 (def: (reference var)
   (-> ls;Variable Ref)
-  (if (&&function;captured-var? var)
+  (if (&&function;captured? var)
     (#;Captured (|> var (i.* -1) int-to-nat n.dec))
     (#;Local (int-to-nat var))))
 
diff --git a/new-luxc/test/test/luxc/synthesizer/loop.lux b/new-luxc/test/test/luxc/synthesizer/loop.lux
new file mode 100644
index 000000000..b89e09659
--- /dev/null
+++ b/new-luxc/test/test/luxc/synthesizer/loop.lux
@@ -0,0 +1,164 @@
+(;module:
+  lux
+  (lux [io]
+       (control monad)
+       (data [bool "B/" Eq<Bool>]
+             [number]
+             (coll [list "L/" Functor<List> Fold<List>]
+                   ["s" set])
+             text/format)
+       ["r" math/random "r/" Monad<Random>]
+       test)
+  (luxc (lang ["la" analysis]
+              ["ls" synthesis])
+        [synthesizer]
+        (synthesizer ["&&;" loop]))
+  (.. common))
+
+(def: (does-recursion? arity exprS)
+  (-> ls;Arity ls;Synthesis Bool)
+  (loop [exprS exprS]
+    (case exprS
+      (#ls;Case inputS pathS)
+      (loop [pathS pathS]
+        (case pathS
+          (#ls;AltP leftS rightS)
+          (or (recur leftS)
+              (recur rightS))
+
+          (#ls;SeqP leftS rightS)
+          (recur rightS)
+          
+          (#ls;ExecP bodyS)
+          (does-recursion? arity bodyS)
+          
+          _
+          false))
+
+      (#ls;Recur argsS)
+      (n.= arity (list;size argsS))
+
+      (#ls;Let register inputS bodyS)
+      (recur bodyS)
+
+      (#ls;If inputS thenS elseS)
+      (or (recur thenS)
+          (recur elseS))
+
+      _
+      false
+      )))
+
+(def: (gen-body arity output)
+  (-> Nat la;Analysis (r;Random la;Analysis))
+  (r;either (r;either (r/wrap output)
+                      (do r;Monad<Random>
+                        [inputA (|> r;nat (:: @ map (|>. #la;Nat)))
+                         num-cases (|> r;nat (:: @ map (|>. (n.% +10) (n.max +1))))
+                         tests (|> (r;set number;Hash<Nat> num-cases r;nat)
+                                   (:: @ map (|>. s;to-list (L/map (|>. #la;NatP)))))
+                         #let [bad-bodies (list;repeat num-cases #la;Unit)]
+                         good-body (gen-body arity output)
+                         where-to-set (|> r;nat (:: @ map (n.% num-cases)))
+                         #let [bodies (list;concat (list (list;take where-to-set bad-bodies)
+                                                         (list good-body)
+                                                         (list;drop (n.inc where-to-set) bad-bodies)))]]
+                        (wrap (#ls;Case inputA
+                                        (list;zip2 tests bodies)))))
+            (r;either (do r;Monad<Random>
+                        [valueS r;bool
+                         output' (gen-body (n.inc arity) output)]
+                        (wrap (#la;Case (#la;Bool valueS) (list [(#la;BindP arity) output']))))
+                      (do r;Monad<Random>
+                        [valueS r;bool
+                         then|else r;bool
+                         output' (gen-body arity output)
+                         #let [thenA (if then|else output' #ls;Unit)
+                               elseA (if (not then|else) output' #ls;Unit)]]
+                        (wrap (#la;Case (#la;Bool valueS)
+                                        (list [(#la;BoolP then|else) thenA]
+                                              [(#la;BoolP (not then|else)) elseA])))))
+            ))
+
+(def: (make-apply func args)
+  (-> la;Analysis (List la;Analysis) la;Analysis)
+  (L/fold (function [arg' func']
+            (#la;Apply arg' func'))
+          func
+          args))
+
+(def: (make-function arity body)
+  (-> ls;Arity la;Analysis la;Analysis)
+  (case arity
+    +0 body
+    _ (#la;Function {#;name     (list)
+                     #;inner    +0
+                     #;locals   {#;counter +0 #;mappings (list)}
+                     #;captured {#;counter +0 #;mappings (list)}}
+                    (make-function (n.dec arity) body))))
+
+(def: gen-recursion
+  (r;Random [Bool Nat la;Analysis])
+  (do r;Monad<Random>
+    [arity (|> r;nat (:: @ map (|>. (n.% +10) (n.max +1))))
+     recur? r;bool
+     outputS (if recur?
+               (wrap (make-apply (#la;Relative (#;Local +0))
+                                 (list;repeat arity #la;Unit)))
+               (do @
+                 [plus-or-minus? r;bool
+                  how-much (|> r;nat (:: @ map (|>. (n.% arity) (n.max +1))))
+                  #let [shift (if plus-or-minus? n.+ n.-)]]
+                 (wrap (make-apply (#la;Relative (#;Local +0))
+                                   (list;repeat (shift how-much arity) #la;Unit)))))
+     bodyS (gen-body arity outputS)]
+    (wrap [recur? arity (make-function arity bodyS)])))
+
+(def: gen-loop
+  (r;Random [Bool Nat la;Analysis])
+  (do r;Monad<Random>
+    [arity (|> r;nat (:: @ map (|>. (n.% +10) (n.max +1))))
+     recur? r;bool
+     self-ref? r;bool
+     #let [selfA (#la;Relative (#;Local +0))
+           argA (if self-ref? selfA #la;Unit)]
+     outputS (if recur?
+               (wrap (make-apply selfA (list;repeat arity argA)))
+               (do @
+                 [plus-or-minus? r;bool
+                  how-much (|> r;nat (:: @ map (|>. (n.% arity) (n.max +1))))
+                  #let [shift (if plus-or-minus? n.+ n.-)]]
+                 (wrap (make-apply selfA (list;repeat (shift how-much arity) argA)))))
+     bodyS (gen-body arity outputS)]
+    (wrap [(and recur? (not self-ref?))
+           arity
+           (make-function arity bodyS)])))
+
+(test: "Recursion."
+  [[prediction arity analysis] gen-recursion]
+  ($_ seq
+      (assert "Can accurately identify (and then reify) tail recursion."
+              (case (synthesizer;synthesize analysis)
+                (#ls;Function _arity _env _body)
+                (|> _body
+                    (does-recursion? arity)
+                    (B/= prediction)
+                    (and (n.= arity _arity)))
+
+                _
+                false))))
+
+(test: "Loop."
+  [[prediction arity analysis] gen-recursion]
+  ($_ seq
+      (assert "Can reify loops."
+              (case (synthesizer;synthesize (make-apply analysis (list;repeat arity #la;Unit)))
+                (#ls;Loop _register _inits _body)
+                (and (n.= arity (list;size _inits))
+                     (not (&&loop;contains-self-reference? _body)))
+
+                (#ls;Call (#ls;Function _arity _env _bodyS) argsS)
+                (&&loop;contains-self-reference? _bodyS)
+
+                _
+                false))))
diff --git a/new-luxc/test/tests.lux b/new-luxc/test/tests.lux
index 114768c2d..30a8ec522 100644
--- a/new-luxc/test/tests.lux
+++ b/new-luxc/test/tests.lux
@@ -15,7 +15,8 @@
               (synthesizer ["_;S" primitive]
                            ["_;S" structure]
                            ["_;S" function]
-                           ["_;S" procedure]))))
+                           ["_;S" procedure]
+                           ["_;S" loop]))))
 
 ## [Program]
 (program: args