Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Shayne Fletcher
Glasgow Haskell Compiler
Commits
f3e5a3ad
Commit
f3e5a3ad
authored
Apr 25, 2007
by
mnislaih
Browse files
fix :print reconstructing too many types in environment bindings
For more details, see test print019
parent
de73aab4
Changes
1
Hide whitespace changes
Inline
Side-by-side
compiler/ghci/RtClosureInspect.hs
View file @
f3e5a3ad
...
...
@@ -66,7 +66,7 @@ import GHC.Word ( Word32(..), Word64(..) )
import
Control.Monad
import
Data.Maybe
import
Data.Array.Base
import
Data.List
(
partition
)
import
Data.List
(
partition
,
nub
)
import
Foreign.Storable
import
IO
...
...
@@ -475,18 +475,25 @@ cvObtainTerm :: HscEnv -> Bool -> Maybe Type -> HValue -> IO Term
cvObtainTerm
hsc_env
force
mb_ty
a
=
do
-- Obtain the term and tidy the type before returning it
term
<-
cvObtainTerm1
hsc_env
force
mb_ty
a
return
$
tidyTypes
term
where
tidyTypes
=
foldTerm
idTermFold
{
fTerm
=
\
ty
dc
hval
tt
->
Term
(
tidy
ty
)
dc
hval
tt
,
fSuspension
=
\
ct
mb_ty
hval
n
->
Suspension
ct
(
fmap
tidy
mb_ty
)
hval
n
}
tidy
ty
=
tidyType
(
emptyTidyOccEnv
,
tidyVarEnv
ty
)
ty
tidyVarEnv
ty
=
mkVarEnv
$
[
(
v
,
setTyVarName
v
(
tyVarName
tv
))
|
(
tv
,
v
)
<-
zip
alphaTyVars
vars
]
where
vars
=
varSetElems
$
tyVarsOfType
ty
let
term'
=
tidyTypes
term
return
term'
where
allvars
=
nub
.
foldTerm
TermFold
{
fTerm
=
\
ty
_
_
tt
->
varEnvElts
(
tyVarsOfType
ty
)
++
concat
tt
,
fSuspension
=
\
_
mb_ty
_
_
->
maybe
[]
(
varEnvElts
.
tyVarsOfType
)
mb_ty
,
fPrim
=
\
_
_
->
[]
}
tidyTypes
term
=
let
go
=
foldTerm
idTermFold
{
fTerm
=
\
ty
dc
hval
tt
->
Term
(
tidy
ty
)
dc
hval
tt
,
fSuspension
=
\
ct
mb_ty
hval
n
->
Suspension
ct
(
fmap
tidy
mb_ty
)
hval
n
}
tidy
ty
=
tidyType
(
emptyTidyOccEnv
,
tidyVarEnv
)
ty
tidyVarEnv
=
mkVarEnv
$
[
(
v
,
alpha_tv
`
setTyVarUnique
`
varUnique
v
)
|
(
alpha_tv
,
v
)
<-
zip
alphaTyVars
(
allvars
term
)]
in
go
term
cvObtainTerm1
::
HscEnv
->
Bool
->
Maybe
Type
->
HValue
->
IO
Term
cvObtainTerm1
hsc_env
force
mb_ty
hval
=
runTR
hsc_env
$
do
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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