add DimEq.wf and export some things to make it work
This commit is contained in:
parent
5a994ac0e2
commit
ab73c474c3
1 changed files with 27 additions and 14 deletions
|
@ -72,39 +72,39 @@ fromGround : Context' DimConst d -> DimEq d
|
||||||
fromGround = C . fromGround'
|
fromGround = C . fromGround'
|
||||||
|
|
||||||
|
|
||||||
export %inline
|
public export %inline
|
||||||
zeroEq : DimEq 0
|
zeroEq : DimEq 0
|
||||||
zeroEq = C [<]
|
zeroEq = C [<]
|
||||||
|
|
||||||
export %inline
|
public export %inline
|
||||||
new' : {d : Nat} -> DimEq' d
|
new' : {d : Nat} -> DimEq' d
|
||||||
new' {d = 0} = [<]
|
new' {d = 0} = [<]
|
||||||
new' {d = S d} = new' :< Nothing
|
new' {d = S d} = new' :< Nothing
|
||||||
|
|
||||||
export %inline
|
public export %inline
|
||||||
new : {d : Nat} -> DimEq d
|
new : {d : Nat} -> DimEq d
|
||||||
new = C new'
|
new = C new'
|
||||||
|
|
||||||
|
|
||||||
private %inline
|
public export %inline
|
||||||
shiftMay : Maybe (Dim from) -> Shift from to -> Maybe (Dim to)
|
|
||||||
shiftMay p by = map (// by) p
|
|
||||||
|
|
||||||
export %inline
|
|
||||||
get' : DimEq' d -> Var d -> Maybe (Dim d)
|
get' : DimEq' d -> Var d -> Maybe (Dim d)
|
||||||
get' = getWith shiftMay
|
get' = getWith $ \p, by => map (// by) p
|
||||||
|
|
||||||
private %inline
|
public export %inline
|
||||||
|
getVar : DimEq' d -> Var d -> Dim d
|
||||||
|
getVar eqs i = fromMaybe (B i) $ get' eqs i
|
||||||
|
|
||||||
|
public export %inline
|
||||||
getShift' : Shift len out -> DimEq' len -> Var len -> Maybe (Dim out)
|
getShift' : Shift len out -> DimEq' len -> Var len -> Maybe (Dim out)
|
||||||
getShift' = getShiftWith shiftMay
|
getShift' = getShiftWith $ \p, by => map (// by) p
|
||||||
|
|
||||||
export %inline
|
public export %inline
|
||||||
get : DimEq' d -> Dim d -> Dim d
|
get : DimEq' d -> Dim d -> Dim d
|
||||||
get _ (K e) = K e
|
get _ (K e) = K e
|
||||||
get eqs (B i) = fromMaybe (B i) $ get' eqs i
|
get eqs (B i) = getVar eqs i
|
||||||
|
|
||||||
|
|
||||||
export %inline
|
public export %inline
|
||||||
equal : DimEq d -> (p, q : Dim d) -> Bool
|
equal : DimEq d -> (p, q : Dim d) -> Bool
|
||||||
equal ZeroIsOne p q = True
|
equal ZeroIsOne p q = True
|
||||||
equal (C eqs) p q = get eqs p == get eqs q
|
equal (C eqs) p q = get eqs p == get eqs q
|
||||||
|
@ -216,6 +216,19 @@ setSelf (B i) (C eqs) with (compareP i i) | (compare i.nat i.nat)
|
||||||
_ | IsGT gt | GT = absurd gt
|
_ | IsGT gt | GT = absurd gt
|
||||||
|
|
||||||
|
|
||||||
|
public export
|
||||||
|
wf' : DimEq' d -> Bool
|
||||||
|
wf' [<] = True
|
||||||
|
wf' (eqs :< Nothing) = wf' eqs
|
||||||
|
wf' (eqs :< Just (K e)) = wf' eqs
|
||||||
|
wf' (eqs :< Just (B i)) = isNothing (get' eqs i) && wf' eqs
|
||||||
|
|
||||||
|
public export
|
||||||
|
wf : DimEq d -> Bool
|
||||||
|
wf ZeroIsOne = True
|
||||||
|
wf (C eqs) = wf' eqs
|
||||||
|
|
||||||
|
|
||||||
-- [todo] "well formed" dimeqs
|
-- [todo] "well formed" dimeqs
|
||||||
-- [todo] operations maintain well-formedness
|
-- [todo] operations maintain well-formedness
|
||||||
-- [todo] if 'Wf eqs' then 'equal eqs' is an equivalence
|
-- [todo] if 'Wf eqs' then 'equal eqs' is an equivalence
|
||||||
|
|
Loading…
Reference in a new issue