Introduction⌗

I really like SKI calculus. The thing that initially introduced me to it was the Esolangs wiki. Also, I read the works of John Tromp on binary lambda calculus and binary combinatory logic (I really enjoyed these and I can recommend them to anyone who wishes to study Kolmogorov complexity’s limits). One evening in June 2020, I implemented the following combinator calculus beta-reduction machine for the purposes of a code golf submission:

#define J putchar
#define H O->a
#define G H->a
#define K O->b
typedef struct x{struct x*a,*b;int q;}Y;Y*O;z=1;A(q){O=calloc(6,4);O->q=q;}h(Y*O
){Y*u;O=H&&H->q==2?z=K:H&&G&&G->q==1?z=H->b:H&&G&&G->a&&!G->a->q?u=A(3),(u->a=A(
3))->a=G->b,(u->b=A(3))->a=H->b,u->a->b=u->b->b=K,z=u:(O->q==3?H=h(H),K=h(K):0,O
);}r(x){Y*O;x=getchar()-73;x=x+33?A(x?x!=10:2):!getchar(K=r(H=r(O=A(3))))+O;}q(Y
*O){O&&J(O->q["SKI "],O->q-3||J(41,q(K),q(H),J(40)));}main(){Y*O=r();for(;z;O=h(
O))z=0;q(O);}

It’s 476 bytes big and most of the space is being taken by the complex combinator expansion logic. This encouraged me to research the topic further. First, I started researching other combinators - I already was aware of lambda calculus and functional programming, so naturally the first combinator I took on was the fixed point combinator (Y). Later, I discovered the BCW system made by Haskell Curry and quickly wrote a transpiler from the BCW system to the SKI system:

#!/usr/bin/perl -p
s/B/((S(KS))K)/g;
s/C/((S((S(K((S(KS))K)))S))(KK))/g;
s/W/((SS)(SK))/g;

The BCWK system (borrowing the K from SKI calculus) is fairly reasonable and intuitive. First two combinators swap their arguments: B x y z = (((B x) y) z) = ((B x) (y z)) = B x (y z), C x y z = (((C x) y) z) = ((x z) y) = x z y. The last combinator, W, is just W x y = ((W x) y) = ((x y) y) = x y y.

Notation⌗

Pondering these made me think about the notation that I use for writing down my SKI calculus programs. So far, I assumed that the input is a perfect binary tree of combinators. But since it’s a binary tree, i.e. each node can have only either two combinators, two nodes, a combinator and a node, or a node and a combinator inside it, we don’t need the closing parens anymore!. Let me explain. This is a mostly readable version of the evaluator above:

/* All the possible node types. */
#define NODE_BI 1
#define NODE_S 2
#define NODE_K 3
#define NODE_I 4

struct node_t {
    struct node_t * left, * right;
    char type;
};

struct node_t * new_node(void) { /* implementation detail */ }

// The reading function
struct node_t * read() {
    switch(getchar()) {
        case '(': {
            struct node_t * u = new_node(NODE_BI);
            u->left = read();
            u->right = read();
            getchar(); // skip ')'
            return u;
        }
        
        case 'I': return new_node(NODE_I);
        case 'S': return new_node(NODE_S);
        case 'K': return new_node(NODE_K);
    }
}

An important observation is yet to be made - the reading function doesn’t actually use the closing paren for anything. So we replace it with a different character. I chose an apostrophe - '. Assuming the input doesn’t contain any data except (, S, K and I, the following program will convert the new notation to the old notation:

c;main(){c=getchar();if(c=='`'){putchar('(');main();main();putchar(')');}else putchar(c);}

… and the other way round:

c;main(){for(;~(c=getchar());)if(c!=')')putchar(c=='('?'`':c);}

Provided that I already went through the combinators and the closing parens, the element of the encoding to pick on would of course be the opening parens. In many cases - like this one: (((SK)K)I) they just feel unnecessary and redundant. The tree structure is fairly obvious at the first glance and SKKI would be so much more readable. This would mean that tree node nesting binds to the left. Illustratively, α β γ becomes ((α β) γ), α β γ δ becomes (((α β) γ) δ), and so on. A(BCDE)F becomes ((A(((BC)D)E))F).e I decided to call this the free-form encoding of combinator calculus. The free-form notation can be easily translated to the binary free notation using this small bit of code:

