gyehoek-hs/doc/closure-conversion.org

closure-conversion

• scratchpad
  • example
  • wasm
  • example

the closure-conversion phase makes closed-over variables explicit by addition of the primitive make-closure, taking a code pointer (in the CPS language, bare lambda) and the environment.

nice testable properties of closure-converted code:

• code pointers only appear in function position
• no function has free variables

multiple env-ref calls could probably be replaced with a primitive that loads the entire environment at once, returning multiple variables.

scratchpad

example

  (letrec ((curried-add (λ (n)
                          (λ (m)
                            (+ n m)))))
    ((curried-add 3) 4))

scheme source

  (letrec ((curried-add
            (λ (n ktail0)
              (letrec ((curried-add-in
                        (λ (m ktail1)
                          (prim (+ n m)
                                (κ (x0) (continue ktail1 x0))))))
                (continue ktail0 curried-add-in)))))
    (letrec ((k0 (κ (adder) (adder 4 halt))))
      (curried-add 3 k0)))

cps

  (letrec ((curried-add
            (λ (n ktail0)
              (letrec ((curried-add-in-code
                        (λ (env m ktail1)
                          (prim (env-ref 0 env)
                                (κ (n)
                                   (prim (+ n m)
                                         (κ (x0) (continue ktail1 x0))))))))
                (prim (make-closure curried-add-in-code n)
                      (κ (curried-add-in)
                         (continue ktail0 curried-add-in)))))))
    (letrec ((k0 (κ (adder-closure)
                    (prim (closure-code adder-closure)
                          (κ (adder)
                             (adder adder-closure 4 halt))))))
      (curried-add 3 k0)))

closure-converted

wasm

(letrec ((make-adder
        (lambda (n)
          (lambda (x)
            (+ n x)))))
((make-adder 3) 2))

(define add-code
  (lambda (n env)
    (+ n (env-ref env 'x))))

(define make-adder-code
  (lambda (n)
    (make-closure add-code ('x n))))

(define make-adder (make-closure make-adder-code))

(apply-closure (apply-closure make-addder 3) 2)

(module
 (type $heap-object (sub (struct (field $hash (mut i32)))))
 (type $closure (sub $heap-object
                     (struct (field $hash (mut i32))
                             (field $code (ref $cont-type)))))
 (type $closure1 (sub $closure
                      (struct (field $hash (mut i32))
                              (field $code (ref $cont-type))
                              (field $env0 (ref eq)))))
 (global $arg0 (mut (ref null eq)) (ref.null eq))
 (global $arg1 (mut (ref null eq)) (ref.null eq))
 (global $arg2 (mut (ref null eq)) (ref.null eq))
 (global $arg3 (mut (ref null eq)) (ref.null eq))
 (global $arg4 (mut (ref null eq)) (ref.null eq))
 (global $arg5 (mut (ref null eq)) (ref.null eq))
 ;; ⋮
 ;; (global $argn (mut (ref null eq)) (ref.null eq))

 (global $current-closure (mut (ref null $closure)) (ref.null $closure))

 (func $add-code (param $nargs i32)
       (local $n (ref eq))
       (local $x (ref eq))
       (local.set $n (global.get $arg0))
       (local.set $x (struct.get $closure1
                                 (global.get $current-closure)
                                 $env0))
       (return (i32.add $n $x)))

 (func $make-adder-code (param $nargs i32)
       (local $n (ref eq))
       (local.set $n (global.get $arg0))
       (return (struct.new $closure1
                           0
                           $add-code)))

 (func $main
       (local.set $make-adder
                  (struct.new $closure
                              0
                              $make-adder-code))
       (global.set $current-closure $make-adder)
       (global.set $arg0 (i32.const 3))
       (local.set $f (call (struct.get $closure
                                       $make-adder
                                       $code)
                           1))
       (global.set $current-closure $f)
       (global.set $arg0 (i32.const 2))
       (return (call (struct.get $closure
                                 $f
                                 $code)
                     1))))

example

  (λ (n m ktail)
    (letrec ((f (λ (x ktail-0) (+ x n ktail-0)))
             (g (λ (y ktail-1) (+ y g ktail-1))))
      (prim (cons f g) ktail)))

  (λ (n m ktail)
    (letrec ((f-code (λ (x ktail-0)
                       (prim (env-get 2)
                         (κ (n)
                           (+ x n ktail-0)))))
             (g-code (λ (y ktail-1)
                       (prim (env-get 3)
                         (κ (m)
                           (+ y m ktail-1))))))
      (letrec ((with-closure-code
                (κ (f g)
                  (prim (get-env 0)
                    (κ (ktail)
                      (prim cons f g ktail))))))
        (prim (make-shared-closure (with-closure-code)
                                   ktail)
          (κ (with-closure)
            (prim (make-shared-closure (f-code g-code) n m)
              with-closure))))))