Here are codes in Tcl, Sparc Assembly and x86 Assembly.
First Tcl (which works only for versions >= 8.5, thanks to Matthias Benkard):
set zero {f {list x {expr $x}}}
proc succ {number} {
set number_body [string range [lindex $number 1] 8 end-1]
if [string equal [lindex $number_body 0] "expr"] {
set number_body {expr $x}
}
return "f {list x "apply {$f} \[$number_body\]"}"
}
proc get_church_numeral {n} {
global zero
set numeral $zero
for {set i 0} {$i < $n} {incr i} {
set numeral [succ $numeral]
}
return $numeral
}
Then in SPARC Assembly, also thanks to Matthias Benkard, see here for the most current version:
!!! -*- mode: asm; asm-comment-char: ?! -*-
!!! SPARC assembly language
!!! Church numerals
!!! Copyright 2009, Matthias Andreas Benkard
!!! Compile with:
!!! gcc -o church-numerals church-numerals.S
!! 16 extended words (64 bit) for the register window.
!!#define FRAME_SIZE (16*8)
!! 16 words (32 bit) for the register window.
#define FRAME_SIZE 64
.section ".text"
.global main
.id: save %sp, -FRAME_SIZE, %sp
.id_set_function:
!! function to call (set 0, %l0)
sethi %hi(0), %l0
or %l0, %lo(0), %l0
mov %i0, %o0
.id_footer:
ret
restore %o0, 0, %o0 ! move %i0 to %o0
.id_end:
nop
.church_function_call:
call %l0
nop
.church_copy_function:
mov %l2, %o0
set .church_function_call, %o1
set (.church_copy_function - .church_function_call), %o2
!! We can't simply `call memmove' here because that would make
!! this a relative branch. Relative branches are bad. Bad,
!! bad, bad. See, we want to relocate this code by copying stuff
!! around. Relative branches hurt. Really, they do.
set memmove, %g1
call %g1
nop
add %l2, (.church_copy_function - .church_function_call), %l2
.church_end:
nop
!!! The Church numeral for zero. As is, it returns a copy of id, but it's
!!! also a template for all other Church numerals. Comments in square
!!! brackets signify places that church_succ alters.
!!!
!!! A Church numeral generally expects a subroutine pointer in %i0 and
!!! returns a pointer to a newly allocated function closure in %i0 and its
!!! size in %i1. The closure, when called, calls the subroutine passed to
!!! the numeral n times where n is the number represented by the Church
!!! numeral.
church_zero:
save %sp, -FRAME_SIZE, %sp
!! Allocate enough room for id
set (.id_end - .id), %o0
church_zero_call_malloc:
add %o0, 0, %o0 ! [modify this]
mov %o0, %l1
set malloc, %g1
call %g1
nop
mov %o0, %l0
church_zero_copy_id_header:
!! Copy id header to allocated region
mov %l0, %o0
set .id, %o1
set (.id_footer - .id), %o2
set memmove, %g1
call %g1
nop
add %l0, (.id_footer - .id), %l2
church_zero_copy_id_footer:
!! [Insert function call copying here]
!! Copy id footer to allocated region
mov %l2, %o0
set .id_footer, %o1
set (.id_end - .id_footer), %o2
set memmove, %g1
call %g1
nop
!! Modify function pointer within the closure.
add %l0, (.id_set_function - .id), %l2
srl %i0, 10, %l4
and %i0, 0x3ff, %l5
ld [%l2], %l3
or %l3, %l4, %l3
st %l3, [%l2]
ld [%l2+4], %l3
or %l3, %l5, %l3
st %l3, [%l2+4]
!! Return address to region along with size
mov %l0, %i0
mov %l1, %i1
ret
restore
church_zero_end:
nop
!!! Church numeral successor function. This is the interesting part of the
!!! programme. It expects a Church numeral in %i0 and its size in %i1 and
!!! returns the successor numeral in %i0 along with its size in %i1.
church_succ:
!! %i0: block
!! %i1: length of block
save %sp, -FRAME_SIZE, %sp
add %i1, (.church_end - .church_copy_function), %l1
mov %l1, %o0
set 1, %o1
call calloc
nop
mov %o0, %l0
!! Copy first part of the Church number.
mov %i0, %o1
set (church_zero_copy_id_footer - church_zero), %o2
call memmove
nop
!! Modify closure allocation size.
add %l0, (church_zero_call_malloc - church_zero), %l2
ld [%l2], %l4
and %l4, 0xfff, %l4 ! load lower 12 bits
add %l4, (.church_copy_function - .church_function_call), %l4
ld [%l2], %l3
srl %l3, 12, %l3
sll %l3, 12, %l3
or %l3, %l4, %l3
st %l3, [%l2]
!! Note that we have now got the number of synthesised
!! instruction blocks, multiplied by the block length, in %l4.
udiv %l4, (.church_copy_function - .church_function_call), %l4
dec %l4
!! Add an instance of .church_copy_function.
add %l0, (church_zero_copy_id_footer - church_zero), %o0
set .church_copy_function, %o1
set (.church_end - .church_copy_function), %o2
call memmove
nop
!! Copy the second part of the Church number.
add %l0, (church_zero_copy_id_footer - church_zero + .church_end - .church_copy_function), %o0
add %i0, (church_zero_copy_id_footer - church_zero), %o1
umul %l4, (.church_end - .church_copy_function), %o2
add %o2, (church_zero_end - church_zero_copy_id_footer), %o2
call memmove
nop
mov %l0, %i0
mov %l1, %i1
ret
restore %g0, %g0, %g0
!!! An example function to test the numerals with. You should be able
!!! to substitute any function that obeys the SPARC calling conventions
!!! for it.
increment:
retl
inc %o0
main: save %sp, -FRAME_SIZE, %sp
set church_zero, %o0
set (church_zero_end - church_zero), %o1
call church_succ
nop
call church_succ
nop
call church_succ
nop
call church_succ
nop
mov %o0, %l0
mov %o1, %l1
set increment, %o0
call %l0
nop
mov %o0, %l0
clr %o0
call %l0
nop
mov %o0, %o1
set .msg, %o0
call printf
nop
ret
restore %g0, 0, %o0
.section ".data1"
.align 4
.msg: .ascii "Result: %dn"
.msg_end:
.skip 4
And finally, my own code, in x86 assembly (tested unter x86, 32 bit, Linux):
/** An Implementation of Church Numerals in x86 assembly
* Copyright 2009, Christoph Senjak
* compile with gcc -o church church.S
*/
#define ENTER_FN
pushl %ebp;
movl %esp, %ebp
#define EXIT_FN
movl %ebp, %esp;
popl %ebp;
ret
.global main
.section .data
format:
.ascii "%dn"
id: # x=>x
ENTER_FN
movl 8(%esp), %eax
EXIT_FN
nfnx: #n, f, x => f(n(f)(x))
ENTER_FN
#calculate n(f)
pushl 12(%ebp) #f
movl 8(%ebp), %eax #n
call *%eax
popl %ecx
#%eax = n(f)
#calculate n(f)(x)
pushl 16(%ebp) #x
call *%eax
popl %ecx
#%eax = n(f)(x)
#calculate f(n(f)(x))
pushl %eax #n(f)(x)
movl 12(%ebp), %eax #f
call *%eax
popl %ecx
#eax = f(n(f)(x))
EXIT_FN
fn_ret: #x
ENTER_FN
pushl 8(%ebp) # push x
movl $0xFFFFFFFF, %eax # replace by f
pushl %eax
movl $0xEEEEEEEE, %eax # replace by n
pushl %eax
movl $nfnx, %eax
call *%eax
popl %ecx
popl %ecx
popl %ecx
EXIT_FN
.set fn_ret_len, . - fn_ret
fn: #f, n
ENTER_FN
#allocate memory
pushl $fn_ret_len
call malloc
popl %ecx
pushl $fn_ret_len
pushl $fn_ret
pushl %eax
call copy_bytes
popl %eax
popl %ecx
popl %ecx
movl %eax, %ecx
addl $7, %ecx #insert f and n
movl 8(%ebp), %edx
movl %edx, (%ecx)
addl $6, %ecx
movl 12(%ebp), %edx
movl %edx, (%ecx)
EXIT_FN
cs_ret: #f
ENTER_FN
movl $0xFFFFFFFF, %eax # replace by n
pushl %eax
pushl 8(%ebp) # push f
movl $fn, %eax
call *%eax
popl %ecx
popl %ecx
EXIT_FN
.set cs_ret_len, . - cs_ret
.section .text
churchZero: #f => id
ENTER_FN
movl $id, %eax
EXIT_FN
churchSucc: # n => n+1
ENTER_FN
#allocate memory
pushl $cs_ret_len
call malloc
popl %ecx
pushl $cs_ret_len
pushl $cs_ret
pushl %eax
call copy_bytes
popl %eax
popl %ecx
popl %ecx
movl %eax, %ecx
addl $4, %ecx #insert n
movl 8(%ebp), %edx
movl %edx, (%ecx)
EXIT_FN
copy_bytes: #dest source length
ENTER_FN
subl $24, %esp
movl 8(%ebp), %ecx # dest
movl %ecx, -4(%ebp)
movl 12(%ebp), %ebx # source
movl %ebx, -8(%ebp)
movl 16(%ebp), %eax # length
movl %eax, -12(%ebp)
addl %eax, %ecx # last dest-byte
movl %ecx, -16(%ebp)
addl %eax, %edx # last source-byte
movl %ecx, -20(%ebp)
movl -4(%ebp), %eax
movl -8(%ebp), %ebx
movl -16(%ebp), %ecx
copy_bytes_2:
movb (%ebx), %dl
movb %dl, (%eax)
incl %eax
incl %ebx
cmp %eax, %ecx
jne copy_bytes_2
EXIT_FN
incf: #n
ENTER_FN
movl 8(%ebp), %eax
incl %eax
EXIT_FN
main:
ENTER_FN
# generate the church number 10
movl $churchZero, %eax
movl $10, %ecx
start_succ_loop:
pushl %ecx
pushl %eax
call churchSucc
popl %ecx
popl %ecx
loop start_succ_loop
#call it with incf
pushl $incf
call *%eax
popl %ecx
#call 10(incf)(0)
pushl $0
call *%eax
popl %ecx
#print out aftermath
pushl %eax
pushl $format
call printf
movl $0, %eax
EXIT_FN
