rhi/quox
rhi/quox
1
0
Fork 0
Code Issues 15 Pull requests 1 Releases Wiki Activity

rewrite pretty printer

Browse source
This commit is contained in:
rhiannon morris 2023-05-14 19:58:46 +02:00
parent f6abf084b3
commit 7b93a913c7
26 changed files with 1193 additions and 1360 deletions
Download patch file Download diff file Expand all files Collapse all files

65
lib/Quox/Typing/Context.idr
View file

@ -228,41 +228,38 @@ namespace WhnfContext
private
data CtxBinder a = MkCtxBinder BindName a
prettyTContextElt : {opts : _} ->
BContext d -> BContext n ->
Qty -> BindName -> Term d n -> Eff Pretty (Doc opts)
prettyTContextElt dnames tnames q x s =
pure $ hsep [hcat [!(prettyQty q), !dotD, !(prettyTBind x)], !colonD,
!(withPrec Outer $ prettyTerm dnames tnames s)]
PrettyHL a => PrettyHL (CtxBinder a) where
prettyM (MkCtxBinder x t) = pure $
sep [hsep [!(pretty0M $ TV x.name), colonD], !(pretty0M t)]
private
prettyTContext' : {opts : _} ->
BContext d -> QContext n -> BContext n ->
TContext d n -> Eff Pretty (SnocList (Doc opts))
prettyTContext' _ [<] [<] [<] = pure [<]
prettyTContext' dnames (qtys :< q) (tnames :< x) (tys :< t) =
[|prettyTContext' dnames qtys tnames tys :<
prettyTContextElt dnames tnames q x t|]
parameters (unicode : Bool)
private
pipeD : Doc HL
pipeD = hl Syntax "|"
export
prettyTContext : {opts : _} ->
BContext d -> QContext n -> BContext n ->
TContext d n -> Eff Pretty (Doc opts)
prettyTContext dnames qtys tnames tys =
separateTight !commaD <$> prettyTContext' dnames qtys tnames tys
export covering
prettyTContext : BContext d ->
QContext n -> BContext n ->
TContext d n -> Doc HL
prettyTContext ds qs xs ctx = separate comma $ toList $ go qs xs ctx where
go : QContext m -> BContext m -> TContext d m -> SnocList (Doc HL)
go [<] [<] [<] = [<]
go (qs :< q) (xs :< x) (ctx :< t) =
let bind = MkWithQty q $ MkCtxBinder x t in
go qs xs ctx :<
runPrettyWith unicode (toNames ds) (toNames xs) (pretty0M bind)
export
prettyTyContext : {opts : _} -> TyContext d n -> Eff Pretty (Doc opts)
prettyTyContext (MkTyContext dctx dnames tctx tnames qtys) =
case dctx of
C [<] => prettyTContext dnames qtys tnames tctx
_ => pure $
sep [!(prettyDimEq dnames dctx) <++> !pipeD,
!(prettyTContext dnames qtys tnames tctx)]
export covering
prettyTyContext : TyContext d n -> Doc HL
prettyTyContext (MkTyContext dctx dnames tctx tnames qtys) =
case dctx of
C [<] => prettyTContext dnames qtys tnames tctx
_ => sep [prettyDimEq dnames dctx <++> pipeD,
prettyTContext dnames qtys tnames tctx]
export covering
prettyEqContext : EqContext n -> Doc HL
prettyEqContext (MkEqContext dassign dnames tctx tnames qtys) =
case dassign of
[<] => prettyTContext [<] qtys tnames tctx
_ => sep [prettyDimEq dnames (fromGround dassign) <++> pipeD,
prettyTContext [<] qtys tnames tctx]
export
prettyEqContext : {opts : _} -> EqContext n -> Eff Pretty (Doc opts)
prettyEqContext ctx = prettyTyContext $ toTyContext ctx