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

pretty printing fixes

Browse source
This commit is contained in:
rhiannon morris 2023-12-21 18:03:57 +01:00
parent 48a050491c
commit b7074720ad
5 changed files with 71 additions and 49 deletions
Download patch file Download diff file Expand all files Collapse all files

57
lib/Quox/Syntax/Term/Pretty.idr
View file

@ -342,18 +342,39 @@ private covering
prettyLets : {opts : LayoutOpts} ->
BContext d -> BContext a -> Telescope (LetBinder d) a b ->
Eff Pretty (SnocList (Doc opts))
prettyLets dnames xs lets = sequence $ snd $ go lets where
prettyLets dnames xs lets = snd <$> go lets where
peelAnn : forall d, n. Elim d n -> Maybe (Term d n, Term d n)
peelAnn (Ann tm ty _) = Just (tm, ty)
peelAnn e = Nothing
letHeader : Qty -> BindName -> Eff Pretty (Doc opts)
letHeader qty x = do
lett <- [|letD <+> prettyQty qty|]
x <- prettyTBind x
pure $ lett <++> x
letBody : forall n. BContext n ->
Doc opts -> Elim d n -> Eff Pretty (Doc opts)
letBody tnames hdr e = case peelAnn e of
Just (tm, ty) => do
ty <- withPrec Outer $ assert_total prettyTerm dnames tnames ty
tm <- withPrec Outer $ assert_total prettyTerm dnames tnames tm
colon <- colonD; eq <- cstD; d <- askAt INDENT
pure $ hangSingle d (hangSingle d hdr (colon <++> ty)) (eq <++> tm)
Nothing => do
e <- withPrec Outer $ assert_total prettyElim dnames tnames e
eq <- cstD; d <- askAt INDENT
pure $ ifMultiline
(hsep [hdr, eq, e])
(vsep [hdr, indent d $ hsep [eq, e]])
go : forall b. Telescope (LetBinder d) a b ->
(BContext b, SnocList (Eff Pretty (Doc opts)))
go [<] = (xs, [<])
go (lets :< (qty, x, rhs)) =
let (ys, docs) = go lets
doc = do
lett <- [|letD <+> prettyQty qty|]
x <- prettyTBind x
rhs <- withPrec Outer $ assert_total prettyElim dnames ys rhs
hangDSingle (hsep [lett, x, !cstD]) (hsep [rhs, !inD]) in
(ys :< x, docs :< doc)
Eff Pretty (BContext b, SnocList (Doc opts))
go [<] = pure (xs, [<])
go (lets :< (qty, x, rhs)) = do
(ys, docs) <- go lets
doc <- letBody ys !(letHeader qty x) rhs
pure (ys :< x, docs :< doc)
private
@ -504,7 +525,10 @@ prettyTerm dnames tnames (Let qty rhs body _) = do
let lines = toList $ heads :< body
pure $ ifMultiline (hsep lines) (vsep lines)
prettyTerm dnames tnames (E e) = prettyElim dnames tnames e
prettyTerm dnames tnames (E e) =
case the (Elim d n) (pushSubsts' e) of
Ann tm _ _ => assert_total prettyTerm dnames tnames tm
_ => assert_total prettyElim dnames tnames e
prettyTerm dnames tnames t0@(CloT (Sub t ph)) =
prettyTerm dnames tnames $ assert_smaller t0 $ pushSubstsWith' id ph t
@ -567,9 +591,12 @@ prettyElim dnames tnames e@(DApp {}) =
prettyDTApps dnames tnames f xs
prettyElim dnames tnames (Ann tm ty _) =
parensIfM Outer =<<
hangDSingle !(withPrec AnnL [|prettyTerm dnames tnames tm <++> annD|])
!(withPrec Outer (prettyTerm dnames tnames ty))
case the (Term d n) (pushSubsts' tm) of
E e => assert_total prettyElim dnames tnames e
_ => do
tm <- withPrec AnnL $ assert_total prettyTerm dnames tnames tm
ty <- withPrec Outer $ assert_total prettyTerm dnames tnames ty
parensIfM Outer =<< hangDSingle (tm <++> !annD) ty
prettyElim dnames tnames (Coe ty p q val _) =
parensIfM App =<< do