Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : ghc-7.4
http://hackage.haskell.org/trac/ghc/changeset/c0835f8933df1b1fccef07058ad6f14ceb074ebf >--------------------------------------------------------------- commit c0835f8933df1b1fccef07058ad6f14ceb074ebf Author: Manuel M T Chakravarty <[email protected]> Date: Wed Dec 14 13:25:37 2011 +1100 Fix -ddump-tc-trace for recursively defined type constructors >--------------------------------------------------------------- compiler/vectorise/Vectorise/Monad/Global.hs | 17 +++++++++++++---- compiler/vectorise/Vectorise/Type/TyConDecl.hs | 15 +++++---------- 2 files changed, 18 insertions(+), 14 deletions(-) diff --git a/compiler/vectorise/Vectorise/Monad/Global.hs b/compiler/vectorise/Vectorise/Monad/Global.hs index bb8cc1a..e728d6a 100644 --- a/compiler/vectorise/Vectorise/Monad/Global.hs +++ b/compiler/vectorise/Vectorise/Monad/Global.hs @@ -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) diff --git a/compiler/vectorise/Vectorise/Type/TyConDecl.hs b/compiler/vectorise/Vectorise/Type/TyConDecl.hs index 6db7dab..88ff686 100644 --- a/compiler/vectorise/Vectorise/Type/TyConDecl.hs +++ b/compiler/vectorise/Vectorise/Type/TyConDecl.hs @@ -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) _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
