From: simonpj <unknown>
Date: Mon, 16 May 2005 12:39:15 +0000 (+0000)
Subject: [project @ 2005-05-16 12:39:15 by simonpj]
X-Git-Tag: Initial_conversion_from_CVS_complete~548
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=4898649ce5d8bd677450988f6c3d3a39e146daac;p=ghc-hetmet.git

[project @ 2005-05-16 12:39:15 by simonpj]
Add assertions (only)
---

diff --git a/ghc/compiler/basicTypes/DataCon.lhs b/ghc/compiler/basicTypes/DataCon.lhs
index cce7cbd..2cacc14 100644
--- a/ghc/compiler/basicTypes/DataCon.lhs
+++ b/ghc/compiler/basicTypes/DataCon.lhs
@@ -496,11 +496,13 @@ dataConArgTys :: DataCon
 				--     but EXCLUDE the data-decl context which is discarded
 				-- It's all post-flattening etc; this is a representation type
 dataConArgTys (MkData {dcRepArgTys = arg_tys, dcTyVars = tyvars}) inst_tys
- = map (substTyWith tyvars inst_tys) arg_tys
+ = ASSERT( length tyvars == length inst_tys )
+   map (substTyWith tyvars inst_tys) arg_tys
 
 dataConResTy :: DataCon -> [Type] -> Type
 dataConResTy (MkData {dcTyVars = tyvars, dcTyCon = tc, dcResTys = res_tys}) inst_tys
- = substTy (zipTopTvSubst tyvars inst_tys) (mkTyConApp tc res_tys)
+ = ASSERT( length tyvars == length inst_tys )
+   substTy (zipTopTvSubst tyvars inst_tys) (mkTyConApp tc res_tys)
 	-- zipTopTvSubst because the res_tys can't contain any foralls
 
 -- And the same deal for the original arg tys
@@ -508,6 +510,7 @@ dataConResTy (MkData {dcTyVars = tyvars, dcTyCon = tc, dcResTys = res_tys}) inst
 dataConInstOrigArgTys :: DataCon -> [Type] -> [Type]
 dataConInstOrigArgTys (MkData {dcOrigArgTys = arg_tys, dcTyVars = tyvars, dcVanilla = is_vanilla}) inst_tys
  = ASSERT( is_vanilla ) 
+   ASSERT( length tyvars == length inst_tys )
    map (substTyWith tyvars inst_tys) arg_tys
 
 dataConStupidTheta :: DataCon -> ThetaType
diff --git a/ghc/compiler/types/Type.lhs b/ghc/compiler/types/Type.lhs
index 7fa651a..a376cf7 100644
--- a/ghc/compiler/types/Type.lhs
+++ b/ghc/compiler/types/Type.lhs
@@ -588,8 +588,9 @@ splitRecNewType_maybe (TyConApp tc tys)
 						-- 	to *types* (of kind *)
     ASSERT( isRecursiveTyCon tc ) 		-- Guaranteed by coreView
     case newTyConRhs tc of
-	(tvs, rep_ty) -> Just (substTyWith tvs tys rep_ty)
-
+	(tvs, rep_ty) -> ASSERT( length tvs == length tys )
+			 Just (substTyWith tvs tys rep_ty)
+	
 splitRecNewType_maybe other = Nothing
 \end{code}
 
@@ -1082,6 +1083,11 @@ mkOpenTvSubst env = TvSubst (mkInScopeSet (tyVarsOfTypes (varEnvElts env))) env
 
 zipOpenTvSubst :: [TyVar] -> [Type] -> TvSubst
 zipOpenTvSubst tyvars tys 
+#ifdef DEBUG
+  | length tyvars /= length tys
+  = pprTrace "zipOpenTvSubst" (ppr tyvars $$ ppr tys) emptyTvSubst
+  | otherwise
+#endif
   = TvSubst (mkInScopeSet (tyVarsOfTypes tys)) (zipTyEnv tyvars tys)
 
 -- mkTopTvSubst is called when doing top-level substitutions.
@@ -1091,7 +1097,13 @@ mkTopTvSubst :: [(TyVar, Type)] -> TvSubst
 mkTopTvSubst prs = TvSubst emptyInScopeSet (mkVarEnv prs)
 
 zipTopTvSubst :: [TyVar] -> [Type] -> TvSubst
-zipTopTvSubst tyvars tys = TvSubst emptyInScopeSet (zipTyEnv tyvars tys)
+zipTopTvSubst tyvars tys 
+#ifdef DEBUG
+  | length tyvars /= length tys
+  = pprTrace "zipOpenTvSubst" (ppr tyvars $$ ppr tys) emptyTvSubst
+  | otherwise
+#endif
+  = TvSubst emptyInScopeSet (zipTyEnv tyvars tys)
 
 zipTyEnv :: [TyVar] -> [Type] -> TvSubstEnv
 zipTyEnv tyvars tys
@@ -1134,7 +1146,8 @@ instance Outputable TvSubst where
 
 \begin{code}
 substTyWith :: [TyVar] -> [Type] -> Type -> Type
-substTyWith tvs tys = substTy (zipOpenTvSubst tvs tys)
+substTyWith tvs tys = ASSERT( length tvs == length tys )
+		      substTy (zipOpenTvSubst tvs tys)
 
 substTy :: TvSubst -> Type  -> Type
 substTy subst ty | isEmptyTvSubst subst = ty