Unlambda in K

  • Introduction
  • An s-k-i interpreter
  • An Unlambda interpreter
  • Special forms
  • Time-limited evaluation
  • Parsing
  • Display
  • Files
  • Abstraction elimination
  • API
  • Operation
  • Future work
  • Introduction

    This is an interim report on work in progress on a K implementation of David Madore's beautiful but exasperatingly difficult programming language Unlambda.

    Unlambda, variously described as an obfuscated functional programming language and, by the author, as "Your Functional Programming Language Nightmares Come True", contains only a handful of primitives: ` (binary function application) s k i (the Curry combinators) v (self-reference) d (lazy evaluation) c (call-with-current-continuation) r (print new line) and 256 single-character printing functions .x (of which r is one). Version 2 of the language adds a few more primitives (@ ? |, for input, and e, to exit the evaluation loop).

    Unlambda is an applicative functional language. The application of F to G is written `FG. Since every value in Unlambda is a function, the result of `FG is a function.

    Unlambda was intended as an "obfuscated" programming language: the elements are difficult to understand; and, once understood, are difficult to use as the building blocks of non-trivial programs. Consider, for example, the following program, which computes the Fibonacci numbers, and prints them as successive lines of asterisks:

    ```s``s``sii`ki
     `k.*``s``s`ks
    ``s`k`s`ks``s``s`ks``s`k`s`kr``s`k`sikk
     `k``s`ksk

    Unlambda is interesting for two reasons:

    First, it presents in very pure form several ideas drawn from more-or-less remote realms of computer science: lazy evaluation (the 'd' built-in), continuations ('c'), stackless evaluation, tail-recursion, and abstraction-elimination (the elimination of bound variables in favor of combinators). Mastering the black art of programming in Unlambda leads to deeper understanding of these rebarbative concepts.

    Second, the presence of lazy evaluation and continuations, apart from serving the author's goal of obfuscating the Unlambda language proper, presents interesting difficulties in the implementation of an Unlambda interpreter in a language which lacks those features. Despite the fact that K is such a language, the present implementation is, I believe, the smallest such achieved to date.

    One of my goals in this project is to demonstrate how compact, efficient code is achievable in K: factor, factor, factor. With that end in mind, I have limited myself to a maximum of fifty-two named objects: a-z for current and future Unlambda primitives, and A-Z for interpreter objects. (E_ and Z_ are viewed as alternative implementations of the evaluation and trace functions).

    Other approaches are possible. For example, name only those objects which are part of the API, or which are called by more than one function; define the rest as locals.

    A second goal is to shed light on the concepts of Unlambda from a purely algorithmic point of view. The present paper contains no new examples of Unlambda programming, nor does it have anything new to say on the nature of the language. For that, the reader is advised to consult the official Unlambda page mentioned above.

    An s-k-i interpreter

    Before tackling the full Unlambda interpreter, we'll look at how one is written in K for a simple applicative language with three functions, the classical combinators s, k, and i.

    The language consists of four symbols:

    i
    k
    s
    `

    'i' is the identity function: it takes a single argument x and returns it:

    i x -> x

    'k' is the constant function: it takes two arguments x and y and returns x:

    k x y -> x

    's' is the substitution function: it takes three arguments x, y, and z, applies x to z, and the result of that to the application of y to z. In K notation, using f[x] to denote the application of f to x:

    s x y z -> x[z][y[z]]

    Our interpreter will treat all functions as monadic: a function takes exactly one argument and returns a single value. This is easy to understand in the case of 'i', which is defined to take one argument. But 'k' as defined above takes two arguments, and 's' takes three. So how does that work?

    We say that 'k' applied to x returns k[x], itself a function of one argument. When k[x] is applied it discards its argument and returns x, the value on which 'k' was called.

    Similarly for 's': applied to x it returns s[x], which, when applied to y returns s[x][y], which when applied to z returns x[z][y[z]]. That is, s[x][y] applied to z evaluates to the result of applying x[z] to y[z].

    '`' is application. It is not a function. Rather,

    `FG

    denotes the application of F to G.

    Given a string which represents an ski program, we parse it by replacing each character with the corresponding K function. Those functions are:

    s:{x[z][y[z]]}
    k:{y;x}
    i:{x}

    The ` character is replaced by K null.

    The interpreter will take a parsed program (the initial instruction stack), and () (the initial data stack), and repeatedly process the last data item and the next instruction until the result is the same twice in a row.

    An ski program can be interpreted by scanning it from the left or from the right, so we will have two interpreters, lr and rl.

    In the left-to-right case, at each step, the data and instruction stacks will satisfy exactly one of the following three patterns:

    .. `    : X ..
    .. X    : ` ..
    .. ` F  : G ..		where neither F nor G is `

    If the stacks satisfy one of the first two patterns, we push the next instruction onto the data stack:

    .. ` X  : ..
    .. X `  : ..

    otherwise we remove ` and F from the data stack, apply F to G, and push the result onto the instruction stack:

    ..      : F[G] ..

    In the right-to-left case, the interpreter is applied to the reversed program. At each step, we check to see which of the following two patterns match the data and instruction stacks:

    .. F G  : ` ..
    ..	: F ..

    If the stacks match the first pattern, we remove ` from the instruction stack, apply F to G, and push the result onto the data stack:

    .. F[G]	: ..

    If not, then the stacks must match the second pattern, in which case we move F from the instruction stack to the data stack:

    .. F	: ..

    Let's look at the K mechanics of interpretation, starting with the LR case.

    First, we need to parse the input program, and construct the initial data stack:

    p:(,()),,(s;k;i;)"ski"?/:

    For example:

      p"```skss"
    (()
     (;;;{x[z][y[z]]};{y;x};{x[z][y[z]]};{x[z][y[z]]}))

    The heart of the interpreter (eventually, we'll wrap the details in a function) is the step function:

    lr_:{x[1][y;z];:[~#z;(y;z);_n _in(-1#y),1#z;(y,1#z;1_ z);(-2_ y;x[0][*|y;*z],1_ z)]}

    lr_ takes three arguments:

    The first, x, is a pair of functions: an apply function x[0], and a display function x[1].

    The apply function x[0] takes two arguments: x, the object to apply, and y, the object to which x is to be applied, and returns x applied to y.

    The display function x[1] also takes two arguments: x, the data stack, and y, the instruction stack. The result is discarded.

    The apply function for interpretation is:

    a:{x[y]}

    The display function for interpretation is:

    :

    The second argument of lr_, y, is the data stack, and the third, z, is the instruction stack.

    lr_ first calls the display function on the data and instruction stacks.

    If the instruction stack z is empty, it returns (y;z) unchanged.

    If the last element of the data stack is null, or the next element of the instruction stack is null, the next instruction is moved to the data stack.

    Otherwise, the last two elements of the data are dropped, and the first element of the instruction stack is replaced with the application of the next instruction to the last data element.

    Notice that lr_ returns a pair of lists - the data stack and the instruction stack. When we're finished, we want to return just the first element of the data stack; i.e.,

    **(data stack;instruction stack)

    Assembling the parser, the step function, and the return processing, we have:

    lr:**(lr_[(a;::)].)/p@

    Similarly, for the right-to-left interpreter:

    rl_:{x[1][y;z];:[~#z;(y;z);_n~*z;((-2_ y),{x[z;y]}[*x]/-2#y;1_ z);(y,1#z;1_ z)]}
    rl:**(rl_[(a;:)].)/p@|:

    The step functions lr_ and rl_ can be used to compile ski programs into executable K expressions. To that end, we need to redefine the parser and the apply and display functions.

    The apply function 'a' takes a function x and an argument y and applies x to y: x[y]. Now suppose that x and y are not functions, but strings, fragments of code? Then we want the apply function to construct a string z from x and y s.t. . z = (. x)[. y]. Hence:

    b:{,x,"[",y,"]"}

    The display function for the interpreter is :. The compiler will use:

    t:{`0:,1_,/":",'30 -30$'{,/(@[x;&x~'_n;:;"`"]),""}'(x;y)}

    Instead of fully parsing the program to be compiled, we only replace the ` character:

    q:(,()),,("ski",_n)"ski"?/:

    The compilers are:

    lrk:**(lr_[(b;t)].)/q@
    rlk:**(rl_[(b;t)].)/q@|:

    Examples:

      lrk"```skss"
                                  :```skss
                                 `:``skss
                                ``:`skss
                               ```:skss
                              ```s:kss
                                ``:s[k]ss
                            ``s[k]:ss
                                 `:s[k][s]s
                          `s[k][s]:s
                                  :s[k][s][s]
                        s[k][s][s]:
    "s[k][s][s]"
      rlk"``s`kss"
                                  :ssk`s``
                                 s:sk`s``
                                ss:k`s``
                               ssk:`s``
                             sk[s]:s``
                            sk[s]s:``
                          ss[k[s]]:`
                        s[k[s]][s]:
    "s[k[s]][s]"

    The result of compilation is a string which, when executed, returns the value of the input program:

      ."s[k][s][s]"
    {x[z][y[z]]}

    An Unlambda interpreter

    The call-structure of the Unlambda interpreter is:

    E		outer interpreter
     Z		trace
      X		inner interpreter
       Y		next instruction
        T		terminate
        C		continue
        D		delay
        A		apply
         J		evaluate x[x]
          K		evaluate <cont>[x]

    The interpreter also calls:

    P	parser
    B	split XY into X Y 

    The outer interpreter E takes two arguments:

    x	display function (see U)
    y	Unlambda program to evaluate

    E is defined as:

    E:{Z[x]/("";();P y)}

    E creates an initial triple (x;y;z):

    x	no current character
    y	empty data stack
    z	parsed program

    It then repeatedly calls Z (projected on the display function x) on the current triple. The display function is applied to the triple. If the user types a character, the input is returned unaltered, causing the interpreter to exit (see Display below). Otherwise, X is called and returns the next (current character;data stack;instruction stack). Z is defined as:

    Z:{:[#x . y;y;X . y]}

    E will exit when the result is the same twice in a row.

    The inner interpreter X takes three arguments:

    x	the current character
    y	the data stack
    z	the instruction stack

    The current character is either "" or a one element character vector, e.g. ,"A".

    The data stack is a list, initialized to ().

    The instruction stack is a list, initialized to the parse of the program to be interpreted.

    The primitives, or in Unlambda lingo, "builtins", are defined as K functions:

    `	a:{a}				apply
    s	s:{a,a,x,z,a,y,z}		substitute
    k	k:{y;x}				constant
    i	i:{x}				identity
    v	v:{v}				void
    d	d:{a,a,f,y,x}			delay
    	f:{a,y,x}			force promise
    c	c:{a,x,y}			call-with-current-continuation
    e	e:{a,t,x}			exit
    	t:{t}				terminate		
    r	r:{`0:"\n";x}			print newline
    .x	p:{`0:x;y}			print x
    @	o:{a,x,:[#I::0:`;i;v]}		read character
    ?x	q:{a,y,:[I~,x;i;v]}		compare character read
    |	b:{a,x,:[#I;h i;v]}		reprint character read
    	h:{p[*x]}			project print

    X is the function:

    X:{:[~#z;(x;y;z);a~*z;(x;y,a;1_ z);Y[x;y,*z;1_ z]]}

    If the instruction stack z is empty, (x;y;z) is returned without any changes.

    If the next instruction is 'a' (that is, `), then 'a' is moved from the instruction stack to the data stack. Otherwise Y is called, with the next instruction moved to the data stack.

    Y is the function:

    Y:{:[3>i:(a,/:(t;c;d))?-2#y;(T;C;D)[i][x;-2_ y;B z];(3>#y)|a _in -2#y;(x;y;z);A[x;(-3_ y;-2#y);z]]}

    We first check to see if the data stack matches one of the following three patterns:

    .. a t		terminate
    .. a c		call-with-current-continuation
    .. a d		delay

    For each of these special forms there is a separate processor. We'll return to consider them below.

    If the data stack does not match one of these patterns, we check to see if it matches one of the following:

    X		a single element
    X Y		two elements
    .. a a		nothing to apply
    .. X a		nothing to apply
    .. a X		nothing to apply X to

    If the data stack matches one of these patterns (it might match several) there is nothing to do, so (x;y;z) is returned unchanged.

    If the data stack does not match any of these patterns, then it must match the pattern

    .. a X Y	apply X to Y

    We then call A with three arguments:

    x		current character
    y		data stack, partitioned (-3_ y;-2#y)
    z		instruction stack

    The first partition of y drops off the last three elements a X Y; the second partition consists of the pair (X;Y).

    A:{:[5=4:*y 1;K[y[1;0;`c];y[1;1];z];J[x;y;z]]}

    A is prepared to apply y[1;0] to y[1;1]. There are two cases. Either y[1;0] is a continuation or it is a function. If it is a continuation (5=4:*y 1) we call K, which we will examine in detail below. Otherwise, we call J:

    J:{I::x;(I;*y;y[1;0][y[1;1]],z)}

    The current character is assigned to I. We do this initially since the function to be applied y[1;0] may need to access it. We return a triple consisting of the current character (I), the new data stack (*y), and the result of applying y[1;0] to y[1;1], pushed onto the instruction stack.

    Why the instruction stack and not the data stack?

    Suppose y[1] is (s;X), where X is some value. Then the result of applying s to X is s[X], a projection of the 's' function. 's' takes three arguments, so s[X] takes two arguments. At some later point, s[X] may turn up on the data stack, and we will have (s[X];Y); so we perform the application, pushing s[X][Y], a function of one argument, onto the instruction stack. Still later, (s[X][Y];Z) may turn up, and the result of that application will be a,a,X,Z,a,Y,Z, since s[X][Y][Z] finally executes, and the result is pushed onto the instruction stack, where the components may eventually be processed.

    For this reason, we say that our interpreter is O(1): complex operations, which involve multiple applications, are repeatedly deferred, the application components pushed onto the instruction stack where they will be dealt with later. This property allows the interpreter to be timeshared over several independent programs: apply X to (x1;y1;z1) to get (x1';y1';z1'), then apply Y to (x2;y2;z2) to get (x2';y2';z2'), &c.

    Special forms

    The interpreter recognizes three special forms: terminate, call-with-current-contination, and delay. When 't', 'c', or 'd' appears as the last element on the data stack

    .. a t : XY
    .. a c : XY
    .. a d : XY

    the interpreter calls the corresponding special function T, C, or D on three arguments:

    x	current character
    y	data stack, from which the last two elements have been dropped: -2_ y
    z	instruction stack, partitioned by B into (X;Y)

    The B function finds the first complete expression on the instruction stack XY, and returns a pair consisting of that expression and the rest of the stack:

    B:{(0,1+(+\-1 1 x~'a)?-1)_ x}

    For example, if the instruction stack is:

    XY	``s``s`ksk`kr.*

    then B splits it into (X;Y):

    X	``s``s`ksk`kr
    Y	.*

    d, f

    The Unlambda page contains the following explanation of 'd':

    The d function is an exception to the normal rules of evaluation (hence it should be called a special form rather than a function). When Unlambda is evaluating `FG and F evaluates to d (for example when F is d) then G is not evaluated. The result `dG is a promise to evaluate G: that is, G is kept unevaluated until the promise is itself applied to an expression H. When that happens, G is finally evaluated (after H is), and it is applied to H. This is called forcing the promise.

    When 'd' appears in applicand position on the data stack

    .. a d : G H

    the corresponding special function D is called:

    D:{(x;y),,d[*z],z 1}

    D will return a new triple (current character;data stack;instruction stack):

    x	current character
    y	data stack
    z	d[G],H

    That is, the new current character is the old current character, the new data stack is the old data stack, and the new instruction stack is d[G],H, the result of calling 'd' with unevaluated G, the first complete expression on the instruction stack, prepended to the rest of the instruction stack.

    The 'd' function is:

    d:{a,a,f,y,x}

    which takes two arguments. So what is prepended to the instruction stack is the projection d[G]; i.e. a K function of one argument:

    .. : .. d[G] H

    At some later point, d[G] may appear in application position on the data stack, but it will do so with G unevaluated, after H has been evaluated, say to X::

    .. a d[G] X : ..

    at which point d[G] will be applied to X and the result pushed onto the instruction stack:

    .. : a a f X G ..

    Note that G has still not been evaluated. Eventually, the data stack will look like this:

    .. a a f X : G ..

    with 'f' in application position. 'f' is defined:

    f:{a,y,x}

    so the successive states are:

    .. a        : f[X] G ..		push promise[X]
    .. a f[X] Y : ..		evaluate G -> Y
    ..          : a Y X ..		delayed apply of Y (G) to X (H)

    Examples from the Unlambda page:

    For example, `d`ri does nothing (and remains unevaluated), and ``d`rii prints a blank line (because we are forcing the promise). Another point to note is that ``dd`ri prints a blank line: indeed, `dd is first evaluated, and since it is not the d function (instead, it is a promise to evaluate d), it does not prevent the `ri expression from being evaluated (to i, with the side effect of printing a newline), so that when finally d is applied, it is already too late to prevent the newline from being printed; to summarize, the d function can delay the d function itself. On the other hand, ``id`ri does not print a blank line (because `id does evaluate to d). Similarly, ```s`kdri is first transformed to ```kdi`ri, in which ``kdi is evaluated to d, which then prevents `ri from being evaluated so no newline gets printed.

    E.g.,

      t"``d`rii"
    :                                          :``d`rii
    :                                         `:`d`rii
    :                                        ``:d`rii
    :                                         `:d[`ri]i
    :                                   `d[`ri]:i
    :                                          :``fi`ri
    :                                         `:`fi`ri
    :                                        ``:fi`ri
    :                                       ``f:i`ri
    :                                         `:f[i]`ri
    :                                     `f[i]:`ri
    :                                    `f[i]`:ri
    :                                   `f[i]`r:i
    								<-- promise forced, newline printed
    :                                     `f[i]:i
    :                                          :`ii
    :                                         `:ii
    :                                        `i:i
    :                                          :i
    :                                         i:
    (""
     ,{x}
     ())

    e, t

    When 'e' appears in applicand position on the data stack:

    .. a e X : ..

    it is treated as a normal builtin - the J function applies 'e' to X and pushes the result onto the instruction stack:

    .. : a t X ..

    The next two steps cause 'a' and 't' to be pushed onto the data stack:

    .. a t : X ..

    at which point the special form for termination is detected by Y and the function T is called:

    T:{(x;*z;())}

    T returns a triple in which X is the data stack and the instruction stack is set to (). On the next iteration, Y will detect an empty instruction stack and return the triple unchanged, causing execution to terminate.

    c

    The 'c' builtin is call-with-current-continuation. Here is what the Unlambda page has to say about it:

    The c (“call with current continuation”) function is probably the most difficult to explain (if you are familiar with the corresponding function in Scheme, it will help a lot). I suggest you try reading the call/cc page at this point. c called with an argument F will apply F to the current continuation. The current continuation is a special function which, when it is applied to X, has the effect of making c return immediately the value X. In other words, c can return in two ways: if F applied to the continuation evaluates normally, then its return value is that of c; but if F calls the continuation at some point, c will immediately return the value passed to the continuation.

    When 'c' appears in applicand position on the data stack:

    .. a c : XY

    B splits the instruction stack into X and Y and the 'C' function is called:

    C:{(x;y),,c[*z;.,`c,,(x;y),,z 1],z 1}

    C returns (x;y;z) where

    x	current character
    y	data stack
    z	c[X;current continuation],Y

    That is, the new instruction stack is created by replacing X with the result of applying 'c' to X (the function on which call-with-current-continuation is to be called) and the current continuation, and prepending the result to Y, the rest of the instruction stack.

    The current continuation is a K dictionary (following the Unlambda convention, we shall write it '<cont>') with a single entry, 'c'. <cont> is a triple (x;y;z), where x is the current character, y is the current data stack, and z is the current instruction stack Y.

    The 'c' function is quite simple:

    c:{a,x,y}

    I.e., apply x, which is X, to y, which is <cont>. So the return triple from C resets the data and instruction stacks to:

    .. : a X <cont> Y

    Now suppose that, at some later point in evaluation, the data stack matches the following pattern:

    .. a <cont> Z : ..

    That is, we are in a state where <cont> is to be applied to Z. The 'A' function is called (see above), and it detects that the object in application position is a dictionary, i.e. <cont>:

    A:{:[5=4:*y 1;K[y[1;0;`c];y[1;1];z]J[x;y;z]]}

    y[1;0], the continuation, is to be applied to y[1;1], and z is the instruction stack at that point. So K is called: with arguments:

    x	(x';y';z')	cached continuation
    y	Z		apply continuation to this value
    z	..		instruction stack

    The K function is:

    K:{(2#x),,y,z,x 2}

    which resets the current character, data stack, and instruction stack to:

    x' : y' : Z .. z'

    Let's work through a simple example:

      t"``cir"
    :                                          :``cir
    :                                         `:`cir			push `
    :                                        ``:cir				push `

    'c' is pushed onto the data stack, and the pattern 'a c' is matched. C is called, which calls 'c' on x=X=i and y=<cont>, which returns a,x,y, which is ` i <:`:r>, which is prepended to Y:

    :                                         `:`i<:`:r>r			C -> c -> pushes a i <cont>
    :                                        ``:i<:`:r>r			push `
    :                                       ``i:<:`:r>r			push i

    The pattern 'a a i' is matched, so i is applied to the continuation <:`:r>, which pushes <:`:r> onto the instruction stack:

    :                                         `:<:`:r>r			i <cont> -> <cont>
    :                                   `<:`:r>:r				push <cont>

    'r' is pushed onto the data stack, and the pattern 'a X Y' is matched. A is called, which finds a continuation in the last position, so K is called, which resets the data stack (to `) and prepends 'r' to the instruction stack:

    :                                         `:rr				push `
    :                                        `r:r				push r
    									push r, print newline
    :                                          :r				r leaves r on the stack
    :                                         r:				push r, end - empty stack

    Time-limited evaluation

    Many interesting Unlambda programs never terminate; for example, this infinite counter.

    The interpreter can be interrupted by pressing Ctrl-c, but it is handy to be able to limit the time spent in the interpreter. Since the current implementation is O(1), we can enhance E (and Z) to check whether the specified time has been exceeded. If it hasn't, we continue, incrementing time-spent on each loop through evaluation; else we exit:

    E_:{Z_[x;_t,z]/("";();P y;0)}
    Z_:{:[~y[1]>*-1#z;z;#x .-1_ z;z;(X .-1_ z),_t-*y]}

    For example,

    f_["unlambda/count";1]		/ spend no more than a second evaluating unlambda/count.unl

    Parsing

    The Unlambda builtins - the primitives - are implemented as simple K functions. For example, the 'i' function takes a value x and returns it

    i:{x}

    Input to the interpreter is a string representing an Unlambda program; for example

    "```skss"

    Program-strings are converted by the parse function 'P' into lists of K functions:

      P"```skss"
    ({a};{a};{a};{a,a,x,z,a,y,z};{y;x};{a,a,x,z,a,y,z};{a,a,x,z,a,y,z})

    There is one external global variable 'R'. R is a pair of pairs:

    R:0 4_/:("^$.?@|`iksrcvdfet";(l;m;p;q;o;b;a;i;k;s;r;c;v;d;f;e;t))

    R[0] is a pair whose first element is a list of those primitives which are bound at parse-time to specific character values. For example, the Unlambda print-character builtin '.' is bound at parse-time to the character which it prints. ".x" is a function takes some value, prints '.' as a side-effect, and returns x. Hence, Unlambda contains 256 printing functions, one for each character. The second element of R[0] is a list of the remaining Unlambda primitives.

    R[1] is a pair whose structure mirrors R[0]: lists of the K functions corresponding to the primitives mentioned in R[0].

    Notation for variables ($x) and variable binding (^x) is included in the parser, although of course since Unlambda programs are lambda-free, the interpreter makes no use of it.

    The parse function P and its subfunction Q are:

    P:{Q@@[x;i;:;(,/R 1)(,/*R)?/:x i:&(x _lin,/*R)&-1!~{1_0 x\_ic y}[++1!0,,(!256)_lin _ic**R]x]}
    Q:{,/@[(|,)':x,i;_n;{:[x[0]_in*R 1;x[0][x[1]];x[0]_in R[1;1];*x;()]}]}

    Display

    The display function U takes the familiar triple (current character;data stack;instruction stack), formats the parts, separated by ":", writes the resulting string to standard out, and waits for the user to press Return:

    x:		.. y:z ..

    If the user presses any key before doing so, the calling function (typically E) exits. If a component of the triple overflows allocated space (40 characters) the symbol "--" is used, either at the beginning (data stack) or end (instruction stack).

    U calls V, which can be used to format arbitrarily large components:

    U:{{`0:($x),":",(42$:[40<#y;"--";""],40$y),":",-42$(-40$z),:[40<#z;"--";""]}[x]. V'(y;z);0:`}
    V:{W{x,""}@,/{:[5=t:4:x;{"<",($x),":",y,":",z,">"}. V'x`c;~t;V'x;~t=1;_ssr/[$x;$,/R 1;,/*R];"^$"[x<0],_ci __abs x]}'x}
    W:{_ssr/[_ssr/[x;("[[]\"";"\"[]]";"[[],"),".",'d;("";"";"["),c]_dvl d;c:_ci 1+!4;d:"(;,)"]}

    Files

    The file I/O function F is:

    F:{{x@&(-1!x _lin**R)|~" "=x:("",x)_dvl"\b\r\n\t"}@,/{(x?"#")#x}'0:x,:[".unl"~-4#x$:;"";".unl"]}

    Abstraction elimination

    An implementation of abstraction elimination:

    L:{V@|*(M .)/(();|P x)}
    M:{(:[~#y;x;~1=4:*y;x,*y;0>*y;x,*y;|N[-*y;|x]];1_ y)}
    N:{,/(O[x].)/(();y)}
    O:{(:[~#z;y;a~*z;y,a,a,s;x~*z;y,i;y,a,k,*z];1_ z)}

    The parser replaces '^x' with the ASCII integer for x, and '$x' with the negate of that number. The "primitives" for ^ and $ are

    l:_ic			^x  lambda x
    m:-_ic			$x  variable x

    For example,

       P"^x^y`$y$x"
    (120;121;{a};-121;-120)

    The abstraction elimination tool L takes a string containing lambdas, variables, and Unlambda primitives and returns a string containing only Unlambda primitives:

      L"^x^y`$y$x"
    "``s``s`ks`ki``s`kki"

    L applies M over a stack x (initially empty: ()) and y, the reverse of the parsed expression.

    M keeps scanning the input until it finds *y = lambda ^x. At that point it calls N with the bound variable -*y and the reverse of the stack.

    N scans the stack (left to right, in the order of the original expression), calling O to perform the appropriate step in eliminating variable x.

    O checks to see whether the stack has been completely converted (~#z), and if so, it returns (y;1_ z). If there is work remaining, then the stack must satisfy one of the following three patterns, and the appropriate substitution is performed:

    `F	->	``sF
    $xF	->	iF
    F	->	`kF

    API

    The interpreter code lives in .unl on the K tree. Three functions are defined in the user space .k:

    e:.unl.E[{0#z}]		/ evaluate
    t:.unl.E[.unl.U]	/ trace
    f:e .unl.F@		/ read from file, evaluate
    l:.unl.L		/ abstraction elimination
    e_:.unl.E_[{0#z}]	/ time-limited evaluation
    t_:.unl.E_[.unl.U]	/ time-limited trace
    f_:{e_[.unl.F x;y]}	/ time-limited read from file, evaluate

    Operation

    Download K, download unlambda.k, download (or otherwise have available) the Unlambda programs.

    In a command prompt, say e.g.

    k unlambda unlambda/hello

    to run an Unlambda program from the command line, or say

    k unlambda

    and then, e.g.

    f"unlambda/hello.unl"

    The trailing qualifier ".unl" may be elided; i.e.,

    f"unlambda/hello"

    To execute an Unlambda program in immediate mode:

      e"```skss"
    (""
     ,{a,a,x,z,a,y,z}
     ())

    'e' returns a triple of the form (current character;data stack;instruction stack).

    To trace an Unlambda program in immediate mode:

      t"```skss"
    :                                          :```skss
    :                                         `:``skss
    :                                        ``:`skss
    :                                       ```:skss
    :                                      ```s:kss
    :                                        ``:s[k]ss
    :                                    ``s[k]:ss
    :                                         `:s[k][s]s
    :                                  `s[k][s]:s
    :                                          :``ks`ss
    :                                         `:`ks`ss
    :                                        ``:ks`ss
    :                                       ``k:s`ss
    :                                         `:k[s]`ss
    :                                     `k[s]:`ss
    :                                    `k[s]`:ss
    :                                   `k[s]`s:s
    :                                     `k[s]:s[s]
    :                                          :s
    :                                         s:
    (""
     ,{a,a,x,z,a,y,z}
     ())

    Each line has the form

    current character:data stack:instruction stack

    Continuations have the form

    <current character:data stack:instruction stack>

    For example:

      t"``cir"
    :                                          :``cir
    :                                         `:`cir
    :                                        ``:cir
    :                                         `:`i<:`:r>r		<--- <:`:r> is a continuation
    :                                        ``:i<:`:r>r
    :                                       ``i:<:`:r>r
    :                                         `:<:`:r>r
    :                                   `<:`:r>:r
    :                                         `:rr
    :                                        `r:r
    
    :                                          :r
    :                                         r:
    (""
     ,{`0:"\n";x}
     ())

    To continue after each step, press Return; else type any character to exit.

    Future work

    Extending the interpreter to Unlambda 3, whenever the spec appears. The extension may or may not include direct support for Church numerals, arithmetic, and comparison.

    A more sophisticated abstraction elimination tool.