import HscTypes
import IdInfo
---import Id
+import Id
import Name
import Var hiding ( varName )
import VarSet
import SrcLoc
import PprTyThing
-import Control.Exception
+import Exception
import Control.Monad
import Data.List
import Data.Maybe
go cms id = do
term_ <- GHC.obtainTerm cms force id
term <- tidyTermTyVars cms term_
- term' <- if not bindThings then return term
- else bindSuspensions cms term
+ term' <- if bindThings &&
+ False == isUnliftedTypeKind (termType term)
+ then bindSuspensions cms term
+ else return term
-- Before leaving, we compare the type obtained to see if it's more specific
-- Then, we extract a substitution,
-- mapping the old tyvars to the reconstructed types.
- let Just reconstructed_type = termType term
- subst = unifyRTTI (idType id) (reconstructed_type)
- return (term',subst)
+ let reconstructed_type = termType term
+ mb_subst <- withSession cms $ \hsc_env ->
+ improveRTTIType hsc_env (idType id) (reconstructed_type)
+ return (term', fromMaybe emptyTvSubst mb_subst)
tidyTermTyVars :: Session -> Term -> IO Term
tidyTermTyVars (Session ref) t = do
(term, names) <- t
return (RefWrap ty term, names)
}
- doSuspension freeNames ct mb_ty hval _name = do
+ doSuspension freeNames ct ty hval _name = do
name <- atomicModifyIORef freeNames (\x->(tail x, head x))
n <- newGrimName name
- let ty' = fromMaybe (error "unexpected") mb_ty
- return (Suspension ct mb_ty hval (Just n), [(n,ty',hval)])
+ return (Suspension ct ty hval (Just n), [(n,ty,hval)])
-- A custom Term printer to enable the use of Show instances
GHC.setSessionDynFlags cms dflags
cPprShowable prec NewtypeWrap{ty=new_ty,wrapped_term=t} =
cPprShowable prec t{ty=new_ty}
- cPprShowable prec RefWrap{wrapped_term=t} = cPprShowable prec t
cPprShowable _ _ = return Nothing
needsParens ('"':_) = False -- some simple heuristics to see whether parens