[project @ 2004-04-06 11:37:50 by simonpj]

[ghc-hetmet.git] / ghc / compiler / deSugar / DsMeta.hs

diff --git a/ghc/compiler/deSugar/DsMeta.hs b/ghc/compiler/deSugar/DsMeta.hs
index 229bb54..dbd8fce 100644 (file)
--- a/ghc/compiler/deSugar/DsMeta.hs
+++ b/ghc/compiler/deSugar/DsMeta.hs
@@ -290,14 +290,14 @@ repBangTy (L _ (BangType str ty)) = do
 
 repDerivs :: Maybe [LHsType Name] -> DsM (Core [TH.Name])
 repDerivs Nothing = coreList nameTyConName []
-repDerivs (Just (L _ ctxt))
+repDerivs (Just ctxt)
   = do { strs <- mapM rep_deriv ctxt ; 
         coreList nameTyConName strs }
   where
-    rep_deriv :: LHsPred Name -> DsM (Core TH.Name)
+    rep_deriv :: LHsType Name -> DsM (Core TH.Name)
        -- Deriving clauses must have the simple H98 form
-    rep_deriv (L _ (HsPredTy (L _ (HsClassP cls [])))) = lookupOcc cls
-    rep_deriv other                                   = panic "rep_deriv"
+    rep_deriv (L _ (HsPredTy (HsClassP cls []))) = lookupOcc cls
+    rep_deriv other                             = panic "rep_deriv"
 
 
 -------------------------------------------------------
@@ -421,7 +421,7 @@ repTy (HsOpTy ty1 n ty2)      = repLTy ((nlHsTyVar (unLoc n) `nlHsAppTy` ty1)
 repTy (HsParTy t)                = repLTy t
 repTy (HsNumTy i)                 =
   panic "DsMeta.repTy: Can't represent number types (for generics)"
-repTy (HsPredTy pred)             = repLPred pred
+repTy (HsPredTy pred)             = repPred pred
 repTy (HsKindSig ty kind)        = 
   panic "DsMeta.repTy: Can't represent explicit kind signatures yet"
 
@@ -682,10 +682,11 @@ rep_bind :: LHsBind Name -> DsM (SrcSpan, Core TH.DecQ)
 rep_bind (L loc (FunBind fn infx [L _ (Match [] ty (GRHSs guards wheres ty2))]))
  = do { (ss,wherecore) <- repBinds wheres
        ; guardcore <- addBinds ss (repGuards guards)
-       ; fn' <- lookupLBinder fn
-       ; p   <- repPvar fn'
-       ; ans <- repVal p guardcore wherecore
-       ; return (loc, ans) }
+       ; fn'  <- lookupLBinder fn
+       ; p    <- repPvar fn'
+       ; ans  <- repVal p guardcore wherecore
+       ; ans' <- wrapGenSyns ss ans
+       ; return (loc, ans') }
 
 rep_bind (L loc (FunBind fn infx ms))
  =   do { ms1 <- mapM repClauseTup ms
@@ -697,8 +698,9 @@ rep_bind (L loc (PatBind pat (GRHSs guards wheres ty2)))
  =   do { patcore <- repLP pat 
         ; (ss,wherecore) <- repBinds wheres
        ; guardcore <- addBinds ss (repGuards guards)
-        ; ans <- repVal patcore guardcore wherecore
-        ; return (loc, ans) }
+        ; ans  <- repVal patcore guardcore wherecore
+       ; ans' <- wrapGenSyns ss ans
+        ; return (loc, ans') }
 
 rep_bind (L loc (VarBind v e))
  =   do { v' <- lookupBinder v