[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.

Language/Haskell/TH.hs
Language/Haskell/TH/Lib.hs
Language/Haskell/TH/Ppr.hs
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, 
-       Strict(..), Foreign(..), Callconv(..), Safety(..),
+       Strict(..), Foreign(..), Callconv(..), Safety(..), FunDep(..),
        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)
 
-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
-    return $ ClassD ctxt1 cls tvs decs1
+    return $ ClassD ctxt1 cls tvs fds decs1
 
 instanceD :: CxtQ -> TypeQ -> [DecQ] -> DecQ
 instanceD ctxt ty decs =
@@ -389,6 +389,12 @@ unsafe = Unsafe
 safe = Safe
 threadsafe = Threadsafe
 
+-------------------------------------------------------------------------------
+--     FunDep
+
+funDep :: [Name] -> [Name] -> FunDep
+funDep = FunDep
+
 --------------------------------------------------------------
 -- 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)
-    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
 
 ------------------------------
+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"
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(..),
-       StrictType, VarStrictType, 
+       StrictType, VarStrictType, FunDep(..),
        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) }
-  | 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 )
 
+data FunDep = FunDep [Name] [Name]
+  deriving( Show, Eq )
+
 data Foreign = ImportF Callconv Safety String Name Type
              | ExportF Callconv        String Name Type
          deriving( Show, Eq )