X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcSplice.lhs;h=0d7ba6ab916d560b9ad7f411d8ca02f71d70211f;hp=aa5e9a175b0305e5d0eccf341e2f4ea75ac5e727;hb=9ba922ee06b048774d7a82964867ff768a78126e;hpb=2b8358cfe8b6399874090c099e3b96e932c6ccbb

diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs
index aa5e9a1..0d7ba6a 100644
--- a/compiler/typecheck/TcSplice.lhs
+++ b/compiler/typecheck/TcSplice.lhs
@@ -344,7 +344,7 @@ tcBracket brack res_ty
        ; let brack_stage = Brack cur_stage pending_splices lie_var
 
        ; (meta_ty, lie) <- setStage brack_stage $
-                           getConstraints $
+                           captureConstraints $
                            tc_bracket cur_stage brack
 
        ; simplifyBracket lie
@@ -395,7 +395,7 @@ tc_bracket _ (DecBrG decls)
 
 tc_bracket _ (PatBr pat)
   = do	{ any_ty <- newFlexiTyVarTy liftedTypeKind
-	; _ <- tcPat ThPatQuote pat any_ty unitTy $ 
+	; _ <- tcPat ThPatQuote pat any_ty $ 
                return ()
 	; tcMetaTy patQTyConName }
 	-- Result type is PatQ (= Q Pat)
@@ -487,7 +487,7 @@ tcTopSpliceExpr tc_action
                    -- if the type checker fails!
     setStage Splice $ 
     do {    -- Typecheck the expression
-         (expr', lie) <- getConstraints tc_action
+         (expr', lie) <- captureConstraints tc_action
         
 	-- Solve the constraints
 	; const_binds <- simplifyTop lie
@@ -664,7 +664,17 @@ runQuasiQuote :: Outputable hs_syn
               -> MetaOps th_syn hs_syn 
               -> RnM hs_syn
 runQuasiQuote (HsQuasiQuote quoter q_span quote) quote_selector meta_ty meta_ops
-  = do	{ quoter' <- lookupOccRn quoter
+  = do  {     -- Drop the leading "$" from the quoter name, if present
+              -- This is old-style syntax, now deprecated
+              -- NB: when removing this backward-compat, remove
+              --     the matching code in Lexer.x (around line 310)
+          let occ_str = occNameString (rdrNameOcc quoter)
+        ; quoter <- ASSERT( not (null occ_str) )  -- Lexer ensures this
+                    if head occ_str /= '$' then return quoter
+                    else do { addWarn (deprecatedDollar quoter)
+                            ; return (mkRdrUnqual (mkVarOcc (tail occ_str))) }
+
+        ; quoter' <- lookupOccRn quoter
 		-- 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).
@@ -709,6 +719,12 @@ quoteStageError :: Name -> SDoc
 quoteStageError quoter
   = sep [ptext (sLit "GHC stage restriction:") <+> ppr quoter,
          nest 2 (ptext (sLit "is used in a quasiquote, and must be imported, not defined locally"))]
+
+deprecatedDollar :: RdrName -> SDoc
+deprecatedDollar quoter
+  = hang (ptext (sLit "Deprecated syntax:"))
+       2 (ptext (sLit "quasiquotes no longer need a dollar sign:")
+          <+> ppr quoter)
 \end{code}
 
 
@@ -787,7 +803,7 @@ runMeta show_code run_and_convert expr
 	; hsc_env <- getTopEnv
 	; src_span <- getSrcSpanM
 	; either_hval <- tryM $ liftIO $
-			 HscMain.compileExpr hsc_env src_span ds_expr
+			 HscMain.hscCompileCoreExpr hsc_env src_span ds_expr
 	; case either_hval of {
 	    Left exn   -> failWithTc (mk_msg "compile and link" exn) ;
 	    Right hval -> do