summaryrefslogtreecommitdiff
path: root/compiler/coreSyn
diff options
context:
space:
mode:
authorsimonpj@microsoft.com <unknown>2010-09-02 07:32:11 +0000
committersimonpj@microsoft.com <unknown>2010-09-02 07:32:11 +0000
commit4beee1c6a1c81951378805af8f63fe1f45d09e76 (patch)
treeef56cf3770331f568479410b92e77c8b1e31b37f /compiler/coreSyn
parentbd8a952b1ec55c1c8fe6db968f8f0cc08596a550 (diff)
downloadhaskell-4beee1c6a1c81951378805af8f63fe1f45d09e76.tar.gz
Add aserts
Diffstat (limited to 'compiler/coreSyn')
-rw-r--r--compiler/coreSyn/MkCore.lhs15
1 files changed, 9 insertions, 6 deletions
diff --git a/compiler/coreSyn/MkCore.lhs b/compiler/coreSyn/MkCore.lhs
index f7c0f9ab6f..7714b586fe 100644
--- a/compiler/coreSyn/MkCore.lhs
+++ b/compiler/coreSyn/MkCore.lhs
@@ -52,12 +52,12 @@ import Type
import TysPrim ( alphaTyVar )
import DataCon ( DataCon, dataConWorkId )
+import Outputable
import FastString
import UniqSupply
import Unique ( mkBuiltinUnique )
import BasicTypes
import Util ( notNull, zipEqual )
-import Panic
import Constants
import Data.Char ( ord )
@@ -93,20 +93,23 @@ mkCoreApp :: CoreExpr -> CoreExpr -> CoreExpr
-- Check the invariant that the arg of an App is ok-for-speculation if unlifted
-- See CoreSyn Note [CoreSyn let/app invariant]
mkCoreApp fun (Type ty) = App fun (Type ty)
-mkCoreApp fun arg = mk_val_app fun arg arg_ty res_ty
+mkCoreApp fun arg = ASSERT2( isFunTy fun_ty, ppr fun $$ ppr arg )
+ mk_val_app fun arg arg_ty res_ty
where
- (arg_ty, res_ty) = splitFunTy (exprType fun)
+ fun_ty = exprType fun
+ (arg_ty, res_ty) = splitFunTy fun_ty
-- | Construct an expression which represents the application of a number of
-- expressions to another. The leftmost expression in the list is applied first
mkCoreApps :: CoreExpr -> [CoreExpr] -> CoreExpr
-- Slightly more efficient version of (foldl mkCoreApp)
-mkCoreApps fun args
- = go fun (exprType fun) args
+mkCoreApps orig_fun orig_args
+ = go orig_fun (exprType orig_fun) orig_args
where
go fun _ [] = fun
go fun fun_ty (Type ty : args) = go (App fun (Type ty)) (applyTy fun_ty ty) args
- go fun fun_ty (arg : args) = go (mk_val_app fun arg arg_ty res_ty) res_ty args
+ go fun fun_ty (arg : args) = ASSERT2( isFunTy fun_ty, ppr fun_ty $$ ppr orig_fun $$ ppr orig_args )
+ go (mk_val_app fun arg arg_ty res_ty) res_ty args
where
(arg_ty, res_ty) = splitFunTy fun_ty