X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FDsMeta.hs;h=985916719fce4d996f07bea4d31e644dcb9713de;hb=d3d2b45d5b07064f73d76b33ce571e3f10cc3f42;hp=83eff557bff9e25f97977214af3b293623fc4a57;hpb=4bc7e71805c4c90c06a323cf2fcff7c218e300bd;p=ghc-hetmet.git

diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index 83eff55..9859167 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -13,6 +13,12 @@
 -- a Royal Pain (triggers other recompilation).
 -----------------------------------------------------------------------------
 
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
 
 module DsMeta( dsBracket, 
 	       templateHaskellNames, qTyConName, nameTyConName,
@@ -418,7 +424,7 @@ repTy (HsForAllTy _ tvs ctxt ty)  =
 
 repTy (HsTyVar n)
   | isTvOcc (nameOccName n)       = do 
-				      tv1 <- lookupBinder n
+				      tv1 <- lookupTvOcc n
 				      repTvar tv1
   | otherwise		          = do 
 				      tc1 <- lookupOcc n
@@ -784,7 +790,7 @@ repLambda (L _ (Match ps _ (GRHSs [L _ (GRHS [] e)] EmptyLocalBinds)))
 		do { xs <- repLPs ps; body <- repLE e; repLam xs body })
       ; wrapGenSyns ss lam }
 
-repLambda (L _ m) = notHandled "Guarded labmdas" (pprMatch LambdaExpr m)
+repLambda (L _ m) = notHandled "Guarded labmdas" (pprMatch (LambdaExpr :: HsMatchContext Name) m)
 
   
 -----------------------------------------------------------------------------
@@ -825,8 +831,8 @@ repP (ConPatIn dc details)
                                 p2' <- repLP p2;
                                 repPinfix p1' con_str p2' }
    }
-repP (NPat l Nothing _ _)  = do { a <- repOverloadedLiteral l; repPlit a }
-repP p@(NPat l (Just _) _ _) = notHandled "Negative overloaded patterns" (ppr p)
+repP (NPat l Nothing _)  = do { a <- repOverloadedLiteral l; repPlit a }
+repP p@(NPat l (Just _) _) = notHandled "Negative overloaded patterns" (ppr p)
 repP p@(SigPatIn {})  = notHandled "Type signatures in patterns" (ppr p)
 	-- The problem is to do with scoped type variables.
 	-- To implement them, we have to implement the scoping rules
@@ -911,6 +917,18 @@ lookupOcc n
 		Just (Splice _) -> pprPanic "repE:lookupOcc" (ppr n) 
     }
 
+lookupTvOcc :: Name -> DsM (Core TH.Name)
+-- Type variables can't be staged and are not lexically scoped in TH
+lookupTvOcc n	
+  = do {  mb_val <- dsLookupMetaEnv n ;
+          case mb_val of
+		Just (Bound x)  -> return (coreVar x)
+		other	        -> failWithDs msg
+    }
+  where
+    msg = vcat  [ ptext SLIT("Illegal lexically-scoped type variable") <+> quotes (ppr n)
+		, ptext SLIT("Lexically scoped type variables are not supported by Template Haskell") ]
+
 globalVar :: Name -> DsM (Core TH.Name)
 -- Not bound by the meta-env
 -- Could be top-level; or could be local
@@ -1271,9 +1289,9 @@ mk_string s   = do string_ty <- lookupType stringTyConName
                    return $ HsString s
 
 repOverloadedLiteral :: HsOverLit Name -> DsM (Core TH.Lit)
-repOverloadedLiteral (HsIntegral i _)   = do { lit <- mk_integer  i; repLiteral lit }
-repOverloadedLiteral (HsFractional f _) = do { lit <- mk_rational f; repLiteral lit }
-repOverloadedLiteral (HsIsString s _)   = do { lit <- mk_string   s; repLiteral lit }
+repOverloadedLiteral (HsIntegral i _ _)   = do { lit <- mk_integer  i; repLiteral lit }
+repOverloadedLiteral (HsFractional f _ _) = do { lit <- mk_rational f; repLiteral lit }
+repOverloadedLiteral (HsIsString s _ _)   = do { lit <- mk_string   s; repLiteral lit }
 	-- The type Rational will be in the environment, becuase 
 	-- the smart constructor 'TH.Syntax.rationalL' uses it in its type,
 	-- and rationalL is sucked in when any TH stuff is used