Repository : ssh://darcs.haskell.org//srv/darcs/packages/ghc-prim On branch : fix#5464
http://hackage.haskell.org/trac/ghc/changeset/60a85ba01303e1a28024e9983f5e9733fbd4888c >--------------------------------------------------------------- commit 60a85ba01303e1a28024e9983f5e9733fbd4888c Author: Jose Pedro Magalhaes <[email protected]> Date: Thu Sep 8 08:08:01 2011 +0200 Break the GHC.Generics / GHC.Types import loop. Also related to #5464. Now GHC.Generics imports GHC.Types, and the Generic instances for primitive types use StandaloneDeriving. >--------------------------------------------------------------- GHC/CString.hs | 2 +- GHC/Generics.hs | 81 +++++++++++++++++++++++++++++++++++++++++++++++++++- GHC/Types.hs | 81 ++--------------------------------------------------- GHC/Types.hs-boot | 17 ----------- 4 files changed, 83 insertions(+), 98 deletions(-) diff --git a/GHC/CString.hs b/GHC/CString.hs index 4c10b30..92842ae 100644 --- a/GHC/CString.hs +++ b/GHC/CString.hs @@ -20,7 +20,7 @@ module GHC.CString ( unpackCStringUtf8#, unpackNBytes# ) where -import {-# SOURCE #-} GHC.Types +import GHC.Types import GHC.Prim ----------------------------------------------------------------------------- diff --git a/GHC/Generics.hs b/GHC/Generics.hs index 21d4e63..9095f73 100644 --- a/GHC/Generics.hs +++ b/GHC/Generics.hs @@ -1,11 +1,12 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE EmptyDataDecls #-} -{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE DeriveGeneric #-} module GHC.Generics ( -- * Generic representation types @@ -26,7 +27,7 @@ module GHC.Generics ( ) where -- We use some base types -import {-# SOURCE #-} GHC.Types +import GHC.Types -- We need this to give the Generic instances in ghc-prim import GHC.CString () @@ -164,3 +165,79 @@ class Generic1 f where -- | Convert from the representation to the datatype to1 :: (Rep1 f) a -> f a +-------------------------------------------------------------------------------- +-- Generic representations +-------------------------------------------------------------------------------- + +-- Int +data D_Int +data C_Int + +instance Datatype D_Int where + datatypeName _ = "Int" + moduleName _ = "GHC.Int" + +instance Constructor C_Int where + conName _ = "" -- JPM: I'm not sure this is the right implementation... + +instance Generic Int where + type Rep Int = D1 D_Int (C1 C_Int (S1 NoSelector (Rec0 Int))) + from x = M1 (M1 (M1 (K1 x))) + to (M1 (M1 (M1 (K1 x)))) = x + + +-- Float +data D_Float +data C_Float + +instance Datatype D_Float where + datatypeName _ = "Float" + moduleName _ = "GHC.Float" + +instance Constructor C_Float where + conName _ = "" -- JPM: I'm not sure this is the right implementation... + +instance Generic Float where + type Rep Float = D1 D_Float (C1 C_Float (S1 NoSelector (Rec0 Float))) + from x = M1 (M1 (M1 (K1 x))) + to (M1 (M1 (M1 (K1 x)))) = x + + +-- Double +data D_Double +data C_Double + +instance Datatype D_Double where + datatypeName _ = "Double" + moduleName _ = "GHC.Float" + +instance Constructor C_Double where + conName _ = "" -- JPM: I'm not sure this is the right implementation... + +instance Generic Double where + type Rep Double = D1 D_Double (C1 C_Double (S1 NoSelector (Rec0 Double))) + from x = M1 (M1 (M1 (K1 x))) + to (M1 (M1 (M1 (K1 x)))) = x + + +-- Char +data D_Char +data C_Char + +instance Datatype D_Char where + datatypeName _ = "Char" + moduleName _ = "GHC.Base" + +instance Constructor C_Char where + conName _ = "" -- JPM: I'm not sure this is the right implementation... + +instance Generic Char where + type Rep Char = D1 D_Char (C1 C_Char (S1 NoSelector (Rec0 Char))) + from x = M1 (M1 (M1 (K1 x))) + to (M1 (M1 (M1 (K1 x)))) = x + + +-- Derived instances +deriving instance Generic [a] +deriving instance Generic Bool +deriving instance Generic Ordering diff --git a/GHC/Types.hs b/GHC/Types.hs index 3303cda..3862656 100644 --- a/GHC/Types.hs +++ b/GHC/Types.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude, TypeFamilies, DeriveGeneric #-} +{-# LANGUAGE NoImplicitPrelude, TypeFamilies #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Types @@ -22,14 +22,13 @@ module GHC.Types ( ) where import GHC.Prim -import GHC.Generics infixr 5 : -data [] a = [] | a : [a] deriving Generic +data [] a = [] | a : [a] -data Bool = False | True deriving Generic +data Bool = False | True {- | The character type 'Char' is an enumeration whose values represent Unicode (or equivalently ISO\/IEC 10646) characters (see @@ -60,7 +59,6 @@ data Float = F# Float# data Double = D# Double# data Ordering = LT | EQ | GT - deriving Generic {- | A value of type @'IO' a@ is a computation which, when performed, @@ -76,76 +74,3 @@ at some point, directly or indirectly, from @Main.main@. or the '>>' and '>>=' operations from the 'Monad' class. -} newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #)) - - --------------------------------------------------------------------------------- --- Generic representations --------------------------------------------------------------------------------- - --- Int -data D_Int -data C_Int - -instance Datatype D_Int where - datatypeName _ = "Int" - moduleName _ = "GHC.Int" - -instance Constructor C_Int where - conName _ = "" -- JPM: I'm not sure this is the right implementation... - -instance Generic Int where - type Rep Int = D1 D_Int (C1 C_Int (S1 NoSelector (Rec0 Int))) - from x = M1 (M1 (M1 (K1 x))) - to (M1 (M1 (M1 (K1 x)))) = x - - --- Float -data D_Float -data C_Float - -instance Datatype D_Float where - datatypeName _ = "Float" - moduleName _ = "GHC.Float" - -instance Constructor C_Float where - conName _ = "" -- JPM: I'm not sure this is the right implementation... - -instance Generic Float where - type Rep Float = D1 D_Float (C1 C_Float (S1 NoSelector (Rec0 Float))) - from x = M1 (M1 (M1 (K1 x))) - to (M1 (M1 (M1 (K1 x)))) = x - - --- Double -data D_Double -data C_Double - -instance Datatype D_Double where - datatypeName _ = "Double" - moduleName _ = "GHC.Float" - -instance Constructor C_Double where - conName _ = "" -- JPM: I'm not sure this is the right implementation... - -instance Generic Double where - type Rep Double = D1 D_Double (C1 C_Double (S1 NoSelector (Rec0 Double))) - from x = M1 (M1 (M1 (K1 x))) - to (M1 (M1 (M1 (K1 x)))) = x - - --- Char -data D_Char -data C_Char - -instance Datatype D_Char where - datatypeName _ = "Char" - moduleName _ = "GHC.Base" - -instance Constructor C_Char where - conName _ = "" -- JPM: I'm not sure this is the right implementation... - -instance Generic Char where - type Rep Char = D1 D_Char (C1 C_Char (S1 NoSelector (Rec0 Char))) - from x = M1 (M1 (M1 (K1 x))) - to (M1 (M1 (M1 (K1 x)))) = x - diff --git a/GHC/Types.hs-boot b/GHC/Types.hs-boot deleted file mode 100644 index 0933a2f..0000000 --- a/GHC/Types.hs-boot +++ /dev/null @@ -1,17 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} - -module GHC.Types where - -import GHC.Prim - - -infixr 5 : - -data [] a = [] | a : [a] - -data Char = C# Char# - -data Int = I# Int# - -data Bool = False | True - _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
