X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcEnv.lhs;h=bcc2169942b77859f21263c239eca52a81293fd1;hb=f04dead93a15af1cb818172f207b8a81d2c81298;hp=055fc2cf8825e55035ad767b293e0e36aea59f5d;hpb=aa0c0de94e25aa64139688f8e4c4ba51ddca6f54;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcEnv.lhs b/compiler/typecheck/TcEnv.lhs
index 055fc2c..bcc2169 100644
--- a/compiler/typecheck/TcEnv.lhs
+++ b/compiler/typecheck/TcEnv.lhs
@@ -38,7 +38,7 @@ module TcEnv(
 	tcGetGlobalTyVars,
 
 	-- Template Haskell stuff
-	checkWellStaged, spliceOK, bracketOK, tcMetaTy, thLevel, 
+	checkWellStaged, tcMetaTy, thLevel, 
 	topIdLvl, thTopLevelId, thRnBrack, isBrackStage,
 
 	-- New Ids
@@ -337,7 +337,7 @@ tcExtendTyVarEnv2 binds thing_inside = do
                    tcl_tyvars = gtvs,
                    tcl_rdr = rdr_env}) <- getLclEnv
     let
-	rdr_env'   = extendLocalRdrEnv rdr_env (map fst binds)
+	rdr_env'   = extendLocalRdrEnvList rdr_env (map fst binds)
 	new_tv_set = tcTyVarsOfTypes (map snd binds)
  	le'        = extendNameEnvList le [(name, ATyVar name ty) | (name, ty) <- binds]
 
@@ -408,7 +408,7 @@ tc_extend_local_id_env env th_lvl names_w_ids thing_inside
 						  _        -> Wobbly})
     		      | (name,id) <- names_w_ids, let id_ty = idType id]
     le'		    = extendNameEnvList (tcl_env env) extra_env
-    rdr_env'	    = extendLocalRdrEnv (tcl_rdr env) [name | (name,_) <- names_w_ids]
+    rdr_env'	    = extendLocalRdrEnvList (tcl_rdr env) [name | (name,_) <- names_w_ids]
 \end{code}
 
 
@@ -526,41 +526,25 @@ tcExtendRules lcl_rules thing_inside
 %************************************************************************
 
 \begin{code}
-instance Outputable ThStage where
-   ppr (Comp l)	     = text "Comp" <+> int l
-   ppr (Brack l _ _) = text "Brack" <+> int l
-   ppr (Splice l)    = text "Splice" <+> int l
-
-
-thLevel :: ThStage -> ThLevel
-thLevel (Comp l)      = l
-thLevel (Splice l)    = l
-thLevel (Brack l _ _) = l
-
-
 checkWellStaged :: SDoc		-- What the stage check is for
 		-> ThLevel 	-- Binding level (increases inside brackets)
-	        -> ThStage	-- Use stage
+	        -> ThLevel	-- Use stage
 		-> TcM ()	-- Fail if badly staged, adding an error
-checkWellStaged pp_thing bind_lvl use_stage
+checkWellStaged pp_thing bind_lvl use_lvl
   | use_lvl >= bind_lvl 	-- OK! Used later than bound
   = return ()			-- E.g.  \x -> [| $(f x) |]
 
-  | bind_lvl == topLevel	-- GHC restriction on top level splices
+  | bind_lvl == outerLevel	-- GHC restriction on top level splices
   = failWithTc $ 
     sep [ptext (sLit "GHC stage restriction:") <+>  pp_thing,
-	 nest 2 (ptext (sLit "is used in") <+> use_lvl_doc <> ptext (sLit ", and must be imported, not defined locally"))]
+	 nest 2 (vcat [ ptext (sLit "is used in a top-level splice or annotation,")
+                      , ptext (sLit "and must be imported, not defined locally")])]
 
   | otherwise			-- Badly staged
   = failWithTc $ 		-- E.g.  \x -> $(f x)
     ptext (sLit "Stage error:") <+> pp_thing <+> 
 	hsep   [ptext (sLit "is bound at stage") <+> ppr bind_lvl,
 		ptext (sLit "but used at stage") <+> ppr use_lvl]
-  where
-    use_lvl = thLevel use_stage
-    use_lvl_doc | use_lvl == thLevel topStage    = ptext (sLit "a top-level splice")
-                | use_lvl == thLevel topAnnStage = ptext (sLit "an annotation")
-                | otherwise                      = panic "checkWellStaged"
 
 topIdLvl :: Id -> ThLevel
 -- Globals may either be imported, or may be from an earlier "chunk" 
@@ -572,19 +556,9 @@ topIdLvl :: Id -> ThLevel
 --	$( f x )
 -- By the time we are prcessing the $(f x), the binding for "x" 
 -- will be in the global env, not the local one.
-topIdLvl id | isLocalId id = topLevel
+topIdLvl id | isLocalId id = outerLevel
 	    | otherwise    = impLevel
 
--- Indicates the legal transitions on bracket( [| |] ).
-bracketOK :: ThStage -> Maybe ThLevel
-bracketOK (Brack _ _ _) = Nothing	-- Bracket illegal inside a bracket
-bracketOK stage         = Just (thLevel stage + 1)
-
--- Indicates the legal transitions on splice($).
-spliceOK :: ThStage -> Maybe ThLevel
-spliceOK (Splice _) = Nothing	-- Splice illegal inside splice
-spliceOK stage      = Just (thLevel stage - 1)
-
 tcMetaTy :: Name -> TcM Type
 -- Given the name of a Template Haskell data type, 
 -- return the type