clean up printing of contexts

- just π.x : A instead of π.(x : A)
- skip the " |" if the dctx is empty
This commit is contained in:
rhiannon morris 2023-03-26 14:41:36 +02:00
parent 78e48911d0
commit 7e3a8e72bd

View file

@ -199,6 +199,13 @@ namespace EqContext
injectE (MkEqContext {termLen = Val n, _}) el = el // shift0 n injectE (MkEqContext {termLen = Val n, _}) el = el // shift0 n
private
data CtxBinder a = MkCtxBinder BaseName a
PrettyHL a => PrettyHL (CtxBinder a) where
prettyM (MkCtxBinder x t) = pure $
sep [hsep [!(pretty0M $ TV x), colonD], !(pretty0M t)]
parameters {auto _ : (Eq q, PrettyHL q, IsQty q)} (unicode : Bool) parameters {auto _ : (Eq q, PrettyHL q, IsQty q)} (unicode : Bool)
private private
pipeD : Doc HL pipeD : Doc HL
@ -210,17 +217,21 @@ parameters {auto _ : (Eq q, PrettyHL q, IsQty q)} (unicode : Bool)
go : QContext q m -> NContext m -> TContext q d m -> SnocList (Doc HL) go : QContext q m -> NContext m -> TContext q d m -> SnocList (Doc HL)
go [<] [<] [<] = [<] go [<] [<] [<] = [<]
go (qs :< q) (xs :< x) (ctx :< t) = go (qs :< q) (xs :< x) (ctx :< t) =
let bind = MkWithQty q $ MkBinder x t in let bind = MkWithQty q $ MkCtxBinder x t in
go qs xs ctx :< runPretty unicode (pretty0M bind) go qs xs ctx :< runPretty unicode (pretty0M bind)
export covering export covering
prettyTyContext : TyContext q d n -> Doc HL prettyTyContext : TyContext q d n -> Doc HL
prettyTyContext (MkTyContext dctx dnames tctx tnames qtys) = prettyTyContext (MkTyContext dctx dnames tctx tnames qtys) =
sep [prettyDimEq dnames dctx <++> pipeD, case dctx of
C [<] => prettyTContext qtys tnames tctx
_ => sep [prettyDimEq dnames dctx <++> pipeD,
prettyTContext qtys tnames tctx] prettyTContext qtys tnames tctx]
export covering export covering
prettyEqContext : EqContext q n -> Doc HL prettyEqContext : EqContext q n -> Doc HL
prettyEqContext (MkEqContext dassign dnames tctx tnames qtys) = prettyEqContext (MkEqContext dassign dnames tctx tnames qtys) =
sep [prettyDimEq dnames (fromGround dassign) <++> pipeD, case dassign of
[<] => prettyTContext qtys tnames tctx
_ => sep [prettyDimEq dnames (fromGround dassign) <++> pipeD,
prettyTContext qtys tnames tctx] prettyTContext qtys tnames tctx]