module Ho.Type where
import Data.Monoid
import qualified Data.ByteString as BS
import qualified Data.Map as Map
import Data.Version
import DataConstructors(DataTable)
import E.Rules(Rules)
import E.Type
import E.TypeCheck()
import FrontEnd.Class(ClassHierarchy)
import FrontEnd.Infix(FixityMap)
import FrontEnd.KindInfer(KindEnv)
import FrontEnd.Rename(FieldMap())
import FrontEnd.SrcLoc(SrcLoc)
import FrontEnd.Tc.Type(Type())
import FrontEnd.TypeSynonyms(TypeSynonyms)
import Name.Id
import Name.Name(Name,Module)
import PackedString
import Support.CFF
import Support.MapBinaryInstance()
import qualified Support.MD5 as MD5
cff_magic = chunkType "JHC"
cff_link = chunkType "LINK"
cff_libr = chunkType "LIBR"
cff_jhdr = chunkType "JHDR"
cff_core = chunkType "CORE"
cff_defs = chunkType "DEFS"
cff_lcor = chunkType "LCOR"
cff_ldef = chunkType "LDEF"
cff_idep = chunkType "IDEP"
cff_file = chunkType "FILE"
type SourceHash = MD5.Hash
type HoHash = MD5.Hash
type ModuleGroup = Module
data CollectedHo = CollectedHo {
choExternalNames :: IdSet,
choCombinators :: IdMap Comb,
choOrphanRules :: Rules,
choHoMap :: Map.Map ModuleGroup Ho,
choLibDeps :: Map.Map PackedString HoHash,
choHo :: Ho,
choVarMap :: IdMap (Maybe E)
}
data HoHeader = HoHeader {
hohVersion :: Int,
hohHash :: HoHash,
hohName :: Either ModuleGroup (PackedString,Version),
hohLibDeps :: [(PackedString,HoHash)],
hohArchDeps :: [(PackedString,PackedString)]
}
data HoIDeps = HoIDeps {
hoIDeps :: Map.Map SourceHash (Module,[(Module,SrcLoc)]),
hoDepends :: [(Module,SourceHash)],
hoModDepends :: [HoHash],
hoModuleGroupNeeds :: [ModuleGroup]
}
data HoLib = HoLib {
hoModuleMap :: Map.Map Module ModuleGroup,
hoReexports :: Map.Map Module Module,
hoModuleDeps :: Map.Map ModuleGroup [ModuleGroup],
hoMetaInfo :: [(PackedString,PackedString)]
}
data Library = Library {
libHoHeader :: HoHeader,
libHoLib :: HoLib,
libTcMap :: (Map.Map ModuleGroup HoTcInfo),
libBuildMap :: (Map.Map ModuleGroup HoBuild),
libExtraFiles :: [ExtraFile],
libFileName :: FilePath
}
instance Show Library where
showsPrec n lib = showsPrec n (hohHash $ libHoHeader lib)
data HoTcInfo = HoTcInfo {
hoExports :: Map.Map Module [Name],
hoDefs :: Map.Map Name (SrcLoc,[Name]),
hoAssumps :: Map.Map Name Type,
hoFixities :: FixityMap,
hoKinds :: KindEnv,
hoTypeSynonyms :: TypeSynonyms,
hoClassHierarchy :: ClassHierarchy,
hoFieldMap :: FieldMap
}
data HoBuild = HoBuild {
hoDataTable :: DataTable,
hoEs :: [(TVr,E)],
hoRules :: Rules
}
data Ho = Ho {
hoModuleGroup :: ModuleGroup,
hoTcInfo :: HoTcInfo,
hoBuild :: HoBuild
}
instance Monoid Ho where
mempty = Ho (error "unknown module group") mempty mempty
mappend ha hb = Ho (hoModuleGroup ha) (hoTcInfo ha `mappend` hoTcInfo hb) (hoBuild ha `mappend` hoBuild hb)
data ExtraFile = ExtraFile {
extraFileName :: PackedString,
extraFileData :: BS.ByteString
}
choCombinators_u f r@CollectedHo{choCombinators = x} = r{choCombinators = f x}
choExternalNames_u f r@CollectedHo{choExternalNames = x} = r{choExternalNames = f x}
choHo_u f r@CollectedHo{choHo = x} = r{choHo = f x}
choHoMap_u f r@CollectedHo{choHoMap = x} = r{choHoMap = f x}
choLibDeps_u f r@CollectedHo{choLibDeps = x} = r{choLibDeps = f x}
choOrphanRules_u f r@CollectedHo{choOrphanRules = x} = r{choOrphanRules = f x}
choVarMap_u f r@CollectedHo{choVarMap = x} = r{choVarMap = f x}
choCombinators_s v = choCombinators_u (const v)
choExternalNames_s v = choExternalNames_u (const v)
choHo_s v = choHo_u (const v)
choHoMap_s v = choHoMap_u (const v)
choLibDeps_s v = choLibDeps_u (const v)
choOrphanRules_s v = choOrphanRules_u (const v)
choVarMap_s v = choVarMap_u (const v)
hoAssumps_u f r@HoTcInfo{hoAssumps = x} = r{hoAssumps = f x}
hoClassHierarchy_u f r@HoTcInfo{hoClassHierarchy = x} = r{hoClassHierarchy = f x}
hoDefs_u f r@HoTcInfo{hoDefs = x} = r{hoDefs = f x}
hoExports_u f r@HoTcInfo{hoExports = x} = r{hoExports = f x}
hoFieldMap_u f r@HoTcInfo{hoFieldMap = x} = r{hoFieldMap = f x}
hoFixities_u f r@HoTcInfo{hoFixities = x} = r{hoFixities = f x}
hoKinds_u f r@HoTcInfo{hoKinds = x} = r{hoKinds = f x}
hoTypeSynonyms_u f r@HoTcInfo{hoTypeSynonyms = x} = r{hoTypeSynonyms = f x}
hoAssumps_s v = hoAssumps_u (const v)
hoClassHierarchy_s v = hoClassHierarchy_u (const v)
hoDefs_s v = hoDefs_u (const v)
hoExports_s v = hoExports_u (const v)
hoFieldMap_s v = hoFieldMap_u (const v)
hoFixities_s v = hoFixities_u (const v)
hoKinds_s v = hoKinds_u (const v)
hoTypeSynonyms_s v = hoTypeSynonyms_u (const v)
instance Monoid HoTcInfo where
mempty = HoTcInfo mempty mempty mempty mempty mempty mempty mempty mempty
mappend (HoTcInfo aa ab ac ad ae af ag ah) (HoTcInfo aa' ab' ac' ad' ae' af' ag' ah') = HoTcInfo (mappend aa aa')(mappend ab ab')(mappend ac ac')(mappend ad ad')(mappend ae ae')(mappend af af')(mappend ag ag')(mappend ah ah')
hoDataTable_u f r@HoBuild{hoDataTable = x} = r{hoDataTable = f x}
hoEs_u f r@HoBuild{hoEs = x} = r{hoEs = f x}
hoRules_u f r@HoBuild{hoRules = x} = r{hoRules = f x}
hoDataTable_s v = hoDataTable_u (const v)
hoEs_s v = hoEs_u (const v)
hoRules_s v = hoRules_u (const v)
instance Monoid HoBuild where
mempty = HoBuild mempty mempty mempty
mappend (HoBuild aa ab ac) (HoBuild aa' ab' ac') = HoBuild (mappend aa aa')(mappend ab ab')(mappend ac ac')
hoBuild_u f r@Ho{hoBuild = x} = r{hoBuild = f x}
hoModuleGroup_u f r@Ho{hoModuleGroup = x} = r{hoModuleGroup = f x}
hoTcInfo_u f r@Ho{hoTcInfo = x} = r{hoTcInfo = f x}
hoBuild_s v = hoBuild_u (const v)
hoModuleGroup_s v = hoModuleGroup_u (const v)
hoTcInfo_s v = hoTcInfo_u (const v)