module Data.Vect import Language.Reflection import public Data.VectType %access public %default total -------------------------------------------------------------------------------- -- Elem -------------------------------------------------------------------------------- ||| A proof that some element is found in a vector data Elem : a -> Vect k a -> Type where Here : Elem x (x::xs) There : Elem x xs -> Elem x (y::xs) ||| Nothing can be in an empty Vect noEmptyElem : {x : a} -> Elem x [] -> Void noEmptyElem Here impossible ||| An item not in the head and not in the tail is not in the Vect at all neitherHereNorThere : {x, y : a} -> {xs : Vect n a} -> Not (x = y) -> Not (Elem x xs) -> Not (Elem x (y :: xs)) neitherHereNorThere xneqy xninxs Here = xneqy Refl neitherHereNorThere xneqy xninxs (There xinxs) = xninxs xinxs ||| A decision procedure for Elem isElem : DecEq a => (x : a) -> (xs : Vect n a) -> Dec (Elem x xs) isElem x [] = No noEmptyElem isElem x (y :: xs) with (decEq x y) isElem x (x :: xs) | (Yes Refl) = Yes Here isElem x (y :: xs) | (No xneqy) with (isElem x xs) isElem x (y :: xs) | (No xneqy) | (Yes xinxs) = Yes (There xinxs) isElem x (y :: xs) | (No xneqy) | (No xninxs) = No (neitherHereNorThere xneqy xninxs) ||| A tactic for discovering where, if anywhere, an element is in a vector ||| @ n how many elements to search before giving up findElem : (n : Nat) -> List (TTName, Binder TT) -> TT -> Tactic findElem Z ctxt goal = Refine "Here" `Seq` Solve findElem (S n) ctxt goal = GoalType "Elem" (Try (Refine "Here" `Seq` Solve) (Refine "There" `Seq` (Solve `Seq` findElem n ctxt goal))) replaceElem : (xs : Vect k t) -> Elem x xs -> (y : t) -> (ys : Vect k t ** Elem y ys) replaceElem (x::xs) Here y = (y :: xs ** Here) replaceElem (x::xs) (There xinxs) y with (replaceElem xs xinxs y) | (ys ** yinys) = (x :: ys ** There yinys) replaceByElem : (xs : Vect k t) -> Elem x xs -> t -> Vect k t replaceByElem (x::xs) Here y = y :: xs replaceByElem (x::xs) (There xinxs) y = x :: replaceByElem xs xinxs y mapElem : {xs : Vect k t} -> {f : t -> u} -> Elem x xs -> Elem (f x) (map f xs) mapElem Here = Here mapElem (There e) = There (mapElem e) -- Some convenience functions for testing lengths ||| If the given Vect is the required length, return a Vect with that ||| length in its type, otherwise return Nothing ||| @len the required length ||| @xs the vector with the desired length -- Needs to be Maybe rather than Dec, because if 'n' is unequal to m, we -- only know we don't know how to make a Vect n a, not that one can't exist. isLength : {m : Nat} -> -- expected at run-time (len : Nat) -> (xs : Vect m a) -> Maybe (Vect len a) isLength {m} len xs with (decEq m len) isLength {m = m} m xs | (Yes Refl) = Just xs isLength {m = m} len xs | (No contra) = Nothing ||| If the given Vect is at least the required length, return a Vect with ||| at least that length in its type, otherwise return Nothing ||| @len the required length ||| @xs the vector with the desired length overLength : {m : Nat} -> -- expected at run-time (len : Nat) -> (xs : Vect m a) -> Maybe (p ** Vect (plus p len) a) overLength {m} n xs with (cmp m n) overLength {m = m} (plus m (S y)) xs | (CmpLT y) = Nothing overLength {m = m} m xs | CmpEQ = Just (0 ** xs) overLength {m = plus n (S x)} n xs | (CmpGT x) = Just (S x ** rewrite plusCommutative (S x) n in xs)