Re-add FunTy (big patch)
[ghc.git] / compiler / types / TyCon.hs
index 628eabd..c7c225d 100644 (file)
@@ -6,7 +6,7 @@
 The @TyCon@ datatype
 -}
 
-{-# LANGUAGE CPP, DeriveDataTypeable #-}
+{-# LANGUAGE CPP #-}
 
 module TyCon(
         -- * Main TyCon data types
@@ -111,7 +111,7 @@ module TyCon(
 
 #include "HsVersions.h"
 
-import {-# SOURCE #-} TyCoRep ( Kind, Type, PredType, TyBinder, pprType, mkForAllTys )
+import {-# SOURCE #-} TyCoRep ( Kind, Type, PredType, TyBinder, pprType, mkPiTys )
 import {-# SOURCE #-} TysWiredIn  ( runtimeRepTyCon, constraintKind
                                   , vecCountTyCon, vecElemTyCon, liftedTypeKind )
 import {-# SOURCE #-} DataCon ( DataCon, dataConExTyVars, dataConFieldLabels )
@@ -137,7 +137,6 @@ import UniqSet
 import Module
 
 import qualified Data.Data as Data
-import Data.Typeable (Typeable)
 
 {-
 -----------------------------------------------
@@ -368,6 +367,15 @@ See also:
 ************************************************************************
 -}
 
+{- Note [TyCon binders]
+~~~~~~~~~~~~~~~~~~~~~~~
+
+data TyConBinder = TCB TyVar TcConBinderVis
+
+data TyConBinderVis = NamedTCB VisiblityFlag
+                    | AnonTCB
+-}
+
 -- | TyCons represent type constructors. Type constructors are introduced by
 -- things such as:
 --
@@ -609,7 +617,6 @@ data TyCon
         tcTyConScopedTyVars :: [TyVar] -- ^ Scoped tyvars over the
                                        -- tycon's body. See Note [TcTyCon]
       }
-  deriving Typeable
 
 
 -- | Represents right-hand-sides of 'TyCon's for algebraic types
@@ -813,7 +820,7 @@ data FamTyConFlav
 All TyCons have this group of fields
   tyConBinders :: [TyBinder]
   tyConResKind :: Kind
-  tyConKind    :: Kind   -- Cached = mkForAllTys tyConBinders tyConResKind
+  tyConKind    :: Kind   -- Cached = mkPiTys tyConBinders tyConResKind
   tyConArity   :: Arity  -- Cached = length tyConBinders
 
 They fit together like so:
@@ -834,8 +841,8 @@ They fit together like so:
   considered saturated.  Here we mean "applied to in the actual Type",
   not surface syntax; i.e. including implicit kind variables.
 
-Note [tyConBinders and tyConTyVars]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Note [tyConTyVars and tyConBinders]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider
   type App a (b :: k) = a b
     -- App :: forall {k}; (k->*) -> k -> *
@@ -1197,20 +1204,20 @@ primRepIsFloat  _            = Just False
 
 -- | The labels for the fields of this particular 'TyCon'
 tyConFieldLabels :: TyCon -> [FieldLabel]
-tyConFieldLabels tc = fsEnvElts $ tyConFieldLabelEnv tc
+tyConFieldLabels tc = dFsEnvElts $ tyConFieldLabelEnv tc
 
 -- | The labels for the fields of this particular 'TyCon'
 tyConFieldLabelEnv :: TyCon -> FieldLabelEnv
 tyConFieldLabelEnv tc
   | isAlgTyCon tc = algTcFields tc
-  | otherwise     = emptyFsEnv
+  | otherwise     = emptyDFsEnv
 
 
 -- | Make a map from strings to FieldLabels from all the data
 -- constructors of this algebraic tycon
 fieldsOfAlgTcRhs :: AlgTyConRhs -> FieldLabelEnv
-fieldsOfAlgTcRhs rhs = mkFsEnv [ (flLabel fl, fl)
-                               | fl <- dataConsFields (visibleDataCons rhs) ]
+fieldsOfAlgTcRhs rhs = mkDFsEnv [ (flLabel fl, fl)
+                                | fl <- dataConsFields (visibleDataCons rhs) ]
   where
     -- Duplicates in this list will be removed by 'mkFsEnv'
     dataConsFields dcs = concatMap dataConFieldLabels dcs
@@ -1240,7 +1247,7 @@ mkFunTyCon name binders rep_nm
         tyConName    = name,
         tyConBinders = binders,
         tyConResKind = liftedTypeKind,
-        tyConKind    = mkForAllTys binders liftedTypeKind,
+        tyConKind    = mkPiTys binders liftedTypeKind,
         tyConArity   = 2,
         tcRepName    = rep_nm
     }
@@ -1271,7 +1278,7 @@ mkAlgTyCon name binders res_kind tyvars roles cType stupid rhs parent is_rec gad
         tyConUnique      = nameUnique name,
         tyConBinders     = binders,
         tyConResKind     = res_kind,
-        tyConKind        = mkForAllTys binders res_kind,
+        tyConKind        = mkPiTys binders res_kind,
         tyConArity       = length tyvars,
         tyConTyVars      = tyvars,
         tcRoles          = roles,
@@ -1308,7 +1315,7 @@ mkTupleTyCon name binders res_kind arity tyvars con sort parent
         tyConUnique      = nameUnique name,
         tyConBinders     = binders,
         tyConResKind     = res_kind,
-        tyConKind        = mkForAllTys binders res_kind,
+        tyConKind        = mkPiTys binders res_kind,
         tyConArity       = arity,
         tyConTyVars      = tyvars,
         tcRoles          = replicate arity Representational,
@@ -1316,7 +1323,7 @@ mkTupleTyCon name binders res_kind arity tyvars con sort parent
         algTcStupidTheta = [],
         algTcRhs         = TupleTyCon { data_con = con,
                                         tup_sort = sort },
-        algTcFields      = emptyFsEnv,
+        algTcFields      = emptyDFsEnv,
         algTcParent      = parent,
         algTcRec         = NonRecursive,
         algTcGadtSyntax  = False
@@ -1339,7 +1346,7 @@ mkTcTyCon name tvs binders res_kind unsat scoped_tvs
             , tyConTyVars  = tvs
             , tyConBinders = binders
             , tyConResKind = res_kind
-            , tyConKind    = mkForAllTys binders res_kind
+            , tyConKind    = mkPiTys binders res_kind
             , tyConUnsat   = unsat
             , tyConArity   = length binders
             , tcTyConScopedTyVars = scoped_tvs }
@@ -1365,7 +1372,8 @@ mkLiftedPrimTyCon :: Name -> [TyBinder]
                   -> Kind   -- ^ /result/ kind
                   -> [Role] -> TyCon
 mkLiftedPrimTyCon name binders res_kind roles
-  = mkPrimTyCon' name binders res_kind roles False Nothing
+  = mkPrimTyCon' name binders res_kind roles False (Just rep_nm)
+  where rep_nm = mkPrelTyConRepName name
 
 mkPrimTyCon' :: Name -> [TyBinder]
              -> Kind    -- ^ /result/ kind
@@ -1377,7 +1385,7 @@ mkPrimTyCon' name binders res_kind roles is_unlifted rep_nm
         tyConUnique  = nameUnique name,
         tyConBinders = binders,
         tyConResKind = res_kind,
-        tyConKind    = mkForAllTys binders res_kind,
+        tyConKind    = mkPiTys binders res_kind,
         tyConArity   = length roles,
         tcRoles      = roles,
         isUnlifted   = is_unlifted,
@@ -1393,7 +1401,7 @@ mkSynonymTyCon name binders res_kind tyvars roles rhs
         tyConUnique  = nameUnique name,
         tyConBinders = binders,
         tyConResKind = res_kind,
-        tyConKind    = mkForAllTys binders res_kind,
+        tyConKind    = mkPiTys binders res_kind,
         tyConArity   = length tyvars,
         tyConTyVars  = tyvars,
         tcRoles      = roles,
@@ -1410,7 +1418,7 @@ mkFamilyTyCon name binders res_kind tyvars resVar flav parent inj
       , tyConName    = name
       , tyConBinders = binders
       , tyConResKind = res_kind
-      , tyConKind    = mkForAllTys binders res_kind
+      , tyConKind    = mkPiTys binders res_kind
       , tyConArity   = length tyvars
       , tyConTyVars  = tyvars
       , famTcResVar  = resVar
@@ -1434,7 +1442,7 @@ mkPromotedDataCon con name rep_name binders res_kind roles rep_info
         tcRoles       = roles,
         tyConBinders  = binders,
         tyConResKind  = res_kind,
-        tyConKind     = mkForAllTys binders res_kind,
+        tyConKind     = mkPiTys binders res_kind,
         dataCon       = con,
         tcRepName     = rep_name,
         promDcRepInfo = rep_info
@@ -2073,8 +2081,8 @@ tyConRuntimeRepInfo _                                         = NoRRI
 -}
 
 instance Eq TyCon where
-    a == b = case (a `compare` b) of { EQ -> True;   _ -> False }
-    a /= b = case (a `compare` b) of { EQ -> False;  _ -> True  }
+    a == b = getUnique a == getUnique b
+    a /= b = getUnique a /= getUnique b
 
 instance Ord TyCon where
     a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }