# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1225572376 14400
# Node ID 07f6576aeb0af418f4f0a5aa6abedceb6fbdd348
# Parent  89f766f19d5bf6fb2f4801f0f90b737a0f40f7ba
Wrapping works in Blog

diff -r 89f766f19d5b -r 07f6576aeb0a src/core.sml
--- a/src/core.sml	Sat Nov 01 16:08:39 2008 -0400
+++ b/src/core.sml	Sat Nov 01 16:46:16 2008 -0400
@@ -103,6 +103,8 @@
 
        | EClosure of int * exp list
 
+       | ELet of string * con * exp * exp
+
 withtype exp = exp' located
 
 datatype export_kind =
diff -r 89f766f19d5b -r 07f6576aeb0a src/core_print.sml
--- a/src/core_print.sml	Sat Nov 01 16:08:39 2008 -0400
+++ b/src/core_print.sml	Sat Nov 01 16:46:16 2008 -0400
@@ -362,6 +362,21 @@
                                                                       p_exp env e]) es,
                                  string ")"]
 
+      | ELet (x, t, e1, e2) => box [string "let",
+                                    space,
+                                    string x,
+                                    space,
+                                    string ":",
+                                    p_con env t,
+                                    space,
+                                    string "=",
+                                    space,
+                                    p_exp env e1,
+                                    space,
+                                    string "in",
+                                    newline,
+                                    p_exp (E.pushERel env x t) e2]
+
 and p_exp env = p_exp' false env
 
 fun p_named x n =
diff -r 89f766f19d5b -r 07f6576aeb0a src/core_util.sml
--- a/src/core_util.sml	Sat Nov 01 16:08:39 2008 -0400
+++ b/src/core_util.sml	Sat Nov 01 16:46:16 2008 -0400
@@ -487,6 +487,15 @@
                      fn es' =>
                         (EClosure (n, es'), loc))
 
+              | ELet (x, t, e1, e2) =>
+                S.bind2 (mfc ctx t,
+                         fn t' =>
+                            S.bind2 (mfe ctx e1,
+                                  fn e1' =>
+                                     S.map2 (mfe ctx e2,
+                                          fn e2' =>
+                                             (ELet (x, t', e1', e2'), loc))))
+
         and mfp ctx (pAll as (p, loc)) =
             case p of
                 PWild => S.return2 pAll
diff -r 89f766f19d5b -r 07f6576aeb0a src/corify.sml
--- a/src/corify.sml	Sat Nov 01 16:08:39 2008 -0400
+++ b/src/corify.sml	Sat Nov 01 16:46:16 2008 -0400
@@ -580,6 +580,8 @@
 
       | L.EWrite e => (L'.EWrite (corifyExp st e), loc)
 
+      | L.ELet (x, t, e1, e2) => (L'.ELet (x, corifyCon st t, corifyExp st e1, corifyExp st e2), loc)
+
 fun corifyDecl mods ((d, loc : EM.span), st) =
     case d of
         L.DCon (x, n, k, c) =>
diff -r 89f766f19d5b -r 07f6576aeb0a src/monoize.sml
--- a/src/monoize.sml	Sat Nov 01 16:08:39 2008 -0400
+++ b/src/monoize.sml	Sat Nov 01 16:46:16 2008 -0400
@@ -1954,6 +1954,15 @@
             in
                 ((L'.EClosure (n, es), loc), fm)
             end
+
+          | L.ELet (x, t, e1, e2) =>
+            let
+                val t' = monoType env t
+                val (e1, fm) = monoExp (env, st, fm) e1
+                val (e2, fm) = monoExp (Env.pushERel env x t, st, fm) e2
+            in
+                ((L'.ELet (x, t', e1, e2), loc), fm)
+            end
     end
 
 fun monoDecl (env, fm) (all as (d, loc)) =
diff -r 89f766f19d5b -r 07f6576aeb0a src/unnest.sml
--- a/src/unnest.sml	Sat Nov 01 16:08:39 2008 -0400
+++ b/src/unnest.sml	Sat Nov 01 16:46:16 2008 -0400
@@ -206,29 +206,31 @@
 
                             val subs' = ListUtil.mapi (fn (i, (_, n, _, _)) =>
                                                           let
-                                                              val e = apply (ENamed n, loc)
+                                                              val dummy = (EError, ErrorMsg.dummySpan)
+                                                                          
+                                                              fun repeatLift k =
+                                                                  if k = 0 then
+                                                                      apply (ENamed n, loc)
+                                                                  else
+                                                                      E.liftExpInExp 0 (repeatLift (k - 1))
                                                           in
-                                                              (0, E.liftExpInExp (nr - i - 1) e)
+                                                              (0, repeatLift i)
                                                           end)
-                                            vis
+                                                      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 e = doSubst e subs
 
                                                   (*val () = Print.prefaces "squishCon"
                                                                           [("t", ElabPrint.p_con E.empty t)]*)
diff -r 89f766f19d5b -r 07f6576aeb0a tests/nest.ur
--- a/tests/nest.ur	Sat Nov 01 16:08:39 2008 -0400
+++ b/tests/nest.ur	Sat Nov 01 16:46:16 2008 -0400
@@ -25,7 +25,24 @@
                 Some r => return <xml><body><a link={page1 ()}>{[r]}</a></body></xml>
               | _ => return <xml>Error</xml>
     in
-        page1
+        page2
+    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><body><a link={page3 ()}>!!</a></body></xml>
+
+        and page3 () = return <xml><body><a link={page2 ()}>!</a><a link={page1 ()}>!</a>
+          <a link={page3 ()}>!</a></body></xml>
+    in
+        page3
     end
 
 datatype list t = Nil | Cons of t * list t
@@ -39,3 +56,4 @@
     in
         length' ls 0
     end
+