diff options
author | simonpj@microsoft.com <unknown> | 2010-09-02 07:32:11 +0000 |
---|---|---|
committer | simonpj@microsoft.com <unknown> | 2010-09-02 07:32:11 +0000 |
commit | 4beee1c6a1c81951378805af8f63fe1f45d09e76 (patch) | |
tree | ef56cf3770331f568479410b92e77c8b1e31b37f /compiler/coreSyn | |
parent | bd8a952b1ec55c1c8fe6db968f8f0cc08596a550 (diff) | |
download | haskell-4beee1c6a1c81951378805af8f63fe1f45d09e76.tar.gz |
Add aserts
Diffstat (limited to 'compiler/coreSyn')
-rw-r--r-- | compiler/coreSyn/MkCore.lhs | 15 |
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 |