Commit 275dde6d authored by chak@cse.unsw.edu.au.'s avatar chak@cse.unsw.edu.au.
Browse files

Fixed two data family bugs

Mon Sep 18 19:06:51 EDT 2006  Manuel M T Chakravarty <chak@cse.unsw.edu.au>
  * Fixed two data family bugs
  Mon Aug 21 15:16:16 EDT 2006  Manuel M T Chakravarty <chak@cse.unsw.edu.au>
    * Fixed two data family bugs
    - Too liberal pattern matching in `tcTyClDecl1'
    - Open TyCons must always be exposed (ie, never be turned into abstract tycons
      during tidying)
parent 0e3e2862
...@@ -39,7 +39,8 @@ import Type ( tidyTopType ) ...@@ -39,7 +39,8 @@ import Type ( tidyTopType )
import TcType ( isFFITy ) import TcType ( isFFITy )
import DataCon ( dataConName, dataConFieldLabels, dataConWrapId_maybe ) import DataCon ( dataConName, dataConFieldLabels, dataConWrapId_maybe )
import TyCon ( TyCon, makeTyConAbstract, tyConDataCons, isNewTyCon, import TyCon ( TyCon, makeTyConAbstract, tyConDataCons, isNewTyCon,
newTyConRep, tyConSelIds, isAlgTyCon, isEnumerationTyCon ) newTyConRep, tyConSelIds, isAlgTyCon,
isEnumerationTyCon, isOpenTyCon )
import Class ( classSelIds ) import Class ( classSelIds )
import Module ( Module ) import Module ( Module )
import HscTypes ( HscEnv(..), NameCache( nsUniqs ), CgGuts(..), import HscTypes ( HscEnv(..), NameCache( nsUniqs ), CgGuts(..),
...@@ -351,6 +352,8 @@ mustExposeTyCon exports tc ...@@ -351,6 +352,8 @@ mustExposeTyCon exports tc
| isEnumerationTyCon tc -- For an enumeration, exposing the constructors | isEnumerationTyCon tc -- For an enumeration, exposing the constructors
= True -- won't lead to the need for further exposure = True -- won't lead to the need for further exposure
-- (This includes data types with no constructors.) -- (This includes data types with no constructors.)
| isOpenTyCon tc -- open type family
= True
| otherwise -- Newtype, datatype | otherwise -- Newtype, datatype
= any exported_con (tyConDataCons tc) = any exported_con (tyConDataCons tc)
-- Expose rep if any datacon or field is exported -- Expose rep if any datacon or field is exported
......
...@@ -615,7 +615,8 @@ tcTyClDecl calc_isrec decl ...@@ -615,7 +615,8 @@ tcTyClDecl calc_isrec decl
tcTyClDecl1 _calc_isrec tcTyClDecl1 _calc_isrec
(TyFunction {tcdLName = L _ tc_name, tcdTyVars = tvs, tcdKind = kind}) (TyFunction {tcdLName = L _ tc_name, tcdTyVars = tvs, tcdKind = kind})
= tcTyVarBndrs tvs $ \ tvs' -> do = tcTyVarBndrs tvs $ \ tvs' -> do
{ gla_exts <- doptM Opt_GlasgowExts { traceTc (text "type family: " <+> ppr tc_name)
; gla_exts <- doptM Opt_GlasgowExts
-- Check that we don't use kind signatures without Glasgow extensions -- Check that we don't use kind signatures without Glasgow extensions
; checkTc gla_exts $ badSigTyDecl tc_name ; checkTc gla_exts $ badSigTyDecl tc_name
...@@ -626,9 +627,10 @@ tcTyClDecl1 _calc_isrec ...@@ -626,9 +627,10 @@ tcTyClDecl1 _calc_isrec
-- kind signature for an indexed data type -- kind signature for an indexed data type
tcTyClDecl1 _calc_isrec tcTyClDecl1 _calc_isrec
(TyData {tcdND = new_or_data, tcdCtxt = ctxt, tcdTyVars = tvs, (TyData {tcdND = new_or_data, tcdCtxt = ctxt, tcdTyVars = tvs,
tcdLName = L _ tc_name, tcdKindSig = mb_ksig, tcdCons = []}) tcdLName = L _ tc_name, tcdKindSig = Just ksig, tcdCons = []})
= tcTyVarBndrs tvs $ \ tvs' -> do = tcTyVarBndrs tvs $ \ tvs' -> do
{ extra_tvs <- tcDataKindSig mb_ksig { traceTc (text "data/newtype family: " <+> ppr tc_name)
; extra_tvs <- tcDataKindSig (Just ksig)
; let final_tvs = tvs' ++ extra_tvs -- we may not need these ; let final_tvs = tvs' ++ extra_tvs -- we may not need these
; checkTc (null . unLoc $ ctxt) $ badKindSigCtxt tc_name ; checkTc (null . unLoc $ ctxt) $ badKindSigCtxt tc_name
......
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