-tcBracket :: HsBracket Name -> TcM TcType
-tcBracket (ExpBr expr)
- = newTyVarTy openTypeKind `thenM` \ any_ty ->
- tcMonoExpr expr any_ty `thenM_`
- tcMetaTy exprTyConName
+tcBracket :: HsBracket Name -> Expected TcType -> TcM TcExpr
+tcBracket brack res_ty
+ = getStage `thenM` \ level ->
+ case bracketOK level of {
+ Nothing -> failWithTc (illegalBracket level) ;
+ Just next_level ->
+
+ -- Typecheck expr to make sure it is valid,
+ -- but throw away the results. We'll type check
+ -- it again when we actually use it.
+ newMutVar [] `thenM` \ pending_splices ->
+ getLIEVar `thenM` \ lie_var ->
+
+ setStage (Brack next_level pending_splices lie_var) (
+ getLIE (tc_bracket brack)
+ ) `thenM` \ (meta_ty, lie) ->
+ tcSimplifyBracket lie `thenM_`
+
+ -- Make the expected type have the right shape
+ zapExpectedTo res_ty meta_ty `thenM_`
+
+ -- Return the original expression, not the type-decorated one
+ readMutVar pending_splices `thenM` \ pendings ->
+ returnM (HsBracketOut brack pendings)
+ }
+
+tc_bracket :: HsBracket Name -> TcM TcType
+tc_bracket (ExpBr expr)
+ = newTyVarTy openTypeKind `thenM` \ any_ty ->
+ tcCheckRho expr any_ty `thenM_`
+ tcMetaTy expQTyConName