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
adamc@377:  * 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
adamc@377:             
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
adamc@707:                                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: 
adam@1845: fun check (ds, _) = ignore (foldl checkDecl (SS.empty, SS.empty, SS.empty, SS.empty) ds)
adamc@377: 
adamc@377: end