From e32f7cee070ed0caf4e3bac895a09e27dee6e8ab Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Sat, 19 Feb 2011 13:32:11 +0000 Subject: [PATCH] Roll back generics changes in the HEAD repos --- GHC/Generics.hs | 273 ----------------------------------------------------- GHC/Ordering.hs | 1 - GHC/Tuple.hs | 1 - GHC/Types.hs | 3 +- GHC/Types.hs-boot | 17 ---- GHC/Unit.hs | 1 - 6 files changed, 1 insertion(+), 295 deletions(-) delete mode 100644 GHC/Types.hs-boot diff --git a/GHC/Generics.hs b/GHC/Generics.hs index 9dde8b1..6c97085 100644 --- a/GHC/Generics.hs +++ b/GHC/Generics.hs @@ -1,5 +1,3 @@ -{- - {-# OPTIONS_GHC -XNoImplicitPrelude -XTypeOperators #-} module GHC.Generics where @@ -12,274 +10,3 @@ data (:+:) a b = Inl a | Inr b data (:*:) a b = a :*: b #endif --} - -{-# OPTIONS_GHC -XNoImplicitPrelude #-} -{-# OPTIONS_GHC -XEmptyDataDecls #-} -{-# OPTIONS_GHC -XMultiParamTypeClasses #-} -{-# OPTIONS_GHC -XTypeSynonymInstances #-} -{-# OPTIONS_GHC -XTypeOperators #-} -{-# OPTIONS_GHC -XKindSignatures #-} -{-# OPTIONS_GHC -XFunctionalDependencies #-} -{-# OPTIONS_GHC -XNoGenerics #-} - -module GHC.Generics ( - -- * Generic representation types - V1, U1(..), Par1(..), Rec1(..), K1(..), M1(..) - , (:+:)(..), (:*:)(..), (:.:)(..) - - -- ** Synonyms for convenience - , Rec0, Par0, R, P - , D1, C1, S1, D, C, S - - -- * Meta-information - , Datatype(..), Constructor(..), Selector(..), NoSelector - , Fixity(..), Associativity(..), Arity(..), prec - - -- * Representable type classes - , Representable0(..), Representable1(..) - -{- - -- * Representations for base types - , Rep0Char, Rep0Int, Rep0Float - , Rep0Maybe, Rep1Maybe - , Rep0List, Rep1List --} - ) where - -import {-# SOURCE #-} GHC.Types -- ([](..), Int, Char, Bool(..)) - --------------------------------------------------------------------------------- --- Representation types --------------------------------------------------------------------------------- - --- | Void: used for datatypes without constructors -data V1 p - --- | Unit: used for constructors without arguments -data U1 p = U1 - --- | Used for marking occurrences of the parameter -newtype Par1 p = Par1 { unPar1 :: p } - - --- | Recursive calls of kind * -> * -newtype Rec1 f p = Rec1 { unRec1 :: f p } - --- | Constants, additional parameters and recursion of kind * -newtype K1 i c p = K1 { unK1 :: c } - --- | Meta-information (constructor names, etc.) -newtype M1 i c f p = M1 { unM1 :: f p } - --- | Sums: encode choice between constructors -infixr 5 :+: -data (:+:) f g p = L1 (f p) | R1 (g p) - --- | Products: encode multiple arguments to constructors -infixr 6 :*: -data (:*:) f g p = f p :*: g p - --- | Composition of functors -infixr 7 :.: -newtype (:.:) f g p = Comp1 { unComp1 :: f (g p) } - --- | Tag for K1: recursion (of kind *) -data R --- | Tag for K1: parameters (other than the last) -data P - --- | Type synonym for encoding recursion (of kind *) -type Rec0 = K1 R --- | Type synonym for encoding parameters (other than the last) -type Par0 = K1 P - --- | Tag for M1: datatype -data D --- | Tag for M1: constructor -data C --- | Tag for M1: record selector -data S - --- | Type synonym for encoding meta-information for datatypes -type D1 = M1 D - --- | Type synonym for encoding meta-information for constructors -type C1 = M1 C - --- | Type synonym for encoding meta-information for record selectors -type S1 = M1 S - - --- | Class for datatypes that represent datatypes -class Datatype d where - -- | The name of the datatype (unqualified) - datatypeName :: t d (f :: * -> *) a -> [Char] - -- | The fully-qualified name of the module where the type is declared - moduleName :: t d (f :: * -> *) a -> [Char] - - --- | Class for datatypes that represent records -class Selector s where - -- | The name of the selector - selName :: t s (f :: * -> *) a -> [Char] - --- | Used for constructor fields without a name -data NoSelector - -instance Selector NoSelector where selName _ = "" - --- | Class for datatypes that represent data constructors -class Constructor c where - -- | The name of the constructor - conName :: t c (f :: * -> *) a -> [Char] - - -- | The fixity of the constructor - conFixity :: t c (f :: * -> *) a -> Fixity - conFixity _ = Prefix - - -- | Marks if this constructor is a record - conIsRecord :: t c (f :: * -> *) a -> Bool - conIsRecord _ = False - - -- | Marks if this constructor is a tuple, - -- returning arity >=0 if so, <0 if not - conIsTuple :: t c (f :: * -> *) a -> Arity - conIsTuple _ = NoArity - - --- | Datatype to represent the arity of a tuple. -data Arity = NoArity | Arity Int --- deriving (Eq, Show, Ord, Read) --- TODO: Add these instances to the Prelude - --- | Datatype to represent the fixity of a constructor. An infix --- | declaration directly corresponds to an application of 'Infix'. -data Fixity = Prefix | Infix Associativity Int --- deriving (Eq, Show, Ord, Read) --- TODO: Add these instances to the Prelude - --- | Get the precedence of a fixity value. -prec :: Fixity -> Int -prec Prefix = I# 10# -prec (Infix _ n) = n - --- | Datatype to represent the associativy of a constructor -data Associativity = LeftAssociative - | RightAssociative - | NotAssociative --- deriving (Eq, Show, Ord, Read) --- TODO: Add these instances to the Prelude - - --- | Representable types of kind * -class Representable0 a rep | a -> rep where - -- | Convert from the datatype to its representation - from0 :: a -> rep x - -- | Convert from the representation to the datatype - to0 :: rep x -> a - --- | Representable types of kind * -> * -class Representable1 f rep | f -> rep where - -- | Convert from the datatype to its representation - from1 :: f a -> rep a - -- | Convert from the representation to the datatype - to1 :: rep a -> f a - --------------------------------------------------------------------------------- --- Representation for base types --------------------------------------------------------------------------------- - --- Representation types -{- -type Rep1Par1 = Par1 -instance Representable1 Par1 Rep1Par1 where - from1 = id - to1 = id - -type Rep1Rec1 f = Rec1 f -instance Representable1 (Rec1 f) (Rep1Rec1 f) where - from1 = id - to1 = id --} --- Kind * - -{- -type Rep0Char = Rec0 Char -instance Representable0 Char Rep0Char where - from0 = K1 - to0 = unK1 - -type Rep0Int = Rec0 Int -instance Representable0 Int Rep0Int where - from0 = K1 - to0 = unK1 - -type Rep0Float = Rec0 Float -instance Representable0 Float Rep0Float where - from0 = K1 - to0 = unK1 - --- etc... - --- Kind * -> * - -data Maybe_ -data Nothing_ -data Just_ - -instance Datatype Maybe_ where - datatypeName _ = "Maybe" - moduleName _ = "Representation" - -instance Constructor Nothing_ where - conName _ = "Nothing" - -instance Constructor Just_ where - conName _ = "Just" - -type Rep0Maybe a = D1 Maybe_ (C1 Nothing_ U1 :+: C1 Just_ (Par0 a)) -instance Representable0 (Maybe a) (Rep0Maybe a) where - from0 Nothing = M1 (L1 (M1 U1)) - from0 (Just x) = M1 (R1 (M1 (K1 x))) - to0 (M1 (L1 (M1 U1))) = Nothing - to0 (M1 (R1 (M1 (K1 x)))) = Just x - -type Rep1Maybe = D1 Maybe_ (C1 Nothing_ U1 :+: C1 Just_ Par1) -instance Representable1 Maybe Rep1Maybe where - from1 Nothing = M1 (L1 (M1 U1)) - from1 (Just x) = M1 (R1 (M1 (Par1 x))) - to1 (M1 (L1 (M1 U1))) = Nothing - to1 (M1 (R1 (M1 (Par1 x)))) = Just x - - -data List__ -data Nil__ -data Cons__ - -instance Datatype [a] where - datatypeName _ = "[]" - moduleName _ = "Data.List" - -instance Constructor Nil__ where conName _ = "[]" -instance Constructor Cons__ where - conName _ = ":" - conFixity _ = Infix RightAssociative 5 - -type Rep0List a = D1 List__ ((C1 Nil__ U1) :+: (C1 Cons__ (Par0 a :*: Rec0 [a]))) -instance Representable0 [a] (Rep0List a) where - from0 [] = M1 (L1 (M1 U1)) - from0 (h:t) = M1 (R1 (M1 (K1 h :*: K1 t))) - to0 (M1 (L1 (M1 U1))) = [] - to0 (M1 (R1 (M1 (K1 h :*: K1 t)))) = h : t - -type Rep1List = D1 List__ ((C1 Nil__ U1) :+: (C1 Cons__ (Par1 :*: Rec1 []))) -instance Representable1 [] Rep1List where - from1 [] = M1 (L1 (M1 U1)) - from1 (h:t) = M1 (R1 (M1 (Par1 h :*: Rec1 t))) - to1 (M1 (L1 (M1 U1))) = [] - to1 (M1 (R1 (M1 (Par1 h :*: Rec1 t)))) = h : t - --- etc... --} - diff --git a/GHC/Ordering.hs b/GHC/Ordering.hs index 95831de..ebc1e23 100644 --- a/GHC/Ordering.hs +++ b/GHC/Ordering.hs @@ -1,6 +1,5 @@ {-# OPTIONS_GHC -XNoImplicitPrelude #-} -{-# OPTIONS_GHC -XNoGenerics #-} module GHC.Ordering where diff --git a/GHC/Tuple.hs b/GHC/Tuple.hs index 334275a..01ece26 100644 --- a/GHC/Tuple.hs +++ b/GHC/Tuple.hs @@ -1,5 +1,4 @@ {-# OPTIONS_GHC -XNoImplicitPrelude #-} -{-# OPTIONS_GHC -XNoGenerics #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Tuple diff --git a/GHC/Types.hs b/GHC/Types.hs index ca63c31..59ce386 100644 --- a/GHC/Types.hs +++ b/GHC/Types.hs @@ -15,13 +15,12 @@ ----------------------------------------------------------------------------- {-# OPTIONS_GHC -XNoImplicitPrelude #-} -{-# OPTIONS_GHC -XNoGenerics #-} module GHC.Types (Bool(..), Char(..), Int(..), Float(..), Double(..), IO(..)) where import GHC.Prim -- We need Inl etc behind the scenes for the type definitions -import GHC.Generics () -- JPM: Do we really need this? +import GHC.Generics () infixr 5 : diff --git a/GHC/Types.hs-boot b/GHC/Types.hs-boot deleted file mode 100644 index be0e3bd..0000000 --- a/GHC/Types.hs-boot +++ /dev/null @@ -1,17 +0,0 @@ -{-# OPTIONS_GHC -XNoImplicitPrelude #-} - -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 - diff --git a/GHC/Unit.hs b/GHC/Unit.hs index 976881b..09ebe73 100644 --- a/GHC/Unit.hs +++ b/GHC/Unit.hs @@ -1,6 +1,5 @@ {-# OPTIONS_GHC -XNoImplicitPrelude #-} -{-# OPTIONS_GHC -XNoGenerics #-} module GHC.Unit where -- 1.7.10.4