X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FRtClosureInspect.hs;h=d4487934193aaf7f9c0b3b60cf2a313d9af34e6f;hb=c0778bd3da61e80948e5813255ee82cdfebe0fdf;hp=164b9c59ce5b6dccfd4c89291b381eec7a0c5504;hpb=decbb181cf7a06c6135ca451307a7e7214385f2e;p=ghc-hetmet.git

diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs
index 164b9c5..d448793 100644
--- a/compiler/ghci/RtClosureInspect.hs
+++ b/compiler/ghci/RtClosureInspect.hs
@@ -517,8 +517,6 @@ Right hand sides are missing them. We can either (a) drop them from the lhs, or
 The function congruenceNewtypes takes a shot at (b)
 -}
 
--- The Type Reconstruction monad
-type TR a = TcM a
 
 -- A (non-mutable) tau type containing
 -- existentially quantified tyvars.
@@ -529,20 +527,17 @@ type RttiType = Type
 -- An incomplete type as stored in GHCi:
 --  no polymorphism: no quantifiers & all tyvars are skolem.
 type GhciType = Type
-{-
-runTR :: HscEnv -> TR a -> IO a
-runTR hsc_env c = do
-  mb_term <- runTR_maybe hsc_env c
-  case mb_term of 
-    Nothing -> panic "RTTI: Failed to reconstruct a term"
-    Just x  -> return x
--}
+
+
+-- The Type Reconstruction monad
+--------------------------------
+type TR a = TcM a
 
 runTR :: HscEnv -> TR a -> IO a
 runTR hsc_env thing = do
   mb_val <- runTR_maybe hsc_env thing
   case mb_val of
-    Nothing -> error "RTTI error: probably due to :forcing an undefined"
+    Nothing -> error "unable to :print the term"
     Just x  -> return x
 
 runTR_maybe :: HscEnv -> TR a -> IO (Maybe a)
@@ -590,11 +585,13 @@ addConstraint actual expected = do
     recoverTR (traceTR $ fsep [text "Failed to unify", ppr actual,
                                     text "with", ppr expected])
               (congruenceNewtypes actual expected >>=
-                           uncurry boxyUnify >> return ())
+                           (getLIE . uncurry boxyUnify) >> return ())
      -- TOMDO: what about the coercion?
      -- we should consider family instances
 
--- Type & Term reconstruction 
+
+-- Type & Term reconstruction
+------------------------------
 cvObtainTerm :: HscEnv -> Int -> Bool -> RttiType -> HValue -> IO Term
 cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do
   -- we quantify existential tyvars as universal,
@@ -760,6 +757,7 @@ cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do
 
 
 -- Fast, breadth-first Type reconstruction
+------------------------------------------
 cvReconstructType :: HscEnv -> Int -> GhciType -> HValue -> IO (Maybe Type)
 cvReconstructType hsc_env max_depth old_ty hval = runTR_maybe hsc_env $ do
    traceTR (text "RTTI started with initial type " <> ppr old_ty)
@@ -844,7 +842,7 @@ improveRTTIType hsc_env _ty rtti_ty = runTR_maybe hsc_env $ do
     (ty_tvs,  _, _)   <- tcInstType return ty
     (ty_tvs', _, ty') <- tcInstType (mapM tcInstTyVar) ty
     (_, _, rtti_ty')  <- tcInstType (mapM tcInstTyVar) (sigmaType rtti_ty)
-    boxyUnify rtti_ty' ty'
+    getLIE(boxyUnify rtti_ty' ty')
     tvs1_contents     <- zonkTcTyVars ty_tvs'
     let subst = (uncurry zipTopTvSubst . unzip)
                  [(tv,ty) | (tv,ty) <- zip ty_tvs tvs1_contents
@@ -1180,4 +1178,4 @@ sizeofTyCon = primRepSizeW . tyConPrimRep
 
 
 (|.|) :: (a -> Bool) -> (a -> Bool) -> a -> Bool
-(f |.| g) x = f x || g x
\ No newline at end of file
+(f |.| g) x = f x || g x