uniques <- liftM uniqsFromSupply (mkSplitUniqSupply 'q')
return$ map (\u-> (mkSysTvName u (mkFastString "a"))) uniques
mb_ids <- io$ mapM (cleanUp cms newvarsNames) (words str)
- new_ids <- mapM (io . go cms) (catMaybes mb_ids)
- io$ updateIds cms new_ids
+ mb_new_ids <- mapM (io . go cms) (catMaybes mb_ids)
+ io$ updateIds cms (catMaybes mb_new_ids)
where
-- Find the Id, clean up 'Unknowns'
cleanUp :: Session -> [Name] -> String -> IO (Maybe Id)
-- Do the obtainTerm--bindSuspensions-refineIdType dance
-- Warning! This function got a good deal of side-effects
- go :: Session -> Id -> IO Id
+ go :: Session -> Id -> IO (Maybe Id)
go cms id = do
- Just term <- obtainTerm cms force id
- term' <- if not bindThings then return term
- else bindSuspensions cms term
- showterm <- pprTerm cms term'
- unqual <- GHC.getPrintUnqual cms
- let showSDocForUserOneLine unqual doc =
- showDocWith LeftMode (doc (mkErrStyle unqual))
- (putStrLn . showSDocForUserOneLine unqual) (ppr id <+> char '=' <+> showterm)
+ 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 <- pprTerm cms term'
+ unqual <- GHC.getPrintUnqual cms
+ let showSDocForUserOneLine unqual doc =
+ showDocWith LeftMode (doc (mkErrStyle unqual))
+ (putStrLn . showSDocForUserOneLine unqual) (ppr id <+> char '=' <+> showterm)
-- Before leaving, we compare the type obtained to see if it's more specific
-- Note how we need the Unknown-clear type returned by obtainTerm
- let Just reconstructedType = termType term
- new_type <- instantiateTyVarsToUnknown cms
- (mostSpecificType (idType id) reconstructedType)
- return (setIdType id new_type)
+ let Just reconstructedType = termType term
+ new_type <- instantiateTyVarsToUnknown cms
+ (mostSpecificType (idType id) reconstructedType)
+ return . Just $ setIdType id new_type
updateIds :: Session -> [Id] -> IO ()
updateIds (Session ref) new_ids = do
-- | The inverse function. Strip the GHC.Base.Unknowns in the type of the id, they correspond to tyvars. The caller must provide an infinite list of fresh names
stripUnknowns :: [Name] -> Id -> Id
-stripUnknowns names id = setIdType id . sigmaType . fst . go names . idType
+stripUnknowns names id = setIdType id . fst . go names . idType
$ id
where
go tyvarsNames@(v:vv) ty
kind1 = mkArrowKind liftedTypeKind liftedTypeKind
kind2 = mkArrowKind kind1 liftedTypeKind
kind3 = mkArrowKind kind2 liftedTypeKind
-stripUnknowns _ id = id
-----------------------------
-- | The :breakpoint command
either
(handleBkptEx s mod)
(\(newTable, site) -> do
- setBkptTable newTable
- io (putStrLn ("Breakpoint set at " ++
- show (getSiteCoords newTable mod site))))
+ setBkptTable newTable
+ let (x,y) = getSiteCoords newTable mod site
+ io (putStrLn ("Breakpoint set at " ++ showSDoc (ppr mod)
+ ++ ':' : show x ++ ':' : show y)))
(f mod bt)
bkptOptions' s ("del":cmds) bt