Mercurial > hg > Members > atton > agda-proofs
diff cbc/product.agda @ 26:d503a73186ce
Split cbc type definition using product
author | atton <atton@cr.ie.u-ryukyu.ac.jp> |
---|---|
date | Fri, 23 Dec 2016 02:50:03 +0000 |
parents | |
children | 892f8b3aa57e |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/cbc/product.agda Fri Dec 23 02:50:03 2016 +0000 @@ -0,0 +1,59 @@ +module product where + +open import Data.String +open import Data.Product +open import Data.Nat +open import Function using (_∘_ ; id) +open import Data.Unit + +data CodeSegment (I O : Set) : Set₁ where + cs : (I -> O) -> CodeSegment I O + + +twiceWithName : (String × ℕ ) -> (String × ℕ ) +twiceWithName (s , n) = s , twice n + where + twice : ℕ -> ℕ + twice zero = zero + twice (ℕ.suc n₁) = (ℕ.suc (ℕ.suc (twice n₁))) + +csDouble : CodeSegment (String × ℕ) (String × ℕ) +csDouble = cs twiceWithName + + +ods : {I O : Set} -> CodeSegment I O -> Set +ods {i} {o} c = o + +ods-double : ods csDouble +ods-double = "hoge" , zero + + +ids : {I O : Set} -> CodeSegment I O -> Set +ids {i} {o} c = i + +ids-double : ids csDouble +ids-double = "fuga" , 3 + +--ids-double : {A : Set} {a : A} -> ids csDouble +--ids-double {_} {a} = \(s : String) -> \(n : ℕ) -> a + + + +executeCS : {A B : Set} -> CodeSegment A B -> (A -> B) +executeCS (cs b) = b + + + +infixr 30 _◎_ +_◎_ : {A B C : Set} -> CodeSegment A B -> CodeSegment B C -> CodeSegment A C +(cs b1) ◎ (cs b2) = cs (b2 ∘ b1) + + + + +◎-double : CodeSegment (String × ℕ) (String × ℕ ) +--◎-double = csDouble ◎ csDouble ◎ csDouble -- ok +◎-double = csDouble ◎ (cs (\s -> tt)) ◎ (cs (\t -> ("yo" , 100))) -- ok +--◎-double = csDouble ◎ (cs (\s -> tt)) ◎ csDouble -- ng (valid type check) + +