CheckModules.lhs

module CheckModules(ModSysErr(..),chkModule) where
 
  import Relations
  import NamesEntities
  import ModSysAST
  --import Modules
  import List (partition,nub)
  import Maybe(isNothing)
  import Sets






  data ModSysErr 
    = UndefinedModuleAlias ModName
    | UndefinedExport QName
    | UndefinedSubExport QName Name
    | AmbiguousExport Name [Entity] 
    | MissingModule ModName
    | UndefinedImport ModName Name 
    | UndefinedSubImport ModName Name Name 
    deriving Show             










































  chkModule :: 
    (ModName -> Maybe (Rel Name Entity)) ->
    Rel QName Entity ->
    Module ->
      [ModSysErr]
 
  chkModule expsOf inscp mod
    = chkAmbigExps mod_exports
      ++ if null missingModules
         then chkExpSpec inscp mod
               ++ [err | (imp,Just exps) <- impSources,
                         err <- chkImport exps imp]
         else map MissingModule missingModules
    where
    Just mod_exports = expsOf (modName mod)
 
    missingModules =
      nub [impSource imp|(imp,Nothing)<-impSources]
    impSources =
      [(imp,expsOf (impSource imp))|imp<-modImports mod]


















  chkAmbigExps :: Rel Name Entity -> [ModSysErr]
  chkAmbigExps exps = concatMap isAmbig 
                               (setToList (dom exps))
    where
    isAmbig n = 
      let (values,types) = partition isValue (applyRel exps n) 
      in ambig n values ++ ambig n types
 
    ambig n ents@(_:_:_)    = [AmbiguousExport n ents]
    ambig n _               = []





















  chkEntSpec :: (Ord j, ToSimple j) =>
    Bool ->                             -- is it a hiding import?
    (j -> ModSysErr) ->                 -- report error
    (j -> Name -> ModSysErr) ->         -- report error
    EntSpec j ->                        -- the specification
    Rel j Entity  ->                    -- the relation to check
    (j->[Entity]) ->                    -- the relation to check
      [ModSysErr]                       -- detected errors
 
  chkEntSpec isHiding errUndef errUndefSub 
             (Ent x subspec) rel relfun =
    case xents of
      []   -> [errUndef x]
      ents -> concatMap chk ents
    where
    xents = filter consider (relfun x)
 
    chk ent = 
      case subspec of
        Just (Subs subs) -> 
          map (errUndefSub x)
              (filter (not . (`elementOf` subsInScope)) subs)
          where
          subsInScope = 
            mapSet toSimple 
              $ dom 
              $ restrictRng (`elementOf` owns ent) rel
        _ -> []
 
    consider
      | isHiding && isNothing subspec = const True
      | otherwise                     = not . isCon





















  chkExpSpec :: Rel QName Entity -> Module -> [ModSysErr]
  chkExpSpec inscp mod =
      case modExpList mod of
        Nothing   -> []
        Just exps -> concatMap chk exps
    where
    aliases = modName mod : impAs `map` modImports mod
 
    chk (ModuleExp x)
      | x `elem` aliases = []
      | otherwise        = [UndefinedModuleAlias x]
    chk (EntExp spec) = chkEntSpec False 
                 UndefinedExport UndefinedSubExport 
                 spec inscp (applyRel inscp)







  chkImport :: Rel Name Entity -> Import -> [ModSysErr]
  chkImport exps imp = concatMap chk (impList imp)
    where
    src      = impSource imp
    chk spec = 
      chkEntSpec (impHiding imp)
        (UndefinedImport src) (UndefinedSubImport src)
        spec exps (applyRel exps)