Fix a bug to do with recursive modules in one-shot mode

[ghc-hetmet.git] / compiler / main / InteractiveEval.hs

diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index c006752..42d2798 100644 (file)
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -497,7 +497,7 @@ moveHist fn (Session ref) = do
 -- -----------------------------------------------------------------------------
 -- After stopping at a breakpoint, add free variables to the environment
 result_fs :: FastString
-result_fs = FSLIT("_result")
+result_fs = fsLit "_result"
 
 bindLocalsAtBreakpoint
         :: HscEnv
@@ -510,9 +510,9 @@ bindLocalsAtBreakpoint
 -- bind, all we can do is bind a local variable to the exception
 -- value.
 bindLocalsAtBreakpoint hsc_env apStack Nothing = do
-   let exn_fs    = FSLIT("_exception")
+   let exn_fs    = fsLit "_exception"
        exn_name  = mkInternalName (getUnique exn_fs) (mkVarOccFS exn_fs) span
-       e_fs      = FSLIT("e")
+       e_fs      = fsLit "e"
        e_name    = mkInternalName (getUnique e_fs) (mkTyVarOcc e_fs) span
        e_tyvar   = mkTcTyVar e_name liftedTypeKind (SkolemTv RuntimeUnkSkol)
        exn_id    = Id.mkGlobalId VanillaGlobal exn_name (mkTyVarTy e_tyvar)
@@ -522,7 +522,7 @@ bindLocalsAtBreakpoint hsc_env apStack Nothing = do
        ictxt0 = hsc_IC hsc_env
        ictxt1 = extendInteractiveContext ictxt0 [exn_id] new_tyvars
 
-       span = mkGeneralSrcSpan FSLIT("<exception thrown>")
+       span = mkGeneralSrcSpan (fsLit "<exception thrown>")
    --
    Linker.extendLinkEnv [(exn_name, unsafeCoerce# apStack)]
    return (hsc_env{ hsc_IC = ictxt1 }, [exn_name], span)
@@ -616,10 +616,15 @@ rttiEnvironment hsc_env@HscEnv{hsc_IC=ic} = do
    tys <- reconstructType hsc_env 10 `mapM` incompletelyTypedIds
           -- map termType `fmap` (obtainTerm hsc_env False `mapM` incompletelyTypedIds)
    
-   let substs = [unifyRTTI ty ty' 
+   improvs <- sequence [improveRTTIType hsc_env ty ty'
                  | (ty, Just ty') <- zip (map idType incompletelyTypedIds) tys]
-       ic'    = foldr (flip substInteractiveContext) ic 
-                           (map skolemiseSubst substs)
+   let ic' = foldr (\mb_subst ic' ->
+                        maybe (WARN(True, text ("RTTI failed to calculate the "
+                                           ++  "improvement for a type")) ic')
+                              (substInteractiveContext ic' . skolemiseSubst)
+                              mb_subst)
+                   ic
+                   improvs
    return hsc_env{hsc_IC=ic'}
 
 skolemiseSubst :: TvSubst -> TvSubst