- return$ cparen (p >= app_prec) (ppr dc <+> sep tt_docs)
-
-pprTermM y _ t = pprTermM1 y t
-
-pprTermM1 _ Prim{value=words, ty=ty} = return$ text$ repPrim (tyConAppTyCon ty)
- words
-pprTermM1 y t@Term{} = panic "pprTermM1 - unreachable"
-pprTermM1 _ Suspension{bound_to=Nothing} = return$ char '_'
-pprTermM1 _ Suspension{mb_ty=Just ty, bound_to=Just n}
- | Just _ <- splitFunTy_maybe ty = return$ ptext SLIT("<function>")
- | otherwise = return$ parens$ ppr n <> text "::" <> ppr ty
-
--- Takes a list of custom printers with a explicit recursion knot and a term,
+ return$ cparen (p >= app_prec) (ppr dc <+> pprDeeperList fsep tt_docs)
+
+ppr_termM y p t@NewtypeWrap{} = pprNewtypeWrap y p t
+ppr_termM y p RefWrap{wrapped_term=t} = do
+ contents <- y app_prec t
+ return$ cparen (p >= app_prec) (text "GHC.Prim.MutVar#" <+> contents)
+ -- The constructor name is wired in here ^^^ for the sake of simplicity.
+ -- I don't think mutvars are going to change in a near future.
+ -- In any case this is solely a presentation matter: MutVar# is
+ -- a datatype with no constructors, implemented by the RTS
+ -- (hence there is no way to obtain a datacon and print it).
+ppr_termM _ _ t = ppr_termM1 t
+
+
+ppr_termM1 :: Monad m => Term -> m SDoc
+ppr_termM1 Prim{value=words, ty=ty} =
+ return$ text$ repPrim (tyConAppTyCon ty) words
+ppr_termM1 Suspension{bound_to=Nothing} = return$ char '_'
+ppr_termM1 Suspension{ty=ty, bound_to=Just n}
+ | Just _ <- splitFunTy_maybe ty = return$ ptext (sLit "<function>")
+ | otherwise = return$ parens$ ppr n <> text "::" <> ppr ty
+ppr_termM1 Term{} = panic "ppr_termM1 - Term"
+ppr_termM1 RefWrap{} = panic "ppr_termM1 - RefWrap"
+ppr_termM1 NewtypeWrap{} = panic "ppr_termM1 - NewtypeWrap"
+
+pprNewtypeWrap y p NewtypeWrap{ty=ty, wrapped_term=t}
+ | Just (tc,_) <- splitNewTyConApp_maybe ty
+ , ASSERT(isNewTyCon tc) True
+ , Just new_dc <- maybeTyConSingleCon tc = do
+ real_term <- y max_prec t
+ return$ cparen (p >= app_prec) (ppr new_dc <+> real_term)
+pprNewtypeWrap _ _ _ = panic "pprNewtypeWrap"
+
+-------------------------------------------------------
+-- Custom Term Pretty Printers
+-------------------------------------------------------
+
+-- We can want to customize the representation of a
+-- term depending on its type.
+-- However, note that custom printers have to work with
+-- type representations, instead of directly with types.
+-- We cannot use type classes here, unless we employ some
+-- typerep trickery (e.g. Weirich's RepLib tricks),
+-- which I didn't. Therefore, this code replicates a lot
+-- of what type classes provide for free.
+
+type CustomTermPrinter m = TermPrinterM m
+ -> [Precedence -> Term -> (m (Maybe SDoc))]
+
+-- | Takes a list of custom printers with a explicit recursion knot and a term,