[project @ 2004-11-18 00:56:24 by igloo]
authorigloo <unknown>
Thu, 18 Nov 2004 00:56:24 +0000 (00:56 +0000)
committerigloo <unknown>
Thu, 18 Nov 2004 00:56:24 +0000 (00:56 +0000)
Implement FunDeps for TH.

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 e78b6a2..ac85130 100644 (file)
@@ -20,7 +20,7 @@ module Language.Haskell.TH(
        Dec(..), Exp(..), Con(..), Type(..), Cxt, Match(..), 
        Clause(..), Body(..), Guard(..), Stmt(..), Range(..),
        Lit(..), Pat(..), FieldExp, FieldPat, 
        Dec(..), Exp(..), Con(..), Type(..), Cxt, Match(..), 
        Clause(..), Body(..), Guard(..), Stmt(..), Range(..),
        Lit(..), Pat(..), FieldExp, FieldPat, 
-       Strict(..), Foreign(..), Callconv(..), Safety(..),
+       Strict(..), Foreign(..), Callconv(..), Safety(..), FunDep(..),
        Info(..), 
        Fixity(..), FixityDirection(..), defaultFixity, maxPrecedence,
 
        Info(..), 
        Fixity(..), FixityDirection(..), defaultFixity, maxPrecedence,
 
index 685f81c..426b679 100644 (file)
@@ -292,12 +292,12 @@ newtypeD ctxt tc tvs con derivs =
     con1 <- con
     return (NewtypeD ctxt1 tc tvs con1 derivs)
 
     con1 <- con
     return (NewtypeD ctxt1 tc tvs con1 derivs)
 
-classD :: CxtQ -> Name -> [Name] -> [DecQ] -> DecQ
-classD ctxt cls tvs decs =
+classD :: CxtQ -> Name -> [Name] -> [FunDep] -> [DecQ] -> DecQ
+classD ctxt cls tvs fds decs =
   do 
     decs1 <- sequence decs
     ctxt1 <- ctxt
   do 
     decs1 <- sequence decs
     ctxt1 <- ctxt
-    return $ ClassD ctxt1 cls tvs decs1
+    return $ ClassD ctxt1 cls tvs fds decs1
 
 instanceD :: CxtQ -> TypeQ -> [DecQ] -> DecQ
 instanceD ctxt ty decs =
 
 instanceD :: CxtQ -> TypeQ -> [DecQ] -> DecQ
 instanceD ctxt ty decs =
@@ -389,6 +389,12 @@ unsafe = Unsafe
 safe = Safe
 threadsafe = Threadsafe
 
 safe = Safe
 threadsafe = Threadsafe
 
+-------------------------------------------------------------------------------
+--     FunDep
+
+funDep :: [Name] -> [Name] -> FunDep
+funDep = FunDep
+
 --------------------------------------------------------------
 -- Useful helper functions
 
 --------------------------------------------------------------
 -- Useful helper functions
 
index adca695..0c9eeb3 100644 (file)
@@ -208,15 +208,20 @@ instance Ppr Dec where
           else nest nestDepth
              $ text "deriving"
            <+> parens (hsep $ punctuate comma $ map ppr decs)
           else nest nestDepth
              $ text "deriving"
            <+> parens (hsep $ punctuate comma $ map ppr decs)
-    ppr (ClassD ctxt c xs ds) = text "class" <+> pprCxt ctxt
-                            <+> ppr c <+> hsep (map ppr xs)
-                             $$ where_clause ds
+    ppr (ClassD ctxt c xs fds ds) = text "class" <+> pprCxt ctxt
+                                <+> ppr c <+> hsep (map ppr xs) <+> ppr fds
+                                 $$ where_clause ds
     ppr (InstanceD ctxt i ds) = text "instance" <+> pprCxt ctxt <+> ppr i
                              $$ where_clause ds
     ppr (SigD f t) = ppr f <+> text "::" <+> ppr t
     ppr (ForeignD f) = ppr f
 
 ------------------------------
     ppr (InstanceD ctxt i ds) = text "instance" <+> pprCxt ctxt <+> ppr i
                              $$ where_clause ds
     ppr (SigD f t) = ppr f <+> text "::" <+> ppr t
     ppr (ForeignD f) = ppr f
 
 ------------------------------
+instance Ppr FunDep where
+    ppr (FunDep xs ys) = hsep (map ppr xs) <+> text "->" <+> hsep (map ppr ys)
+    ppr_list xs = char '|' <+> sep (punctuate (text ", ") (map ppr xs))
+
+------------------------------
 instance Ppr Foreign where
     ppr (ImportF callconv safety impent as typ)
        = text "foreign import"
 instance Ppr Foreign where
     ppr (ImportF callconv safety impent as typ)
        = text "foreign import"
index 6bd5aec..6b69863 100644 (file)
@@ -29,7 +29,7 @@ module Language.Haskell.TH.Syntax(
        Clause(..), Body(..), Guard(..), Stmt(..), Range(..),
        Lit(..), Pat(..), FieldExp, FieldPat, 
        Strict(..), Foreign(..), Callconv(..), Safety(..),
        Clause(..), Body(..), Guard(..), Stmt(..), Range(..),
        Lit(..), Pat(..), FieldExp, FieldPat, 
        Strict(..), Foreign(..), Callconv(..), Safety(..),
-       StrictType, VarStrictType, 
+       StrictType, VarStrictType, FunDep(..),
        Info(..), 
        Fixity(..), FixityDirection(..), defaultFixity, maxPrecedence,
 
        Info(..), 
        Fixity(..), FixityDirection(..), defaultFixity, maxPrecedence,
 
@@ -507,13 +507,17 @@ data Dec
          Con [Name]               -- { newtype Cxt x => T x = A (B x)
                                   --       deriving (Z,W)}
   | TySynD Name [Name] Type       -- { type T x = (x,x) }
          Con [Name]               -- { newtype Cxt x => T x = A (B x)
                                   --       deriving (Z,W)}
   | TySynD Name [Name] Type       -- { type T x = (x,x) }
-  | ClassD Cxt Name [Name] [Dec]  -- { class Eq a => Ord a where ds }
+  | ClassD Cxt Name [Name] [FunDep] [Dec]
+                                  -- { class Eq a => Ord a where ds }
   | InstanceD Cxt Type [Dec]      -- { instance Show w => Show [w]
                                   --       where ds }
   | SigD Name Type                -- { length :: [a] -> Int }
   | ForeignD Foreign
   deriving( Show, Eq )
 
   | InstanceD Cxt Type [Dec]      -- { instance Show w => Show [w]
                                   --       where ds }
   | SigD Name Type                -- { length :: [a] -> Int }
   | ForeignD Foreign
   deriving( Show, Eq )
 
+data FunDep = FunDep [Name] [Name]
+  deriving( Show, Eq )
+
 data Foreign = ImportF Callconv Safety String Name Type
              | ExportF Callconv        String Name Type
          deriving( Show, Eq )
 data Foreign = ImportF Callconv Safety String Name Type
              | ExportF Callconv        String Name Type
          deriving( Show, Eq )