#define R return
#define P putchar
#define T x->q
typedef struct a{struct a*x,*y;int q;}b,*c;c M(q){
c x=malloc(sizeof(b));x->x=x->y=0;T=q;R x;}c f();c
n(){int c=getchar();if(c==40)R f();if(c==41||c==-1
)R 0;if(isalpha(c))R M(c);R n();}c f(){c x=M(-1),y
,z;z=x->x=n();if(!z)R 0;while(y=n())z=z->y=y;R x;}
void q(c x){if(!x)R;if(~T)P(T);else{c z=x->x;while
(z->y){P(40);z=z->y;}z=x->x;q(z);while(z=z->y){q(z
);P(41);}}}main(){q(f());}

This, of course, assumes that the free-form notation derives from the binary tree notation. But what if we used our simplified notation instead? This would bring down the size even further - α β γ becomes ((α β) γ), α β γ δ becomes (((α β) γ) δ), and so on. Let’s sum up all the encoding laws we came up with so far:

  • in the binary tree notation, the closing paren is never necessary.
  • the free-form notation is just as powerful as the binary tree notation.

Having worked out these, now let’s bring the encoding to some binary format. First, we start by noticing that the three combinators and the tree node opening character are 4 different states in total, which means that we can encode them with 4 bits. The encoding would be, for example:

00 - '
01 - S
10 - K
11 - I

… but just as well we could drop the I combinator (as it’s simply just SKK), meaning that we have three states now, so we can encode our data using one or two binary digits:

0  - '
10 - S
11 - K

Because the drawbacks of each encoding aren’t instantaneously obvious, we can test them on a few example SKI calculus expressions. Example:

{
    (((S((S(KI))((S((S(KI))I))(K(K(KI))))))(K((S(KK))I)))(
    (S((S(KI))((S(K((S(KS))(S(KI)))))((S(KK))I))))(KI)))
    <=> [ replacing I with (SK)K ]
    (((S((S(K((SK)K)))((S((S(K((SK)K)))((SK)K)))(K(K(K((SK
    )K)))))))(K((S(KK))((SK)K))))((S((S(K((SK)K)))((S(K((S
    (KS))(S(K((SK)K))))))((S(KK))((SK)K)))))(K((SK)K))))
}
=> (convering to simplified form) {
    '''S''S'KI''S''S'KII'K'K'KI'K''S'KKI''S''S'KI''S'K''S'KS'S'KI''S'KKI'KI
    <=>
    '''S''S'K''SKK''S''S'K''SKK''SKK'K'K'K''SKK'K''S'KK''SKK''S''S'K''SKK''
    S'K''S'KS'S'K''SKK''S'KK''SKK'K''SKK
}
=> (conveting to binary) {
    0000000100000100101100000100000100101111001000100010110010000001001010110000010000010010110000010010000001001001000100101100000100101011001011
    <=>
    00010001001100101111001000100110010111100101111011011011001011110110010011110010111100100010011001011110010011001001110010011001011110010011110010111101100101111
}
=> (converting to hexadecimal) {
    233896F70BDC3C4AFCC09510647F2E47B62F78384995A33A1B538CB46296BD6AA11B51F11E8018A6D2744F76F956D1B48DB0651FF163CEB3
    <=>
    2E9E8A31763346A56A1C2472720F66E0C0F95635EE71C4861C282CC2856F5F64F8AFA8967B8B8AADC44313EE9C6B0E88B1F7057BD7F8BF144E24B8062EF65340DF7
}

The implications are fairly simple - adding new combinators is generally beneficial for the code size (I managed to replicate the same effect on a bunch of SKI calculus expressions). This was just about what I expected - all in all, dictionary compession is pretty much the baseline standard nowadays.

Implementing⌗

In February 2021, I implemented a tiny (976 byte .exe file) SKI calculus evaluator with a GUI for Windows. The code follows.


; A tiny SKI calculus evaluator.
; Copyright (C) Kamila Szewczyk, 2020.
; ------------------------------------
; A bit less braindead version of the bundled 976-byte binary,
; it doesn't leak the memory like a sieve and starts a bit faster,
; at the expense of being larger out-of-the-box (I could pack it
; with my packer to around 1,66K).

format PE GUI 4.0

entry _start

include 'win32ax.inc'

