add -fsimpleopt-before-flatten
[ghc-hetmet.git] / compiler / iface / IfaceType.lhs
index 1688344..c97e16e 100644 (file)
@@ -7,7 +7,9 @@ This module defines interface types and binders
 
 \begin{code}
 module IfaceType (
-       IfaceType(..), IfaceKind, IfacePredType(..), IfaceTyCon(..),
+       IfExtName, IfLclName,
+
+        IfaceType(..), IfaceKind, IfacePredType(..), IfaceTyCon(..),
        IfaceContext, IfaceBndr(..), IfaceTvBndr, IfaceIdBndr, IfaceCoercion,
        ifaceTyConName,
 
@@ -41,19 +43,24 @@ import FastString
 %************************************************************************
 
 \begin{code}
+type IfLclName = FastString    -- A local name in iface syntax
+
+type IfExtName = Name  -- An External or WiredIn Name can appear in IfaceSyn
+                       -- (However Internal or System Names never should)
+
 data IfaceBndr                 -- Local (non-top-level) binders
   = IfaceIdBndr {-# UNPACK #-} !IfaceIdBndr
   | IfaceTvBndr {-# UNPACK #-} !IfaceTvBndr
 
-type IfaceIdBndr  = (FastString, IfaceType)
-type IfaceTvBndr  = (FastString, IfaceKind)
+type IfaceIdBndr  = (IfLclName, IfaceType)
+type IfaceTvBndr  = (IfLclName, IfaceKind)
 
 -------------------------------
 type IfaceKind     = IfaceType
 type IfaceCoercion = IfaceType
 
 data IfaceType
-  = IfaceTyVar    FastString                   -- Type variable only, not tycon
+  = IfaceTyVar    IfLclName                    -- Type variable only, not tycon
   | IfaceAppTy    IfaceType IfaceType
   | IfaceForAllTy IfaceTvBndr IfaceType
   | IfacePredTy   IfacePredType
@@ -62,38 +69,49 @@ data IfaceType
   | IfaceFunTy  IfaceType IfaceType
 
 data IfacePredType     -- NewTypes are handled as ordinary TyConApps
-  = IfaceClassP Name [IfaceType]
+  = IfaceClassP IfExtName [IfaceType]
   | IfaceIParam (IPName OccName) IfaceType
   | IfaceEqPred IfaceType IfaceType
 
 type IfaceContext = [IfacePredType]
 
--- NB: If you add a data constructor, remember to add a case to
---     IfaceSyn.eqIfTc!
 data IfaceTyCon        -- Abbreviations for common tycons with known names
-  = IfaceTc Name       -- The common case
+  = IfaceTc IfExtName  -- The common case
   | IfaceIntTc | IfaceBoolTc | IfaceCharTc
   | IfaceListTc | IfacePArrTc
   | IfaceTupTc Boxity Arity 
+  | IfaceAnyTc IfaceKind     -- Used for AnyTyCon (see Note [Any Types] in TysPrim)
+                            -- other than 'Any :: *' itself
   | IfaceLiftedTypeKindTc | IfaceOpenTypeKindTc | IfaceUnliftedTypeKindTc
   | IfaceUbxTupleKindTc | IfaceArgTypeKindTc 
-  deriving( Eq )
-
-ifaceTyConName :: IfaceTyCon -> Name
-ifaceTyConName IfaceIntTc        = intTyConName
-ifaceTyConName IfaceBoolTc       = boolTyConName
-ifaceTyConName IfaceCharTc       = charTyConName
-ifaceTyConName IfaceListTc       = listTyConName
-ifaceTyConName IfacePArrTc       = parrTyConName
-ifaceTyConName (IfaceTupTc bx ar) = getName (tupleTyCon bx ar)
+
+ifaceTyConName :: IfaceTyCon -> IfExtName
+ifaceTyConName IfaceIntTc             = intTyConName
+ifaceTyConName IfaceBoolTc            = boolTyConName
+ifaceTyConName IfaceCharTc            = charTyConName
+ifaceTyConName IfaceListTc            = listTyConName
+ifaceTyConName IfacePArrTc            = parrTyConName
+ifaceTyConName (IfaceTupTc bx ar)      = getName (tupleTyCon bx ar)
 ifaceTyConName IfaceLiftedTypeKindTc   = liftedTypeKindTyConName
 ifaceTyConName IfaceOpenTypeKindTc     = openTypeKindTyConName
 ifaceTyConName IfaceUnliftedTypeKindTc = unliftedTypeKindTyConName
 ifaceTyConName IfaceUbxTupleKindTc     = ubxTupleKindTyConName
 ifaceTyConName IfaceArgTypeKindTc      = argTypeKindTyConName
-ifaceTyConName (IfaceTc ext)      = ext
+ifaceTyConName (IfaceTc ext)           = ext
+ifaceTyConName (IfaceAnyTc k)          = pprPanic "ifaceTyConName" (ppr k)
+                                        -- Note [The Name of an IfaceAnyTc]
 \end{code}
 
+Note [The Name of an IfaceAnyTc]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+It isn't easy to get the Name of an IfaceAnyTc in a pure way.  What you
+really need to do is to transform it to a TyCon, and get the Name of that.
+But doing so needs the monad because there's an IfaceKind inside, and we
+need a Kind.
+
+In fact, ifaceTyConName is only used for instances and rules, and we don't
+expect to instantiate those at these (internal-ish) Any types, so rather
+than solve this potential problem now, I'm going to defer it until it happens!
 
 %************************************************************************
 %*                                                                     *
@@ -162,7 +180,7 @@ instance Outputable IfaceBndr where
 pprIfaceBndrs :: [IfaceBndr] -> SDoc
 pprIfaceBndrs bs = sep (map ppr bs)
 
-pprIfaceIdBndr :: (FastString, IfaceType) -> SDoc
+pprIfaceIdBndr :: (IfLclName, IfaceType) -> SDoc
 pprIfaceIdBndr (name, ty) = hsep [ppr name, dcolon, ppr ty]
 
 pprIfaceTvBndr :: IfaceTvBndr -> SDoc
@@ -244,14 +262,17 @@ instance Outputable IfacePredType where
                             <+> sep (map pprParendIfaceType ts)
 
 instance Outputable IfaceTyCon where
-  ppr (IfaceTc ext) = ppr ext
-  ppr other_tc      = ppr (ifaceTyConName other_tc)
+  ppr (IfaceAnyTc k) = ptext (sLit "Any") <> pprParendIfaceType k
+                            -- We can't easily get the Name of an IfaceAnyTc
+                            -- (see Note [The Name of an IfaceAnyTc])
+                            -- so we fake it.  It's only for debug printing!
+  ppr other_tc       = ppr (ifaceTyConName other_tc)
 
 -------------------
 pprIfaceContext :: IfaceContext -> SDoc
 -- Prints "(C a, D b) =>", including the arrow
 pprIfaceContext []     = empty
-pprIfaceContext theta = ppr_preds theta <+> ptext (sLit "=>")
+pprIfaceContext theta = ppr_preds theta <+> darrow
 
 ppr_preds :: [IfacePredType] -> SDoc
 ppr_preds [pred] = ppr pred    -- No parens
@@ -270,11 +291,11 @@ pabrackets p = ptext (sLit "[:") <> p <> ptext (sLit ":]")
 
 \begin{code}
 ----------------
-toIfaceTvBndr :: TyVar -> (FastString, IfaceType)
+toIfaceTvBndr :: TyVar -> (IfLclName, IfaceType)
 toIfaceTvBndr tyvar   = (occNameFS (getOccName tyvar), toIfaceKind (tyVarKind tyvar))
-toIfaceIdBndr :: Id -> (FastString, IfaceType)
+toIfaceIdBndr :: Id -> (IfLclName, IfaceType)
 toIfaceIdBndr id      = (occNameFS (getOccName id),    toIfaceType (idType id))
-toIfaceTvBndrs :: [TyVar] -> [(FastString, IfaceType)]
+toIfaceTvBndrs :: [TyVar] -> [(IfLclName, IfaceType)]
 toIfaceTvBndrs tyvars = map toIfaceTvBndr tyvars
 
 toIfaceBndr :: Var -> IfaceBndr
@@ -312,6 +333,7 @@ toIfaceType (PredTy st) =
 toIfaceTyCon :: TyCon -> IfaceTyCon
 toIfaceTyCon tc 
   | isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
+  | isAnyTyCon tc   = IfaceAnyTc (toIfaceKind (tyConKind tc))
   | otherwise      = toIfaceTyCon_name (tyConName tc)
 
 toIfaceTyCon_name :: Name -> IfaceTyCon
@@ -323,7 +345,8 @@ toIfaceTyCon_name nm
 
 toIfaceWiredInTyCon :: TyCon -> Name -> IfaceTyCon
 toIfaceWiredInTyCon tc nm
-  | isTupleTyCon tc                 =  IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
+  | isTupleTyCon tc                 = IfaceTupTc  (tupleTyConBoxity tc) (tyConArity tc)
+  | isAnyTyCon tc                   = IfaceAnyTc (toIfaceKind (tyConKind tc))
   | nm == intTyConName              = IfaceIntTc
   | nm == boolTyConName             = IfaceBoolTc 
   | nm == charTyConName             = IfaceCharTc