diff options
Diffstat (limited to 'compiler/deSugar')
| -rw-r--r-- | compiler/deSugar/DsBinds.lhs | 7 | ||||
| -rw-r--r-- | compiler/deSugar/DsMonad.lhs | 5 |
2 files changed, 8 insertions, 4 deletions
diff --git a/compiler/deSugar/DsBinds.lhs b/compiler/deSugar/DsBinds.lhs index 7cc58583dd..8e8278783e 100644 --- a/compiler/deSugar/DsBinds.lhs +++ b/compiler/deSugar/DsBinds.lhs @@ -32,6 +32,7 @@ import DsUtils import HsSyn -- lots of things import CoreSyn -- lots of things +import Literal ( Literal(MachStr) ) import CoreSubst import MkCore import CoreUtils @@ -40,6 +41,7 @@ import CoreUnfold import CoreFVs import Digraph + import TyCon ( isTupleTyCon, tyConDataCons_maybe ) import TcEvidence import TcType @@ -705,7 +707,10 @@ dsEvTerm (EvSuperClass d n) = Var sc_sel_id `mkTyApps` tys `App` Var d where sc_sel_id = classSCSelId cls n -- Zero-indexed - (cls, tys) = getClassPredTys (evVarPred d) + (cls, tys) = getClassPredTys (evVarPred d) +dsEvTerm (EvDelayedError ty msg) = Var errorId `mkTyApps` [ty] `mkApps` [litMsg] + where errorId = rUNTIME_ERROR_ID + litMsg = Lit (MachStr msg) --------------------------------------- dsTcCoercion :: TcCoercion -> (Coercion -> CoreExpr) -> CoreExpr diff --git a/compiler/deSugar/DsMonad.lhs b/compiler/deSugar/DsMonad.lhs index bf05fdffe2..551165a3ad 100644 --- a/compiler/deSugar/DsMonad.lhs +++ b/compiler/deSugar/DsMonad.lhs @@ -226,7 +226,7 @@ initDs hsc_env mod rdr_env type_env thing_inside where loadOneModule :: ModuleName -- the module to load -> DsM Bool -- under which condition - -> Message -- error message if module not found + -> MsgDoc -- error message if module not found -> DsM GlobalRdrEnv -- empty if condition 'False' loadOneModule modname check err = do { doLoad <- check @@ -370,8 +370,7 @@ putSrcSpanDs new_loc thing_inside = updLclEnv (\ env -> env {ds_loc = new_loc}) warnDs :: SDoc -> DsM () warnDs warn = do { env <- getGblEnv ; loc <- getSrcSpanDs - ; let msg = mkWarnMsg loc (ds_unqual env) - (ptext (sLit "Warning:") <+> warn) + ; let msg = mkWarnMsg loc (ds_unqual env) warn ; updMutVar (ds_msgs env) (\ (w,e) -> (w `snocBag` msg, e)) } failWithDs :: SDoc -> DsM a |