add DimEq.wf and export some things to make it work

This commit is contained in:
rhiannon morris 2023-03-25 20:50:03 +01:00
parent 5a994ac0e2
commit ab73c474c3

View file

@ -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