X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcSplice.lhs;h=abba313e5c1fc28a4d2c7eb1a8dd79e1855a0b73;hb=a8dc46dcbeeaf94a5321a1b8932725f7650d7abd;hp=61ed8c7838f913b0a2aa8d97f766e48d33872b95;hpb=f69bf6be6101d6b5d7952c384dd5eeb1917b4cdb;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs index 61ed8c7..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 @@ -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