[project @ 2004-08-13 13:04:50 by simonmar]

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

diff --git a/ghc/compiler/types/Type.lhs b/ghc/compiler/types/Type.lhs
index 5cf242c..c7e5fa2 100644 (file)
--- a/ghc/compiler/types/Type.lhs
+++ b/ghc/compiler/types/Type.lhs
@@ -12,6 +12,8 @@ module Type (
        -- Re-exports from Kind
        module Kind,
 
+       -- Re-exports from TyCon
+       PrimRep(..),
 
        mkTyVarTy, mkTyVarTys, getTyVar, getTyVar_maybe, isTyVarTy,
 
@@ -84,16 +86,14 @@ import Name ( NamedThing(..), mkInternalName, tidyOccName )
 import Class   ( Class, classTyCon )
 import TyCon   ( TyCon, isRecursiveTyCon, isPrimTyCon,
                  isUnboxedTupleTyCon, isUnLiftedTyCon,
-                 isFunTyCon, isNewTyCon, newTyConRep,
+                 isFunTyCon, isNewTyCon, newTyConRep, newTyConRhs,
                  isAlgTyCon, isSynTyCon, tyConArity, 
-                 tyConKind, getSynTyConDefn,
-                 tyConPrimRep, 
+                 tyConKind, getSynTyConDefn, PrimRep(..), tyConPrimRep,
                )
 
 -- others
 import CmdLineOpts     ( opt_DictsStrict )
 import SrcLoc          ( noSrcLoc )
-import PrimRep         ( PrimRep(..) )
 import Unique          ( Uniquable(..) )
 import Util            ( mapAccumL, seqList, lengthIs, snocView )
 import Outputable
@@ -391,15 +391,27 @@ repType (NewTcApp tc tys) = ASSERT( tys `lengthIs` tyConArity tc )
 repType ty               = ty
 
 
+-- ToDo: this could be moved to the code generator, using splitTyConApp instead
+-- of inspecting the type directly.
 typePrimRep :: Type -> PrimRep
 typePrimRep ty = case repType ty of
                   TyConApp tc _ -> tyConPrimRep tc
                   FunTy _ _     -> PtrRep
-                  AppTy _ _     -> PtrRep      -- ??
+                  AppTy _ _     -> PtrRep      -- See note below
                   TyVarTy _     -> PtrRep
                   other         -> pprPanic "typePrimRep" (ppr ty)
-\end{code}
+       -- Types of the form 'f a' must be of kind *, not *#, so
+       -- we are guaranteed that they are represented by pointers.
+       -- The reason is that f must have kind *->*, not *->*#, because
+       -- (we claim) there is no way to constrain f's kind any other
+       -- way.
 
+-- new_type_rep doesn't ask any questions: 
+-- it just expands newtype, whether recursive or not
+new_type_rep new_tycon tys = ASSERT( tys `lengthIs` tyConArity new_tycon )
+                            case newTyConRep new_tycon of
+                                (tvs, rep_ty) -> substTyWith tvs tys rep_ty
+\end{code}
 
 
 ---------------------------------------------------------------------
@@ -512,6 +524,8 @@ mkPredTys preds = map PredTy preds
 predTypeRep :: PredType -> Type
 -- Convert a PredType to its "representation type";
 -- the post-type-checking type used by all the Core passes of GHC.
+-- Unwraps only the outermost level; for example, the result might
+-- be a NewTcApp; c.f. newTypeRep
 predTypeRep (IParam _ ty)     = ty
 predTypeRep (ClassP clas tys) = mkTyConApp (classTyCon clas) tys
        -- Result might be a NewTcApp, but the consumer will
@@ -529,23 +543,33 @@ predTypeRep (ClassP clas tys) = mkTyConApp (classTyCon clas) tys
 splitRecNewType_maybe :: Type -> Maybe Type
 -- Newtypes are always represented by a NewTcApp
 -- Sometimes we want to look through a recursive newtype, and that's what happens here
+-- It only strips *one layer* off, so the caller will usually call itself recursively
 -- Only applied to types of kind *, hence the newtype is always saturated
 splitRecNewType_maybe (NoteTy _ ty) = splitRecNewType_maybe ty  
+splitRecNewType_maybe (PredTy p)    = splitRecNewType_maybe (predTypeRep p)
 splitRecNewType_maybe (NewTcApp tc tys)
   | isRecursiveTyCon tc
   = ASSERT( tys `lengthIs` tyConArity tc && isNewTyCon tc )
-       -- The assert should hold because repType should
-       -- only be applied to *types* (of kind *)
-    Just (new_type_rep tc tys)
+       -- The assert should hold because splitRecNewType_maybe
+       -- should only be applied to *types* (of kind *)
+    Just (new_type_rhs tc tys)
 splitRecNewType_maybe other = Nothing
                        
 -----------------------------
 newTypeRep :: TyCon -> [Type] -> Type
 -- A local helper function (not exported)
--- Expands a newtype application to 
+-- Expands *the outermoset level of* a newtype application to 
 --     *either* a vanilla TyConApp (recursive newtype, or non-saturated)
---     *or*     the newtype representation (otherwise)
--- Either way, the result is not a NewTcApp
+--     *or*     the newtype representation (otherwise), meaning the
+--                     type written in the RHS of the newtype decl,
+--                     which may itself be a newtype
+--
+-- Example: newtype R = MkR S
+--         newtype S = MkS T
+--         newtype T = MkT (T -> T)
+--   newTypeRep on R gives NewTcApp S
+--             on S gives NewTcApp T
+--             on T gives TyConApp T
 --
 -- NB: the returned TyConApp is always deconstructed immediately by the 
 --     caller... a TyConApp with a newtype type constructor never lives
@@ -553,17 +577,16 @@ newTypeRep :: TyCon -> [Type] -> Type
 newTypeRep tc tys
   | not (isRecursiveTyCon tc),         -- Not recursive and saturated
     tys `lengthIs` tyConArity tc       -- treat as equivalent to expansion
-  = new_type_rep tc tys
+  = new_type_rhs tc tys
   | otherwise
   = TyConApp tc tys
        -- ToDo: Consider caching this substitution in a NType
 
-----------------------------
--- new_type_rep doesn't ask any questions: 
--- it just expands newtype, whether recursive or not
-new_type_rep new_tycon tys = ASSERT( tys `lengthIs` tyConArity new_tycon )
-                            case newTyConRep new_tycon of
-                                (tvs, rep_ty) -> substTyWith tvs tys rep_ty
+-- new_type_rhs doesn't ask any questions: 
+-- it just expands newtype one level, whether recursive or not
+new_type_rhs tc tys 
+  = case newTyConRhs tc of
+       (tvs, rep_ty) -> substTyWith tvs tys rep_ty
 \end{code}