X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcoreSyn%2FCoreUtils.lhs;h=07709c8a42c6d624a1bbcac65c5a538e1f0d4ef5;hb=55a95e74e844fee27a9990beb9350b033a4e1344;hp=0fe04cbd2b8b559f01c55c1faef1516fb6a0b728;hpb=a26a4f61262227c1efcf608b94e3ce20c660b50c;p=ghc-hetmet.git diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs index 0fe04cb..07709c8 100644 --- a/compiler/coreSyn/CoreUtils.lhs +++ b/compiler/coreSyn/CoreUtils.lhs @@ -154,12 +154,16 @@ applyTypeToArgs e op_ty (Type ty : args) go rev_tys (Type ty : args) = go (ty:rev_tys) args go rev_tys rest_args = applyTypeToArgs e op_ty' rest_args where - op_ty' = applyTys op_ty (reverse rev_tys) + op_ty' = applyTysD msg op_ty (reverse rev_tys) + msg = panic_msg e op_ty applyTypeToArgs e op_ty (_ : args) = case (splitFunTy_maybe op_ty) of Just (_, res_ty) -> applyTypeToArgs e res_ty args - Nothing -> pprPanic "applyTypeToArgs" (pprCoreExpr e $$ ppr op_ty) + Nothing -> pprPanic "applyTypeToArgs" (panic_msg e op_ty) + +panic_msg :: CoreExpr -> Type -> SDoc +panic_msg e op_ty = pprCoreExpr e $$ ppr op_ty \end{code} %************************************************************************ @@ -1474,7 +1478,7 @@ hashExpr :: CoreExpr -> Int hashExpr e = fromIntegral (hash_expr (1,emptyVarEnv) e .&. 0x7fffffff) -- UniqFM doesn't like negative Ints -type HashEnv = (Int, VarEnv Int) -- ^ Hash code for bound variables +type HashEnv = (Int, VarEnv Int) -- Hash code for bound variables hash_expr :: HashEnv -> CoreExpr -> Word32 -- Word32, because we're expecting overflows here, and overflowing