Commit 856de825 authored by chak@cse.unsw.edu.au.'s avatar chak@cse.unsw.edu.au.
Browse files

Fix -ddump-tc-trace for recursively defined type constructors

parent 64caa89e
......@@ -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)
......
......@@ -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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment