Commit 0aa7f2ee authored by simonpj's avatar simonpj
Browse files

[project @ 2005-02-03 13:11:44 by simonpj]

Fix another substitution-related bug in CoreLint
parent 30881c00
...@@ -33,7 +33,7 @@ import Type ( Type, tyVarsOfType, coreEqType, ...@@ -33,7 +33,7 @@ import Type ( Type, tyVarsOfType, coreEqType,
isUnLiftedType, typeKind, mkForAllTy, mkFunTy, isUnLiftedType, typeKind, mkForAllTy, mkFunTy,
isUnboxedTupleType, isSubKind, isUnboxedTupleType, isSubKind,
substTyWith, emptyTvSubst, extendTvInScope, substTyWith, emptyTvSubst, extendTvInScope,
TvSubst, TvSubstEnv, setTvSubstEnv, substTy, TvSubst, TvSubstEnv, mkTvSubst, setTvSubstEnv, substTy,
extendTvSubst, composeTvSubst, isInScope, extendTvSubst, composeTvSubst, isInScope,
getTvSubstEnv, getTvInScope ) getTvSubstEnv, getTvInScope )
import TyCon ( isPrimTyCon ) import TyCon ( isPrimTyCon )
...@@ -425,9 +425,8 @@ checkAltExpr expr ann_ty ...@@ -425,9 +425,8 @@ checkAltExpr expr ann_ty
= do { actual_ty <- lintCoreExpr expr = do { actual_ty <- lintCoreExpr expr
; checkTys actual_ty ann_ty (mkCaseAltMsg expr actual_ty ann_ty) } ; checkTys actual_ty ann_ty (mkCaseAltMsg expr actual_ty ann_ty) }
lintCoreAlt :: Type -- Type of scrutinee; a fixed point of lintCoreAlt :: OutType -- Type of scrutinee
-- the substitution -> OutType -- Type of the alternative
-> Type -- Type of the alternative
-> CoreAlt -> CoreAlt
-> LintM () -> LintM ()
...@@ -437,8 +436,7 @@ lintCoreAlt scrut_ty alt_ty alt@(DEFAULT, args, rhs) = ...@@ -437,8 +436,7 @@ lintCoreAlt scrut_ty alt_ty alt@(DEFAULT, args, rhs) =
lintCoreAlt scrut_ty alt_ty alt@(LitAlt lit, args, rhs) = lintCoreAlt scrut_ty alt_ty alt@(LitAlt lit, args, rhs) =
do { checkL (null args) (mkDefaultArgsMsg args) do { checkL (null args) (mkDefaultArgsMsg args)
; checkTys lit_ty scrut_ty ; checkTys lit_ty scrut_ty (mkBadPatMsg lit_ty scrut_ty)
(mkBadPatMsg lit_ty scrut_ty)
; checkAltExpr rhs alt_ty } ; checkAltExpr rhs alt_ty }
where where
lit_ty = literalType lit lit_ty = literalType lit
...@@ -477,7 +475,11 @@ lintCoreAlt scrut_ty alt_ty alt@(DataAlt con, args, rhs) ...@@ -477,7 +475,11 @@ lintCoreAlt scrut_ty alt_ty alt@(DataAlt con, args, rhs)
; con_type <- lintTyApps (dataConRepType con) tvs' ; con_type <- lintTyApps (dataConRepType con) tvs'
; mapM lintBinder ids -- Lint Ids in the refined world ; mapM lintBinder ids -- Lint Ids in the refined world
; lintCoreArgs con_type (map Var ids) ; lintCoreArgs con_type (map Var ids)
; checkAltExpr rhs alt_ty ; let refined_alt_ty = substTy (mkTvSubst in_scope refine) alt_ty
-- alt_ty is already an OutType, so don't re-apply
-- the current substitution. But we must apply the
-- refinement so that the check in checkAltExpr is ok
; checkAltExpr rhs refined_alt_ty
} } } } } }
| otherwise -- Scrut-ty is wrong shape | otherwise -- Scrut-ty is wrong shape
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment