X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcSplice.lhs;h=d59b0f885296c1b7bf666dcda4456c7ef7c6b2d4;hb=67ee8a93fc96a38c3f73468cb86d8421a11d2911;hp=f1e8c5644d48641613ab0a42efcda7db06362b2b;hpb=7383309f0ffe52a30b214a7dcaefad0426f88aba;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs index f1e8c56..d59b0f8 100644 --- a/compiler/typecheck/TcSplice.lhs +++ b/compiler/typecheck/TcSplice.lhs @@ -55,6 +55,8 @@ import Id ( idName, globalIdDetails ) 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 @@ -368,17 +370,14 @@ runMeta :: (SrcSpan -> th_syn -> Either Message hs_syn) -> 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 @@ -568,9 +567,9 @@ reifyThing (AGlobal (ADataCon dc)) ; 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_ty = 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) }