X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcSplice.lhs;h=abba313e5c1fc28a4d2c7eb1a8dd79e1855a0b73;hb=a8dc46dcbeeaf94a5321a1b8932725f7650d7abd;hp=d67a57bfc6c6a1b431370cb1acdc5b394370a58a;hpb=836b1e90821aacc9d1e09fe78085f911597274c8;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs
index d67a57b..abba313 100644
--- a/compiler/typecheck/TcSplice.lhs
+++ b/compiler/typecheck/TcSplice.lhs
@@ -74,6 +74,7 @@ import BasicTypes
 import Panic
 import FastString
 import Exception
+import Control.Monad	( when )
 
 import qualified Language.Haskell.TH as TH
 -- THSyntax gives access to internal functions and data types
@@ -337,9 +338,12 @@ tcBracket brack res_ty
 	-- it again when we actually use it.
        ; pending_splices <- newMutVar []
        ; lie_var <- getLIEVar
+       ; let brack_stage = Brack cur_stage pending_splices lie_var
+
+       ; (meta_ty, lie) <- setStage brack_stage $
+                           getLIE $
+                           tc_bracket cur_stage brack
 
-       ; (meta_ty, lie) <- setStage (Brack cur_stage pending_splices lie_var)
-                                    (getLIE (tc_bracket cur_stage brack))
        ; tcSimplifyBracket lie
 
 	-- Make the expected type have the right shape
@@ -380,6 +384,10 @@ tc_bracket _ (DecBrG decls)
   = do	{ _ <- tcTopSrcDecls emptyModDetails decls
 	       -- Typecheck the declarations, dicarding the result
 	       -- We'll get all that stuff later, when we splice it in
+
+	       -- Top-level declarations in the bracket get unqualified names
+               -- See Note [Top-level Names in Template Haskell decl quotes] in RnNames
+
 	; tcMetaTy decsQTyConName } -- Result type is Q [Dec]
 
 tc_bracket _ (PatBr pat)
@@ -655,15 +663,16 @@ runQuasiQuote :: Outputable hs_syn
               -> RnM hs_syn
 runQuasiQuote (HsQuasiQuote quoter q_span quote) quote_selector meta_ty meta_ops
   = do	{ quoter' <- lookupOccRn quoter
-		-- If 'quoter' is not in scope, proceed no further
-		-- Otherwise lookupOcc adds an error messsage and returns 
-		-- an "unubound name", which makes the subsequent attempt to
-		-- run the quote fail
-		--
 		-- We use lookupOcc rather than lookupGlobalOcc because in the
 		-- erroneous case of \x -> [x| ...|] we get a better error message
 		-- (stage restriction rather than out of scope).
 
+        ; when (isUnboundName quoter') failM 
+		-- If 'quoter' is not in scope, proceed no further
+		-- The error message was generated by lookupOccRn, but it then
+		-- succeeds with an "unbound name", which makes the subsequent 
+		-- attempt to run the quote fail in a confusing way
+
           -- Check that the quoter is not locally defined, otherwise the TH
           -- machinery will not be able to run the quasiquote.
    	; this_mod <- getModule
@@ -1119,7 +1128,7 @@ reifyKind  ki
         kis_rep    = map reifyKind kis
         ki'_rep    = reifyNonArrowKind ki'
     in
-    foldl TH.ArrowK ki'_rep kis_rep
+    foldr TH.ArrowK ki'_rep kis_rep
   where
     reifyNonArrowKind k | isLiftedTypeKind k = TH.StarK
                         | otherwise          = pprPanic "Exotic form of kind" 
@@ -1195,10 +1204,9 @@ reifyFixity name
       conv_dir BasicTypes.InfixL = TH.InfixL
       conv_dir BasicTypes.InfixN = TH.InfixN
 
-reifyStrict :: BasicTypes.StrictnessMark -> TH.Strict
-reifyStrict MarkedStrict    = TH.IsStrict
-reifyStrict MarkedUnboxed   = TH.IsStrict
-reifyStrict NotMarkedStrict = TH.NotStrict
+reifyStrict :: BasicTypes.HsBang -> TH.Strict
+reifyStrict bang | isBanged bang = TH.IsStrict
+                 | otherwise     = TH.NotStrict
 
 ------------------------------
 noTH :: LitString -> SDoc -> TcM a