Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
fbb68f1d
Commit
fbb68f1d
authored
Dec 18, 2006
by
mnislaih
Browse files
Remove uses of Data.Traversable to fix stage1 on pre ghc-6.6 systems
parent
7ef63167
Changes
4
Hide whitespace changes
Inline
Side-by-side
compiler/ghci/Debugger.hs
View file @
fbb68f1d
...
...
@@ -38,12 +38,12 @@ import ErrUtils
import
FastString
import
SrcLoc
import
Util
import
Maybes
import
Control.Exception
import
Control.Monad
import
qualified
Data.Map
as
Map
import
Data.Array.Unboxed
import
Data.Traversable
(
traverse
)
import
Data.Typeable
(
Typeable
)
import
Data.Maybe
import
Data.IORef
...
...
@@ -77,9 +77,9 @@ pprintClosureCommand bindThings force str = do
-- Give names to suspensions and bind them in the local env
mb_terms'
<-
if
bindThings
then
io
$
mapM
(
travers
e
(
bindSuspensions
cms
))
mb_terms
then
io
$
mapM
(
fmapMMayb
e
(
bindSuspensions
cms
))
mb_terms
else
return
mb_terms
ppr_terms
<-
io
$
mapM
(
travers
e
(
printTerm
cms
))
mb_terms'
ppr_terms
<-
io
$
mapM
(
fmapMMayb
e
(
printTerm
cms
))
mb_terms'
let
docs
=
[
ppr
id
<+>
char
'='
<+>
t
|
(
Just
t
,
id
)
<-
zip
ppr_terms
ids
]
unqual
<-
io
$
GHC
.
getPrintUnqual
cms
io
.
putStrLn
.
showSDocForUser
unqual
$
Outputable
.
vcat
docs
...
...
compiler/ghci/RtClosureInspect.hs
View file @
fbb68f1d
...
...
@@ -76,6 +76,7 @@ import TysWiredIn
import
Constants
(
wORD_SIZE
)
import
FastString
(
mkFastString
)
import
Outputable
import
Maybes
import
Panic
import
GHC.Arr
(
Array
(
..
)
)
...
...
@@ -87,13 +88,10 @@ import GHC.Word ( Word32(..), Word64(..) )
import
Control.Monad
(
liftM
,
liftM2
,
msum
)
import
Data.Maybe
import
Data.List
import
Data.Traversable
(
mapM
)
import
Data.Array.Base
import
Foreign.Storable
import
Foreign
(
unsafePerformIO
)
import
Prelude
hiding
(
mapM
)
---------------------------------------------
-- * A representation of semi evaluated Terms
---------------------------------------------
...
...
@@ -546,7 +544,7 @@ zonkTerm = foldTerm idTermFoldM {
fTerm
=
\
ty
dc
v
tt
->
sequence
tt
>>=
\
tt
->
zonkTcType
ty
>>=
\
ty'
->
return
(
Term
ty'
dc
v
tt
)
,
fSuspension
=
\
ct
ty
v
b
->
mapM
zonkTcType
ty
>>=
\
ty
->
,
fSuspension
=
\
ct
ty
v
b
->
f
mapM
Maybe
zonkTcType
ty
>>=
\
ty
->
return
(
Suspension
ct
ty
v
b
)}
{-
...
...
compiler/main/GHC.hs
View file @
fbb68f1d
...
...
@@ -280,7 +280,6 @@ import System.Exit ( exitWith, ExitCode(..) )
import
System.Time
(
ClockTime
)
import
Control.Exception
as
Exception
hiding
(
handle
)
import
Data.IORef
import
Data.Traversable
(
traverse
)
import
System.IO
import
System.IO.Error
(
isDoesNotExistError
)
import
Prelude
hiding
(
init
)
...
...
compiler/utils/Maybes.lhs
View file @
fbb68f1d
...
...
@@ -17,7 +17,7 @@ module Maybes (
expectJust,
maybeToBool,
thenMaybe, seqMaybe, returnMaybe, failMaybe
thenMaybe, seqMaybe, returnMaybe, failMaybe
, fmapMMaybe
) where
#include "HsVersions.h"
...
...
@@ -100,6 +100,11 @@ failMaybe = Nothing
orElse :: Maybe a -> a -> a
(Just x) `orElse` y = x
Nothing `orElse` y = y
fmapMMaybe :: Monad m => (a -> m b) -> Maybe a -> m (Maybe b)
fmapMMaybe f Nothing = return Nothing
fmapMMaybe f (Just x) = f x >>= \x' -> return (Just x')
\end{code}
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment