module DDC.Core.Module
(
Module (..)
, isMainModule
, moduleKindEnv
, moduleTypeEnv
, modulesGetBinds
, ModuleMap
, modulesExportKinds
, modulesExportTypes
, QualName (..)
, ModuleName (..)
, isMainModuleName)
where
import DDC.Core.Exp
import Data.Typeable
import Data.Map.Strict (Map)
import DDC.Type.Env as Env
import qualified Data.Map.Strict as Map
import Control.DeepSeq
data Module a n
= ModuleCore
{
moduleName :: !ModuleName
, moduleExportKinds :: !(Map n (Kind n))
, moduleExportTypes :: !(Map n (Type n))
, moduleImportKinds :: !(Map n (QualName n, Kind n))
, moduleImportTypes :: !(Map n (QualName n, Type n))
, moduleBody :: !(Exp a n)
}
deriving (Show, Typeable)
instance (NFData a, NFData n) => NFData (Module a n) where
rnf !mm
= rnf (moduleName mm)
`seq` rnf (moduleExportKinds mm)
`seq` rnf (moduleExportTypes mm)
`seq` rnf (moduleImportKinds mm)
`seq` rnf (moduleImportTypes mm)
`seq` rnf (moduleBody mm)
isMainModule :: Module a n -> Bool
isMainModule mm
= isMainModuleName
$ moduleName mm
moduleKindEnv :: Ord n => Module a n -> KindEnv n
moduleKindEnv mm
= Env.fromList
$ [BName n k | (n, (_, k)) <- Map.toList $ moduleImportKinds mm]
moduleTypeEnv :: Ord n => Module a n -> TypeEnv n
moduleTypeEnv mm
= Env.fromList
$ [BName n k | (n, (_, k)) <- Map.toList $ moduleImportTypes mm]
type ModuleMap a n
= Map ModuleName (Module a n)
modulesGetBinds m
= Env.fromList $ map (uncurry BName) (Map.assocs m)
modulesExportKinds :: Ord n => ModuleMap a n -> KindEnv n -> KindEnv n
modulesExportKinds mods base
= foldl Env.union base
$ map (modulesGetBinds.moduleExportKinds) (Map.elems mods)
modulesExportTypes :: Ord n => ModuleMap a n -> TypeEnv n -> TypeEnv n
modulesExportTypes mods base
= foldl Env.union base
$ map (modulesGetBinds.moduleExportTypes) (Map.elems mods)
data ModuleName
= ModuleName [String]
deriving (Show, Eq, Ord, Typeable)
instance NFData ModuleName where
rnf (ModuleName ss)
= rnf ss
data QualName n
= QualName ModuleName n
deriving Show
instance NFData n => NFData (QualName n) where
rnf (QualName mn n)
= rnf mn `seq` rnf n
isMainModuleName :: ModuleName -> Bool
isMainModuleName mn
= case mn of
ModuleName ["Main"] -> True
_ -> False