X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FDsMonad.lhs;h=a38b291bc8429dc769e14b7a4e385e750c65df9b;hb=a8427a4125e9b78e88a487eeabf018f1c6e8bc08;hp=d3dd0e110f1e4f6b293942af27a5eb3d48d8f93d;hpb=eca538c8c62951d6f140c99c88a97ef2b0a0497d;p=ghc-hetmet.git diff --git a/compiler/deSugar/DsMonad.lhs b/compiler/deSugar/DsMonad.lhs index d3dd0e1..a38b291 100644 --- a/compiler/deSugar/DsMonad.lhs +++ b/compiler/deSugar/DsMonad.lhs @@ -20,10 +20,10 @@ module DsMonad ( UniqSupply, newUniqueSupply, getDOptsDs, getGhcModeDs, doptDs, dsLookupGlobal, dsLookupGlobalId, dsLookupTyCon, dsLookupDataCon, + dsLookupClass, DsMetaEnv, DsMetaVal(..), dsLookupMetaEnv, dsExtendMetaEnv, - bindLocalsDs, getLocalBindsDs, getBkptSitesDs, -- Warnings DsWarning, warnDs, failWithDs, @@ -44,6 +44,7 @@ import HscTypes import Bag import DataCon import TyCon +import Class import Id import Module import Var @@ -56,9 +57,6 @@ import NameEnv import OccName import DynFlags import ErrUtils -import Bag -import Breakpoints -import OccName import Data.IORef @@ -136,15 +134,13 @@ data DsGblEnv = DsGblEnv { ds_mod :: Module, -- For SCC profiling ds_unqual :: PrintUnqualified, ds_msgs :: IORef Messages, -- Warning messages - ds_if_env :: (IfGblEnv, IfLclEnv), -- Used for looking up global, + ds_if_env :: (IfGblEnv, IfLclEnv) -- Used for looking up global, -- possibly-imported things - ds_bkptSites :: IORef SiteMap -- Inserted Breakpoints sites } data DsLclEnv = DsLclEnv { ds_meta :: DsMetaEnv, -- Template Haskell bindings - ds_loc :: SrcSpan, -- to put in pattern-matching error msgs - ds_locals :: OccEnv Id -- For locals in breakpoints + ds_loc :: SrcSpan -- to put in pattern-matching error msgs } -- Inside [| |] brackets, the desugarer looks @@ -207,11 +203,9 @@ mkDsEnvs mod rdr_env type_env msg_var gbl_env = DsGblEnv { ds_mod = mod, ds_if_env = (if_genv, if_lenv), ds_unqual = mkPrintUnqualified rdr_env, - ds_msgs = msg_var, - ds_bkptSites = sites_var} + ds_msgs = msg_var} lcl_env = DsLclEnv { ds_meta = emptyNameEnv, - ds_loc = noSrcSpan, - ds_locals = emptyOccEnv } + ds_loc = noSrcSpan } return (gbl_env, lcl_env) @@ -322,6 +316,11 @@ dsLookupDataCon :: Name -> DsM DataCon dsLookupDataCon name = dsLookupGlobal name `thenDs` \ thing -> returnDs (tyThingDataCon thing) + +dsLookupClass :: Name -> DsM Class +dsLookupClass name + = dsLookupGlobal name `thenDs` \ thing -> + returnDs (tyThingClass thing) \end{code} \begin{code} @@ -332,19 +331,3 @@ 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} -getLocalBindsDs :: DsM [Id] -getLocalBindsDs = do { env <- getLclEnv; return (occEnvElts$ ds_locals env) } - -bindLocalsDs :: [Id] -> DsM a -> DsM a -bindLocalsDs new_ids enclosed_scope = - updLclEnv (\env-> env {ds_locals = ds_locals env `extendOccEnvList` occnamed_ids}) - enclosed_scope - where occnamed_ids = [ (nameOccName (idName id),id) | id <- new_ids ] - -getBkptSitesDs :: DsM (IORef SiteMap) -getBkptSitesDs = do { env <- getGblEnv; return (ds_bkptSites env) } - -\end{code} -