Man or boy test: Difference between revisions

{{works with|Ada|Ada|2005, 2012}}

 

 

procedure Man_Or_Boy is

Zero'Access -- Returns 0

) ) );

 

Ada 2012 supports expression functions and conditional expressions which are used in the implementation below:

{{works with|Ada|Ada|2012}}

 

 

procedure Man_Or_Boy is

X4 => One'Access,

X5 => Zero'Access)));

 

This version resembles more Knuth's original version in that the result of B is thrown away.

 

use Ada.Text_IO;

 

X5 => Zero'Access)));

 

 

Sample output:

 

=={{header|Aime}}==

F(list l)

{

 

0;

Output:

<pre>

{{wont work with|ELLA ALGOL 68|Any (with appropriate job cards) - tested with release [http://sourceforge.net/projects/algol68/files/algol68toc/algol68toc-1.8.8d/algol68toc-1.8-8d.fc9.i386.rpm/download 1.8-8d] - due to extensive use of FORMATted transput}}

[[wp:Charles_H._Lindsey|Charles H. Lindsey]] implemented this [http://archive.computerhistory.org/resources/text/algol/algol_bulletin/A52/P43.HTM man boy test] in [[ALGOL 68]], and - as call by name is not necessary - the same algorithm can be implemented in many languages including [[:Category:Pascal|Pascal]] and [[:Category:PL/I|PL/I]] <!-- <ref>{{cite web|title=Block Structure and Environments | author=[[Charles H. Lindsey]] | url=http://archive.computerhistory.org/resources/text/algol/algol_bulletin/A52/P43.HTM | accessyear=2007 | accessmonthday=May 2| year=1988 | month=Dec}}</ref>. --> <!-- <ref>{{cite web|title="Man or boy" test|url=http://groups.google.com/group/comp.lang.haskell/browse_thread/thread/eef78beaaac73b26/7a6672ceea07b34e}}</ref>, -->.

INT k := in k;

PROC b = INT: a(k-:=1, b, xl, x2, x3, x4);

test:(

printf(($gl$,a(10, INT:1, INT:-1, INT:-1, INT:1, INT:0)))

Output:

<pre>

<p>

Note that unlike Algol 60, in Algol W the result of a procedure is the final value calculated by the procedure and so the result cannot be assigned in a sub-procedure. This means the following sample is "strictly incorrect" (see the notes on the Algol 60 sample) but yields the correct result.

real procedure A (integer value k; real procedure x1, x2, x3, x4, x5);

begin

end;

write (r_format := "A", r_w := 8, r_d := 2, A (10, 1, -1, -1, 1, 0))

{{out}}

<pre>

AppleScript's stack limit is around 500 frames, which is too low to run this example. It runs in the compatible [http://en.wikipedia.org/wiki/Smile_%28software%29 Smile] environment, however.

 

script b

set k to k - 1

 

a(10, int(1), int(-1), int(-1), int(1), int(0))

Output:

<pre>

</pre>

 

{{works with|BBC BASIC for Windows}}

FOR k% = 0 TO 20

DEF FN0(d%) = 0

DEF FN1(d%) = 1

Output:

<pre>

Even if [[closures]] are not available in a language, their effect can be simulated. This is what happens in the following C implementation:

 

#include <stdio.h>

#include <stdlib.h>

MAKE_ARG(f1), MAKE_ARG(f0))));

return 0;

 

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)

#define INT(body) ({ int lambda(){ body; }; lambda; })

main(){

}

printf(" %d\n",a(10, INT(return 1), INT(return -1), INT(return -1), INT(return 1), INT(return 0)));

 

C without C99 or gcc extensions:

 

#include <stdlib.h>

printf("%d\n", A(Frame(&a, &k, &f1, &fn1, &fn1, &f1, &f0)));

return 0;

 

Output:

{{works with|C sharp|C#|2+}}

 

delegate T Func<T>();

}

}

 

C# 3.0 supports lambda expressions which are used in the implementation below:

{{works with|C sharp|C#|3+}}

 

class ManOrBoy

return k <= 0 ? x4() + x5() : b();

}

 

=={{header|C++}}==

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".

 

#include <tr1/memory>

using std::tr1::shared_ptr;

shared_ptr<Arg>(new Const(0))) << std::endl;

return 0;

 

{{works with|C++11}} uses anonymous functions. Tested with g++ version 4.5 and Visual C++ version 16 (Windows SDK 7.1):

#include <iostream>

 

std::cout << A(10, L(1), L(-1), L(-1), L(1), L(0)) << std::endl;

return 0;

 

{{works with|TR1}} uses TR1 without C++11.

#include <iostream>

 

std::cout << A(10, L(1), L(-1), L(-1), L(1), L(0)) << std::endl;

return 0;

 

=={{header|Clipper}}==

 

Local k

For k := 0 to 20

xVal := x

Endif

 

 

=={{header|Clojure}}==

 

 

(defn man-or-boy

 

(man-or-boy 10)

 

=={{header|Common Lisp}}==

 

(a x (lambda () 1)

(lambda () -1)

(b))))

 

 

=={{header|Crystal}}==

b = uninitialized -> typeof(k)

b = ->() { k -= 1; a(k, b, x1, x2, x3, x4) }

end

 

{{out}}

<pre>

=={{header|D}}==

===Straightforward Version===

 

int a(int k, const lazy int x1, const lazy int x2, const lazy int x3,

void main() {

printf("%d\n", a(10, 1, -1, -1, 1, 0));

The DMD compiler is a man. Increasing the maximum stack space to about 1.2 GB the DMD 2.059 compiler computes the result -9479595 for k = 25 in about 6.5 seconds on a 32 bit system (-inline -O -release -L/STACK:1300000000).

 

[http://www.digitalmars.com/d/1.0/function.html Lazy Variadic Functions] version, as quoted:<br>

:If the variadic parameter is an array of delegates with no parameters:<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;void foo(int delegate()[] dgs ...);</tt><br>Then each of the arguments whose type does not match that of the delegate is converted to a delegate.<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;int delegate() dg;</tt><br><tt>&nbsp;&nbsp;&nbsp;&nbsp;foo(1, 3+x, dg, cast(int delegate())null);</tt><br>is the same as:<br><tt>&nbsp;&nbsp;&nbsp;&nbsp;foo( { return 1; }, { return 3+x; }, dg, null );</tt><br>

int b() nothrow @safe {

k--;

 

A(10, 1, -1, -1, 1, 0).writeln;

 

===Template Version===

int b() nothrow @safe @nogc {

static if (is(T == int))

 

A(10, 1, -1, -1, 1, 0).writeln;

 

===Anonymous Class Version===

Similar to Java example:

 

interface B {

void main() {

writeln(A(10, 1, -1, -1, 1, 0));

 

===Faster Version===

This version cheats, using a different much faster algorithm.

 

// Adapted from C code by Goran Weinholt, adapted from Knuth code.

writefln("...\n500 %-(%s\\\n %)",

A(500, 1, -1, -1, 1, 0).text.chunks(60));

{{out}}

<pre>0 1

The latest editions of Delphi support anonymous methods, providing a way to implement call by name semantics.

 

TFunc<T> = reference to function: T;

begin

Writeln(A(10, C(1), C(-1), C(-1), C(1), C(0))); // -67 output

 

=={{header|Dyalect}}==

 

() => i

}

}

 

{{out}}

 

 

=={{header|Dylan}}==

(k :: <integer>, x1 :: <function>, x2 :: <function>, x3 :: <function>,

x4 :: <function>, x5 :: <function>)

end method man-or-boy;

 

 

=={{header|Déjà Vu}}==

{{trans|Python}}

 

local b:

set :k -- k

i

 

 

=={{header|E}}==

Provided that it is marked in the caller and callee, E can perfectly emulate the requested [[wp:Call-by-name#Call_by_name|call-by-name]] behavior by passing slots instead of values:

 

def bS; def &b := bS

bind bS {

def n := -1

def z := 0

 

Here each of the "<code>x</code>" parameters is effectively call-by-name. <var><code>b</code></var> is bound to a custom slot definition.

 

=={{header|EchoLisp}}==

;; copied from Scheme

(define (A k x1 x2 x3 x4 x5)

❗ InternalError : too much recursion - JS internal error (please, report it)-

→ stack overflow using FireFox

 

=={{header|Ela}}==

Stack overflow is not a problem in Ela (but "out of memory" is):

 

 

liftM2 f m1 m2 = do

 

_ = a 10 (!!1) (!! -1) (!! -1) (!!1) (!!0) >>= (putStr << show) ::: IO

 

=={{header|Elena}}==

 

A(k,x1,x2,x3,x4,x5)

public program()

{

{

console.printLine(A(n,{^1},{^-1},{^-1},{^1},{^0}))

}

{{out}}

<pre>

▶ man_or_boy.(14) #⇒ -1446

▶ man_or_boy.(20) #⇒ [error] Too many processes

</pre>

 

Straightforward version:

 

[<EntryPoint>]

let main (args : string[]) =

 

0

 

Using a trampoline to avoid stack overflows when k >= 20:

 

type Tramp<'t> =

| Delay of (unit -> Tramp<'t>)

 

0

 

=={{header|Fantom}}==

Fantom has closures, so:

 

class ManOrBoy

{

}

}

 

yields

Gforth provides flat closures [{: ... :}L ... ;] that are initialized from the stack. You have to perform flat-closure conversion and assignment conversion manually (and this has been done here).

 

k @ 0<= IF x4 x5 f+ ELSE

B k x1 x2 x3 action-of x4 [{: B k x1 x2 x3 x4 :}L

k @ B @ x1 x2 x3 x4 A ;] dup B !

execute THEN ;

 

=={{header|Fortran}}==

Fortran 2008 (uses an internal procedure as function argument). Tested with g95 and gfortran 4.6.

 

implicit none

use man_or_boy

write (*,*) A(10,one,minus_one,minus_one,one,zero)

 

=={{header|Go}}==

import "fmt"

 

x := func(i int) func() int { return func() int { return i } }

fmt.Println(a(10, x(1), x(-1), x(-1), x(1), x(0)))

 

Another version that uses named result parameters the way the original Algol uses the function name. This includes B setting the result of its enclosing A.

 

import "fmt"

fmt.Println(A(10, K(1), K(-1), K(-1), K(1), K(0)))

}

 

By exploiting interfaces, one can more closely parallel the original Algol's polymorphic parameters.

 

import "fmt"

func main() {

fmt.Println(A(10, 1, -1, -1, 1, 0))

 

Inspired by D's "faster" version, here's another that uses a different algorithm to compute the result.

 

import (

 

func A(k int) *big.Int {

one := big.NewInt(1)

c0 := big.NewInt(3)

 

func main() {

p(500)

p(10000)

p(1e6)

{{out}}

<pre>

A(10) = -67

A(30) = -512016658

A(500) = -36608...67320 (172 digits)

A(10000) = -19928...34899 (3464 digits)

This is not stictly identical with Wirth's example.

 

var k = in_k

var B(): int // B is a function variable

return k<=0 ? x4()+x5() : B()

}

 

Output:

=={{header|Groovy}}==

Solution:

def b; b = {

a (--k, b, x1, x2, x3, x4)

}

 

 

Test 1:

 

This test overflowed the stack at the default stack size. On my system I required "-Xss1409k" or larger to run successfully.

 

Test 2:

printf ("%3d: %7d\n", k, a(k, x(1), x(-1), x(-1), x(1), x(0)))

 

This test required "-Xss345m" to avoid overflow.

Haskell is a pure language, so the impure effects of updating ''k'' must be wrapped in the IO or ST [[Monads|monad]]:

 

 

a

main = a 10 # 1 # (-1) # (-1) # 1 # 0 >>= print

where

 

On an AMD Opteron 6282 SE using GHC 7.8.2 this program can compute ''k'' = 30 in 1064 s and 156.2 GiB.

 

The co-expression version.

# ... be obvious when we break normal scope rules

procedure main(arglist) # supply the initial k value

k.value -:= 1 # diddle A's copy of k

return A(k.value, create |B(k,x1,x2,x3,x4,x5),x1,x2,x3,x4) # call A with a new k and 5 x's

 

Below are the code changes for the non-co-expression version. A new record type is introduced and the two return expressions are changed slightly.

 

 

procedure eval(ref) # evaluator to distinguish between a simple value and a code reference

k.value -:= 1 # diddle A's copy of k

return A(k.value, defercall(B,[k,x1,x2,x3,x4,x5]),x1,x2,x3,x4)# call A with a new k and 5 x's

 

=={{header|Io}}==

Io is nothing if not aggressively manly.

 

 

a := method(k, xs,

1 to(500) foreach(k,

(k .. " ") print

 

=={{header|J}}==

Given

 

L=.cocreate'' NB. L is context where names are defined.

k__L=:x

k__L=:k__L-1

a__L=:k__L A L&B`(x1__L f.)`(x2__L f.)`(x3__L f.)`(x4__L f.)

 

 

 

=={{header|Java}}==

Java Version 8 and up

 

 

public class ManOrBoy {

System.out.println(A(10, () -> 1.0, () -> -1.0, () -> -1.0, () -> 1.0, () -> 0.0));

}

 

Java Version 7

 

interface Arg {

public int run();

System.out.println(A(10, C(1), C(-1), C(-1), C(1), C(0)));

}

 

=={{header|JavaScript}}==

In Chrome we get a "Maximum call stack size exceeded" when a > 13. In Firefox we get "too much recursion" when a > 12.

function b() {

k -= 1;

};

}

 

Implemented using ES6 syntax

 

var a = (k, x1, x2, x3, x4, x5) => {

var b = () => a(--k, b, x1, x2, x3, x4); //decrement k before use

return (k > 0) ? b() : x4() + x5();

 

=={{header|Jsish}}==

From Javascript entry.

/* As noted, needs a fair sized stack depth, default is 200 in jsish v2.8.24 */

Interp.conf({maxDepth:2048});

-67

=!EXPECTEND!=

 

{{out}}

 

=={{header|Julia}}==

b = ()-> a(k-=1, b, x1, x2, x3, x4);

k <= 0 ? (x4() + x5()) : b();

end

 

 

=={{header|Kotlin}}==

Using the default JVM stack size, could only get to k = 12 before experiencing an overflow:

 

typealias Func = () -> Int

}

}

 

{{out}}

 

=={{header|Lox}}==

print k;

fun B() {

fun I_1() { return -1; }

 

 

=={{header|Lua}}==

 

local function b()

k = k - 1

end

 

=={{header|Mathematica}}/{{header|Wolfram Language}}==

This ''Mathematica'' code was derived from the Ruby example appearing below.

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[]]]

{{out}}

<pre>-67</pre>

=={{header|Modula-3}}==

 

IMPORT IO;

 

IO.PutInt(A(10, F1, Fn1, Fn1, F1, F0));

IO.Put("\n");

 

=={{header|Nim}}==

With standard compilation values, it is possible to run the program with <code>k = 10</code>. With <code>k = 11</code>, we reach the default call depth limit (2000). In this case, compiling with option <code>-d:nimCallDepthLimit=2100</code> is enough to get the result: -138.

 

proc a(k: int; x1, x2, x3, x4, x5: proc(): int): int =

else: b()

 

 

{{out}}

=={{header|Objeck}}==

Using anonymous classes instead of closures

method : virtual : public : Run() ~ Int;

}

}

}

 

=={{header|Objective-C}}==

{{works with|Cocoa|Mac OS X 10.6+}}

 

typedef NSInteger (^IntegerBlock)(void);

}

return 0;

 

Without ARC, the above should be:

 

typedef NSInteger (^IntegerBlock)(void);

[pool drain];

return 0;

 

 

without Blocks or ARC:

-(NSInteger)call;

@end

[pool release];

return 0;

 

=={{header|OCaml}}==

OCaml variables are not mutable, so "k" is wrapped in a mutable object, which we access through a reference type called "ref".

 

if k <= 0 then

x4 () + x5 ()

 

let () =

 

=={{header|Ol}}==

But! For some reasons in version 1.2 a very limited mutators (set-ref!, set-car!, set-cdr!) are added; so this task can be implemented as usual. Please, be aware that mutators receives only values (small numbers, constants) or previously (before the mutating dest) declared objects.

 

; Because argument "k" is a small number, it's a value, not an object.

; So we must 'pack' it in object - 'box' it; And 'unbox' when we try to get value.

(print (man-or-boy 15))

(print (man-or-boy 20))

Output:

<pre>

We use explicit "return variables" to emulate the strange behaviour of the ALGOL B procedure which assigns a value to A's return value.

 

fun {A K X1 X2 X3 X4 X5}

ReturnA = {NewCell undefined}

end

in

 

=={{header|Pascal}}==

 

 

function zero: integer; begin zero := 0 end;

 

begin writeln(A(10, one, negone, negone, one, zero))

 

=={{header|Perl}}==

my ($k, $x1, $x2, $x3, $x4, $x5) = @_;

my($B);

}

<!-- $B must be declared before it is used. Otherwise it references the global variable

$B.

Ugh. Phix does not allow this sort of nonsense implicitly, so you have to get a bit <s>dirty</s> creative.<br>

Explicitly allocates space (which is automatically freed) for the various "k contexts". Manages up to k=23 in about 10s, but crashes on k=24.

{{out}}

<pre>

</pre>

 

=={{header|PHP}}==

{{works with|PHP|5.3+}}

function A($k,$x1,$x2,$x3,$x4,$x5) {

$b = function () use (&$b,&$k,$x1,$x2,$x3,$x4) {

function () { return 1; },

function () { return 0; }) . "\n";

 

{{works with|PHP|pre-5.3 and 5.3+}}

function A($k,$x1,$x2,$x3,$x4,$x5) {

static $i = 0;

create_function('', 'return 1;'),

create_function('', 'return 0;')) . "\n";

 

=={{header|PicoLisp}}==

As PicoLisp uses exclusively shallow dynamic binding, stack frames have to be

explicitly constructed.

(let (@K (cons K) B (cons)) # Explicit frame

(set B

(if (gt0 (car @K)) ((car B)) (+ (X4) (X5))) ) )

 

Output:

<pre>-> -67</pre>

=={{header|Python}}==

{{works with|Python|2.5}}

import sys

sys.setrecursionlimit(1025)

x = lambda i: lambda: i

print(a(10, x(1), x(-1), x(-1), x(1), x(0)))

A better-looking alternative to using lists as storage are function attributes:

import sys

sys.setrecursionlimit(1025)

x = lambda i: lambda: i

print(a(10, x(1), x(-1), x(-1), x(1), x(0)))

 

Output:

{{works with|Python|3.0}}

 

import sys

sys.setrecursionlimit(1025)

return x4() + x5() if k <= 0 else B()

 

 

=={{header|R}}==

Like many implementations this uses lambda wrappers around the numeric arguments and explicit function calls in the x4() + x5() step to force the order of evaluation and handle value/call duality.

 

 

A <- function(k, x1, x2, x3, x4, x5) {

}

 

 

That is the way any sane person would implement Man-or-Boy. However, we can be a bit more evil than that. Here <tt>call.by.name</tt> is a function that rewrites the function definition given as its input:

 

cl <- as.list(match.call())

sublist <- lapply(cl[2:(length(cl)-1)],

}, list(body=fndef[[3]], subcall=subcall))

eval.parent(fndef)

 

allowing us to write A in a way that mirrors ALGOL60 semantics closely:

 

function(k, x1, x2, x3, x4, x5) {

Aout <- NULL

Aout

}

 

One has to increase the recursion limit a bit, but it gives correct answers:

 

> mapply(A, 0:10, 1, -1, -1, 1, 0)

If you inspect <tt>A</tt> without the original source you will see what has happened: <tt>call.by.name</tt> rewrote A so that it looks like this:

 

function (k, x1, x2, x3, x4, x5)

{

x4 = substitute(evalq(., .caller), list(. = substitute(x4))),

x5 = substitute(evalq(., .caller), list(. = substitute(x5))))))

 

That is, instead of evaluating its arguments normally, <tt>A</tt> captures their original expressions, and instead of evaluating its body normally, <tt>A</tt> substitutes calls to <tt>evalq</tt> the captured argument expressions in the calling frame. After a few levels of recursion this way, you end up evaluating expressions like <tt>A(k, B(), evalq(B(), .caller), evalq(evalq(B(), .caller), .caller), evalq(evalq(evalq(1, .caller), .caller), .caller), evalq(evalq(evalq(-1, .caller), .caller), .caller))</tt>, so this is not very efficient, but works.

Copied from Scheme, works fine:

 

 

(define (A k x1 x2 x3 x4 x5)

(B)))

 

=={{header|Raku}}==

(formerly Perl 6)

This solution avoids creating the closure B if $k <= 0 (that is, nearly every time).

$k <= 0

?? x4() + x5()

};

{{out}}

<pre>-67</pre>

The REXX language only passes by value, not by name. &nbsp; However, there is a way to treat passed arguments as names.

<br>However, using the code below, it only works for &nbsp; '''n''' &nbsp; up to (and including) &nbsp; '''3'''.

do n=0 /*increment N from zero forever. */

say 'n='n a(N,x1,x2,x3,x4,x5) /*display the result to the terminal. */

x3: procedure; return -1

x4: procedure; return 1

'''output'''

<pre>

 

Note: the lambda call can be replaced with Proc.new and still work.

b = lambda { k -= 1; a(k, b, x1, x2, x3, x4) }

k <= 0 ? x4[] + x5[] : b[]

end

 

 

=={{header|Rust}}==

 

 

trait Arg {

pub fn main() {

println!("{}", a(10, &1, &-1, &-1, &1, &0));

 

Another solution where we have B take itself as an argument in order to recursively call itself:

 

 

fn a(k: i32, x1: &Fn() -> i32, x2: &Fn() -> i32, x3: &Fn() -> i32, x4: &Fn() -> i32, x5: &Fn() -> i32) -> i32 {

pub fn main() {

println!("{}", a(10, &||1, &||-1, &||-1, &||1, &||0));

 

Another solution that gives a reference-counted function a weak reference to itself:

 

{{trans|Objective-C}}

use std::cell::RefCell;

use std::rc::Rc;

pub fn main() {

println!("{}", a(10, &||1, &||-1, &||-1, &||1, &||0));

 

=={{header|Scala}}==

var k = in_k

def B: Int = {

if (k<=0) x4+x5 else B

}

 

=={{header|Scheme}}==

 

(define (B)

(set! k (- k 1))

(B)))

 

 

=={{header|Sidef}}==

func b { a(--k, b, x1, x2, x3, x4) };

k <= 0 ? (x4() + x5()) : b();

}

 

This solution avoids creating the closure b if k <= 0 (that is, nearly every time).

k <= 0 ? (x4() + x5())

: func b { a(--k, b, x1, x2, x3, x4) }();

}

 

Alternatively, we can implement it as a class also:

method a(k, x1, x2, x3, x4, x5) {

func b { self.a(--k, b, x1, x2, x3, x4) };

 

var obj = MOB();

 

 

Number>>x1: x1 x2: x2 x3: x3 x4: x4 x5: x5

Sparkling does not directly support modifying external local variables. To work around this limitation, we wrap the <tt>k</tt> variable in an array, which is mutable.

 

let kk = { "k": k.k };

let b = function b() {

}

 

 

=={{header|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".

 

if k <= 0 then

x4 () + x5 ()

 

val () =

 

=={{header|Swift}}==

As of Swift 3.0, closure parameters are "non-escaping" by default. The Man or Boy Test requires the closures to be escaping, and thus we must now annotate the closure parameters with the "@escaping" attribute.

 

_ x1: @escaping () -> Int,

_ x2: @escaping () -> Int,

}

{{works with|Swift|2.x}}

var k1 = k

func B() -> Int {

}

 

{{works with|Swift|1.x}}

var B: (() -> Int)!

B = {

}

 

 

 

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

expr {$k<=0 ? [eval $x4]+[eval $x5] : [B \#[info level]]}

}

proc C {val} {return $val}

interp recursionlimit {} 1157

 

The <tt>[info level 0]</tt> 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:

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

 

=={{header|TSQL}}==

 

SQL is kinda limited, and TSQL is not much better. Unfortunately it fails the Man test due to Stack Level being limited to 32.

CREATE PROCEDURE dbo.LAMBDA_WRAP_INTEGER

 

END

 

 

Outputs:

The goal in this solution is to emulate the Algol 60 solution as closely as possible, and not merely get the correct result. For that, we could just crib the Common Lisp or Scheme solution, with more succinct syntax, like this:

 

(labels ((B ()

(dec k)

(if (<= k 0) (+ [x4] [x5]) (B))))

 

 

To do a proper job, we define a call-by-name system as a set of functions and macros. With these, the function <code>A</code> can be defined as a close transliteration of the Algol, as can the call to <code>A</code> with the integer constants:

 

(let ((k k))

(labels-cbn (B ()

(B))))) ;; value of (B) correctly discarded here!

 

 

We define the global function with <code>defun-cbn</code> ("cbn" stands for "call by name") and the inner function with <code>labels-cbn</code>. These functions are actually macros which call hidden call-by-value functions. The macros create all the necessary thunks out of their argument expressions, and the hidden functions use local macros to provide transparent access to their arguments from their bodies.

The complete code follows:

 

 

(defmacro make-cbn-val (place)

(B))))) ;; value of (B) correctly discarded here!

 

 

 

Visual Prolog (like any other Prolog) does not allow variables to be changed. But behavior can easily be mimicked by using a '''varM''' (modifiable variable), which is actually an object containing a value of the relevant type in a modifiable entity (a so called fact variable). Secondly, anonymous function (lambda-expression) cannot be recursive, but this is mimicked by using yet a '''varM''' to hold the function.

(Token coloring of Visual Prolog in this wiki is unfortunately wrong, because styles are used across languages. A correctly colored version can be seen in [http://wiki.visual-prolog.com/index.php?title=Man_or_boy_test Man or boy test] in the Visual Prolog wiki).

 

implement main

open core

R = if KM:value <= 0 then X4() + X5() else BM:value() end if.

 

 

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.

 

b = method(){

code.k = code.k - 1

}

 

 

=={{header|Wren}}==

In Wren, a fiber's stack starts quite small but is then increased as needed, apparently limited only by available memory. Anyway, satisfying the test for k up to 20 is unlikely to be a problem on a modern machine.

 

var a

for (k in 0..20) {

Fmt.print("$2d : $ d", k, a.call(k, Fn.new { 1 }, Fn.new { -1 }, Fn.new { -1 }, Fn.new { 1 }, Fn.new { 0 }))

 

{{out}}

19 : -78985

20 : -175416

</pre>

 

The compiler is OK but the VM is a girlie-man VM. Due to the way closures are built, the stack blows quickly when closures recurse. So, while the code can be written per Knuth, it is unable to do anything. So, classes are used to simulate the closures. Also (5)()-->5 so no problems there.

B:=CB(k, x1, x2, x3, x4, x5);

if(k <= 0) x4()+x5() else B.B();

A(k, B, x1, x2, x3, x4);

}

{{out}}

<pre>