[project @ 2001-08-14 16:29:56 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 4fc0348..fb48222 100644 (file)
--- a/ghc/compiler/types/TyCon.lhs
+++ b/ghc/compiler/types/TyCon.lhs
@@ -19,6 +19,7 @@ module TyCon(
        mkClassTyCon,
        mkFunTyCon,
        mkPrimTyCon,
+       mkLiftedPrimTyCon,
        mkTupleTyCon,
        mkSynTyCon,
        mkKindCon,
@@ -182,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
@@ -267,7 +270,7 @@ mkAlgTyCon name kind tyvars theta argvrcs cons ncons sels flavour 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,
@@ -281,7 +284,7 @@ mkClassTyCon name kind tyvars argvrcs con clas flavour
        noOfDataCons            = 1,
        algTyConClass           = Just clas,
        algTyConFlavour         = flavour,
-       algTyConRec             = NonRecursive,
+       algTyConRec             = rec,
        genInfo                 = Nothing
     }
 
@@ -316,7 +319,15 @@ mkForeignTyCon name ext_name kind arity arg_vrcs
     }
 
 
+-- 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,
@@ -324,7 +335,7 @@ mkPrimTyCon name kind arity arg_vrcs rep
        tyConArity   = arity,
         tyConArgVrcs = arg_vrcs,
        primTyConRep = rep,
-       isUnLifted   = True,
+       isUnLifted   = is_unlifted,
        tyConExtName = Nothing
     }
 
@@ -365,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,