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 <[email protected]> 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: [email protected] _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
