- substs <- catMaybes `liftM` mapM (io . go cms)
- [id | AnId id <- tythings]
- mapM (io . applySubstToEnv cms . skolemSubst) substs
- return ()
- where
-
- -- Do the obtainTerm--bindSuspensions-refineIdType dance
- -- Warning! This function got a good deal of side-effects
- go :: Session -> Id -> IO (Maybe TvSubst)
- go cms id = do
- mb_term <- obtainTerm cms force id
- maybe (return Nothing) `flip` mb_term $ \term -> do
- term' <- if not bindThings then return term
- else bindSuspensions cms term
- showterm <- printTerm cms term'
- unqual <- GHC.getPrintUnqual cms
- let showSDocForUserOneLine unqual doc =
- showDocWith LeftMode (doc (mkErrStyle unqual))
- (putStrLn . showSDocForUserOneLine unqual) (ppr id <+> char '=' <+> showterm)
+ let ids = [id | AnId id <- tythings]
+
+ -- Obtain the terms and the recovered type information
+ (subst, terms) <- mapAccumLM go emptyTvSubst ids
+
+ -- Apply the substitutions obtained after recovering the types
+ modifySession $ \hsc_env ->
+ hsc_env{hsc_IC = substInteractiveContext (hsc_IC hsc_env) subst}
+
+ -- Finally, print the Terms
+ unqual <- GHC.getPrintUnqual
+ docterms <- mapM showTerm terms
+ liftIO $ (printForUser stdout unqual . vcat)
+ (zipWith (\id docterm -> ppr id <+> char '=' <+> docterm)
+ ids
+ docterms)
+ where
+ -- Do the obtainTerm--bindSuspensions-computeSubstitution dance
+ go :: GhcMonad m => TvSubst -> Id -> m (TvSubst, Term)
+ go subst id = do
+ let id' = id `setIdType` substTy subst (idType id)
+ term_ <- GHC.obtainTermFromId maxBound force id'
+ term <- tidyTermTyVars term_
+ term' <- if bindThings &&
+ False == isUnliftedTypeKind (termType term)
+ then bindSuspensions term
+ else return term