adamc@377: (* Copyright (c) 2008, Adam Chlipala adamc@377: * All rights reserved. adamc@377: * adamc@377: * Redistribution and use in source and binary forms, with or without adamc@377: * modification, are permitted provided that the following conditions are met: adamc@377: * adamc@377: * - Redistributions of source code must retain the above copyright notice, adamc@377: * this list of conditions and the following disclaimer. adamc@377: * - Redistributions in binary form must reproduce the above copyright notice, adamc@377: * this list of conditions and the following disclaimer in the documentation adamc@377: * and/or other materials provided with the distribution. adamc@377: * - The names of contributors may not be used to endorse or promote products adamc@377: * derived from this software without specific prior written permission. adamc@377: * adamc@377: * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" adamc@377: * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE adamc@377: * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE adamc@377: * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE ziv@2252: * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR adamc@377: * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF adamc@377: * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS adamc@377: * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN adamc@377: * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) adamc@377: * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE adamc@377: * POSSIBILITY OF SUCH DAMAGE. adamc@377: *) adamc@377: adamc@377: structure PathCheck :> PATH_CHECK = struct adamc@377: adamc@377: open Mono adamc@377: adamc@377: structure E = ErrorMsg adamc@377: adamc@377: structure SS = BinarySetFn(struct adamc@377: type ord_key = string adamc@377: val compare = String.compare adamc@377: end) adamc@377: adamc@725: fun checkDecl ((d, loc), (funcs, rels, cookies, styles)) = adamc@377: let adamc@704: fun doFunc s = adamc@704: (if SS.member (funcs, s) then adamc@704: E.errorAt loc ("Duplicate function path " ^ s) adamc@704: else adamc@704: (); adamc@725: (SS.add (funcs, s), rels, cookies, styles)) adamc@704: adamc@377: fun doRel s = adamc@377: (if SS.member (rels, s) then adamc@377: E.errorAt loc ("Duplicate table/sequence path " ^ s) adamc@377: else adamc@377: (); adamc@725: (funcs, SS.add (rels, s), cookies, styles)) adamc@725: adamc@725: fun doCookie s = adamc@725: (if SS.member (cookies, s) then adamc@725: E.errorAt loc ("Duplicate cookie path " ^ s) adamc@725: else adamc@725: (); adamc@725: (funcs, rels, SS.add (cookies, s), styles)) adamc@725: adamc@725: fun doStyle s = adamc@725: (if SS.member (styles, s) then adamc@725: E.errorAt loc ("Duplicate style path " ^ s) adamc@725: else adamc@725: (); adamc@725: (funcs, rels, cookies, SS.add (styles, s))) adamc@377: in adamc@377: case d of adamc@1104: DExport (_, s, _, _, _, _) => doFunc s ziv@2252: adamc@707: | DTable (s, _, pe, ce) => adamc@704: let adamc@704: fun constraints (e, rels) = adamc@704: case #1 e of adamc@704: ERecord [(s', _, _)] => adamc@704: let adamc@704: val s' = s ^ "_" ^ s' adamc@704: in adamc@704: if SS.member (rels, s') then adamc@704: E.errorAt loc ("Duplicate constraint path " ^ s') adamc@704: else adamc@704: (); adamc@704: SS.add (rels, s') adamc@704: end adamc@704: | EStrcat (e1, e2) => constraints (e2, constraints (e1, rels)) adamc@704: | _ => rels adamc@707: adamc@707: val rels = #2 (doRel s) adamc@707: val rels = case #1 pe of adam@2048: EPrim (Prim.String (_, "")) => rels adamc@707: | _ => adamc@707: let adamc@707: val s' = s ^ "_Pkey" adamc@707: in adamc@707: if SS.member (rels, s') then adamc@707: E.errorAt loc ("Duplicate primary key constraint path " ^ s') adamc@707: else adamc@707: (); adamc@707: SS.add (rels, s') adamc@707: end adamc@704: in adamc@725: (funcs, constraints (ce, rels), cookies, styles) adamc@704: end adamc@377: | DSequence s => doRel s adamc@377: adamc@725: | DCookie s => doCookie s adamc@725: | DStyle s => doStyle s adamc@725: adamc@725: | _ => (funcs, rels, cookies, styles) adamc@377: end adamc@377: ziv@2252: fun check (ds, _) = ignore (foldl checkDecl (SS.empty, SS.empty, SS.empty, SS.empty) ds) adamc@377: adamc@377: end