093-heap-mark-rewind.scm (2336B)
1 ; heap-mark / heap-rewind! — A → B → C ergonomics. 2 ; 3 ; A: caller. Arena-unaware; just calls (B input) and gets a value back. 4 ; B: arena boundary. Allocates the output cell BEFORE marking, calls C 5 ; to fill it in, rewinds, returns the output to A. 6 ; C: worker. Arena-unaware; allocates scratch and mutates the output. 7 ; 8 ; Invariant for B: between (heap-rewind! mark) and the function's final 9 ; return of out, NO heap allocation may occur. heap-rewind! only resets 10 ; heap_next; it does not zero memory. The trailing env walk that resolves 11 ; the bare `out` symbol reads dropped-but-intact cells, which is well- 12 ; defined as long as nothing has allocated since the rewind. By the time 13 ; A receives the value, all references are to `out` itself (allocated 14 ; pre-mark, permanently safe). 15 ; 16 ; C is tail-recursive; proper tail calls collapse host frames, and the 17 ; recursive heap envs all die together at the rewind. 18 19 (define (C-loop out xs sum count rev) 20 (if (null? xs) 21 (begin 22 (set-car! out sum) 23 (set-cdr! out count)) 24 (C-loop out 25 (cdr xs) 26 (+ sum (car xs)) 27 (+ count 1) 28 (cons (car xs) rev)))) 29 30 (define (C out input) 31 (C-loop out input 0 0 '())) 32 33 (define (B input) 34 (let ((out (cons 0 0)) ; pre-mark: survives rewind 35 (mark (heap-mark))) ; everything past here is C's scratch 36 (C out input) 37 (heap-rewind! mark) 38 out)) 39 40 (define (A) 41 (let ((input (cons 1 (cons 2 (cons 3 (cons 4 (cons 5 '()))))))) 42 (B input))) 43 44 ; A no-rewind sibling lets us assert the rewind actually saves bytes. 45 (define (B-noreclaim input) 46 (let ((out (cons 0 0))) 47 (C out input) 48 out)) 49 50 (define (A-noreclaim) 51 (let ((input (cons 1 (cons 2 (cons 3 (cons 4 (cons 5 '()))))))) 52 (B-noreclaim input))) 53 54 (define before (heap-mark)) 55 (define result (A)) 56 (define after (heap-mark)) 57 (define delta (- after before)) 58 59 (define before2 (heap-mark)) 60 (define result2 (A-noreclaim)) 61 (define after2 (heap-mark)) 62 (define delta2 (- after2 before2)) 63 64 (sys-exit 65 (if (= (car result) 15) 66 (if (= (cdr result) 5) 67 (if (= (car result2) 15) 68 (if (= (cdr result2) 5) 69 (if (< delta delta2) 70 42 71 43) 72 44) 73 45) 74 46) 75 47))