module Yhc.Core.MapNames (
mapFunNames,
mapDataNames,
mapConNames) where
import Yhc.Core
import Data.Maybe
import qualified Data.Map as M
mapFunNames :: M.Map CoreFuncName CoreFuncName -> Core -> Core
mapFunNames funmap core = mapFunDefs funmap $ mapUnderCore mapfun core where
mapfun (CoreFun s) = let ns = M.lookup s funmap in CoreFun $ fromMaybe s ns
mapfun z = z
mapFunDefs dmap core = core {coreFuncs = mpfd} where
mpfd = map mpof $ coreFuncs core
mpof func = let old = coreFuncName func
new = fromMaybe old $ M.lookup old dmap
in func {coreFuncName = new}
mapDataNames :: M.Map CoreDataName CoreDataName -> Core -> Core
mapDataNames dmap core = core {coreDatas = mpdd} where
mpdd = map mpod $ coreDatas core
mpod dtdf = let old = coreDataName dtdf
new = fromMaybe old $ M.lookup old dmap
in dtdf {coreDataName = new}
mapConNames :: M.Map CoreCtorName CoreCtorName -> Core -> Core
mapConNames conmap core = mapConDefs conmap $ mapUnderCore mapcon core where
mapcon (CoreCon s) = let ns = M.lookup s conmap in CoreCon $ fromMaybe s ns
mapcon (CoreCase expr alts) = CoreCase (mapcon expr) (map (mapalt conmap) alts) where
mapalt conmap (altpat, altexpr) = (mappat conmap altpat, mapcon altexpr) where
mappat conmap (PatCon s cvs) =
let ns = M.lookup s conmap in PatCon (fromMaybe s ns) cvs
mappat _ x = x
mapcon z = z
mapConDefs cmap core = core {coreDatas = mpcd} where
mpcd = map mapcons $ coreDatas core
mapcons cdata = cdata {coreDataCtors = map mpod $ coreDataCtors cdata}
mpod ctor = let old = coreCtorName ctor
new = fromMaybe old $ M.lookup old cmap
in ctor {coreCtorName = new}