--<Pre>

f x = (x,x)

g x = let f = \ y -> (x,y)
          w1 = f "z"
          w2 = f True
      in (x,f)
      
{- 
-- The next two examples cause errors

g x = (\ f -> let w1 = f "z"
                  w2 = f True
              in (x,f))
      (x,f)

h f x = let w1 = f "z"
            w2 = f True
        in (w1,w2)
-}

h :: (forall a . a -> a) -> x -> (x,Bool)
h f x = let w1 = f x
            w2 = f True
        in (w1,w2)
        
{-        
ex2 = (4,h)        
(line 28): Use of h requires at least 1 argument                

ex3 = h ( \ x -> 1) 5
ERROR (line 33): Cannot justify constraints in application
*** Expression    : \x -> 1
*** Type          : b -> b
*** Given context : ()
*** Constraints   : Num b
-}

ex4 = h id 5


--- Data Constructors and rank 2 polymorhism

data Test x = C (forall a . a -> x -> (a,x)) x

ex5 = C (\ a x -> (a,x+1)) 3

ex6 = C (\ a x -> (a,not x)) True

f3 (C h n) w = h "z" w

------ Church numerals

data Nat = Z | S Nat

cataNat zobj sfun Z = zobj
cataNat zobj sfun (S x) = 
        sfun (cataNat zobj sfun x)

plus x y = cataNat y S x
ex7 = plus (S Z) (S (S Z))

times x = cataNat Z (plus x)
one = S Z
two = S one
three = S two
ex8 = times two three

----------------------------------------
data N = N (forall z . z -> (z -> z) -> z)

cataN zobj sfun (N f) = f zobj sfun

n0 = N(\ z s -> z)
n1 = N(\ z s -> s z)
n2 = N(\ z s -> s(s z))
n3 = N(\ z s -> s(s(s z)))
n4 = N(\ z s -> s(s(s(s z))))

n2Int n = cataN 0 (+1) n
ex9 = n2Int n3

--plus x y = cataNat y S x
succN (N f) = N(\ z s -> s(f z s))
plusN x y = cataN y succN x

ex10 = n2Int (plusN n2 n3)

----------------------------------------------------
-- Rank 2 polymorphism
data L1 a = L1 (forall b . b -> (a -> b -> b) -> b)

-- [1,2,3,4] 
ex1 = L1 ( \ n  c -> c 1 (c 2 (c 3 (c 4 n))))

toList (L1 f) = f [] (:)

ex11 = toList ex1

cataList nobj cfun [] = nobj
cataList nobj cfun (x:xs) = 
         cfun x (cataList nobj cfun)

cataL nobj cfun (L1 f) = f nobj cfun

cons x (L1 f) = L1(\ n c -> c x (f n c))

app x y = cataL y cons x

ex12 = app ex1 ex1
ex13 = toList ex12


build :: (forall b . b -> (a -> b -> b) -> b) -> [a]
build f = f [] (:)

cata nobj cfun [] = nobj
cata nobj cfun (x:xs) = cfun x (cata nobj cfun xs)

upto x = 
 build(\ n c ->
         let h m = if m>x 
                      then n 
                      else c m (h (m+1))
         in h 1)
         
mapX f x = 
  build(\ n c -> cata n (\ y ys -> c (f y) ys) x)
  
sumX xs = cata 0 (+) xs  

{-
sum(map (+1) (upto 3))
sum(map (+1) 
      (build(\ n c ->
               let h m = if m>3
                         then n 
                         else c m (h (m+1))
               in h 1)
sum(build(\ n c -> 
            cata n (\ y ys -> c (f y) ys)
                 (build(\ n c ->
                          let h m = if m>3
                                       then n 
                                       else c m (h (m+1))
                          in h 1)))
sum(build(\ n c ->
            let h m = if m>3
                         then n
                         else c (f m) (h (m+1))))
cata 0 (+)
     (build(\ n c ->
              let h m = if m>3
                           then n
                           else c (f m) (h (m+1))))
let h m = if m>3
             then 0
             else (f m) + (h (m+1))
                          
-}

data List a 
  = Nil
  | Cons a (List a)
  | Build (forall b . b -> (a -> b -> b) -> b)
  
cataZ nobj cfun Nil = nobj
cataZ nobj cfun (Cons y ys) = cfun y (cataZ nobj cfun ys)
cataZ nobj cfun (Build f) = f nobj cfun
  
uptoZ x = 
 Build(\ n c ->
         let h m = if m>x 
                      then n 
                      else c m (h (m+1))
         in h 1)
         
mapZ f x = 
  Build(\ n c -> cataZ n (\ y ys -> c (f y) ys) x)
  
sumZ xs = cataZ 0 (+) xs   

ex14 = sumZ(mapZ (+1) (uptoZ 3))
ex15 = sum(map (+1) ([1..3]))

{-
Main> ex14
9
(81 reductions, 177 cells)
Main> ex15
9
(111 reductions, 197 cells)
-}
--</Pre>