Commit 18741899 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

For GHC, implement the Typeable.hs macros using standalone deriving

As well as being more pleasant, this fixes #1841:
    Data.Typeable: Instances of basic types don't provide qualified
    strings to mkTyCon
parent bea20c00
{-# LANGUAGE CPP #-}
#ifdef __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
#endif
-----------------------------------------------------------------------------
-- |
......
{-# LANGUAGE CPP #-}
#ifdef __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
#endif
-----------------------------------------------------------------------------
-- |
......
{-# LANGUAGE CPP #-}
#ifdef __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
#endif
-----------------------------------------------------------------------------
-- |
......
{-# LANGUAGE CPP #-}
#ifdef __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
#endif
-----------------------------------------------------------------------------
-- |
......
{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-}
#ifdef __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
#endif
#include "Typeable.h"
......
......@@ -3,6 +3,9 @@
, ForeignFunctionInterface
, ExistentialQuantification
#-}
#ifdef __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
#endif
#include "Typeable.h"
......
{-# LANGUAGE CPP, DeriveDataTypeable #-}
#ifdef __GLASGOW_HASKELL__
{-# LANGUAGE StandaloneDeriving #-}
#endif
-----------------------------------------------------------------------------
-- |
......
{-# LANGUAGE CPP, NoImplicitPrelude #-}
#ifdef __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
#endif
-----------------------------------------------------------------------------
-- |
......
{-# LANGUAGE CPP, NoImplicitPrelude #-}
#ifdef __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
#endif
-----------------------------------------------------------------------------
-- |
......
......@@ -6,6 +6,9 @@
, FlexibleInstances
#-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
#ifdef __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
#endif
-- The -XOverlappingInstances flag allows the user to over-ride
-- the instances for Typeable given here. In particular, we provide an instance
......@@ -577,9 +580,26 @@ gcast2 x = r
INSTANCE_TYPEABLE0((),unitTc,"()")
INSTANCE_TYPEABLE1([],listTc,"[]")
#if defined(__GLASGOW_HASKELL__)
listTc :: TyCon
listTc = typeRepTyCon (typeOf [()])
#endif
INSTANCE_TYPEABLE1(Maybe,maybeTc,"Maybe")
INSTANCE_TYPEABLE1(Ratio,ratioTc,"Ratio")
#if defined(__GLASGOW_HASKELL__)
{-
TODO: Deriving this instance fails with:
libraries/base/Data/Typeable.hs:589:1:
Can't make a derived instance of `Typeable2 (->)':
The last argument of the instance must be a data or newtype application
In the stand-alone deriving instance for `Typeable2 (->)'
-}
instance Typeable2 (->) where { typeOf2 _ = mkTyConApp funTc [] }
funTc :: TyCon
funTc = mkTyCon "->"
#else
INSTANCE_TYPEABLE2((->),funTc,"->")
#endif
INSTANCE_TYPEABLE1(IO,ioTc,"IO")
#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)
......@@ -651,7 +671,17 @@ INSTANCE_TYPEABLE0(TyCon,tyconTc,"TyCon")
INSTANCE_TYPEABLE0(TypeRep,typeRepTc,"TypeRep")
#ifdef __GLASGOW_HASKELL__
INSTANCE_TYPEABLE0(RealWorld,realWorldTc,"RealWorld")
{-
TODO: This can't be derived currently:
libraries/base/Data/Typeable.hs:674:1:
Can't make a derived instance of `Typeable RealWorld':
The last argument of the instance must be a data or newtype application
In the stand-alone deriving instance for `Typeable RealWorld'
-}
realWorldTc :: TyCon; \
realWorldTc = mkTyCon "GHC.Base.RealWorld"; \
instance Typeable RealWorld where { typeOf _ = mkTyConApp realWorldTc [] }
#endif
---------------------------------------------
......
......@@ -4,6 +4,9 @@
, GeneralizedNewtypeDeriving
#-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
#ifdef __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
#endif
-- XXX -fno-warn-unused-binds stops us warning about unused constructors,
-- but really we should just remove them if we don't want them
......@@ -91,7 +94,7 @@ import Foreign.Storable
import Data.Bits ( Bits(..) )
import Data.Int ( Int8, Int16, Int32, Int64 )
import Data.Word ( Word8, Word16, Word32, Word64 )
import {-# SOURCE #-} Data.Typeable (Typeable(typeOf), TyCon, mkTyCon, mkTyConApp)
import {-# SOURCE #-} Data.Typeable
#ifdef __GLASGOW_HASKELL__
import GHC.Base
......
......@@ -4,6 +4,9 @@
, MagicHash
, GeneralizedNewtypeDeriving
#-}
#ifdef __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
#endif
-----------------------------------------------------------------------------
-- |
......
......@@ -7,6 +7,7 @@
, UnliftedFFITypes
, ForeignFunctionInterface
, DeriveDataTypeable
, StandaloneDeriving
, RankNTypes
#-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
......
......@@ -5,6 +5,7 @@
, UnboxedTuples
#-}
{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
-----------------------------------------------------------------------------
-- |
......
......@@ -4,6 +4,8 @@
, BangPatterns
, MagicHash
, UnboxedTuples
, DeriveDataTypeable
, StandaloneDeriving
#-}
{-# OPTIONS_HADDOCK hide #-}
......
{-# LANGUAGE CPP #-}
#ifdef __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
{-# LANGUAGE MagicHash #-}
#if !defined(__PARALLEL_HASKELL__)
{-# LANGUAGE UnboxedTuples #-}
......
......@@ -4,6 +4,9 @@
, GeneralizedNewtypeDeriving
#-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
#ifdef __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
#endif
-----------------------------------------------------------------------------
-- |
......
{-# LANGUAGE CPP #-}
#ifdef __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
#endif
-------------------------------------------------------------------------------
-- |
......
......@@ -14,52 +14,26 @@
#ifndef TYPEABLE_H
#define TYPEABLE_H
#define INSTANCE_TYPEABLE0(tycon,tcname,str) \
tcname :: TyCon; \
tcname = mkTyCon str; \
instance Typeable tycon where { typeOf _ = mkTyConApp tcname [] }
#ifdef __GLASGOW_HASKELL__
-- // For GHC, the extra instances follow from general instance declarations
-- // defined in Data.Typeable.
-- // For GHC, we can use DeriveDataTypeable + StandaloneDeriving to
-- // generate the instances.
#define INSTANCE_TYPEABLE1(tycon,tcname,str) \
tcname :: TyCon; \
tcname = mkTyCon str; \
instance Typeable1 tycon where { typeOf1 _ = mkTyConApp tcname [] }
#define INSTANCE_TYPEABLE0(tycon,tcname,str) deriving instance Typeable tycon
#define INSTANCE_TYPEABLE1(tycon,tcname,str) deriving instance Typeable1 tycon
#define INSTANCE_TYPEABLE2(tycon,tcname,str) deriving instance Typeable2 tycon
#define INSTANCE_TYPEABLE3(tycon,tcname,str) deriving instance Typeable3 tycon
#define INSTANCE_TYPEABLE4(tycon,tcname,str) deriving instance Typeable4 tycon
#define INSTANCE_TYPEABLE5(tycon,tcname,str) deriving instance Typeable5 tycon
#define INSTANCE_TYPEABLE6(tycon,tcname,str) deriving instance Typeable6 tycon
#define INSTANCE_TYPEABLE7(tycon,tcname,str) deriving instance Typeable7 tycon
#define INSTANCE_TYPEABLE2(tycon,tcname,str) \
tcname :: TyCon; \
tcname = mkTyCon str; \
instance Typeable2 tycon where { typeOf2 _ = mkTyConApp tcname [] }
#define INSTANCE_TYPEABLE3(tycon,tcname,str) \
tcname :: TyCon; \
tcname = mkTyCon str; \
instance Typeable3 tycon where { typeOf3 _ = mkTyConApp tcname [] }
#define INSTANCE_TYPEABLE4(tycon,tcname,str) \
tcname :: TyCon; \
tcname = mkTyCon str; \
instance Typeable4 tycon where { typeOf4 _ = mkTyConApp tcname [] }
#define INSTANCE_TYPEABLE5(tycon,tcname,str) \
tcname :: TyCon; \
tcname = mkTyCon str; \
instance Typeable5 tycon where { typeOf5 _ = mkTyConApp tcname [] }
#define INSTANCE_TYPEABLE6(tycon,tcname,str) \
tcname :: TyCon; \
tcname = mkTyCon str; \
instance Typeable6 tycon where { typeOf6 _ = mkTyConApp tcname [] }
#else /* !__GLASGOW_HASKELL__ */
#define INSTANCE_TYPEABLE7(tycon,tcname,str) \
#define INSTANCE_TYPEABLE0(tycon,tcname,str) \
tcname :: TyCon; \
tcname = mkTyCon str; \
instance Typeable7 tycon where { typeOf7 _ = mkTyConApp tcname [] }
#else /* !__GLASGOW_HASKELL__ */
instance Typeable tycon where { typeOf _ = mkTyConApp tcname [] }
#define INSTANCE_TYPEABLE1(tycon,tcname,str) \
tcname = mkTyCon str; \
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment