[project @ 1996-05-16 09:42:08 by partain]

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

diff --git a/ghc/compiler/types/TyCon.lhs b/ghc/compiler/types/TyCon.lhs
index e0a6ed2..d406196 100644 (file)
--- a/ghc/compiler/types/TyCon.lhs
+++ b/ghc/compiler/types/TyCon.lhs
@@ -12,7 +12,7 @@ module TyCon(
        Arity(..), NewOrData(..),
 
        isFunTyCon, isPrimTyCon, isBoxedTyCon,
-       isDataTyCon, isSynTyCon,
+       isDataTyCon, isSynTyCon, isNewTyCon,
 
        mkDataTyCon,
        mkFunTyCon,
@@ -48,16 +48,17 @@ import TyLoop               ( Type(..), GenType,
 import TyVar           ( GenTyVar, alphaTyVars, alphaTyVar, betaTyVar )
 import Usage           ( GenUsage, Usage(..) )
 import Kind            ( Kind, mkBoxedTypeKind, mkArrowKind, resultKind, argKind )
-import PrelMods                ( pRELUDE_BUILTIN )
 
 import Maybes
 import Name            ( Name, RdrName(..), appendRdr, nameUnique,
                          mkTupleTyConName, mkFunTyConName
                        )
 import Unique          ( Unique, funTyConKey, mkTupleTyConUnique )
+import PrelInfo                ( intDataCon, charDataCon )
 import Pretty          ( Pretty(..), PrettyRep )
 import PprStyle                ( PprStyle )
 import SrcLoc          ( SrcLoc, mkBuiltinSrcLoc )
+import Unique          ( intDataConKey, charDataConKey )
 import Util            ( panic, panic#, nOfThem, isIn, Ord3(..) )
 \end{code}
 
@@ -146,8 +147,12 @@ isBoxedTyCon = not . isPrimTyCon
 -- isDataTyCon returns False for @newtype@.
 -- Not sure about this decision yet.
 isDataTyCon (DataTyCon _ _ _ _ _ _ _ DataType) = True
+isDataTyCon (TupleTyCon _ _ _)                = True
 isDataTyCon other                             = False
 
+isNewTyCon (DataTyCon _ _ _ _ _ _ _ NewType) = True 
+isNewTyCon other                            = False
+
 isSynTyCon (SynTyCon _ _ _ _ _ _) = True
 isSynTyCon _                     = False
 \end{code}
@@ -161,14 +166,7 @@ tyConKind :: TyCon -> Kind
 tyConKind FunTyCon                      = kind2
 tyConKind (DataTyCon _ _ kind _ _ _ _ _) = kind
 tyConKind (PrimTyCon _ _ kind)          = kind
-
-tyConKind (SpecTyCon tc tys)
-  = spec (tyConKind tc) tys
-   where
-    spec kind []             = kind
-    spec kind (Just _  : tys) = spec (resultKind kind) tys
-    spec kind (Nothing : tys) =
-      argKind kind `mkArrowKind` spec (resultKind kind) tys
+tyConKind (SynTyCon _ _ k _ _ _)        = k
 
 tyConKind (TupleTyCon _ _ n)
   = mkArrow n
@@ -177,6 +175,14 @@ tyConKind (TupleTyCon _ _ n)
     mkArrow 1 = kind1
     mkArrow 2 = kind2
     mkArrow n = mkBoxedTypeKind `mkArrowKind` mkArrow (n-1)
+
+tyConKind (SpecTyCon tc tys)
+  = spec (tyConKind tc) tys
+   where
+    spec kind []             = kind
+    spec kind (Just _  : tys) = spec (resultKind kind) tys
+    spec kind (Nothing : tys) =
+      argKind kind `mkArrowKind` spec (resultKind kind) tys
 \end{code}
 
 \begin{code}
@@ -229,7 +235,7 @@ tyConFamilySize (TupleTyCon _ _ _)              = 1
 \begin{code}
 tyConDerivings :: TyCon -> [Class]
 tyConDerivings (DataTyCon _ _ _ _ _ _ derivs _) = derivs
-tyConDerivings other                              = []
+tyConDerivings other                           = []
 \end{code}
 
 \begin{code}
@@ -297,11 +303,13 @@ instance Ord3 TyCon where
     where
       tag1 = tag_TyCon other_1
       tag2 = tag_TyCon other_2
+
       tag_TyCon FunTyCon                   = ILIT(1)
       tag_TyCon (DataTyCon _ _ _ _ _ _ _ _) = ILIT(2)
       tag_TyCon (TupleTyCon _ _ _)         = ILIT(3)
       tag_TyCon (PrimTyCon  _ _ _)         = ILIT(4)
       tag_TyCon (SpecTyCon  _ _)           = ILIT(5)
+      tag_TyCon (SynTyCon _ _ _ _ _ _)     = ILIT(6)
 
 instance Eq TyCon where
     a == b = case (a `cmp` b) of { EQ_ -> True;   _ -> False }
@@ -315,11 +323,12 @@ instance Ord TyCon where
     _tagCmp a b = case (a `cmp` b) of { LT_ -> _LT; EQ_ -> _EQ; GT__ -> _GT }
 
 instance Uniquable TyCon where
-    uniqueOf (DataTyCon u _ _ _ _ _ _ _) = u
-    uniqueOf (PrimTyCon u _ _)          = u
-    uniqueOf (SynTyCon  u _ _ _ _ _)    = u
-    uniqueOf tc@(SpecTyCon _ _)                 = panic "uniqueOf:SpecTyCon"
-    uniqueOf tc                                 = uniqueOf (getName tc)
+    uniqueOf (DataTyCon  u _ _ _ _ _ _ _) = u
+    uniqueOf (TupleTyCon u _ _)                  = u
+    uniqueOf (PrimTyCon  u _ _)                  = u
+    uniqueOf (SynTyCon   u _ _ _ _ _)    = u
+    uniqueOf tc@(SpecTyCon _ _)                  = panic "uniqueOf:SpecTyCon"
+    uniqueOf tc                                  = uniqueOf (getName tc)
 \end{code}
 
 \begin{code}
@@ -333,9 +342,9 @@ instance NamedThing TyCon where
     getName tc                         = panic "TyCon.getName"
 
 {- LATER:
-    getName (SpecTyCon tc tys) = let (m,n) = getOrigName tc in
+    getName (SpecTyCon tc tys) = let (m,n) = moduleNamePair tc in
                                     (m, n _APPEND_ specMaybeTysSuffix tys)
-    getName    other_tc           = getOrigName (expectJust "tycon1" (getName other_tc))
+    getName    other_tc           = moduleNamePair (expectJust "tycon1" (getName other_tc))
     getName other                           = Nothing
 -}
 \end{code}