changeset 448:85819353a84f

First Unnest tests working
author Adam Chlipala <adamc@hcoop.net>
date Sat, 01 Nov 2008 15:58:55 -0400
parents b77863cd0be2
children 89f766f19d5b
files src/compiler.sig src/compiler.sml src/elab_env.sig src/elab_env.sml src/elab_print.sml src/elab_util.sig src/elab_util.sml src/sources src/termination.sml src/unnest.sig src/unnest.sml tests/nest.ur tests/nest.urp
diffstat 13 files changed, 627 insertions(+), 5 deletions(-) [+]
line wrap: on
line diff
--- a/src/compiler.sig	Sat Nov 01 11:17:29 2008 -0400
+++ b/src/compiler.sig	Sat Nov 01 15:58:55 2008 -0400
@@ -58,6 +58,7 @@
 
     val parse : (job, Source.file) phase
     val elaborate : (Source.file, Elab.file) phase
+    val unnest : (Elab.file, Elab.file) phase
     val termination : (Elab.file, Elab.file) phase
     val explify : (Elab.file, Expl.file) phase
     val corify : (Expl.file, Core.file) phase
@@ -80,6 +81,7 @@
     val toParseJob : (string, job) transform
     val toParse : (string, Source.file) transform
     val toElaborate : (string, Elab.file) transform
+    val toUnnest : (string, Elab.file) transform
     val toTermination : (string, Elab.file) transform
     val toExplify : (string, Expl.file) transform
     val toCorify : (string, Core.file) transform
--- a/src/compiler.sml	Sat Nov 01 11:17:29 2008 -0400
+++ b/src/compiler.sml	Sat Nov 01 15:58:55 2008 -0400
@@ -383,12 +383,19 @@
 
 val toElaborate = transform elaborate "elaborate" o toParse
 
+val unnest = {
+    func = Unnest.unnest,
+    print = ElabPrint.p_file ElabEnv.empty
+}
+
+val toUnnest = transform unnest "unnest" o toElaborate
+
 val termination = {
     func = (fn file => (Termination.check file; file)),
     print = ElabPrint.p_file ElabEnv.empty
 }
 