; Node in memory:

; ESI     ESI+4     ESI+8
; v       v         v
; +--------------------------+
; | left  |  right  |  type  |
; +--------------------------+

node.left  equ 0
node.right equ 4
node.type  equ 8

; SKI nodes
TYPE_S  equ 0
TYPE_K  equ 1
TYPE_I  equ 2

; alloc_node node holding two other nodes.
TYPE_BI equ 3

section '.text' code readable executable writeable
    ; Program entry point.
    ; Create the dialog, hook up the dialog procedure,
    ; enter an event loop.
    proc _start
        ; Create a heap, store it's handle in asmh.
        invoke HeapCreate, 0, 0, 0
        mov DWORD [asmh], eax
        ; Get the handle of the current module
        invoke GetModuleHandleA, 0
        ; ... and use it to create a dialog box.
        ; 1 here is the resource identifier for the form.
        invoke CreateDialogParamA, eax, 1, 0, DialogProc, 0
        ; store the dialog handle in hDlg.
        mov DWORD [hDlg], eax
        ; show the dialog.
        invoke ShowWindow, eax, SW_SHOW
        ; window message loop.
    .message_loop:
        ; fetch the next message to msg.
        invoke GetMessage, msg, 0, 0, 0
        ; GetMessage returns 0 => quit
        test eax, eax
        je .quit
        ; if the return value != -1
        inc eax
        jne .isdlg
        ; return value == -1 => an error occured.
        ; ExitProcess(1)
        push 1
        jmp .die
    .isdlg:
        ; is it a dialog message?
        invoke IsDialogMessageA, hDlg, msg
        ; nope, ignore.
        test eax, eax
        jne .message_loop
        ; Otherwise, translate and dispatch it.
        invoke TranslateMessage, msg
        invoke DispatchMessage, msg
        jmp .message_loop
    .quit:
        ; ExitProcess(0)
        push 0
    .die:
        call [ExitProcess]
    endp

    ; Dialog procedure - handling incoming messages.
    proc DialogProc
        ; Stack frame construction.
        push ebp
        mov ebp, esp
        sub esp, 16
        mov edx, DWORD [ebp+12]
        mov eax, DWORD [ebp+8]
        mov ecx, DWORD [ebp+16]
        ; handle WM_CLOSE
        cmp edx, WM_CLOSE
        je .close_handler
        ; handle WM_COMMAND
        cmp edx, WM_COMMAND
        je .command_handler
        ; don't handle everything not being WM_DESTROY
        ; (return FALSE)
        cmp edx, WM_DESTROY
        jne .no_op
        ; ... so we're handling WM_DESTROY here.
        invoke PostQuitMessage, 0
        jmp .c_exit
    .close_handler:
        ; WM_CLOSE => pass around the WM_DESTROY message.
        invoke DestroyWindow, eax
    .c_exit:
        ; common WM_DESTROY and WM_CLOSE fallthrough.
        ; return TRUE.
        xor ebx, ebx
        inc ebx
        ; the only way out is to
        jmp .die
    .command_handler:
        ; 2 is the '&Quit' button ID.
        ; If anything other has been pressed, branch.
        cmp cx, 2
        jne .not_quit
        ; Quit button pressed -> die
        invoke DestroyWindow, eax
    .no_op:
        ; a RETURN FALSE stub for lacking handlers for
        ; WM_COMMAND cases and unknown message ID's.
        xor ebx, ebx
        jmp .die
    .not_quit:
        ; '&Quit' wasn't pressed, so maybe it was '&Evaluate'?
        ; return FALSE if LOWORD(ecx) != 1
        xor ebx, ebx
        dec cx
        jne .die
        ; '&Evaluate' pressed, handle that.
        ; Get the handle to the 3rd dialog item => the expression input
        invoke GetDlgItem, eax, 3
        ; stuff it in wnd
        mov DWORD [wnd], eax
        ; get the text length to allocate approperiate amount of space on the stack
        invoke GetWindowTextLengthA, eax
        ; Save the esp
        mov ecx, esp
        ; Reserve space for the null terminator.
        ; Basically, we're constructing a buffer on the stack
        lea edx, [eax+1]
        add eax, 17
        and eax, 0xFFFFFFF0
        sub ecx, eax
        mov esp, ecx
        ; While we're at it, null-terminate it.
        mov BYTE [esp], 0
        ; Read the control data, put it in the buffer.
        mov DWORD [ebp-12], ecx
        invoke GetWindowTextA, DWORD [wnd], ecx, edx
        mov ecx, DWORD [ebp-12]
        ; Evaluate it.
        call eval
        ; Reset the control text.
        invoke SetWindowText, DWORD [wnd], eax
    .die:
        ; Pop off the VLA
        lea esp, [ebp-8]
        ; Set the correct return value.
        mov eax, ebx
        ; Balance the stack
        pop ebx
        pop esi
        pop ebp
        ret 16
    endp

    ; Calculate the size of the tree, stringified.
    ; Takes the tree in eax.
    proc str_size
        ; Preserve and clear eax, make a copy of the
        ; pointer in ebx.
        push esi ebx
        xor esi, esi
        mov ebx, eax
    .loop:
        ; if node.type == TYPE_BI, then it has two children
        cmp DWORD [ebx+node.type], TYPE_BI
        jne .quit
        ; Apparently it does.
        ; left-recurse to get the lhs size
        mov eax, DWORD [ebx+node.left]
        call str_size
        ; eax contains the lhs size, so everything left
        ; is the rhs size. loop on the right node.
        mov ebx, DWORD [ebx+node.right]
        ; add two bytes for '(' and ')'
        lea esi, [esi+eax+2]
        jmp .loop
    .quit:
        ; The node doesn't have two children - return 1
        ; (a single byte for either S, K or I)
        lea eax, [esi+1]
        pop ebx esi
        ret
    endp

    ; Stringify the tree.
    ; Take it in eax. The buffer is static and
    ; it's the callers' duty to allocate it.
    proc stringify
        ; copy the node pointer to ebx
        push ebx
        mov ebx, eax
        ; first, take the node type.
        mov edx, DWORD [eax+node.type]
        ; because no matter where we branch the buffer will be used,
        ; preload it.
        mov eax, DWORD [buf]
        ; increment the current buffer pointer stored in the variable
        ; and hold own instance, which points to one byte before
        inc eax
        mov DWORD [buf], eax
        dec eax
        ; has two children?
        cmp edx, TYPE_BI
        jne .combinator
        ; alloc_node tree starts with '('
        mov BYTE [eax], '('
        ; Recurse on the lhs and rhs
        mov eax, DWORD [ebx+node.left]
        call stringify
        mov eax, DWORD [ebx+node.right]
        call stringify
        ; increment pointer, store the ')'.
        mov eax, DWORD [buf]
        mov BYTE [eax], ')'
        inc eax
        mov DWORD [buf], eax
        dec eax
        jmp .stop
    .combinator:
        ; stringify the combinator.
        ; use the lookup string for that.
        mov dl, BYTE [ski+edx]
        ; store back the letter.
        mov BYTE [eax], dl
        ; the pointer is already incremented, so we fall thru to return
    .stop:
        pop ebx
        ret
    endp

    ; a wrapper over HeapFree, which frees the pointer in eax.
    ; XXX: inline?
    proc free
        invoke HeapFree, DWORD [asmh], 0, eax
        ret
    endp

    ; free a tree recursively
    proc free_tree
        ; preserve ebx, make a copy of eax
        push ebx
        mov ebx, eax
        ; has children?
        cmp DWORD [eax+node.type], TYPE_BI
        jne .no_children
        ; recurse over children.
        mov eax, DWORD [eax+node.left]
        call free_tree
        mov eax, DWORD [ebx+node.right]
        call free_tree
    .no_children:
        ; take the copy, restore ebx, free the parent.
        mov eax, ebx
        pop ebx
        jmp free
    endp

    ; Allocate a new tree node.
    ; takes new nodes' type in eax.
    proc alloc_node
        ; preserve eax, because it will get trashed by HeapAlloc
        push ebx
        mov ebx, eax
        ; Call HeapAlloc, alloc 4 (left) + 4 (right) + 4 (type) B.
        ; Zero the memory so we don't have to set left and right to NULL.
        invoke HeapAlloc, DWORD [asmh], HEAP_ZERO_MEMORY, 4 + 4 + 4
        ; Set the type.
        mov DWORD [eax+node.type], ebx
        pop ebx
        ret
    endp

    ; read a node from the input buffer, and return it in eax.
    proc read_node
        ; preserve ebx
        push ebx
        ; load the code pointer
        mov eax, DWORD [code]
        ; increment it, store back
        inc eax
        mov DWORD [code], eax
        dec eax
        ; load a byte
        mov al, BYTE [eax]
        ; if al>'K' then al may be 'S'
        cmp al, 'K'
        je  .read_k
        jg  .maybe_s
        ; reading a tree
        cmp al, '('
        je  .read_bitree
        ; if it's not 'I', spew out an error.
        cmp al, 'I'
        jne .parse_error
        ; build an i-node
        push TYPE_I
        pop eax
        jmp .build_node
    .maybe_s:
        ; if it's not 'S', spew out an error.
        cmp al, 'S'
        jne .parse_error
        ; otherwise, clear eax (load TYPE_S)
        ; and build a new node.
        xor eax, eax
        jmp .build_node
    .read_bitree:
        ; load the approperiate type and allocate a node
        push TYPE_BI
        pop eax
        call alloc_node
        mov ebx, eax
        ; read the left node
        call read_node
        mov DWORD [ebx+node.left], eax
        ; eax = 0 => return NULL to broadcast an error.
        test eax, eax
        je .nullify
        ; read the right node
        call read_node
        mov DWORD [ebx+node.right], eax
        test eax, eax
        je .nullify
        ; no errors - increment the code pointer to skip the trailing `)`.
        inc DWORD [code]
        jmp .die
    .read_k:
        ; set eax to 1 (loading TYPE_K)
        ; and fall thru to construction of a new node.
        xor eax, eax
        inc eax
    .build_node:
        pop ebx
        jmp alloc_node
    .parse_error:
        ; in case of a parse error, display a message and fall thru to returning NULL.
        invoke MessageBoxA, 0, msge, 0, MB_OK
    .nullify:
        xor ebx, ebx
    .die:
        ; set the return value and quit
        mov eax, ebx
        pop ebx
        ret
    endp

    ; duplicate a tree in eax.
    proc dup_tree
        push esi ebx
        mov ebx, eax
        ; Make a new node with this node's type.
        mov eax, DWORD [eax+node.type]
        call alloc_node
        ; if type != TYPE_BI then return that instance.
        cmp DWORD [ebx+node.type], TYPE_BI
        jne .shallow
        ; else, clone recursively. copy the original
        ; ptr, because it will get overwritten
        mov esi, eax
        ; clone the left node
        mov eax, DWORD [ebx+node.left]
        call dup_tree
        mov DWORD [esi+node.left], eax
        ; clone the right node
        mov eax, DWORD [ebx+node.right]
        call dup_tree
        mov DWORD [esi+node.right], eax
        ; restore eax
        mov eax, esi
    .shallow:
        pop ebx esi
        ret
    endp

    proc eval_step
        push edi esi ebx
        mov ebx, eax
        ; has one child? if node.left == NULL
        mov eax, DWORD [eax+node.left]
        test eax, eax
        je .no_left
        ; if the first child's type is I
        cmp DWORD [eax+node.type], TYPE_I
        jne .not_inode
        ; got identity, so take the right node.
        mov esi, DWORD [ebx+node.right]
        ; free this node and the left node.
        jmp .clean
    .not_inode:
        ; it's not I. eax is now orig->left
        ; if orig->left->left->type == K
        mov edx, DWORD [eax+node.left]
        ; wait, maybe there is no left node
        test edx, edx
        je .no_left
        ; check the type.
        cmp DWORD [edx+node.type], TYPE_K
        ; branch if it's not K either.
        jne .not_knode
        ; free orig->right and orig->left->left
        ; keep and return orig->left->right
        mov esi, DWORD [eax+node.right]
        mov eax, DWORD [ebx+node.right]
        call free_tree
        mov eax, DWORD [ebx+node.left]
        mov eax, DWORD [eax+node.left]
        ; fallthru to free the orig->left->left node
    .clean:
        call free_tree
        mov eax, ebx
        call free
    .yield_saved:
        mov ebx, esi
        jmp .done
    .not_knode:
        ; if it's not a K or I node, then for sure it's either
        ; a node we have to evaluate recursively _or_ a S node.
        ; check for existence of X = orig->left->left->left
        mov edx, DWORD [edx]
        test edx, edx
        je .no_left
        ; X->type != TYPE_S?
        cmp DWORD [edx+node.type], TYPE_S
        jne .no_left
        ; ok, so definitely it's a S node.
        ; to get ((Sx)y)z = ((xz)(yz)), first build the outer binode.
        push TYPE_BI
        pop eax
        call alloc_node
        ; OK, save it in esi
        mov esi, eax
        ; build two another binodes, and put them as the left and right
        ; node of this tree.
        push 3
        pop eax
        call alloc_node
        mov DWORD [esi+node.left], eax
        push 3
        pop eax
        call alloc_node
        mov DWORD [esi+node.right], eax
        ; now the magic happens. do the following:
        ; (esi + node.left)->left = dup(orig->left->left->right)
        ; (esi + node.left)->right = dup(orig->right)
        ; (esi + node.right)->left = dup(orig->left->right)
        ; (esi + node.right)->right = dup(orig->right)
        ; I'm not sure if this many dup calls are required, but they
        ; help to shave off some space and trouble needed to free the
        ; correct elements of the trees. we're not really aiming for
        ; performance here, so it's alright.
        mov edi, DWORD [esi+node.left]
        mov eax, DWORD [ebx+node.left]
        mov eax, DWORD [eax+node.left]
        mov eax, DWORD [eax+node.right]
        call dup_tree
        mov DWORD [edi+node.left], eax
        mov eax, DWORD [ebx+node.right]
        mov edi, DWORD [esi+node.left]
        call dup_tree
        mov DWORD [edi+node.right], eax
        mov eax, DWORD [ebx+node.left]
        mov edi, DWORD [esi+node.right]
        mov eax, DWORD [eax+node.right]
        call dup_tree
        mov DWORD [edi+node.left], eax
        mov eax, DWORD [ebx+node.right]
        mov edi, DWORD [esi+node.right]
        call dup_tree
        mov DWORD [edi+node.right], eax
        ; free the original tree
        mov eax, ebx
        call free_tree
        jmp .yield_saved
    .no_left:
        ; maybe it's a binode, which we just need to evaluate
        ; deeper to get some observable result?
        cmp DWORD [ebx+node.type], TYPE_BI
        jne .done
        ; recurse twice. first set the left node, then the right node.
        call eval_step
        mov DWORD [ebx+node.left], eax
        mov eax, DWORD [ebx+node.right]
        call eval_step
        mov DWORD [ebx+node.right], eax
    .done:
        mov eax, ebx
        pop ebx esi edi
        ret
    endp

    ; the evaluation wrapper called by the DialogProc.
    ; takes the input buffer in ecx.
    eval:
        push esi ebx
        mov ebx, ecx
        ; store the input in the code buffer.
        mov DWORD [code], ecx
        ; read the expression.
        call read_node
        ; if read_node returns null, then an error occured
        test eax, eax
        je .read_fail
        ; call the evaluation procedure.
        call eval_step
        mov esi, eax
        ; find out the size of the buffer, stringified.
        call str_size
        ; allocate it a byte of extra space.
        inc eax
        invoke HeapAlloc, DWORD [asmh], 0, eax
        ; initialize the output buffer.
        mov DWORD [buf], eax
        ; save the output copy to ourselves to later return it.
        mov ebx, eax
        ; take back the saved buffer, stringify the input into it
        mov eax, esi
        call stringify
        ; NULL terminate
        mov eax, DWORD [buf]
        mov BYTE [eax], 0
        ; free the original tree
        mov eax, esi
        call free_tree
    .read_fail:
        ; in any case, return the value we've got.
        mov eax, ebx
        pop ebx esi
        ret

