Modules.lhs

  module Modules(computeInsOuts,inscope) where
 
  import Relations
  import NamesEntities
  import ModSysAST
  import Maybe (isNothing)
  import Sets




































  mEntSpec :: (Ord j,ToSimple j) => 
    Bool ->           -- is it a hiding import?
    Rel j Entity ->   -- the original relation
    EntSpec j         -- the specification
      -> Rel j Entity -- the subset satisfying the specification
 
  mEntSpec isHiding rel (Ent x subspec) =
    unionRels [mSpec, mSub]
    where
    mSpec   = restrictRng consider (restrictDom (== x) rel)
    allSubs = owns `unionMapSet` rng mSpec
    subs    = restrictRng (`elementOf` allSubs) rel
    mSub    = 
      case subspec of
        Nothing        -> emptyRel
        Just AllSubs   -> subs
        Just (Subs xs) -> 
          restrictDom ((`elem` xs) . toSimple) subs
 
    consider
      | isHiding && isNothing subspec = const True
      | otherwise                     = not . isCon



















































































































































  exports :: Module -> Rel QName Entity -> Rel Name Entity
  exports mod inscp = 
    case modExpList mod of
      Nothing -> modDefines mod
      Just es -> getQualified `mapDom` unionRels exps
        where
        exps = mExpListEntry inscp `map` es
























  mExpListEntry :: 
    Rel QName Entity -> ExpListEntry -> Rel QName Entity
  mExpListEntry inscp (EntExp it) = mEntSpec False inscp it
  mExpListEntry inscp (ModuleExp m) = 
    (qual m `mapDom` unqs) `intersectRel` qs
    where
    (qs,unqs) = partitionDom isQual inscp








  inscope :: Module -> (ModName -> Rel Name Entity) 
                          -> Rel QName Entity
  inscope m expsOf = unionRels [imports, locals]
    where
    defEnts = modDefines m
    locals  = unionRels 
                [mkUnqual `mapDom` defEnts,
                 mkQual (modName m) `mapDom` defEnts]
 
    imports = 
      unionRels $ map (mImp expsOf) (modImports m)





























  mImp :: (ModName -> Rel Name Entity) -> Import ->
           Rel QName Entity 
  mImp expsOf imp
    | impQualified imp  = qs
    | otherwise         = unionRels [unqs, qs]
    where
    qs      = mkQual (impAs imp) `mapDom` incoming
    unqs    = mkUnqual `mapDom` incoming
 
    listed  = unionRels $
                map (mEntSpec isHiding exps) 
                    (impList imp)
    incoming
      | isHiding  = exps `minusRel` listed
      | otherwise = listed
 
    isHiding  = impHiding imp
    exps      = expsOf (impSource imp)












































  computeInsOuts :: 
    (ModName -> Rel Name Entity) -> [Module] ->
     [(Rel QName Entity, Rel Name Entity)]
  computeInsOuts otherExps mods = inscps `zip` exps
    where
    inscps = computeIs exps
    exps   = lfpAfter nextExps $ 
              replicate (length mods) emptyRel
 
    nextExps = computeEs . computeIs
 
    computeEs is = zipWith exports mods is
    computeIs es = map (`inscope` toFun es) mods
 
    toFun es m   = maybe (otherExps m) (es !!) 
                         (lookup m mod_ixs)
    mod_ixs      = map modName mods `zip` [0..]
 
  lfpAfter f x = if fx == x then fx else lfpAfter f fx
    where 
    fx = f x