[project @ 2001-06-07 11:07:51 by sewardj]

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

diff --git a/ghc/compiler/types/TyCon.lhs b/ghc/compiler/types/TyCon.lhs
index 61c4ac4..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,
@@ -55,6 +57,7 @@ import {-# SOURCE #-} DataCon ( DataCon, isExistentialDataCon )
 
 
 import Var             ( TyVar, Id )
+import Class           ( Class )
 import BasicTypes      ( Arity, RecFlag(..), Boxity(..), 
                          isBoxed, EP(..) )
 import Name            ( Name, nameUnique, NamedThing(getName) )
@@ -119,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 {
@@ -252,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
@@ -270,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
@@ -289,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
@@ -321,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
@@ -382,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}
@@ -456,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}