content: {-# LANGUAGE Trustworthy #-}
  {-# LANGUAGE CPP
             , NoImplicitPrelude
             , OverlappingInstances
             , ScopedTypeVariables
             , ForeignFunctionInterface
             , FlexibleInstances
    #-}
  {-# OPTIONS_GHC -funbox-strict-fields #-}
  
  -- The -XOverlappingInstances flag allows the user to over-ride
  -- the instances for Typeable given here.  In particular, we provide an instance
  --      instance ... => Typeable (s a) 
  -- But a user might want to say
  --      instance ... => Typeable (MyType a b)
  
  -----------------------------------------------------------------------------
  -- |
  -- Module      :  Data.Typeable
  -- Copyright   :  (c) The University of Glasgow, CWI 2001--2004
  -- License     :  BSD-style (see the file libraries/base/LICENSE)
  -- 
  -- Maintainer  :  libraries@haskell.org
  -- Stability   :  experimental
  -- Portability :  portable
  --
  -- The 'Typeable' class reifies types to some extent by associating type
  -- representations to types. These type representations can be compared,
  -- and one can in turn define a type-safe cast operation. To this end,
  -- an unsafe cast is guarded by a test for type (representation)
  -- equivalence. The module "Data.Dynamic" uses Typeable for an
  -- implementation of dynamics. The module "Data.Data" uses Typeable
  -- and type-safe cast (but not dynamics) to support the \"Scrap your
  -- boilerplate\" style of generic programming.
  --
  -----------------------------------------------------------------------------
  
  module Data.Typeable
    (
  
          -- * The Typeable class
          Typeable( typeOf ),     -- :: a -> TypeRep
  
          -- * Type-safe cast
          cast,                   -- :: (Typeable a, Typeable b) => a -> Maybe b
          gcast,                  -- a generalisation of cast
  
          -- * Type representations
          TypeRep,        -- abstract, instance of: Eq, Show, Typeable
          showsTypeRep,
  
          TyCon,          -- abstract, instance of: Eq, Show, Typeable
          tyConString,    -- :: TyCon   -> String
          tyConPackage,   -- :: TyCon   -> String
          tyConModule,    -- :: TyCon   -> String
          tyConName,      -- :: TyCon   -> String
  
          -- * Construction of type representations
          mkTyCon,        -- :: String  -> TyCon
          mkTyCon3,       -- :: String  -> String -> String -> TyCon
          mkTyConApp,     -- :: TyCon   -> [TypeRep] -> TypeRep
          mkAppTy,        -- :: TypeRep -> TypeRep   -> TypeRep
          mkFunTy,        -- :: TypeRep -> TypeRep   -> TypeRep
  
          -- * Observation of type representations
          splitTyConApp,  -- :: TypeRep -> (TyCon, [TypeRep])
          funResultTy,    -- :: TypeRep -> TypeRep   -> Maybe TypeRep
          typeRepTyCon,   -- :: TypeRep -> TyCon
          typeRepArgs,    -- :: TypeRep -> [TypeRep]
          typeRepKey,     -- :: TypeRep -> IO TypeRepKey
          TypeRepKey,     -- abstract, instance of Eq, Ord
  
          -- * The other Typeable classes
          -- | /Note:/ The general instances are provided for GHC only.
          Typeable1( typeOf1 ),   -- :: t a -> TypeRep
          Typeable2( typeOf2 ),   -- :: t a b -> TypeRep
          Typeable3( typeOf3 ),   -- :: t a b c -> TypeRep
          Typeable4( typeOf4 ),   -- :: t a b c d -> TypeRep
          Typeable5( typeOf5 ),   -- :: t a b c d e -> TypeRep
          Typeable6( typeOf6 ),   -- :: t a b c d e f -> TypeRep
          Typeable7( typeOf7 ),   -- :: t a b c d e f g -> TypeRep
          gcast1,                 -- :: ... => c (t a) -> Maybe (c (t' a))
          gcast2,                 -- :: ... => c (t a b) -> Maybe (c (t' a b))
  
          -- * Default instances
          -- | /Note:/ These are not needed by GHC, for which these instances
          -- are generated by general instance declarations.
          typeOfDefault,  -- :: (Typeable1 t, Typeable a) => t a -> TypeRep
          typeOf1Default, -- :: (Typeable2 t, Typeable a) => t a b -> TypeRep
          typeOf2Default, -- :: (Typeable3 t, Typeable a) => t a b c -> TypeRep
          typeOf3Default, -- :: (Typeable4 t, Typeable a) => t a b c d -> TypeRep
          typeOf4Default, -- :: (Typeable5 t, Typeable a) => t a b c d e -> TypeRep
          typeOf5Default, -- :: (Typeable6 t, Typeable a) => t a b c d e f -> TypeRep
          typeOf6Default  -- :: (Typeable7 t, Typeable a) => t a b c d e f g -> TypeRep
  
    ) where
  
  import Data.Typeable.Internal hiding (mkTyCon)
  
  import Unsafe.Coerce
  import Data.Maybe
  
  #ifdef __GLASGOW_HASKELL__
  import GHC.Base
  import GHC.Err          (undefined)
  
  import GHC.Fingerprint.Type
  import {-# SOURCE #-} GHC.Fingerprint
     -- loop: GHC.Fingerprint -> Foreign.Ptr -> Data.Typeable
     -- Better to break the loop here, because we want non-SOURCE imports
     -- of Data.Typeable as much as possible so we can optimise the derived
     -- instances.
  
  #endif
  
  #ifdef __HUGS__
  import Hugs.Prelude     ( Key(..), TypeRep(..), TyCon(..), Ratio,
                            Handle, Ptr, FunPtr, ForeignPtr, StablePtr )
  import Hugs.IORef       ( IORef, newIORef, readIORef, writeIORef )
  import Hugs.IOExts      ( unsafePerformIO )
          -- For the Typeable instance
  import Hugs.Array       ( Array )
  import Hugs.IOArray
  import Hugs.ConcBase    ( MVar )
  #endif
  
  #ifdef __NHC__
  import NHC.IOExtras (IOArray,IORef,newIORef,readIORef,writeIORef,unsafePerformIO)
  import IO (Handle)
  import Ratio (Ratio)
          -- For the Typeable instance
  import NHC.FFI  ( Ptr,FunPtr,StablePtr,ForeignPtr )
  import Array    ( Array )
  #endif
  
  #include "Typeable.h"
  
  {-# DEPRECATED typeRepKey "TypeRep itself is now an instance of Ord" #-}
  -- | (DEPRECATED) Returns a unique key associated with a 'TypeRep'.
  -- This function is deprecated because 'TypeRep' itself is now an
  -- instance of 'Ord', so mappings can be made directly with 'TypeRep'
  -- as the key.
  --
  typeRepKey :: TypeRep -> IO TypeRepKey
  typeRepKey (TypeRep f _ _) = return (TypeRepKey f)
  
          -- 
          -- let fTy = mkTyCon "Foo" in show (mkTyConApp (mkTyCon ",,")
          --                                 [fTy,fTy,fTy])
          -- 
          -- returns "(Foo,Foo,Foo)"
          --
          -- The TypeRep Show instance promises to print tuple types
          -- correctly. Tuple type constructors are specified by a 
          -- sequence of commas, e.g., (mkTyCon ",,,,") returns
          -- the 5-tuple tycon.
  
  newtype TypeRepKey = TypeRepKey Fingerprint
    deriving (Eq,Ord)
  
  ----------------- Construction ---------------------
  
  {-# DEPRECATED mkTyCon "either derive Typeable, or use mkTyCon3 instead" #-}
  -- | Backwards-compatible API
  mkTyCon :: String       -- ^ unique string
          -> TyCon        -- ^ A unique 'TyCon' object
  mkTyCon name = TyCon (fingerprintString name) "" "" name
  
  -------------------------------------------------------------
  --
  --              Type-safe cast
  --
  -------------------------------------------------------------
  
  -- | The type-safe cast operation
  cast :: (Typeable a, Typeable b) => a -> Maybe b
  cast x = r
         where
           r = if typeOf x == typeOf (fromJust r)
                 then Just $ unsafeCoerce x
                 else Nothing
  
  -- | A flexible variation parameterised in a type constructor
  gcast :: (Typeable a, Typeable b) => c a -> Maybe (c b)
  gcast x = r
   where
    r = if typeOf (getArg x) == typeOf (getArg (fromJust r))
          then Just $ unsafeCoerce x
          else Nothing
    getArg :: c x -> x 
    getArg = undefined
  
  -- | Cast for * -> *
  gcast1 :: (Typeable1 t, Typeable1 t') => c (t a) -> Maybe (c (t' a)) 
  gcast1 x = r
   where
    r = if typeOf1 (getArg x) == typeOf1 (getArg (fromJust r))
         then Just $ unsafeCoerce x
         else Nothing
    getArg :: c x -> x 
    getArg = undefined
  
  -- | Cast for * -> * -> *
  gcast2 :: (Typeable2 t, Typeable2 t') => c (t a b) -> Maybe (c (t' a b)) 
  gcast2 x = r
   where
    r = if typeOf2 (getArg x) == typeOf2 (getArg (fromJust r))
         then Just $ unsafeCoerce x
         else Nothing
    getArg :: c x -> x 
    getArg = undefined
  
  