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

diff --git a/ghc/compiler/hsSyn/Convert.lhs b/ghc/compiler/hsSyn/Convert.lhs
index e286b43..0dffc23 100644 (file)
--- a/ghc/compiler/hsSyn/Convert.lhs
+++ b/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
 

diff --git a/ghc/compiler/hsSyn/HsDecls.lhs b/ghc/compiler/hsSyn/HsDecls.lhs
index 1b7d389..001d4f8 100644 (file)
--- a/ghc/compiler/hsSyn/HsDecls.lhs
+++ b/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
 

diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y
index 443d2b3..5ca2359 100644 (file)
--- a/ghc/compiler/parser/Parser.y
+++ b/ghc/compiler/parser/Parser.y
@@ -1,6 +1,6 @@
 {-                                                             -*-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.

diff --git a/ghc/compiler/parser/RdrHsSyn.lhs b/ghc/compiler/parser/RdrHsSyn.lhs
index 4320c28..5624a2d 100644 (file)
--- a/ghc/compiler/parser/RdrHsSyn.lhs
+++ b/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}
@@ -324,22 +328,6 @@ data RdrMatch
 
 %************************************************************************
 %*                                                                     *
-\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.}
 %*                                                                     *
 %************************************************************************