\begin{code}
module DsMonad (
- DsM, mappM,
- initDs, returnDs, thenDs, listDs, fixDs, mapAndUnzipDs, foldlDs,
+ DsM, mappM, mapAndUnzipM,
+ initDs, returnDs, thenDs, listDs, fixDs, mapAndUnzipDs,
+ foldlDs, foldrDs,
- newTyVarsDs,
+ newTyVarsDs, newLocalName,
duplicateLocalDs, newSysLocalDs, newSysLocalsDs, newUniqueId,
newFailLocalDs,
getSrcSpanDs, putSrcSpanDs,
-- Data types
DsMatchContext(..),
- EquationInfo(..), MatchResult(..),
+ EquationInfo(..), MatchResult(..), DsWrapper, idWrapper,
CanItFail(..), orFail
) where
import Bag ( emptyBag, snocBag, Bag )
import DataCon ( DataCon )
import TyCon ( TyCon )
-import DataCon ( DataCon )
import Id ( mkSysLocal, setIdUnique, Id )
import Module ( Module )
import Var ( TyVar, setTyVarUnique )
import Name ( Name, nameOccName )
import NameEnv
import OccName ( occNameFS )
-import CmdLineOpts ( DynFlags )
+import DynFlags ( DynFlags )
import ErrUtils ( WarnMsg, mkWarnMsg )
import Bag ( mapBag )
\begin{code}
data DsMatchContext
- = DsMatchContext (HsMatchContext Name) [Pat Id] SrcSpan
+ = DsMatchContext (HsMatchContext Name) SrcSpan
| NoMatchContext
deriving ()
data EquationInfo
- = EqnInfo { eqn_pats :: [Pat Id], -- The patterns for an eqn
+ = EqnInfo { eqn_wrap :: DsWrapper, -- Bindings
+ eqn_pats :: [Pat Id], -- The patterns for an eqn
eqn_rhs :: MatchResult } -- What to do after match
+type DsWrapper = CoreExpr -> CoreExpr
+idWrapper e = e
+
-- The semantics of (match vs (EqnInfo wrap pats rhs)) is the MatchResult
-- \fail. wrap (case vs of { pats -> rhs fail })
--- where vs are not in the domain of wrap
+-- where vs are not bound by wrap
-- A MatchResult is an expression with a hole in it
returnDs = returnM
listDs = sequenceM
foldlDs = foldlM
+foldrDs = foldrM
mapAndUnzipDs = mapAndUnzipM
putSrcSpanDs :: SrcSpan -> DsM a -> DsM a
putSrcSpanDs new_loc thing_inside = updLclEnv (\ env -> env {ds_loc = new_loc}) thing_inside
-dsWarn :: DsWarning -> DsM ()
-dsWarn (loc,warn) = do { env <- getGblEnv; updMutVar (ds_warns env) (`snocBag` (loc,msg)) }
+dsWarn :: SDoc -> DsM ()
+dsWarn warn = do { env <- getGblEnv
+ ; loc <- getSrcSpanDs
+ ; updMutVar (ds_warns env) (`snocBag` (loc,msg)) }
where
msg = ptext SLIT("Warning:") <+> warn
\end{code}