Update other combinators to match book
This commit is contained in:
@@ -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)]
|
||||
|
||||
Reference in New Issue
Block a user