Skip to content
GitLab
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
856de825
Commit
856de825
authored
Dec 14, 2011
by
chak@cse.unsw.edu.au.
Browse files
Fix -ddump-tc-trace for recursively defined type constructors
parent
64caa89e
Changes
2
Hide whitespace changes
Inline
Side-by-side
compiler/vectorise/Vectorise/Monad/Global.hs
View file @
856de825
...
...
@@ -16,7 +16,7 @@ module Vectorise.Monad.Global (
-- * TyCons
lookupTyCon
,
defTyCon
,
globalVectTyCons
,
defTyConName
,
defTyCon
,
globalVectTyCons
,
-- * Datacons
lookupDataCon
,
...
...
@@ -136,9 +136,13 @@ lookupTyCon tc
-- |Add a mapping between plain and vectorised `TyCon`s to the global environment.
--
defTyCon
::
TyCon
->
TyCon
->
VM
()
defTyCon
tc
tc'
=
do
{
traceVt
"add global tycon mapping:"
(
ppr
tc
<+>
text
"-->"
<+>
ppr
tc'
)
-- The second argument is only to enable tracing for (mutually) recursively defined type
-- constructors, where we /must not/ pull at the vectorised type constructors (because that would
-- pull too early at the recursive knot).
--
defTyConName
::
TyCon
->
Name
->
TyCon
->
VM
()
defTyConName
tc
nameOfTc'
tc'
=
do
{
traceVt
"add global tycon mapping:"
(
ppr
tc
<+>
text
"-->"
<+>
ppr
nameOfTc'
)
-- check for duplicate vectorisation
;
currentDef
<-
readGEnv
$
\
env
->
lookupNameEnv
(
global_tycons
env
)
(
tyConName
tc
)
...
...
@@ -158,6 +162,11 @@ defTyCon tc tc'
|
otherwise
=
ptext
(
sLit
"in the current module"
)
-- |Add a mapping between plain and vectorised `TyCon`s to the global environment.
--
defTyCon
::
TyCon
->
TyCon
->
VM
()
defTyCon
tc
tc'
=
defTyConName
tc
(
tyConName
tc'
)
tc'
-- |Get the set of all vectorised type constructors.
--
globalVectTyCons
::
VM
(
NameEnv
TyCon
)
...
...
compiler/vectorise/Vectorise/Type/TyConDecl.hs
View file @
856de825
...
...
@@ -22,23 +22,21 @@ import Control.Monad
--
vectTyConDecls
::
[
TyCon
]
->
VM
[
TyCon
]
vectTyConDecls
tcs
=
fixV
$
\
tcs'
->
do
{
mapM_
(
uncurry
defTyCon
)
(
zipLazy
tcs
tcs'
)
;
mapM
vectTyConDecl
tcs
do
{
names'
<-
mapM
(
mkLocalisedName
mkVectTyConOcc
.
tyConName
)
tcs
;
mapM_
(
uncurry
(
uncurry
defTyConName
))
(
tcs
`
zip
`
names'
`
zipLazy
`
tcs'
)
;
zipWithM
vectTyConDecl
tcs
names'
}
-- |Vectorise a single type constructor.
--
vectTyConDecl
::
TyCon
->
VM
TyCon
vectTyConDecl
tycon
vectTyConDecl
::
TyCon
->
Name
->
VM
TyCon
vectTyConDecl
tycon
name'
-- Type constructor representing a type class
|
Just
cls
<-
tyConClass_maybe
tycon
=
do
{
unless
(
null
$
classATs
cls
)
$
cantVectorise
"Associated types are not yet supported"
(
ppr
cls
)
-- make the name of the vectorised class tycon: "Class" --> "V:Class"
;
name'
<-
mkLocalisedName
mkVectTyConOcc
(
tyConName
tycon
)
-- vectorise superclass constraint (types)
;
theta'
<-
mapM
vectType
(
classSCTheta
cls
)
...
...
@@ -87,9 +85,6 @@ vectTyConDecl tycon
=
do
{
unless
(
all
isVanillaDataCon
(
tyConDataCons
tycon
))
$
cantVectorise
"Currently only Haskell 2011 datatypes are supported"
(
ppr
tycon
)
-- make the name of the vectorised class tycon
;
name'
<-
mkLocalisedName
mkVectTyConOcc
(
tyConName
tycon
)
-- vectorise the data constructor of the class tycon
;
rhs'
<-
vectAlgTyConRhs
tycon
(
algTyConRhs
tycon
)
...
...
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