projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Fix desugaring of unboxed tuples
[ghc-hetmet.git]
/
ghc
/
compiler
/
deSugar
/
DsMonad.lhs
diff --git
a/ghc/compiler/deSugar/DsMonad.lhs
b/ghc/compiler/deSugar/DsMonad.lhs
index
2dbe8b1
..
f24dee4
100644
(file)
--- a/
ghc/compiler/deSugar/DsMonad.lhs
+++ b/
ghc/compiler/deSugar/DsMonad.lhs
@@
-5,10
+5,11
@@
\begin{code}
module DsMonad (
\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,
duplicateLocalDs, newSysLocalDs, newSysLocalsDs, newUniqueId,
newFailLocalDs,
getSrcSpanDs, putSrcSpanDs,
@@
-68,7
+69,7
@@
infixr 9 `thenDs`
\begin{code}
data DsMatchContext
\begin{code}
data DsMatchContext
- = DsMatchContext (HsMatchContext Name) [Pat Id] SrcSpan
+ = DsMatchContext (HsMatchContext Name) SrcSpan
| NoMatchContext
deriving ()
| NoMatchContext
deriving ()
@@
-82,7
+83,7
@@
idWrapper e = e
-- The semantics of (match vs (EqnInfo wrap pats rhs)) is the MatchResult
-- \fail. wrap (case vs of { pats -> rhs fail })
-- 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
-- A MatchResult is an expression with a hole in it
@@
-119,6
+120,7
@@
thenDs = thenM
returnDs = returnM
listDs = sequenceM
foldlDs = foldlM
returnDs = returnM
listDs = sequenceM
foldlDs = foldlM
+foldrDs = foldrM
mapAndUnzipDs = mapAndUnzipM
mapAndUnzipDs = mapAndUnzipM
@@
-239,8
+241,10
@@
getSrcSpanDs = do { env <- getLclEnv; return (ds_loc env) }
putSrcSpanDs :: SrcSpan -> DsM a -> DsM a
putSrcSpanDs new_loc thing_inside = updLclEnv (\ env -> env {ds_loc = new_loc}) thing_inside
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}
where
msg = ptext SLIT("Warning:") <+> warn
\end{code}