Commit 7de2f211 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Pass DynFlags down to showSDocOneLine

parent b3894840
......@@ -1159,15 +1159,17 @@ segsToStmts empty_rec_stmt ((defs, uses, fwds, ss) : segs) fvs_later
%************************************************************************
\begin{code}
srcSpanPrimLit :: SrcSpan -> HsExpr Name
srcSpanPrimLit span = HsLit (HsStringPrim (mkFastString (showSDocOneLine (ppr span))))
srcSpanPrimLit :: DynFlags -> SrcSpan -> HsExpr Name
srcSpanPrimLit dflags span
= HsLit (HsStringPrim (mkFastString (showSDocOneLine dflags (ppr span))))
mkAssertErrorExpr :: RnM (HsExpr Name)
-- Return an expression for (assertError "Foo.hs:27")
mkAssertErrorExpr
= getSrcSpanM `thenM` \ sloc ->
return (HsApp (L sloc (HsVar assertErrorName))
(L sloc (srcSpanPrimLit sloc)))
= do sloc <- getSrcSpanM
dflags <- getDynFlags
return (HsApp (L sloc (HsVar assertErrorName))
(L sloc (srcSpanPrimLit dflags sloc)))
\end{code}
Note [Adding the implicit parameter to 'assert']
......
......@@ -1504,19 +1504,22 @@ genDerivStuff loc fix_env clas name tycon
= gen_Generic_binds tycon (nameModule name)
| otherwise -- Non-monadic generators
= case assocMaybe gen_list (getUnique clas) of
= do dflags <- getDynFlags
case assocMaybe (gen_list dflags) (getUnique clas) of
Just gen_fn -> return (gen_fn loc tycon)
Nothing -> pprPanic "genDerivStuff: bad derived class" (ppr clas)
where
gen_list :: [(Unique, SrcSpan -> TyCon -> (LHsBinds RdrName, BagDerivStuff))]
gen_list = [(eqClassKey, gen_Eq_binds)
gen_list :: DynFlags
-> [(Unique, SrcSpan -> TyCon -> (LHsBinds RdrName, BagDerivStuff))]
gen_list dflags
= [(eqClassKey, gen_Eq_binds)
,(ordClassKey, gen_Ord_binds)
,(enumClassKey, gen_Enum_binds)
,(boundedClassKey, gen_Bounded_binds)
,(ixClassKey, gen_Ix_binds)
,(showClassKey, gen_Show_binds fix_env)
,(readClassKey, gen_Read_binds fix_env)
,(dataClassKey, gen_Data_binds)
,(dataClassKey, gen_Data_binds dflags)
,(functorClassKey, gen_Functor_binds)
,(foldableClassKey, gen_Foldable_binds)
,(traversableClassKey, gen_Traversable_binds)
......
......@@ -49,6 +49,7 @@ import BasicTypes
import DataCon
import Name
import DynFlags
import HscTypes
import PrelInfo
import FamInstEnv( FamInst )
......@@ -1269,11 +1270,12 @@ we generate
\begin{code}
gen_Data_binds :: SrcSpan
gen_Data_binds :: DynFlags
-> SrcSpan
-> TyCon
-> (LHsBinds RdrName, -- The method bindings
BagDerivStuff) -- Auxiliary bindings
gen_Data_binds loc tycon
gen_Data_binds dflags loc tycon
= (listToBag [gfoldl_bind, gunfold_bind, toCon_bind, dataTypeOf_bind]
`unionBags` gcast_binds,
-- Auxiliary definitions: the data type and constructors
......@@ -1293,7 +1295,7 @@ gen_Data_binds loc tycon
sig_ty = nlHsTyVar dataType_RDR
constrs = [nlHsVar (mk_constr_name con) | con <- tyConDataCons tycon]
rhs = nlHsVar mkDataType_RDR
`nlHsApp` nlHsLit (mkHsString (showSDocOneLine (ppr tycon)))
`nlHsApp` nlHsLit (mkHsString (showSDocOneLine dflags (ppr tycon)))
`nlHsApp` nlList constrs
genDataDataCon :: DataCon -> (LHsBind RdrName, LSig RdrName)
......
......@@ -371,8 +371,8 @@ renderWithStyle _ sdoc sty =
-- This shows an SDoc, but on one line only. It's cheaper than a full
-- showSDoc, designed for when we're getting results like "Foo.bar"
-- and "foo{uniq strictness}" so we don't want fancy layout anyway.
showSDocOneLine :: SDoc -> String
showSDocOneLine d
showSDocOneLine :: DynFlags -> SDoc -> String
showSDocOneLine _ d
= Pretty.showDocWith PageMode
(runSDoc d (initSDocContext defaultUserStyle))
......
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