Man Or Boy

September 16, 2016

Knuth got it wrong:

(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))
> (a 10 (lambda ()  1)
        (lambda () -1)
        (lambda () -1)
        (lambda ()  1)
        (lambda ()  0))

All of the lambdas are necessary because b is a procedure, and thus all the numbers x1, x2, x3, x4, and x5 must be represented as procedures. It is instructive to follow the recursion by hand for a few small values of k. Note that the sequence (A132343) becomes very large very quickly.

You can run the program at


Pages: 1 2

8 Responses to “Man Or Boy”

  1. Milbrae said

    Maybe you’d like to check this out:

  2. Informatimago said
    It is not a test of recursion, but a test of call-by-name.
    You have to be careful to interpret the name of the functions in
    Algol: depending on whether they are "left-values" or "right-values",
    they will denote an assignment to a variable that will be the function
    result, or they denote a (possibly recursive) function call.
           B := A := A(k, B, x1, x2, x3, x4)
           ^    ^    ^    ^
           |    |    |    |
           |    |    |    +--- function call.
           |    |    +-------- function call.
           |    +------------- assignment to result variable
           +------------------ assignment to result variable
           if k ≤ then A : = x4 + x5 else B
                       ^                  ^
                       |                  |
                       |                  +---- function call
                       +----------------------- assignment to result variable
    All the arguments to A, but the first one which is declared to be
    by-value, are passed by-name.  This requires the creation of a thunk
    (macro byname), and the evaluation of that thunk when the value is
    eventually needed (function deref).
    (defun deref (x)
      (if (functionp x)
          (deref (funcall x))
    (defmacro byname (x)
      `(lambda () ,x))
    (labels ((A (k x1 x2 x3 x4 x5)
               (let ((a :uninitialized-a))
                 (labels ((b ()
                            (let ((b :uninitialized-b))
                              (decf k)
                              (setf b (setf a (a k (byname (b)) (byname x1) (byname x2) (byname x3) (byname x4))))
                   (if (<= k 0)
                       (setf a (+ (deref x4) (deref x5)))
      (a 10 1 -1 -1 1 0))
    ;; --> -67
  3. namako said

    This goes up to 27…so I suppose I am a man compiler.

    ;For ml64, Windows x86-64
    ;ml64 <filename>.asm /Cp /link /ENTRY:ENTRY /SUBSYSTEM:CONSOLE kernel32.lib user32.lib /STACK:<stacksize>
    ;Got up to 27 with a /STACK:10737418240 (10GB), 13 with the defaul 1MB stack.
    Some hideous ALGOL60 by Knuth:
    real procedure A(k, x1, x2, x3, x4, x5);
    value k; integer k;
    real procedure B;
    k := k - 1;
    B := A := A(k, B, x1, x2, x3, x4)
    if k <= 0 then A : = x4 + x5 else B
    outreal(A(10, 1, -1, -1, 1, 0))
    Algol uses "pass by name", so there's a little bit of nastiness to be had here. I'm not actually 
    sure what the second B in B := refers to.
    After some thinking, it looks like it refers to B in the frame when it was put in there.
    Which is a little annoying.
    So...I'll pass structures containing pointers to functions that take that structure -_-'.
    struct S{
    	int (*fun)(S*);
    Then things should be sensible again.
    ;int32_t A(int32_t, void *, void *, void *, void *, void *); 
    ;void* parameter: some POD with a pointer to an int32_t function taking a pointer to that POD as parameter.
    ;A's Stack plan
    ;x5				104
    ;x4				96
    ;(x3) r9		88
    ;(x2) r8		80
    ;(x1) rdx		72
    ;(k) rcx		64 
    ;return			56 ;allocate 56
    ;A				48
    ;frame for B	40
    ;pointer for B	32
    ;call space		24
    ;call space		16
    ;call space		8
    ;call space		0
    	sub rsp,56
    	cmp ecx,0	;check k
    	jle sum
    	;On this branch the shadow space needs populating.
    	mov [rsp+64],rcx
    	mov [rsp+72],rdx
    	mov [rsp+80],r8
    	mov [rsp+88],r9
    	mov [rsp+40],rsp	;save the frame pointer for B
    	lea rax,B
    	mov [rsp+32],rax	;save B's address for B
    	lea rcx,[rsp+32]
    	call B				;call B on that pointer
    	mov eax,[rsp+48]	;get the return value out
    	jmp done
    	mov rcx,[rsp+96]	
    	call QWORD PTR [rcx];call x4
    	mov [rsp+48],eax	;save return
    	mov rcx,[rsp+104]	
    	call QWORD PTR [rcx];call x5
    	add eax,[rsp+48]	;sum to return.
    	add rsp,56
    A ENDP
    ;B's stack plan
    ;free			88
    ;free			80
    ;free			72
    ;(pointer)rcx	64
    ;return			56
    ;rbx			48
    ;p5				40
    ;p4				32
    ;p3				24
    ;p2				16
    ;p1				8
    ;p0				0
    	push rbx
    	.PUSHREG rbx
    	sub rsp,48
    	mov rbx,[rcx+8]			;get the saved frame pointer for A
    	dec DWORD PTR [rbx + 64];k <- k-1 in that frame
    	movdqu xmm0,[rbx+88]
    	movdqa [rsp+32],xmm0	;x3 and x4
    	mov r9,[rbx+80]			;x2
    	mov r8,[rbx+72]			;x1
    	mov rdx,rcx				;B
    	mov rcx,[rbx+64]		;k
    	call A					;A(k,B,x1,x2,x3,x4)
    	mov [rbx+48],eax		;save the result (as in the original code)
    	add rsp,48
    	pop rbx
    B ENDP
    ;Business to actually do things.
    EXTERN __imp_ExitProcess:PROC
    EXTERN __imp_GetStdHandle:PROC
    EXTERN __imp_WriteFile:PROC
    EXTERN __imp_wsprintfA:PROC 
    ALIGN 16
    pf0		dq f0
    pf1		dq f1
    pfm1	dq fm1
    format_string	db	"%d -> %d",0dh,0ah,0
    len_format_string = $-format_string
    end_string 		db	"Stack overflow!"
    len_end_string = $ - end_string
    output_string	db	1024 dup (?)
    f0:		xor eax,eax
    f1:		mov eax,1
    fm1:	mov eax,-1
    EXTERN __imp_RtlUnwind:PROC
    		sub rsp,8
    		;check what we can do with the exception
    		cmp DWORD PTR [rcx+4],0
    		jne do_nothing	;it's not something I can deal with unless it's continuable.		
    		cmp DWORD PTR [rcx],0c00000fdh 	;check for a stack overflow
    		jne do_nothing ;I can't do anything with it
    		;so...a stack overflow is to be had!
    		;It could come from windows, but that would be crazy.
    		mov r10,rdx	;save the exception frame
    		mov r9,0
    		mov r8,rcx
    		lea rdx,[ehandler_safe_position]
    		mov rcx,r10
    		call QWORD PTR [__imp_RtlUnwind]
    		xor rax,rax
    		add rsp,8
    		mov rax,1
    		add rsp,8
    		sub rsp,56
    		.ALLOCSTACK 56
    		mov rcx,-11
    		call QWORD PTR [__imp_GetStdHandle]
    		mov [rsp+80],rax
    		mov QWORD PTR [rsp+88],0
    		lea r11,[pf0]
    		mov [rsp+40],r11
    		lea r10,[pf1]
    		mov [rsp+32],r10
    		lea r9,[pfm1]
    		lea r8,[pfm1]
    		lea rdx,[pf1]
    		mov rcx,[rsp+88]			;here's k!
    		call A
    		mov r9,rax
    		mov r8,[rsp+88]
    		lea rdx,[format_string]
    		lea rcx,[output_string]
    		call QWORD PTR [__imp_wsprintfA]
    		mov QWORD PTR [rsp+32],0
    		lea r9,[rsp+64]
    		mov r8,rax
    		lea rdx,[output_string]
    		mov rcx,[rsp+80]
    		call QWORD PTR [__imp_WriteFile]
    		inc QWORD PTR [rsp+88]
    		jmp next
    		mov QWORD PTR [rsp+32],0
    		lea r9,[rsp+64]
    		mov r8,len_end_string
    		lea rdx,[end_string]
    		mov rcx,[rsp+80]
    		call QWORD PTR [__imp_WriteFile]
    		xor rcx,rcx
    		call QWORD PTR [__imp_ExitProcess]
    		add rsp,40
  4. Jussi Piitulainen said

    I modified the Algol 60 program by hand until GNU MARST would compile it: declared the xs (as integers), removed the space from inside an assignment operator, replaced the proper inequality symbol with its ASCII representation, added the 0 to compare against (huh?), and inserted a couple of semicolons. And added a “channel” where the result is printed: 1 for stdout.

    MARST processes Algol 60 according to a Modified Report, 1976, which applies a Supplement to the Revised Report. (Scheme would later follow its Revised Report, 1978, with a Revised Revised Report.)

    real procedure A(k, x1, x2, x3, x4, x5);
    value k; integer k;
    integer x1, x2, x3, x4, x5;
    real procedure B;
    k := k – 1;
    B := A := A(k, B, x1, x2, x3, x4)
    if k <= 0 then A := x4 + x5 else B
    outreal(1, A(10, 1, -1, -1, 1, 0))

    MARST translates Algol 60 to C. MARST agrees with those who say that the answer should be -67.

    $ ./marst knuth.alg -o knuth.c
    $ gcc knuth.c -L .libs -lalgol -lm -o knuth
    $ LD_LIBRARY_PATH=.libs/ ./knuth
    -67 $

    MARST comes with a converter from earlier forms of the language. I haven’t tried the converter. Was that 0 really optional at some stage?

    I’m also wondering why the result should be declared real. This is clearly integer arithmetic.

  5. Jussi Piitulainen said

    I object to the eating of the indentations. Happily they weren’t all that crucial this time.

  6. kernelbob said

    This was a fun problem. Thanks!

    @namako, that was beautiful.

    Here are two solutions. The first, in Python 3, reads a lot like the original. The trickiest part was having B find the right instance of k.

    #!/usr/bin/env python3
    from itertools import count
    import sys
    def name(x):
        def v():
            return x
        return v
    def A(k, x1, x2, x3, x4, x5):
        k = [k[0]]
        def B():
            k[0] -= 1
            return A(k, B, x1, x2, x3, x4)
        if k[0] <= 0:
            return x4() + x5()
            return B()
    for k in count():
        print(k, A([k], name(1), name(-1), name(-1), name(1), name(0)))

    And here is one in C. C is really badly suited for this process, though this C programs runs faster than Our Gracious Host’s solution in Ikarus Scheme. Most Scheme compilers have to search the environment for the nonlocal variable k, I think, while the C program increments k in O(1) time.

    I tried to follow the spirit of Algol 60, using thunks and explicit stack frames to evaluate parameters with call-by-name semantics. If I limit the process’s stack size to 16 GB, I can also evaluate k=27. (My workstation only has 16 GB, so going higher is horribly slow as the virtual memory system thrashes.)

    #include <assert.h>
    #include <stdbool.h>
    #include <stdio.h>
    typedef struct thunk thunk;
    typedef int getter(thunk *);
    typedef void setter(thunk *, int);
    struct thunk {
        void *frame;
        getter *get;
        setter *set;
    static void set_constant(thunk *p, int new_value)
        assert(false && "can't assign to constant");
    typedef struct A_frame {
        int A;
        int k;
        thunk x1;
        thunk x2;
        thunk x3;
        thunk x4;
        thunk x5;
    } A_frame;
    int A(int k, thunk *x1, thunk *x2, thunk *x3, thunk *x4, thunk *x5);
    int B(A_frame *);
    static int get_B(thunk *p)
        return B(p->frame);
    static void set_B(thunk *p, int new_value) {
        assert(false && "can't assign to B");
    int B(A_frame *ap) {
        ap->k -= 1;
        thunk t1 = { ap, get_B, set_B };
        return ap->A = A(ap->k, &t1, &ap->x1, &ap->x2, &ap->x3, &ap->x4);
    int A(int k, thunk *x1, thunk *x2, thunk *x3, thunk *x4, thunk *x5)
        A_frame f;
        if (k <= 0) {
            f.A = x4->get(x4) + x5->get(x5);
        } else {
            f.k = k;
            f.x1 = *x1;
            f.x2 = *x2;
            f.x3 = *x3;
            f.x4 = *x4;
            f.x5 = *x5;
        return f.A;
    static int get_plus1(thunk *p)
        return +1;
    static int get_minus1(thunk *p)
        return -1;
    static int get_zero(thunk *p)
        return 0;
    int main()
        int k = 0;
        while (true) {
            thunk t1 = { NULL, get_plus1,  set_constant };
            thunk t2 = { NULL, get_minus1, set_constant };
            thunk t3 = { NULL, get_minus1, set_constant };
            thunk t4 = { NULL, get_plus1,  set_constant };
            thunk t5 = { NULL, get_zero,   set_constant };
            printf("k=%d, A=%d\n", k, A(k, &t1, &t2, &t3, &t4, &t5));
  7. kernelbob said

    One more note. The first time I used Algol-60 was in the MIT introductory CS class, 6.031, in 1979. The last time I used Algol-60 was also in 6.031 in 1979. (-:

  8. Jussi Piitulainen said

    I’m stll puzzled at Knuth declaring those procedures “real”. They seem to work fine as “integer” (-67, using GNU MARST to compile).
    (And I’m hoping to have it indented as intended this time.)

        comment replaced real with integer procedures;
        comment why where they real?;
        integer procedure A(k, x1, x2, x3, x4, x5);
        value k; integer k;
        integer x1, x2, x3, x4, x5;
            integer procedure B;
               k := k - 1; 
               B := A := A(k, B, x1, x2, x3, x4)
            if k <= 0 then A := x4 + x5 else B
        outstring(1, "The correct (integer!) answer is ");
        outreal(1, A(10, 1, -1, -1, 1, 0));
        outstring(1, ".\n")

Leave a Reply

Fill in your details below or click an icon to log in: Logo

You are commenting using your account. Log Out /  Change )

Google photo

You are commenting using your Google account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

%d bloggers like this: