[commit: template-haskell] overlapping-tyfams: Update to support branched type family instances; bumped version number. (2de9642)

[Richard Eisenberg]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/template-haskell

On branch  : overlapping-tyfams

http://hackage.haskell.org/trac/ghc/changeset/2de9642985f0240cdebfc24bda414061a40ae01e

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

commit 2de9642985f0240cdebfc24bda414061a40ae01e
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Tue Dec 4 08:58:00 2012 -0500

    Update to support branched type family instances; bumped version number.
    
    The big change is in the syntax for the TySynInstD constructor
    of Dec. It now takes a list of TySynEqn's.

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

 Language/Haskell/TH.hs        |    6 +++---
 Language/Haskell/TH/Lib.hs    |   15 +++++++++++----
 Language/Haskell/TH/Ppr.hs    |    8 +++++++-
 Language/Haskell/TH/Syntax.hs |   14 +++++++++++++-
 template-haskell.cabal        |    2 +-
 5 files changed, 35 insertions(+), 10 deletions(-)

diff --git a/Language/Haskell/TH.hs b/Language/Haskell/TH.hs
index 5ec7cf1..a435f66 100644
--- a/Language/Haskell/TH.hs
+++ b/Language/Haskell/TH.hs
@@ -52,7 +52,7 @@ module Language.Haskell.TH(
 	Dec(..), Con(..), Clause(..), 
 	Strict(..), Foreign(..), Callconv(..), Safety(..), Pragma(..),
 	Inline(..), RuleMatch(..), Phases(..), RuleBndr(..),
-	FunDep(..), FamFlavour(..),
+	FunDep(..), FamFlavour(..), TySynEqn(..),
 	Fixity(..), FixityDirection(..), defaultFixity, maxPrecedence,
     -- ** Expressions
         Exp(..), Match(..), Body(..), Guard(..), Stmt(..), Range(..), Lit(..),
@@ -65,7 +65,7 @@ module Language.Haskell.TH(
     -- ** Abbreviations
         InfoQ, ExpQ, DecQ, DecsQ, ConQ, TypeQ, TyLitQ, CxtQ, PredQ, MatchQ, ClauseQ,
         BodyQ, GuardQ, StmtQ, RangeQ, StrictTypeQ, VarStrictTypeQ, PatQ, FieldPatQ,
-        RuleBndrQ,
+        RuleBndrQ, TySynEqnQ,
 
     -- ** Constructors lifted to 'Q'
     -- *** Literals
@@ -116,7 +116,7 @@ module Language.Haskell.TH(
     -- **** Type Family / Data Family
     familyNoKindD, familyKindD, dataInstD,
     newtypeInstD, tySynInstD,
-    typeFam, dataFam,
+    typeFam, dataFam, tySynEqn,
     -- **** Foreign Function Interface (FFI)
     cCall, stdCall, unsafe, safe, forImpD,
     -- **** Pragmas
diff --git a/Language/Haskell/TH/Lib.hs b/Language/Haskell/TH/Lib.hs
index f07010f..71adf66 100644
--- a/Language/Haskell/TH/Lib.hs
+++ b/Language/Haskell/TH/Lib.hs
@@ -36,6 +36,7 @@ type StrictTypeQ    = Q StrictType
 type VarStrictTypeQ = Q VarStrictType
 type FieldExpQ      = Q FieldExp
 type RuleBndrQ      = Q RuleBndr
+type TySynEqnQ      = Q TySynEqn
 
 ----------------------------------------------------------
 -- * Lowercase pattern syntax functions
@@ -423,12 +424,18 @@ newtypeInstD ctxt tc tys con derivs =
     con1  <- con
     return (NewtypeInstD ctxt1 tc tys1 con1 derivs)
 
-tySynInstD :: Name -> [TypeQ] -> TypeQ -> DecQ
-tySynInstD tc tys rhs = 
+tySynInstD :: Name -> [TySynEqnQ] -> DecQ
+tySynInstD tc eqns = 
   do 
-    tys1 <- sequence tys
+    eqns1 <- sequence eqns
+    return (TySynInstD tc eqns1)
+
+tySynEqn :: [TypeQ] -> TypeQ -> TySynEqnQ
+tySynEqn lhs rhs =
+  do
+    lhs1 <- sequence lhs
     rhs1 <- rhs
-    return (TySynInstD tc tys1 rhs1)
+    return (TySynEqn lhs1 rhs1)
 
 cxt :: [PredQ] -> CxtQ
 cxt = sequence
diff --git a/Language/Haskell/TH/Ppr.hs b/Language/Haskell/TH/Ppr.hs
index 60b9c01..b9105d5 100644
--- a/Language/Haskell/TH/Ppr.hs
+++ b/Language/Haskell/TH/Ppr.hs
@@ -275,11 +275,17 @@ ppr_dec isTop (NewtypeInstD ctxt tc tys c decs)
   where
     maybeInst | isTop     = text "instance"
               | otherwise = empty
-ppr_dec isTop (TySynInstD tc tys rhs) 
+ppr_dec isTop (TySynInstD tc eqns)
+  | [TySynEqn tys rhs] <- eqns
   = ppr_tySyn maybeInst tc (sep (map pprParendType tys)) rhs
+  | otherwise
+  = hang (text "type instance where")
+         nestDepth (vcat (map ppr_eqn eqns))
   where
     maybeInst | isTop     = text "instance"
               | otherwise = empty
+    ppr_eqn (TySynEqn lhs rhs)
+      = ppr tc <+> sep (map pprParendType lhs) <+> text "=" <+> ppr rhs
 
 ppr_data :: Doc -> Cxt -> Name -> Doc -> [Con] -> [Name] -> Doc
 ppr_data maybeInst ctxt t argsDoc cs decs
diff --git a/Language/Haskell/TH/Syntax.hs b/Language/Haskell/TH/Syntax.hs
index 9173aff..91b1a7d 100644
--- a/Language/Haskell/TH/Syntax.hs
+++ b/Language/Haskell/TH/Syntax.hs
@@ -1170,7 +1170,19 @@ data Dec
   | NewtypeInstD Cxt Name [Type]
          Con [Name]               -- ^ @{ newtype instance Cxt x => T [x] = A (B x)
                                   --       deriving (Z,W)}@
-  | TySynInstD Name [Type] Type   -- ^ @{ type instance T (Maybe x) = (x,x) }@
+  | TySynInstD Name [TySynEqn]    -- ^
+                                  -- @
+                                  -- { type instance where { T ... = ... 
+                                  --                       ; T ... = ... } }
+                                  -- @
+                                  --
+                                  --  @type instance T ... = ...@ is used when
+                                  --  the list has length 1
+  deriving( Show, Eq, Data, Typeable )
+
+-- | One equation of a (branched) type family instance. The arguments are the
+-- left-hand-side type patterns and the right-hand-side result.
+data TySynEqn = TySynEqn [Type] Type
   deriving( Show, Eq, Data, Typeable )
 
 data FunDep = FunDep [Name] [Name]
diff --git a/template-haskell.cabal b/template-haskell.cabal
index 4591d5d..2c8577b 100644
--- a/template-haskell.cabal
+++ b/template-haskell.cabal
@@ -1,5 +1,5 @@
 name:		template-haskell
-version:	2.8.0.0
+version:	2.9.0.0
 license:	BSD3
 license-file:	LICENSE
 maintainer:	libraries at haskell.org