Repository : ssh://darcs.haskell.org//srv/darcs/packages/template-haskell On branch : patch-4491-take-2
http://hackage.haskell.org/trac/ghc/changeset/c4c250a9a54e49505114b1ad81b6851ae501e8bd >--------------------------------------------------------------- commit c4c250a9a54e49505114b1ad81b6851ae501e8bd Author: Geoffrey Mainland <[email protected]> Date: Tue Oct 4 17:57:29 2011 +0100 Make dataToQa work regardless of the set of in-scope names (fixes #4491). Use tyConPackage and tyConModule to determine the package and module to which a data type belongs. With this information we can use mkNameG_d to build constructor names which ensures that dataToQa creates TH terms that are independent of the set of in-scope names. >--------------------------------------------------------------- Language/Haskell/TH/Quote.hs | 29 ++++++++++++++++++----------- 1 files changed, 18 insertions(+), 11 deletions(-) diff --git a/Language/Haskell/TH/Quote.hs b/Language/Haskell/TH/Quote.hs index 2d98a92..357bf8f 100644 --- a/Language/Haskell/TH/Quote.hs +++ b/Language/Haskell/TH/Quote.hs @@ -25,8 +25,24 @@ dataToQa mkCon mkLit appCon antiQ t = case antiQ t of Nothing -> case constrRep constr of - AlgConstr _ -> - appCon con conArgs + AlgConstr _ -> + appCon (mkCon conName) conArgs + where + conName :: Name + conName = + case showConstr constr of + "(:)" -> Name (mkOccName ":") NameS + con@"[]" -> Name (mkOccName con) NameS + con@('(':_) -> Name (mkOccName con) NameS + con -> mkNameG_d (tyConPackage tycon) + (tyConModule tycon) + con + where + tycon :: TyCon + tycon = (typeRepTyCon . typeOf) t + + conArgs :: [Q q] + conArgs = gmapQ (dataToQa mkCon mkLit appCon antiQ) t IntConstr n -> mkLit $ integerL n FloatConstr n -> @@ -36,15 +52,6 @@ dataToQa mkCon mkLit appCon antiQ t = where constr :: Constr constr = toConstr t - constrName :: Constr -> String - constrName k = - case showConstr k of - "(:)" -> ":" - name -> name - con :: k - con = mkCon (mkName (constrName constr)) - conArgs :: [Q q] - conArgs = gmapQ (dataToQa mkCon mkLit appCon antiQ) t Just y -> y _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
