Mercurial > hg > Members > atton > delta_monad
diff agda/delta.agda @ 104:ebd0d6e2772c
Trying redenition Delta with length constraints
author | Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp> |
---|---|
date | Mon, 26 Jan 2015 23:00:05 +0900 |
parents | dfe8c67390bd |
children | e6499a50ccbd |
line wrap: on
line diff
--- a/agda/delta.agda Mon Jan 26 14:08:46 2015 +0900 +++ b/agda/delta.agda Mon Jan 26 23:00:05 2015 +0900 @@ -1,6 +1,7 @@ open import list open import basic open import nat +open import revision open import laws open import Level @@ -9,59 +10,56 @@ module delta where +data Delta {l : Level} (A : Set l) : (Rev -> (Set l)) where + mono : A -> Delta A init + delta : {v : Rev} -> A -> Delta A v -> Delta A (commit v) -data Delta {l : Level} (A : Set l) : (Set l) where - mono : A -> Delta A - delta : A -> Delta A -> Delta A - -deltaAppend : {l : Level} {A : Set l} -> Delta A -> Delta A -> Delta A +deltaAppend : {l : Level} {A : Set l} {n m : Rev} -> Delta A n -> Delta A m -> Delta A (merge n m) deltaAppend (mono x) d = delta x d deltaAppend (delta x d) ds = delta x (deltaAppend d ds) -headDelta : {l : Level} {A : Set l} -> Delta A -> A +headDelta : {l : Level} {A : Set l} {n : Rev} -> Delta A n -> A headDelta (mono x) = x headDelta (delta x _) = x -tailDelta : {l : Level} {A : Set l} -> Delta A -> Delta A -tailDelta (mono x) = mono x +tailDelta : {l : Level} {A : Set l} {n : Rev} -> Delta A (commit n) -> Delta A n tailDelta (delta _ d) = d -n-tail : {l : Level} {A : Set l} -> Nat -> ((Delta A) -> (Delta A)) -n-tail O = id -n-tail (S n) = tailDelta ∙ (n-tail n) -- Functor -delta-fmap : {l : Level} {A B : Set l} -> (A -> B) -> (Delta A) -> (Delta B) +delta-fmap : {l : Level} {A B : Set l} {n : Rev} -> (A -> B) -> (Delta A n) -> (Delta B n) delta-fmap f (mono x) = mono (f x) delta-fmap f (delta x d) = delta (f x) (delta-fmap f d) -- Monad (Category) -delta-eta : {l : Level} {A : Set l} -> A -> Delta A -delta-eta x = mono x +delta-eta : {l : Level} {A : Set l} {v : Rev} -> A -> Delta A v +delta-eta {v = init} x = mono x +delta-eta {v = commit v} x = delta x (delta-eta {v = v} x) -delta-bind : {l : Level} {A B : Set l} -> (Delta A) -> (A -> Delta B) -> Delta B -delta-bind (mono x) f = f x -delta-bind (delta x d) f = delta (headDelta (f x)) (delta-bind d (tailDelta ∙ f)) +delta-bind : {l : Level} {A B : Set l} {n : Rev} -> (Delta A n) -> (A -> Delta B n) -> Delta B n +delta-bind (mono x) f = f x +delta-bind (delta x d) f = delta (headDelta (f x)) (tailDelta (f x)) -delta-mu : {l : Level} {A : Set l} -> Delta (Delta A) -> Delta A +delta-mu : {l : Level} {A : Set l} {n : Rev} -> (Delta (Delta A n) n) -> Delta A n delta-mu d = delta-bind d id +{- -- Monad (Haskell) -delta-return : {l : Level} {A : Set l} -> A -> Delta A +delta-return : {l : Level} {A : Set l} -> A -> Delta A (S O) delta-return = delta-eta -_>>=_ : {l : Level} {A B : Set l} -> - (x : Delta A) -> (f : A -> (Delta B)) -> (Delta B) -(mono x) >>= f = f x -(delta x d) >>= f = delta (headDelta (f x)) (d >>= (tailDelta ∙ f)) +_>>=_ : {l : Level} {A B : Set l} {n : Nat} -> + (x : Delta A n) -> (f : A -> (Delta B n)) -> (Delta B n) +d >>= f = delta-bind d f +-} - +{- -- proofs -- sub-proofs @@ -122,3 +120,4 @@ delta-fmap f (n-tail n d) ≡⟨ refl ⟩ delta-fmap f (((n-tail n) ∙ tailDelta) (delta x d)) ≡⟨ cong (\t -> delta-fmap f (t (delta x d))) (n-tail-plus n) ⟩ delta-fmap f (n-tail (S n) (delta x d)) ∎ +-}