Mercurial > urweb
view src/shake.sml @ 71:6431b315a1e3
Elaborate efold
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Thu, 26 Jun 2008 11:09:30 -0400 |
parents | 02f42e9a1825 |
children | f0f59e918cac |
line wrap: on
line source
(* Copyright (c) 2008, Adam Chlipala * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are met: * * - Redistributions of source code must retain the above copyright notice, * this list of conditions and the following disclaimer. * - Redistributions in binary form must reproduce the above copyright notice, * this list of conditions and the following disclaimer in the documentation * and/or other materials provided with the distribution. * - The names of contributors may not be used to endorse or promote products * derived from this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE * POSSIBILITY OF SUCH DAMAGE. *) (* Remove unused definitions from a file *) structure Shake :> SHAKE = struct open Core structure U = CoreUtil structure IS = IntBinarySet structure IM = IntBinaryMap type free = { con : IS.set, exp : IS.set } fun shake file = case List.foldl (fn ((DVal ("main", n, t, e), _), _) => SOME (n, t, e) | (_, s) => s) NONE file of NONE => [] | SOME (main, mainT, body) => let val (cdef, edef) = foldl (fn ((DCon (_, n, _, c), _), (cdef, edef)) => (IM.insert (cdef, n, c), edef) | ((DVal (_, n, t, e), _), (cdef, edef)) => (cdef, IM.insert (edef, n, (t, e)))) (IM.empty, IM.empty) file fun kind (_, s) = s fun con (c, s) = case c of CNamed n => if IS.member (#con s, n) then s else let val s' = {con = IS.add (#con s, n), exp = #exp s} in case IM.find (cdef, n) of NONE => s' | SOME c => shakeCon s' c end | _ => s and shakeCon s = U.Con.fold {kind = kind, con = con} s fun exp (e, s) = case e of ENamed n => if IS.member (#exp s, n) then s else let val s' = {exp = IS.add (#exp s, n), con = #con s} in case IM.find (edef, n) of NONE => s' | SOME (t, e) => shakeExp (shakeCon s' t) e end | _ => s and shakeExp s = U.Exp.fold {kind = kind, con = con, exp = exp} s val s = {con = IS.empty, exp = IS.singleton main} val s = U.Con.fold {kind = kind, con = con} s mainT val s = U.Exp.fold {kind = kind, con = con, exp = exp} s body in List.filter (fn (DCon (_, n, _, _), _) => IS.member (#con s, n) | (DVal (_, n, _, _), _) => IS.member (#exp s, n)) file end end