fun with functions and application

namespace path {::tcl::mathop ::tcl::unsupported}

puts [apply {f {list apply $f $f}} {f {list apply $f $f}}]

# Lambda is defined as constructing an invocation of [apply]

interp alias {} lambda {} apply {args {list apply $args}}

# The I combinator simply returns its argument

interp alias {} I {} return -level 0

# The U combinator passes a function as an argument to itself.

proc U {f args} {tailcall {*}$f $f {*}$args}

# recursive factorial

puts [U [lambda {f x} {
    if {$x == 0} {
	I 1
    } else {
	* $x [U $f [- $x 1]]
    }
}] 6]

# iterative factorial

puts [U [lambda {f x {y 1}} {
    if {$x == 0} {
	I $y
    } else {
	tailcall U $f [- $x 1] [* $y $x]
    }
}] 6]

# fold a lambda!

puts [U [lambda {foldl base op list} {
    if {[llength $list] == 0} {
	I $base
    } else {
	tailcall U $foldl \
	    [{*}$op $base [lindex $list 0]] \
	    $op \
	    [lrange $list 1 end]
    }
}] \
	  {0 1} \
	  [lambda {p q} {
	      list [+ [lindex $p 0] $q] \
		  [* [lindex $p 1] $q]}] \
	  {1 2 3 4 5}]

# fold - left associative

proc foldl {base op list} {
    if {[llength $list] == 0} {
	I $base
    } else {
	tailcall foldl [{*}$op $base [lindex $list 0]] $op [lrange $list 1 end]
    }
}
puts [foldl 0 + {1 2 3 4 5}]
puts [foldl 0 [lambda {x y} {+ $x $y}] {1 2 3 4 5}]

proc fact3 {n c} {
    if {$n == 0} {
	{*}$c 1
    } else {
	tailcall fact3 [- $n 1] \
	    [list apply {{n c f} {
		puts [list continuation $c will get the product of $n and $f]
		{*}$c [* $n $f]
	    }} $n $c]
    }
}
fact3 6 puts