On this page:
15.1 Functions in their most general form
15.2 Long Live Lambda!
15.3 Lambda is Dead!
15.4 Defunctionalization at work
15.5 Compiling Loot
15.6 Compiling Function Definitions
15.7 Save the Environment:   Create a Closure!
15.8 Calling Functions
15.9 Recursive Functions
15.10 Syntactic sugar for function definitions
7.4

15 Loot: lambda the ultimate

    15.1 Functions in their most general form

    15.2 Long Live Lambda!

    15.3 Lambda is Dead!

    15.4 Defunctionalization at work

    15.5 Compiling Loot

    15.6 Compiling Function Definitions

    15.7 Save the Environment: Create a Closure!

    15.8 Calling Functions

    15.9 Recursive Functions

    15.10 Syntactic sugar for function definitions

15.1 Functions in their most general form

We’ve been building up the pieces of functions, first with second-class functions, then with tail-calls, then with first-class function pointers.

Now we’re ready to deal with functions in their most general form: λ-expressions.

We add λ-expressions to the syntax and remove the (fun ,Variable) and (call ,Expr ,@(Listof Expr)) forms. We no longer need a separate syntactic form for referencing the name of a function, we can just use variable binding. Likewise, we use the same syntax as Racket for function application:

;; type Expr =

;; | ....

;; | `(λ ,Formals ,Expr)

;; | `(,Expr ,@(Listof Expr))

For the moment, Formals can be defined as a list of variables:

;; type Formals = (Listof Variable)

But it’s possible to extend the λ-notation to include the ability to define variable-arity functions, as you will see in (part "Assignment 6").

15.2 Long Live Lambda!

Let’s start by developing the interpreter for Loot, where the relevant forms are λs and applications:

