Man or boy test
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"
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.
ALGOL 68
Charles H. Lindsey implemented the algorithm 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 .
main:(
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)
);
IF k<=0 THEN x4 + x5 ELSE b FI
);
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:
/* 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)) ));
}
Version: gcc version 4.1.2 20070925 (Red Hat 4.1.2-27)
#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)));
}
Output:
-67
Common Lisp
(defun man-or-boy (x)
(man-or-boy-func x (lambda () 1) (lambda () -1)
(lambda () -1) (lambda () 1)
(lambda () 0)))
(defun man-or-boy-func (k-param x1 x2 x3 x4 x5)
(let*
((k k-param)
(b
(lambda ()
(progn
(setq k (- k 1))
(man-or-boy-func k b x1 x2 x3 x4)))))
(if (<= k 0)
(+ (funcall x4) (funcall x5))
(funcall b))))
D
This is a boy-on-man approach, using same ideas as Java's examples :p
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
}
The D template style :
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
}
Both need D ver2.007+ .
Haskell
Haskell is a pure language, so the impure effects of updating k must be wrapped in a state monad.
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
k <- readSTRef kr
let k' = k - 1
writeSTRef kr k'
a k' (b kr) x1 x2 x3 x4
run k =
runST (a k (return 1) (return (-1)) (return (-1)) (return 1) (return 0))
Java
We use anonymous classes to represent closures.
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; } }));
}
}
JavaScript
This is the equivalent JavaScript code, but most interpreters don't support the required call stack depth for k=10.
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) ) )
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".
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))
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;
Python
#!/usr/bin/env python
import sys
sys.setrecursionlimit(1025)
def a(in_k, xl, x2, x3, x4, x5):
class scope_a: k = in_k;
def b():
scope_a.k = scope_a.k - 1;
return a(scope_a.k, b, xl, x2, x3, x4)
if scope_a.k<=0: out=x4() + x5()
else: out=b();
return out;
print(" %r"% a(10, lambda:1, lambda:-1, lambda:-1, lambda:1, lambda:0))
Output:
-67
Ruby
Note: the lambda call can be replaced with Proc.new and still work.
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})
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]