Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
4898649c
Commit
4898649c
authored
May 16, 2005
by
simonpj
Browse files
[project @ 2005-05-16 12:39:15 by simonpj]
Add assertions (only)
parent
edaedc5b
Changes
2
Hide whitespace changes
Inline
Side-by-side
ghc/compiler/basicTypes/DataCon.lhs
View file @
4898649c
...
...
@@ -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
...
...
ghc/compiler/types/Type.lhs
View file @
4898649c
...
...
@@ -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
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment