[project @ 2001-05-24 15:01:33 by simonpj]
[ghc-hetmet.git] / ghc / compiler / types / TyCon.lhs
index ccd7618..b8a139b 100644 (file)
@@ -13,7 +13,9 @@ module TyCon(
        isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, tupleTyConBoxity,
        isRecursiveTyCon, newTyConRep,
 
-       mkAlgTyConRep, --mkAlgTyCon, 
+       mkForeignTyCon, isForeignTyCon,
+
+       mkAlgTyCon, --mkAlgTyCon, 
        mkClassTyCon,
        mkFunTyCon,
        mkPrimTyCon,
@@ -29,12 +31,12 @@ module TyCon(
        tyConUnique,
        tyConTyVars,
        tyConArgVrcs_maybe,
-       tyConDataCons, tyConDataConsIfAvailable,
-       tyConFamilySize,
+       tyConDataCons, tyConDataConsIfAvailable, tyConFamilySize,
+       tyConSelIds,
        tyConTheta,
        tyConPrimRep,
        tyConArity,
-       isClassTyCon,
+       isClassTyCon, tyConClass_maybe,
        getSynTyConDefn,
 
         maybeTyConSingleCon,
@@ -47,15 +49,15 @@ module TyCon(
 
 #include "HsVersions.h"
 
-import {-# SOURCE #-} TypeRep ( Type, Kind, SuperKind )
+import {-# SOURCE #-} TypeRep ( Type, PredType, Kind, SuperKind )
  -- Should just be Type(Type), but this fails due to bug present up to
  -- and including 4.02 involving slurping of hi-boot files.  Bug is now fixed.
 
 import {-# SOURCE #-} DataCon ( DataCon, isExistentialDataCon )
 
 
-import Class           ( ClassContext )
 import Var             ( TyVar, Id )
+import Class           ( Class )
 import BasicTypes      ( Arity, RecFlag(..), Boxity(..), 
                          isBoxed, EP(..) )
 import Name            ( Name, nameUnique, NamedThing(getName) )
@@ -92,7 +94,7 @@ data TyCon
        
        tyConTyVars   :: [TyVar],
        tyConArgVrcs  :: ArgVrcs,
-       algTyConTheta :: ClassContext,
+       algTyConTheta :: [PredType],
 
        dataCons :: [DataCon],
                -- Its data constructors, with fully polymorphic types
@@ -102,6 +104,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
@@ -118,17 +122,21 @@ data TyCon
                                        -- e.g. the TyCon for a Class dictionary,
                                        -- and TyCons with unboxed arguments
 
-       algTyConClass :: Bool           -- True if this tycon comes from a class declaration
+       algTyConClass :: Maybe Class    -- Just cl if this tycon came from a class declaration
     }
 
-  | PrimTyCon {                -- Primitive types; cannot be defined in Haskell
-                       -- NB: All of these guys are *unlifted*, but not all are *unboxed*
+  | PrimTyCon {                        -- Primitive types; cannot be defined in Haskell
+                               -- Now includes foreign-imported types
        tyConUnique  :: Unique,
        tyConName    :: Name,
        tyConKind    :: Kind,
        tyConArity   :: Arity,
        tyConArgVrcs :: ArgVrcs,
-       primTyConRep :: PrimRep
+       primTyConRep :: PrimRep,        -- Many primitive tycons are unboxed, but some are
+                                       -- boxed (represented by pointers). The PrimRep tells.
+
+       isUnLifted   :: Bool    -- Most primitive tycons are unlifted, 
+                               -- but foreign-imported ones may not be
     }
 
   | TupleTyCon {
@@ -169,8 +177,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 +246,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,8 +257,9 @@ mkAlgTyConRep name kind tyvars theta argvrcs cons ncons flavour rec
        tyConArgVrcs            = argvrcs,
        algTyConTheta           = theta,
        dataCons                = cons, 
+       selIds                  = sels,
        noOfDataCons            = ncons,
-       algTyConClass           = False,
+       algTyConClass           = Nothing,
        algTyConFlavour         = flavour,
        algTyConRec             = rec,
        genInfo                 = gen_info
@@ -268,8 +275,9 @@ mkClassTyCon name kind tyvars argvrcs con clas flavour
        tyConArgVrcs            = argvrcs,
        algTyConTheta           = [],
        dataCons                = [con],
+       selIds                  = [],
        noOfDataCons            = 1,
-       algTyConClass           = True,
+       algTyConClass           = Just clas,
        algTyConFlavour         = flavour,
        algTyConRec             = NonRecursive,
        genInfo                 = Nothing
@@ -288,14 +296,30 @@ mkTupleTyCon name kind arity tyvars con boxed gen_info
        genInfo = gen_info
     }
 
-mkPrimTyCon name kind arity arg_vrcs rep 
+-- Foreign-imported (.NET) type constructors are represented
+-- as primitive, but *lifted*, TyCons for now.  
+-- They  have PtrRep
+mkForeignTyCon name kind arity arg_vrcs
   = PrimTyCon {
-       tyConName = name,
-       tyConUnique = nameUnique name,
-       tyConKind = kind,
-       tyConArity = arity,
+       tyConName    = name,
+       tyConUnique  = nameUnique name,
+       tyConKind    = kind,
+       tyConArity   = arity,
         tyConArgVrcs = arg_vrcs,
-       primTyConRep = rep
+       primTyConRep = PtrRep,
+       isUnLifted   = False
+    }
+
+
+mkPrimTyCon name kind arity arg_vrcs rep
+  = PrimTyCon {
+       tyConName    = name,
+       tyConUnique  = nameUnique name,
+       tyConKind    = kind,
+       tyConArity   = arity,
+        tyConArgVrcs = arg_vrcs,
+       primTyConRep = rep,
+       isUnLifted   = True
     }
 
 mkSynTyCon name kind arity tyvars rhs argvrcs
@@ -320,9 +344,9 @@ isFunTyCon _             = False
 isPrimTyCon (PrimTyCon {}) = True
 isPrimTyCon _              = False
 
-isUnLiftedTyCon (PrimTyCon {}) = True
-isUnLiftedTyCon (TupleTyCon { tyConBoxed = boxity}) = not (isBoxed boxity)
-isUnLiftedTyCon _              = False
+isUnLiftedTyCon (PrimTyCon  {isUnLifted = is_unlifted}) = is_unlifted
+isUnLiftedTyCon (TupleTyCon {tyConBoxed = boxity})      = not (isBoxed boxity)
+isUnLiftedTyCon _                                      = False
 
 -- isBoxedTyCon should not be applied to SynTyCon, nor KindCon
 isBoxedTyCon (AlgTyCon {}) = True
@@ -381,11 +405,18 @@ tupleTyConBoxity tc = tyConBoxed tc
 
 isRecursiveTyCon (AlgTyCon {algTyConRec = Recursive}) = True
 isRecursiveTyCon other                               = False
+
+-- isForeignTyCon identifies foreign-imported type constructors
+-- For the moment, they are primitive but lifted, but that may change
+isForeignTyCon (PrimTyCon {isUnLifted = is_unlifted}) = not is_unlifted
+isForeignTyCon other                                 = False
 \end{code}
 
 \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,13 +434,19 @@ 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
 \end{code}
 
 \begin{code}
-tyConTheta :: TyCon -> ClassContext
+tyConTheta :: TyCon -> [PredType]
 tyConTheta (AlgTyCon {algTyConTheta = theta}) = theta
 -- should ask about anything else
 \end{code}
@@ -447,8 +484,12 @@ maybeTyConSingleCon tc = pprPanic "maybeTyConSingleCon: unexpected tycon " $
 
 \begin{code}
 isClassTyCon :: TyCon -> Bool
-isClassTyCon (AlgTyCon {algTyConClass = is_class_tycon}) = is_class_tycon
-isClassTyCon other_tycon                                = False
+isClassTyCon (AlgTyCon {algTyConClass = Just _}) = True
+isClassTyCon other_tycon                        = False
+
+tyConClass_maybe :: TyCon -> Maybe Class
+tyConClass_maybe (AlgTyCon {algTyConClass = maybe_clas}) = maybe_clas
+tyConClass_maybe ther_tycon                             = Nothing
 \end{code}