Mercurial > urweb

comparison src/mono_reduce.sml @ 694:7ea0df9e56b6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
spawn
author Adam Chlipala <adamc@hcoop.net>
date Sat, 04 Apr 2009 14:55:36 -0400
parents 01b6f2ee2ef0
children 500e93aa436f
comparison
equal deleted inserted replaced
693:655bcc9b77e0 694:7ea0df9e56b6
59 | EFfiApp ("Basis", "set_client_source", _) => true 59 | EFfiApp ("Basis", "set_client_source", _) => true
60 | EFfiApp ("Basis", "alert", _) => true 60 | EFfiApp ("Basis", "alert", _) => true
61 | EFfiApp ("Basis", "new_channel", _) => true 61 | EFfiApp ("Basis", "new_channel", _) => true
62 | EFfiApp ("Basis", "subscribe", _) => true 62 | EFfiApp ("Basis", "subscribe", _) => true
63 | EFfiApp ("Basis", "send", _) => true 63 | EFfiApp ("Basis", "send", _) => true
64 | EFfiApp ("Basis", "recv", _) => true
64 | EFfiApp _ => false 65 | EFfiApp _ => false
65 | EApp ((EFfi _, _), _) => false 66 | EApp ((EFfi _, _), _) => false
66 | EApp _ => true 67 | EApp _ => true
67 68
68 | EUnop (_, e) => impure e 69 | EUnop (_, e) => impure e
279 | EFfiApp ("Basis", "set_client_source", es) => ffi es 280 | EFfiApp ("Basis", "set_client_source", es) => ffi es
280 | EFfiApp ("Basis", "alert", es) => ffi es 281 | EFfiApp ("Basis", "alert", es) => ffi es
281 | EFfiApp ("Basis", "new_channel", es) => ffi es 282 | EFfiApp ("Basis", "new_channel", es) => ffi es
282 | EFfiApp ("Basis", "subscribe", es) => ffi es 283 | EFfiApp ("Basis", "subscribe", es) => ffi es
283 | EFfiApp ("Basis", "send", es) => ffi es 284 | EFfiApp ("Basis", "send", es) => ffi es
285 | EFfiApp ("Basis", "recv", es) => ffi es
284 | EFfiApp (_, _, es) => List.concat (map (summarize d) es) 286 | EFfiApp (_, _, es) => List.concat (map (summarize d) es)
285 | EApp ((EFfi _, _), e) => summarize d e 287 | EApp ((EFfi _, _), e) => summarize d e
286 | EApp _ => 288 | EApp _ =>
287 let 289 let
288 fun unravel (e, ls) = 290 fun unravel (e, passed, ls) =
289 case e of 291 case e of
290 ENamed n => 292 ENamed n =>
291 let 293 let
292 val ls = rev ls 294 val ls = rev ls
293 in 295 in
294 case IM.find (absCounts, n) of 296 case IM.find (absCounts, n) of
295 NONE => [Unsure] 297 NONE => [Unsure]
296 | SOME len => 298 | SOME len =>
297 if length ls < len then 299 if passed < len then
298 ls 300 ls
299 else 301 else
300 [Unsure] 302 ls @ [Unsure]
301 end 303 end
302 | ERel n => List.revAppend (ls, 304 | ERel n => List.revAppend (ls,
303 if n = d then 305 if n = d then
304 [UseRel, Unsure] 306 [UseRel, Unsure]
305 else 307 else
306 [Unsure]) 308 [Unsure])
307 | EApp (f, x) => 309 | EApp (f, x) =>
308 unravel (#1 f, summarize d x @ ls) 310 unravel (#1 f, passed + 1, summarize d x @ ls)
309 | _ => [Unsure] 311 | _ => [Unsure]
310 in 312 in
311 unravel (e, []) 313 unravel (e, 0, [])
312 end 314 end
313 315
314 | EAbs (_, _, _, e) => List.filter (fn UseRel => true 316 | EAbs (_, _, _, e) => List.filter (fn UseRel => true
315 | _ => false) (summarize (d + 1) e) 317 | _ => false) (summarize (d + 1) e)
316 318
384 #1 e') 386 #1 e')
385 | _ => e) 387 | _ => e)
386 388
387 | EApp ((EAbs (x, t, _, e1), loc), e2) => 389 | EApp ((EAbs (x, t, _, e1), loc), e2) =>
388 ((*Print.prefaces "Considering" [("e1", MonoPrint.p_exp (E.pushERel env x t NONE) e1), 390 ((*Print.prefaces "Considering" [("e1", MonoPrint.p_exp (E.pushERel env x t NONE) e1),
389 ("e2", MonoPrint.p_exp env e2), 391 ("e2", MonoPrint.p_exp env e2),
390 ("sub", MonoPrint.p_exp env (reduceExp env (subExpInExp (0, e2) e1)))];*) 392 ("sub", MonoPrint.p_exp env (reduceExp env (subExpInExp (0, e2) e1)))];*)
391 if impure e2 then 393 if impure e2 then
392 #1 (reduceExp env (ELet (x, t, e2, e1), loc)) 394 #1 (reduceExp env (ELet (x, t, e2, e1), loc))
393 else 395 else
394 #1 (reduceExp env (subExpInExp (0, e2) e1))) 396 #1 (reduceExp env (subExpInExp (0, e2) e1)))
395 397