[project @ 2004-08-13 13:04:50 by simonmar]

[ghc-hetmet.git] / ghc / compiler / hsSyn / HsDecls.lhs

diff --git a/ghc/compiler/hsSyn/HsDecls.lhs b/ghc/compiler/hsSyn/HsDecls.lhs
index 24f6b99..3a61002 100644 (file)
--- a/ghc/compiler/hsSyn/HsDecls.lhs
+++ b/ghc/compiler/hsSyn/HsDecls.lhs
@@ -9,7 +9,7 @@ Definitions for: @TyDecl@ and @oCnDecl@, @ClassDecl@,
 \begin{code}
 module HsDecls (
        HsDecl(..), LHsDecl, TyClDecl(..), LTyClDecl, 
-       InstDecl(..), LInstDecl,
+       InstDecl(..), LInstDecl, NewOrData(..),
        RuleDecl(..), LRuleDecl, RuleBndr(..),
        DefaultDecl(..), LDefaultDecl, HsGroup(..), SpliceDecl(..),
        ForeignDecl(..), LForeignDecl, ForeignImport(..), ForeignExport(..),
@@ -32,20 +32,19 @@ import {-# SOURCE #-}       HsExpr( HsExpr, pprExpr )
        -- Because Expr imports Decls via HsBracket
 
 import HsBinds         ( HsBindGroup, HsBind, LHsBinds, 
-                         Sig(..), LSig, LFixitySig )
+                         Sig(..), LSig, LFixitySig, pprLHsBinds )
 import HsPat           ( HsConDetails(..), hsConArgs )
 import HsImpExp                ( pprHsVar )
 import HsTypes
 import HscTypes                ( DeprecTxt )
 import CoreSyn         ( RuleName )
-import BasicTypes      ( NewOrData(..), Activation(..) )
+import BasicTypes      ( Activation(..) )
 import ForeignCall     ( CCallTarget(..), DNCallSpec, CCallConv, Safety,
-                         CExportSpec(..)) 
+                         CExportSpec(..), CLabelString ) 
 
 -- others:
 import FunDeps         ( pprFundeps )
 import Class           ( FunDep )
-import CStrings                ( CLabelString )
 import Outputable      
 import Util            ( count )
 import SrcLoc          ( Located(..), unLoc )
@@ -306,9 +305,13 @@ data TyClDecl name
                tcdLName  :: Located name,              -- Type constructor
                tcdTyVars :: [LHsTyVarBndr name],       -- Type variables
                tcdCons   :: [LConDecl name],           -- Data constructors
-               tcdDerivs :: Maybe (LHsContext name)    
+               tcdDerivs :: Maybe [LHsType name]
                        -- Derivings; Nothing => not specified
                        --            Just [] => derive exactly what is asked
+                       -- These "types" must be of form
+                       --      forall ab. C ty1 ty2
+                       -- Typically the foralls and ty args are empty, but they
+                       -- are non-empty for the newtype-deriving case
     }
 
   | TySynonym {        tcdLName  :: Located name,              -- type constructor
@@ -323,6 +326,11 @@ data TyClDecl name
                tcdSigs    :: [LSig name],              -- Methods' signatures
                tcdMeths   :: LHsBinds name             -- Default methods
     }
+
+data NewOrData
+  = NewType    -- "newtype Blah ..."
+  | DataType   -- "data Blah ..."
+  deriving( Eq )       -- Needed because Demand derives Eq
 \end{code}
 
 Simple classifiers
@@ -428,9 +436,12 @@ pp_tydecl pp_head pp_decl_rhs derivings
        pp_decl_rhs,
        case derivings of
          Nothing          -> empty
-         Just ds          -> hsep [ptext SLIT("deriving"), 
-                                       ppr_hs_context (unLoc ds)]
+         Just ds          -> hsep [ptext SLIT("deriving"), parens (interpp'SP ds)]
     ])
+
+instance Outputable NewOrData where
+  ppr NewType  = ptext SLIT("newtype")
+  ppr DataType = ptext SLIT("data")
 \end{code}
 
 
@@ -541,7 +552,7 @@ instance (OutputableBndr name) => Outputable (InstDecl name) where
     ppr (InstDecl inst_ty binds uprags)
       = vcat [hsep [ptext SLIT("instance"), ppr inst_ty, ptext SLIT("where")],
              nest 4 (ppr uprags),
-             nest 4 (ppr binds) ]
+             nest 4 (pprLHsBinds binds) ]
 \end{code}
 
 %************************************************************************