Mercurial > urweb

comparison src/mono_opt.sml @ 495:98f85c1bc867

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Fix type calculation for applying-a-case optimization
author Adam Chlipala <adamc@hcoop.net>
date Tue, 11 Nov 2008 20:24:55 -0500
parents 8e055bbbd28b
children 65d8541c130b
comparison
equal deleted inserted replaced
494:1bbcc3345d12 495:98f85c1bc867
290 optExp (ECase (discE, 290 optExp (ECase (discE,
291 map (fn (p, e) => (p, (EWrite e, loc))) pes, 291 map (fn (p, e) => (p, (EWrite e, loc))) pes,
292 {disc = disc, 292 {disc = disc,
293 result = (TRecord [], loc)}), loc) 293 result = (TRecord [], loc)}), loc)
294 294
295 | EApp ((ECase (discE, pes, {disc, ...}), loc), arg as (ERecord [], _)) => 295 | EApp ((ECase (discE, pes, {disc, result = (TFun (_, ran), _)}), loc), arg as (ERecord [], _)) =>
296 let 296 let
297 fun doBody e = 297 fun doBody e =
298 case #1 e of 298 case #1 e of
299 EAbs (_, _, _, body) => MonoReduce.subExpInExp (0, arg) body 299 EAbs (_, _, _, body) => MonoReduce.subExpInExp (0, arg) body
300 | _ => (EApp (e, arg), loc) 300 | _ => (EApp (e, arg), loc)
301 in 301 in
302 optExp (ECase (discE, 302 optExp (ECase (discE,
303 map (fn (p, e) => (p, doBody e)) pes, 303 map (fn (p, e) => (p, doBody e)) pes,
304 {disc = disc, 304 {disc = disc,
305 result = (TRecord [], loc)}), loc) 305 result = ran}), loc)
306 end 306 end
307 307
308 | EWrite (EQuery {exps, tables, state, query, 308 | EWrite (EQuery {exps, tables, state, query,
309 initial = (EPrim (Prim.String ""), _), 309 initial = (EPrim (Prim.String ""), _),
310 body = (EStrcat ((EPrim (Prim.String s), _), 310 body = (EStrcat ((EPrim (Prim.String s), _),