-val toTermination = transform termination "termination" o toElaborate
+val toTermination = transform termination "termination" o toUnnest
 
 val explify = {
     func = Explify.explify,
--- a/src/elab_env.sig	Sat Nov 01 11:17:29 2008 -0400
+++ b/src/elab_env.sig	Sat Nov 01 15:58:55 2008 -0400
@@ -30,6 +30,10 @@
     exception SynUnif
     val liftConInCon : int -> Elab.con -> Elab.con
 
+    val liftExpInExp : int -> Elab.exp -> Elab.exp
+
+    val subExpInExp : (int * Elab.exp) -> Elab.exp -> Elab.exp
+
     type env
 
     val empty : env
--- a/src/elab_env.sml	Sat Nov 01 11:17:29 2008 -0400
+++ b/src/elab_env.sml	Sat Nov 01 15:58:55 2008 -0400
@@ -61,6 +61,20 @@
 
 val lift = liftConInCon 0
 
+val liftConInExp =
+    U.Exp.mapB {kind = fn k => k,
+                con = fn bound => fn c =>
+                                     case c of
+                                         CRel xn =>
+                                         if xn < bound then
+                                             c
+                                         else
+                                             CRel (xn + 1)
+                                       | _ => c,
+                exp = fn _ => fn e => e,
+                bind = fn (bound, U.Exp.RelC _) => bound + 1
+                        | (bound, _) => bound}
+
 val liftExpInExp =
     U.Exp.mapB {kind = fn k => k,
                 con = fn _ => fn c => c,
@@ -78,6 +92,21 @@
 
 val liftExp = liftExpInExp 0
 
+val subExpInExp =
+    U.Exp.mapB {kind = fn k => k,
+                con = fn _ => fn c => c,
+                exp = fn (xn, rep) => fn e =>
+                                  case e of
+                                      ERel xn' =>
+                                      (case Int.compare (xn', xn) of
+                                           EQUAL => #1 rep
+                                         | GREATER=> ERel (xn' - 1)
+                                         | LESS => e)
+                                    | _ => e,
+                bind = fn ((xn, rep), U.Exp.RelE _) => (xn+1, liftExpInExp 0 rep)
+                        | ((xn, rep), U.Exp.RelC _) => (xn, liftConInExp 0 rep)
+                        | (ctx, _) => ctx}
+
 (* Back to environments *)
 
 datatype 'a var' =
--- a/src/elab_print.sml	Sat Nov 01 11:17:29 2008 -0400
+++ b/src/elab_print.sml	Sat Nov 01 15:58:55 2008 -0400
@@ -198,7 +198,7 @@
               string (#1 (E.lookupENamed env n) ^ "__" ^ Int.toString n)
           else
               string (#1 (E.lookupENamed env n)))
-         handle E.UnboundRel _ => string ("UNBOUND_NAMED" ^ Int.toString n))
+         handle E.UnboundNamed _ => string ("UNBOUND_NAMED" ^ Int.toString n))
       | PConProj (m1, ms, x) =>
         let
             val m1x = #1 (E.lookupStrNamed env m1)
@@ -247,7 +247,7 @@
               string (#1 (E.lookupENamed env n) ^ "__" ^ Int.toString n)
           else
               string (#1 (E.lookupENamed env n)))
-         handle E.UnboundRel _ => string ("UNBOUND_NAMED" ^ Int.toString n))
+         handle E.UnboundNamed _ => string ("UNBOUND_NAMED" ^ Int.toString n))
       | EModProj (m1, ms, x) =>
         let
             val m1x = #1 (E.lookupStrNamed env m1)
--- a/src/elab_util.sig	Sat Nov 01 11:17:29 2008 -0400
+++ b/src/elab_util.sig	Sat Nov 01 15:58:55 2008 -0400
@@ -57,6 +57,11 @@
               -> Elab.con -> Elab.con
     val exists : {kind : Elab.kind' -> bool,
                   con : Elab.con' -> bool} -> Elab.con -> bool
+
+    val foldB : {kind : Elab.kind' * 'state -> 'state,
+                 con : 'context * Elab.con' * 'state -> 'state,
+                 bind : 'context * binder -> 'context}
+                -> 'context -> 'state -> Elab.con -> 'state
 end
 
 structure Exp : sig
@@ -83,6 +88,12 @@
     val exists : {kind : Elab.kind' -> bool,
                   con : Elab.con' -> bool,
                   exp : Elab.exp' -> bool} -> Elab.exp -> bool
+
+    val foldB : {kind : Elab.kind' * 'state -> 'state,
+                 con : 'context * Elab.con' * 'state -> 'state,
+                 exp : 'context * Elab.exp' * 'state -> 'state,
+                 bind : 'context * binder -> 'context}
+                -> 'context -> 'state -> Elab.exp -> 'state
 end
 
 structure Sgn : sig
@@ -156,6 +167,20 @@
                   str : Elab.str' -> 'a option,
                   decl : Elab.decl' -> 'a option}
                  -> Elab.decl -> 'a option
+
+    val foldMapB : {kind : Elab.kind' * 'state -> Elab.kind' * 'state,
+                    con : 'context * Elab.con' * 'state -> Elab.con' * 'state,
+                    exp : 'context * Elab.exp' * 'state -> Elab.exp' * 'state,
+                    sgn_item : 'context * Elab.sgn_item' * 'state -> Elab.sgn_item' * 'state,
+                    sgn : 'context * Elab.sgn' * 'state -> Elab.sgn' * 'state,
+                    str : 'context * Elab.str' * 'state -> Elab.str' * 'state,
+                    decl : 'context * Elab.decl' * 'state -> Elab.decl' * 'state,
+                    bind : 'context * binder -> 'context}
+                   -> 'context -> 'state -> Elab.decl -> Elab.decl * 'state
+end
+
+structure File : sig
+    val maxName : Elab.file -> int
 end
 
 end
--- a/src/elab_util.sml	Sat Nov 01 11:17:29 2008 -0400
+++ b/src/elab_util.sml	Sat Nov 01 15:58:55 2008 -0400
@@ -226,6 +226,13 @@
         S.Return _ => true
       | S.Continue _ => false
 
+fun foldB {kind, con, bind} ctx st c =
+    case mapfoldB {kind = fn k => fn st => S.Continue (k, kind (k, st)),
+                   con = fn ctx => fn c => fn st => S.Continue (c, con (ctx, c, st)),
+                   bind = bind} ctx c st of
+        S.Continue (_, st) => st
+      | S.Return _ => raise Fail "ElabUtil.Con.foldB: Impossible"
+
 end
 
 structure Exp = struct
@@ -340,8 +347,20 @@
                 S.bind2 (mfe ctx e,
                          fn e' =>
                             S.bind2 (ListUtil.mapfold (fn (p, e) =>
-                                                         S.map2 (mfe ctx e,
-                                                              fn e' => (p, e'))) pes,
+                                                          let
+                                                              fun pb ((p, _), ctx) =
+                                                                  case p of
+                                                                      PWild => ctx
+                                                                    | PVar (x, t) => bind (ctx, RelE (x, t))
+                                                                    | PPrim _ => ctx
+                                                                    | PCon (_, _, _, NONE) => ctx
+                                                                    | PCon (_, _, _, SOME p) => pb (p, ctx)
+                                                                    | PRecord xps => foldl (fn ((_, p, _), ctx) =>
+                                                                                               pb (p, ctx)) ctx xps
+                                                          in
+                                                              S.map2 (mfe (pb (p, ctx)) e,
+                                                                   fn e' => (p, e'))
+                                                          end) pes,
                                     fn pes' =>
                                        S.bind2 (mfc ctx disc,
                                              fn disc' =>
@@ -431,6 +450,14 @@
         S.Continue (e, ()) => e
       | S.Return _ => raise Fail "ElabUtil.Exp.mapB: Impossible"
 
+fun foldB {kind, con, exp, bind} ctx st e =
+    case mapfoldB {kind = fn k => fn st => S.Continue (k, kind (k, st)),
+                   con = fn ctx => fn c => fn st => S.Continue (c, con (ctx, c, st)),
+                   exp = fn ctx => fn e => fn st => S.Continue (e, exp (ctx, e, st)),
+                   bind = bind} ctx e st of
+        S.Continue (_, st) => st
+      | S.Return _ => raise Fail "ElabUtil.Exp.foldB: Impossible"
+
 end
 
 structure Sgn = struct
@@ -888,6 +915,82 @@
         S.Return x => SOME x
       | S.Continue _ => NONE
 
+fun foldMapB {kind, con, exp, sgn_item, sgn, str, decl, bind} ctx st d =
+    case mapfoldB {kind = fn x => fn st => S.Continue (kind (x, st)),
+                   con = fn ctx => fn x => fn st => S.Continue (con (ctx, x, st)),
+                   exp = fn ctx => fn x => fn st => S.Continue (exp (ctx, x, st)),
+                   sgn_item = fn ctx => fn x => fn st => S.Continue (sgn_item (ctx, x, st)),
+                   sgn = fn ctx => fn x => fn st => S.Continue (sgn (ctx, x, st)),
+                   str = fn ctx => fn x => fn st => S.Continue (str (ctx, x, st)),
+                   decl = fn ctx => fn x => fn st => S.Continue (decl (ctx, x, st)),
+                   bind = bind} ctx d st of
+        S.Continue x => x
+      | S.Return _ => raise Fail "ElabUtil.Decl.foldMapB: Impossible"
+
+end
+
+structure File = struct
+
+fun maxName ds = foldl (fn (d, count) => Int.max (maxNameDecl d, count)) 0 ds
+
+and maxNameDecl (d, _) =
+    case d of
+        DCon (_, n, _, _) => n
+      | DDatatype (_, n, _, ns) =>
+                  foldl (fn ((_, n', _), m) => Int.max (n', m))
+                        n ns
+      | DDatatypeImp (_, n1, n2, _, _, _, ns) =>
+        foldl (fn ((_, n', _), m) => Int.max (n', m))
+              (Int.max (n1, n2)) ns
+      | DVal (_, n, _, _) => n
+      | DValRec vis => foldl (fn ((_, n, _, _), count) => Int.max (n, count)) 0 vis
+      | DStr (_, n, sgn, str) => Int.max (n, Int.max (maxNameSgn sgn, maxNameStr str))
+      | DSgn (_, n, sgn) => Int.max (n, maxNameSgn sgn)
+      | DFfiStr (_, n, sgn) => Int.max (n, maxNameSgn sgn)
+      | DConstraint _ => 0
+      | DClass (_, n, _) => n
+      | DExport _ => 0
+      | DTable (n, _, _, _) => n
+      | DSequence (n, _, _) => n
+      | DDatabase _ => 0
+
+and maxNameStr (str, _) =
+    case str of
+        StrConst ds => maxName ds
+      | StrVar n => n
+      | StrProj (str, _) => maxNameStr str
+      | StrFun (_, n, dom, ran, str) => foldl Int.max n [maxNameSgn dom, maxNameSgn ran, maxNameStr str]
+      | StrApp (str1, str2) => Int.max (maxNameStr str1, maxNameStr str2)
+      | StrError => 0
+
+and maxNameSgn (sgn, _) =
+    case sgn of
+        SgnConst sgis => foldl (fn (sgi, count) => Int.max (maxNameSgi sgi, count)) 0 sgis
+      | SgnVar n => n
+      | SgnFun (_, n, dom, ran) => Int.max (n, Int.max (maxNameSgn dom, maxNameSgn ran))
+      | SgnWhere (sgn, _, _) => maxNameSgn sgn
+      | SgnProj (n, _, _) => n
+      | SgnError => 0
+
+and maxNameSgi (sgi, _) =
+    case sgi of
+        SgiConAbs (_, n, _) => n
+      | SgiCon (_, n, _, _) => n
+      | SgiDatatype (_, n, _, ns) =>
+        foldl (fn ((_, n', _), m) => Int.max (n', m))
+              n ns
+      | SgiDatatypeImp (_, n1, n2, _, _, _, ns) =>
+        foldl (fn ((_, n', _), m) => Int.max (n', m))
+              (Int.max (n1, n2)) ns
+      | SgiVal (_, n, _) => n
+      | SgiStr (_, n, sgn) => Int.max (n, maxNameSgn sgn)
+      | SgiSgn (_, n, sgn) => Int.max (n, maxNameSgn sgn)
+      | SgiConstraint _ => 0
+      | SgiTable (n, _, _, _) => n
+      | SgiSequence (n, _, _) => n
+      | SgiClassAbs (_, n) => n
+      | SgiClass (_, n, _) => n
+              
 end
 
 end
--- a/src/sources	Sat Nov 01 11:17:29 2008 -0400
+++ b/src/sources	Sat Nov 01 15:58:55 2008 -0400
@@ -50,6 +50,9 @@
 elaborate.sig
 elaborate.sml
 
+unnest.sig
+unnest.sml
+
 termination.sig
 termination.sml
 
--- a/src/termination.sml	Sat Nov 01 11:17:29 2008 -0400
+++ b/src/termination.sml	Sat Nov 01 15:58:55 2008 -0400
@@ -292,6 +292,8 @@
                       | EError => (Rabble, calls)
                       | EUnif (ref (SOME e)) => exp parent (penv, calls) e
                       | EUnif (ref NONE) => (Rabble, calls)
+
+                      | ELet (_, e) => exp parent (penv, calls) e
                 end
 
             fun doVali (i, (_, f, _, e), calls) =
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/unnest.sig	Sat Nov 01 15:58:55 2008 -0400
@@ -0,0 +1,34 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Remove nested function definitions *)
+
+signature UNNEST = sig
+
+    val unnest : Elab.file -> Elab.file
+    
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/unnest.sml	Sat Nov 01 15:58:55 2008 -0400
@@ -0,0 +1,369 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Remove nested function definitions *)
+
+structure Unnest :> UNNEST = struct
+
+open Elab
+
+structure E = ElabEnv
+structure U = ElabUtil
+
+structure IS = IntBinarySet
+
+val fvsCon = U.Con.foldB {kind = fn (_, st) => st,
+                          con = fn (cb, c, cvs) =>
+                                   case c of
+                                       CRel n =>
+                                       if n >= cb then
+                                           IS.add (cvs, n - cb)
+                                       else
+                                           cvs
+                                     | _ => cvs,
+                          bind = fn (cb, b) =>
+                                    case b of
+                                        U.Con.Rel _ => cb + 1
+                                      | _ => cb}
+                         0 IS.empty
+
+fun fvsExp nr = U.Exp.foldB {kind = fn (_, st) => st,
+                             con = fn ((cb, eb), c, st as (cvs, evs)) =>
+                                      case c of
+                                          CRel n =>
+                                          if n >= cb then
+                                              (IS.add (cvs, n - cb), evs)
+                                          else
+                                              st
+                                        | _ => st,
+                             exp = fn ((cb, eb), e, st as (cvs, evs)) =>
+                                      case e of
+                                          ERel n =>
+                                          if n >= eb then
+                                              (cvs, IS.add (evs, n - eb))
+                                          else
+                                              st
+                                        | _ => st,
+                             bind = fn (ctx as (cb, eb), b) =>
+                                       case b of
+                                           U.Exp.RelC _ => (cb + 1, eb)
+                                         | U.Exp.RelE _ => (cb, eb + 1)
+                                         | _ => ctx}
+                            (0, nr) (IS.empty, IS.empty)
+
+fun positionOf (x : int) ls =
+    let
+        fun po n ls =
+            case ls of
+                [] => raise Fail "Unnest.positionOf"
+              | x' :: ls' =>
+                if x' = x then
+                    n
+                else
+                    po (n + 1) ls'
+    in
+        po 0 ls
+        handle Fail _ => raise Fail ("Unnset.positionOf("
+                                     ^ Int.toString x
+                                     ^ ", "
+                                     ^ String.concatWith ";" (map Int.toString ls)
+                                     ^ ")")
+    end
+
+fun squishCon cfv =
+    U.Con.mapB {kind = fn k => k,
+                con = fn cb => fn c =>
+                                  case c of
+                                      CRel n =>
+                                      if n >= cb then
+                                          CRel (positionOf (n - cb) cfv + cb)
+                                      else
+                                          c
+                                    | _ => c,
+                bind = fn (cb, b) =>
+                          case b of
+                              U.Con.Rel _ => cb + 1
+                            | _ => cb}
+               0
+
+fun squishExp (nr, cfv, efv) =
+    U.Exp.mapB {kind = fn k => k,
+                con = fn (cb, eb) => fn c =>
+                                        case c of
+                                            CRel n =>
+                                            if n >= cb then
+                                                CRel (positionOf (n - cb) cfv + cb)
+                                            else
+                                                c
+                                          | _ => c,
+                exp = fn (cb, eb) => fn e =>
+                                        case e of
+                                            ERel n =>
+                                            if n >= eb then
+                                                 ERel (positionOf (n - eb) efv + eb)
+                                            else
+                                                e
+                                          | _ => e,
+                bind = fn (ctx as (cb, eb), b) =>
+                          case b of
+                              U.Exp.RelC _ => (cb + 1, eb)
+                            | U.Exp.RelE _ => (cb, eb + 1)
+                            | _ => ctx}
+               (0, nr)
+
+type state = {
+     maxName : int,
+     decls : decl list
+}
+
+fun kind (k, st) = (k, st)
+
+fun exp ((ks, ts), e, st : state) =
+    case e of
+        ELet (eds, e) =>
+        let
+            val doSubst = foldl (fn (p, e) => E.subExpInExp p e)
+
+            val (eds, (maxName, ds, subs)) =
+                ListUtil.foldlMapConcat
+                (fn (ed, (maxName, ds, subs)) =>
+                    case #1 ed of
+                        EDVal _ => ([ed], (maxName, ds, map (fn (n, e) => (n + 1, E.liftExpInExp 0 e)) subs))
+                      | EDValRec vis =>
+                        let
+                            val loc = #2 ed
+
+                            val nr = length vis
+                            val (cfv, efv) = foldl (fn ((_, t, e), (cfv, efv)) =>
+                                                       let
+                                                           val (cfv', efv') = fvsExp nr e
+                                                           (*val () = Print.prefaces "fvsExp"
+                                                                    [("e", ElabPrint.p_exp E.empty e),
+                                                                     ("cfv", Print.PD.string
+                                                                                 (Int.toString (IS.numItems cfv'))),
+                                                                     ("efv", Print.PD.string
+                                                                                 (Int.toString (IS.numItems efv')))]*)
+                                                           val cfv'' = fvsCon t
+                                                       in
+                                                           (IS.union (cfv, IS.union (cfv', cfv'')),
+                                                            IS.union (efv, efv'))
+                                                       end)
+                                                   (IS.empty, IS.empty) vis
+
+                            (*val () = print ("A: " ^ Int.toString (length ts) ^ ", " ^ Int.toString (length ks) ^ "\n")*)
+                            val cfv = IS.foldl (fn (x, cfv) =>
+                                                   let
+                                                       (*val () = print (Int.toString x ^ "\n")*)
+                                                       val (_, t) = List.nth (ts, x)
+                                                   in
+                                                       IS.union (cfv, fvsCon t)
+                                                   end)
+                                               cfv efv
+                            (*val () = print "B\n"*)
+
+                            val (vis, maxName) =
+                                ListUtil.foldlMap (fn ((x, t, e), maxName) =>
+                                                      ((x, maxName, t, e),
+                                                       maxName + 1))
+                                maxName vis
+
+                            fun apply e =
+                                let
+                                    val e = IS.foldl (fn (x, e) =>
+                                                         (ECApp (e, (CRel x, loc)), loc))
+                                            e cfv
+                                in
+                                    IS.foldl (fn (x, e) =>
+                                                 (EApp (e, (ERel x, loc)), loc))
+                                             e efv
+                                end
+
+                            val subs = map (fn (n, e) => (n + nr, E.liftExpInExp nr e)) subs
+
+                            val subs' = ListUtil.mapi (fn (i, (_, n, _, _)) =>
+                                                          let
+                                                              val e = apply (ENamed n, loc)
+                                                          in
+                                                              (0, E.liftExpInExp (nr - i - 1) e)
+                                                          end)
+                                            vis
+                            val subs' = rev subs'
+
+                            val cfv = IS.listItems cfv
+                            val efv = IS.listItems efv
+                            val efn = length efv
+
+                            (*val subsInner = subs
+                                            @ map (fn (i, e) =>
+                                                      (i + efn,
+                                                       E.liftExpInExp efn e)) subs'*)
+
+                            val subs = subs @ subs'
+
+                            val vis = map (fn (x, n, t, e) =>
+                                              let
+                                                  (*val () = Print.prefaces "preSubst"
+                                                                          [("e", ElabPrint.p_exp E.empty e)]*)
+                                                  val e = doSubst e subs(*Inner*)
+
+                                                  (*val () = Print.prefaces "squishCon"
+                                                                          [("t", ElabPrint.p_con E.empty t)]*)
+                                                  val t = squishCon cfv t
+                                                  (*val () = Print.prefaces "squishExp"
+                                                                          [("e", ElabPrint.p_exp E.empty e)]*)
+                                                  val e = squishExp (nr, cfv, efv) e
+
+                                                  val (e, t) = foldr (fn (ex, (e, t)) =>
+                                                                         let
+                                                                             val (name, t') = List.nth (ts, ex)
+                                                                         in
+                                                                             ((EAbs (name,
+                                                                                     t',
+                                                                                     t,
+                                                                                     e), loc),
+                                                                              (TFun (t',
+                                                                                     t), loc))
+                                                                         end)
+                                                                     (e, t) efv
+
+                                                  val (e, t) = foldr (fn (cx, (e, t)) =>
+                                                                         let
+                                                                             val (name, k) = List.nth (ks, cx)
+                                                                         in
+                                                                             ((ECAbs (Explicit,
+                                                                                      name,
+                                                                                      k,
+                                                                                      e), loc),
+                                                                              (TCFun (Explicit,
+                                                                                      name,
+                                                                                      k,
+                                                                                      t), loc))
+                                                                         end)
+                                                                     (e, t) cfv
+                                              in
+                                                  (x, n, t, e)
+                                              end)
+                                          vis
+
+                            val d = (DValRec vis, #2 ed)
+                        in
+                            ([], (maxName, d :: ds, subs))
+                        end)
+                (#maxName st, #decls st, []) eds
+        in
+            (ELet (eds, doSubst e subs),
+             {maxName = maxName,
+              decls = ds})
+        end
+
+      | _ => (e, st)
+
+fun default (ctx, d, st) = (d, st)
+
+fun bind ((ks, ts), b) =
+    case b of
+        U.Decl.RelC p => (p :: ks, map (fn (name, t) => (name, E.liftConInCon 0 t)) ts)
+      | U.Decl.RelE p => (ks, p :: ts)
+      | _ => (ks, ts)                        
+
+val unnestDecl = U.Decl.foldMapB {kind = kind,
+                                  con = default,
+                                  exp = exp,
+                                  sgn_item = default,
+                                  sgn = default,
+                                  str = default,
+                                  decl = default,
+                                  bind = bind}
+                                 ([], [])
+
+fun unnest file =
+    let
+        fun doDecl (all as (d, loc), st : state) =
+            let
+                fun default () = ([all], st)
+                fun explore () =
+                    let
+                        val (d, st) = unnestDecl st all
+                    in
+                        (rev (d :: #decls st),
+                         {maxName = #maxName st,
+                          decls = []})
+                    end
+            in
+                case d of
+                    DCon _ => default ()
+                  | DDatatype _ => default ()
+                  | DDatatypeImp _ => default ()
+                  | DVal _ => explore ()
+                  | DValRec _ => explore ()
+                  | DSgn _ => default ()
+                  | DStr (x, n, sgn, str) =>
+                    let
+                        val (str, st) = doStr (str, st)
+                    in
+                        ([(DStr (x, n, sgn, str), loc)], st)
+                    end
+                  | DFfiStr _ => default ()
+                  | DConstraint _ => default ()
+                  | DExport _ => default ()
+                  | DTable _ => default ()
+                  | DSequence _ => default ()
+                  | DClass _ => default ()
+                  | DDatabase _ => default ()
+            end
+
+        and doStr (all as (str, loc), st) =
+            let
+                fun default () = (all, st)
+            in
+                case str of
+                    StrConst ds =>
+                    let
+                        val (ds, st) = ListUtil.foldlMapConcat doDecl st ds
+                    in
+                        ((StrConst ds, loc), st)
+                    end
+                  | StrVar _ => default ()
+                  | StrProj _ => default ()
+                  | StrFun (x, n, dom, ran, str) =>
+                    let
+                        val (str, st) = doStr (str, st)
+                    in
+                        ((StrFun (x, n, dom, ran, str), loc), st)
+                    end
+                  | StrApp _ => default ()
+                  | StrError => raise Fail "Unnest: StrError"
+            end
+
+        val (ds, _) = ListUtil.foldlMapConcat doDecl
+                      {maxName = U.File.maxName file + 1,
+                       decls = []} file
+    in
+        ds
+    end
+
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/nest.ur	Sat Nov 01 15:58:55 2008 -0400
@@ -0,0 +1,41 @@
+fun add x =
+    let
+        fun add' y = x + y
+    in
+        add' 1 + add' 2
+    end
+
+fun f (x : int) =
+    let
+        fun page () = return <xml><body>
+          <a link={page ()}>{[x]}</a>
+        </body></xml>
+    in
+        page
+    end
+
+fun f (x : int) =
+    let
+        fun page1 () = return <xml><body>
+          <a link={page2 ()}>{[x]}</a>
+        </body></xml>
+
+        and page2 () =
+            case Some True of
+                Some r => return <xml><body><a link={page1 ()}>{[r]}</a></body></xml>
+              | _ => return <xml>Error</xml>
+    in
+        page1
+    end
+
+datatype list t = Nil | Cons of t * list t
+
+fun length (t ::: Type) (ls : list t) =
+    let
+        fun length' ls acc =
+            case ls of
+                Nil => acc
+              | Cons (_, ls') => length' ls' (acc + 1)
+    in
+        length' ls 0
+    end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/nest.urp	Sat Nov 01 15:58:55 2008 -0400
@@ -0,0 +1,3 @@
+debug
+
+nest