[project @ 2001-08-14 16:29:56 by simonmar]
[ghc-hetmet.git] / ghc / compiler / types / TyCon.lhs
index a4bf2bc..fb48222 100644 (file)
@@ -13,10 +13,13 @@ module TyCon(
        isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, tupleTyConBoxity,
        isRecursiveTyCon, newTyConRep,
 
+       mkForeignTyCon, isForeignTyCon,
+
        mkAlgTyCon, --mkAlgTyCon, 
        mkClassTyCon,
        mkFunTyCon,
        mkPrimTyCon,
+       mkLiftedPrimTyCon,
        mkTupleTyCon,
        mkSynTyCon,
        mkKindCon,
@@ -34,7 +37,7 @@ module TyCon(
        tyConTheta,
        tyConPrimRep,
        tyConArity,
-       isClassTyCon,
+       isClassTyCon, tyConClass_maybe,
        getSynTyConDefn,
 
         maybeTyConSingleCon,
@@ -47,21 +50,22 @@ 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) )
 import PrelNames       ( Unique, Uniquable(..), anyBoxConKey )
 import PrimRep         ( PrimRep(..), isFollowableRep )
 import Outputable
+import FastString
 \end{code}
 
 %************************************************************************
@@ -92,7 +96,7 @@ data TyCon
        
        tyConTyVars   :: [TyVar],
        tyConArgVrcs  :: ArgVrcs,
-       algTyConTheta :: ClassContext,
+       algTyConTheta :: [PredType],
 
        dataCons :: [DataCon],
                -- Its data constructors, with fully polymorphic types
@@ -120,17 +124,22 @@ 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
+       tyConExtName :: Maybe FastString
     }
 
   | TupleTyCon {
@@ -174,15 +183,17 @@ type ArgVrcs = [(Bool,Bool)]  -- Tyvar variance info: [(occPos,occNeg)]
 
 data AlgTyConFlavour
   = DataTyCon          -- Data type
+
   | EnumTyCon          -- Special sort of enumeration type
+
   | NewTyCon Type      -- Newtype, with its *ultimate* representation type
                        -- By 'ultimate' I mean that the rep type is not itself
                        -- a newtype or type synonym.
 
-                       -- The rep type has explicit for-alls for the tyvars of
-                       -- the TyCon.  Thus:
+                       -- The rep type has free type variables the tyConTyVars
+                       -- Thus:
                        --      newtype T a = MkT [(a,Int)]
-                       -- The rep type is forall a. [(a,Int)]
+                       -- The rep type is [(a,Int)]
                        --
                        -- The rep type isn't entirely simple:
                        --  for a recursive newtype we pick () as the rep type
@@ -253,13 +264,13 @@ 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
     }
 
-mkClassTyCon name kind tyvars argvrcs con clas flavour
+mkClassTyCon name kind tyvars argvrcs con clas flavour rec
   = AlgTyCon { 
        tyConName               = name,
        tyConUnique             = nameUnique name,
@@ -271,9 +282,9 @@ mkClassTyCon name kind tyvars argvrcs con clas flavour
        dataCons                = [con],
        selIds                  = [],
        noOfDataCons            = 1,
-       algTyConClass           = True,
+       algTyConClass           = Just clas,
        algTyConFlavour         = flavour,
-       algTyConRec             = NonRecursive,
+       algTyConRec             = rec,
        genInfo                 = Nothing
     }
 
@@ -290,14 +301,42 @@ 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 are lifted
+-- because the Haskell type T representing the (foreign) .NET
+-- type T is actually implemented (in ILX) as a thunk<T>
+-- They have PtrRep
+mkForeignTyCon name ext_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,
+       tyConExtName = ext_name
+    }
+
+
+-- most Prim tycons are lifted
+mkPrimTyCon name kind arity arg_vrcs rep
+  = mkPrimTyCon' name kind arity arg_vrcs rep True  
+
+-- but RealWorld is lifted
+mkLiftedPrimTyCon name kind arity arg_vrcs rep
+  = mkPrimTyCon' name kind arity arg_vrcs rep False
+
+mkPrimTyCon' name kind arity arg_vrcs rep is_unlifted
+  = PrimTyCon {
+       tyConName    = name,
+       tyConUnique  = nameUnique name,
+       tyConKind    = kind,
+       tyConArity   = arity,
+        tyConArgVrcs = arg_vrcs,
+       primTyConRep = rep,
+       isUnLifted   = is_unlifted,
+       tyConExtName = Nothing
     }
 
 mkSynTyCon name kind arity tyvars rhs argvrcs
@@ -322,9 +361,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
@@ -337,18 +376,26 @@ isAlgTyCon (AlgTyCon {})   = True
 isAlgTyCon (TupleTyCon {}) = True
 isAlgTyCon other          = False
 
--- isDataTyCon returns False for @newtype@ and for unboxed tuples
-isDataTyCon (AlgTyCon {algTyConFlavour = new_or_data})  = case new_or_data of
-                                                               NewTyCon _ -> False
-                                                               other   -> True
+-- isDataTyCon returns True for data types that are represented by
+-- heap-allocated constructors.
+-- These are srcutinised by Core-level @case@ expressions, and they
+-- get info tables allocated for them.
+--     True for all @data@ types
+--     False for newtypes
+--               unboxed tuples
+isDataTyCon (AlgTyCon {algTyConFlavour = new_or_data, algTyConRec = is_rec})  
+  = case new_or_data of
+       NewTyCon _ -> False
+       other      -> True
+
 isDataTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
 isDataTyCon other = False
 
 isNewTyCon (AlgTyCon {algTyConFlavour = NewTyCon _}) = True 
 isNewTyCon other                                    = False
 
-newTyConRep (AlgTyCon {algTyConFlavour = NewTyCon rep}) = Just rep
-newTyConRep other                                      = Nothing
+newTyConRep :: TyCon -> ([TyVar], Type)
+newTyConRep (AlgTyCon {tyConTyVars = tvs, algTyConFlavour = NewTyCon rep}) = (tvs, rep)
 
 -- A "product" tycon
 --     has *one* constructor, 
@@ -383,12 +430,16 @@ 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 ) 
-                     ASSERT2( length cons == tyConFamilySize tycon, ppr tycon )
+tyConDataCons tycon = ASSERT2( length cons == tyConFamilySize tycon, ppr tycon )
                      cons
                    where
                      cons = tyConDataConsIfAvailable tycon
@@ -419,7 +470,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 +508,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}