Adding equality constraints
authorManuel M T Chakravarty <chak@cse.unsw.edu.au>
Thu, 19 Mar 2009 13:10:54 +0000 (13:10 +0000)
committerManuel M T Chakravarty <chak@cse.unsw.edu.au>
Thu, 19 Mar 2009 13:10:54 +0000 (13:10 +0000)
- This patch adds equality constraints
- This requires an incompatible change of the type TH.Cxt - hence:

  *** This patch changes the API!  Existing client code will break! ***

- I took the opportunity to sanitise the definition of contexts a bit.

libraries/template-haskell/Language/Haskell/TH.hs
libraries/template-haskell/Language/Haskell/TH/Lib.hs
libraries/template-haskell/Language/Haskell/TH/Ppr.hs
libraries/template-haskell/Language/Haskell/TH/Syntax.hs

index a339bfa..93beb1e 100644 (file)
@@ -18,7 +18,7 @@ module Language.Haskell.TH(
        tupleTypeName, tupleDataName,   -- Int -> Name
        
        -- The algebraic data types
-       Dec(..), Exp(..), Con(..), Type(..), Cxt, Match(..), 
+       Dec(..), Exp(..), Con(..), Type(..), Cxt, Pred(..), Match(..), 
        Clause(..), Body(..), Guard(..), Stmt(..), Range(..),
        Lit(..), Pat(..), FieldExp, FieldPat, 
        Strict(..), Foreign(..), Callconv(..), Safety(..), FunDep(..), 
@@ -26,8 +26,8 @@ module Language.Haskell.TH(
        Fixity(..), FixityDirection(..), defaultFixity, maxPrecedence,
 
        -- Library functions
-       InfoQ, ExpQ, DecQ, ConQ, TypeQ, CxtQ, MatchQ, ClauseQ, BodyQ, GuardQ,
-       StmtQ, RangeQ, StrictTypeQ, VarStrictTypeQ, PatQ, FieldPatQ,
+       InfoQ, ExpQ, DecQ, ConQ, TypeQ, CxtQ, PredQ, MatchQ, ClauseQ, BodyQ,
+       GuardQ, StmtQ, RangeQ, StrictTypeQ, VarStrictTypeQ, PatQ, FieldPatQ,
        intPrimL, wordPrimL, floatPrimL, doublePrimL, integerL, rationalL,
        charL, stringL,
        litP, varP, tupP, conP, infixP, tildeP, asP, wildP, recP, listP, sigP,
@@ -41,7 +41,7 @@ module Language.Haskell.TH(
        listE, sigE, recConE, recUpdE, stringE, fieldExp,
        valD, funD, tySynD, dataD, newtypeD, classD, instanceD, sigD, forImpD,
         familyD, dataInstD, newtypeInstD, tySynInstD,
-       cxt, normalC, recC, infixC,
+       cxt, classP, equalP, normalC, recC, infixC,
        forallT, varT, conT, appT, arrowT, listT, tupleT,
        isStrict, notStrict, strictType, varStrictType,
        cCall, stdCall, unsafe, safe, threadsafe, typeFam, dataFam,
index 4a9de43..c23ae71 100644 (file)
@@ -21,6 +21,7 @@ type DecQ           = Q Dec
 type ConQ           = Q Con
 type TypeQ          = Q Type
 type CxtQ           = Q Cxt
+type PredQ          = Q Pred
 type MatchQ         = Q Match
 type ClauseQ        = Q Clause
 type BodyQ          = Q Body
@@ -343,9 +344,22 @@ tySynInstD tc tys rhs =
     rhs1 <- rhs
     return (TySynInstD tc tys1 rhs1)
 
-cxt :: [TypeQ] -> CxtQ
+cxt :: [PredQ] -> CxtQ
 cxt = sequence
 
+classP :: Name -> [TypeQ] -> PredQ
+classP cla tys
+  = do
+      tys1 <- sequence tys
+      return (ClassP cla tys1)
+
+equalP :: TypeQ -> TypeQ -> PredQ
+equalP tleft tright
+  = do
+      tleft1  <- tleft
+      tright1 <- tright
+      return (EqualP tleft1 tright1)
+
 normalC :: Name -> [StrictTypeQ] -> ConQ
 normalC con strtys = liftM (NormalC con) $ sequence strtys
 
index 4af7b74..391ceed 100644 (file)
@@ -362,6 +362,11 @@ pprCxt [t] = ppr t <+> text "=>"
 pprCxt ts = parens (hsep $ punctuate comma $ map ppr ts) <+> text "=>"
 
 ------------------------------
+instance Ppr Pred where
+  ppr (ClassP cla tys) = ppr cla <+> sep (map pprParendType tys)
+  ppr (EqualP ty1 ty2) = pprFunArgType ty1 <+> char '~' <+> pprFunArgType ty2
+
+------------------------------
 instance Ppr Range where
     ppr = brackets . pprRange
         where pprRange :: Range -> Doc
index 6cc5970..e297934 100644 (file)
@@ -30,7 +30,7 @@ module Language.Haskell.TH.Syntax(
         showName, showName', NameIs(..),
 
        -- The algebraic data types
-       Dec(..), Exp(..), Con(..), Type(..), Cxt, Match(..), 
+       Dec(..), Exp(..), Con(..), Type(..), Cxt, Pred(..), Match(..), 
        Clause(..), Body(..), Guard(..), Stmt(..), Range(..),
        Lit(..), Pat(..), FieldExp, FieldPat, 
        Strict(..), Foreign(..), Callconv(..), Safety(..),
@@ -757,7 +757,11 @@ data Callconv = CCall | StdCall
 data Safety = Unsafe | Safe | Threadsafe
         deriving( Show, Eq, Data, Typeable )
 
-type Cxt = [Type]    -- (Eq a, Ord b)
+type Cxt = [Pred]                 -- (Eq a, Ord b)
+
+data Pred = ClassP Name [Type]    -- Eq (Int, a)
+          | EqualP Type Type      -- F a ~ Bool
+          deriving( Show, Eq, Data, Typeable )
 
 data Strict = IsStrict | NotStrict
          deriving( Show, Eq, Data, Typeable )