[project @ 1997-05-18 04:15:13 by sof]

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

diff --git a/ghc/compiler/types/TyCon.lhs b/ghc/compiler/types/TyCon.lhs
index d79ce4d..0460e6e 100644 (file)
--- a/ghc/compiler/types/TyCon.lhs
+++ b/ghc/compiler/types/TyCon.lhs
@@ -34,7 +34,7 @@ module TyCon(
        getSynTyConDefn,
 
         maybeTyConSingleCon,
-       isEnumerationTyCon,
+       isEnumerationTyCon, isTupleTyCon,
        derivedFor
 ) where
 
@@ -44,7 +44,7 @@ IMPORT_DELOOPER(TyLoop)       ( SYN_IE(Type), GenType,
                          SYN_IE(Class), GenClass,
                          SYN_IE(Id), GenId,
                          splitSigmaTy, splitFunTy,
-                         mkTupleCon, isNullaryDataCon, idType
+                         tupleCon, isNullaryDataCon, idType
                          --LATER: specMaybeTysSuffix
                        )
 
@@ -53,18 +53,18 @@ import Usage                ( GenUsage, SYN_IE(Usage) )
 import Kind            ( Kind, mkBoxedTypeKind, mkArrowKind, resultKind, argKind )
 
 import Maybes
-import Name            ( Name, RdrName(..), appendRdr, nameUnique,
-                         mkTupleTyConName, mkFunTyConName
-                       )
-import Unique          ( Unique, funTyConKey, mkTupleTyConUnique )
+import Name            ( Name, nameUnique, mkWiredInTyConName )
+import Unique          ( Unique, funTyConKey )
 import Pretty          ( SYN_IE(Pretty), PrettyRep )
 import PrimRep         ( PrimRep(..) )
+import PrelMods                ( gHC__, pREL_TUP, pREL_BASE )
+import Lex             ( mkTupNameStr )
 import SrcLoc          ( SrcLoc, mkBuiltinSrcLoc )
-import Util            ( nOfThem, isIn, Ord3(..), panic, panic#, assertPanic, pprPanic{-ToDo:rm-} )
-import {-hide me-}
-       PprType (pprTyCon)
-import {-hide me-}
-       PprStyle--ToDo:rm
+import Util            ( nOfThem, isIn, Ord3(..), panic, panic#, assertPanic )
+--import {-hide me-}
+--     PprType (pprTyCon)
+--import {-hide me-}
+--     PprStyle--ToDo:rm
 \end{code}
 
 \begin{code}
@@ -79,6 +79,11 @@ data TyCon
                [TyVar]
                [(Class,Type)]  -- Its context
                [Id]            -- Its data constructors, with fully polymorphic types
+                               --      This list can be empty, when we import a data type abstractly,
+                               --      either (a) the interface is hand-written and doesn't give
+                               --                 the constructors, or
+                               --             (b) in a quest for fast compilation we don't import 
+                               --                 the constructors
                [Class]         -- Classes which have derived instances
                NewOrData
 
@@ -124,14 +129,11 @@ data NewOrData
 \end{code}
 
 \begin{code}
-mkFunTyCon   = FunTyCon
-mkSpecTyCon  = SpecTyCon
+mkFunTyCon     = FunTyCon
+mkFunTyConName = mkWiredInTyConName funTyConKey gHC__ SLIT("->") FunTyCon
 
-mkTupleTyCon arity
-  = TupleTyCon u n arity 
-  where
-    n = mkTupleTyConName arity
-    u = uniqueOf n
+mkSpecTyCon  = SpecTyCon
+mkTupleTyCon = TupleTyCon
 
 mkDataTyCon name = DataTyCon (nameUnique name) name
 mkPrimTyCon name = PrimTyCon (nameUnique name) name
@@ -229,7 +231,7 @@ tyConDataCons :: TyCon -> [Id]
 tyConFamilySize  :: TyCon -> Int
 
 tyConDataCons (DataTyCon _ _ _ _ _ data_cons _ _) = data_cons
-tyConDataCons (TupleTyCon _ _ a)                 = [mkTupleCon a]
+tyConDataCons (TupleTyCon _ _ a)                 = [tupleCon a]
 tyConDataCons other                              = []
        -- You may think this last equation should fail,
        -- but it's quite convenient to return no constructors for
@@ -238,7 +240,7 @@ tyConDataCons other                           = []
 tyConFamilySize (DataTyCon _ _ _ _ _ data_cons _ _) = length data_cons
 tyConFamilySize (TupleTyCon _ _ _)                 = 1
 #ifdef DEBUG
-tyConFamilySize other = pprPanic "tyConFamilySize:" (pprTyCon PprDebug other)
+--tyConFamilySize other = pprPanic "tyConFamilySize:" (pprTyCon PprDebug other)
 #endif
 
 tyConPrimRep :: TyCon -> PrimRep
@@ -267,7 +269,7 @@ getSynTyConDefn (SynTyCon _ _ _ _ tyvars ty) = (tyvars,ty)
 \begin{code}
 maybeTyConSingleCon :: TyCon -> Maybe Id
 
-maybeTyConSingleCon (TupleTyCon _ _ arity)        = Just (mkTupleCon arity)
+maybeTyConSingleCon (TupleTyCon _ _ arity)        = Just (tupleCon arity)
 maybeTyConSingleCon (DataTyCon _ _ _ _ _ [c] _ _) = Just c
 maybeTyConSingleCon (DataTyCon _ _ _ _ _ _   _ _) = Nothing
 maybeTyConSingleCon (PrimTyCon _ _ _ _)                  = Nothing
@@ -278,6 +280,13 @@ isEnumerationTyCon (TupleTyCon _ _ arity)
   = arity == 0
 isEnumerationTyCon (DataTyCon _ _ _ _ _ data_cons _ _)
   = not (null data_cons) && all isNullaryDataCon data_cons
+
+
+isTupleTyCon (TupleTyCon _ _ arity) = arity >= 2    -- treat "0-tuple" specially
+isTupleTyCon (SpecTyCon tc tys)     = isTupleTyCon tc
+isTupleTyCon other                 = False
+
+
 \end{code}
 
 @derivedFor@ reports if we have an {\em obviously}-derived instance
@@ -344,4 +353,5 @@ instance NamedThing TyCon where
     getName    other_tc           = moduleNamePair (expectJust "tycon1" (getName other_tc))
     getName other                           = Nothing
 -}
+
 \end{code}