WorkModule.hs

module WorkModule(WorkModuleI(..),Ent(..),ExpRel,
		  analyzeModules, -- obsolete
		  mkWM,inscpList,analyzeSCM,readRel,showRel
		  ) where

import Modules
import Maybe(fromMaybe,fromJust)
--import Names
import Ents

import DefinedNames
import Relations
import CheckModules
import SCMs
import ModSysAST
import AST4ModSys(toMod)

import PrettyPrint
import PPModules

import MUtils(mapFst,mapSnd)

#if __GLASGOW_HASKELL__ >= 604 
import qualified Data.Set as S hiding (map)

elemsS = S.elems
#else
import qualified Sets as S

elemsS = S.setToList
#endif


-- a user of the module system


type ExpRel n = Rel n (Ent n)

data WorkModuleI i n = WorkModuleI
    { inscpRel      :: Rel i (Ent n)
    , expRel        :: ExpRel n
    , inScope       :: i -> [Ent n]
    , inScopeDom    :: [i]
    , inScopeRng    :: [Ent n]
    , exports       :: [(n, Ent n)]
    }
inscpList = relToList . inscpRel

--instance (Ord i, Ord n, Read i, Read n) => Read (WorkModuleI i n) where
--    readsPrec p xs = [ (mkWM p,ys) | (p,ys) <- readsPrec p xs]

instance (Show i, Show n) => Show (WorkModuleI i n) where
    showsPrec p wm = showsPrec p (inscpRel wm, expRel wm)

mkWM (i,e) = WorkModuleI 
        { inscpRel      = i
        , expRel        = e

        , inScope       = applyRel i
        , inScopeDom    = elemsS (dom i)
        , inScopeRng    = elemsS (rng i)
        , exports       = relToList e
        }

instance (Printable i, Printable n) => Printable (WorkModuleI i n) where
    ppi wm  = text "in scope:" 
            $$ ppRel ((\x -> (x,inScope wm x)) `map` inScopeDom wm)
            $$ "exports:"
            $$ ppRel (exports wm)


type ExportRel n = Rel n (Ent n)
{-
analyzeSCM :: 
    (QualNames i ModuleName n, DefinedNames i ds, Eq n) => 
    [(ModuleName, ExportRel n)] -> 
    [HsModuleI i ds] -> 
    Either 
        [(ModuleName,[ModSysErr i ModuleName n (Ent n)])] 
        [(ModuleName,WorkModuleI i n)]
-}
analyzeSCM exports_from_earlier scms 
    | not (null errs)   = Left errs
    | otherwise         = Right newwms
    where
    mods        = toMod `map` scms
    newwms'     = mods `zip` map mkWM (computeInsOuts otherExps mods)
    newwms      = mapFst modName newwms'
    otherExps m = fromMaybe emptyRel $ lookup m exports_from_earlier

    all_exports = mapSnd expRel newwms++exports_from_earlier
    expsOf  m   = lookup m all_exports
    errs        = [ (modName m, es) | (m,wm) <- newwms', 
                    let es = chkModule expsOf (inscpRel wm) m, not (null es) ]

    --fromJust' = fromMaybe (error "WorkModule.analyzeSCM")

-- obsolete function
analyzeModules ms 
    | not $ all null errs   = Left $ reportErrs errs
    | otherwise             = Right (scms, wms)
    where

    scms    = scMods ms
    scmods  = map toMod `map` scms 
    
    mods    = concat scmods
    names   = modName `map` mods


    wms = foldl f [] scmods 
        where
        f ws ms = ws ++ zipWith mk ms insouts
            where
            insouts     = computeInsOuts otherExps ms 
            otherExps m = maybe emptyRel expRel $ lookup m ws

    mk mod p = (modName mod, mkWM p)
            
    reportErrs  = filter (not . null . snd) . zip names
   
    inscpOf = inscpRel . fromJust . flip lookup wms
    expsOf  = fmap expRel . flip lookup wms 
    errs    = (\m -> chkModule expsOf (inscpOf (modName m)) m) `map` mods