Task

In the Church encoding of natural numbers, the number N is encoded by a function that applies its first argument N times to its second argument.

 Church zero always returns the identity function, regardless of its first argument. In other words, the first argument is not applied to the second argument at all.
 Church one applies its first argument f just once to its second argument x, yielding f(x)
 Church two applies its first argument f twice to its second argument x, yielding f(f(x))
 and each successive Church numeral applies its first argument one additional time to its second argument, f(f(f(x))), f(f(f(f(x)))) ... The Church numeral 4, for example, returns a quadruple composition of the function supplied as its first argument.


Arithmetic operations on natural numbers can be similarly represented as functions on Church numerals.

In your language define:

 Church Zero,
 a Church successor function (a function on a Church numeral which returns the next Church numeral in the series),
 functions for Addition, Multiplication and Exponentiation over Church numerals,
 a function to convert integers to corresponding Church numerals,
 and a function to convert Church numerals to corresponding integers.


You should:

 Derive Church numerals three and four in terms of Church zero and a Church successor function.
 use Church numeral arithmetic to obtain the the sum and the product of Church 3 and Church 4,
 similarly obtain 4^3 and 3^4 in terms of Church numerals, using a Church numeral exponentiation function,
 convert each result back to an integer, and return it or print it to the console.


--------------------- CHURCH NUMERALS --------------------
 
-- churchZero :: (a -> a) -> a -> a
on churchZero(f, x)
    x
end churchZero
 
 
-- churchSucc :: ((a -> a) -> a -> a) -> (a -> a) -> a -> a
on churchSucc(n)
    script
        on |λ|(f)
            script
                property mf : mReturn(f)
                on |λ|(x)
                    mf's |λ|(mReturn(n)'s |λ|(mf)'s |λ|(x))
                end |λ|
            end script
        end |λ|
    end script
end churchSucc
 
 
-- churchFromInt(n) :: Int -> (b -> b) -> b -> b
on churchFromInt(n)
    script
        on |λ|(f)
            foldr(my compose, my |id|, replicate(n, f))
        end |λ|
    end script
end churchFromInt
 
 
-- intFromChurch :: ((Int -> Int) -> Int -> Int) -> Int
on intFromChurch(cn)
    mReturn(cn)'s |λ|(my succ)'s |λ|(0)
end intFromChurch
 
 
on churchAdd(m, n)
    script
        on |λ|(f)
            script
                property mf : mReturn(m)
                property nf : mReturn(n)
                on |λ|(x)
                    nf's |λ|(f)'s |λ|(mf's |λ|(f)'s |λ|(x))
                end |λ|
            end script
        end |λ|
    end script
end churchAdd
 
 
on churchMult(m, n)
    script
        on |λ|(f)
            script
                property mf : mReturn(m)
                property nf : mReturn(n)
                on |λ|(x)
                    mf's |λ|(nf's |λ|(f))'s |λ|(x)
                end |λ|
            end script
        end |λ|
    end script
end churchMult
 
 
on churchExp(m, n)
    n's |λ|(m)
end churchExp
 
 
--------------------------- TEST -------------------------
on run
    set cThree to churchFromInt(3)
    set cFour to churchFromInt(4)
 
    map(intFromChurch, ¬
        {churchAdd(cThree, cFour), churchMult(cThree, cFour), ¬
            churchExp(cFour, cThree), churchExp(cThree, cFour)})
end run
 
 
------------------------- GENERIC ------------------------
 
-- compose (<<<) :: (b -> c) -> (a -> b) -> a -> c
on compose(f, g)
    script
        property mf : mReturn(f)
        property mg : mReturn(g)
        on |λ|(x)
            mf's |λ|(mg's |λ|(x))
        end |λ|
    end script
end compose
 
 
-- id :: a -> a
on |id|(x)
    x
end |id|
 
 
-- foldr :: (a -> b -> b) -> b -> [a] -> b
on foldr(f, startValue, xs)
    tell mReturn(f)
        set v to startValue
        set lng to length of xs
        repeat with i from lng to 1 by -1
            set v to |λ|(item i of xs, v, i, xs)
        end repeat
        return v
    end tell
end foldr
 
 
-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
    tell mReturn(f)
        set lng to length of xs
        set lst to {}
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs, i, xs)
        end repeat
        return lst
    end tell
end map
 
 
-- Lift 2nd class handler function into 1st class script wrapper 
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
    if class of f is script then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn
 
 
-- Egyptian multiplication - progressively doubling a list, appending
-- stages of doubling to an accumulator where needed for binary 
-- assembly of a target length
-- replicate :: Int -> a -> [a]
on replicate(n, a)
    set out to {}
    if n < 1 then return out
    set dbl to {a}
 
    repeat while (n > 1)
        if (n mod 2) > 0 then set out to out & dbl
        set n to (n div 2)
        set dbl to (dbl & dbl)
    end repeat
    return out & dbl
end replicate
 
 
-- succ :: Int -> Int
on succ(x)
    1 + x
end succ