Update other combinators to match book

This commit is contained in:
2025-11-22 20:21:28 -06:00
parent 0d721bde8b
commit 9df556d2ac

View File

@@ -354,7 +354,7 @@
(let lp ([rank 0]
[m* (meaning-list e* r #f)])
(if (pair? m*)
(STORE-ARGUMENT (lp (1+ rank) (cdr m*)) (car m*) rank)
(STORE-ARGUMENT (car m*) (lp (1+ rank) (cdr m*)) rank)
(ALLOCATE-FRAME (length e*)))))
(define (meaning*-dotted e* r fixed-size)
@@ -362,17 +362,17 @@
[m* (meaning-list e* r #f)])
(cond
[(null? m*) (ALLOCATE-DOTTED-FRAME fixed-size)]
[(> fixed-size rank) (STORE-ARGUMENT (lp (1+ rank) (cdr m*)) (car m*) rank)]
[else (CONS-ARGUMENT (lp (1+ rank) (cdr m*)) (car m*) fixed-size)])))
[(> fixed-size rank) (STORE-ARGUMENT (car m*) (lp (1+ rank) (cdr m*)) rank)]
[else (CONS-ARGUMENT (car m*) (lp (1+ rank) (cdr m*)) fixed-size)])))
(define (STORE-ARGUMENT m* m rank)
(define (STORE-ARGUMENT m m* rank)
(lambda ()
(let ([v* (m*)]
[v (m)])
(activation-rec-set! v* rank v)
v*)))
(define (CONS-ARGUMENT m* m size)
(define (CONS-ARGUMENT m m* size)
(lambda ()
(let* ([v* (m*)]
[v (m)]
@@ -395,18 +395,18 @@
(m* (meaning* e* r))]
((if tail? TR-REGULAR-CALL REGULAR-CALL) mf m*))) ;; hehe new trick
(define (REGULAR-CALL m m+)
(define (REGULAR-CALL m m*)
(lambda ()
(let* ([f (m)]
[v* (m+)]
[v* (m*)]
[sr (*env*)]
[res (invoke f v*)])
(*env* sr)
res)))
(define (TR-REGULAR-CALL m m+)
(define (TR-REGULAR-CALL m m*)
(lambda ()
(invoke (m) (m+))))
(invoke (m) (m*))))
(define (meaning-primitive-application f e* r)
(let* ([desc (get-description f)]