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

index Var.Compare by compare

Browse source 
i may go back on this if it's too annoying
This commit is contained in:
rhiannon morris 2023-01-10 00:08:47 +01:00
parent f405aeb7f9
commit ef8b8b0da3
2 changed files with 17 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
lib/Quox/Syntax/DimEq.idr
View file

@ -104,10 +104,10 @@ mutual
export %inline
setVar : (i, j : Var d) -> DimEq' d -> DimEq d
setVar i j eqs = case compareP i j of
IsLT lt => setVar' i j lt eqs
IsEQ => C eqs
IsGT gt => setVar' j i gt eqs
setVar i j eqs with (compareP i j) | (compare i.nat j.nat)
setVar i j eqs | IsLT lt | LT = setVar' i j lt eqs
setVar i i eqs | IsEQ | EQ = C eqs
setVar i j eqs | IsGT gt | GT = setVar' j i gt eqs
export %inline
@ -166,7 +166,10 @@ export
setSelf p ZeroIsOne = Refl
setSelf (K Zero) (C eqs) = Refl
setSelf (K One) (C eqs) = Refl
setSelf (B i) (C eqs) = rewrite comparePSelf i in Refl
setSelf (B i) (C eqs) with (compareP i i) | (compare i.nat i.nat)
_ | IsLT lt | LT = absurd lt
_ | IsEQ | EQ = Refl
_ | IsGT gt | GT = absurd gt
-- [todo] "well formed" dimeqs

18
lib/Quox/Syntax/Var.idr
View file

@ -172,34 +172,34 @@ isLT (VS i) (VS j) with (isLT i j)
public export
data Compare : (i, j : Var n) -> Type where
IsLT : (lt : i `LT` j) -> Compare i j
IsEQ : Compare i i
IsGT : (gt : i `GT` j) -> Compare i j
data Compare : (i, j : Var n) -> Ordering -> Type where
IsLT : (lt : i `LT` j) -> Compare i j LT
IsEQ : Compare i i EQ
IsGT : (gt : i `GT` j) -> Compare i j GT
%name Compare cmp
export
compareS : Compare i j -> Compare (VS i) (VS j)
compareS : Compare i j o -> Compare (VS i) (VS j) o
compareS (IsLT lt) = IsLT (LTS lt)
compareS IsEQ = IsEQ
compareS (IsGT gt) = IsGT (LTS gt)
export
compareP : (i, j : Var n) -> Compare i j
compareP : (i, j : Var n) -> Compare i j (compare i j)
compareP VZ VZ = IsEQ
compareP VZ (VS j) = IsLT LTZ
compareP (VS i) VZ = IsGT LTZ
compareP (VS i) (VS j) = compareS $ compareP i j
export
0 compareSelf : (c : Compare i i) -> c = IsEQ
0 compareSelf : Compare i i o -> o = EQ
compareSelf (IsLT lt) = absurd lt
compareSelf IsEQ = Refl
compareSelf (IsGT gt) = absurd gt
export
0 comparePSelf : (i : Var n) -> compareP i i = IsEQ
comparePSelf i = compareSelf {}
0 comparePSelf : (i : Var n) -> Compare i i EQ
comparePSelf i = rewrite sym $ compareNatDiag i.nat in compareP i i
public export