Modules.lhs

  module Modules where

  import List (partition, nub)
  import Maybe (fromJust)

  -- implementation only
  import QualNames








































































  data Mod qn m n ent = Mod
      { modName       :: m
      , modExport     :: Maybe [ExpListEntry qn m]
      , modImports    :: [Import m n]
      , modDefines    :: Rel n ent
      }                                                 












  data ExpListEntry qn m    = Ent (EntSpec qn) | ModuleExp m












  data EntSpec j          = EntSpec j (Maybe (SubSpec j)) deriving Eq
  data SubSpec j          = All | Some [j]                deriving Eq















  data Import m n     = Import
      { impQualified  :: Bool
      , impFrom       :: m 
      , impAs         :: m
      , impSpec       :: (ImpMethod, [EntSpec n])
      }                  
 
  data ImpMethod = Importing | Hiding















































  type Rel a b = [(a,b)]


























  locals mod = [ (mkUnqual n, e) | (n,e) <- defEnts ]
            ++ [ (mkQual m n, e) | (n,e) <- defEnts ]
    where
    m       = modName mod
    defEnts = modDefines mod







































  mEntSpec p (EntSpec x spec) r = xents ++ xsubs
    where
    xents       = [ (y,e) | (y,e) <- r, y == x, p e ]
 
    xsubs = case spec of 
        Nothing         -> []
        Just All        -> allxsubs
        Just (Some xs)  -> [ (y,e) | (y,e) <- allxsubs, y `elem` xs ]
 
    allxsubs    = [ (y,e) | (_,xe) <- xents, s <- owns xe, (y,e) <- r, e == s ]























  exports m inscp = [ (getQualified qn, e) | (qn,e) <- exps ]
    where
    exps = case modExport m of
      Nothing   -> locals m
      Just es   -> concat [ mExpListEntry e inscp | e <- es ]






























  mExpListEntry (ModuleExp m) inscp =
                [ (x,ent) | (x,ent) <- unqs, (qual m x,ent) `elem` qs ]
    where
    (qs,unqs) = partition (isQual . fst) inscp
 
  mExpListEntry (Ent ispec) inscp = mEntSpec (not . isCon) ispec inscp
















  inscope m expsOf = imports ++ locals m 
    where
    imports = concat [ mImp imp (expsOf (impFrom imp)) | imp <- modImports m ]









  mImp imp exps 
    | impQualified imp  = qs
    | otherwise         = unqs ++ qs
    where
    m           = impAs imp
    qs          = [ (mkQual m n, e) | (n,e) <- incoming ]
    unqs        = [ (mkUnqual n, e) | (n,e) <- incoming ]
    incoming    = mImpSpec (impSpec imp) exps




















  mImpSpec (method, specs) exps = case method of
    Importing   -> ents (not . isCon)
    Hiding      -> [ exp | exp <- exps, exp `notElem` ents (const True) ]
    where
    ents p = [ x | spec <- specs, x <- mEntSpec p spec exps ]






















  (<<=) :: (Eq a, Eq b) => [Rel a b] -> [Rel a b] -> Bool
  xss <<= yss = and (zipWith subEq xss yss)
    where
    xs `subEq` ys   = all (`elem` ys) xs 




























  computeInsOuts otherExps mods = inscps `zip` exps
    where
    inscps          = nub `map` computeIs exps 
    exps            = lfpAfter nextExps (repeat [])
 
    nextExps        = computeEs . computeIs 
 
    computeEs is    = zipWith (\m -> nub . exports m) mods is
    computeIs es    = (\m -> inscope m (toFun es)) `map` mods
  
    toFun es m = maybe (otherExps m) (es !!) $ lookup m mod_ixs
    -- toFun es m = let Just pos = lookup m mod_ixs in es !! pos
    mod_ixs     = (modName `map` mods) `zip` [0 .. ] 

  lfpAfter :: Eq a => (a -> a) -> (a -> a) 
  lfpAfter f x = let fx = f x in if fx == x then x else lfpAfter f fx