{-# Language RankNTypes #-}
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
n2String n = cataN "Z" (\ x -> "(S "++x++")") 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)
-}
--