# HG changeset patch # User Yasutaka Higa # Date 1412662157 -32400 # Node ID e0ba1bf564ddc2508712d4bc5d84de2483d6aa09 # Parent 6e6d646d7722f4e2c2fa787e3885961c652a168f Apply level to some functions diff -r 6e6d646d7722 -r e0ba1bf564dd agda/basic.agda --- a/agda/basic.agda Tue Oct 07 14:55:40 2014 +0900 +++ b/agda/basic.agda Tue Oct 07 15:09:17 2014 +0900 @@ -1,10 +1,12 @@ +open import Level + module basic where -id : {A : Set} -> A -> A +id : {l : Level} {A : Set} -> A -> A id x = x -_∙_ : {A B C : Set} -> (A -> B) -> (B -> C) -> (A -> C) -f ∙ g = \x -> g (f x) +_∙_ : {l ll lll : Level} {A : Set l} {B : Set ll} {C : Set lll} -> (B -> C) -> (A -> B) -> (A -> C) +f ∙ g = \x -> f (g x) postulate String : Set postulate show : {A : Set} -> A -> String \ No newline at end of file diff -r 6e6d646d7722 -r e0ba1bf564dd agda/similar.agda --- a/agda/similar.agda Tue Oct 07 14:55:40 2014 +0900 +++ b/agda/similar.agda Tue Oct 07 15:09:17 2014 +0900 @@ -1,17 +1,19 @@ open import list open import basic + +open import Level open import Relation.Binary.PropositionalEquality open ≡-Reasoning module similar where -data Similar (A : Set) : Set where +data Similar {l : Level} (A : Set l) : (Set (suc l)) where similar : List String -> A -> List String -> A -> Similar A -fmap : {A B : Set} -> (A -> B) -> (Similar A) -> (Similar B) +fmap : {l ll : Level} {A : Set l} {B : Set ll} -> (A -> B) -> (Similar A) -> (Similar B) fmap f (similar xs x ys y) = similar xs (f x) ys (f y) -mu : {A : Set} -> Similar (Similar A) -> Similar A +mu : {l : Level} {A : Set l} -> Similar (Similar A) -> Similar A mu (similar lx (similar llx x _ _) ly (similar _ _ lly y)) = similar (lx ++ llx) x (ly ++ lly) y return : {A : Set} -> A -> Similar A @@ -23,10 +25,23 @@ returnSS : {A : Set} -> A -> A -> Similar A returnSS x y = similar [[ (show x) ]] x [[ (show y) ]] y +--monad-law-1 : mu ∙ (fmap mu) ≡ mu ∙ mu -monad-law-1 : mu ∙ (fmap mu) ≡ mu ∙ mu -monad-law-1 = {!!} +monad-law-1 : {l : Level} {A : Set l} -> (s : Similar (Similar (Similar A))) -> ((mu ∙ (fmap mu)) s) ≡ ((mu ∙ mu) s) +monad-law-1 s = begin + ((mu ∙ (fmap mu)) s) + ≡⟨⟩ + mu (fmap mu s) + ≡⟨ {!!} ⟩ + mu (mu s) + ≡⟨⟩ + ((mu ∙ mu) s) + ∎ + + + +{- --monad-law-2 : mu ∙ fmap return ≡ mu ∙ return ≡id monad-law-2-1 : mu ∙ fmap return ≡ mu ∙ return monad-law-2-1 = {!!} @@ -35,7 +50,8 @@ monad-law-2-2 = {!!} monad-law-3 : ∀{f} -> return ∙ f ≡ fmap f ∙ return -monad-law-3 = {!!} +monad-law-3 = {!!} monad-law-4 : ∀{f} -> mu ∙ fmap (fmap f) ≡ fmap f ∙ mu -monad-law-4 = {!!} +monad-law-4 = {!!} +-}