Mercurial > urweb

comparison src/unnest.sml @ 1272:56bd4a4f6e66

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Some serious bug-fix work to get HTML example to compile; this includes fixing a bug with 'val' patterns in Unnest and the need for more local reduction in Especialize
author Adam Chlipala <adamc@hcoop.net>
date Thu, 03 Jun 2010 13:04:37 -0400
parents c316ca3c9ec6
children b4480a56cab7
comparison
equal deleted inserted replaced
1271:503d4ec93494 1272:56bd4a4f6e66
1 (* Copyright (c) 2008, Adam Chlipala 1 (* Copyright (c) 2008-2010, Adam Chlipala
2 * All rights reserved. 2 * All rights reserved.
3 * 3 *
4 * Redistribution and use in source and binary forms, with or without 4 * Redistribution and use in source and binary forms, with or without
5 * modification, are permitted provided that the following conditions are met: 5 * modification, are permitted provided that the following conditions are met:
6 * 6 *
202 | PCon (_, _, _, NONE) => ts 202 | PCon (_, _, _, NONE) => ts
203 | PCon (_, _, _, SOME p) => doVars (p, ts) 203 | PCon (_, _, _, SOME p) => doVars (p, ts)
204 | PRecord xpcs => 204 | PRecord xpcs =>
205 foldl (fn ((_, p, _), ts) => doVars (p, ts)) 205 foldl (fn ((_, p, _), ts) => doVars (p, ts))
206 ts xpcs 206 ts xpcs
207
208 fun bindOne subs = ((0, (ERel 0, #2 ed))
209 :: map (fn (n, e) => (n + 1, E.liftExpInExp 0 e)) subs)
210
211 fun bindMany (n, subs) =
212 case n of
213 0 => subs
214 | _ => bindMany (n - 1, bindOne subs)
207 in 215 in
208 ([(EDVal (p, t, e), #2 ed)], 216 ([(EDVal (p, t, e), #2 ed)],
209 (doVars (p, ts), 217 (doVars (p, ts),
210 maxName, ds, 218 maxName, ds,
211 ((0, (ERel 0, #2 ed)) 219 bindMany (E.patBindsN p, subs),
212 :: map (fn (n, e) => (n + 1, E.liftExpInExp 0 e)) subs),
213 by)) 220 by))
214 end 221 end
215 | EDValRec vis => 222 | EDValRec vis =>
216 let 223 let
217 val loc = #2 ed 224 val loc = #2 ed
308 (*val () = print ("Avail: " ^ Int.toString (length ts) ^ "\n")*) 315 (*val () = print ("Avail: " ^ Int.toString (length ts) ^ "\n")*)
309 val (e, t) = foldl (fn (ex, (e, t)) => 316 val (e, t) = foldl (fn (ex, (e, t)) =>
310 let 317 let
311 (*val () = print (Int.toString ex ^ "\n")*) 318 (*val () = print (Int.toString ex ^ "\n")*)
312 val (name, t') = List.nth (ts, ex) 319 val (name, t') = List.nth (ts, ex)
320 val t' = squishCon cfv t'
313 in 321 in
314 ((EAbs (name, 322 ((EAbs (name,
315 t', 323 t',
316 t, 324 t,
317 e), loc), 325 e), loc),
352 val e' = doSubst (e, subs, by) 360 val e' = doSubst (e, subs, by)
353 in 361 in
354 (*Print.prefaces "Before" [("e", ElabPrint.p_exp ElabEnv.empty e), 362 (*Print.prefaces "Before" [("e", ElabPrint.p_exp ElabEnv.empty e),
355 ("se", ElabPrint.p_exp ElabEnv.empty (doSubst' (e, subs))), 363 ("se", ElabPrint.p_exp ElabEnv.empty (doSubst' (e, subs))),
356 ("e'", ElabPrint.p_exp ElabEnv.empty e')];*) 364 ("e'", ElabPrint.p_exp ElabEnv.empty e')];*)
365 (*Print.prefaces "Let" [("Before", ElabPrint.p_exp ElabEnv.empty (old, ErrorMsg.dummySpan)),
366 ("After", ElabPrint.p_exp ElabEnv.empty (ELet (eds, e', t), ErrorMsg.dummySpan))];*)
357 (ELet (eds, e', t), 367 (ELet (eds, e', t),
358 {maxName = maxName, 368 {maxName = maxName,
359 decls = ds}) 369 decls = ds})
360 (*(ELet (eds, doSubst (liftExpInExp (~(length subs - numRemaining)) (length subs) e) subs),*) 370 (*(ELet (eds, doSubst (liftExpInExp (~(length subs - numRemaining)) (length subs) e) subs),*)
361 end 371 end