summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEdward Z. Yang <ezyang@cs.stanford.edu>2016-06-24 11:03:47 -0700
committerEdward Z. Yang <ezyang@cs.stanford.edu>2016-06-30 10:43:28 -0700
commitb8b3e30a6eedf9f213b8a718573c4827cfa230ba (patch)
treecc8f8394fbf92afa12a5aa0bcc0e664d4f841efb
parent480e0661fb45395610d6b4a7c586a580d30d8df4 (diff)
downloadhaskell-b8b3e30a6eedf9f213b8a718573c4827cfa230ba.tar.gz
Axe RecFlag on TyCons.
Summary: This commit removes the information about whether or not a TyCon is "recursive", as well as the code responsible for calculating this information. The original trigger for this change was complexity regarding how we computed the RecFlag for hs-boot files. The problem is that in order to determine if a TyCon is recursive or not, we need to determine if it was defined in an hs-boot file (if so, we conservatively assume that it is recursive.) It turns that doing this is quite tricky. The "obvious" strategy is to typecheck the hi-boot file (since we are eventually going to need the typechecked types to check if we properly implemented the hi-boot file) and just extract the names of all defined TyCons from the ModDetails, but this actually does not work well if Names from the hi-boot file are being knot-tied via if_rec_types: the "extraction" process will force thunks, which will force the typechecking process earlier than we have actually defined the types locally. Rather than work around all this trickiness (it certainly can be worked around, either by making interface loading MORE lazy, or just reading of the set of defined TyCons directly from the ModIface), we instead opted to excise the source of the problem, the RecFlag. For one, it is not clear if the RecFlag even makes sense, in the presence of higher-orderness: data T f a = MkT (f a) T doesn't look recursive, but if we instantiate f with T, then it very well is! It was all very shaky. So we just don't bother anymore. This has two user-visible implications: 1. is_too_recursive now assumes that all TyCons are recursive and will bail out in a way that is still mysterious to me if there are too many TyCons. 2. checkRecTc, which is used when stripping newtypes to get to representation, also assumes all TyCons are recursive, and will stop running if we hit the limit. The biggest risk for this patch is that we specialize less than we used to; however, the codeGen tests still seem to be passing. Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu> Reviewers: simonpj, austin, bgamari Subscribers: goldfire, thomie Differential Revision: https://phabricator.haskell.org/D2360
Diffstat
-rw-r--r--compiler/basicTypes/DataCon.hs5
-rw-r--r--compiler/iface/BuildTyCl.hs5
-rw-r--r--compiler/iface/IfaceSyn.hs30
-rw-r--r--compiler/iface/MkIface.hs5
-rw-r--r--compiler/iface/TcIface.hs8
-rw-r--r--compiler/prelude/TysWiredIn.hs49
-rw-r--r--compiler/specialise/SpecConstr.hs8
-rw-r--r--compiler/typecheck/TcInstDcls.hs2
-rw-r--r--compiler/typecheck/TcTyClsDecls.hs44
-rw-r--r--compiler/typecheck/TcTyDecls.hs234
-rw-r--r--compiler/types/TyCon.hs25
-rw-r--r--compiler/vectorise/Vectorise/Generic/PData.hs3
-rw-r--r--compiler/vectorise/Vectorise/Type/TyConDecl.hs11
13 files changed, 79 insertions, 350 deletions
diff --git a/compiler/basicTypes/DataCon.hs b/compiler/basicTypes/DataCon.hs
index 2b508d6abd..27ac483120 100644
--- a/compiler/basicTypes/DataCon.hs
+++ b/compiler/basicTypes/DataCon.hs
@@ -1283,14 +1283,13 @@ buildAlgTyCon :: Name
-> Maybe CType
-> ThetaType -- ^ Stupid theta
-> AlgTyConRhs
- -> RecFlag
-> Bool -- ^ True <=> was declared in GADT syntax
-> AlgTyConFlav
-> TyCon
buildAlgTyCon tc_name ktvs roles cType stupid_theta rhs
- is_rec gadt_syn parent
+ gadt_syn parent
= mkAlgTyCon tc_name binders liftedTypeKind roles cType stupid_theta
- rhs parent is_rec gadt_syn
+ rhs parent gadt_syn
where
binders = mkTyConBindersPreferAnon ktvs liftedTypeKind
diff --git a/compiler/iface/BuildTyCl.hs b/compiler/iface/BuildTyCl.hs
index 007f458c80..f23bbb3794 100644
--- a/compiler/iface/BuildTyCl.hs
+++ b/compiler/iface/BuildTyCl.hs
@@ -285,11 +285,10 @@ buildClass :: Name -- Name of the class/tycon (they have the same Name)
-> [ClassATItem] -- Associated types
-> [TcMethInfo] -- Method info
-> ClassMinimalDef -- Minimal complete definition
- -> RecFlag -- Info for type constructor
-> TcRnIf m n Class
buildClass tycon_name binders roles sc_theta
- fds at_items sig_stuff mindef tc_isrec
+ fds at_items sig_stuff mindef
= fixM $ \ rec_clas -> -- Only name generation inside loop
do { traceIf (text "buildClass")
@@ -356,7 +355,7 @@ buildClass tycon_name binders roles sc_theta
else return (mkDataTyConRhs [dict_con])
; let { tycon = mkClassTyCon tycon_name binders roles
- rhs rec_clas tc_isrec tc_rep_name
+ rhs rec_clas tc_rep_name
-- A class can be recursive, and in the case of newtypes
-- this matters. For example
-- class C a where { op :: C b => a -> b -> Int }
diff --git a/compiler/iface/IfaceSyn.hs b/compiler/iface/IfaceSyn.hs
index 283da53e87..689452f859 100644
--- a/compiler/iface/IfaceSyn.hs
+++ b/compiler/iface/IfaceSyn.hs
@@ -101,7 +101,6 @@ data IfaceDecl
ifRoles :: [Role], -- Roles
ifCtxt :: IfaceContext, -- The "stupid theta"
ifCons :: IfaceConDecls, -- Includes new/data/data family info
- ifRec :: RecFlag, -- Recursive or not?
ifGadtSyntax :: Bool, -- True <=> declared using
-- GADT syntax
ifParent :: IfaceTyConParent -- The axiom, for a newtype,
@@ -130,9 +129,7 @@ data IfaceDecl
ifFDs :: [FunDep FastString], -- Functional dependencies
ifATs :: [IfaceAT], -- Associated type families
ifSigs :: [IfaceClassOp], -- Method signatures
- ifMinDef :: BooleanFormula IfLclName, -- Minimal complete definition
- ifRec :: RecFlag -- Is newtype/datatype associated
- -- with the class recursive?
+ ifMinDef :: BooleanFormula IfLclName -- Minimal complete definition
}
| IfaceAxiom { ifName :: IfaceTopBndr, -- Axiom name
@@ -625,7 +622,7 @@ pprIfaceDecl :: ShowSub -> IfaceDecl -> SDoc
pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype,
ifCtxt = context,
ifRoles = roles, ifCons = condecls,
- ifParent = parent, ifRec = isrec,
+ ifParent = parent,
ifGadtSyntax = gadt,
ifBinders = binders })
@@ -671,10 +668,10 @@ pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype,
IfDataTyCon{} -> text "data"
IfNewTyCon{} -> text "newtype"
- pp_extra = vcat [pprCType ctype, pprRec isrec]
+ pp_extra = vcat [pprCType ctype]
-pprIfaceDecl ss (IfaceClass { ifATs = ats, ifSigs = sigs, ifRec = isrec
+pprIfaceDecl ss (IfaceClass { ifATs = ats, ifSigs = sigs
, ifCtxt = context, ifName = clas
, ifRoles = roles
, ifFDs = fds, ifMinDef = minDef
@@ -682,14 +679,13 @@ pprIfaceDecl ss (IfaceClass { ifATs = ats, ifSigs = sigs, ifRec = isrec
= vcat [ pprRoles (== Nominal) (pprPrefixIfDeclBndr ss clas) binders roles
, text "class" <+> pprIfaceDeclHead context ss clas binders Nothing
<+> pprFundeps fds <+> pp_where
- , nest 2 (vcat [ vcat asocs, vcat dsigs, pprec
+ , nest 2 (vcat [ vcat asocs, vcat dsigs
, ppShowAllSubs ss (pprMinDef minDef)])]
where
pp_where = ppShowRhs ss $ ppUnless (null sigs && null ats) (text "where")
asocs = ppr_trim $ map maybeShowAssoc ats
dsigs = ppr_trim $ map maybeShowSig sigs
- pprec = ppShowIface ss (pprRec isrec)
maybeShowAssoc :: IfaceAT -> Maybe SDoc
maybeShowAssoc asc@(IfaceAT d _)
@@ -805,10 +801,6 @@ pprRoles suppress_if tyCon bndrs roles
in ppUnless (all suppress_if roles || null froles) $
text "type role" <+> tyCon <+> hsep (map ppr froles)
-pprRec :: RecFlag -> SDoc
-pprRec NonRecursive = Outputable.empty
-pprRec Recursive = text "RecFlag: Recursive"
-
pprInfixIfDeclBndr, pprPrefixIfDeclBndr :: ShowSub -> OccName -> SDoc
pprInfixIfDeclBndr (ShowSub { ss_ppr_bndr = ppr_bndr }) occ
= pprInfixVar (isSymOcc occ) (ppr_bndr occ)
@@ -1453,7 +1445,7 @@ instance Binary IfaceDecl where
put_ bh details
put_ bh idinfo
- put_ bh (IfaceData a1 a2 a3 a4 a5 a6 a7 a8 a9 a10) = do
+ put_ bh (IfaceData a1 a2 a3 a4 a5 a6 a7 a8 a9) = do
putByte bh 2
put_ bh (occNameFS a1)
put_ bh a2
@@ -1464,7 +1456,6 @@ instance Binary IfaceDecl where
put_ bh a7
put_ bh a8
put_ bh a9
- put_ bh a10
put_ bh (IfaceSynonym a1 a2 a3 a4 a5) = do
putByte bh 3
@@ -1483,7 +1474,7 @@ instance Binary IfaceDecl where
put_ bh a5
put_ bh a6
- put_ bh (IfaceClass a1 a2 a3 a4 a5 a6 a7 a8 a9) = do
+ put_ bh (IfaceClass a1 a2 a3 a4 a5 a6 a7 a8) = do
putByte bh 5
put_ bh a1
put_ bh (occNameFS a2)
@@ -1493,7 +1484,6 @@ instance Binary IfaceDecl where
put_ bh a6
put_ bh a7
put_ bh a8
- put_ bh a9
put_ bh (IfaceAxiom a1 a2 a3 a4) = do
putByte bh 6
@@ -1535,9 +1525,8 @@ instance Binary IfaceDecl where
a7 <- get bh
a8 <- get bh
a9 <- get bh
- a10 <- get bh
occ <- return $! mkTcOccFS a1
- return (IfaceData occ a2 a3 a4 a5 a6 a7 a8 a9 a10)
+ return (IfaceData occ a2 a3 a4 a5 a6 a7 a8 a9)
3 -> do a1 <- get bh
a2 <- get bh
a3 <- get bh
@@ -1561,9 +1550,8 @@ instance Binary IfaceDecl where
a6 <- get bh
a7 <- get bh
a8 <- get bh
- a9 <- get bh
occ <- return $! mkClsOccFS a2
- return (IfaceClass a1 occ a3 a4 a5 a6 a7 a8 a9)
+ return (IfaceClass a1 occ a3 a4 a5 a6 a7 a8)
6 -> do a1 <- get bh
a2 <- get bh
a3 <- get bh
diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs
index 1aa3111655..d6a70e4d43 100644
--- a/compiler/iface/MkIface.hs
+++ b/compiler/iface/MkIface.hs
@@ -1409,7 +1409,6 @@ tyConToIfaceDecl env tycon
ifRoles = tyConRoles tycon,
ifCtxt = tidyToIfaceContext tc_env1 (tyConStupidTheta tycon),
ifCons = ifaceConDecls (algTyConRhs tycon) (algTcFields tycon),
- ifRec = boolToRecFlag (isRecursiveTyCon tycon),
ifGadtSyntax = isGadtSyntaxTyCon tycon,
ifParent = parent })
@@ -1425,7 +1424,6 @@ tyConToIfaceDecl env tycon
ifRoles = tyConRoles tycon,
ifCtxt = [],
ifCons = IfDataTyCon [] False [],
- ifRec = boolToRecFlag False,
ifGadtSyntax = False,
ifParent = IfNoParent })
where
@@ -1526,8 +1524,7 @@ classToIfaceDecl env clas
ifFDs = map toIfaceFD clas_fds,
ifATs = map toIfaceAT clas_ats,
ifSigs = map toIfaceClassOp op_stuff,
- ifMinDef = fmap getOccFS (classMinimalDef clas),
- ifRec = boolToRecFlag (isRecursiveTyCon tycon) })
+ ifMinDef = fmap getOccFS (classMinimalDef clas) })
where
(_, clas_fds, sc_theta, _, clas_ats, op_stuff)
= classExtraBigSig clas
diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs
index d0ddd55197..5ffef1acfe 100644
--- a/compiler/iface/TcIface.hs
+++ b/compiler/iface/TcIface.hs
@@ -320,7 +320,7 @@ tc_iface_decl _ _ (IfaceData {ifName = occ_name,
ifRoles = roles,
ifCtxt = ctxt, ifGadtSyntax = gadt_syn,
ifCons = rdr_cons,
- ifRec = is_rec, ifParent = mb_parent })
+ ifParent = mb_parent })
= bindIfaceTyConBinders_AT binders $ \ binders' -> do
{ tc_name <- lookupIfaceTop occ_name
; res_kind' <- tcIfaceType res_kind
@@ -331,7 +331,7 @@ tc_iface_decl _ _ (IfaceData {ifName = occ_name,
; cons <- tcIfaceDataCons tc_name tycon binders' rdr_cons
; return (mkAlgTyCon tc_name binders' res_kind'
roles cType stupid_theta
- cons parent' is_rec gadt_syn) }
+ cons parent' gadt_syn) }
; traceIf (text "tcIfaceDecl4" <+> ppr tycon)
; return (ATyCon tycon) }
where
@@ -397,7 +397,7 @@ tc_iface_decl _parent ignore_prags
ifBinders = binders,
ifFDs = rdr_fds,
ifATs = rdr_ats, ifSigs = rdr_sigs,
- ifMinDef = mindef_occ, ifRec = tc_isrec })
+ ifMinDef = mindef_occ })
-- ToDo: in hs-boot files we should really treat abstract classes specially,
-- as we do abstract tycons
= bindIfaceTyConBinders binders $ \ binders' -> do
@@ -412,7 +412,7 @@ tc_iface_decl _parent ignore_prags
; cls <- fixM $ \ cls -> do
{ ats <- mapM (tc_at cls) rdr_ats
; traceIf (text "tc-iface-class4" <+> ppr tc_occ)
- ; buildClass tc_name binders' roles ctxt fds ats sigs mindef tc_isrec }
+ ; buildClass tc_name binders' roles ctxt fds ats sigs mindef }
; return (ATyCon (classTyCon cls)) }
where
tc_sc pred = forkM (mk_sc_doc pred) (tcIfaceType pred)
diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs
index 228c4d1103..51f5555dd3 100644
--- a/compiler/prelude/TysWiredIn.hs
+++ b/compiler/prelude/TysWiredIn.hs
@@ -136,7 +136,7 @@ import Class ( Class, mkClass )
import RdrName
import Name
import NameSet ( NameSet, mkNameSet, elemNameSet )
-import BasicTypes ( Arity, RecFlag(..), Boxity(..),
+import BasicTypes ( Arity, Boxity(..),
TupleSort(..) )
import ForeignCall
import SrcLoc ( noSrcSpan )
@@ -446,14 +446,14 @@ parrTyCon_RDR = nameRdrName parrTyConName
************************************************************************
-}
-pcNonRecDataTyCon :: Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
+pcNonEnumTyCon :: Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
-- Not an enumeration
-pcNonRecDataTyCon = pcTyCon False NonRecursive
+pcNonEnumTyCon = pcTyCon False
-- This function assumes that the types it creates have all parameters at
-- Representational role, and that there is no kind polymorphism.
-pcTyCon :: Bool -> RecFlag -> Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
-pcTyCon is_enum is_rec name cType tyvars cons
+pcTyCon :: Bool -> Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
+pcTyCon is_enum name cType tyvars cons
= mkAlgTyCon name
(mkAnonTyConBinders tyvars)
liftedTypeKind
@@ -462,7 +462,6 @@ pcTyCon is_enum is_rec name cType tyvars cons
[] -- No stupid theta
(DataTyCon cons is_enum)
(VanillaAlgTyCon (mkPrelTyConRepName name))
- is_rec
False -- Not in GADT syntax
pcDataCon :: Name -> [TyVar] -> [Type] -> TyCon -> DataCon
@@ -535,15 +534,15 @@ pcSpecialDataCon dc_name arg_tys tycon rri
typeNatKindCon, typeSymbolKindCon :: TyCon
-- data Nat
-- data Symbol
-typeNatKindCon = pcTyCon False NonRecursive typeNatKindConName Nothing [] []
-typeSymbolKindCon = pcTyCon False NonRecursive typeSymbolKindConName Nothing [] []
+typeNatKindCon = pcTyCon False typeNatKindConName Nothing [] []
+typeSymbolKindCon = pcTyCon False typeSymbolKindConName Nothing [] []
typeNatKind, typeSymbolKind :: Kind
typeNatKind = mkTyConTy typeNatKindCon
typeSymbolKind = mkTyConTy typeSymbolKindCon
constraintKindTyCon :: TyCon
-constraintKindTyCon = pcTyCon False NonRecursive constraintKindTyConName
+constraintKindTyCon = pcTyCon False constraintKindTyConName
Nothing [] []
liftedTypeKind, constraintKind, unboxedTupleKind :: Kind
@@ -826,7 +825,7 @@ heqSCSelId, coercibleSCSelId :: Id
= (tycon, klass, datacon, sc_sel_id)
where
tycon = mkClassTyCon heqTyConName binders roles
- rhs klass NonRecursive
+ rhs klass
(mkPrelTyConRepName heqTyConName)
klass = mk_class tycon sc_pred sc_sel_id
datacon = pcDataCon heqDataConName tvs [sc_pred] tycon
@@ -844,7 +843,7 @@ heqSCSelId, coercibleSCSelId :: Id
= (tycon, klass, datacon, sc_sel_id)
where
tycon = mkClassTyCon coercibleTyConName binders roles
- rhs klass NonRecursive
+ rhs klass
(mkPrelTyConRepName coercibleTyConName)
klass = mk_class tycon sc_pred sc_sel_id
datacon = pcDataCon coercibleDataConName tvs [sc_pred] tycon
@@ -890,7 +889,7 @@ unicodeStarKindTyCon = mkSynonymTyCon unicodeStarKindTyConName
(tYPE ptrRepLiftedTy)
runtimeRepTyCon :: TyCon
-runtimeRepTyCon = pcNonRecDataTyCon runtimeRepTyConName Nothing []
+runtimeRepTyCon = pcNonEnumTyCon runtimeRepTyConName Nothing []
(vecRepDataCon : runtimeRepSimpleDataCons)
vecRepDataCon :: DataCon
@@ -935,7 +934,7 @@ voidRepDataConTy, intRepDataConTy, wordRepDataConTy, int64RepDataConTy,
runtimeRepSimpleDataCons
vecCountTyCon :: TyCon
-vecCountTyCon = pcNonRecDataTyCon vecCountTyConName Nothing []
+vecCountTyCon = pcNonEnumTyCon vecCountTyConName Nothing []
vecCountDataCons
-- See Note [Wiring in RuntimeRep]
@@ -954,7 +953,7 @@ vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy,
vec64DataConTy] = map (mkTyConTy . promoteDataCon) vecCountDataCons
vecElemTyCon :: TyCon
-vecElemTyCon = pcNonRecDataTyCon vecElemTyConName Nothing [] vecElemDataCons
+vecElemTyCon = pcNonEnumTyCon vecElemTyConName Nothing [] vecElemDataCons
-- See Note [Wiring in RuntimeRep]
vecElemDataCons :: [DataCon]
@@ -992,7 +991,7 @@ charTy :: Type
charTy = mkTyConTy charTyCon
charTyCon :: TyCon
-charTyCon = pcNonRecDataTyCon charTyConName
+charTyCon = pcNonEnumTyCon charTyConName
(Just (CType "" Nothing ("HsChar",fsLit "HsChar")))
[] [charDataCon]
charDataCon :: DataCon
@@ -1005,7 +1004,7 @@ intTy :: Type
intTy = mkTyConTy intTyCon
intTyCon :: TyCon
-intTyCon = pcNonRecDataTyCon intTyConName
+intTyCon = pcNonEnumTyCon intTyConName
(Just (CType "" Nothing ("HsInt",fsLit "HsInt"))) []
[intDataCon]
intDataCon :: DataCon
@@ -1015,7 +1014,7 @@ wordTy :: Type
wordTy = mkTyConTy wordTyCon
wordTyCon :: TyCon
-wordTyCon = pcNonRecDataTyCon wordTyConName
+wordTyCon = pcNonEnumTyCon wordTyConName
(Just (CType "" Nothing ("HsWord", fsLit "HsWord"))) []
[wordDataCon]
wordDataCon :: DataCon
@@ -1025,7 +1024,7 @@ word8Ty :: Type
word8Ty = mkTyConTy word8TyCon
word8TyCon :: TyCon
-word8TyCon = pcNonRecDataTyCon word8TyConName
+word8TyCon = pcNonEnumTyCon word8TyConName
(Just (CType "" Nothing ("HsWord8", fsLit "HsWord8"))) []
[word8DataCon]
word8DataCon :: DataCon
@@ -1035,7 +1034,7 @@ floatTy :: Type
floatTy = mkTyConTy floatTyCon
floatTyCon :: TyCon
-floatTyCon = pcNonRecDataTyCon floatTyConName
+floatTyCon = pcNonEnumTyCon floatTyConName
(Just (CType "" Nothing ("HsFloat", fsLit "HsFloat"))) []
[floatDataCon]
floatDataCon :: DataCon
@@ -1045,7 +1044,7 @@ doubleTy :: Type
doubleTy = mkTyConTy doubleTyCon
doubleTyCon :: TyCon
-doubleTyCon = pcNonRecDataTyCon doubleTyConName
+doubleTyCon = pcNonEnumTyCon doubleTyConName
(Just (CType "" Nothing ("HsDouble",fsLit "HsDouble"))) []
[doubleDataCon]
@@ -1106,7 +1105,7 @@ boolTy :: Type
boolTy = mkTyConTy boolTyCon
boolTyCon :: TyCon
-boolTyCon = pcTyCon True NonRecursive boolTyConName
+boolTyCon = pcTyCon True boolTyConName
(Just (CType "" Nothing ("HsBool", fsLit "HsBool")))
[] [falseDataCon, trueDataCon]
@@ -1119,7 +1118,7 @@ falseDataConId = dataConWorkId falseDataCon
trueDataConId = dataConWorkId trueDataCon
orderingTyCon :: TyCon
-orderingTyCon = pcTyCon True NonRecursive orderingTyConName Nothing
+orderingTyCon = pcTyCon True orderingTyConName Nothing
[] [ltDataCon, eqDataCon, gtDataCon]
ltDataCon, eqDataCon, gtDataCon :: DataCon
@@ -1151,7 +1150,7 @@ listTyCon :: TyCon
listTyCon = buildAlgTyCon listTyConName alpha_tyvar [Representational]
Nothing []
(DataTyCon [nilDataCon, consDataCon] False )
- Recursive False
+ False
(VanillaAlgTyCon $ mkPrelTyConRepName listTyConName)
nilDataCon :: DataCon
@@ -1168,7 +1167,7 @@ consDataCon = pcDataConWithFixity True {- Declared infix -}
-- Wired-in type Maybe
maybeTyCon :: TyCon
-maybeTyCon = pcTyCon False NonRecursive maybeTyConName Nothing alpha_tyvar
+maybeTyCon = pcTyCon False maybeTyConName Nothing alpha_tyvar
[nothingDataCon, justDataCon]
nothingDataCon :: DataCon
@@ -1264,7 +1263,7 @@ mkPArrTy ty = mkTyConApp parrTyCon [ty]
-- @PrelPArr@.
--
parrTyCon :: TyCon
-parrTyCon = pcNonRecDataTyCon parrTyConName Nothing alpha_tyvar [parrDataCon]
+parrTyCon = pcNonEnumTyCon parrTyConName Nothing alpha_tyvar [parrDataCon]
parrDataCon :: DataCon
parrDataCon = pcDataCon
diff --git a/compiler/specialise/SpecConstr.hs b/compiler/specialise/SpecConstr.hs
index 00c68535f3..8cc393cb44 100644
--- a/compiler/specialise/SpecConstr.hs
+++ b/compiler/specialise/SpecConstr.hs
@@ -34,7 +34,7 @@ import DataCon
import Coercion hiding( substCo )
import Rules
import Type hiding ( substTy )
-import TyCon ( isRecursiveTyCon, tyConName )
+import TyCon ( tyConName )
import Id
import PprCore ( pprParendExpr )
import MkCore ( mkImpossibleExpr )
@@ -1834,15 +1834,15 @@ is_too_recursive :: ScEnv -> (CallPat, ValueEnv) -> Bool
-- This is only necessary if ForceSpecConstr is in effect:
-- otherwise specConstrCount will cause specialisation to terminate.
-- See Note [Limit recursive specialisation]
+-- TODO: make me more accurate
is_too_recursive env ((_,exprs), val_env)
= sc_force env && maximum (map go exprs) > sc_recursive env
where
go e
- | Just (ConVal (DataAlt dc) args) <- isValue val_env e
- , isRecursiveTyCon (dataConTyCon dc)
+ | Just (ConVal (DataAlt _) args) <- isValue val_env e
= 1 + sum (map go args)
- |App f a <- e
+ | App f a <- e
= go f + go a
| otherwise
diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs
index d4cc023740..21eea28b99 100644
--- a/compiler/typecheck/TcInstDcls.hs
+++ b/compiler/typecheck/TcInstDcls.hs
@@ -671,7 +671,7 @@ tcDataFamInstDecl mb_clsinfo
(map (const Nominal) full_tvs)
(fmap unLoc cType) stupid_theta
tc_rhs parent
- Recursive gadt_syntax
+ gadt_syntax
-- We always assume that indexed types are recursive. Why?
-- (1) Due to their open nature, we can never be sure that a
-- further instance might not introduce a new recursive
diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs
index ef78c68f19..fe3c713662 100644
--- a/compiler/typecheck/TcTyClsDecls.hs
+++ b/compiler/typecheck/TcTyClsDecls.hs
@@ -185,9 +185,7 @@ tcTyClDecls tyclds role_annots
-- the final TyCons and Classes
; fixM $ \ ~rec_tyclss -> do
{ is_boot <- tcIsHsBootOrSig
- ; self_boot <- tcSelfBootInfo
- ; let rec_flags = calcRecFlags self_boot is_boot
- role_annots rec_tyclss
+ ; let roles = inferRoles is_boot role_annots rec_tyclss
-- Populate environment with knot-tied ATyCon for TyCons
-- NB: if the decls mention any ill-staged data cons
@@ -201,7 +199,7 @@ tcTyClDecls tyclds role_annots
tcExtendKindEnv2 (map mkTcTyConPair tc_tycons) $
-- Kind and type check declarations for this group
- mapM (tcTyClDecl rec_flags) tyclds
+ mapM (tcTyClDecl roles) tyclds
} }
where
ppr_tc_tycon tc = parens (sep [ ppr (tyConName tc) <> comma
@@ -706,8 +704,8 @@ e.g. the need to make the data constructor worker name for
a constraint tuple match the wired-in one
-}
-tcTyClDecl :: RecTyInfo -> LTyClDecl Name -> TcM TyCon
-tcTyClDecl rec_info (L loc decl)
+tcTyClDecl :: RolesInfo -> LTyClDecl Name -> TcM TyCon
+tcTyClDecl roles_info (L loc decl)
| Just thing <- wiredInNameTyThing_maybe (tcdName decl)
= case thing of -- See Note [Declarations for wired-in things]
ATyCon tc -> return tc
@@ -716,28 +714,28 @@ tcTyClDecl rec_info (L loc decl)
| otherwise
= setSrcSpan loc $ tcAddDeclCtxt decl $
do { traceTc "tcTyAndCl-x" (ppr decl)
- ; tcTyClDecl1 Nothing rec_info decl }
+ ; tcTyClDecl1 Nothing roles_info decl }
-- "type family" declarations
-tcTyClDecl1 :: Maybe Class -> RecTyInfo -> TyClDecl Name -> TcM TyCon
-tcTyClDecl1 parent _rec_info (FamDecl { tcdFam = fd })
+tcTyClDecl1 :: Maybe Class -> RolesInfo -> TyClDecl Name -> TcM TyCon
+tcTyClDecl1 parent _roles_info (FamDecl { tcdFam = fd })
= tcFamDecl1 parent fd
-- "type" synonym declaration
-tcTyClDecl1 _parent rec_info
+tcTyClDecl1 _parent roles_info
(SynDecl { tcdLName = L _ tc_name, tcdRhs = rhs })
= ASSERT( isNothing _parent )
tcTyClTyVars tc_name $ \ binders res_kind ->
- tcTySynRhs rec_info tc_name binders res_kind rhs
+ tcTySynRhs roles_info tc_name binders res_kind rhs
-- "data/newtype" declaration
-tcTyClDecl1 _parent rec_info
+tcTyClDecl1 _parent roles_info
(DataDecl { tcdLName = L _ tc_name, tcdDataDefn = defn })
= ASSERT( isNothing _parent )
tcTyClTyVars tc_name $ \ tycon_binders res_kind ->
- tcDataDefn rec_info tc_name tycon_binders res_kind defn
+ tcDataDefn roles_info tc_name tycon_binders res_kind defn
-tcTyClDecl1 _parent rec_info
+tcTyClDecl1 _parent roles_info
(ClassDecl { tcdLName = L _ class_name
, tcdCtxt = ctxt, tcdMeths = meths
, tcdFDs = fundeps, tcdSigs = sigs
@@ -751,8 +749,7 @@ tcTyClDecl1 _parent rec_info
-- need to look up its recursiveness
; traceTc "tcClassDecl 1" (ppr class_name $$ ppr binders)
; let tycon_name = tyConName (classTyCon clas)
- tc_isrec = rti_is_rec rec_info tycon_name
- roles = rti_roles rec_info tycon_name
+ roles = roles_info tycon_name
; ctxt' <- solveEqualities $ tcHsContext ctxt
; ctxt' <- zonkTcTypeToTypes emptyZonkEnv ctxt'
@@ -764,7 +761,7 @@ tcTyClDecl1 _parent rec_info
; clas <- buildClass
class_name binders roles ctxt'
fds' at_stuff
- sig_stuff mindef tc_isrec
+ sig_stuff mindef
; traceTc "tcClassDecl" (ppr fundeps $$ ppr binders $$
ppr fds')
; return clas }
@@ -905,31 +902,31 @@ tcInjectivity tcbs (Just (L loc (InjectivityAnn _ lInjNames)))
, ppr inj_ktvs, ppr inj_bools ])
; return $ Injective inj_bools }
-tcTySynRhs :: RecTyInfo
+tcTySynRhs :: RolesInfo
-> Name
-> [TyConBinder] -> Kind
-> LHsType Name -> TcM TyCon
-tcTySynRhs rec_info tc_name binders res_kind hs_ty
+tcTySynRhs roles_info tc_name binders res_kind hs_ty
= do { env <- getLclEnv
; traceTc "tc-syn" (ppr tc_name $$ ppr (tcl_env env))
; rhs_ty <- solveEqualities $ tcCheckLHsType hs_ty res_kind
; rhs_ty <- zonkTcTypeToType emptyZonkEnv rhs_ty
- ; let roles = rti_roles rec_info tc_name
+ ; let roles = roles_info tc_name
tycon = mkSynonymTyCon tc_name binders res_kind roles rhs_ty
; return tycon }
-tcDataDefn :: RecTyInfo -> Name
+tcDataDefn :: RolesInfo -> Name
-> [TyConBinder] -> Kind
-> HsDataDefn Name -> TcM TyCon
-- NB: not used for newtype/data instances (whether associated or not)
-tcDataDefn rec_info -- Knot-tied; don't look at this eagerly
+tcDataDefn roles_info
tc_name tycon_binders res_kind
(HsDataDefn { dd_ND = new_or_data, dd_cType = cType
, dd_ctxt = ctxt, dd_kindSig = mb_ksig
, dd_cons = cons })
= do { (extra_bndrs, real_res_kind) <- tcDataKindSig res_kind
; let final_bndrs = tycon_binders `chkAppend` extra_bndrs
- roles = rti_roles rec_info tc_name
+ roles = roles_info tc_name
; stupid_tc_theta <- solveEqualities $ tcHsContext ctxt
; stupid_theta <- zonkTcTypeToTypes emptyZonkEnv
@@ -956,7 +953,6 @@ tcDataDefn rec_info -- Knot-tied; don't look at this eagerly
(fmap unLoc cType)
stupid_theta tc_rhs
(VanillaAlgTyCon tc_rep_nm)
- (rti_is_rec rec_info tc_name)
gadt_syntax) }
; return tycon }
where
diff --git a/compiler/typecheck/TcTyDecls.hs b/compiler/typecheck/TcTyDecls.hs
index 825597f5d5..6070227d72 100644
--- a/compiler/typecheck/TcTyDecls.hs
+++ b/compiler/typecheck/TcTyDecls.hs
@@ -12,7 +12,8 @@ files for imported data types.
{-# LANGUAGE CPP #-}
module TcTyDecls(
- calcRecFlags, RecTyInfo(..),
+ RolesInfo,
+ inferRoles,
calcSynCycles,
checkClassCycles,
@@ -47,8 +48,7 @@ import Id
import IdInfo
import VarEnv
import VarSet
-import NameSet ( NameSet, unitNameSet, emptyNameSet, unionNameSet
- , extendNameSet, mkNameSet, elemNameSet )
+import NameSet ( NameSet, unitNameSet, extendNameSet, elemNameSet )
import Coercion ( ltRole )
import Digraph
import BasicTypes
@@ -57,7 +57,6 @@ import Unique ( mkBuiltinUnique )
import Outputable
import Util
import Maybes
-import Data.List
import Bag
import FastString
import FV
@@ -253,231 +252,6 @@ checkClassCycles cls
{-
************************************************************************
* *
- Deciding which type constructors are recursive
-* *
-************************************************************************
-
-Identification of recursive TyCons
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The knot-tying parameters: @rec_details_list@ is an alist mapping @Name@s to
-@TyThing@s.
-
-Identifying a TyCon as recursive serves two purposes
-
-1. Avoid infinite types. Non-recursive newtypes are treated as
-"transparent", like type synonyms, after the type checker. If we did
-this for all newtypes, we'd get infinite types. So we figure out for
-each newtype whether it is "recursive", and add a coercion if so. In
-effect, we are trying to "cut the loops" by identifying a loop-breaker.
-
-2. Avoid infinite unboxing. This has nothing to do with newtypes.
-Suppose we have
- data T = MkT Int T
- f (MkT x t) = f t
-Well, this function diverges, but we don't want the strictness analyser
-to diverge. But the strictness analyser will diverge because it looks
-deeper and deeper into the structure of T. (I believe there are
-examples where the function does something sane, and the strictness
-analyser still diverges, but I can't see one now.)
-
-Now, concerning (1), the FC2 branch currently adds a coercion for ALL
-newtypes. I did this as an experiment, to try to expose cases in which
-the coercions got in the way of optimisations. If it turns out that we
-can indeed always use a coercion, then we don't risk recursive types,
-and don't need to figure out what the loop breakers are.
-
-For newtype *families* though, we will always have a coercion, so they
-are always loop breakers! So you can easily adjust the current
-algorithm by simply treating all newtype families as loop breakers (and
-indeed type families). I think.
-
-
-
-For newtypes, we label some as "recursive" such that
-
- INVARIANT: there is no cycle of non-recursive newtypes
-
-In any loop, only one newtype need be marked as recursive; it is
-a "loop breaker". Labelling more than necessary as recursive is OK,
-provided the invariant is maintained.
-
-A newtype M.T is defined to be "recursive" iff
- (a) it is declared in an hi-boot file (see RdrHsSyn.hsIfaceDecl)
- (b) it is declared in a source file, but that source file has a
- companion hi-boot file which declares the type
- or (c) one can get from T's rhs to T via type
- synonyms, or non-recursive newtypes *in M*
- e.g. newtype T = MkT (T -> Int)
-
-(a) is conservative; declarations in hi-boot files are always
- made loop breakers. That's why in (b) we can restrict attention
- to tycons in M, because any loops through newtypes outside M
- will be broken by those newtypes
-(b) ensures that a newtype is not treated as a loop breaker in one place
-and later as a non-loop-breaker. This matters in GHCi particularly, when
-a newtype T might be embedded in many types in the environment, and then
-T's source module is compiled. We don't want T's recursiveness to change.
-
-The "recursive" flag for algebraic data types is irrelevant (never consulted)
-for types with more than one constructor.
-
-
-An algebraic data type M.T is "recursive" iff
- it has just one constructor, and
- (a) it is declared in an hi-boot file (see RdrHsSyn.hsIfaceDecl)
- (b) it is declared in a source file, but that source file has a
- companion hi-boot file which declares the type
- or (c) one can get from its arg types to T via type synonyms,
- or by non-recursive newtypes or non-recursive product types in M
- e.g. data T = MkT (T -> Int) Bool
-Just like newtype in fact
-
-A type synonym is recursive if one can get from its
-right hand side back to it via type synonyms. (This is
-reported as an error.)
-
-A class is recursive if one can get from its superclasses
-back to it. (This is an error too.)
-
-Hi-boot types
-~~~~~~~~~~~~~
-A data type read from an hi-boot file will have an AbstractTyCon as its AlgTyConRhs
-and will respond True to isAbstractTyCon. The idea is that we treat these as if one
-could get from these types to anywhere. So when we see
-
- module Baz where
- import {-# SOURCE #-} Foo( T )
- newtype S = MkS T
-
-then we mark S as recursive, just in case. What that means is that if we see
-
- import Baz( S )
- newtype R = MkR S
-
-then we don't need to look inside S to compute R's recursiveness. Since S is imported
-(not from an hi-boot file), one cannot get from R back to S except via an hi-boot file,
-and that means that some data type will be marked recursive along the way. So R is
-unconditionly non-recursive (i.e. there'll be a loop breaker elsewhere if necessary)
-
-This in turn means that we grovel through fewer interface files when computing
-recursiveness, because we need only look at the type decls in the module being
-compiled, plus the outer structure of directly-mentioned types.
--}
-
-data RecTyInfo = RTI { rti_roles :: Name -> [Role]
- , rti_is_rec :: Name -> RecFlag }
-
-calcRecFlags :: SelfBootInfo -> Bool -- hs-boot file?
- -> RoleAnnotEnv -> [TyCon] -> RecTyInfo
--- The 'boot_names' are the things declared in M.hi-boot, if M is the current module.
--- Any type constructors in boot_names are automatically considered loop breakers
--- Recursion of newtypes/data types can happen via
--- the class TyCon, so all_tycons includes the class tycons
-calcRecFlags boot_details is_boot mrole_env all_tycons
- = RTI { rti_roles = roles
- , rti_is_rec = is_rec }
- where
- roles = inferRoles is_boot mrole_env all_tycons
-
- ----------------- Recursion calculation ----------------
- is_rec n | n `elemNameSet` rec_names = Recursive
- | otherwise = NonRecursive
-
- boot_name_set = case boot_details of
- NoSelfBoot -> emptyNameSet
- SelfBoot { sb_tcs = tcs } -> tcs
- rec_names = boot_name_set `unionNameSet`
- nt_loop_breakers `unionNameSet`
- prod_loop_breakers
-
-
- -------------------------------------------------
- -- NOTE
- -- These edge-construction loops rely on
- -- every loop going via tyclss, the types and classes
- -- in the module being compiled. Stuff in interface
- -- files should be correctly marked. If not (e.g. a
- -- type synonym in a hi-boot file) we can get an infinite
- -- loop. We could program round this, but it'd make the code
- -- rather less nice, so I'm not going to do that yet.
-
- single_con_tycons = [ tc | tc <- all_tycons
- , not (tyConName tc `elemNameSet` boot_name_set)
- -- Remove the boot_name_set because they are
- -- going to be loop breakers regardless.
- , isSingleton (tyConDataCons tc) ]
- -- Both newtypes and data types, with exactly one data constructor
-
- (new_tycons, prod_tycons) = partition isNewTyCon single_con_tycons
- -- NB: we do *not* call isProductTyCon because that checks
- -- for vanilla-ness of data constructors; and that depends
- -- on empty existential type variables; and that is figured
- -- out by tcResultType; which uses tcMatchTy; which uses
- -- coreView; which calls expandSynTyCon_maybe; which uses
- -- the recursiveness of the TyCon. Result... a black hole.
- -- YUK YUK YUK
-
- --------------- Newtypes ----------------------
- nt_loop_breakers = mkNameSet (findLoopBreakers nt_edges)
- is_rec_nt tc = tyConName tc `elemNameSet` nt_loop_breakers
- -- is_rec_nt is a locally-used helper function
-
- nt_edges = [(t, mk_nt_edges t) | t <- new_tycons]
-
- mk_nt_edges nt -- Invariant: nt is a newtype
- = [ tc | tc <- nonDetEltsUFM (tyConsOfType (new_tc_rhs nt))
- -- tyConsOfType looks through synonyms
- -- It's OK to use nonDetEltsUFM here, see
- -- Note [findLoopBreakers determinism].
- , tc `elem` new_tycons ]
- -- If not (tc `elem` new_tycons) we know that either it's a local *data* type,
- -- or it's imported. Either way, it can't form part of a newtype cycle
-
- --------------- Product types ----------------------
- prod_loop_breakers = mkNameSet (findLoopBreakers prod_edges)
-
- prod_edges = [(tc, mk_prod_edges tc) | tc <- prod_tycons]
-
- mk_prod_edges tc -- Invariant: tc is a product tycon
- = concatMap (mk_prod_edges1 tc) (dataConOrigArgTys (head (tyConDataCons tc)))
-
- mk_prod_edges1 ptc ty = concatMap (mk_prod_edges2 ptc) (nonDetEltsUFM (tyConsOfType ty))
- -- It's OK to use nonDetEltsUFM here, see
- -- Note [findLoopBreakers determinism].
-
- mk_prod_edges2 ptc tc
- | tc `elem` prod_tycons = [tc] -- Local product
- | tc `elem` new_tycons = if is_rec_nt tc -- Local newtype
- then []
- else mk_prod_edges1 ptc (new_tc_rhs tc)
- -- At this point we know that either it's a local non-product data type,
- -- or it's imported. Either way, it can't form part of a cycle
- | otherwise = []
-
-new_tc_rhs :: TyCon -> Type
-new_tc_rhs tc = snd (newTyConRhs tc) -- Ignore the type variables
-
-{-
-Note [findLoopBreakers determinism]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The order of edges doesn't matter for determinism here as explained in
-Note [Deterministic SCC] in Digraph. It's enough for the order of nodes
-to be deterministic.
--}
-
-findLoopBreakers :: [(TyCon, [TyCon])] -> [Name]
--- Finds a set of tycons that cut all loops
-findLoopBreakers deps
- = go [(tc,tc,ds) | (tc,ds) <- deps]
- where
- go edges = [ name
- | CyclicSCC ((tc,_,_) : edges') <-
- stronglyConnCompFromEdgedVerticesUniqR edges,
- name <- tyConName tc : go edges']
-
-{-
-************************************************************************
-* *
Role inference
* *
************************************************************************
@@ -585,6 +359,8 @@ we want to totally ignore coercions when doing role inference. This includes omi
any type variables that appear in nominal positions but only within coercions.
-}
+type RolesInfo = Name -> [Role]
+
type RoleEnv = NameEnv [Role] -- from tycon names to roles
-- This, and any of the functions it calls, must *not* look at the roles
diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs
index be73a9f6cf..d825712e27 100644
--- a/compiler/types/TyCon.hs
+++ b/compiler/types/TyCon.hs
@@ -60,7 +60,6 @@ module TyCon(
isUnliftedTyCon,
isGadtSyntaxTyCon, isInjectiveTyCon, isGenerativeTyCon, isGenInjAlgRhs,
isTyConAssoc, tyConAssoc_maybe,
- isRecursiveTyCon,
isImplicitTyCon,
isTyConWithSrcDataCons,
isTcTyCon,
@@ -590,9 +589,6 @@ data TyCon
algTcFields :: FieldLabelEnv, -- ^ Maps a label to information
-- about the field
- algTcRec :: RecFlag, -- ^ Tells us whether the data type is part
- -- of a mutually-recursive group or not
-
algTcParent :: AlgTyConFlav -- ^ Gives the class or family declaration
-- 'TyCon' for derived 'TyCon's representing
-- class or family instances, respectively.
@@ -1327,10 +1323,9 @@ mkAlgTyCon :: Name
-> AlgTyConRhs -- ^ Information about data constructors
-> AlgTyConFlav -- ^ What flavour is it?
-- (e.g. vanilla, type family)
- -> RecFlag -- ^ Is the 'TyCon' recursive?
-> Bool -- ^ Was the 'TyCon' declared with GADT syntax?
-> TyCon
-mkAlgTyCon name binders res_kind roles cType stupid rhs parent is_rec gadt_syn
+mkAlgTyCon name binders res_kind roles cType stupid rhs parent gadt_syn
= AlgTyCon {
tyConName = name,
tyConUnique = nameUnique name,
@@ -1345,18 +1340,17 @@ mkAlgTyCon name binders res_kind roles cType stupid rhs parent is_rec gadt_syn
algTcRhs = rhs,
algTcFields = fieldsOfAlgTcRhs rhs,
algTcParent = ASSERT2( okParent name parent, ppr name $$ ppr parent ) parent,
- algTcRec = is_rec,
algTcGadtSyntax = gadt_syn
}
-- | Simpler specialization of 'mkAlgTyCon' for classes
mkClassTyCon :: Name -> [TyConBinder]
-> [Role] -> AlgTyConRhs -> Class
- -> RecFlag -> Name -> TyCon
-mkClassTyCon name binders roles rhs clas is_rec tc_rep_name
+ -> Name -> TyCon
+mkClassTyCon name binders roles rhs clas tc_rep_name
= mkAlgTyCon name binders constraintKind roles Nothing [] rhs
(ClassTyCon clas tc_rep_name)
- is_rec False
+ False
mkTupleTyCon :: Name
-> [TyConBinder]
@@ -1382,7 +1376,6 @@ mkTupleTyCon name binders res_kind arity con sort parent
tup_sort = sort },
algTcFields = emptyDFsEnv,
algTcParent = parent,
- algTcRec = NonRecursive,
algTcGadtSyntax = False
}
@@ -1816,11 +1809,6 @@ isBoxedTupleTyCon (AlgTyCon { algTcRhs = rhs })
= isBoxed (tupleSortBoxity sort)
isBoxedTupleTyCon _ = False
--- | Is this a recursive 'TyCon'?
-isRecursiveTyCon :: TyCon -> Bool
-isRecursiveTyCon (AlgTyCon {algTcRec = Recursive}) = True
-isRecursiveTyCon _ = False
-
-- | Is this a PromotedDataCon?
isPromotedDataCon :: TyCon -> Bool
isPromotedDataCon (PromotedDataCon {}) = True
@@ -2258,10 +2246,7 @@ initRecTc = RC 100 emptyNameEnv
checkRecTc :: RecTcChecker -> TyCon -> Maybe RecTcChecker
-- Nothing => Recursion detected
-- Just rec_tcs => Keep going
-checkRecTc rc@(RC bound rec_nts) tc
- | not (isRecursiveTyCon tc)
- = Just rc -- Tuples are a common example here
- | otherwise
+checkRecTc (RC bound rec_nts) tc
= case lookupNameEnv rec_nts tc_name of
Just n | n >= bound -> Nothing
| otherwise -> Just (RC bound (extendNameEnv rec_nts tc_name (n+1)))
diff --git a/compiler/vectorise/Vectorise/Generic/PData.hs b/compiler/vectorise/Vectorise/Generic/PData.hs
index 9fbe1283f2..d4abeae51b 100644
--- a/compiler/vectorise/Vectorise/Generic/PData.hs
+++ b/compiler/vectorise/Vectorise/Generic/PData.hs
@@ -14,7 +14,6 @@ import Vectorise.Generic.Description
import Vectorise.Utils
import Vectorise.Env( GlobalEnv( global_fam_inst_env ) )
-import BasicTypes
import BuildTyCl
import DataCon
import TyCon
@@ -58,12 +57,10 @@ buildDataFamInst name' fam_tc vect_tc rhs
[] -- no stupid theta
rhs
(DataFamInstTyCon ax fam_tc pat_tys)
- rec_flag -- FIXME: is this ok?
False -- not GADT syntax
; liftDs $ newFamInst (DataFamilyInst rep_tc) ax }
where
tyvars = tyConTyVars vect_tc
- rec_flag = boolToRecFlag (isRecursiveTyCon vect_tc)
buildPDataTyConRhs :: Name -> TyCon -> TyCon -> SumRepr -> VM AlgTyConRhs
buildPDataTyConRhs orig_name vect_tc repr_tc repr
diff --git a/compiler/vectorise/Vectorise/Type/TyConDecl.hs b/compiler/vectorise/Vectorise/Type/TyConDecl.hs
index 3085beb183..a75391eca5 100644
--- a/compiler/vectorise/Vectorise/Type/TyConDecl.hs
+++ b/compiler/vectorise/Vectorise/Type/TyConDecl.hs
@@ -12,7 +12,6 @@ import Class
import Type
import TyCon
import DataCon
-import BasicTypes
import DynFlags
import Var
import Name
@@ -51,9 +50,6 @@ vectTyConDecl tycon name'
opTys = drop (length argTys - length opItems) argTys -- only method types
; methods' <- sequence [ vectMethod id meth ty | ((id, meth), ty) <- zip opItems opTys]
- -- keep the original recursiveness flag
- ; let rec_flag = boolToRecFlag (isRecursiveTyCon tycon)
-
-- construct the vectorised class (this also creates the class type constructors and its
-- data constructor)
--
@@ -68,7 +64,6 @@ vectTyConDecl tycon name'
[] -- no associated types (for the moment)
methods' -- method info
(classMinimalDef cls) -- Inherit minimal complete definition from cls
- rec_flag -- whether recursive
-- the original dictionary constructor must map to the vectorised one
; let tycon' = classTyCon cls'
@@ -94,9 +89,8 @@ vectTyConDecl tycon name'
-- vectorise the data constructor of the class tycon
; rhs' <- vectAlgTyConRhs tycon (algTyConRhs tycon)
- -- keep the original recursiveness and GADT flags
- ; let rec_flag = boolToRecFlag (isRecursiveTyCon tycon)
- gadt_flag = isGadtSyntaxTyCon tycon
+ -- keep the original GADT flags
+ ; let gadt_flag = isGadtSyntaxTyCon tycon
-- build the vectorised type constructor
; tc_rep_name <- mkDerivedName mkTyConRepOcc name'
@@ -109,7 +103,6 @@ vectTyConDecl tycon name'
[] -- no stupid theta
rhs' -- new constructor defs
(VanillaAlgTyCon tc_rep_name)
- rec_flag -- whether recursive
gadt_flag -- whether in GADT syntax
}
View Lorry Controller Status