import IdInfo ( GlobalIdDetails(..) )
import TysWiredIn ( mkListTy )
import DsMeta ( expQTyConName, typeQTyConName, decTyConName, qTyConName, nameTyConName )
+import DsExpr ( dsLExpr )
+import DsMonad ( initDsTc )
import ErrUtils ( Message )
import SrcLoc ( SrcSpan, noLoc, unLoc, getLoc )
import Outputable
%************************************************************************
\begin{code}
-tcBracket :: HsBracket Name -> BoxyRhoType -> TcM (LHsExpr Id)
+tcBracket :: HsBracket Name -> BoxyRhoType -> TcM (LHsExpr TcId)
tcBracket brack res_ty
= getStage `thenM` \ level ->
case bracketOK level of {
-> LHsExpr Id -- Of type X
-> TcM hs_syn -- Of type t
runMeta convert expr
- = do { hsc_env <- getTopEnv
- ; tcg_env <- getGblEnv
- ; this_mod <- getModule
- ; let type_env = tcg_type_env tcg_env
- rdr_env = tcg_rdr_env tcg_env
+ = do { -- Desugar
+ ds_expr <- initDsTc (dsLExpr expr)
-- Compile and link it; might fail if linking fails
+ ; hsc_env <- getTopEnv
+ ; src_span <- getSrcSpanM
; either_hval <- tryM $ ioToTcRn $
- HscMain.compileExpr
- hsc_env this_mod
- rdr_env type_env expr
+ HscMain.compileExpr hsc_env src_span ds_expr
; case either_hval of {
Left exn -> failWithTc (mk_msg "compile and link" exn) ;
Right hval -> do
; fix <- reifyFixity name
; return (TH.DataConI (reifyName name) ty (reifyName (dataConTyCon dc)) fix) }
-reifyThing (ATcId id _ _)
- = do { ty1 <- zonkTcType (idType id) -- Make use of all the info we have, even
- -- though it may be incomplete
+reifyThing (ATcId {tct_id = id, tct_type = ty})
+ = do { ty1 <- zonkTcType ty -- Make use of all the info we have, even
+ -- though it may be incomplete
; ty2 <- reifyType ty1
; fix <- reifyFixity (idName id)
; return (TH.VarI (reifyName id) ty2 Nothing fix) }
| isFunTyCon tc = return (TH.PrimTyConI (reifyName tc) 2 False)
| isPrimTyCon tc = return (TH.PrimTyConI (reifyName tc) (tyConArity tc) (isUnLiftedTyCon tc))
| isSynTyCon tc
- = do { let (tvs, rhs) = synTyConDefn tc
- ; rhs' <- reifyType rhs
- ; return (TH.TyConI $ TH.TySynD (reifyName tc) (reifyTyVars tvs) rhs') }
+ = do { let (tvs, rhs) = synTyConDefn tc
+ ; rhs' <- reifyType rhs
+ ; return (TH.TyConI $
+ TH.TySynD (reifyName tc) (reifyTyVars tvs) rhs') }
reifyTyCon tc
= do { cxt <- reifyCxt (tyConStupidTheta tc)
; ops <- mapM reify_op op_stuff
; return (TH.ClassI $ TH.ClassD cxt (reifyName cls) (reifyTyVars tvs) fds' ops) }
where
- (tvs, fds, theta, _, op_stuff) = classExtraBigSig cls
+ (tvs, fds, theta, _, _, op_stuff) = classExtraBigSig cls
fds' = map reifyFunDep fds
reify_op (op, _) = do { ty <- reifyType (idType op)
; return (TH.SigD (reifyName op) ty) }