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

use NContext/SnocVect for scope name lists etc

Browse source
This commit is contained in:
rhiannon morris 2023-03-16 18:18:49 +01:00
parent 32f38238ef
commit 6dc7177be5
12 changed files with 165 additions and 134 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -73,12 +73,13 @@ prettyArm sort xs pat body = do
export
prettyLams : PrettyHL a => Pretty.HasEnv m =>
Maybe (Doc HL) -> BinderSort -> List BaseName -> a -> m (Doc HL)
Maybe (Doc HL) -> BinderSort -> SnocList BaseName -> a ->
m (Doc HL)
prettyLams lam sort names body = do
let var = case sort of T => TVar; D => DVar
header <- sequence $ [hlF var $ prettyM x | x <- names]
header <- sequence $ [hlF var $ prettyM x | x <- toList names]
let header = sep $ maybe header (:: header) lam
parensIfM Outer =<< prettyArm sort (cast names) header body
parensIfM Outer =<< prettyArm sort names header body
export
prettyApps : PrettyHL f => PrettyHL a => Pretty.HasEnv m =>
@ -110,7 +111,7 @@ prettyCase : PrettyHL a => PrettyHL b => PrettyHL c => PrettyHL q =>
m (Doc HL)
prettyCase pi elim r ret arms = do
elim <- prettyQtyBinds [pi] elim
ret <- prettyLams Nothing T [r] ret
ret <- prettyLams Nothing T [< r] ret
arms <- prettyArms arms
pure $ asep [caseD <++> elim, returnD <++> ret, ofD <++> arms]
@ -127,12 +128,12 @@ parameters (showSubsts : Bool)
where
prettyM (TYPE l) =
parensIfM App $ !typeD <+> hl Syntax !(prettyUnivSuffix l)
prettyM (Pi qty s (S [x] t)) =
prettyM (Pi qty s (S [< x] t)) =
prettyBindType [qty] x s !arrowD t.term
prettyM (Lam (S x t)) =
let GotLams {names, body, _} = getLams' x t.term Refl in
prettyLams (Just !lamD) T (toList names) body
prettyM (Sig s (S [x] t)) =
prettyLams (Just !lamD) T (toSnocList' names) body
prettyM (Sig s (S [< x] t)) =
prettyBindType {q} [] x s !timesD t.term
prettyM (Pair s t) =
let GotPairs {init, last, _} = getPairs' [< s] t in
@ -147,14 +148,14 @@ parameters (showSubsts : Bool)
r <- withPrec InEq $ prettyM r
ty <- withPrec InEq $ prettyM ty
parensIfM Eq $ asep [l <++> !eqndD, r <++> colonD, ty]
prettyM (Eq (S [i] (Y ty)) l r) = do
ty <- bracks <$> withPrec Outer (prettyLams Nothing D [i] ty)
prettyM (Eq (S [< i] (Y ty)) l r) = do
ty <- bracks <$> withPrec Outer (prettyLams Nothing D [< i] ty)
l <- withPrec Arg $ prettyM l
r <- withPrec Arg $ prettyM r
parensIfM App $ eqD <++> asep [ty, l, r]
prettyM (DLam (S i t)) =
let GotDLams {names, body, _} = getDLams' i t.term Refl in
prettyLams (Just !dlamD) D (toList names) body
prettyLams (Just !dlamD) D (toSnocList' names) body
prettyM (E e) = prettyM e
prettyM (CloT s th) =
if showSubsts then
@ -179,10 +180,10 @@ parameters (showSubsts : Bool)
prettyM (e :@ s) =
let GotArgs {fun, args, _} = getArgs' e [s] in
prettyApps Nothing fun args
prettyM (CasePair pi p (S [r] ret) (S [x, y] body)) = do
prettyM (CasePair pi p (S [< r] ret) (S [< x, y] body)) = do
pat <- parens . separate commaD <$> traverse (hlF TVar . prettyM) [x, y]
prettyCase pi p r ret.term [([< x, y], pat, body.term)]
prettyM (CaseEnum pi t (S [r] ret) arms) =
prettyM (CaseEnum pi t (S [< r] ret) arms) =
prettyCase pi t r ret.term
[([<], prettyTag t, b) | (t, b) <- SortedMap.toList arms]
prettyM (e :% d) =