- let Just reconstructed_type = termType term
-
- -- tcUnifyTys doesn't look through forall's, so we drop them from
- -- the original type, instead of sigma-typing the reconstructed type
- -- In addition, we strip newtypes too, since the reconstructed type might
- -- not have recovered them all
- mb_subst = tcUnifyTys (const BindMe)
- [repType' $ dropForAlls$ idType id]
- [repType' $ reconstructed_type]
-
- ASSERT2 (isJust mb_subst, ppr reconstructed_type $$ (ppr$ idType id))
- return mb_subst
-
- applySubstToEnv :: Session -> TvSubst -> IO ()
- applySubstToEnv cms subst | isEmptyTvSubst subst = return ()
- applySubstToEnv cms@(Session ref) subst = do
- hsc_env <- readIORef ref
- inScope <- GHC.getBindings cms
- let ictxt = hsc_IC hsc_env
- ids = ic_tmp_ids ictxt
- ids' = map (\id -> id `setIdType` substTy subst (idType id)) ids
- subst_dom= varEnvKeys$ getTvSubstEnv subst
- subst_ran= varEnvElts$ getTvSubstEnv subst
- new_tvs = [ tv | Just tv <- map getTyVar_maybe subst_ran]
- ic_tyvars'= (`delVarSetListByKey` subst_dom)
- . (`extendVarSetList` new_tvs)
- $ ic_tyvars ictxt
- ictxt' = ictxt { ic_tmp_ids = ids'
- , ic_tyvars = ic_tyvars' }
- writeIORef ref (hsc_env {hsc_IC = ictxt'})
-
- where delVarSetListByKey = foldl' delVarSetByKey
-
- tidyTermTyVars :: Session -> Term -> IO Term
- tidyTermTyVars (Session ref) t = do
- hsc_env <- readIORef ref
- let env_tvs = ic_tyvars (hsc_IC hsc_env)
+ let reconstructed_type = termType term
+ hsc_env <- getSession
+ case (improveRTTIType hsc_env (idType id) (reconstructed_type)) of
+ Nothing -> return (subst, term')
+ Just subst' -> do { traceOptIf Opt_D_dump_rtti
+ (fsep $ [text "RTTI Improvement for", ppr id,
+ text "is the substitution:" , ppr subst'])
+ ; return (subst `unionTvSubst` subst', term')}
+
+ tidyTermTyVars :: GhcMonad m => Term -> m Term
+ tidyTermTyVars t =
+ withSession $ \hsc_env -> do
+ let env_tvs = tyVarsOfTypes (map idType (ic_tmp_ids (hsc_IC hsc_env)))