[project @ 2001-03-01 15:59:51 by simonmar]

[ghc-hetmet.git] / ghc / compiler / types / TyCon.lhs

diff --git a/ghc/compiler/types/TyCon.lhs b/ghc/compiler/types/TyCon.lhs
index ccd7618..a4bf2bc 100644 (file)
--- a/ghc/compiler/types/TyCon.lhs
+++ b/ghc/compiler/types/TyCon.lhs
@@ -13,7 +13,7 @@ module TyCon(
        isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, tupleTyConBoxity,
        isRecursiveTyCon, newTyConRep,
 
-       mkAlgTyConRep, --mkAlgTyCon, 
+       mkAlgTyCon, --mkAlgTyCon, 
        mkClassTyCon,
        mkFunTyCon,
        mkPrimTyCon,
@@ -29,8 +29,8 @@ module TyCon(
        tyConUnique,
        tyConTyVars,
        tyConArgVrcs_maybe,
-       tyConDataCons, tyConDataConsIfAvailable,
-       tyConFamilySize,
+       tyConDataCons, tyConDataConsIfAvailable, tyConFamilySize,
+       tyConSelIds,
        tyConTheta,
        tyConPrimRep,
        tyConArity,
@@ -102,6 +102,8 @@ data TyCon
                --             (b) in a quest for fast compilation we don't import 
                --                 the constructors
 
+       selIds :: [Id], -- Its record selectors (if any)
+
        noOfDataCons :: Int,    -- Number of data constructors
                                -- Usually this is the same as the length of the
                                -- dataCons field, but the latter may be empty if
@@ -169,8 +171,6 @@ data TyCon
     }
 
 type ArgVrcs = [(Bool,Bool)]  -- Tyvar variance info: [(occPos,occNeg)]
-                              -- *NB*: this is tyvar variance info, *not*
-                              --       termvar usage info.
 
 data AlgTyConFlavour
   = DataTyCon          -- Data type
@@ -240,7 +240,7 @@ tyConGenIds tycon = case tyConGenInfo tycon of
 -- This is the making of a TyCon. Just the same as the old mkAlgTyCon,
 -- but now you also have to pass in the generic information about the type
 -- constructor - you can get hold of it easily (see Generics module)
-mkAlgTyConRep name kind tyvars theta argvrcs cons ncons flavour rec 
+mkAlgTyCon name kind tyvars theta argvrcs cons ncons sels flavour rec 
              gen_info
   = AlgTyCon { 
        tyConName               = name,
@@ -251,6 +251,7 @@ mkAlgTyConRep name kind tyvars theta argvrcs cons ncons flavour rec
        tyConArgVrcs            = argvrcs,
        algTyConTheta           = theta,
        dataCons                = cons, 
+       selIds                  = sels,
        noOfDataCons            = ncons,
        algTyConClass           = False,
        algTyConFlavour         = flavour,
@@ -268,6 +269,7 @@ mkClassTyCon name kind tyvars argvrcs con clas flavour
        tyConArgVrcs            = argvrcs,
        algTyConTheta           = [],
        dataCons                = [con],
+       selIds                  = [],
        noOfDataCons            = 1,
        algTyConClass           = True,
        algTyConFlavour         = flavour,
@@ -385,7 +387,9 @@ isRecursiveTyCon other                                    = False
 
 \begin{code}
 tyConDataCons :: TyCon -> [DataCon]
-tyConDataCons tycon = ASSERT2( not (null cons), ppr tycon ) cons
+tyConDataCons tycon = ASSERT2( not (null cons), ppr tycon ) 
+                     ASSERT2( length cons == tyConFamilySize tycon, ppr tycon )
+                     cons
                    where
                      cons = tyConDataConsIfAvailable tycon
 
@@ -403,6 +407,12 @@ tyConFamilySize (TupleTyCon {})          = 1
 tyConFamilySize other = pprPanic "tyConFamilySize:" (ppr other)
 #endif
 
+tyConSelIds :: TyCon -> [Id]
+tyConSelIds (AlgTyCon {selIds = sels}) = sels
+tyConSelIds other_tycon                       = []
+\end{code}
+
+\begin{code}
 tyConPrimRep :: TyCon -> PrimRep
 tyConPrimRep (PrimTyCon {primTyConRep = rep}) = rep
 tyConPrimRep _                               = PtrRep