From 2293837a835850d221f6e6623f1f845220ff24c3 Mon Sep 17 00:00:00 2001 From: Karn Kallio Date: Fri, 12 Aug 2011 23:07:28 -0530 Subject: Handle case where shakeExp can remove datatype. --- src/mono_shake.sml | 69 ++++++++++++++++++++++++++++++------------------------ 1 file changed, 39 insertions(+), 30 deletions(-) (limited to 'src/mono_shake.sml') diff --git a/src/mono_shake.sml b/src/mono_shake.sml index d8baf07e..7eb66705 100644 --- a/src/mono_shake.sml +++ b/src/mono_shake.sml @@ -43,36 +43,6 @@ type free = { fun shake file = let - val usedVars = U.Exp.fold {typ = fn (c, st as (cs, es)) => - case c of - TDatatype (n, _) => (IS.add (cs, n), es) - | _ => st, - exp = fn (e, st as (cs, es)) => - case e of - ENamed n => (cs, IS.add (es, n)) - | _ => st} - - val (page_cs, page_es) = - List.foldl - (fn ((DExport (_, _, n, _, _, _), _), (page_cs, page_es)) => (page_cs, IS.add (page_es, n)) - | ((DDatabase {expunge = n1, initialize = n2, ...}, _), (page_cs, page_es)) => - (page_cs, IS.addList (page_es, [n1, n2])) - | ((DTask (e1, e2), _), st) => usedVars (usedVars st e2) e1 - | ((DView (_, _, e), _), st) => usedVars st e - | ((DPolicy pol, _), st) => - let - val e1 = case pol of - PolClient e1 => e1 - | PolInsert e1 => e1 - | PolDelete e1 => e1 - | PolUpdate e1 => e1 - | PolSequence e1 => e1 - in - usedVars st e1 - end - | ((DOnError n, _), (page_cs, page_es)) => (page_cs, IS.add (page_es, n)) - | (_, st) => st) (IS.empty, IS.empty) file - val (cdef, edef) = foldl (fn ((DDatatype dts, _), (cdef, edef)) => (foldl (fn ((_, n, xncs), cdef) => IM.insert (cdef, n, xncs)) cdef dts, edef) | ((DVal (_, n, t, e, _), _), (cdef, edef)) => @@ -132,6 +102,45 @@ fun shake file = and shakeExp s = U.Exp.fold {typ = typ, exp = exp} s +(* + val usedVars = U.Exp.fold {typ = fn (c, st as (cs, es)) => + case c of + TDatatype (n, _) => (IS.add (cs, n), es) + | _ => st, + exp = fn (e, st as (cs, es)) => + case e of + ENamed n => (cs, IS.add (es, n)) + | _ => st} +*) + + fun usedVars (cs, es) e = + let + val {con = cs', exp = es'} = shakeExp {con = cs, exp = es} e + in + (cs', es') + end + + val (page_cs, page_es) = + List.foldl + (fn ((DExport (_, _, n, _, _, _), _), (page_cs, page_es)) => (page_cs, IS.add (page_es, n)) + | ((DDatabase {expunge = n1, initialize = n2, ...}, _), (page_cs, page_es)) => + (page_cs, IS.addList (page_es, [n1, n2])) + | ((DTask (e1, e2), _), st) => usedVars (usedVars st e2) e1 + | ((DView (_, _, e), _), st) => usedVars st e + | ((DPolicy pol, _), st) => + let + val e1 = case pol of + PolClient e1 => e1 + | PolInsert e1 => e1 + | PolDelete e1 => e1 + | PolUpdate e1 => e1 + | PolSequence e1 => e1 + in + usedVars st e1 + end + | ((DOnError n, _), (page_cs, page_es)) => (page_cs, IS.add (page_es, n)) + | (_, st) => st) (IS.empty, IS.empty) file + val s = {con = page_cs, exp = page_es} val s = IS.foldl (fn (n, s) => -- cgit v1.2.3