X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcSplice.lhs;h=bafddf8e3582334039af4bbb7353f85176f17ce0;hb=241c6ba59c89d491aa4087f754dfcbbca26163f4;hp=d67a57bfc6c6a1b431370cb1acdc5b394370a58a;hpb=836b1e90821aacc9d1e09fe78085f911597274c8;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs index d67a57b..bafddf8 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 @@ -655,15 +656,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 +1121,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 +1197,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