if 0 {Richard Suchenwirth 2004-12-04 - John Backus turned 80 these days. For creating FORTRAN and the BNF style of language description, he received the ACM Turing Award in 1977. In his Turing Award lecture,
''Can Programming Be Liberated from the von Neumann Style? A Functional Style and Its Algebra of Programs. (Comm. ACM 21.8, Aug. 1978, 613- 641)''
he developed an amazing framework for functional programming, from theoretical foundations to implementation hints, e.g. for installation, user privileges, and system self-protection. In a nutshell, his FP system comprises
I'm far from having digested it all, but like so often, interesting reading prompts me to do Tcl experiments, especially on weekends. I started with Backus' first Functional Program example,
Def Innerproduct = (Insert +) o (ApplyToAll x) o Transpose
and wanted to bring it to life - slightly adapted to Tcl style, especially by replacing the infix operator "o" with a Polish prefix style:
Def Innerproduct = {o {Insert +} {ApplyToAll *} Transpose}Unlike procs or lambdas, more like APL or RPN, this definition needs no variables - it declares (from right to left) what to do with the input; the result of each step is the input for the next step (to the left of it). In an RPN language, the example might look like this:
/Innerproduct {Transpose * swap ApplyToAll + swap Insert} defwhich has the advantage that execution goes from left to right, but requires some stack awareness (and some swaps to set the stack right ;^)
Implementing Def, I took an easy route by just creating a proc that adds an argument and leaves it to the "functional" to do the right thing (with some quoting heaven :-) }
proc Def {name = functional} {
proc $name x "\[$functional\] \$x"
}if 0 {For functional composition, where, say for two functions f and g,
[{o f g} $x] == [f [g $x]]again a proc is created that does the bracket nesting: }
proc o args {
set body return
foreach f $args {append body " \[$f"}
set name [info level 0]
proc $name x "$body \$x [string repeat \] [llength $args]]"
set name
}if 0 {Why Backus used Transpose on the input, wasn't first clear to me, but as he (like we Tclers) represents a matrix as a list of rows, which are again lists (also known as vectors), it later made much sense to me. This code for transposing a matrix uses the fact that variable names can be any string, including those that look like integers, so the column contents are collected into variables named 0 1 2 ... and finally turned into the result list: }
proc Transpose matrix {
set cols [iota [llength [lindex $matrix 0]]]
foreach row $matrix {
foreach element $row col $cols {
lappend $col $element
}
}
set res {}
foreach col $cols {lappend res [set $col]}
set res
}if 0 {An integer range generator produces the variable names, e.g
iota 3 => {0 1 2}}
proc iota n {
set res {}
for {set i 0} {$i<$n} {incr i} {lappend res $i}
set res
}#-- This "functional form" is mostly called map in more recent FP:
proc ApplyToAll {f list} {
set res {}
foreach element $list {lappend res [$f $element]}
set res
}if 0 {...and Insert is better known as fold, I suppose. My oversimple implementation assumes that the operator is one that expr understands:}
proc Insert {op arguments} {expr [join $arguments $op]}#-- Prefix multiplication comes as a special case of this:
interp alias {} * {} Insert *#-- Now to try out the whole thing:
Def Innerproduct = {o {Insert +} {ApplyToAll *} Transpose}
puts [Innerproduct {{1 2 3} {6 5 4}}]if 0 { which returns 28 just as Dr. Backus ordered (= 1*6 + 2*5 + 3*4). Ah, the joys of weekend Tcl'ing... - and belatedly, Happy Birthday, John! :)
Another example, cooked up by myself this time, computes the average of a list. For this we need to implement the construction operator, which is sort of inverse mapping - while mapping a function over a sequence of inputs produces a sequence of outputs of that function applied to each input, Backus' construction maps a sequence of functions over one input to produce a sequence of results of each function to that input, e.g.
[f,g](x) == <f(x),g(x)>
Of course I can't use circumfix brackets as operator name, so let's call it constr: }
proc constr args {
set functions [lrange $args 0 end-1]
set x [lindex $args end]
set res {}
foreach f $functions {lappend res [eval $f [list $x]]}
set res
}#-- Testing:
Def mean = {o {Insert /} {constr {Insert +} llength}}
puts [mean {1 2 3 4 5}]if 0 {which returns correctly 3. However, as integer division takes place, it would be better to make that}
proc double x {expr {double($x)}}
Def mean = {o {Insert /} {constr {Insert +} dlength}}
Def dlength = {o double llength}
puts [mean {1 2 3 4}]if 0 {giving the correct result 2.5. However, the auxiliary definition for dlength cannot be inlined into the definition of mean - so this needs more work... - One more experiment, just to get the feel: }
Def hypot = {o sqrt {Insert +} {ApplyToAll square}}
Def square = {o {Insert *} {constr id id}}
proc sqrt x {expr {sqrt($x)}}
proc id x {set x}
puts [hypot {3 4}]if 0 {which gives 5.0. Compared to an RPN language, hypot would be
/hypot {dup * swap dup * + sqrt} defwhich is shorter and simpler, but meddles more directly with the stack.
An important functional form is the conditional, which at Backus looks like
p1 -> f; p2 -> g; h
meaning, translated to Tcl,
if {[p1 $x]} then {f $x} elseif {[p2 $x]} then {g $x} else {h $x}Let's try that, rewritten Polish-ly to:
cond p1 f p2 g h
}
proc cond args {
set body ""
foreach {condition function} [lrange $args 0 end-1] {
append body "if {\[$condition \$x\]} {$function \$x} else"
}
append body " {[lindex $args end] \$x}"
set name [info level 0]
proc $name x $body
set name
}#-- Testing, with K in another role as Konstant function :)
Def abs = {cond {> 0} -- id}
proc > {a b} {expr {$a>$b}}
proc < {a b} {expr {$a<$b}}
proc -- x {expr -$x}
puts [abs -42],[abs 0],[abs 42]
Def sgn = {cond {< 0} {K 1} {> 0} {K -1} {K 0}}
proc K {a b} {set a}
puts [sgn 42]/[sgn 0]/[sgn -42]if 0 {
Category Functional Programming | Arts and crafts of Tcl-Tk programming }