Mercurial > urweb

annotate src/shake.sml @ 1739:c414850f206f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Add support for -boot flag, which allows in-tree execution of Ur/Web The boot flag rewrites most hardcoded paths to point to the build directory, and also forces static compilation. This is convenient for developing Ur/Web, or if you cannot 'sudo make install' Ur/Web. The following changes were made: * Header files were moved to include/urweb instead of include; this lets FFI users point their C_INCLUDE_PATH at this directory at write <urweb/urweb.h>. For internal Ur/Web executables, we simply pass -I$PATH/include/urweb as normal. * Differentiate between LIB and SRCLIB; SRCLIB is Ur and JavaScript source files, while LIB is compiled products from libtool. For in-tree compilation these live in different places. * No longer reference Config for paths; instead use Settings; these settings can be changed dynamically by Compiler.enableBoot () (TODO: add a disableBoot function.) * config.h is now generated directly in include/urweb/config.h, for consistency's sake (especially since it gets installed along with the rest of the headers!) * All of the autotools build products got updated. * The linkStatic field in protocols now only contains the name of the build product, and not the absolute path. Future users have to be careful not to reference the Settings files to early, lest they get an old version (this was the source of two bugs during development of this patch.)
author Edward Z. Yang <ezyang@mit.edu>
date Wed, 02 May 2012 17:17:57 -0400
parents b4480a56cab7
children e15234fbb163
rev   line source
adamc@1265 1 (* Copyright (c) 2008-2010, Adam Chlipala
adamc@23 2 * All rights reserved.
adamc@23 3 *
adamc@23 4 * Redistribution and use in source and binary forms, with or without
adamc@23 5 * modification, are permitted provided that the following conditions are met:
adamc@23 6 *
adamc@23 7 * - Redistributions of source code must retain the above copyright notice,
adamc@23 8 * this list of conditions and the following disclaimer.
adamc@23 9 * - Redistributions in binary form must reproduce the above copyright notice,
adamc@23 10 * this list of conditions and the following disclaimer in the documentation
adamc@23 11 * and/or other materials provided with the distribution.
adamc@23 12 * - The names of contributors may not be used to endorse or promote products
adamc@23 13 * derived from this software without specific prior written permission.
adamc@23 14 *
adamc@23 15 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
adamc@23 16 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
adamc@23 17 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
adamc@23 18 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
adamc@23 19 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
adamc@23 20 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
adamc@23 21 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
adamc@23 22 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
adamc@23 23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
adamc@23 24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
adamc@23 25 * POSSIBILITY OF SUCH DAMAGE.
adamc@23 26 *)
adamc@23 27
adamc@23 28 (* Remove unused definitions from a file *)
adamc@23 29
adamc@23 30 structure Shake :> SHAKE = struct
adamc@23 31
adamc@1112 32 val sliceDb = ref false
adamc@1112 33
adamc@23 34 open Core
adamc@23 35
adamc@23 36 structure U = CoreUtil
adamc@23 37
adamc@23 38 structure IS = IntBinarySet
adamc@23 39 structure IM = IntBinaryMap
adamc@23 40
adamc@23 41 type free = {
adamc@23 42 con : IS.set,
adamc@23 43 exp : IS.set
adamc@23 44 }
adamc@23 45
adamc@338 46 val dummyt = (TRecord (CRecord ((KType, ErrorMsg.dummySpan), []), ErrorMsg.dummySpan), ErrorMsg.dummySpan)
adamc@247 47 val dummye = (EPrim (Prim.String ""), ErrorMsg.dummySpan)
adamc@247 48
adamc@1060 49 fun tupleC cs = (CTuple cs, ErrorMsg.dummySpan)
adamc@1060 50 fun tupleE es = (ERecord (map (fn e => (dummyt, e, dummyt)) es), ErrorMsg.dummySpan)
adamc@1060 51
adamc@23 52 fun shake file =
adamc@100 53 let
adamc@1060 54 val usedVarsC = U.Con.fold {kind = fn (_, st) => st,
adamc@1060 55 con = fn (c, cs) =>
adamc@1060 56 case c of
adamc@1060 57 CNamed n => IS.add (cs, n)
adamc@1060 58 | _ => cs}
adamc@1060 59
adamc@704 60 val usedVars = U.Exp.fold {kind = fn (_, st) => st,
adamc@704 61 con = fn (c, st as (es, cs)) =>
adamc@704 62 case c of
adamc@704 63 CNamed n => (es, IS.add (cs, n))
adamc@704 64 | _ => st,
adamc@704 65 exp = fn (e, st as (es, cs)) =>
adamc@704 66 case e of
adamc@704 67 ENamed n => (IS.add (es, n), cs)
adamc@704 68 | _ => st}
adamc@704 69
adamc@1060 70 val (usedE, usedC) =
adamc@248 71 List.foldl
adamc@1112 72 (fn ((DExport (_, n, _), _), st as (usedE, usedC)) =>
adamc@1112 73 if !sliceDb then
adamc@1112 74 st
adamc@1112 75 else
adamc@1112 76 (IS.add (usedE, n), usedC)
adamc@1060 77 | ((DTable (_, _, c, _, pe, pc, ce, cc), _), (usedE, usedC)) =>
adamc@704 78 let
adamc@1060 79 val usedC = usedVarsC usedC c
adamc@1060 80 val usedC = usedVarsC usedC pc
adamc@1060 81 val usedC = usedVarsC usedC cc
adamc@1060 82
adamc@707 83 val (usedE, usedC) = usedVars (usedE, usedC) pe
adamc@707 84 val (usedE, usedC) = usedVars (usedE, usedC) ce
adamc@704 85 in
adamc@1060 86 (usedE, usedC)
adamc@704 87 end
adamc@1265 88 | ((DView (_, _, _, e, c), _), (usedE, usedC)) =>
adamc@1265 89 let
adamc@1265 90 val usedC = usedVarsC usedC c
adamc@1265 91 in
adamc@1265 92 usedVars (usedE, usedC) e
adamc@1265 93 end
adamc@1112 94 | ((DTask (e1, e2), _), st) =>
adamc@1112 95 if !sliceDb then
adamc@1112 96 st
adamc@1112 97 else
adamc@1112 98 usedVars (usedVars st e1) e2
adamc@1199 99 | ((DPolicy e1, _), st) =>
adamc@1199 100 if !sliceDb then
adamc@1199 101 st
adamc@1199 102 else
adamc@1199 103 usedVars st e1
adam@1294 104 | ((DOnError n, _), st as (usedE, usedC)) =>
adam@1294 105 if !sliceDb then
adam@1294 106 st
adam@1294 107 else
adam@1294 108 (IS.add (usedE, n), usedC)
adamc@1060 109 | (_, acc) => acc) (IS.empty, IS.empty) file
adamc@23 110
adamc@163 111 val (cdef, edef) = foldl (fn ((DCon (_, n, _, c), _), (cdef, edef)) => (IM.insert (cdef, n, [c]), edef)
adamc@807 112 | ((DDatatype dts, _), (cdef, edef)) =>
adamc@807 113 (foldl (fn ((_, n, _, xncs), cdef) =>
adamc@807 114 IM.insert (cdef, n, List.mapPartial #3 xncs)) cdef dts, edef)
adamc@453 115 | ((DVal (_, n, t, e, _), _), (cdef, edef)) => (cdef, IM.insert (edef, n, ([], t, e)))
adamc@125 116 | ((DValRec vis, _), (cdef, edef)) =>
adamc@453 117 let
adamc@453 118 val all_ns = map (fn (_, n, _, _, _) => n) vis
adamc@453 119 in
adamc@453 120 (cdef, foldl (fn ((_, n, t, e, _), edef) =>
adamc@453 121 IM.insert (edef, n, (all_ns, t, e))) edef vis)
adamc@453 122 end
adamc@247 123 | ((DExport _, _), acc) => acc
adamc@1060 124 | ((DTable (_, n, c, _, e1, c1, e2, c2), _), (cdef, edef)) =>
adamc@1060 125 (cdef, IM.insert (edef, n, ([], tupleC [c, c1, c2], tupleE [e1, e2])))
adamc@338 126 | ((DSequence (_, n, _), _), (cdef, edef)) =>
adamc@453 127 (cdef, IM.insert (edef, n, ([], dummyt, dummye)))
adamc@754 128 | ((DView (_, n, _, _, c), _), (cdef, edef)) =>
adamc@754 129 (cdef, IM.insert (edef, n, ([], c, dummye)))
adamc@461 130 | ((DDatabase _, _), acc) => acc
adamc@461 131 | ((DCookie (_, n, c, _), _), (cdef, edef)) =>
adamc@718 132 (cdef, IM.insert (edef, n, ([], c, dummye)))
adamc@720 133 | ((DStyle (_, n, _), _), (cdef, edef)) =>
adamc@1073 134 (cdef, IM.insert (edef, n, ([], dummyt, dummye)))
adamc@1199 135 | ((DTask _, _), acc) => acc
adam@1294 136 | ((DPolicy _, _), acc) => acc
adam@1294 137 | ((DOnError _, _), acc) => acc)
adamc@100 138 (IM.empty, IM.empty) file
adamc@23 139
adamc@100 140 fun kind (_, s) = s
adamc@23 141
adamc@100 142 fun con (c, s) =
adamc@100 143 case c of
adamc@100 144 CNamed n =>
adamc@100 145 if IS.member (#con s, n) then
adamc@100 146 s
adamc@100 147 else
adamc@100 148 let
adamc@100 149 val s' = {con = IS.add (#con s, n),
adamc@100 150 exp = #exp s}
adamc@100 151 in
adamc@100 152 case IM.find (cdef, n) of
adamc@100 153 NONE => s'
adamc@163 154 | SOME cs => foldl (fn (c, s') => shakeCon s' c) s' cs
adamc@100 155 end
adamc@100 156 | _ => s
adamc@23 157
adamc@100 158 and shakeCon s = U.Con.fold {kind = kind, con = con} s
adamc@23 159
adamc@1080 160 (*val () = print "=====\nSHAKE\n=====\n"
adamc@1080 161 val current = ref 0*)
adamc@1080 162
adamc@100 163 fun exp (e, s) =
adamc@607 164 let
adamc@607 165 fun check n =
adamc@607 166 if IS.member (#exp s, n) then
adamc@607 167 s
adamc@607 168 else
adamc@607 169 let
adamc@607 170 val s' = {exp = IS.add (#exp s, n),
adamc@607 171 con = #con s}
adamc@607 172 in
adamc@1080 173 (*print ("Need " ^ Int.toString n ^ " <-- " ^ Int.toString (!current) ^ "\n");*)
adamc@607 174 case IM.find (edef, n) of
adamc@607 175 NONE => s'
adamc@607 176 | SOME (ns, t, e) =>
adamc@607 177 let
adamc@1080 178 (*val old = !current
adamc@1080 179 val () = current := n*)
adamc@607 180 val s' = shakeExp (shakeCon s' t) e
adamc@607 181 in
adamc@1080 182 (*current := old;*)
adamc@607 183 foldl (fn (n, s') => exp (ENamed n, s')) s' ns
adamc@607 184 end
adamc@607 185 end
adamc@607 186 in
adamc@607 187 case e of
adamc@607 188 ENamed n => check n
adamc@1020 189 | EServerCall (n, _, _) => check n
adamc@607 190 | _ => s
adamc@607 191 end
adamc@23 192
adamc@100 193 and shakeExp s = U.Exp.fold {kind = kind, con = con, exp = exp} s
adamc@100 194
adamc@704 195 val s = {con = usedC, exp = usedE}
adamc@109 196
adamc@704 197 val s = IS.foldl (fn (n, s) =>
adamc@704 198 case IM.find (edef, n) of
adamc@704 199 NONE => raise Fail "Shake: Couldn't find 'val'"
adamc@704 200 | SOME (ns, t, e) =>
adamc@704 201 let
adamc@1080 202 (*val () = current := n*)
adamc@704 203 val s = shakeExp (shakeCon s t) e
adamc@704 204 in
adamc@704 205 foldl (fn (n, s) => exp (ENamed n, s)) s ns
adamc@704 206 end) s usedE
adamc@248 207
adamc@1060 208 val s = IS.foldl (fn (n, s) =>
adamc@1060 209 case IM.find (cdef, n) of
adamc@1062 210 NONE => raise Fail ("Shake: Couldn't find 'con' " ^ Int.toString n)
adamc@1060 211 | SOME cs => foldl (fn (c, s) => shakeCon s c) s cs) s usedC
adamc@100 212 in
adamc@100 213 List.filter (fn (DCon (_, n, _, _), _) => IS.member (#con s, n)
adamc@807 214 | (DDatatype dts, _) => List.exists (fn (_, n, _, _) => IS.member (#con s, n)) dts
adamc@109 215 | (DVal (_, n, _, _, _), _) => IS.member (#exp s, n)
adamc@125 216 | (DValRec vis, _) => List.exists (fn (_, n, _, _, _) => IS.member (#exp s, n)) vis
adamc@1112 217 | (DExport _, _) => not (!sliceDb)
adamc@754 218 | (DView _, _) => true
adamc@754 219 | (DSequence _, _) => true
adamc@271 220 | (DTable _, _) => true
adamc@1112 221 | (DDatabase _, _) => not (!sliceDb)
adamc@1112 222 | (DCookie _, _) => not (!sliceDb)
adamc@1112 223 | (DStyle _, _) => not (!sliceDb)
adamc@1199 224 | (DTask _, _) => not (!sliceDb)
adam@1294 225 | (DPolicy _, _) => not (!sliceDb)
adam@1294 226 | (DOnError _, _) => not (!sliceDb)) file
adamc@100 227 end
adamc@23 228
adamc@23 229 end