summaryrefslogtreecommitdiff
path: root/libraries
diff options
context:
space:
mode:
Diffstat (limited to 'libraries')
-rw-r--r--libraries/ghci/GHCi/TH/Binary.hs1
-rw-r--r--libraries/template-haskell/Language/Haskell/TH.hs4
-rw-r--r--libraries/template-haskell/Language/Haskell/TH/Lib.hs9
-rw-r--r--libraries/template-haskell/Language/Haskell/TH/Ppr.hs12
-rw-r--r--libraries/template-haskell/Language/Haskell/TH/Syntax.hs14
-rw-r--r--libraries/template-haskell/changelog.md2
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*