Axe RecFlag on TyCons.
authorEdward Z. Yang <ezyang@cs.stanford.edu>
Fri, 24 Jun 2016 18:03:47 +0000 (11:03 -0700)
committerEdward Z. Yang <ezyang@cs.stanford.edu>
Thu, 30 Jun 2016 17:43:28 +0000 (10:43 -0700)
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

13 files changed:
compiler/basicTypes/DataCon.hs
compiler/iface/BuildTyCl.hs
compiler/iface/IfaceSyn.hs
compiler/iface/MkIface.hs
compiler/iface/TcIface.hs
compiler/prelude/TysWiredIn.hs
compiler/specialise/SpecConstr.hs
compiler/typecheck/TcInstDcls.hs
compiler/typecheck/TcTyClsDecls.hs
compiler/typecheck/TcTyDecls.hs
compiler/types/TyCon.hs
compiler/vectorise/Vectorise/Generic/PData.hs
compiler/vectorise/Vectorise/Type/TyConDecl.hs

index 2b508d6..27ac483 100644 (file)
@@ -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
index 007f458..f23bbb3 100644 (file)
@@ -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 }
index 283da53..689452f 100644 (file)
@@ -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
index 1aa3111..d6a70e4 100644 (file)
@@ -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
index d0ddd55..5ffef1a 100644 (file)
@@ -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)
index 228c4d1..51f5555 100644 (file)
@@ -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
index 00c6853..8cc393c 100644 (file)
@@ -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
index d4cc023..21eea28 100644 (file)
@@ -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
index ef78c68..fe3c713 100644 (file)
@@ -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
index 825597f..6070227 100644 (file)
@@ -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
index be73a9f..d825712 100644 (file)
@@ -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)))
index 9fbe128..d4abeae 100644 (file)
@@ -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
index 3085beb..a75391e 100644 (file)
@@ -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
        }