From c1a02072e648de3f5e573d39c5fe80b75868ae14 Mon Sep 17 00:00:00 2001 From: simonpj Date: Wed, 21 Jul 2004 10:44:49 +0000 Subject: [PATCH] [project @ 2004-07-21 10:44:49 by simonpj] Wibble to :i for (,); make algTyConRhs behave right --- ghc/compiler/types/TyCon.lhs | 101 ++++++++++++++++++++++-------------------- 1 file changed, 52 insertions(+), 49 deletions(-) diff --git a/ghc/compiler/types/TyCon.lhs b/ghc/compiler/types/TyCon.lhs index 24e94e5..072e9c3 100644 --- a/ghc/compiler/types/TyCon.lhs +++ b/ghc/compiler/types/TyCon.lhs @@ -95,7 +95,7 @@ data TyCon selIds :: [Id], -- Its record selectors (if any) - algTyConRhs :: AlgTyConRhs, -- Data constructors in here + algRhs :: AlgTyConRhs, -- Data constructors in here algTyConRec :: RecFlag, -- Tells whether the data type is part of -- a mutually-recursive group or not @@ -123,7 +123,6 @@ data TyCon } | TupleTyCon { - tyConUnique :: Unique, tyConName :: Name, tyConKind :: Kind, @@ -215,34 +214,34 @@ mkFunTyCon name kind -- constructor - you can get hold of it easily (see Generics module) mkAlgTyCon name kind tyvars theta argvrcs rhs sels is_rec gen_info = AlgTyCon { - tyConName = name, - tyConUnique = nameUnique name, - tyConKind = kind, - tyConArity = length tyvars, - tyConTyVars = tyvars, - argVrcs = argvrcs, - algTyConTheta = theta, - algTyConRhs = rhs, - selIds = sels, - algTyConClass = Nothing, - algTyConRec = is_rec, - hasGenerics = gen_info + tyConName = name, + tyConUnique = nameUnique name, + tyConKind = kind, + tyConArity = length tyvars, + tyConTyVars = tyvars, + argVrcs = argvrcs, + algTyConTheta = theta, + algRhs = rhs, + selIds = sels, + algTyConClass = Nothing, + algTyConRec = is_rec, + hasGenerics = gen_info } mkClassTyCon name kind tyvars argvrcs rhs clas is_rec = AlgTyCon { - tyConName = name, - tyConUnique = nameUnique name, - tyConKind = kind, - tyConArity = length tyvars, - tyConTyVars = tyvars, - argVrcs = argvrcs, - algTyConTheta = [], - algTyConRhs = rhs, - selIds = [], - algTyConClass = Just clas, - algTyConRec = is_rec, - hasGenerics = False + tyConName = name, + tyConUnique = nameUnique name, + tyConKind = kind, + tyConArity = length tyvars, + tyConTyVars = tyvars, + argVrcs = argvrcs, + algTyConTheta = [], + algRhs = rhs, + selIds = [], + algTyConClass = Just clas, + algTyConRec = is_rec, + hasGenerics = False } @@ -314,7 +313,7 @@ isFunTyCon (FunTyCon {}) = True isFunTyCon _ = False isAbstractTyCon :: TyCon -> Bool -isAbstractTyCon (AlgTyCon { algTyConRhs = AbstractTyCon }) = True +isAbstractTyCon (AlgTyCon { algRhs = AbstractTyCon }) = True isAbstractTyCon _ = False isPrimTyCon :: TyCon -> Bool @@ -332,6 +331,10 @@ isAlgTyCon (AlgTyCon {}) = True isAlgTyCon (TupleTyCon {}) = True isAlgTyCon other = False +algTyConRhs :: TyCon -> AlgTyConRhs +algTyConRhs (AlgTyCon {algRhs = rhs}) = rhs +algTyConRhs (TupleTyCon {dataCon = dc}) = DataTyCon [dc] False + isDataTyCon :: TyCon -> Bool -- isDataTyCon returns True for data types that are represented by -- heap-allocated constructors. @@ -340,7 +343,7 @@ isDataTyCon :: TyCon -> Bool -- True for all @data@ types -- False for newtypes -- unboxed tuples -isDataTyCon (AlgTyCon {algTyConRhs = rhs}) +isDataTyCon (AlgTyCon {algRhs = rhs}) = case rhs of DataTyCon _ _ -> True NewTyCon _ _ _ -> False @@ -350,8 +353,8 @@ isDataTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity isDataTyCon other = False isNewTyCon :: TyCon -> Bool -isNewTyCon (AlgTyCon {algTyConRhs = NewTyCon _ _ _}) = True -isNewTyCon other = False +isNewTyCon (AlgTyCon {algRhs = NewTyCon _ _ _}) = True +isNewTyCon other = False isProductTyCon :: TyCon -> Bool -- A "product" tycon @@ -361,7 +364,7 @@ isProductTyCon :: TyCon -> Bool -- may be DataType or NewType, -- may be unboxed or not, -- may be recursive or not -isProductTyCon tc@(AlgTyCon {}) = case algTyConRhs tc of +isProductTyCon tc@(AlgTyCon {}) = case algRhs tc of DataTyCon [data_con] _ -> not (isExistentialDataCon data_con) NewTyCon _ _ _ -> True other -> False @@ -373,7 +376,7 @@ isSynTyCon (SynTyCon {}) = True isSynTyCon _ = False isEnumerationTyCon :: TyCon -> Bool -isEnumerationTyCon (AlgTyCon {algTyConRhs = DataTyCon _ is_enum}) = is_enum +isEnumerationTyCon (AlgTyCon {algRhs = DataTyCon _ is_enum}) = is_enum isEnumerationTyCon other = False isTupleTyCon :: TyCon -> Bool @@ -399,8 +402,8 @@ isRecursiveTyCon other = False isHiBootTyCon :: TyCon -> Bool -- Used for knot-tying in hi-boot files -isHiBootTyCon (AlgTyCon {algTyConRhs = AbstractTyCon}) = True -isHiBootTyCon other = False +isHiBootTyCon (AlgTyCon {algRhs = AbstractTyCon}) = True +isHiBootTyCon other = False isForeignTyCon :: TyCon -> Bool -- isForeignTyCon identifies foreign-imported type constructors @@ -421,15 +424,15 @@ tyConDataCons :: TyCon -> [DataCon] tyConDataCons tycon = tyConDataCons_maybe tycon `orElse` [] tyConDataCons_maybe :: TyCon -> Maybe [DataCon] -tyConDataCons_maybe (AlgTyCon {algTyConRhs = DataTyCon cons _}) = Just cons -tyConDataCons_maybe (AlgTyCon {algTyConRhs = NewTyCon con _ _}) = Just [con] -tyConDataCons_maybe (TupleTyCon {dataCon = con}) = Just [con] -tyConDataCons_maybe other = Nothing +tyConDataCons_maybe (AlgTyCon {algRhs = DataTyCon cons _}) = Just cons +tyConDataCons_maybe (AlgTyCon {algRhs = NewTyCon con _ _}) = Just [con] +tyConDataCons_maybe (TupleTyCon {dataCon = con}) = Just [con] +tyConDataCons_maybe other = Nothing tyConFamilySize :: TyCon -> Int -tyConFamilySize (AlgTyCon {algTyConRhs = DataTyCon cons _}) = length cons -tyConFamilySize (AlgTyCon {algTyConRhs = NewTyCon _ _ _}) = 1 -tyConFamilySize (TupleTyCon {}) = 1 +tyConFamilySize (AlgTyCon {algRhs = DataTyCon cons _}) = length cons +tyConFamilySize (AlgTyCon {algRhs = NewTyCon _ _ _}) = 1 +tyConFamilySize (TupleTyCon {}) = 1 #ifdef DEBUG tyConFamilySize other = pprPanic "tyConFamilySize:" (ppr other) #endif @@ -441,10 +444,10 @@ tyConSelIds other_tycon = [] \begin{code} newTyConRep :: TyCon -> ([TyVar], Type) -newTyConRep (AlgTyCon {tyConTyVars = tvs, algTyConRhs = NewTyCon _ _ rep}) = (tvs, rep) +newTyConRep (AlgTyCon {tyConTyVars = tvs, algRhs = NewTyCon _ _ rep}) = (tvs, rep) newTyConRhs :: TyCon -> ([TyVar], Type) -newTyConRhs (AlgTyCon {tyConTyVars = tvs, algTyConRhs = NewTyCon _ rhs _}) = (tvs, rhs) +newTyConRhs (AlgTyCon {tyConTyVars = tvs, algRhs = NewTyCon _ rhs _}) = (tvs, rhs) tyConPrimRep :: TyCon -> PrimRep tyConPrimRep (PrimTyCon {primTyConRep = rep}) = rep @@ -481,12 +484,12 @@ getSynTyConDefn (SynTyCon {tyConTyVars = tyvars, synTyConDefn = ty}) = (tyvars,t \begin{code} maybeTyConSingleCon :: TyCon -> Maybe DataCon -maybeTyConSingleCon (AlgTyCon {algTyConRhs = DataTyCon [c] _}) = Just c -maybeTyConSingleCon (AlgTyCon {algTyConRhs = NewTyCon c _ _}) = Just c -maybeTyConSingleCon (AlgTyCon {}) = Nothing -maybeTyConSingleCon (TupleTyCon {dataCon = con}) = Just con -maybeTyConSingleCon (PrimTyCon {}) = Nothing -maybeTyConSingleCon (FunTyCon {}) = Nothing -- case at funty +maybeTyConSingleCon (AlgTyCon {algRhs = DataTyCon [c] _}) = Just c +maybeTyConSingleCon (AlgTyCon {algRhs = NewTyCon c _ _}) = Just c +maybeTyConSingleCon (AlgTyCon {}) = Nothing +maybeTyConSingleCon (TupleTyCon {dataCon = con}) = Just con +maybeTyConSingleCon (PrimTyCon {}) = Nothing +maybeTyConSingleCon (FunTyCon {}) = Nothing -- case at funty maybeTyConSingleCon tc = pprPanic "maybeTyConSingleCon: unexpected tycon " $ ppr tc \end{code} -- 1.7.10.4