X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FhsSyn%2FHsDecls.lhs;h=3a610024a35beb222102eb33d60697775c9a52eb;hb=dcf58a64367700d80dc7609b1b55ff6a8e8b97ee;hp=43efaf5be0ed0ceb2315dbc56683abcd5549e4cd;hpb=550421384b8364cdaf3135f7859c9f7d7ee1fff1;p=ghc-hetmet.git

diff --git a/ghc/compiler/hsSyn/HsDecls.lhs b/ghc/compiler/hsSyn/HsDecls.lhs
index 43efaf5..3a61002 100644
--- 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}
 
 
@@ -480,7 +491,7 @@ data BangType name = BangType HsBang (LHsType name)
 
 data HsBang = HsNoBang
 	    | HsStrict	-- ! 
-	    | HsUnbox	-- !! (GHC extension, meaning "unbox")
+	    | HsUnbox	-- {-# UNPACK #-} ! (GHC extension, meaning "unbox")
 
 getBangType       (BangType _ ty) = ty
 getBangStrictness (BangType s _)  = s
@@ -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}
 
 %************************************************************************