summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
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