Mercurial > urweb
changeset 450:07f6576aeb0a
Wrapping works in Blog
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Sat, 01 Nov 2008 16:46:16 -0400 |
| parents | 89f766f19d5b |
| children | 1bd575eb2d1e |
| files | src/core.sml src/core_print.sml src/core_util.sml src/corify.sml src/monoize.sml src/unnest.sml tests/nest.ur |
| diffstat | 7 files changed, 67 insertions(+), 10 deletions(-) [+] |
line wrap: on
line diff
--- 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 =
--- 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 =
--- 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
--- 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) =>
--- 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)) =
--- 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)]*)
--- 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 +