Man or boy test: Difference between revisions

From Rosetta Code
Content added Content deleted
Line 113: Line 113:
public static int A(final int k, final Arg x1, final Arg x2, final Arg x3, final Arg x4, final Arg x5)
public static int A(final int k, final Arg x1, final Arg x2, final Arg x3, final Arg x4, final Arg x5)
{
{
Arg b = new Arg() {
int m = k;
public int run()
{
m--;
return A(m, this, x1, x2, x3, x4);
}
};
if (k <= 0)
if (k <= 0)
return x4.run() + x5.run();
return x4.run() + x5.run();
else
else {
Arg b = new Arg() {
int m = k;
public int run()
{
m--;
return A(m, this, x1, x2, x3, x4);
}
};
return b.run();
return b.run();
}
}
}

Revision as of 08:16, 3 February 2008

The man or boy test was proposed by computer scientist Donald Knuth as a means of evaluating implementations of the 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 .

BEGIN
 PROC a = (REAL in k, PROC REAL xl, x2, x3, x4, x5) REAL:
 BEGIN
   REAL k := in k;
   PROC b = REAL:
   BEGIN k := k - 1;
         a(k, b, xl, x2, x3, x4)
   END;
   IF k<=0 THEN x4 + x5 ELSE b FI
 END;
 printf(($+2d.8d$, a(10, REAL:1, REAL:-1, REAL:-1, REAL:1, REAL:0)))
END

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)) ));
}


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) ) )

Lisp

Since Lisp does not have a full range of monads as in Haskell, the Lisp implementation uses setq; a purely functional implementation would be much more complicated:

(defun manOrBoy (x)
 (manOrBoy-func x (lambda () 1) (lambda () -1)
                  (lambda () -1) (lambda () 1)
                  (lambda () 0)))

(defun manOrBoy-func (k-param x1 x2 x3 x4 x5)
 (let*
   ((k k-param)
    (b
     (lambda ()
       (progn
         (setq k (- k 1))
         (manOrBoy-func k b x1 x2 x3 x4)))))
   (if (<= k 0)
       (+ (funcall x4) (funcall x5))
       (funcall b))))

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, called a "ref". In the "b" function, when "k" is passed to "a", its contents are retrieved and re-wrapped into a new object, so that modifications made in that call will not be reflected in our "k".

let rec a k x1 x2 x3 x4 x5 =
  let rec b () =
    decr k;
    a (ref !k) b x1 x2 x3 x4
  in
  if !k <= 0 then
    x4 () + x5 ()
  else
    b ()

let _ =
  Printf.printf "%d\n" (a (ref 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, lambda2, lambda3, lambda4, lambda5));

 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;

 lambda1: proc returns(fixed bin (31)); return(1);  end lambda1;
 lambda2: proc returns(fixed bin (31)); return(-1); end lambda2;
 lambda3: proc returns(fixed bin (31)); return(-1); end lambda3;
 lambda4: proc returns(fixed bin (31)); return(1);  end lambda4;
 lambda5: proc returns(fixed bin (31)); return(0);  end lambda5;
end morb;

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]

See also