[commit: ghc] wip/branchedness: derive typeable, needed by Coercion on 7.8.x (0622a29)

git at git.haskell.org git at git.haskell.org
Fri Jul 31 19:35:57 UTC 2015


Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/branchedness
Link       : http://ghc.haskell.org/trac/ghc/changeset/0622a2923e1c721110ee7f5e027c3a99ba44db61/ghc

>---------------------------------------------------------------

commit 0622a2923e1c721110ee7f5e027c3a99ba44db61
Author: Gabor Greif <ggreif at gmail.com>
Date:   Fri Jul 31 21:35:36 2015 +0200

    derive typeable, needed by Coercion on 7.8.x


>---------------------------------------------------------------

0622a2923e1c721110ee7f5e027c3a99ba44db61
 compiler/types/CoAxiom.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/compiler/types/CoAxiom.hs b/compiler/types/CoAxiom.hs
index 82433db..4c6f478 100644
--- a/compiler/types/CoAxiom.hs
+++ b/compiler/types/CoAxiom.hs
@@ -1,6 +1,6 @@
 -- (c) The University of Glasgow 2012
 
-{-# LANGUAGE CPP, DataKinds, DeriveDataTypeable, GADTs, KindSignatures, ScopedTypeVariables #-}
+{-# LANGUAGE CPP, DataKinds, DeriveDataTypeable, GADTs, KindSignatures, ScopedTypeVariables, StandaloneDeriving #-}
 
 -- | Module for coercion axioms, used to represent type family instances
 -- and newtypes
@@ -120,6 +120,8 @@ type BranchIndex = Int  -- The index of the branch in the list of branches
 
 -- promoted data type
 data Branchedness = Unbranched | Branched
+deriving instance Typeable 'Unbranched
+deriving instance Typeable 'Branched
 
 data BranchList a (br :: Branchedness) where
   FirstBranch :: a -> BranchList a br



More information about the ghc-commits mailing list