; Expr REnv -> Answer
(define (interp-env e r)
    ; ...
    [`(λ (,xs ...) ,e)  '...]
    [`(,e . ,es)        '...])

These two parts of the interpreter must fit together: λ is the constructor for functions and application is deconstructor. An application will evaluate all its subexpressions and the value produced by e ought to be the kind of value constructed by λ. That value needs to include all the necessary information to, if given the values of the arguments es, evaluate the body of the function in an environment associating the parameter names with the arguments’ values.

So how should functions be represented? Here is a simple idea following the pattern we’ve used frequently in the interpreter:

So now:
  • Q: How can we represent functions?

  • A: With functions!?

Great, so we will use function to represent functions. We can implement function application with function application. Let’s fill in what we know so far:

; Expr REnv -> Answer
(define (interp-env e r)
    ; ...
    [`(λ (,xs ...) ,e)
     (λ ??? '...)]
    [`(,e . ,es)
     (let ((f (interp-eval e r))
           (vs (interp-eval* es r)))
       (apply f vs))])

It’s not totally clear what parameters the representation of a function should have or what we should in the body of that function. However, the code in the interpretation of an application sheds light on both. First, it’s clear a function should potentially take any number of arguments:

; Expr REnv -> Answer
(define (interp-env e r)
    ; ...
    [`(λ (,xs ...) ,e)
     (λ vs '...)]
    [`(,e . ,es)
     (let ((f (interp-eval e r))
           (vs (interp-eval* es r)))
       (apply f vs))])

Second, what should happen when a function is applied? It should produce the answer produced by the body of the λ expression in an environment that associates xs with vs. Translating that to code, we get:

; Expr REnv -> Answer
(define (interp-env e r)
    ; ...
    [`(λ (,xs ...) ,e)
     (λ vs (interp-env e (zip xs vs)))]
    [`(,e . ,es)
     (let ((f (interp-eval e r))
           (vs (interp-eval* es r)))
       (apply f vs))])

And now we have simultaneously arrived at our representation of function values:
; type Value =
; | ....
; | (Value ... -> Answer)

and completed the implementation of the interpreter.

There are, however, problems.

For one, this approach does not model how λ-expressions are able to capture the environment in which they are evaluated. Consider:

(let ((y 8))
  (λ (x) (+ x y)))

This evaluates to a function that, when applied, should add 8 to its argument. It does so by evaluating the body of the λ, but in an environment that both associates x with the value of the argument, but also associates y with 8. That association comes from the environment in place when the λ-expression is evaluated. The interpreter as written will consider y is unbound!

The solution is easy: in order for (Loot) functions to capture their (implicit) environment, we should capture the (explicit) environment in the (Racket) function:

; Expr REnv -> Answer
(define (interp-env e r)
    ; ...
    [`(λ (,xs ...) ,e)
     (λ (vs) (interp-env e (append (zip xs vs) r)))]
    [`(,e . ,es)
     (let ((f (interp-eval e r))
           (vs (interp-eval* es r)))
       (apply f vs))])

The last remaining issue is we should do some type and arity-checking:

; Expr REnv -> Answer
(define (interp-env e r)
    ; ...
    [`(λ (,xs ...) ,e)
     (λ (vs)
       (if (= (length xs) (length vs))
           (interp-env e (append (zip xs vs) r))
           'err))]
    [`(,e . ,es)
     (let ((f (interp-eval e r))
           (vs (interp-eval* es r)))
       (if (procedure? f)
           (apply f vs)
           'err))])

The complete interpreter is:

loot/interp.rkt

  #lang racket
  (provide (all-defined-out))
  (require "syntax.rkt")
   
  ;; type Expr =
  ;; ...
  ;; | `(λ ,(Listof Variable) ,Expr)
   
  ;; type Value =
  ;; ...
  ;; | Function
   
  ;; type Function =
  ;; | (Values ... -> Answer)
   
  (define (interp e)
    (interp-env (desugar e) '()))
   
  ;; Expr REnv -> Answer
  (define (interp-env e r)
    (match e
      [''() '()]
      [(? syntactic-value? v) v]
      [(list (? prim? p) es ...)
       (match (interp-env* es r)
         [(list vs ...) (interp-prim p vs)]
         [_ 'err])]
      [`(if ,e0 ,e1 ,e2)
       (match (interp-env e0 r)
         ['err 'err]
         [v
          (if v
              (interp-env e1 r)
              (interp-env e2 r))])]
      [(? symbol? x)
       (lookup r x)]
      [`(let ((,x ,e0)) ,e1)
       (match (interp-env e0 r)
         ['err 'err]
         [v
          (interp-env e1 (ext r x v))])]    
      [`(letrec ,bs ,e)
       (letrec ((r* (λ ()
                      (append
                       (zip (map first bs)
                            ;; η-expansion to delay evaluating r*
                            ;; relies on RHSs being functions
                            (map (λ (l) (λ vs (apply (interp-env l (r*)) vs)))
                                 (map second bs)))
                       r))))
         (interp-env e (r*)))]
      [`(λ (,xs ...) ,e)
       (λ vs
         (if (= (length vs) (length xs))
             (interp-env e (append (zip xs vs) r))
             'err))]
      [`(,e . ,es)
       (match (interp-env* (cons e es) r)
         [(list f vs ...)
          (if (procedure? f)
              (apply f vs)
              'err)]
         [_ 'err])]))
   
  ;; (Listof Expr) REnv -> (Listof Value) | 'err
  (define (interp-env* es r)
    (match es
      ['() '()]
      [(cons e es)
       (match (interp-env e r)
         ['err 'err]
         [v (cons v (interp-env* es r))])]))
   
  ;; Any -> Boolean
  (define (prim? x)
    (and (symbol? x)
         (memq x '(add1 sub1 + - zero?
                        box unbox empty? cons car cdr))))
   
  ;; Any -> Boolean
  (define (syntactic-value? x)
    (or (integer? x)
        (boolean? x)
        (null? x)))
   
  ;; Prim (Listof Value) -> Answer
  (define (interp-prim p vs)
    (match (cons p vs)
      [(list 'add1 (? integer? i0))  (add1 i0)]
      [(list 'sub1 (? integer? i0))  (sub1 i0)]
      [(list 'zero? (? integer? i0)) (zero? i0)]
      [(list 'box v0)                (box v0)]
      [(list 'unbox (? box? v0))     (unbox v0)]
      [(list 'empty? v0)             (empty? v0)]
      [(list 'cons v0 v1)            (cons v0 v1)]
      [(list 'car (cons v0 v1))      v0]
      [(list 'cdr (cons v0 v1))      v1]
      [(list '+ (? integer? i0) (? integer? i1))
       (+ i0 i1)]
      [(list '- (? integer? i0) (? integer? i1))
       (- i0 i1)]
      [_ 'err]))
   
  ;; Env Variable -> Answer 
  (define (lookup env x)
    (match env
      ['() 'err]
      [(cons (list y i) env)
       (match (symbol=? x y)
         [#t i]
         [#f (lookup env x)])]))
   
  ;; Env Variable Value -> Value
  (define (ext r x i)
    (cons (list x i) r))
   
  (define (zip xs ys)
    (match* (xs ys)
      [('() '()) '()]
      [((cons x xs) (cons y ys))
       (cons (list x y)
             (zip xs ys))]))
   

We now have the full power of λ expressions in our language. We can write recursive functions, using only anonymous functions, via the Y-combinator:

Examples

> (interp
    '(λ (t)
       ((λ (f) (t (λ (z) ((f f) z))))
        (λ (f) (t (λ (z) ((f f) z)))))))

#<procedure:.../loot/interp.rkt:53:5>

For example, computing the triangular function applied to 10:

Examples

> (interp
    '(((λ (t)
         ((λ (f) (t (λ (z) ((f f) z))))
          (λ (f) (t (λ (z) ((f f) z))))))
       (λ (tri)
         (λ (n)
           (if (zero? n)
               1
               (+ n (tri (sub1 n)))))))
      10))

56

One of the niceties of using Racket functions to represent Loot functions is we can define Racket functions via the interpretation of Loot functions:

Examples

> (define Y
    (interp
      '(λ (t)
         ((λ (f) (t (λ (z) ((f f) z))))
          (λ (f) (t (λ (z) ((f f) z))))))))
> (define tri
    (interp '(λ (tri)
               (λ (n)
                 (if (zero? n)
                     1
                     (+ n (tri (sub1 n))))))))

And then use them from within Racket:

Examples

> ((Y tri) 10)

56

We can also “import” Racket functions in to Loot:

Examples

> (interp-env '(expt 2 10)
              `((expt ,expt)))

1024

15.3 Lambda is Dead!

Now the question you might naturally wonder is: how does implementing functions in terms of functions help me implement functions in x86, which after all, doesn’t have λ?

The answer is that from this point, in which we have an understandable account of functions, we can iteratively revise the interpreter to eliminate the use of functions while computing equivalent results. Doing so will shed light on the lower-level implementation of functions in the compiler.

Consider again what it is that a λ-expression is doing for you:

We can achive these things without using a function value by:

So we are changing the representation of functions from:

And now we have simultaneously arrived at our representation of function values:
; type Value =
; | ....
; | (Value ... -> Answer)

To:

; type Value =
; | ....
; | (closure ,Formals ,Expr ,Env)

When a λ is evaluated, a closure is created. When a function is applied, we deconstruct the closure and execute the code that used to be in the (Racket) function:

; Expr REnv -> Answer
(define (interp-env e r)
    ; ...
    [`(λ (,xs ...) ,e)
     `(closure ,xs ,e ,r)]
    [`(,e . ,es)
     (let ((f (interp-eval e r))
           (vs (interp-eval* es r)))
       (match f
         [`(closure ,xs ,e ,r)
          (if (= (length vs) (length xs))
              (interp-env e (append (zip xs vs) r))
              'err)]
         [_ 'err]))])

We can give it a try:

Examples

> (interp '(λ (x) x))

'(closure (x) x ())

> (interp '((λ (x) (λ (y) x)) 8))

'(closure (y) x ((x 8)))

Notice in the second example how the closure contains the body of the function and the environment mapping the free variable 'x to 8.

We can also confirm our larger example works:

Examples

> (interp
    '(((λ (t)
         ((λ (f) (t (λ (z) ((f f) z))))
          (λ (f) (t (λ (z) ((f f) z))))))
       (λ (tri)
         (λ (n)
           (if (zero? n)
               1
               (+ n (tri (sub1 n)))))))
      10))

56

While can’t apply the interpretation of functions in Racket like we did previously, we can apply-function the interpretation of functions:

Examples

> (define Y
    (interp
      '(λ (t)
         ((λ (f) (t (λ (z) ((f f) z))))
          (λ (f) (t (λ (z) ((f f) z))))))))
> (define tri
    (interp '(λ (tri)
               (λ (n)
                 (if (zero? n)
                     1
                     (+ n (tri (sub1 n))))))))
> (apply-function (apply-function Y tri) 10)

56

The process we used to eliminate function values from the interpreter is an instance of a general-purpose whole-program transformation called defunctionalization for replacing function values with data structures.

15.4 Defunctionalization at work

Let’s digress for a moment and learn this very useful transformation.

Here is a data type for representing regular expressions:

; type Regexp =
; | 'zero
; | 'one
; | (char ,Char)
; | (times ,Regexp ,Regexp)
; | (plus ,Regexp ,Regexp)
; | (star ,Regexp)

The regular expression 'zero matches nothing; 'one matches the empty string; `(char ,c) matches the character c; `(times ,r1 ,r2) matches the concatenation of a string matching r1 followed by a string matching r2; `(plus ,r1 ,r2) matching either a string matching r1 or a string matching r2; and `(star ,r) matches a string made up of any number of substrings, each of which match r.

A really nice way to write a matcher is to use a continuation-passing style that keeps track of what is required of the remainder of the string after matching a prefix against the regexp:

loot/regexp.rkt

  #lang racket
  (provide accepts)
   
  ;; type Regexp =
  ;; | 'zero
  ;; | 'one
  ;; | `(char ,Char)
  ;; | `(times ,Regexp ,Regexp)
  ;; | `(plus ,Regexp ,Regexp)
  ;; | `(star ,Regexp)
   
  ;; Regexp String -> Boolean
  (define (accepts r s)
    (matcher r (string->list s) (λ (cs) (empty? cs))))
   
  ;; Regexp (Listof Char) ((Listof Char) -> Bool) -> Bool
  (define (matcher r cs k)
    (match r
      ['zero #f]
      ['one (k cs)]
      [`(char ,c)
       (match cs
         ['() #f]
         [(cons d cs) (and (char=? c d) (k cs))])]
      [`(plus ,r1 ,r2)
       (or (matcher r1 cs k) (matcher r2 cs k))]
      [`(times ,r1 ,r2)
       (matcher r1 cs (λ (cs) (matcher r2 cs k)))]
      [`(star ,r)
       (letrec ((matcher* (λ (cs) (or (k cs) (matcher r cs matcher*)))))
         (matcher* cs))]))
   

Let’s give it a try:

Examples

> (accepts `(star (char #\a)) "aaaaa")

#t

> (accepts `(star (char #\a)) "aaaab")

#f

> (accepts `(star (plus (char #\a) (char #\b))) "aaaab")

#t

But what if needed to program this regular expression matching without the use of function values? We can arrive at such code systematically by applying defunctionalization.

loot/regexp-defun.rkt

  #lang racket
  (provide accepts)
   
  ;; type Regexp =
  ;; | 'zero
  ;; | 'one
  ;; | `(char ,Char)
  ;; | `(times ,Regexp ,Regexp)
  ;; | `(plus ,Regexp ,Regexp)
  ;; | `(star ,Regexp)
   
  ;; type K =
  ;; | '(k0)
  ;; | `(k1 ,Regexp ,K)
  ;; | `(k2 ,K ,Regexp)
   
  ;; Regexp String -> Boolean
  (define (accepts r s)
    (matcher r (string->list s) '(k0)))
   
  ;; Regexp (Listof Char) K -> Bool
  (define (matcher r cs k)
    (match r
      ['zero #f]
      ['one (apply-k k cs)]
      [`(char ,c)
       (match cs
         ['() #f]
         [(cons d cs)
          (and (char=? c d) (apply-k k cs))])]
      [`(plus ,r1 ,r2)
       (or (matcher r1 cs k) (matcher r2 cs k))]
      [`(times ,r1 ,r2)
       (matcher r1 cs `(k1 ,r2 ,k))]
      [`(star ,r)
       (apply-k `(k2 ,k ,r) cs)]))
   
  ;; K (Listof Char) -> Bool
  (define (apply-k k cs)
    (match k
      [`(k0) (empty? cs)]
      [`(k1 ,r2 ,k) (matcher r2 cs k)]
      [`(k2 ,k* ,r) (or (apply-k k* cs) (matcher r cs k))]))
   

And we get the same results:

Examples

> (accepts `(star (char #\a)) "aaaaa")

#t

> (accepts `(star (char #\a)) "aaaab")

#f

> (accepts `(star (plus (char #\a) (char #\b))) "aaaab")

#t

15.5 Compiling Loot

Compiling a λ-expression will involve generating two different chunks of instructions:

15.6 Compiling Function Definitions

The first part closely follows the appoach of defining a function definition (define (f x ...) e) from our previous compilers.

Ther are two important differences from the past though:

To deal with the first issue, we first make a pass over the program inserting computed names for each λ-expression.

To accomodate this, we will introduce the following data type for “labelled” expressions:

; type LExpr =
; ....
; | (λ ,Formals ',Symbol ,Expr)

An LExpr is just like a Expr except that λ-expressions have the form like (λ (x) 'fred (+ x x)). The symbol 'fred here is used to give a name to the λ-expression. The use of quote is so that LExprs are still a valid subset of Racket expressions.

The first step of the compiler will be to label every λ-expression using the following function:

; Expr -> LExpr
(define (label-λ e)
  (match e
    [(? symbol? x)         x]
    [(? imm? i)            i]
    [`(box ,e0)            `(box ,(label-λ e0))]
    [`(unbox ,e0)          `(unbox ,(label-λ e0))]
    [`(cons ,e0 ,e1)       `(cons ,(label-λ e0) ,(label-λ e1))]
    [`(car ,e0)            `(car ,(label-λ e0))]
    [`(cdr ,e0)            `(cdr ,(label-λ e0))]
    [`(add1 ,e0)           `(add1 ,(label-λ e0))]
    [`(sub1 ,e0)           `(sub1 ,(label-λ e0))]
    [`(zero? ,e0)          `(zero? ,(label-λ e0))]
    [`(empty? ,e0)         `(empty? ,(label-λ e0))]
    [`(if ,e0 ,e1 ,e2)     `(if ,(label-λ e0) ,(label-λ e1) ,(label-λ e2))]
    [`(+ ,e0 ,e1)          `(+ ,(label-λ e0) ,(label-λ e1))]
    [`(let ((,x ,e0)) ,e1) `(let ((,x ,(label-λ e0))) ,(label-λ e1))]
    [`(λ ,xs ,e0)          `(λ ,xs ',(gensym) ,(label-λ e0))]
    [`(,e . ,es)           `(,(label-λ e) ,@(map label-λ es))]))

Here it is at work:

Examples

> (label-λ
    '(λ (t)
      ((λ (f) (t (λ (z) ((f f) z))))
       (λ (f) (t (λ (z) ((f f) z)))))))

'(λ (t) 'g5328 ((λ (f) 'g5329 (t (z) 'g5330 ((f f) z)))) (f) 'g5331 (t (z) 'g5332 ((f f) z))))))

Now turning to the second issue–λ-expression may reference variables bound outside of the expression—let’s consider how to compile something like (λ (x) z)?

There are many possible solutions, but perhaps the simplest is to compile this as a function that takes two arguments, i.e. compile it as if it were: (λ (x z) z). The idea is that a λ-expression defines a function of both explicit arguments (the parameters) and implicit arguments (the free variables of the λ-expression).

This will have to work in concert with closure creation and function calls. When the λ-expression is evaluated, a closure will be created storing the value of z. When the function is applied, the caller will need to retrieve that value and place it as the second argument on stack before calling the function’s code.

To implement this, we will need to compute the free variables, which we do with the following function:

; LExpr -> (Listof Variable)
(define (fvs e)
  (define (fvs e)
    (match e
      [(? symbol? x)         (list x)]
      [(? imm? i)            '()]
      [`(box ,e0)            (fvs e0)]
      [`(unbox ,e0)          (fvs e0)]
      [`(cons ,e0 ,e1)       (append (fvs e0) (fvs e1))]
      [`(car ,e0)            (fvs e0)]
      [`(cdr ,e0)            (fvs e0)]
      [`(add1 ,e0)           (fvs e0)]
      [`(sub1 ,e0)           (fvs e0)]
      [`(zero? ,e0)          (fvs e0)]
      [`(empty? ,e0)         (fvs e0)]
      [`(if ,e0 ,e1 ,e2)     (append (fvs e0) (fvs e1) (fvs e2))]
      [`(+ ,e0 ,e1)          (append (fvs e0) (fvs e1))]
      [`(let ((,x ,e0)) ,e1) (append (fvs e0) (remq* (list x) (fvs e1)))]
      [`(λ ,xs ,l ,e0)       (remq* xs (fvs e0))]
      [`(,e . ,es)           (append (fvs e) (apply append (map fvs es)))]))
  (remove-duplicates (fvs e)))

We can now write the function that compiles a labelled λ-expression into a function in assembly:

; Lambda -> Asm
(define (compile-λ-definition l)
  (match l
    [`(λ ,xs ',f ,e0)
     (let ((c0 (compile-tail-e e0 (reverse (append xs (fvs l))))))
       `(,f
         ,@c0
         ret))]))

Here’s what’s emitted for a λ-expression with a free variable:

Examples

> (compile-λ-definition '(λ (x) 'f z))

'(f (mov rax (offset rsp -2)) ret)

Notice that it’s identical to a λ-expression with an added parameter and no free variables:

Examples

> (compile-λ-definition '(λ (x z) 'f z))

'(f (mov rax (offset rsp -2)) ret)

The compiler will need to generate one such function for each λ-expression in the program. So we use a helper function for extracting all the λ-expressions and another for compiling each of them:

; LExpr -> (Listof LExpr)
; Extract all the lambda expressions
(define (λs e)
  (match e
    [(? symbol? x)         '()]
    [(? imm? i)            '()]
    [`(box ,e0)            (λs e0)]
    [`(unbox ,e0)          (λs e0)]
    [`(cons ,e0 ,e1)       (append (λs e0) (λs e1))]
    [`(car ,e0)            (λs e0)]
    [`(cdr ,e0)            (λs e0)]
    [`(add1 ,e0)           (λs e0)]
    [`(sub1 ,e0)           (λs e0)]
    [`(zero? ,e0)          (λs e0)]
    [`(empty? ,e0)         (λs e0)]
    [`(if ,e0 ,e1 ,e2)     (append (λs e0) (λs e1) (λs e2))]
    [`(+ ,e0 ,e1)          (append (λs e0) (λs e1))]
    [`(let ((,x ,e0)) ,e1) (append (λs e0) (λs e1))]
    [`(λ ,xs ,l ,e0)       (cons e (λs e0))]
    [`(,e . ,es)           (append (λs e) (apply append (map λs es)))]))
 
; (Listof Lambda) -> Asm
(define (compile-λ-definitions ls)
  (apply append (map compile-λ-definition ls)))

The top-level compile function now labels inserts labels and compiles all the λ-expressions to functions:

; Expr -> Asm
(define (compile e)
  (let ((le (label-λ e)))
    `(entry
      ,@(compile-tail-e le '())
      ret
      ,@(compile-λ-definitions (λs le))
      err
      (push rbp)
      (call error)
      ret)))

What remains is the issue of compiling λ-expressions to code to create a closure.

15.7 Save the Environment: Create a Closure!

We’ve already seen how to create a reference to a function pointer, enabling functions to be first-class values that can be passed around, returned from other functions, stored in data structures, etc. The basic idea was to allocate a location in memory and save the address of a function label there.

A closure is just this, plus the environment that needs to be restored with the function is called. So representing a closure is fairly straightforward: we will allocate a location in memory and save the function label, plus each value that is needed from the environment. In order to keep track of how many values there are, we’ll also store the length of the environment.

Here’s the function for emitting closure construction code:

; (Listof Variable) Label (Listof Varialbe) CEnv -> Asm
(define (compile-λ xs f ys c)
  `(; Save label address
    (lea rax (offset ,f 0))
    (mov (offset rdi 0) rax)
 
    ; Save the environment
    (mov r8 ,(length ys))
    (mov (offset rdi 1) r8)
    (mov r9 rdi)
    (add r9 16)
    ,@(copy-env-to-heap ys c 0)
 
    ; Return a pointer to the closure
    (mov rax rdi)
    (or rax ,type-proc)
    (add rdi ,(* 8 (+ 2 (length ys))))))

Compared the previous code we say for function pointer references, the only difference is the code to store the length and value of the free variables of the λ-expression. Also: the amount of memory allocated is no longer just a single cell, but depends on the number of free variables being closed over.

The copy-env-to-heap function generates instructions for dereferencing variables and copying them to the appropriate memory location where the closure is stored:

; (Listof Variable) CEnv Natural -> Asm
; Pointer to beginning of environment in r9
(define (copy-env-to-heap fvs c i)
  (match fvs
    ['() '()]
    [(cons x fvs)
     `((mov r8 (offset rsp ,(- (add1 (lookup x c)))))
       (mov (offset r9 ,i) r8)
       ,@(copy-env-to-heap fvs c (add1 i)))]))

That’s all there is to closure construction!

15.8 Calling Functions

The last final peice of the puzzle is making function calls and closures work together. Remember that a λ-expression is compiled into a function that expects two sets of arguments on the stack: the first are the explicit arguments that given at the call site; the other arguments are the implicit arguments corresponding to free variables the λ-expression being called. The value of these arguments are given by the environment saved in the closure of the λ-expressions.

So the code generated for a function call needs to manage running each subexpression, the first of which should evaluate to a function (a pointer to a closure). The arguments are saved on the stack, and then the values stored in the environment part of the closure need to be copied from the heap to the stack:

; LExpr (Listof LExpr) CEnv -> Asm
(define (compile-call e0 es c)
  (let ((cs (compile-es es (cons #f c)))
        (c0 (compile-e e0 c))
        (i (- (add1 (length c))))
        (stack-size (* 8 (length c))))
    `(,@c0
      (mov (offset rsp ,i) rax)
      ,@cs
      (mov rax (offset rsp ,i))
      ,@assert-proc
      (xor rax ,type-proc)
      (sub rsp ,stack-size)
      ,@(copy-closure-env-to-stack (add1 (length es)))
      (call (offset rax 0))
      (add rsp ,stack-size))))

The only new bit is the use of copy-closure-env-to-stack. Unlike the closure construction code, in which we statically know what and how many variables to save in a closure, we must dynamically loop over the environment to move values to the stack:

; Natural -> Asm
; Copy closure's (in rax) env to stack skipping n spots
(define (copy-closure-env-to-stack n)
  (let ((copy-loop (gensym 'copy_closure))
        (copy-done (gensym 'copy_done)))
    `((mov r8 (offset rax 1)) ; length
      (mov r9 rax)
      (add r9 16)             ; start of env
      (mov rcx rsp)           ; start of stack
      (add rcx ,(- (* 8 (add1 n))))
      ,copy-loop
      (cmp r8 0)
      (je ,copy-done)
      (mov rbx (offset r9 0))
      (mov (offset rcx 0) rbx)
      (sub r8 1)
      (add r9 8)
      (sub rcx 8)
      (jmp ,copy-loop)
      ,copy-done)))

Let’s try it out:

Examples

> (asm-interp (compile '((let ((x 8)) (λ (y) x)) 2)))

8

> (asm-interp (compile '(((λ (x) (λ (y) x)) 8) 2)))

8

> (asm-interp (compile '((λ (f) (f (f 0))) (λ (x) (add1 x)))))

2

15.9 Recursive Functions

Writing recursive programs with the Y-combinator is a bit inconvenient. Let us now add a recursive function binding construct: letrec.

A letrec-expression has a shape like a let-expression, but variables are bound in both the body and the right-hand-side of the letrec. To keep matters simple, we will assume the right-hand-sides of a letrec are all λ-expressions. (Racket eases this restriction, but it significantly complicates compilation.)

So for example, writing the even? and odd? functions using letrec looks like:

Examples

> (letrec ((even?
            (λ (x)
              (if (zero? x)
                  #t
                  (odd? (sub1 x)))))
           (odd?
            (λ (x)
              (if (zero? x)
                  #f
                  (even? (sub1 x))))))
    (even? 10))

#t

To compile a letrec-expression, we can compile the λ-expression as functions just as before. Notice that the recursive (or mutually recursive) occurrence will be considered a free variable within the λ-expression, so just like any other free variable, the closure creation should capture the value of this binding.

We need to extend the syntax functions for computing free variables, extracting λ-expressions, and so on. All of this is straightforward.

The key complication to compiling a letrec-expression is that the name of a function should be bound—to itself—within the body of the function. The key insight into achieving this is to first allocate closures, but to delay the actual population of the closures’ environments.

The way that compiling a letrec-expression works is roughly:

The compile-letrec function takes a list of variables to bind, the right-hand-side λ-expressions, body, and compile-time environment. It relies on three helper functions to handle the tasks listed above:

; (Listof Variable) (Listof Lambda) Expr CEnv -> Asm
(define (compile-letrec fs ls e c)
  (let ((c0 (compile-letrec-λs ls c))
        (c1 (compile-letrec-init fs ls (append (reverse fs) c)))
        (c2 (compile-e e (append (reverse fs) c))))
    `(,@c0
      ,@c1
      ,@c2)))

The first two tasks are taken care of by compile-letrec-λs, which allocates unitialized closures and pushes each on the stack.

; (Listof Lambda) CEnv -> Asm
; Create a bunch of uninitialized closures and push them on the stack
(define (compile-letrec-λs ls c)
  (match ls
    ['() '()]
    [(cons l ls)
     (let ((cs (compile-letrec-λs ls (cons #f c)))
           (ys (fvs l)))
       `((lea rax (offset ,(second (third l)) 0))
         (mov (offset rdi 0) rax)
         (mov rax ,(length ys))
         (mov (offset rdi 1) rax)
         (mov rax rdi)
         (or rax ,type-proc)
         (add rdi ,(* 8 (+ 2 (length ys))))
         (mov (offset rsp ,(- (add1 (length c)))) rax)
         ,@cs))]))

The compile-letrec-init goes through each function and initializes its closure now that all of the function pointers are available. Finally the body is compiled in an extended environment.

; (Listof Variable) (Listof Lambda) CEnv -> Asm
; Initialize closures bound to each variable in fs
(define (compile-letrec-init fs ls c)
  (match fs
    ['() '()]
    [(cons f fs)
     (let ((ys (fvs (first ls)))
           (cs (compile-letrec-init fs (rest ls) c)))
       `((mov r9 (offset rsp ,(- (add1 (lookup f c)))))
         (xor r9 ,type-proc)
         (add r9 16) ; move past label and length
         ,@(copy-env-to-heap ys c 0)
         ,@cs))]))

We can give a spin:

Examples

> (asm-interp (compile '(letrec ((even?
                                  (λ (x)
                                    (if (zero? x)
                                        #t
                                        (odd? (sub1 x)))))
                                 (odd?
                                  (λ (x)
                                    (if (zero? x)
                                        #f
                                        (even? (sub1 x))))))
                          (even? 10))))

#t

> (asm-interp
    (compile
      '(letrec ((map (λ (f ls)
                      (letrec ((mapper (λ (ls)
                                         (if (empty? ls)
                                           '()
                                           (cons (f (car ls)) (mapper (cdr ls)))))))
                        (mapper ls)))))
        (map (λ (f) (f 0))
             (cons (λ (x) (add1 x))
                   (cons (λ (x) (sub1 x))
                         '()))))))

'(1 -1)

15.10 Syntactic sugar for function definitions

The letrec form is a generlization of the (begin (define (f x ...) e) ... e0) form we started with when we first started looking at adding functions to the language. To fully subsume the language of Iniquity, we can add this form back in to the language as syntactic sugar for letrec, i.e. we can eliminate this form from programs by rewriting them.

Let Expr+ refer to programs containing (begin (define (f x ...) e) ... e0). The desugar function writes Expr+s into Exprs.

; Expr+ -> Expr
(define (desugar e+)
  (match e+
    [`(begin ,@(list `(define (,fs . ,xss) ,es) ...) ,e)
     `(letrec ,(map (λ (f xs e) `(,f (λ ,xs ,(desugar e)))) fs xss es)
        ,(desugar e))]
    [(? symbol? x)         x]
    [(? imm? i)            i]
    [`(box ,e0)            `(box ,(desugar e0))]
    [`(unbox ,e0)          `(unbox ,(desugar e0))]
    [`(cons ,e0 ,e1)       `(cons ,(desugar e0) ,(desugar e1))]
    [`(car ,e0)            `(car ,(desugar e0))]
    [`(cdr ,e0)            `(cdr ,(desugar e0))]
    [`(add1 ,e0)           `(add1 ,(desugar e0))]
    [`(sub1 ,e0)           `(sub1 ,(desugar e0))]
    [`(zero? ,e0)          `(zero? ,(desugar e0))]
    [`(empty? ,e0)         `(empty? ,(desugar e0))]
    [`(if ,e0 ,e1 ,e2)     `(if ,(desugar e0) ,(desugar e1) ,(desugar e2))]
    [`(+ ,e0 ,e1)          `(+ ,(desugar e0) ,(desugar e1))]
    [`(let ((,x ,e0)) ,e1) `(let ((,x ,(desugar e0))) ,(desugar e1))]
    [`(letrec ,bs ,e0)
     `(letrec ,(map (λ (b) (list (first b) (desugar (second b)))) bs)
        ,(desugar e0))]
    [`(λ ,xs ,e0)          `(λ ,xs ,(desugar e0))]
    [`(,e . ,es)           `(,(desugar e) ,@(map desugar es))]))

The compiler now just desugars before labeling and compiling expressions.

And here’s the complete compiler, including tail calls, letrec, etc.:

loot/compile.rkt

  #lang racket
  (require "syntax.rkt")
  (provide (all-defined-out))
   
  ;; An immediate is anything ending in #b000
  ;; All other tags in mask #b111 are pointers
   
  (define result-shift     3)
  (define result-type-mask (sub1 (arithmetic-shift 1 result-shift)))
  (define type-imm         #b000)
  (define type-box         #b001)
  (define type-pair        #b010)
  (define type-string      #b011)
  (define type-proc        #b100) ;; <-- NEW: procedure value: points to function label in memory
   
  (define imm-shift        (+ 2 result-shift))
  (define imm-type-mask    (sub1 (arithmetic-shift 1 imm-shift)))
  (define imm-type-int     (arithmetic-shift #b00 result-shift))
  (define imm-type-bool    (arithmetic-shift #b01 result-shift))
  (define imm-type-char    (arithmetic-shift #b10 result-shift))
  (define imm-type-empty   (arithmetic-shift #b11 result-shift))
  (define imm-val-false    imm-type-bool)
  (define imm-val-true
    (bitwise-ior (arithmetic-shift 1 (add1 imm-shift)) imm-type-bool))
   
  ;; Allocate in 64-bit (8-byte) increments, so pointers
  ;; end in #b000 and we tag with #b001 for boxes, etc.
   
  ;; type CEnv = (Listof (Maybe Variable))
  ;; type Imm = Integer | Boolean | Char | ''()
   
  ;; type LExpr =
  ;; ....
  ;; | `(λ ,Formals ,Label ,Expr)
   
  ;; type Label = (quote Symbol)
   
  ;; Expr -> Asm
  (define (compile e)
    (let ((le (label-λ (desugar e))))
      `(entry
        ,@(compile-tail-e le '())
        ret
        ,@(compile-λ-definitions (λs le))
        err
        (push rbp)
        (call error)
        ret)))
   
  ;; (Listof Lambda) -> Asm
  (define (compile-λ-definitions ls)
    (apply append (map compile-λ-definition ls)))
   
  ;; Lambda -> Asm
  (define (compile-λ-definition l)
    (match l
      [`(λ ,xs ',f ,e0)
       (let ((c0 (compile-tail-e e0 (reverse (append xs (fvs l))))))
         `(,f
           ,@c0
           ret))]))
   
  ;; LExpr CEnv -> Asm
  ;; Compile an expression in tail position
  (define (compile-tail-e e c)
    (match e
      [(? symbol? x)         (compile-variable x c)]
      [(? imm? i)            (compile-imm i)]
      [`(box ,e0)            (compile-box e0 c)]
      [`(unbox ,e0)          (compile-unbox e0 c)]
      [`(cons ,e0 ,e1)       (compile-cons e0 e1 c)]
      [`(car ,e0)            (compile-car e0 c)]
      [`(cdr ,e0)            (compile-cdr e0 c)]
      [`(add1 ,e0)           (compile-add1 e0 c)]
      [`(sub1 ,e0)           (compile-sub1 e0 c)]
      [`(zero? ,e0)          (compile-zero? e0 c)]
      [`(empty? ,e0)         (compile-empty? e0 c)]
      [`(if ,e0 ,e1 ,e2)     (compile-tail-if e0 e1 e2 c)]
      [`(+ ,e0 ,e1)          (compile-+ e0 e1 c)]
      [`(let ((,x ,e0)) ,e1) (compile-tail-let x e0 e1 c)]
      [`(letrec ,bs ,e0)     (compile-tail-letrec (map first bs) (map second bs) e0 c)]
      [`(λ ,xs ',l ,e0)      (compile-λ xs l (fvs e) c)]
      [`(,e . ,es)           (compile-tail-call e es c)]))
   
  ;; LExpr CEnv -> Asm
  ;; Compile an expression in non-tail position
  (define (compile-e e c)
    (match e
      [(? symbol? x)         (compile-variable x c)]
      [(? imm? i)            (compile-imm i)]
      [`(box ,e0)            (compile-box e0 c)]
      [`(unbox ,e0)          (compile-unbox e0 c)]
      [`(cons ,e0 ,e1)       (compile-cons e0 e1 c)]
      [`(car ,e0)            (compile-car e0 c)]
      [`(cdr ,e0)            (compile-cdr e0 c)]
      [`(add1 ,e0)           (compile-add1 e0 c)]
      [`(sub1 ,e0)           (compile-sub1 e0 c)]
      [`(zero? ,e0)          (compile-zero? e0 c)]
      [`(empty? ,e0)         (compile-empty? e0 c)]
      [`(if ,e0 ,e1 ,e2)     (compile-if e0 e1 e2 c)]
      [`(+ ,e0 ,e1)          (compile-+ e0 e1 c)]
      [`(let ((,x ,e0)) ,e1) (compile-let x e0 e1 c)]
      [`(λ ,xs ',l ,e0)      (compile-λ xs l (fvs e) c)]
      [`(letrec ,bs ,e0)     (compile-letrec (map first bs) (map second bs) e0 c)]
      [`(,e . ,es)           (compile-call e es c)]))
   
  ;; (Listof Variable) Label (Listof Varialbe) CEnv -> Asm
  (define (compile-λ xs f ys c)
    `(;; Save label address
      (lea rax (offset ,f 0))
      (mov (offset rdi 0) rax)
   
      ;; Save the environment
      (mov r8 ,(length ys))
      (mov (offset rdi 1) r8)
      (mov r9 rdi)
      (add r9 16)
      ,@(copy-env-to-heap ys c 0)
   
      ;; Return a pointer to the closure
      (mov rax rdi)
      (or rax ,type-proc)
      (add rdi ,(* 8 (+ 2 (length ys))))))
   
  ;; (Listof Variable) CEnv Natural -> Asm
  ;; Pointer to beginning of environment in r9
  (define (copy-env-to-heap fvs c i)
    (match fvs
      ['() '()]
      [(cons x fvs)
       `((mov r8 (offset rsp ,(- (add1 (lookup x c)))))
         (mov (offset r9 ,i) r8)
         ,@(copy-env-to-heap fvs c (add1 i)))]))
   
  ;; Natural Natural -> Asm
  ;; Move i arguments upward on stack by offset off
  (define (move-args i off)
    (match i
          [0 '()]
          [_ `(,@(move-args (sub1 i) off)
               (mov rbx (offset rsp ,(- off i)))
               (mov (offset rsp ,(- i)) rbx))]))
   
  ;; LExpr (Listof LExpr) CEnv -> Asm
  (define (compile-call e0 es c)
    (let ((cs (compile-es es (cons #f c)))
          (c0 (compile-e e0 c))
          (i (- (add1 (length c))))
          (stack-size (* 8 (length c))))
      `(,@c0
        (mov (offset rsp ,i) rax)
        ,@cs
        (mov rax (offset rsp ,i))
        ,@assert-proc
        (xor rax ,type-proc)
        (sub rsp ,stack-size)
   
        (mov rcx rsp) ; start of stack in rcx
        (add rcx ,(- (* 8 (+ 2 (length es)))))
        ,@(copy-closure-env-to-stack)
   
        (call (offset rax 0))
        (add rsp ,stack-size))))
   
  ;; LExpr (Listof LExpr) CEnv -> Asm
  (define (compile-tail-call e0 es c)
    (let ((cs (compile-es es (cons #f c)))
          (c0 (compile-e e0 c))
          (i (- (add1 (length c)))))
      `(,@c0
        (mov (offset rsp ,i) rax)
        ,@cs
        (mov rax (offset rsp ,i))
        ,@(move-args (length es) i)
        ,@assert-proc
        (xor rax ,type-proc)
   
        (mov rcx rsp) ; start of stack in rcx
        (add rcx ,(- (* 8 (+ 1 (length es)))))
        ,@(copy-closure-env-to-stack)
   
        ;,@(copy-closure-env-to-stack (length es))
        (jmp (offset rax 0)))))
   
  ;; -> Asm
  ;; Copy closure's (in rax) env to stack in rcx
  (define (copy-closure-env-to-stack)
    (let ((copy-loop (gensym 'copy_closure))
          (copy-done (gensym 'copy_done)))
      `((mov r8 (offset rax 1)) ; length
        (mov r9 rax)
        (add r9 16)             ; start of env
        ,copy-loop
        (cmp r8 0)
        (je ,copy-done)
        (mov rbx (offset r9 0))
        (mov (offset rcx 0) rbx)
        (sub r8 1)
        (add r9 8)
        (sub rcx 8)
        (jmp ,copy-loop)
        ,copy-done)))
   
  ;; (Listof Variable) (Listof Lambda) Expr CEnv -> Asm
  (define (compile-letrec fs ls e c)
    (let ((c0 (compile-letrec-λs ls c))
          (c1 (compile-letrec-init fs ls (append (reverse fs) c)))
          (c2 (compile-e e (append (reverse fs) c))))
      `(,@c0
        ,@c1
        ,@c2)))
   
  ;; (Listof Variable) (Listof Lambda) Expr CEnv -> Asm
  (define (compile-tail-letrec fs ls e c)
    (let ((c0 (compile-letrec-λs ls c))
          (c1 (compile-letrec-init fs ls (append (reverse fs) c)))
          (c2 (compile-tail-e e (append (reverse fs) c))))
      `(,@c0
        ,@c1
        ,@c2)))
   
  ;; (Listof Lambda) CEnv -> Asm
  ;; Create a bunch of uninitialized closures and push them on the stack
  (define (compile-letrec-λs ls c)
    (match ls
      ['() '()]
      [(cons l ls)
       (let ((cs (compile-letrec-λs ls (cons #f c)))
             (ys (fvs l)))
         `((lea rax (offset ,(second (third l)) 0))
           (mov (offset rdi 0) rax)
           (mov rax ,(length ys))
           (mov (offset rdi 1) rax)
           (mov rax rdi)
           (or rax ,type-proc)
           (add rdi ,(* 8 (+ 2 (length ys))))
           (mov (offset rsp ,(- (add1 (length c)))) rax)
           ,@cs))]))
   
  ;; (Listof Variable) (Listof Lambda) CEnv -> Asm
  (define (compile-letrec-init fs ls c)
    (match fs
      ['() '()]
      [(cons f fs)
       (let ((ys (fvs (first ls)))
             (cs (compile-letrec-init fs (rest ls) c)))
         `((mov r9 (offset rsp ,(- (add1 (lookup f c)))))
           (xor r9 ,type-proc)
           (add r9 16) ; move past label and length
           ,@(copy-env-to-heap ys c 0)
           ,@cs))]))
   
  ;; (Listof LExpr) CEnv -> Asm
  (define (compile-es es c)
    (match es
      ['() '()]
      [(cons e es)
       (let ((c0 (compile-e e c))
             (cs (compile-es es (cons #f c))))
         `(,@c0
           (mov (offset rsp ,(- (add1 (length c)))) rax)
           ,@cs))]))
   
  ;; Imm -> Asm
  (define (compile-imm i)
    `((mov rax ,(imm->bits i))))
   
  ;; Imm -> Integer
  (define (imm->bits i)
    (match i
      [(? integer? i) (arithmetic-shift i imm-shift)]
      [(? char? c)    (+ (arithmetic-shift (char->integer c) imm-shift) imm-type-char)]
      [(? boolean? b) (if b imm-val-true imm-val-false)]
      [''()           imm-type-empty]))
   
  ;; Variable CEnv -> Asm
  (define (compile-variable x c)
    (let ((i (lookup x c)))
      `((mov rax (offset rsp ,(- (add1 i)))))))
   
  ;; LExpr CEnv -> Asm
  (define (compile-box e0 c)
    (let ((c0 (compile-e e0 c)))
      `(,@c0
        (mov (offset rdi 0) rax)
        (mov rax rdi)
        (or rax ,type-box)
        (add rdi 8)))) ; allocate 8 bytes
   
  ;; LExpr CEnv -> Asm
  (define (compile-unbox e0 c)
    (let ((c0 (compile-e e0 c)))
      `(,@c0
        ,@assert-box
        (xor rax ,type-box)
        (mov rax (offset rax 0)))))
   
  ;; LExpr LExpr CEnv -> Asm
  (define (compile-cons e0 e1 c)
    (let ((c0 (compile-e e0 c))
          (c1 (compile-e e1 (cons #f c))))
      `(,@c0
        (mov (offset rsp ,(- (add1 (length c)))) rax)
        ,@c1
        (mov (offset rdi 0) rax)
        (mov rax (offset rsp ,(- (add1 (length c)))))
        (mov (offset rdi 1) rax)
        (mov rax rdi)
        (or rax ,type-pair)
        (add rdi 16))))
   
  ;; LExpr CEnv -> Asm
  (define (compile-car e0 c)
    (let ((c0 (compile-e e0 c)))
      `(,@c0
        ,@assert-pair
        (xor rax ,type-pair)
        (mov rax (offset rax 1)))))
   
  ;; LExpr CEnv -> Asm
  (define (compile-cdr e0 c)
    (let ((c0 (compile-e e0 c)))
      `(,@c0
        ,@assert-pair
        (xor rax ,type-pair)
        (mov rax (offset rax 0)))))
   
  ;; LExpr CEnv -> Asm
  (define (compile-empty? e0 c)
    (let ((c0 (compile-e e0 c))
          (l0 (gensym)))
      `(,@c0
        (and rax ,imm-type-mask)
        (cmp rax ,imm-type-empty)
        (mov rax ,imm-val-false)
        (jne ,l0)
        (mov rax ,imm-val-true)
        ,l0)))
   
  ;; LExpr CEnv -> Asm
  (define (compile-add1 e0 c)
    (let ((c0 (compile-e e0 c)))
      `(,@c0
        ,@assert-integer
        (add rax ,(arithmetic-shift 1 imm-shift)))))
   
  ;; LExpr CEnv -> Asm
  (define (compile-sub1 e0 c)
    (let ((c0 (compile-e e0 c)))
      `(,@c0
        ,@assert-integer
        (sub rax ,(arithmetic-shift 1 imm-shift)))))
   
  ;; LExpr CEnv -> Asm
  (define (compile-zero? e0 c)
    (let ((c0 (compile-e e0 c))
          (l0 (gensym))
          (l1 (gensym)))
      `(,@c0
        ,@assert-integer
        (cmp rax 0)
        (mov rax ,imm-val-false)
        (jne ,l0)
        (mov rax ,imm-val-true)
        ,l0)))
   
  ;; LExpr LExpr LExpr CEnv -> Asm
  (define (compile-if e0 e1 e2 c)
    (let ((c0 (compile-e e0 c))
          (c1 (compile-e e1 c))
          (c2 (compile-e e2 c))
          (l0 (gensym))
          (l1 (gensym)))
      `(,@c0
        (cmp rax ,imm-val-false)
        (je ,l0)
        ,@c1
        (jmp ,l1)
        ,l0
        ,@c2
        ,l1)))
   
  ;; LExpr LExpr LExpr CEnv -> Asm
  (define (compile-tail-if e0 e1 e2 c)
    (let ((c0 (compile-e e0 c))
          (c1 (compile-tail-e e1 c))
          (c2 (compile-tail-e e2 c))
          (l0 (gensym))
          (l1 (gensym)))
      `(,@c0
        (cmp rax ,imm-val-false)
        (je ,l0)
        ,@c1
        (jmp ,l1)
        ,l0
        ,@c2
        ,l1)))
   
  ;; Variable LExpr LExpr CEnv -> Asm
  (define (compile-tail-let x e0 e1 c)
    (let ((c0 (compile-e e0 c))
          (c1 (compile-tail-e e1 (cons x c))))
      `(,@c0
        (mov (offset rsp ,(- (add1 (length c)))) rax)
        ,@c1)))
   
  ;; Variable LExpr LExpr CEnv -> Asm
  (define (compile-let x e0 e1 c)
    (let ((c0 (compile-e e0 c))
          (c1 (compile-e e1 (cons x c))))
      `(,@c0
        (mov (offset rsp ,(- (add1 (length c)))) rax)
        ,@c1)))
   
  ;; LExpr LExpr CEnv -> Asm
  (define (compile-+ e0 e1 c)
    (let ((c1 (compile-e e1 c))
          (c0 (compile-e e0 (cons #f c))))
      `(,@c1
        ,@assert-integer
        (mov (offset rsp ,(- (add1 (length c)))) rax)
        ,@c0
        ,@assert-integer
        (add rax (offset rsp ,(- (add1 (length c))))))))
   
   
  (define (type-pred->mask p)
    (match p
      [(or 'box? 'cons? 'string? 'procedure?) result-type-mask]
      [_ imm-type-mask]))
   
  (define (type-pred->tag p)
    (match p
      ['box?       type-box]
      ['cons?      type-pair]
      ['string?    type-string]
      ['procedure? type-proc]
      ['integer?   imm-type-int]
      ['empty?     imm-type-empty]
      ['char?      imm-type-char]
      ['boolean?   imm-type-bool]))
   
  ;; Variable CEnv -> Natural
  (define (lookup x cenv)
    (match cenv
      ['() (error "undefined variable:" x)]
      [(cons y cenv)
       (match (eq? x y)
         [#t (length cenv)]
         [#f (lookup x cenv)])]))
   
  (define (assert-type p)
    `((mov rbx rax)
      (and rbx ,(type-pred->mask p))
      (cmp rbx ,(type-pred->tag p))
      (jne err)))
   
  (define assert-integer (assert-type 'integer?))
  (define assert-box     (assert-type 'box?))
  (define assert-pair    (assert-type 'cons?))
  (define assert-string  (assert-type 'string?))
  (define assert-char    (assert-type 'char?))
  (define assert-proc    (assert-type 'procedure?))
   
  ;; Asm
  (define assert-natural
    `(,@assert-integer
      (cmp rax -1)
      (jle err)))
   
  ;; Asm
  (define assert-integer-codepoint
    `((mov rbx rax)
      (and rbx ,imm-type-mask)
      (cmp rbx 0)
      (jne err)
      (cmp rax ,(arithmetic-shift -1 imm-shift))
      (jle err)
      (cmp rax ,(arithmetic-shift #x10FFFF imm-shift))
      (mov rbx rax)
      (sar rbx ,(+ 11 imm-shift))
      (cmp rbx #b11011)
      (je err)))