[project @ 2001-05-24 13:59:09 by simonpj]

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

diff --git a/ghc/compiler/types/TyCon.lhs b/ghc/compiler/types/TyCon.lhs
index a4bf2bc..b8a139b 100644 (file)
--- a/ghc/compiler/types/TyCon.lhs
+++ b/ghc/compiler/types/TyCon.lhs
@@ -13,6 +13,8 @@ module TyCon(
        isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, tupleTyConBoxity,
        isRecursiveTyCon, newTyConRep,
 
+       mkForeignTyCon, isForeignTyCon,
+
        mkAlgTyCon, --mkAlgTyCon, 
        mkClassTyCon,
        mkFunTyCon,
@@ -34,7 +36,7 @@ module TyCon(
        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
@@ -120,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 {
@@ -253,7 +259,7 @@ mkAlgTyCon name kind tyvars theta argvrcs cons ncons sels flavour rec
        dataCons                = cons, 
        selIds                  = sels,
        noOfDataCons            = ncons,
-       algTyConClass           = False,
+       algTyConClass           = Nothing,
        algTyConFlavour         = flavour,
        algTyConRec             = rec,
        genInfo                 = gen_info
@@ -271,7 +277,7 @@ mkClassTyCon name kind tyvars argvrcs con clas flavour
        dataCons                = [con],
        selIds                  = [],
        noOfDataCons            = 1,
-       algTyConClass           = True,
+       algTyConClass           = Just clas,
        algTyConFlavour         = flavour,
        algTyConRec             = NonRecursive,
        genInfo                 = Nothing
@@ -290,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
@@ -322,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
@@ -383,6 +405,11 @@ 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}
@@ -419,7 +446,7 @@ tyConPrimRep _                                    = PtrRep
 \end{code}
 
 \begin{code}
-tyConTheta :: TyCon -> ClassContext
+tyConTheta :: TyCon -> [PredType]
 tyConTheta (AlgTyCon {algTyConTheta = theta}) = theta
 -- should ask about anything else
 \end{code}
@@ -457,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}