Mercurial > urweb

annotate src/mono_shake.sml @ 305:55eedecb6c50

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Remove need to mention table name in expressions for UPDATE and DELETE
author Adam Chlipala <adamc@hcoop.net>
date Sun, 07 Sep 2008 14:30:32 -0400
parents 09c66a30ef32
children e976b187d73a
rev   line source
adamc@134 1 (* Copyright (c) 2008, Adam Chlipala
adamc@134 2 * All rights reserved.
adamc@134 3 *
adamc@134 4 * Redistribution and use in source and binary forms, with or without
adamc@134 5 * modification, are permitted provided that the following conditions are met:
adamc@134 6 *
adamc@134 7 * - Redistributions of source code must retain the above copyright notice,
adamc@134 8 * this list of conditions and the following disclaimer.
adamc@134 9 * - Redistributions in binary form must reproduce the above copyright notice,
adamc@134 10 * this list of conditions and the following disclaimer in the documentation
adamc@134 11 * and/or other materials provided with the distribution.
adamc@134 12 * - The names of contributors may not be used to endorse or promote products
adamc@134 13 * derived from this software without specific prior written permission.
adamc@134 14 *
adamc@134 15 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
adamc@134 16 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
adamc@134 17 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
adamc@134 18 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
adamc@134 19 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
adamc@134 20 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
adamc@134 21 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
adamc@134 22 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
adamc@134 23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
adamc@134 24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
adamc@134 25 * POSSIBILITY OF SUCH DAMAGE.
adamc@134 26 *)
adamc@134 27
adamc@134 28 (* Remove unused definitions from a file *)
adamc@134 29
adamc@134 30 structure MonoShake :> MONO_SHAKE = struct
adamc@134 31
adamc@134 32 open Mono
adamc@134 33
adamc@134 34 structure U = MonoUtil
adamc@134 35
adamc@134 36 structure IS = IntBinarySet
adamc@134 37 structure IM = IntBinaryMap
adamc@134 38
adamc@134 39 type free = {
adamc@134 40 con : IS.set,
adamc@134 41 exp : IS.set
adamc@134 42 }
adamc@134 43
adamc@134 44 fun shake file =
adamc@134 45 let
adamc@134 46 val page_es = List.foldl
adamc@144 47 (fn ((DExport (_, _, n, _), _), page_es) => n :: page_es
adamc@134 48 | (_, page_es) => page_es) [] file
adamc@134 49
adamc@178 50 val (cdef, edef) = foldl (fn ((DDatatype (_, n, xncs), _), (cdef, edef)) =>
adamc@178 51 (IM.insert (cdef, n, xncs), edef)
adamc@178 52 | ((DVal (_, n, t, e, _), _), (cdef, edef)) =>
adamc@178 53 (cdef, IM.insert (edef, n, (t, e)))
adamc@134 54 | ((DValRec vis, _), (cdef, edef)) =>
adamc@134 55 (cdef, foldl (fn ((_, n, t, e, _), edef) => IM.insert (edef, n, (t, e))) edef vis)
adamc@271 56 | ((DExport _, _), acc) => acc
adamc@273 57 | ((DTable _, _), acc) => acc
adamc@271 58 | ((DDatabase _, _), acc) => acc)
adamc@134 59 (IM.empty, IM.empty) file
adamc@134 60
adamc@164 61 fun typ (c, s) =
adamc@164 62 case c of
adamc@196 63 TDatatype (n, _) =>
adamc@164 64 if IS.member (#con s, n) then
adamc@164 65 s
adamc@164 66 else
adamc@178 67 let
adamc@178 68 val s' = {exp = #exp s,
adamc@178 69 con = IS.add (#con s, n)}
adamc@178 70 in
adamc@178 71 case IM.find (cdef, n) of
adamc@178 72 NONE => s'
adamc@178 73 | SOME xncs => foldl (fn ((_, _, to), s) =>
adamc@178 74 case to of
adamc@178 75 NONE => s
adamc@178 76 | SOME t => shakeTyp s t)
adamc@178 77 s' xncs
adamc@178 78 end
adamc@164 79 | _ => s
adamc@134 80
adamc@178 81 and shakeTyp s = U.Typ.fold typ s
adamc@178 82
adamc@134 83 fun exp (e, s) =
adamc@134 84 case e of
adamc@134 85 ENamed n =>
adamc@134 86 if IS.member (#exp s, n) then
adamc@134 87 s
adamc@134 88 else
adamc@134 89 let
adamc@134 90 val s' = {exp = IS.add (#exp s, n),
adamc@134 91 con = #con s}
adamc@134 92 in
adamc@134 93 case IM.find (edef, n) of
adamc@134 94 NONE => s'
adamc@134 95 | SOME (t, e) => shakeExp s' e
adamc@134 96 end
adamc@134 97 | _ => s
adamc@134 98
adamc@134 99 and shakeExp s = U.Exp.fold {typ = typ, exp = exp} s
adamc@134 100
adamc@134 101 val s = {con = IS.empty, exp = IS.addList (IS.empty, page_es)}
adamc@134 102
adamc@134 103 val s = foldl (fn (n, s) =>
adamc@134 104 case IM.find (edef, n) of
adamc@134 105 NONE => raise Fail "Shake: Couldn't find 'val'"
adamc@134 106 | SOME (t, e) => shakeExp s e) s page_es
adamc@134 107 in
adamc@164 108 List.filter (fn (DDatatype (_, n, _), _) => IS.member (#con s, n)
adamc@164 109 | (DVal (_, n, _, _, _), _) => IS.member (#exp s, n)
adamc@134 110 | (DValRec vis, _) => List.exists (fn (_, n, _, _, _) => IS.member (#exp s, n)) vis
adamc@271 111 | (DExport _, _) => true
adamc@273 112 | (DTable _, _) => true
adamc@271 113 | (DDatabase _, _) => true) file
adamc@134 114 end
adamc@134 115
adamc@134 116 end