"""
BEGIN GeneralizedFold

This handout is simultaneously written in Python and literate Haskell. Part
of it is extracted from:

http://blog.sigfpe.com/2008/02/purely-functional-recursive-types-in.html

Folds can be generalised to any recursive type, not just lists.  Note
how for lists, foldr takes two arguments besides the list: a binary
(i.e. two-argument) function and a nullary (i.e. zero-argument) function. 
Applying a foldr simply replaces the list constructors, (:) and [], with 
these functions.

Generalised folds do something similar: each constructor gives rise to 
an argument to the fold and when the fold is evaluated, with each constructor 
being replaced with the appropriate function. 

Here is an example. Consider a recursive datatype of binary trees:

> data Tree a = OutNode a | InNode a (Tree a) (Tree a)
>               deriving (Show) -- this line is included in order to display
>                               -- instances of this user-defined datatype

An instance of this datatype is:

> t =    (InNode 1
>          (OutNode 2)
>            (InNode 3
>              (OutNode 4)
>                (OutNode 5)))

To make sure you understand the preceding definition, draw on paper the
binary thus represented.

Recall how the standard foldr is used:

(i)  something to replace the binary constructor (:) with, and
(ii) something to replace the nullar constructor [] with,

the result being a function that is applied to lists. Similarly, the
new foldT (in this script, slightly different from foldT in Assignment #3)
takes two arguments:

(i)  something to replace the ternary constructor InNode with, which has
     to be a ternary function in order to respect the arity, and
(ii) something to replace the unary constructor OutNode with, which has
     to be a unary function to respect the arity,

the result being a function that can be applied to binary trees (as defined
in this script). Hence, here is the appropriate definition of foldT (for this
script, not for Assignment #3):

> foldT f g (OutNode x)      = (g x)
> foldT f g (InNode x t1 t2) =  f x (foldT f g t1) (foldT f g t2)

We can now define several useful functions on binary trees:

> sumT = foldT add3 id
>        where
>        add3 m n p = m + n + p

> productT = foldT mult3 id
>            where
>            mult3 m n p = m * n * p

> anyTrueT = foldT or3 id
>            where
>            or3 x y z = x || y || z

> allTrueT = foldT and3 id
>            where
>            and3 x y z = x && y && z

> sizeT    = foldT step one
>            where
>            step x m n = 1 + m + n
>            one x = 1

> idT = foldT InNode OutNode  -- this is just the identity function for the
>                             -- datatype (Tree a)

> flipT    = foldT step OutNode
>            where
>            step x t1 t2 = InNode x t2 t1

> isLeaf (OutNode _) = True
> isLeaf (InNode _ _ _) = False

> label (OutNode x) = x
> label (InNode x _ _) = x

> left  (InNode _ t _) = t
> right (InNode _ _ t) = t

> mapT f = foldT (InNode . f) (OutNode . f)

> preWalk = foldT step init
>           where
>           step x lst1 lst2 = [x] ++ lst1 ++ lst2
>           init x = [x]

> inWalk = foldT step init
>          where
>          step x lst1 lst2 = lst1 ++ [x] ++ lst2
>          init x = [x]

> postWalk = foldT step init
>            where
>            step x lst1 lst2 = lst1 ++ lst2 ++ [x]
>            init x = [x]

--------------
EXERCISE

There are different ways of defining binary trees, suitable for different
applications. Here are two common definitions:

> data TreeA a = LeafA a | BranchA   (TreeA a) (TreeA a)
> data TreeB a = LeafB   | BranchB a (TreeB a) (TreeB a)

Repeat the definitions of the various functions above for the datatype
(Tree a) for the datatype (TreeA a) and (TreeB a).
--------------

Here is another example of a recursive datatype. Consider a simple expression
type in Haskell:

> data Expr = X | Const Int | Binop (Int -> Int -> Int) Expr Expr

This is a recursive type so it has a generalised fold associated with
it. This fold, called 'efold' below, takes four arguments, with the first
three corresponding to:

     X     (nullary, i.e. 0-ary, constructor)
     Const (unary, i.e. 1-ary, constructor)
     Binop (ternary, i.e. 3-ary, constructor)

An argument of efold corresponding to one of these three constructors
takes the same number of arguments. Here is the definition of efold:

> efold :: a -> (Int -> a) -> ((Int -> Int -> Int) -> a -> a -> a) -> Expr -> a
> efold x _ _ X = x
> efold _ c _ (Const a) = c a
> efold x c b (Binop f lt rt) = b f (efold x c b lt) (efold x c b rt)

efold simply replaces each constructor with an application of the
matching function recursively through the entire Expr.

Anything you might want to do to an Expr can be done using efold, and
many things you might naturally want to do with an Expr are
particularly easy to write using it. Below are the functions to (1)
evaluate the expression for X equal to some Int, and (2) to determine
whether or not an expression is free of references to X:

> eval x e   = efold x id id e
> freeX e    = efold False (const True) (const (&&)) e

Some examples to try:
  eval 3 X
  eval 2 (Const 5)
  eval 6 (Binop (+) X X)
  eval 2 (Binop (+) X (Const 5))
  freeX (Binop (+) X (Const 5))

Now we can do the same thing we did above, replace the Expr structure
with its corresponding fold. We can implement it in Python rather than 
Haskell:

"""

def X():
    def _X (x,c,b):
        return x
    return _X

def Const(a):
    def _Const (x,c,b):
        return c(a)
    return _Const

def Binop (f,l,r):
    def _Binop (x,c,b):
        return b (f,l(x,c,b),r(x,c,b))
    return _Binop

def eval (x,e):
    return e (x, lambda x:x, lambda f,l,r:f(l,r))

def freeX (e):
    return e (False, lambda x:True, lambda f,l,r:l and r)

"""

So we have translated the Haskell algebraic type Expr into functional 
expressions in Python. Here are some examples of their use:

Evaluating X, 2 and X+2 at X=3:

"""

print eval (3, X())
print eval (3, Const(2))
print eval (3, Binop(lambda x,y:x+y, X(), Const(2)))

"""

Testing whether 10-2 and X()+2 are free of references to X():

"""

print freeX (Binop (lambda x,y:x-y, Const(10), Const(2)))
print freeX (Binop (lambda x,y:x+y, X(), Const(2)))

"""
END GeneralizedFold
"""