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

make p,q in coe/comp optional and default to @0 @1

Browse source
This commit is contained in:
rhiannon morris 2023-05-15 19:57:10 +02:00
parent 7b93a913c7
commit d631b86be3
7 changed files with 73 additions and 31 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -253,6 +253,26 @@ private
prettyCompPat : {opts : _} -> DimConst -> BindName -> Eff Pretty (Doc opts)
prettyCompPat e x = [|prettyDimConst e <++> prettyDBind x|]
private
prettyCompArm : {opts : _} -> BContext d -> BContext n ->
DimConst -> DScopeTerm d n -> Eff Pretty (Doc opts)
prettyCompArm dnames tnames e s = prettyCaseArm dnames tnames $
MkCaseArm !(prettyCompPat e s.name) [< s.name] [<] s.term
private
layoutComp : {opts : _} ->
(typq : List (Doc opts)) -> (val, r : Doc opts) ->
(arms : List (Doc opts)) -> Eff Pretty (Doc opts)
layoutComp typq val r arms = do
comp <- compD; lb <- hl Delim "{"; rb <- hl Delim "}"
ind <- askAt INDENT
pure $ ifMultiline
(hsep $ concat {t = List} [[comp], typq, [val, r, lb], arms, [rb]]) $
(comp <++>
vsep [sep typq, val, r <++> lb, indent ind $ vsep arms, rb]) <|>
(vsep $ (comp ::) $ map (indent ind) $ concat {t = List}
[typq, [val, r <++> lb], map (indent ind) arms, [rb]])
export
prettyTag : {opts : _} -> String -> Eff Pretty (Doc opts)
@ -296,6 +316,12 @@ prettyCase dnames tnames qty head ret body =
prettyCase_ dnames tnames ![|caseD <+> prettyQty qty|] head ret body
private
isDefaultDir : Dim d -> Dim d -> Bool
isDefaultDir (K Zero _) (K One _) = True
isDefaultDir _ _ = False
-- [fixme] use telescopes in Scoped
private
toTel : BContext s -> BTelescope n (s + n)
@ -477,33 +503,30 @@ prettyElim dnames tnames (Ann tm ty _) =
!(withPrec Outer (prettyTerm dnames tnames ty))
prettyElim dnames tnames (Coe ty p q val _) =
parensIfM App =<< do
ty <- prettyTypeLine dnames tnames ty
p <- prettyDArg dnames p
q <- prettyDArg dnames q
val <- prettyTArg dnames tnames val
prettyAppD !coeD [ty, sep [p, q], val]
parensIfM App =<<
if isDefaultDir p q then do
ty <- prettyTypeLine dnames tnames ty
val <- prettyTArg dnames tnames val
prettyAppD !coeD [ty, val]
else do
ty <- prettyTypeLine dnames tnames ty
p <- prettyDArg dnames p
q <- prettyDArg dnames q
val <- prettyTArg dnames tnames val
prettyAppD !coeD [ty, sep [p, q], val]
prettyElim dnames tnames e@(Comp ty p q val r zero one _) =
parensIfM App =<< do
ty <- prettyTypeLine dnames tnames $ assert_smaller e $ SN ty
p <- prettyDArg dnames p
q <- prettyDArg dnames q
pq <- sep <$> sequence [prettyDArg dnames p, prettyDArg dnames q]
val <- prettyTArg dnames tnames val
r <- prettyDArg dnames r
comp <- compD; lb <- hl Delim "{"; rb <- hl Delim "}"; sc <- semiD
arm0 <- map (<+> sc) $ prettyCaseArm dnames tnames $
MkCaseArm !(prettyCompPat Zero zero.name) [< zero.name] [<] zero.term
arm1 <- prettyCaseArm dnames tnames $
MkCaseArm !(prettyCompPat One one.name) [< one.name] [<] one.term
arm0 <- [|prettyCompArm dnames tnames Zero zero <+> semiD|]
arm1 <- prettyCompArm dnames tnames One one
ind <- askAt INDENT
pure $ ifMultiline
(hsep [comp, ty, p, q, val, r, lb, arm0, arm1, rb])
(comp <++> vsep [sep [ty, sep [p, q]], val, r <++> lb,
indent ind $ vsep [arm0, arm1], rb] <|>
vsep (comp :: map (indent ind)
[ty, sep [p, q], val, r <++> lb,
indent ind $ vsep [arm0, arm1], rb]))
if isDefaultDir p q
then layoutComp [ty] val r [arm0, arm1]
else layoutComp [ty, pq] val r [arm0, arm1]
prettyElim dnames tnames (TypeCase ty ret arms def _) = do
arms <- for (toList arms) $ \(k ** body) => do