wnd:  dd 0
msg   MSG
hDlg: dd 0
asmh: dd 0
buf:  dd 0
code: dd 0
ski:  db 'SKI', 0
msge: db '?', 0

section '.rsrc' resource data readable
directory RT_DIALOG, dialogs
resource dialogs, 1, LANG_ENGLISH+SUBLANG_DEFAULT, demo
dialog demo,'SKI calculus',70,70,330,20,WS_CAPTION+WS_POPUP+WS_SYSMENU+DS_MODALFRAME
    dialogitem 'STATIC', '&Code: ', 4, 4, 5, 21, 9, WS_VISIBLE+WS_CHILD+WS_GROUP
    dialogitem 'BUTTON', '&Quit', 2, 269, 4, 50, 11, BS_PUSHBUTTON+WS_CHILD+WS_VISIBLE+WS_GROUP
    dialogitem 'BUTTON', '&Evaluate', 1, 218, 4, 50, 11, BS_DEFPUSHBUTTON+WS_CHILD+WS_VISIBLE+WS_GROUP
    dialogitem 'EDIT', '', 3, 28, 3, 187, 14, ES_LEFT+WS_CHILD+WS_VISIBLE+WS_BORDER+WS_GROUP+ES_AUTOHSCROLL
enddialog

section '.idata' import data readable writable
library kernel32, 'KERNEL32.DLL', \
        user32, 'USER32.DLL'

