pprInlinePragInfo, ppArityInfo, ppStrictnessInfo
)
import RdrName ( RdrName )
-import Name ( Name, toRdrName )
+import Name ( toRdrName )
import CoreSyn
import CostCentre ( pprCostCentreCore )
import PrimOp ( PrimOp(CCallOp) )
-import Demand ( Demand, StrictnessInfo )
+import Demand ( StrictnessInfo )
import Literal ( Literal, maybeLitLit )
import PrimOp ( CCall, pprCCallOp )
import DataCon ( dataConTyCon )
import TyCon ( isTupleTyCon, tupleTyConBoxity )
-import Type ( Type, Kind )
+import Type ( Kind )
import CostCentre
import SrcLoc ( SrcLoc )
-import BasicTypes ( Arity )
import Outputable
\end{code}
pprUfExpr add_par (UfVar v) = ppr v
pprUfExpr add_par (UfLit l) = ppr l
-pprUfExpr add_par (UfLitLit l ty) = ppr l
+pprUfExpr add_par (UfLitLit l ty) = add_par (hsep [ptext SLIT("__litlit"), pprHsString l, pprParendHsType ty])
pprUfExpr add_par (UfCCall cc ty) = braces (pprCCallOp cc <+> ppr ty)
pprUfExpr add_par (UfType ty) = char '@' <+> pprParendHsType ty
-pprUfExpr add_par (UfLam b body) = add_par (hsep [char '\\', ppr b, ptext SLIT("->"), pprUfExpr noParens body])
+
+pprUfExpr add_par e@(UfLam _ _) = add_par (char '\\' <+> hsep (map ppr bndrs)
+ <+> ptext SLIT("->") <+> pprUfExpr noParens body)
+ where (bndrs,body) = collectUfBndrs e
pprUfExpr add_par (UfApp fun arg) = add_par (pprUfExpr noParens fun <+> pprUfExpr parens arg)
pprUfExpr add_par (UfTuple c as) = hsTupParens c (interpp'SP as)
pprUfExpr add_par (UfNote note body) = add_par (ppr note <+> pprUfExpr parens body)
+collectUfBndrs :: UfExpr name -> ([UfBinder name], UfExpr name)
+collectUfBndrs expr
+ = go [] expr
+ where
+ go bs (UfLam b e) = go (b:bs) e
+ go bs e = (reverse bs, e)
+
instance Outputable name => Outputable (UfNote name) where
ppr (UfSCC cc) = pprCostCentreCore cc
ppr (UfCoerce ty) = ptext SLIT("__coerce") <+> pprParendHsType ty
instance Outputable name => Outputable (UfConAlt name) where
ppr UfDefault = text "__DEFAULT"
ppr (UfLitAlt l) = ppr l
- ppr (UfLitLitAlt l ty) = ppr l
+ ppr (UfLitLitAlt l ty) = parens (hsep [ptext SLIT("__litlit"), pprHsString l, pprParendHsType ty])
ppr (UfDataAlt d) = ppr d
instance Outputable name => Outputable (UfBinder name) where