-pprintClosureCommand :: Bool -> Bool -> String -> GHCi ()
-pprintClosureCommand bindThings force str = do
- cms <- getSession
- newvarsNames <- io$ do
- uniques <- liftM uniqsFromSupply (mkSplitUniqSupply 'q')
- return$ map (\u-> (mkSysTvName u (mkFastString "a"))) uniques
- mb_ids <- io$ mapM (cleanUp cms newvarsNames) (words str)
- mb_new_ids <- mapM (io . go cms) (catMaybes mb_ids)
- io$ updateIds cms (catMaybes mb_new_ids)
- where
- -- Find the Id
- cleanUp :: Session -> [Name] -> String -> IO (Maybe Id)
- cleanUp cms newNames str = do
- tythings <- GHC.parseName cms str >>= mapM (GHC.lookupName cms)
- return$ listToMaybe [ i | Just (AnId i) <- tythings]
-
- -- Do the obtainTerm--bindSuspensions-refineIdType dance
- -- Warning! This function got a good deal of side-effects
- go :: Session -> Id -> IO (Maybe Id)
+pprintClosureCommand :: Session -> Bool -> Bool -> String -> IO ()
+pprintClosureCommand session bindThings force str = do
+ tythings <- (catMaybes . concat) `liftM`
+ mapM (\w -> GHC.parseName session w >>=
+ mapM (GHC.lookupName session))
+ (words str)
+ let ids = [id | AnId id <- tythings]
+
+ -- Obtain the terms and the recovered type information
+ (terms, substs) <- unzip `liftM` mapM (go session) ids
+
+ -- Apply the substitutions obtained after recovering the types
+ modifySession session $ \hsc_env ->
+ hsc_env{hsc_IC = foldr (flip substInteractiveContext)
+ (hsc_IC hsc_env)
+ (map skolemiseSubst substs)}
+ -- Finally, print the Terms
+ unqual <- GHC.getPrintUnqual session
+ docterms <- mapM (showTerm session) terms
+ (printForUser stdout unqual . vcat)
+ (zipWith (\id docterm -> ppr id <+> char '=' <+> docterm)
+ ids
+ docterms)
+ where
+
+ -- Do the obtainTerm--bindSuspensions-computeSubstitution dance
+ go :: Session -> Id -> IO (Term, TvSubst)