Man or boy test: Difference between revisions

From Rosetta Code
Content added Content deleted
Line 186: Line 186:
=={{header|OCaml}}==
=={{header|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".
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 =
let rec a k x1 x2 x3 x4 x5 =
let m = ref k in
let rec b () =
let rec b () =
decr k;
decr m;
a (ref !k) b x1 x2 x3 x4
a !m b x1 x2 x3 x4
in
in
if !k <= 0 then
if k <= 0 then
x4 () + x5 ()
x4 () + x5 ()
else
else
Line 199: Line 200:
let _ =
let _ =
Printf.printf "%d\n" (a (ref 10) (fun () -> 1) (fun () -> -1) (fun () -> -1) (fun () -> 1) (fun () -> 0))
Printf.printf "%d\n" (a 10 (fun () -> 1) (fun () -> -1) (fun () -> -1) (fun () -> 1) (fun () -> 0))


=={{header|PL/I}}==
=={{header|PL/I}}==

Revision as of 09:42, 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, which we access through a reference type called "ref".

let rec a k x1 x2 x3 x4 x5 =
  let m = ref k in
  let rec b () =
    decr m;
    a !m b x1 x2 x3 x4
  in
  if k <= 0 then
    x4 () + x5 ()
  else
    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, 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