Mercurial > hg > Members > atton > delta_monad
changeset 103:a271f3ff1922
Delte type dependencie in Monad record for escape implicit type conflict
| author | Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp> |
|---|---|
| date | Mon, 26 Jan 2015 14:08:46 +0900 |
| parents | 9c62373bd474 |
| children | ebd0d6e2772c |
| files | agda/delta/monad.agda agda/deltaM.agda agda/deltaM/functor.agda agda/deltaM/monad.agda agda/laws.agda agda/nat.agda |
| diffstat | 6 files changed, 49 insertions(+), 53 deletions(-) [+] |
line wrap: on
line diff
--- a/agda/delta/monad.agda Sun Jan 25 12:16:34 2015 +0900 +++ b/agda/delta/monad.agda Mon Jan 26 14:08:46 2015 +0900 @@ -322,7 +322,7 @@ delta-fmap f (delta-mu (delta (delta x d) ds)) ≡⟨ refl ⟩ (delta-fmap f ∙ delta-mu) (delta (delta x d) ds) ∎ -delta-is-monad : {l : Level} {A : Set l} -> Monad {l} {A} Delta delta-is-functor +delta-is-monad : {l : Level} -> Monad {l} Delta delta-is-functor delta-is-monad = record { eta = delta-eta; mu = delta-mu; return = delta-eta;
--- a/agda/deltaM.agda Sun Jan 25 12:16:34 2015 +0900 +++ b/agda/deltaM.agda Mon Jan 26 14:08:46 2015 +0900 @@ -13,7 +13,7 @@ data DeltaM {l : Level} (M : {l' : Level} -> Set l' -> Set l') {functorM : {l' : Level} -> Functor {l'} M} - {monadM : {l' : Level} {A : Set l'} -> Monad {l'} {A} M functorM} + {monadM : {l' : Level} {A : Set l'} -> Monad {l'} M functorM} (A : Set l) : Set l where deltaM : Delta (M A) -> DeltaM M {functorM} {monadM} A @@ -24,7 +24,7 @@ headDeltaM : {l : Level} {A : Set l} {M : {l' : Level} -> Set l' -> Set l'} {functorM : {l' : Level} -> Functor {l'} M} - {monadM : {l' : Level} {A : Set l'} -> Monad {l'} {A} M functorM} + {monadM : {l' : Level} -> Monad {l'} M functorM} -> DeltaM M {functorM} {monadM} A -> M A headDeltaM (deltaM d) = headDelta d @@ -32,7 +32,7 @@ tailDeltaM : {l : Level} {A : Set l} {M : {l' : Level} -> Set l' -> Set l'} {functorM : {l' : Level} -> Functor {l'} M} - {monadM : {l' : Level} {A : Set l'} -> Monad {l'} {A} M functorM} + {monadM : {l' : Level} -> Monad {l'} M functorM} -> DeltaM M {functorM} {monadM} A -> DeltaM M {functorM} {monadM} A tailDeltaM (deltaM d) = deltaM (tailDelta d) @@ -40,7 +40,7 @@ appendDeltaM : {l : Level} {A : Set l} {M : {l' : Level} -> Set l' -> Set l'} {functorM : {l' : Level} -> Functor {l'} M} - {monadM : {l' : Level} {A : Set l'} -> Monad {l'} {A} M functorM} + {monadM : {l' : Level} -> Monad {l'} M functorM} -> DeltaM M {functorM} {monadM} A -> DeltaM M {functorM} {monadM} A -> DeltaM M {functorM} {monadM} A appendDeltaM (deltaM d) (deltaM dd) = deltaM (deltaAppend d dd) @@ -48,7 +48,7 @@ checkOut : {l : Level} {A : Set l} {M : {l' : Level} -> Set l' -> Set l'} {functorM : {l' : Level} -> Functor {l'} M} - {monadM : {l' : Level} {A : Set l'} -> Monad {l'} {A} M functorM} + {monadM : {l' : Level} -> Monad {l'} M functorM} -> Nat -> DeltaM M {functorM} {monadM} A -> M A checkOut O (deltaM (mono x)) = x checkOut O (deltaM (delta x _)) = x @@ -62,7 +62,7 @@ deltaM-fmap : {l : Level} {A B : Set l} {M : {l' : Level} -> Set l' -> Set l'} {functorM : {l' : Level} -> Functor {l'} M} - {monadM : {l' : Level} {A : Set l'} -> Monad {l'} {A} M functorM} + {monadM : {l' : Level} -> Monad {l'} M functorM} -> (A -> B) -> DeltaM M {functorM} {monadM} A -> DeltaM M {functorM} {monadM} B deltaM-fmap {l} {A} {B} {M} {functorM} f (deltaM d) = deltaM (fmap delta-is-functor (fmap functorM f) d) @@ -70,18 +70,18 @@ open Monad deltaM-eta : {l : Level} {A : Set l} {M : {l' : Level} -> Set l' -> Set l'} {functorM : {l' : Level} -> Functor {l'} M} - {monadM : {l' : Level} {A : Set l'} -> Monad {l'} {A} M functorM} + {monadM : {l' : Level} -> Monad {l'} M functorM} -> A -> (DeltaM M {functorM} {monadM} A) -deltaM-eta {_} {A} {_} {_} {monadM} x = deltaM (mono (eta {_} {A} monadM x)) +deltaM-eta {_} {A} {_} {_} {monadM} x = deltaM (mono (eta monadM x)) deltaM-mu : {l : Level} {A : Set l} {M : {l' : Level} -> Set l' -> Set l'} {functorM : {l' : Level} -> Functor {l'} M} - {monadM : {l' : Level} {A : Set l'} -> Monad {l'} {A} M functorM} + {monadM : {l' : Level} -> Monad {l'} M functorM} -> (DeltaM M {functorM} {monadM} (DeltaM M {functorM} {monadM} A)) -> DeltaM M {functorM} {monadM} A -deltaM-mu {l} {A} {M} {functorM} {monadM} (deltaM (mono x)) = deltaM (mono (mu {l} {A} monadM (fmap functorM headDeltaM x))) -deltaM-mu {l} {A} {M} {functorM} {monadM} (deltaM (delta x (mono xx))) = appendDeltaM (deltaM (mono (bind {l} {A} monadM x headDeltaM))) +deltaM-mu {l} {A} {M} {functorM} {monadM} (deltaM (mono x)) = deltaM (mono (mu monadM (fmap functorM headDeltaM x))) +deltaM-mu {l} {A} {M} {functorM} {monadM} (deltaM (delta x (mono xx))) = appendDeltaM (deltaM (mono (bind monadM x headDeltaM))) (deltaM-mu (deltaM (mono xx))) -deltaM-mu {l} {A} {M} {functorM} {monadM} (deltaM (delta x (delta xx d))) = appendDeltaM (deltaM (mono (bind {l} {A} monadM x headDeltaM))) +deltaM-mu {l} {A} {M} {functorM} {monadM} (deltaM (delta x (delta xx d))) = appendDeltaM (deltaM (mono (bind {l} monadM x headDeltaM))) (deltaM-mu (deltaM d)) -- original deltaM-mu definitions. but it's cannot termination checking. -- manually expand nested delta for delete tailDelta in argument to recursive deltaM-mu. @@ -92,6 +92,6 @@ deltaM-bind : {l : Level} {A B : Set l} {M : {l' : Level} -> Set l' -> Set l'} {functorM : {l' : Level} -> Functor {l'} M} - {monadM : {l' : Level} {A : Set l'} -> Monad {l'} {A} M functorM} + {monadM : {l' : Level} -> Monad {l'} M functorM} -> (DeltaM M {functorM} {monadM} A) -> (A -> DeltaM M {functorM} {monadM} B) -> DeltaM M {functorM} {monadM} B deltaM-bind {l} {A} {B} {M} {functorM} {monadM} d f = deltaM-mu (deltaM-fmap f d)
--- a/agda/deltaM/functor.agda Sun Jan 25 12:16:34 2015 +0900 +++ b/agda/deltaM/functor.agda Mon Jan 26 14:08:46 2015 +0900 @@ -15,7 +15,7 @@ deltaM-preserve-id : {l : Level} {A : Set l} {M : {l' : Level} -> Set l' -> Set l'} (functorM : {l' : Level} -> Functor {l'} M) - {monadM : {l' : Level} {A : Set l'} -> Monad {l'} {A} M functorM} + {monadM : {l' : Level} -> Monad {l'} M functorM} -> (d : DeltaM M {functorM} {monadM} A) -> deltaM-fmap id d ≡ id d deltaM-preserve-id functorM (deltaM (mono x)) = begin deltaM-fmap id (deltaM (mono x)) ≡⟨ refl ⟩ @@ -45,7 +45,7 @@ deltaM-covariant : {l : Level} {A B C : Set l} -> {M : {l' : Level} -> Set l' -> Set l'} (functorM : {l' : Level} -> Functor {l'} M) - {monadM : {l' : Level} {A : Set l'} -> Monad {l'} {A} M functorM} + {monadM : {l' : Level} -> Monad {l'} M functorM} (f : B -> C) -> (g : A -> B) -> (d : DeltaM M {functorM} {monadM} A) -> (deltaM-fmap (f ∙ g)) d ≡ ((deltaM-fmap f) ∙ (deltaM-fmap g)) d deltaM-covariant functorM f g (deltaM (mono x)) = begin @@ -81,7 +81,7 @@ deltaM-is-functor : {l : Level} {M : {l' : Level} -> Set l' -> Set l'} {functorM : {l' : Level} -> Functor {l'} M } - {monadM : {l' : Level} {A : Set l'} -> Monad {l'} {A} M functorM} + {monadM : {l' : Level} -> Monad {l'} M functorM} -> Functor {l} (DeltaM M {functorM} {monadM}) deltaM-is-functor {_} {_} {functorM} = record { fmap = deltaM-fmap ; preserve-id = deltaM-preserve-id functorM ;
--- a/agda/deltaM/monad.agda Sun Jan 25 12:16:34 2015 +0900 +++ b/agda/deltaM/monad.agda Mon Jan 26 14:08:46 2015 +0900 @@ -18,7 +18,7 @@ postulate deltaM-mu-is-natural-transformation : {l : Level} {A : Set l} {M : {l' : Level} -> Set l' -> Set l'} -> {functorM : {l' : Level} -> Functor {l'} M} - {monadM : {l' : Level} {A : Set l'} -> Monad {l'} {A} M (functorM ) } -> + {monadM : {l' : Level} -> Monad {l'} M (functorM ) } -> NaturalTransformation (\A -> DeltaM M (DeltaM M A)) (\A -> DeltaM M A) {deltaM-fmap ∙ deltaM-fmap} {deltaM-fmap {l}} (deltaM-mu {_} {_} {M} {functorM} {monadM}) @@ -26,7 +26,7 @@ headDeltaM-commute : {l : Level} {A B : Set l} {M : {l' : Level} -> Set l' -> Set l'} -> {functorM : {l' : Level} -> Functor {l'} M} -> - {monadM : {l' : Level} {A : Set l'} -> Monad {l'} {A} M (functorM ) } -> + {monadM : {l' : Level} -> Monad {l'} M (functorM ) } -> (f : A -> B) -> (x : DeltaM M {functorM} {monadM} A) -> headDeltaM (deltaM-fmap f x) ≡ fmap functorM f (headDeltaM x) headDeltaM-commute f (deltaM (mono x)) = refl @@ -36,49 +36,46 @@ headDeltaM-is-natural-transformation : {l : Level} {A : Set l} {M : {l' : Level} -> Set l' -> Set l'} -> {functorM : {l' : Level} -> Functor {l'} M} - {monadM : {l' : Level} {A : Set l'} -> Monad {l'} {A} M functorM } -> + {monadM : {l' : Level} -> Monad {l'} M functorM } -> NaturalTransformation {l} (\A -> DeltaM M {functorM} {monadM} A) M {\f d → deltaM (mono (headDeltaM (deltaM-fmap f d)))} {fmap functorM} headDeltaM -- {deltaM-fmap} {fmap (functorM {l} {A})} headDeltaM headDeltaM-is-natural-transformation = record { commute = headDeltaM-commute } -headDeltaM-to-mono : {l : Level} {A : Set l} - {M : {l' : Level} -> Set l' -> Set l'} - {functorM : {l' : Level} -> Functor {l'} M} - {monadM : {l' : Level} {A : Set l'} -> Monad {l'} {A} M functorM} - -> (x : M A) -> - headDeltaM {l} {A} {M} {functorM} {monadM} (deltaM (mono x)) ≡ x -headDeltaM-to-mono x = refl - deltaM-right-unity-law : {l : Level} {A : Set l} - {M : {l' : Level} -> Set l' -> Set l'} - (functorM : {l' : Level} -> Functor {l'} M) - (monadM : {l' : Level} {A : Set l'} -> Monad {l'} {A} M functorM) - -> (d : DeltaM M {functorM} {monadM} A) -> - (deltaM-mu ∙ deltaM-eta) d ≡ id d - - - - + {M : {l' : Level} -> Set l' -> Set l'} + (functorM : {l' : Level} -> Functor {l'} M) + (monadM : {l' : Level} -> Monad {l'} M functorM) + (d : DeltaM M {functorM} {monadM} A) -> + (deltaM-mu ∙ deltaM-eta) d ≡ id d deltaM-right-unity-law {l} {A} {M} functorM monadM (deltaM (mono x)) = begin - (deltaM-mu ∙ deltaM-eta) (deltaM (mono x)) ≡⟨ refl ⟩ - deltaM-mu (deltaM-eta (deltaM (mono x))) ≡⟨ refl ⟩ + (deltaM-mu ∙ deltaM-eta) (deltaM (mono x)) ≡⟨ refl ⟩ + deltaM-mu (deltaM-eta (deltaM (mono x))) ≡⟨ refl ⟩ deltaM-mu (deltaM (mono (eta monadM (deltaM (mono x))))) ≡⟨ refl ⟩ deltaM (mono (mu monadM (fmap functorM (headDeltaM {l} {A} {M}) (eta monadM (deltaM (mono x)))))) ≡⟨ refl ⟩ deltaM (mono (mu monadM (fmap functorM (headDeltaM {l} {A} {M}) (eta monadM (deltaM (mono x)))))) ≡⟨ cong (\de -> deltaM (mono (mu monadM de))) (sym (eta-is-nt monadM headDeltaM (deltaM (mono x)))) ⟩ deltaM (mono (mu monadM (eta monadM (headDeltaM {l} {A} {M} {functorM} {monadM} (deltaM (mono x)))))) - ≡⟨ cong (\de -> deltaM (mono (mu monadM (eta monadM de)))) (headDeltaM-to-mono {l} {A} {M} {functorM} {monadM} x) ⟩ - deltaM (mono (mu monadM (eta {l} {DeltaM M A} monadM x))) - ≡⟨ {!!} ⟩ - deltaM (mono (mu monadM (eta {l} {A} monadM x))) + ≡⟨ refl ⟩ + deltaM (mono (mu monadM (eta {l} monadM x))) ≡⟨ cong (\x -> deltaM (mono x)) (sym (right-unity-law monadM x)) ⟩ - deltaM (mono x) ≡⟨ refl ⟩ + deltaM (mono x) + ≡⟨ refl ⟩ id (deltaM (mono x)) ∎ - -deltaM-right-unity-law functorM monadM (deltaM (delta x d)) = {!!} +deltaM-right-unity-law {l} {A} {M} functorM monadM (deltaM (delta x d)) = begin + (deltaM-mu ∙ deltaM-eta) (deltaM (delta x d)) ≡⟨ refl ⟩ + deltaM-mu (deltaM-eta (deltaM (delta x d))) ≡⟨ refl ⟩ + deltaM-mu (deltaM (mono (eta monadM (deltaM (delta x d))))) ≡⟨ refl ⟩ + deltaM (mono (mu monadM (fmap functorM headDeltaM (eta monadM (deltaM (delta x d)))))) + ≡⟨ cong (\de -> deltaM (mono (mu monadM de))) (sym (eta-is-nt monadM headDeltaM (deltaM (delta x d)))) ⟩ + deltaM (mono (mu monadM (eta monadM (headDeltaM (deltaM (delta x d)))))) + ≡⟨ refl ⟩ + deltaM (mono (mu monadM (eta monadM x))) + ≡⟨ {!!} ⟩ + id (deltaM (delta x d)) + ∎ {-
--- a/agda/laws.agda Sun Jan 25 12:16:34 2015 +0900 +++ b/agda/laws.agda Mon Jan 26 14:08:46 2015 +0900 @@ -29,8 +29,7 @@ -- simple Monad definition. without NaturalTransformation (mu, eta) and monad-law with f. -record Monad {l : Level} {A : Set l} - (M : {ll : Level} -> Set ll -> Set ll) +record Monad {l : Level} (M : {ll : Level} -> Set ll -> Set ll) (functorM : Functor {l} M) : Set (suc l) where field -- category @@ -40,11 +39,11 @@ return : {A : Set l} -> A -> M A bind : {A B : Set l} -> M A -> (A -> (M B)) -> M B field -- category laws - association-law : (x : (M (M (M A)))) -> (mu ∙ (fmap functorM mu)) x ≡ (mu ∙ mu) x - left-unity-law : (x : M A) -> (mu ∙ (fmap functorM eta)) x ≡ id x - right-unity-law : (x : M A) -> id x ≡ (mu ∙ eta) x + association-law : {A : Set l} -> (x : (M (M (M A)))) -> (mu ∙ (fmap functorM mu)) x ≡ (mu ∙ mu) x + left-unity-law : {A : Set l} -> (x : M A) -> (mu ∙ (fmap functorM eta)) x ≡ id x + right-unity-law : {A : Set l} -> (x : M A) -> id x ≡ (mu ∙ eta) x field -- natural transformations - eta-is-nt : {B : Set l} -> (f : A -> B) -> (x : A) -> (eta ∙ f) x ≡ fmap functorM f (eta x) + eta-is-nt : {A B : Set l} -> (f : A -> B) -> (x : A) -> (eta ∙ f) x ≡ fmap functorM f (eta x) open Monad \ No newline at end of file