+ ; is this a closure that captures itself?
+ ; e.g. (let ([x 3] [f (closure lambda0 (f x))]) (f))
+ (define (self-captive-closure? name expr)
+ (and (eqv? (ast-type expr) 'closure)
+ (memv name (caddr expr))))
+
+ ;; (define (emit-scc scc env)
+ ;; ; acc is a pair of the env and list of touchups
+ ;; (define (emit-binding acc binding)
+ ;; (let ([binding-name (car binding)]
+ ;; [binding-body (cadr binding)]
+
+ ;; [other-bindings (filter
+ ;; (lambda (x) (not (eqv? binding-name x)))
+ ;; scc)]
+ ;; [mutually-recursives
+ ;; (filter
+ ;; (lambda (other-binding)
+ ;; (memv other-binding (references binding-body)))
+ ;; other-bindings)]
+
+ ;; [new-touchups (append touchups (cdr acc))])
+
+ ;; ; TODO: assert that the only mutually recursives are closures
+ ;; (for-each
+ ;; (lambda (binding)
+ ;; (when (not (eqv? (ast-type (cadr binding))
+
+ ;; (emit "asdf")
+ ;; (cons new-env new-touchups)
+ ;; ))
+
+ ;; (fold-left emit-binding (cons env '()) scc))))
+ ; assoc map of binding name to size
+ (define stack-sizes
+ (map (lambda (binding) (cons (car binding) (expr-size (cadr binding))))
+ bindings))
+
+ ; assoc map of binding name to offset
+ (define stack-offsets
+ ; 2 4 2 8 6
+ (let* ([totals ; 2 6 8 16 22
+ (reverse (fold-left (lambda (acc x)
+ (if (null? acc)
+ (list x)
+ (cons (+ x (car acc)) acc)))
+ '()
+ (map cdr stack-sizes)))]
+ ; 0 2 6 8 16
+ [relative-offsets (map - totals (map cdr stack-sizes))]
+ [absolute-offsets (map (lambda (x) (- si x)) relative-offsets)])
+ (map cons (map car stack-sizes) absolute-offsets)))
+
+ (let* (
+ ; the stack index used when codegening binding body and main body
+ ; -> stack ->
+ ; [stack-offsets | inner-si]
+ [inner-si (- si (fold-left + 0 (map cdr stack-sizes)))]
+
+ [get-offset (lambda (n) (cdr (assoc n stack-offsets)))]
+
+ [inner-env
+ (fold-left
+ (lambda (env comps)
+ (let* ([scc-binding-offsets
+ (fold-left
+ (lambda (acc name)
+ (cons (cons name (get-offset name))
+ acc))
+ (env-bindings env)
+ comps)]
+ [scc-env (make-env (env-data-layouts env) scc-binding-offsets)])
+ (for-each
+ (lambda (name)
+ (let* ([expr (cadr (assoc name bindings))]
+ [size (expr-size expr)])
+ (emit "## generating ~a with scc-env ~a" name scc-env)
+ (if (self-captive-closure? name expr)
+ ; if self-captive, insert a flag into the environment to let
+ ; codegen-closure realise this!
+ (codegen-expr expr
+ inner-si
+ (make-env
+ (env-data-layouts scc-env)
+ (cons (cons name 'self-captive)
+ (env-bindings scc-env))))
+ (codegen-expr expr inner-si scc-env))
+
+ (if (on-stack? expr)
+ (begin
+ ; copy over whatevers on the stack
+ (emit "leaq ~a(%rbp), %rsi" (- inner-si size))
+ (emit "leaq ~a(%rbp), %rdi" (- (get-offset name) size))
+ (emit "movq $~a, %rcx" (/ size wordsize))
+ (emit "rep movsq"))
+
+ (emit "movq %rax, ~a(%rbp)" (get-offset name)))))
+ comps)
+ scc-env))
+ env
+ (reverse (sccs (graph bindings))))])