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
--- a/agda/nat.agda	Sun Jan 25 12:16:34 2015 +0900
+++ b/agda/nat.agda	Mon Jan 26 14:08:46 2015 +0900
@@ -4,7 +4,7 @@
 module nat where
 
 data Nat : Set where
-  O  : Nat
+  O : Nat
   S : Nat -> Nat
 
 _+_ : Nat -> Nat -> Nat