Man or boy test
| This page uses content from Wikipedia. The original article was at Man or boy test. The list of authors can be seen in the page history. As with Rosetta Code, the text of Wikipedia is available under the GNU FDL. (See links for details on variance) |
You are encouraged to solve this task according to the task description, using any language you may know.
Background: The man or boy test was proposed by computer scientist Donald Knuth as a means of evaluating implementations of the ALGOL 60 programming language. The aim of the test was to distinguish compilers that correctly implemented "recursion and non-local references" from those that did not.
I have written the following simple routine, which may separate the 'man-compilers' from the 'boy-compilers'
— Donald Knuth
Task: Imitate Knuth's example in Algol 60 in another language, as far as possible.
Details: Local variables of routines are often kept in activation records (also call frames). In many languages, these records are kept on a call stack. In Algol (and e.g. in Smalltalk), they are allocated on a heap instead. Hence it is possible to pass references to routines that still can use and update variables from their call environment, even if the routine where those variables are declared already returned. This difference in implementations is sometimes called the Funarg Problem.
In Knuth's example, each call to A allocates an activation record for the variable A. When B is called from A, any access to k now refers to this activation record. Now B in turn calls A, but passes itself as an argument. This argument remains bound to the activation record. This call to A also "shifts" the variables xi by one place, so eventually the argument B (still bound to it's particular activation record) will appear as x4 or x5 in a call to A. If this happens when the expression x4 + x5 is evaluated, then this will again call B, which in turn will update k in the activation record it was originally bound to. As this activation record is shared with other instances of calls to A and B, it will influence the whole computation.
So all the example does is to set up a convoluted calling structure, where updates to k can influence the behavior in completely different parts of the call tree.
Knuth used this to test the correctness of the compiler, but one can of course also use it to test that other languages can emulate the Algol behavior correctly. If the handling of activation records is correct, the computed value will be −67.
Ada
<lang ada> with Ada.Text_IO; use Ada.Text_IO;
procedure Man_Or_Boy is
function Zero return Integer is begin return 0; end Zero; function One return Integer is begin return 1; end One; function Neg return Integer is begin return -1; end Neg;
function A
( K : Integer;
X1, X2, X3, X4, X5 : access function return Integer
) return Integer is
M : Integer := K; -- K is read-only in Ada. Here is a mutable copy of
function B return Integer is
begin
M := M - 1;
return A (M, B'Access, X1, X2, X3, X4);
end B;
begin
if M <= 0 then
return X4.all + X5.all;
else
return B;
end if;
end A;
begin
Put_Line
( Integer'Image
( A
( 10,
One'Access, -- Returns 1
Neg'Access, -- Returns -1
Neg'Access, -- Returns -1
One'Access, -- Returns 1
Zero'Access -- Returns 0
) ) );
end Man_Or_Boy; </lang> Sample output:
-67
ALGOL 60 - Knuth's example
begin
real procedure A (k, x1, x2, x3, x4, x5);
value k; integer k;
begin
real procedure B;
begin k:= k - 1;
B:= A := A (k, B, x1, x2, x3, x4);
end;
if k <= 0 then A:= x4 + x5 else B;
end;
outreal (A (10, 1, -1, -1, 1, 0));
end;
This creates a tree of B call frames that refer to each other and to the containing A call frames, each of which has its own copy of k that changes every time the associated B is called. Trying to work it through on paper is probably fruitless, but the correct answer is −67, despite the fact that in the original paper Knuth postulated it to be −121.
Note that Knuth's code states:
if k <= 0 then A:= x4 + x5 else B;
which actually discards the result value from the call to B. Most of the translated examples below are equivalent to:
A := (if k <= 0 then x4 + x5 else B);
and are therefore strictly incorrect, although in a correct 'man' compiler they do produce the expected result, because Knuth's version has already assigned to the return variable for A from within B, and it is in fact that assignment which is the true return value of the function:
B:= A := A (k, B, x1, x2, x3, x4);
It is most likely that this was a deliberate attempt by Knuth to find yet another way to break 'boy' compilers, rather than merely being sloppy code.
ALGOL 68
Charles H. Lindsey implemented this man boy test in ALGOL 68, and - as call by name is not necessary - the same algorithm can be implemented in many languages including Pascal and PL/I .
PROC a = (INT in k, PROC INT xl, x2, x3, x4, x5) INT:( INT k := in k; PROC b = INT: a(k-:=1, b, xl, x2, x3, x4); ( k<=0 | x4 + x5 | b ) ); printf(($gl$,a(10, INT:1, INT:-1, INT:-1, INT:1, INT:0)))
Output:
-67
C
Even if closures are not available in a language, their effect can be simulated. This is what happens in the following C implementation:
<lang c>/* man-or-boy.c */
- include <stdio.h>
- include <stdlib.h>
// --- thunks typedef struct arg {
int (*fn)(struct arg*); int *k; struct arg *x1, *x2, *x3, *x4, *x5;
} ARG;
// --- lambdas int f_1 (ARG* _) { return -1; } int f0 (ARG* _) { return 0; } int f1 (ARG* _) { return 1; }
// --- helper int eval(ARG* a) { return a->fn(a); }
- define ARG(...) (&(ARG){ __VA_ARGS__ })
- define FUN(...) ARG(B,&k,__VA_ARGS__)
// --- functions int B(ARG* a) {
int A(ARG*); int k = *a->k -= 1; return A( FUN(a,a->x1,a->x2,a->x3,a->x4) );
}
int A(ARG* a) {
return *a->k <= 0 ? eval(a->x4)+eval(a->x5) : B(a);
}
int main(int argc, char **argv) {
int k = argc == 2 ? strtol(argv[1],0,0) : 10;
printf("%d\n", A( FUN(ARG(f1),ARG(f_1),ARG(f_1),ARG(f1),ARG(f0)) ));
}</lang>
Two gcc extensions to the C language, nested functions and block sub-expressions, can be combined to create this elegant version:
Version: gcc version 4.1.2 20070925 (Red Hat 4.1.2-27) <lang c>#include <stdio.h>
- define INT(body) ({ int lambda(){ body; }; lambda; })
main(){
int a(int k, int xl(), int x2(), int x3(), int x4(), int x5()){
int b(){
return a(--k, b, xl, x2, x3, x4);
}
return k<=0 ? x4() + x5() : b();
}
printf(" %d\n",a(10, INT(return 1), INT(return -1), INT(return -1), INT(return 1), INT(return 0)));
}</lang>
Output:
-67
C++
works with GCC
Uses "shared_ptr" smart pointers from Boost / TR1 to automatically deallocate objects. Since we have an object which needs to pass a pointer to itself to another function, we need to use "enable_shared_from_this".
<lang cpp>#include <iostream>
- include <tr1/memory>
using std::tr1::shared_ptr; using std::tr1::enable_shared_from_this;
struct Arg {
virtual int run() = 0;
virtual ~Arg() { };
};
int A(int, shared_ptr<Arg>, shared_ptr<Arg>, shared_ptr<Arg>,
shared_ptr<Arg>, shared_ptr<Arg>);
class B : public Arg, public enable_shared_from_this { private:
int k; const shared_ptr<Arg> x1, x2, x3, x4;
public:
B(int _k, shared_ptr<Arg> _x1, shared_ptr<Arg> _x2, shared_ptr<Arg> _x3,
shared_ptr<Arg> _x4)
: k(_k), x1(_x1), x2(_x2), x3(_x3), x4(_x4) { }
int run() {
return A(--k, shared_from_this(), x1, x2, x3, x4);
}
};
class Const : public Arg { private:
const int x;
public:
Const(int _x) : x(_x) { }
int run () { return x; }
};
int A(int k, shared_ptr<Arg> x1, shared_ptr<Arg> x2, shared_ptr<Arg> x3,
shared_ptr<Arg> x4, shared_ptr<Arg> x5) {
if (k <= 0)
return x4->run() + x5->run();
else {
shared_ptr<Arg> b(new B(k, x1, x2, x3, x4));
return b->run();
}
}
int main() {
std::cout << A(10, shared_ptr<Arg>(new Const(1)),
shared_ptr<Arg>(new Const(-1)),
shared_ptr<Arg>(new Const(-1)),
shared_ptr<Arg>(new Const(1)),
shared_ptr<Arg>(new Const(0))) << std::endl;
return 0;
}</lang>
C#
C# 2.0 supports anonymous methods which are used in the implementation below: <lang csharp>using System;
delegate T Func<T>();
class ManOrBoy {
static void Main()
{
Console.WriteLine(A(10, C(1), C(-1), C(-1), C(1), C(0)));
}
static Func<int> C(int i)
{
return delegate { return i; };
}
static int A(int k, Func<int> x1, Func<int> x2, Func<int> x3, Func<int> x4, Func<int> x5)
{
Func<int> b = null;
b = delegate { k--; return A(k, b, x1, x2, x3, x4); };
return k <= 0 ? x4() + x5() : b();
}
} </lang>
C# 3.0 supports lambda expressions which are used in the implementation below: <lang csharp>using System;
class ManOrBoy {
static void Main()
{
Console.WriteLine(A(10, () => 1, () => -1, () => -1, () => 1, () => 0));
}
static int A(int k, Func<int> x1, Func<int> x2, Func<int> x3, Func<int> x4, Func<int> x5)
{
Func<int> b = null;
b = () => { k--; return A(k, b, x1, x2, x3, x4); };
return k <= 0 ? x4() + x5() : b();
}
}</lang>
Clojure
<lang lisp>(declare a)
(defn man-or-boy
"Man or boy test for Clojure"
[k]
(let [k (atom k)]
(a k
(fn [] 1)
(fn [] -1)
(fn [] -1)
(fn [] 1)
(fn [] 0))))
(defn a
[k x1 x2 x3 x4 x5]
(let [k (atom @k)]
(letfn [(b []
(swap! k dec)
(a k b x1 x2 x3 x4))]
(if (<= @k 0)
(+ (x4) (x5))
(b)))))
(man-or-boy 10) </lang>
Common Lisp
<lang lisp>(defun man-or-boy (x)
(a x (lambda () 1)
(lambda () -1)
(lambda () -1)
(lambda () 1)
(lambda () 0)))
(defun a (k x1 x2 x3 x4 x5)
(labels ((b ()
(decf k)
(a k #'b x1 x2 x3 x4)))
(if (<= k 0)
(+ (funcall x4) (funcall x5))
(b))))
(man-or-boy 10)</lang>
D
First, the straightforward way, D1 (you must compile it without -inline, to avoid a compiler bug): <lang d>import std.c.stdio: printf;
int a(int k, lazy int x1, lazy int x2, lazy int x3, lazy int x4, lazy int x5) {
int b() {
k--;
return a(k, b(), x1, x2, x3, x4);
};
return k <= 0 ? x4 + x5 : b();
}
void main() {
printf("%d\n", a(10, 1, -1, -1, 1, 0));
}</lang>
Anonymous class version similar to Java example: <lang d>module mob ; import std.stdio ; interface B { int run() ; } int A(int k, int x1, int x2, int x3, int x4, int x5) {
B mb(int a) { return new class() B { int run() { return a ; } } ; }
return A(k, mb(x1), mb(x2), mb(x3), mb(x4), mb(x5)) ;
} int A(int k, B x1, B x2, B x3, B x4, B x5) {
return (k <= 0) ? x4.run() + x5.run() :
(new class() B {
int m ;
this() { this.m = k ; }
int run() { return A(--m, this, x1, x2, x3, x4) ; }
}).run() ;
} void main(string[] args) {
writefln(A(10, 1, -1, -1, 1, 0)) ; // output -67
}</lang> The D template version : <lang d>module mob ; import std.stdio ;
alias int delegate() B ;
B mb(T)(T mob){ // embeding function
int b() {
static if (typeid(T) is typeid(int)) {
return mob ;
} else {
return mob() ;
}
}
return &b ;
}
int A(T)(int k, T x1, T x2, T x3, T x4, T x5) {
static if (typeid(T) is typeid(int)) {
return A(k, mb(x1), mb(x2), mb(x3), mb(x4), mb(x5)) ;
}else {
int b(){ return A(--k, &b, x1, x2, x3, x4) ; }
return (k <= 0) ? x4() + x5() : b() ;
}
} void main(string[] args) {
writefln(A(10, 1, -1, -1, 1, 0)) ; // output -67
}</lang>
Above 2 versions need D ver2.007+ .
Lazy Variadic Functions version, as quoted:
- If the variadic parameter is an array of delegates with no parameters:
void foo(int delegate()[] dgs ...);
Then each of the arguments whose type does not match that of the delegate is converted to a delegate.
int delegate() dg;
foo(1, 3+x, dg, cast(int delegate())null);
is the same as:
foo( { return 1; }, { return 3+x; }, dg, null );
This version work for both D1 & D2. <lang d>module mob ; import std.stdio ;
alias int delegate() B ;
int A(int k, B[] x ...) {
int b(){ return A(--k, &b, x[0], x[1], x[2], x[3]) ; }
return (k <= 0) ? x[3]() + x[4]() : b() ;
} void main(string[] args) {
writefln(A(10, 1, -1, -1, 1, 0)) ; // output -67
}</lang>
Delphi
The latest editions of Delphi support anonymous methods, providing a way to implement call by name semantics.
<lang delphi>type
TFunc<T> = reference to function: T;
function C(x: Integer): TFunc<Integer>; begin
Result := function: Integer begin Result := x; end;
end;
function A(k: Integer; x1, x2, x3, x4, x5: TFunc<Integer>): Integer; var
b: TFunc<Integer>;
begin
b := function: Integer begin Dec(k); Result := A(k, b, x1, x2, x3, x4); end; if k <= 0 then Result := x4 + x5 else Result := b;
end;
begin
Writeln(A(10, C(1), C(-1), C(-1), C(1), C(0))); // -67 output
end.</lang>
E
Provided that it is marked in the caller and callee, E can perfectly emulate the requested call-by-name behavior by passing slots instead of values:
<lang e>def a(var k, &x1, &x2, &x3, &x4, &x5) {
def bS; def &b := bS
bind bS {
to get() {
k -= 1
return a(k, &b, &x1, &x2, &x3, &x4)
}
}
return if (k <= 0) { x4 + x5 } else { b }
}
def p := 1 def n := -1 def z := 0 println(a(10, &p, &n, &n, &p, &z))</lang>
Here each of the "x" parameters is effectively call-by-name. b is bound to a custom slot definition.
Erlang
Erlang variables cannot be changed after binding, so k is decremented by sending a message to a process.
kloop(K) ->
receive
{decr,Pid} -> Pid ! K-1, kloop(K-1);
_ -> ok
end.
a(K, X1, X2, X3, X4, X5) ->
Kproc = spawn(fun() -> kloop(K) end),
B = fun (B) ->
Kproc ! {decr, self()},
receive Kdecr ->
a(Kdecr, fun() -> B(B) end, X1, X2, X3, X4)
end
end,
if
K =< 0 -> Kproc ! X4() + X5();
true -> Kproc ! B(B)
end.
manorboy(N) ->
a(N, fun() -> 1 end, fun() -> -1 end, fun() -> -1 end, fun() -> 1 end, fun() -> 0 end ).
Fan
Fan has closures, so:
<lang Fan> class ManOrBoy {
Void main()
{
echo(A(10, |->Int|{1}, |->Int|{-1}, |->Int|{-1}, |->Int|{1}, |->Int|{0}));
}
static Int A(Int k, |->Int| x1, |->Int| x2, |->Int| x3, |->Int| x4, |->Int| x5)
{
|->Int|? b
b = |->Int| { k--; return A(k, b, x1, x2, x3, x4) }
return k <= 0 ? x4() + x5() : b()
}
} </lang>
yields
-67
Go
<lang C>package main
func a(k int, x1, x2, x3, x4, x5 func() int) int { var b func() int; b = func() int { k--; return a(k, b, x1, x2, x3, x4); }; if k <= 0 { return x4() + x5() } return b(); }
func main() { x := func(i int) (func() int) { return func() int { return i } }; println(a(10, x(1), x(-1), x(-1), x(1), x(0))); }</lang>
Haskell
Haskell is a pure language, so the impure effects of updating k must be wrapped in a state monad.
<lang haskell> import Control.Monad.ST
import Data.STRef
type S s = ST s Integer
a :: Integer -> S s -> S s -> S s -> S s -> S s -> S s
a k x1 x2 x3 x4 x5 = a' where
a' | k <= 0 = do { x4' <- x4; x5' <- x5; return (x4' + x5') }
| otherwise = do { kr <- newSTRef k; b kr }
b kr = do
modifySTRef kr pred
k' <- readSTRef kr
a k' (b kr) x1 x2 x3 x4
run :: Integer -> Integer
run k =
runST (a k (return 1) (return (-1)) (return (-1)) (return 1) (return 0))
main :: IO ()
main = print $ run 10</lang>
another version, more similar to the other languages: <lang haskell> import Control.Monad.ST
import Data.STRef
type S s = ST s Integer
a :: Integer -> S s -> S s -> S s -> S s -> S s -> S s
a k x1 x2 x3 x4 x5
| k <= 0 = do { x4' <- x4; x5' <- x5; return (x4' + x5') }
| otherwise = do kr <- newSTRef k
let b = do
modifySTRef kr pred
k' <- readSTRef kr
a k' b x1 x2 x3 x4
b
run :: Integer -> Integer
run k =
runST (a k (return 1) (return (-1)) (return (-1)) (return 1) (return 0))
main :: IO ()
main = print $ run 10</lang>
Java
We use anonymous classes to represent closures.
<lang java>public class ManOrBoy {
interface Arg
{
public int run();
}
public static int A(final int k, final Arg x1, final Arg x2, final Arg x3, final Arg x4, final Arg x5)
{
if (k <= 0)
return x4.run() + x5.run();
else {
Arg b = new Arg() {
int m = k;
public int run()
{
m--;
return A(m, this, x1, x2, x3, x4);
}
};
return b.run();
}
}
public static void main(String[] args)
{
System.out.println(A(10,
new Arg() { public int run() { return 1; } },
new Arg() { public int run() { return -1; } },
new Arg() { public int run() { return -1; } },
new Arg() { public int run() { return 1; } },
new Arg() { public int run() { return 0; } }));
}
}</lang>
JavaScript
This is the equivalent JavaScript code, but most interpreters don't support the required call stack depth for k=10. <lang javascript>function A(k,x1,x2,x3,x4,x5) {
var B = function() { return A(--k, B, x1, x2, x3, x4) }
return k<=0 ? x4()+x5() : B()
} function K(n) {
return function() { return n }
} alert( A(10, K(1), K(-1), K(-1), K(1), K(0) ) )</lang>
Lua
<lang lua>function a(k,x1,x2,x3,x4,x5)
local function b() k = k - 1 return a(k,b,x1,x2,x3,x4) end return k <= 0 and x4() + x5() or b()
end
function K(n)
return function() return n end
end
print(a(10, K(1), K(-1), K(-1), K(1), K(0)))</lang>
Mathematica
This Mathematica code was derived from the Ruby example appearing below.
$RecursionLimit = 1665; (* anything less fails for k0 = 10 *)
a[k0_, x1_, x2_, x3_, x4_, x5_] := Module[{k, b },
k = k0;
b = (k--; a[k, b, x1, x2, x3, x4]) &;
If[k <= 0, x4[] + x5[], b[]]]
a[10, 1 &, -1 &, -1 &, 1 &, 0 &] (* => -67 *)
OCaml
OCaml variables are not mutable, so "k" is wrapped in a mutable object, which we access through a reference type called "ref".
<lang ocaml>let rec a k x1 x2 x3 x4 x5 =
if k <= 0 then
x4 () + x5 ()
else
let m = ref k in
let rec b () =
decr m;
a !m b x1 x2 x3 x4
in
b ()
let () =
Printf.printf "%d\n" (a 10 (fun () -> 1) (fun () -> -1) (fun () -> -1) (fun () -> 1) (fun () -> 0))</lang>
Perl
<lang perl>sub A {
my ($k, $x1, $x2, $x3, $x4, $x5) = @_;
my($B);
$B = sub { A(--$k, $B, $x1, $x2, $x3, $x4) };
$k <= 0 ? &$x4 + &$x5 : &$B;
}
print A(10, sub{1}, sub {-1}, sub{-1}, sub{1}, sub{0} ), "\n";</lang>
PHP
PHP 5.3 has closures, so: <lang php>function A($k,$x1,$x2,$x3,$x4,$x5) {
$b = function () use (&$b,&$k,&$x1,&$x2,&$x3,&$x4) {
$k--; return A($k,$b,$x1,$x2,$x3,$x4);
};
return $k <= 0 ? $x4() + $x5() : $b();
}
echo A(10, function () { return 1; },
function () { return -1; },
function () { return -1; },
function () { return 1; },
function () { return 0; }) . "\n";</lang>
PL/I
morb: proc options (main) reorder;
dcl sysprint file;
put skip list(a((10), lambda1, lambdam1, lambdam1, lambda0, lambda0));
a: proc(k, x1, x2, x3, x4, x5) returns(fixed bin (31)) recursive;
dcl k fixed bin (31);
dcl (x1, x2, x3, x4, x5) entry returns(fixed bin (31));
b: proc returns(fixed bin(31)) recursive;
k = k - 1;
return(a((k), b, x1, x2, x3, x4));
end b;
if k <= 0 then
return(x4 + x5);
else
return(b);
end a;
lambdam1: proc returns(fixed bin (31)); return(-1); end lambdam1;
lambda0: proc returns(fixed bin (31)); return(1); end lambda0;
lambda1: proc returns(fixed bin (31)); return(1); end lambda1;
end morb;
Pop11
define A(k, x1, x2, x3, x4, x5);
define B();
k - 1 -> k;
A(k, B, x1, x2, x3, x4)
enddefine;
if k <= 0 then
x4() + x5()
else
B()
endif
enddefine;
define one(); 1 enddefine;
define minus_one(); -1 enddefine;
define zero(); 0 enddefine;
A(10, one, minus_one, minus_one, one, zero) =>
Python
<lang python>#!/usr/bin/env python import sys sys.setrecursionlimit(1025)
def a(in_k, x1, x2, x3, x4, x5):
k = [in_k]
def b():
k[0] -= 1
return a(k[0], b, x1, x2, x3, x4)
return x4() + x5() if k[0] <= 0 else b()
print a(10, *[lambda x=x: x for x in 1,-1,-1,1,0]) </lang> Output:
-67
Py3k
<lang python>#!/usr/bin/env python import sys sys.setrecursionlimit(1025)
def a(k, x1, x2, x3, x4, x5):
def b():
nonlocal k
k -= 1
return a(k, B, x1, x2, x3, x4)
return x4() + x5() if k <= 0 else b()
x = lambda i: lambda: i print(a(10, x(1), x(-1), x(-1), x(1), x(0))) </lang>
Ruby
Note: the lambda call can be replaced with Proc.new and still work. <lang ruby>def a(k, x1, x2, x3, x4, x5)
b = lambda { k -= 1; a(k, b, x1, x2, x3, x4) }
k <= 0 ? x4[] + x5[] : b[]
end
puts a(10, lambda {1}, lambda {-1}, lambda {-1}, lambda {1}, lambda {0})</lang>
Scala
def A(in_k: Int, x1: =>Int, x2: =>Int, x3: =>Int, x4: =>Int, x5: =>Int): Int = {
var k = in_k
def B: Int = {
k = k-1
A(k, B, x1, x2, x3, x4)
}
if (k<=0) x4+x5 else B
}
println(A(10, 1, -1, -1, 1, 0))
Scheme
<lang scheme>(define (A k x1 x2 x3 x4 x5)
(define (B)
(set! k (- k 1))
(A k B x1 x2 x3 x4))
(if (<= k 0)
(+ (x4) (x5))
(B)))
(A 10 (lambda () 1) (lambda () -1) (lambda () -1) (lambda () 1) (lambda () 0))</lang>
Smalltalk
Number>>x1: x1 x2: x2 x3: x3 x4: x4 x5: x5 | b k | k := self. b := [ k := k - 1. k x1: b x2: x1 x3: x2 x4: x3 x5: x4 ]. ^k <= 0 ifTrue: [ x4 value + x5 value ] ifFalse: b 10 x1: [1] x2: [-1] x3: [-1] x4: [1] x5: [0]
Standard ML
Standard ML variables are not mutable, so "k" is wrapped in a mutable object, which we access through a reference type called "ref".
<lang sml>fun a (k, x1, x2, x3, x4, x5) =
if k <= 0 then
x4 () + x5 ()
else let
val m = ref k
fun b () = (
m := !m - 1;
a (!m, b, x1, x2, x3, x4)
)
in
b ()
end
val () =
print (Int.toString (a (10, fn () => 1, fn () => ~1, fn () => ~1, fn () => 1, fn () => 0)) ^ "\n")</lang>
Tcl
There are two nontrivial features in the "man or boy" test. One is that the parameters x1 though x5 are in general going to be function calls that don't get evaluated until their values are needed for the addition in procedure A, which means that these in Tcl are going to be scripts, and therefore it is necessary to introduce a helper procedure C that returns a constant value. The other is that procedure B needs to refer to variables in the local context of its "parent" instance of procedure A. This is precisely what the upvar core command does, but the absolute target level needs to be embedded into the script that performs the delayed call to procedure B (upvar is more often used with relative levels). <lang tcl>proc A {k x1 x2 x3 x4 x5} {
expr {$k<=0 ? [eval $x4]+[eval $x5] : [B \#[info level]]}
} proc B {level} {
upvar $level k k x1 x1 x2 x2 x3 x3 x4 x4 incr k -1 A $k [info level 0] $x1 $x2 $x3 $x4
} proc C {val} {return $val} interp recursionlimit {} 1157 A 10 {C 1} {C -1} {C -1} {C 1} {C 0}</lang>
The [info level 0] here is a sort of "self" idiom; it returns the command (with arguments) that called the current procedure.
Since the values of x1 through x4 are never modified, it is also possible to embed these as parameters of B, thereby slightly purifying the program: <lang tcl>proc AP {k x1 x2 x3 x4 x5} {expr {$k<=0 ? [eval $x4]+[eval $x5] : [BP \#[info level] $x1 $x2 $x3 $x4]}} proc BP {level x1 x2 x3 x4} {AP [uplevel $level {incr k -1}] [info level 0] $x1 $x2 $x3 $x4} proc C {val} {return $val} interp recursionlimit {} 1157 AP 10 {C 1} {C -1} {C -1} {C 1} {C 0}</lang>
Vorpal
Adapted from the Lua example. In vorpal, all execution is a message to an object. This task primarily involves functions, so we have the apply the function objects to self for them to execute. Correctly, prints -67.
<lang vorpal> self.a = method(k, x1, x2, x3, x4, x5){
b = method(){
code.k = code.k - 1
return( self.a(code.k, code, code.x1, code.x2, code.x3, code.x4) )
}
b.k = k
b.x1 = x1
b.x2 = x2
b.x3 = x3
b.x4 = x4
b.x5 = x5
if(k <= 0){
return(self.apply(x4) + self.apply(x5))
}
else{
return(self.apply(b))
}
}
self.K = method(n){
f = method(){
return(code.n)
}
f.n = n
return(f)
}
self.a(10, self.K(1), self.K(-1), self.K(-1), self.K(1), self.K(0)).print() </lang>