adamc@23: (* Copyright (c) 2008, Adam Chlipala adamc@23: * All rights reserved. adamc@23: * adamc@23: * Redistribution and use in source and binary forms, with or without adamc@23: * modification, are permitted provided that the following conditions are met: adamc@23: * adamc@23: * - Redistributions of source code must retain the above copyright notice, adamc@23: * this list of conditions and the following disclaimer. adamc@23: * - Redistributions in binary form must reproduce the above copyright notice, adamc@23: * this list of conditions and the following disclaimer in the documentation adamc@23: * and/or other materials provided with the distribution. adamc@23: * - The names of contributors may not be used to endorse or promote products adamc@23: * derived from this software without specific prior written permission. adamc@23: * adamc@23: * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" adamc@23: * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE adamc@23: * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE adamc@23: * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE adamc@23: * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR adamc@23: * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF adamc@23: * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS adamc@23: * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN adamc@23: * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) adamc@23: * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE adamc@23: * POSSIBILITY OF SUCH DAMAGE. adamc@23: *) adamc@23: adamc@23: (* Remove unused definitions from a file *) adamc@23: adamc@23: structure Shake :> SHAKE = struct adamc@23: adamc@23: open Core adamc@23: adamc@23: structure U = CoreUtil adamc@23: adamc@23: structure IS = IntBinarySet adamc@23: structure IM = IntBinaryMap adamc@23: adamc@23: type free = { adamc@23: con : IS.set, adamc@23: exp : IS.set adamc@23: } adamc@23: adamc@338: val dummyt = (TRecord (CRecord ((KType, ErrorMsg.dummySpan), []), ErrorMsg.dummySpan), ErrorMsg.dummySpan) adamc@247: val dummye = (EPrim (Prim.String ""), ErrorMsg.dummySpan) adamc@247: adamc@23: fun shake file = adamc@100: let adamc@248: val (page_es, table_cs) = adamc@248: List.foldl adamc@248: (fn ((DExport (_, n), _), (page_es, table_cs)) => (n :: page_es, table_cs) adamc@248: | ((DTable (_, _, c, _), _), (page_es, table_cs)) => (page_es, c :: table_cs) adamc@248: | (_, acc) => acc) ([], []) file adamc@23: adamc@163: val (cdef, edef) = foldl (fn ((DCon (_, n, _, c), _), (cdef, edef)) => (IM.insert (cdef, n, [c]), edef) adamc@192: | ((DDatatype (_, n, _, xncs), _), (cdef, edef)) => adamc@163: (IM.insert (cdef, n, List.mapPartial #3 xncs), edef) adamc@109: | ((DVal (_, n, t, e, _), _), (cdef, edef)) => (cdef, IM.insert (edef, n, (t, e))) adamc@125: | ((DValRec vis, _), (cdef, edef)) => adamc@125: (cdef, foldl (fn ((_, n, t, e, _), edef) => IM.insert (edef, n, (t, e))) edef vis) adamc@247: | ((DExport _, _), acc) => acc adamc@247: | ((DTable (_, n, c, _), _), (cdef, edef)) => adamc@271: (cdef, IM.insert (edef, n, (c, dummye))) adamc@338: | ((DSequence (_, n, _), _), (cdef, edef)) => adamc@338: (cdef, IM.insert (edef, n, (dummyt, dummye))) adamc@271: | ((DDatabase _, _), acc) => acc) adamc@100: (IM.empty, IM.empty) file adamc@23: adamc@100: fun kind (_, s) = s adamc@23: adamc@100: fun con (c, s) = adamc@100: case c of adamc@100: CNamed n => adamc@100: if IS.member (#con s, n) then adamc@100: s adamc@100: else adamc@100: let adamc@100: val s' = {con = IS.add (#con s, n), adamc@100: exp = #exp s} adamc@100: in adamc@100: case IM.find (cdef, n) of adamc@100: NONE => s' adamc@163: | SOME cs => foldl (fn (c, s') => shakeCon s' c) s' cs adamc@100: end adamc@100: | _ => s adamc@23: adamc@100: and shakeCon s = U.Con.fold {kind = kind, con = con} s adamc@23: adamc@100: fun exp (e, s) = adamc@100: case e of adamc@100: ENamed n => adamc@100: if IS.member (#exp s, n) then adamc@100: s adamc@100: else adamc@100: let adamc@100: val s' = {exp = IS.add (#exp s, n), adamc@100: con = #con s} adamc@100: in adamc@100: case IM.find (edef, n) of adamc@100: NONE => s' adamc@100: | SOME (t, e) => shakeExp (shakeCon s' t) e adamc@100: end adamc@100: | _ => s adamc@23: adamc@100: and shakeExp s = U.Exp.fold {kind = kind, con = con, exp = exp} s adamc@100: adamc@109: val s = {con = IS.empty, exp = IS.addList (IS.empty, page_es)} adamc@109: adamc@109: val s = foldl (fn (n, s) => adamc@109: case IM.find (edef, n) of adamc@109: NONE => raise Fail "Shake: Couldn't find 'val'" adamc@109: | SOME (t, e) => shakeExp (shakeCon s t) e) s page_es adamc@248: adamc@248: val s = foldl (fn (c, s) => shakeCon s c) s table_cs adamc@100: in adamc@100: List.filter (fn (DCon (_, n, _, _), _) => IS.member (#con s, n) adamc@192: | (DDatatype (_, n, _, _), _) => IS.member (#con s, n) adamc@109: | (DVal (_, n, _, _, _), _) => IS.member (#exp s, n) adamc@125: | (DValRec vis, _) => List.exists (fn (_, n, _, _, _) => IS.member (#exp s, n)) vis adamc@247: | (DExport _, _) => true adamc@271: | (DTable _, _) => true adamc@338: | (DSequence _, _) => true adamc@271: | (DDatabase _, _) => true) file adamc@100: end adamc@23: adamc@23: end