(*** Silly combinator tricks in SML

     Kevin Watkins
     September 2004 ***)

(*** Simple approach ***)

fun THE k x = k (fn z => x)
fun APP k f = f (fn x => fn f => f (fn y => k (fn z => x z (y z))))
fun LAM k f = f (fn x => k (fn z => fn y => x (y, z)))
fun FUN k f = f (fn x => k (fn z => fix (fn f => fn y => x (f, (y, z)))))
and fix f x = f (fix f) x
fun TOP k = k (fn (y, z) => y)
fun POP k f = f (fn x => k (fn (y, z) => x z))
fun EVAL f = f (fn x => x ())

fun plus x y = x + y
fun times x y = x * y
fun equal x y = x = y
fun ifif x y z = if x then y () else z ()

val x = EVAL APP APP LAM LAM APP APP POP TOP TOP TOP THE plus THE 42

(* guess what this is *)
val y = EVAL APP FUN APP APP APP THE ifif APP APP THE equal THE 0 POP TOP LAM THE 1 LAM APP APP THE times POP POP TOP APP POP TOP APP APP THE plus POP POP TOP THE ~1 THE 5

(*** Getting fancy ***)

fun OPEN s c k f = f (fn (y, z) => y) (fn z => fn x => x) (fn x => fn f => f (fn (y, z) => y) (fn z => c z (x z)) k)
fun CLOSE s c k = k c
fun THE s c k x f = f (fn (y, z) => y) (fn z => c z x) k
fun LAM s c k f = f (fn (y, z) => y) (fn z => fn x => x) (fn x => k (fn z => c z (fn y => x (y, z))))
fun FUN s c k f = f (fn (y, z) => y) (fn z => fn x => x) (fn x => k (fn z => c z (fix (fn f => fn y => x (f, (y, z))))))
and fix f x = f (fix f) x
fun TOP s c k f = f (fn (y, z) => y) (fn z => c z (s z)) k
fun POP s c k f = f (fn (y, z) => s z) c k
fun EVAL f = f (fn (y, z) => y) (fn z => fn x => x) (fn x => x ())

fun plus x y = x + y
fun times x y = x * y
fun equal x y = x = y
fun ifif x y z = if x then y () else z ()

val x = EVAL THE plus THE 1 THE 2 CLOSE
val y = EVAL THE plus OPEN THE plus THE 2 THE 5 CLOSE THE 10 CLOSE
val z = EVAL OPEN LAM THE plus TOP TOP CLOSE THE 3 CLOSE
val w = EVAL OPEN LAM LAM TOP POP TOP POP TOP CLOSE THE 3 THE plus CLOSE
val v = EVAL OPEN FUN THE ifif
                      OPEN THE equal THE 0 POP TOP CLOSE
                      OPEN LAM THE 1 CLOSE
                      OPEN LAM THE times POP POP TOP
                        OPEN POP TOP
                          OPEN THE plus POP POP TOP THE ~1 CLOSE
                        CLOSE
                      CLOSE
             CLOSE
             THE 5
        CLOSE

(*** Church's dot notation ***)

fun DOT s c k f = f (fn (y, z) => y) (fn z => fn x => x) (fn x => k (fn z => c z (x z)))

val v = EVAL OPEN FUN THE ifif
                      OPEN THE equal THE 0 POP TOP CLOSE
                      OPEN LAM THE 1 CLOSE
                      LAM THE times POP POP TOP
                        DOT POP TOP
                          DOT THE plus POP POP TOP THE ~1
             CLOSE
             THE 5
        CLOSE