Commit 272fb49e authored by chak@cse.unsw.edu.au.'s avatar chak@cse.unsw.edu.au.
Browse files

checkTauTvUpdate: take synonym families into account

parent c4ff47ea
......@@ -560,8 +560,8 @@ isTauTy other = False
isTauTyCon :: TyCon -> Bool
-- Returns False for type synonyms whose expansion is a polytype
isTauTyCon tc
| isSynTyCon tc && not (isOpenTyCon tc) = isTauTy (snd (synTyConDefn tc))
| otherwise = True
| isClosedSynTyCon tc = isTauTy (snd (synTyConDefn tc))
| otherwise = True
---------------
isBoxyTy :: TcType -> Bool
......
......@@ -1366,7 +1366,11 @@ checkTauTvUpdate orig_tv orig_ty
; case mb_tys' of
Just tys' -> return (TyConApp tc tys')
-- Retain the synonym (the common case)
Nothing -> go (expectJust "checkTauTvUpdate"
Nothing | isOpenTyCon tc
-> notMonoArgs (TyConApp tc tys)
-- Synonym families must have monotype args
| otherwise
-> go (expectJust "checkTauTvUpdate"
(tcView (TyConApp tc tys)))
-- Try again, expanding the synonym
}
......@@ -1588,6 +1592,13 @@ notMonoType ty
msg = ptext SLIT("Cannot match a monotype with") <+> quotes (ppr tidy_ty)
; failWithTcM (env1, msg) }
notMonoArgs ty
= do { ty' <- zonkTcType ty
; env0 <- tcInitTidyEnv
; let (env1, tidy_ty) = tidyOpenType env0 ty'
msg = ptext SLIT("Arguments of synonym family must be monotypes") <+> quotes (ppr tidy_ty)
; failWithTcM (env1, msg) }
occurCheck tyvar ty
= do { env0 <- tcInitTidyEnv
; ty' <- zonkTcType ty
......
......@@ -17,8 +17,8 @@ module TyCon(
SynTyConRhs(..),
isFunTyCon, isUnLiftedTyCon, isProductTyCon,
isAlgTyCon, isDataTyCon, isSynTyCon, isNewTyCon, isClosedNewTyCon,
isPrimTyCon,
isAlgTyCon, isDataTyCon, isNewTyCon, isClosedNewTyCon, isSynTyCon,
isClosedSynTyCon, isPrimTyCon,
isEnumerationTyCon, isGadtSyntaxTyCon, isOpenTyCon,
assocTyConArgPoss_maybe, isTyConAssoc, setTyConArgPoss,
isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, tupleTyConBoxity,
......@@ -600,6 +600,13 @@ isSynTyCon :: TyCon -> Bool
isSynTyCon (SynTyCon {}) = True
isSynTyCon _ = False
-- As for newtypes, it is in some contexts important to distinguish between
-- closed synonyms and synonym families, as synonym families have no unique
-- right hand side to which a synonym family application can expand.
--
isClosedSynTyCon :: TyCon -> Bool
isClosedSynTyCon tycon = isSynTyCon tycon && not (isOpenTyCon tycon)
isGadtSyntaxTyCon :: TyCon -> Bool
isGadtSyntaxTyCon (AlgTyCon { algTcGadtSyntax = res }) = res
isGadtSyntaxTyCon other = False
......
Markdown is supported
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