cubical-0.2.0: examples/curry.cub

module curry where

import swap

curry : (A B C:U) -> ((and A B) -> C) -> A -> B -> C
curry A B C f a b = f (a,b)

uncurry : (A B C:U) -> (A -> B -> C) -> (and A B) -> C
uncurry A B C g z = g z.1 z.2

eqCurry : (A B C : U) -> Id U ((and A B) -> C) (A -> B -> C)
eqCurry A B C =
 isEquivEq T V (curry A B C) (gradLemma T V (curry A B C) (uncurry A B C) (refl V) (refl T))
  where
   T:U
   T = (and A B) -> C
   V : U
   V = A -> B -> C

typFst : U
typFst = (X Y:U) -> (and X Y) -> X

typFst1 : U
typFst1 = (X Y:U) -> X -> Y -> X

eqTest : Id U typFst typFst1
eqTest = eqPi U  (\ X -> Pi U (\ Y -> (and X Y) -> X)) (\ X -> Pi U (\ Y -> X -> Y -> X)) rem
 where
  rem : (X:U) -> Id U (Pi U (\ Y -> (and X Y) -> X)) (Pi U (\ Y -> X -> Y -> X))
  rem X = eqPi U (\ Y -> (and X Y) -> X) (\ Y -> X -> Y -> X) rem1
    where
     rem1 : (Y:U) -> Id U ((and X Y) -> X) (X -> Y -> X)
     rem1 Y = eqCurry X Y X

eqTestInv : Id U typFst1 typFst
eqTestInv = inv U  ((X Y:U) -> (and X Y) -> X) ((X Y:U) -> X -> Y -> X) eqTest

test : N
test =
 transport typFst typFst1
  eqTest (\ X Y z -> z.1) N Bool zero true

test1 : N
test1 =
 transport typFst typFst1
  eqTest (\ X Y z -> z.1) N Bool (suc zero) false

test2 : N
test2 =
 transport typFst1 typFst
  eqTestInv (\ X Y a b -> a) N Bool (zero,true)

-- more test for the equality in U

eqTest2 : Id U typFst typFst
eqTest2 = comp U typFst typFst1 typFst eqTest eqTestInv

eqTest3 : Id U typFst typFst1
eqTest3 = comp U typFst typFst typFst1 eqTest2 eqTest

eqTest4 : Id U typFst typFst
eqTest4 = comp U typFst typFst1 typFst eqTest3 (inv U typFst typFst1 eqTest3)

test4 : N
test4 =
 transport typFst typFst
  eqTest2 (\ X Y z -> z.1) N Bool (suc zero,false)

test5 : N
test5 =
 transport typFst typFst1
  eqTest3 (\ X Y z -> z.1) N Bool (suc zero) false

test6 : N
test6 =
 transport typFst typFst
  eqTest4 (\ X Y z -> z.1) N Bool (suc zero,false)