rhi/quox
rhi
/
quox
1
0
Fork 0
Code Issues 16 Pull Requests 2 Releases Wiki Activity

stop throwing names away

This commit is contained in:
rhiannon morris 2023-09-17 19:06:07 +02:00
parent 7bd959e919
commit 4c88918ade
2 changed files with 9 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
lib/Quox/Syntax/Term/Tighten.idr
View File

@ -250,19 +250,19 @@ export Tighten (\d => Elim d n) where tighten p e = dtightenE p e
parameters {auto _ : Tighten f} {s : Nat} parameters {auto _ : Tighten f} {s : Nat}
export export
squeeze : Scoped s f n -> Either (BContext s, f (s + n)) (f n) squeeze : Scoped s f n -> (BContext s, Either (f (s + n)) (f n))
squeeze (S ns (N t)) = Right t squeeze (S ns (N t)) = (ns, Right t)
squeeze (S ns (Y t)) = maybe (Left (ns, t)) Right $ tightenN s t squeeze (S ns (Y t)) = (ns, maybe (Left t) Right $ tightenN s t)
export export
squeeze' : Scoped s f n -> Scoped s f n squeeze' : Scoped s f n -> Scoped s f n
squeeze' = either (uncurry SY) SN . squeeze squeeze' t = let (ns, res) = squeeze t in S ns $ either Y N res
parameters {0 f : Nat -> Nat -> Type} parameters {0 f : Nat -> Nat -> Type}
{auto tt : Tighten (\d => f d n)} {s : Nat} {auto tt : Tighten (\d => f d n)} {s : Nat}
export export
dsqueeze : Scoped s (\d => f d n) d -> dsqueeze : Scoped s (\d => f d n) d ->
Either (BContext s, f (s + d) n) (f d n) (BContext s, Either (f (s + d) n) (f d n))
dsqueeze = squeeze dsqueeze = squeeze
export export
@ -272,11 +272,11 @@ parameters {0 f : Nat -> Nat -> Type}
-- versions of SY, etc, that try to tighten and use SN automatically -- versions of SY, etc, that try to tighten and use SN automatically
public export public export %inline
ST : Tighten f => {s : Nat} -> BContext s -> f (s + n) -> Scoped s f n ST : Tighten f => {s : Nat} -> BContext s -> f (s + n) -> Scoped s f n
ST names body = squeeze' $ SY names body ST names body = squeeze' $ SY names body
public export public export %inline
DST : {s : Nat} -> BContext s -> Term (s + d) n -> DScopeTermN s d n DST : {s : Nat} -> BContext s -> Term (s + d) n -> DScopeTermN s d n
DST names body = dsqueeze' {f = Term} $ SY names body DST names body = dsqueeze' {f = Term} $ SY names body

4
lib/Quox/Whnf/Main.idr
View File

@ -145,7 +145,7 @@ CanWhnf Elim Interface.isRedexE where
-- --
-- [fixme] needs a real equality check between A‹0/𝑖› and A‹1/𝑖› -- [fixme] needs a real equality check between A‹0/𝑖› and A‹1/𝑖›
case dsqueeze sty {f = Term} of case dsqueeze sty {f = Term} of
Left ([< i], ty) => ([< i], Left ty) =>
case p `decEqv` q of case p `decEqv` q of
-- coe (𝑖 ⇒ A) @p @p s ⇝ (s ∷ A‹p/𝑖›) -- coe (𝑖 ⇒ A) @p @p s ⇝ (s ∷ A‹p/𝑖›)
Yes _ => whnf defs ctx $ Ann val (dsub1 sty p) coeLoc Yes _ => whnf defs ctx $ Ann val (dsub1 sty p) coeLoc
@ -155,7 +155,7 @@ CanWhnf Elim Interface.isRedexE where
Left pc => pushCoe defs ctx i ty p q val coeLoc Left pc => pushCoe defs ctx i ty p q val coeLoc
Right npc => pure $ Element (Coe (SY [< i] ty) p q val coeLoc) Right npc => pure $ Element (Coe (SY [< i] ty) p q val coeLoc)
(tynf `orNo` npc `orNo` notYesNo npq) (tynf `orNo` npc `orNo` notYesNo npq)
Right ty => (_, Right ty) =>
whnf defs ctx $ Ann val ty coeLoc whnf defs ctx $ Ann val ty coeLoc
whnf defs ctx (Comp ty p q val r zero one compLoc) = whnf defs ctx (Comp ty p q val r zero one compLoc) =