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

fix warnings

Browse source
This commit is contained in:
rhiannon morris 2023-09-19 18:05:43 +02:00
parent 80b1b3581a
commit dc076b636d
2 changed files with 29 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

42
lib/Quox/FreeVars.idr
View file

@ -84,19 +84,19 @@ toSet (FV vs) =
public export
interface HasFreeVars (0 term : Nat -> Type) where
interface HasFreeVars (0 tm : Nat -> Type) where
constructor HFV
fv : {n : Nat} -> term n -> FreeVars n
fv : {n : Nat} -> tm n -> FreeVars n
public export
interface HasFreeDVars (0 term : TermLike) where
interface HasFreeDVars (0 tm : TermLike) where
constructor HFDV
fdv : {d, n : Nat} -> term d n -> FreeVars d
fdv : {d, n : Nat} -> tm d n -> FreeVars d
export
Fdv : (0 term : TermLike) -> {n : Nat} ->
HasFreeDVars term => HasFreeVars (\d => term d n)
Fdv term @{HFDV fdv} = HFV fdv
Fdv : (0 tm : TermLike) -> {n : Nat} ->
HasFreeDVars tm => HasFreeVars (\d => tm d n)
Fdv tm @{HFDV fdv} = HFV fdv
export
@ -119,26 +119,26 @@ HasFreeVars Dim where
export
{s : Nat} -> HasFreeVars term => HasFreeVars (Scoped s term) where
{s : Nat} -> HasFreeVars tm => HasFreeVars (Scoped s tm) where
fv (S _ (Y body)) = FV $ drop s (fv body).vars
fv (S _ (N body)) = fv body
export
implementation [DScope]
{s : Nat} -> HasFreeDVars term =>
HasFreeDVars (\d, n => Scoped s (\d' => term d' n) d)
{s : Nat} -> HasFreeDVars tm =>
HasFreeDVars (\d, n => Scoped s (\d' => tm d' n) d)
where
fdv (S _ (Y body)) = FV $ drop s (fdv body).vars
fdv (S _ (N body)) = fdv body
export
fvD : {0 term : TermLike} -> {n : Nat} -> (forall d. HasFreeVars (term d)) =>
Scoped s (\d => term d n) d -> FreeVars n
fvD : {0 tm : TermLike} -> {n : Nat} -> (forall d. HasFreeVars (tm d)) =>
Scoped s (\d => tm d n) d -> FreeVars n
fvD (S _ (Y body)) = fv body
fvD (S _ (N body)) = fv body
export
fdvT : HasFreeDVars term => {s, d, n : Nat} -> Scoped s (term d) n -> FreeVars d
fdvT : HasFreeDVars tm => {s, d, n : Nat} -> Scoped s (tm d) n -> FreeVars d
fdvT (S _ (Y body)) = fdv body
fdvT (S _ (N body)) = fdv body
@ -149,8 +149,8 @@ guardM b x = if b then x else neutral
export
implementation
(HasFreeVars term, HasFreeVars env) =>
HasFreeVars (WithSubst term env)
(HasFreeVars tm, HasFreeVars env) =>
HasFreeVars (WithSubst tm env)
where
fv (Sub term subst) =
let Val from = getFrom subst in
@ -158,8 +158,8 @@ where
export
implementation [WithSubst]
((forall d. HasFreeVars (term d)), HasFreeDVars term, HasFreeDVars env) =>
HasFreeDVars (\d => WithSubst (term d) (env d))
((forall d. HasFreeVars (tm d)), HasFreeDVars tm, HasFreeDVars env) =>
HasFreeDVars (\d => WithSubst (tm d) (env d))
where
fdv (Sub term subst) =
let Val from = getFrom subst in
@ -227,8 +227,8 @@ expandDSubst (t ::: th) = expandDSubst th :< t
private
fdvSubst' : {d1, d2, n : Nat} -> HasFreeDVars term =>
term d1 n -> DSubst d1 d2 -> FreeVars d2
fdvSubst' : {d1, d2, n : Nat} -> HasFreeDVars tm =>
tm d1 n -> DSubst d1 d2 -> FreeVars d2
fdvSubst' t th =
fold $ zipWith maybeOnly (fdv t).vars (expandDSubst th)
where
@ -237,8 +237,8 @@ where
maybeOnly _ _ = none
private
fdvSubst : {d, n : Nat} -> HasFreeDVars term =>
WithSubst (\d => term d n) Dim d -> FreeVars d
fdvSubst : {d, n : Nat} -> HasFreeDVars tm =>
WithSubst (\d => tm d n) Dim d -> FreeVars d
fdvSubst (Sub t th) = let Val from = getFrom th in fdvSubst' t th

12
tests/Tests/FreeVars.idr
View file

@ -38,17 +38,21 @@ testFreeVars lbl tm dims terms =
Right ()
private
prettyWith : (a -> Eff Pretty (Doc (Opts 80))) -> a -> String
Doc80 : Type
Doc80 = Doc $ Opts 80
private
prettyWith : (a -> Eff Pretty Doc80) -> a -> String
prettyWith f = trim . render _ . runPretty . f
parameters {d, n : Nat} (ds : BContext d) (ts : BContext n)
private
withContext : {opts : _} -> Doc opts -> Eff Pretty (Doc opts)
withContext {opts} doc =
withContext : Doc80 -> Eff Pretty Doc80
withContext doc =
if null ds && null ts then pure $ hsep ["⊢", doc]
else pure $ sep [hsep [!(ctx1 ds), "|", !(ctx1 ts), "⊢"], doc]
where
ctx1 : forall k. BContext k -> Eff Pretty (Doc opts)
ctx1 : forall k. BContext k -> Eff Pretty Doc80
ctx1 [<] = pure "·"
ctx1 ctx = fillSeparateTight !commaD . toList' <$>
traverse' (pure . prettyBind') ctx