[project @ 2004-01-05 12:11:42 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 288885d..4bcb32e 100644 (file)
--- a/ghc/compiler/deSugar/DsMeta.hs
+++ b/ghc/compiler/deSugar/DsMeta.hs
@@ -213,20 +213,24 @@ repTyClD (L loc d) = do { dsWarn (loc, hang msg 4 (ppr d)) ;
   where
     msg = ptext SLIT("Cannot desugar this Template Haskell declaration:")
 
-repInstD' (L loc (InstDecl ty binds _))
-       -- Ignore user pragmas for now
- = do  { cxt1 <- repContext cxt
-       ; inst_ty1 <- repPred (HsClassP cls tys)
-       ; ss <- mkGenSyms (collectHsBindBinders binds)
-       ; binds1 <- addBinds ss (rep_binds binds)
-       ; decls1 <- coreList decQTyConName binds1
-       ; decls2 <- wrapNongenSyms ss decls1
-               -- wrapNonGenSyms: do not clone the class op names!
-               -- They must be called 'op' etc, not 'op34'
-       ; i <- repInst cxt1 inst_ty1 decls2
+repInstD' (L loc (InstDecl ty binds _))                -- Ignore user pragmas for now
+ = do  { i <- addTyVarBinds tvs $ \tv_bndrs ->
+               -- We must bring the type variables into scope, so their occurrences
+               -- don't fail,  even though the binders don't appear in the resulting 
+               -- data structure
+               do {  cxt1 <- repContext cxt
+                  ; inst_ty1 <- repPred (HsClassP cls tys)
+                  ; ss <- mkGenSyms (collectHsBindBinders binds)
+                  ; binds1 <- addBinds ss (rep_binds binds)
+                  ; decls1 <- coreList decQTyConName binds1
+                  ; decls2 <- wrapNongenSyms ss decls1
+                  -- wrapNonGenSyms: do not clone the class op names!
+                  -- They must be called 'op' etc, not 'op34'
+                  ; repInst cxt1 inst_ty1 decls2 }
+
        ; return (loc, i)}
  where
-   (_, cxt, cls, tys) = splitHsInstDeclTy (unLoc ty)
+   (tvs, cxt, cls, tys) = splitHsInstDeclTy (unLoc ty)
 
 -------------------------------------------------------
 --                     Constructors
@@ -1154,7 +1158,7 @@ repOverloadedLiteral :: HsOverLit -> DsM (Core TH.Lit)
 repOverloadedLiteral (HsIntegral i _)   = do { lit <- mk_integer  i; repLiteral lit }
 repOverloadedLiteral (HsFractional f _) = do { lit <- mk_rational f; repLiteral lit }
        -- The type Rational will be in the environment, becuase 
-       -- the smart constructor 'THSyntax.rationalL' uses it in its type,
+       -- the smart constructor 'TH.Syntax.rationalL' uses it in its type,
        -- and rationalL is sucked in when any TH stuff is used
               
 --------------- Miscellaneous -------------------
@@ -1271,11 +1275,11 @@ templateHaskellNames = [
     varStrictTypeQTyConName, typeQTyConName, expTyConName, decTyConName,
     typeTyConName, matchTyConName, clauseTyConName]
 
-tH_SYN_Name = mkModuleName "Language.Haskell.TH.THSyntax"
-tH_LIB_Name = mkModuleName "Language.Haskell.TH.THLib"
+tH_SYN_Name = mkModuleName "Language.Haskell.TH.Syntax"
+tH_LIB_Name = mkModuleName "Language.Haskell.TH.Lib"
 
 thSyn :: Module
--- NB: the THSyntax module comes from the "haskell-src" package
+-- NB: the TH.Syntax module comes from the "haskell-src" package
 thSyn = mkModule thPackage  tH_SYN_Name
 thLib = mkModule thPackage  tH_LIB_Name
 
@@ -1288,7 +1292,7 @@ libTc  = mk_known_key_name thLib OccName.tcName
 thFun  = mk_known_key_name thSyn OccName.varName
 thTc   = mk_known_key_name thSyn OccName.tcName
 
--------------------- THSyntax -----------------------
+-------------------- TH.Syntax -----------------------
 qTyConName        = thTc FSLIT("Q")             qTyConKey
 nameTyConName      = thTc FSLIT("Name")           nameTyConKey
 fieldExpTyConName = thTc FSLIT("FieldExp")      fieldExpTyConKey
@@ -1312,7 +1316,7 @@ mkNameG_tcName = thFun FSLIT("mkNameG_tc") mkNameG_tcIdKey
 mkNameUName    = thFun FSLIT("mkNameU")    mkNameUIdKey
 
 
--------------------- THLib -----------------------
+-------------------- TH.Lib -----------------------
 -- data Lit = ...
 charLName       = libFun FSLIT("charL")       charLIdKey
 stringLName     = libFun FSLIT("stringL")     stringLIdKey