diff options
Diffstat (limited to 'libraries')
| -rw-r--r-- | libraries/ghci/GHCi/TH/Binary.hs | 1 | ||||
| -rw-r--r-- | libraries/template-haskell/Language/Haskell/TH.hs | 4 | ||||
| -rw-r--r-- | libraries/template-haskell/Language/Haskell/TH/Lib.hs | 9 | ||||
| -rw-r--r-- | libraries/template-haskell/Language/Haskell/TH/Ppr.hs | 12 | ||||
| -rw-r--r-- | libraries/template-haskell/Language/Haskell/TH/Syntax.hs | 14 | ||||
| -rw-r--r-- | libraries/template-haskell/changelog.md | 2 |
6 files changed, 36 insertions, 6 deletions
diff --git a/libraries/ghci/GHCi/TH/Binary.hs b/libraries/ghci/GHCi/TH/Binary.hs index 6183a3d26f..ab9b35525a 100644 --- a/libraries/ghci/GHCi/TH/Binary.hs +++ b/libraries/ghci/GHCi/TH/Binary.hs @@ -29,6 +29,7 @@ instance Binary TH.Stmt instance Binary TH.Pat instance Binary TH.Exp instance Binary TH.Dec +instance Binary TH.Overlap instance Binary TH.Guard instance Binary TH.Body instance Binary TH.Match diff --git a/libraries/template-haskell/Language/Haskell/TH.hs b/libraries/template-haskell/Language/Haskell/TH.hs index 2f750e32a7..3bca8eaeef 100644 --- a/libraries/template-haskell/Language/Haskell/TH.hs +++ b/libraries/template-haskell/Language/Haskell/TH.hs @@ -142,7 +142,9 @@ module Language.Haskell.TH( -- **** Data valD, funD, tySynD, dataD, newtypeD, -- **** Class - classD, instanceD, sigD, standaloneDerivD, defaultSigD, + classD, instanceD, instanceWithOverlapD, Overlap(..), + sigD, standaloneDerivD, defaultSigD, + -- **** Role annotations roleAnnotD, -- **** Type Family / Data Family diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib.hs b/libraries/template-haskell/Language/Haskell/TH/Lib.hs index 81ef1fcbb6..6971970524 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Lib.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Lib.hs @@ -369,12 +369,17 @@ classD ctxt cls tvs fds decs = return $ ClassD ctxt1 cls tvs fds decs1 instanceD :: CxtQ -> TypeQ -> [DecQ] -> DecQ -instanceD ctxt ty decs = +instanceD = instanceWithOverlapD Nothing + +instanceWithOverlapD :: Maybe Overlap -> CxtQ -> TypeQ -> [DecQ] -> DecQ +instanceWithOverlapD o ctxt ty decs = do ctxt1 <- ctxt decs1 <- sequence decs ty1 <- ty - return $ InstanceD ctxt1 ty1 decs1 + return $ InstanceD o ctxt1 ty1 decs1 + + sigD :: Name -> TypeQ -> DecQ sigD fun ty = liftM (SigD fun) $ ty diff --git a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs index 3f79920a0b..2a56620684 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs @@ -290,7 +290,8 @@ ppr_dec _ (NewtypeD ctxt t xs ksig c decs) ppr_dec _ (ClassD ctxt c xs fds ds) = text "class" <+> pprCxt ctxt <+> ppr c <+> hsep (map ppr xs) <+> ppr fds $$ where_clause ds -ppr_dec _ (InstanceD ctxt i ds) = text "instance" <+> pprCxt ctxt <+> ppr i +ppr_dec _ (InstanceD o ctxt i ds) = + text "instance" <+> maybe empty ppr_overlap o <+> pprCxt ctxt <+> ppr i $$ where_clause ds ppr_dec _ (SigD f t) = pprPrefixOcc f <+> dcolon <+> ppr t ppr_dec _ (ForeignD f) = ppr f @@ -339,6 +340,15 @@ ppr_dec _ (StandaloneDerivD cxt ty) ppr_dec _ (DefaultSigD n ty) = hsep [ text "default", pprPrefixOcc n, dcolon, ppr ty ] + +ppr_overlap :: Overlap -> Doc +ppr_overlap o = text $ + case o of + Overlaps -> "{-# OVERLAPS #-}" + Overlappable -> "{-# OVERLAPPABLE #-}" + Overlapping -> "{-# OVERLAPPING #-}" + Incoherent -> "{-# INCOHERENT #-}" + ppr_data :: Doc -> Cxt -> Name -> Doc -> Maybe Kind -> [Con] -> Cxt -> Doc ppr_data maybeInst ctxt t argsDoc ksig cs decs = sep [text "data" <+> maybeInst diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs index ce3c9083b2..c8d9d75b4b 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs @@ -1510,8 +1510,9 @@ data Dec | TySynD Name [TyVarBndr] Type -- ^ @{ type T x = (x,x) }@ | ClassD Cxt Name [TyVarBndr] [FunDep] [Dec] -- ^ @{ class Eq a => Ord a where ds }@ - | InstanceD Cxt Type [Dec] -- ^ @{ instance Show w => Show [w] - -- where ds }@ + | InstanceD (Maybe Overlap) Cxt Type [Dec] + -- ^ @{ instance {\-\# OVERLAPS \#-\} + -- Show w => Show [w] where ds }@ | SigD Name Type -- ^ @{ length :: [a] -> Int }@ | ForeignD Foreign -- ^ @{ foreign import ... } --{ foreign export ... }@ @@ -1549,6 +1550,15 @@ data Dec | DefaultSigD Name Type -- ^ @{ default size :: Data a => a -> Int }@ deriving( Show, Eq, Ord, Data, Typeable, Generic ) +-- | Properties for overlapping instances. +data Overlap = Overlappable -- ^ May be overlapped by more specific instances + | Overlapping -- ^ May overlap a more general instance + | Overlaps -- ^ Both 'Overlapping' and 'Overlappable' + | Incoherent -- ^ Both 'Overlappable' and 'Overlappable', and + -- pick an arbitrary one if multiple choices are + -- avaialble. + deriving( Show, Eq, Ord, Data, Typeable, Generic ) + -- | Common elements of 'OpenTypeFamilyD' and 'ClosedTypeFamilyD'. -- By analogy with with "head" for type classes and type class instances as -- defined in /Type classes: an exploration of the design space/, the diff --git a/libraries/template-haskell/changelog.md b/libraries/template-haskell/changelog.md index c313c62d14..e746cb54fc 100644 --- a/libraries/template-haskell/changelog.md +++ b/libraries/template-haskell/changelog.md @@ -47,6 +47,8 @@ * TODO: document API changes and important bugfixes + * Add support for OVERLAP(S/PED/PING) pragmas on instances + ## 2.10.0.0 *Mar 2015* |