X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FDsMonad.lhs;h=5245eaaaa60d6372d61c71dbbdb9602a0841a419;hb=3891512c4c770dadd0372ad84d2dec72b34652d2;hp=58a154a93c9269726fbab8b97a2b357b6776bf66;hpb=703ca1542c8e0983cc9d8eebce6e9f3dd3fd71e2;p=ghc-hetmet.git diff --git a/compiler/deSugar/DsMonad.lhs b/compiler/deSugar/DsMonad.lhs index 58a154a..5245eaa 100644 --- a/compiler/deSugar/DsMonad.lhs +++ b/compiler/deSugar/DsMonad.lhs @@ -9,7 +9,7 @@ module DsMonad ( DsM, mapM, mapAndUnzipM, initDs, initDsTc, fixDs, - foldlM, foldrM, ifOptM, + foldlM, foldrM, ifOptM, unsetOptM, Applicative(..),(<$>), newLocalName, @@ -25,6 +25,8 @@ module DsMonad ( DsMetaEnv, DsMetaVal(..), dsLookupMetaEnv, dsExtendMetaEnv, + dsLoadModule, + -- Warnings DsWarning, warnDs, failWithDs, @@ -38,6 +40,7 @@ import TcRnMonad import CoreSyn import HsSyn import TcIface +import LoadIface import RdrName import HscTypes import Bag @@ -218,8 +221,8 @@ it easier to read debugging output. \begin{code} -- Make a new Id with the same print name, but different type, and new unique -newUniqueId :: Name -> Type -> DsM Id -newUniqueId id = mkSysLocalM (occNameFS (nameOccName id)) +newUniqueId :: Id -> Type -> DsM Id +newUniqueId id = mkSysLocalM (occNameFS (nameOccName (idName id))) duplicateLocalDs :: Id -> DsM Id duplicateLocalDs old_local @@ -230,7 +233,7 @@ newPredVarDs :: PredType -> DsM Var newPredVarDs pred | isEqPred pred = do { uniq <- newUnique; - ; let name = mkSystemName uniq (mkOccNameFS tcName (fsLit "co")) + ; let name = mkSystemName uniq (mkOccNameFS tcName (fsLit "co_pv")) kind = mkPredTy pred ; return (mkCoVar name kind) } | otherwise @@ -318,3 +321,13 @@ dsExtendMetaEnv :: DsMetaEnv -> DsM a -> DsM a dsExtendMetaEnv menv thing_inside = updLclEnv (\env -> env { ds_meta = ds_meta env `plusNameEnv` menv }) thing_inside \end{code} + +\begin{code} +dsLoadModule :: SDoc -> Module -> DsM () +dsLoadModule doc mod + = do { env <- getGblEnv + ; setEnvs (ds_if_env env) + (loadSysInterface doc mod >> return ()) + } +\end{code} +