include 'api\kernel32.inc'
include 'api\user32.inc'

The code was initially published on Github alongside a larger, initial 1.6 kilobyte build. The evaluator being optimised for code size leaks memory like a sieve and doesn’t perform any validation of the input. But it works! And it’s small! Have you ever seen a sub-kilobyte, relatively usable functional programming language(*) evaluator?

* - of course, SKI calculus itself stretches the definition of a functional programming langauge, but considering that Haskell internally uses a typed lambda calculus-like IR, and lambda calculus terms are convertible to combinator calculus terms via abstraction ellimination, this might not be as big of an overstatement as you might have thought. SKI calculus is nowhere near being usable, but it’s still more usable than Iota calculus or any other more minimalistic functional language interpreter.

Making combinator calculus terms⌗

Now, as I have learned how to evaluate, try various different encodings of combinator calculus, and make my own small terms, the only thing left is compiling a higher level language to SK(I) calculus, or more generally, just combinator calculus. The idea follows.

Custom combinators are defined using %[name] [code until the end of the line]. [name] can be any letter, including greek letters. For example - %Y (((SK)K)((S(K((SS)(S((SK)K)))))K)) defines the fixed point combinator as Y. Let’s define a few combinators for a good start:

%I ((SK)K)
%B ((S(KS))K)
%C ((S((S(KB))S))(KK))
%W ((SS)(SK))
%Y (((SK)K)((S(K((SS)(S((SK)K)))))K))

