[project @ 2003-05-19 15:10:40 by simonpj]

--------------------------
	Minor Template Haskell bug
	--------------------------

This bug meant that spliced-in class declarations yielded a 'op not in scope',
where op was the class operation.  Thanks to Andre Pang for spotting this.

Some consequential tidying up in parsing too.

ghc/compiler/hsSyn/Convert.lhs

@@ -83,8 +83,8 @@ cvt_top (Data ctxt tc tvs constrs derivs)
 
 cvt_top (Class ctxt cl tvs decs)
   = Left $ TyClD (mkClassDecl (cvt_context ctxt, tconName cl, cvt_tvs tvs)
-                              noFunDeps
-                              sigs (Just binds) loc0)
+                              noFunDeps sigs
+			      (Just binds) loc0)
   where
     (binds,sigs) = cvtBindsAndSigs decs
 

ghc/compiler/hsSyn/HsDecls.lhs

@@ -211,6 +211,7 @@ Here's the deal.  (We distinguish the two cases because source-code decls
 have (Just binds) in the tcdMeths field, whereas interface decls have Nothing.
 
 In *source-code* class declarations:
+
  - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName
    This is done by RdrHsSyn.mkClassOpSigDM
 

ghc/compiler/parser/Parser.y

 {-								-*-haskell-*-
 -----------------------------------------------------------------------------
-$Id: Parser.y,v 1.117 2003/05/06 10:25:32 simonpj Exp $
+$Id: Parser.y,v 1.118 2003/05/19 15:10:40 simonpj Exp $
 
 Haskell grammar.
 
@@ -452,7 +452,7 @@ tycl_decl :: { RdrNameTyClDecl }
 		{ let 
 			(binds,sigs) = cvMonoBindsAndSigs $5 
 		  in
-	 	  mkClassDecl $3 $4 (map cvClassOpSig sigs) (Just binds) $1 }
+	 	  mkClassDecl $3 $4 sigs (Just binds) $1 }
 
 syn_hdr :: { (RdrName, [RdrNameHsTyVar]) }	-- We don't retain the syntax of an infix
 						-- type synonym declaration. Oh well.

ghc/compiler/parser/RdrHsSyn.lhs

@@ -48,7 +48,7 @@ module RdrHsSyn (
 	extractHsTyRdrNames,  extractHsTyRdrTyVars, 
 	extractHsCtxtRdrTyVars, extractGenericPatTyVars,
  
-	mkHsOpApp, mkClassDecl, mkClassOpSigDM, 
+	mkHsOpApp, mkClassDecl, 
 	mkHsNegApp, mkNPlusKPat, mkHsIntegral, mkHsFractional,
 	mkHsDo, mkHsSplice, mkSigDecls,
         mkTyData, mkPrefixCon, mkRecCon,
@@ -58,7 +58,6 @@ module RdrHsSyn (
 	cvBinds,
 	cvMonoBindsAndSigs,
 	cvTopDecls,
-	cvClassOpSig, 
 	findSplice, addImpDecls, emptyGroup, mkGroup,
 
 	-- Stuff to do with Foreign declarations
@@ -245,7 +244,9 @@ Similarly for mkConDecl, mkClassOpSig and default-method names.
 \begin{code}
 mkClassDecl (cxt, cname, tyvars) fds sigs mbinds loc
   = ClassDecl { tcdCtxt = cxt, tcdName = cname, tcdTyVars = tyvars,
-		tcdFDs = fds,  tcdSigs = sigs,  tcdMeths = mbinds,
+		tcdFDs = fds,  
+		tcdSigs = map cvClassOpSig sigs,  	-- Convert to class-op sigs
+		tcdMeths = mbinds,
 		tcdLoc = loc }
 
 mkTyData new_or_data (context, tname, tyvars) data_cons maybe src
@@ -253,10 +254,13 @@ mkTyData new_or_data (context, tname, tyvars) data_cons maybe src
 	     tcdTyVars = tyvars,  tcdCons = data_cons, 
 	     tcdDerivs = maybe,   tcdLoc = src, tcdGeneric = Nothing }
 
-mkClassOpSigDM op ty loc
-  = ClassOpSig op (DefMeth dm_rn) ty loc
+cvClassOpSig :: RdrNameSig -> RdrNameSig
+cvClassOpSig (Sig var poly_ty src_loc) 
+  = ClassOpSig var (DefMeth dm_rn) poly_ty src_loc
   where
-    dm_rn = mkRdrUnqual (mkDefaultMethodOcc (rdrNameOcc op))
+    dm_rn = mkRdrUnqual (mkDefaultMethodOcc (rdrNameOcc var))
+cvClassOpSig sig 
+  = sig
 \end{code}
 
 \begin{code}
@@ -322,22 +326,6 @@ data RdrMatch
 	     RdrNameGRHSs
 \end{code}
 
-%************************************************************************
-%*									*
-\subsection[cvDecls]{Convert various top-level declarations}
-%*									*
-%************************************************************************
-
-We make a point not to throw any user-pragma ``sigs'' at
-these conversion functions:
-
-\begin{code}
-cvClassOpSig :: RdrNameSig -> RdrNameSig
-cvClassOpSig (Sig var poly_ty src_loc) = mkClassOpSigDM var poly_ty src_loc
-cvClassOpSig sig 		       = sig
-\end{code}
-
-
 %************************************************************************
 %*									*
 \subsection[cvBinds-etc]{Converting to @HsBinds@, @MonoBinds@, etc.}