Now, we can define a few basic barewords that are recognized inside expressions. For example:

$true:K
$false:KI
$succ:(SB)
$add:((SI)(K succ))
$0:(KI)
$1:I
$2:(succ 1)
$3:(succ 2)
$4:(succ 3)
$5:(succ 4)
$6:(succ 5)

… and for a good measure, multiplication and predecessor for Church numerals:

$mul:((S((S(KS))((S(K(SI)))((S(KK)) add))))(K(K 0)))
$pred:((S(K((SI)(K 0))))((S((SI)(K((S(K((S(K(S((SI)(K 0)))))K)))((S((\
    S((SI)(KK)))((SI)(K 0))))((S(K succ))((SI)(K 0))))))))(K((S((SI)(KK)))(K 0)))))

\ at the end of the line means that the bare word declaration is spans also the next line. Now the language gets a lispy feel. For instance, (pred 2) compiles to a really long chain of S, K’s and parens.

Concerns⌗

There are a few issues with this very simple design:

  • Numbers. Defining numbers, as awesome as it might feel, is really unweildy especially if it has to be done manually. For this reason, the language should introduce a bunch of macros that capture barewords based on regular expressions.
  • “Something went wrong during compilation, and I don’t know what.” - the classical issue with languages allowing crazy levels of metaprogramming. The language would somehow need to provide a way to “trace” all the expansions of barewords to find the casue of the error. Another (much better) solution would be adding types and constraints…
  • “My code doesn’t work and it’s a mess of S’s and K’s” - a type system and a bunch of constraints/concepts tied to each bareword would solve this problem. It would also be nice to have a builtin evaluator for these, anyway.

All of these concerns beg for a simple answer - “Get rid of the ‘powerful’ metaprogramming and replace it with consistent and predictable metaprogramming” and “Add a type system”.

The show ends here⌗

Disappointing, right? Now that we had a vision of possibly a Scheme-like language being compiled to combinator calculus…

But this content is reserved for future posts. Stay tuned, and I’ll supply a writeup on the combinator calculus language, soon.