sicp-ex-5.44



<< Previous exercise (5.43) | Index | Next exercise (5.45) >>


meteorgan

  
  
  
 (define (overwrite? operator ct-env) 
  (let ((r (find-variable operator ct-env))) 
   (eq? r 'not-found))) 
 (define (open-code? exp ct-env) 
  (and (memq (car exp) '(+ - * /)) 
          (overwrite? (car exp) ct-env))) 

Rptx

My modified procedures are in Exercise 5.38


revc

A compilation of solutions from Ex 5.39 to Ex 5.44.

  
  
  
 (load "ch5-compiler.scm") 
  
 ;;; syntax support 
 (define the-open-code-procedures 
   '(+ - * / =)) 
  
 (define (open-code-application? exp) 
   (memq (car exp) the-open-code-procedures)) 
  
 (define (second-operand operands) (cadr operands)) 
  
 ;;; Exercise 5.39-5.42 implement an "real" definition version of lexical addressing compiler, 
 ;;; in which internal definitions for block structure are considered "real" 
 ;;; defines. 
  
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
 ;;; NOTE: YOU CAN COMMENT OUT EXERCISE 5.43 IF YOU WANT TO RUN THIS VERSION. 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
  
  
 ;;; Exercise 5.39 
 ;;; operations used by run-time environment for lexical-addressing 
  
 (define (frame-number address) 
   (car address)) 
  
 (define (displacement-number address) 
   (cadr address)) 
  
 ;; return a frame with a given index 
 (define (env-ref runtime-env n) 
   (if (= n 0) 
       (first-frame runtime-env) 
       (env-ref (enclosing-environment runtime-env) 
                (- n 1)))) 
  
 (define (frame-values-ref frame-values n) 
   (list-ref frame-values n)) 
  
 (define (frame-values-set! frame-values n val) 
   (if (zero? n) 
       (set-car! frame-values val) 
       (frame-values-set! (cdr frame-values) (- n 1) val))) 
  
 (define (lexical-address-lookup address runtime-env) 
   (let* ([f-num (frame-number address)] 
          [d-num (displacement-number address)] 
          [val (frame-values-ref (frame-values (env-ref runtime-env f-num)) 
                                 d-num)]) 
     (if (eq? val '*unassigned*) 
         (error "use unassigned variable" (car vars)) 
         val))) 
  
 (define (lexical-address-set! address val runtime-env) 
   (let ([f-num (frame-number address)] 
         [d-num (displacement-number address)]) 
     (frame-values-set! 
      (frame-values 
       (env-ref runtime-env f-num)) 
      d-num 
      val))) 
  
  
 ;;; Exercise 5.40 
  
 ;; a blacklist contains a list of modified open-code-procedures 
 ;; which are no longer considered as open-code-procedures, 
 ;; we won't compile modified open-code-procedures "in line", 
 ;; instead, those will be taken as general application. 
 (define (compile exp compile-time-env blacklist target linkage) 
   (cond ((self-evaluating? exp) 
          (compile-self-evaluating exp target linkage)) 
         ((quoted? exp) (compile-quoted exp target linkage)) 
         ((variable? exp) 
          (compile-variable exp compile-time-env target linkage)) 
         ((assignment? exp) 
          (compile-assignment exp compile-time-env blacklist target linkage)) 
         ((definition? exp) 
          (compile-definition exp compile-time-env blacklist target linkage)) 
         ((if? exp) (compile-if exp compile-time-env blacklist target linkage)) 
         ((lambda? exp) (compile-lambda exp compile-time-env blacklist target linkage)) 
         ((begin? exp) 
          (compile-sequence (begin-actions exp) 
                            compile-time-env 
                            blacklist 
                            target 
                            linkage)) 
         ((cond? exp) (compile (cond->if exp) compile-time-env blacklist target linkage)) 
         ;; LET clause for the scaning out version 
         ((let? exp) (compile (let->combination exp) compile-time-env blacklist target linkage)) 
         ((and (open-code-application? exp) ; we compile exp "in line" if and only if 
                                            ; exp is open-code-application [1] 
                                            ;  
                                            ; and operator is open-code-procedure 
                                            ; (which means operator is not in 
                                            ; blacklist) [2] 
                                            ;  
                                            ; and variable will be found in top-level-environment 
                                            ; if we are in the current compile-time environment [3] 
                                            ;  
               (open-code-procedure? (operator exp) blacklist) 
               (variable-in-top-level? (operator exp) compile-time-env)) 
          (compile-open-code exp compile-time-env blacklist target linkage)) 
         ((application? exp) 
          (compile-application exp compile-time-env blacklist target linkage)) 
         (else 
          (error "Unknown expression type -- COMPILE" exp)))) 
  
 (define (compile-sequence seq compile-time-env blacklist target linkage) 
   ;; for internal definitions without scanning out, we need 
   ;; impose an evaluation order on sequence evaluation so that 
   ;; subsequent expressions can refer to preceding definitions. 
   ;; Here's why: I found the order of evaluation of operands is 
   ;; dependent on the implementation of Scheme. In Chez Scheme, 
   ;; the interpreter does not follow ours intuition that 
   ;; operands are evaluated from left to right. Running the 
   ;; compiled instructions by original version will raise 
   ;; an exception, if we don't impose an order of evaluation. 
   (let ([first-code (if (last-exp? seq) 
                         (compile (first-exp seq) compile-time-env blacklist target linkage) 
                         (compile (first-exp seq) compile-time-env blacklist target 'next))]) 
    (if (last-exp? seq) 
        first-code 
        (preserving '(env continue) 
                    first-code 
                    (compile-sequence (rest-exps seq) compile-time-env blacklist target linkage))))) 
  
  
 (define (compile-lambda exp compile-time-env blacklist target linkage) 
   (let ((proc-entry (make-label 'entry)) 
         (after-lambda (make-label 'after-lambda))) 
     (let ((lambda-linkage 
            (if (eq? linkage 'next) after-lambda linkage))) 
       (append-instruction-sequences 
        (tack-on-instruction-sequence 
         (end-with-linkage lambda-linkage 
                           (make-instruction-sequence '(env) (list target) 
                                                      `((assign ,target 
                                                                (op make-compiled-procedure) 
                                                                (label ,proc-entry) 
                                                                (reg env))))) 
         (compile-lambda-body exp 
                              (extend-compile-time-environment 
                               (lambda-parameters exp) 
                               compile-time-env) 
                              blacklist 
                              proc-entry)) 
        after-lambda)))) 
  
 (define (extend-compile-time-environment vars base-env) 
   (cons vars base-env)) 
  
 (define (compile-lambda-body exp compile-time-env blacklist proc-entry) 
   (let ((formals (lambda-parameters exp))) 
     (append-instruction-sequences 
      (make-instruction-sequence '(env proc argl) '(env) 
                                 `(,proc-entry 
                                   (assign env (op compiled-procedure-env) (reg proc)) 
                                   (assign env 
                                           (op extend-environment) 
                                           (const ,formals) 
                                           (reg argl) 
                                           (reg env)))) 
      (compile-sequence 
       (lambda-body exp) 
       compile-time-env 
       blacklist 
       'val 'return)))) 
  
 (define (compile-application exp compile-time-env blacklist target linkage) 
   (let ((proc-code (compile (operator exp) compile-time-env blacklist 'proc 'next)) 
         (operand-codes 
          (map (lambda (operand) (compile operand compile-time-env blacklist 'val 'next)) 
               (operands exp)))) 
     (preserving '(env continue) 
                 proc-code 
                 (preserving '(proc continue) 
                             (construct-arglist operand-codes) 
                             (compile-procedure-call target linkage))))) 
  
 (define (compile-if exp compile-time-env blacklist target linkage) 
   (let ((t-branch (make-label 'true-branch)) 
         (f-branch (make-label 'false-branch)) 
         (after-if (make-label 'after-if))) 
     (let ((consequent-linkage 
            (if (eq? linkage 'next) after-if linkage))) 
       (let ((p-code (compile (if-predicate exp) compile-time-env blacklist 'val 'next)) 
             (c-code 
              (compile 
               (if-consequent exp) compile-time-env blacklist target consequent-linkage)) 
             (a-code 
              (compile (if-alternative exp) compile-time-env blacklist target linkage))) 
         (preserving '(env continue) 
                     p-code 
                     (append-instruction-sequences 
                      (make-instruction-sequence '(val) '() 
                                                 `((test (op false?) (reg val)) 
                                                   (branch (label ,f-branch)))) 
                      (parallel-instruction-sequences 
                       (append-instruction-sequences t-branch c-code) 
                       (append-instruction-sequences f-branch a-code)) 
                      after-if)))))) 
  
  
 ;;; Exercise 5.41 
  
 (define (index-of lst val) 
   (define (iter n lst) 
     (cond [(null? lst) -1] 
           [(eq? (car lst) val) n] 
           [else (iter (+ n 1) (cdr lst))])) 
   (iter 0 lst)) 
  
 (define (found? address) 
   (not (eq? address 'not-found))) 
  
 (define (find-variable var compile-time-env) 
   (define (iter f-num compile-time-env) 
     (if (null? compile-time-env) 
         'not-found 
         (let ([d-num (index-of (first-frame compile-time-env) 
                                var)]) 
           (if (= d-num -1) 
               (iter (+ f-num 1) (enclosing-environment compile-time-env)) 
               (list f-num d-num))))) 
   (iter 0 compile-time-env)) 
  
  
 ;;; Exercise 5.42 
  
 (define (top-level-environment? compile-time-env) 
   (= (length compile-time-env) 1)) 
  
 (define (open-code-procedure? proc blacklist) 
   (and (memq proc the-open-code-procedures) 
        (not 
         (memq proc blacklist)))) 
  
 (define (add-proc-to-blacklist var blacklist) 
   (set-cdr! blacklist (cons var (cdr blacklist)))) 
  
 ;;; define a variable in the current compile-time-env 
 ;;; add a procedure to blacklist if it meets the conditions 
 ;;; (1. the current compile-time-env is top-level-environment 
 ;;;  2. it is open-code-procedure) 
  
 (define (define-compile-time-variable! var compile-time-env blacklist) 
   (if (and (top-level-environment? compile-time-env) 
            (open-code-procedure? var blacklist)) 
       (add-proc-to-blacklist var blacklist)) 
    
   (if (not (memq var (car compile-time-env))) 
       (set-car! compile-time-env (cons var (car compile-time-env))))) 
  
 (define (variable-in-top-level? var compile-time-env) 
   (eq? 
    (frame-number (find-variable var compile-time-env)) 
    (- (length compile-time-env) 1))) 
  
 (define (compile-variable exp compile-time-env target linkage) 
   (let ([address (find-variable exp compile-time-env)]) 
     (end-with-linkage linkage 
                       (make-instruction-sequence '(env) 
                                                  (list target) 
                                                  `((assign ,target 
                                                            (op lexical-address-lookup) 
                                                            (const ,address) 
                                                            (reg env))))))) 
  
 (define (compile-assignment exp compile-time-env blacklist target linkage) 
   (let* ([var (assignment-variable exp)] 
          [get-value-code 
           (compile (assignment-value exp) compile-time-env blacklist 'val 'next)] 
          [address (find-variable var compile-time-env)]) 
     (if (and (variable-in-top-level? var compile-time-env) 
              (open-code-procedure? var blacklist)) 
         (add-proc-to-blacklist var blacklist)) 
     (end-with-linkage linkage 
                       (preserving '(env) 
                                   get-value-code 
                                   (make-instruction-sequence '(env val) 
                                                              (list target) 
                                                              `((perform (op lexical-address-set!) 
                                                                         (const ,address) 
                                                                         (reg val) 
                                                                         (reg env)) 
                                                                (assign ,target (const ok)))))))) 
  
  
  
 (define (compile-definition exp compile-time-env blacklist target linkage) 
   (let ((var (definition-variable exp))) 
     (define-compile-time-variable! var compile-time-env blacklist) 
     (let ((get-value-code 
            (compile (definition-value exp) compile-time-env blacklist 'val 'next))) 
       (end-with-linkage linkage 
                         (preserving '(env) 
                                     get-value-code 
                                     (make-instruction-sequence '(env val) (list target) 
                                                                `((perform (op define-variable!) 
                                                                           (const ,var) 
                                                                           (reg val) 
                                                                           (reg env)) 
                                                                  (assign ,target (const ok))))))))) 
  
  
 ;;; setting up a compile time environment which is perfectly 
 ;;; parallel to the runtime environment, which means we do not 
 ;;; deal with the global environment specially (all variables 
 ;;; in the global environment have a correspoding lexical address. 
 (define (setup-compile-environment) 
   (list 
    (frame-variables 
     (first-frame 
      (setup-environment))))) 
  
  
  
 ;;; Exercise 5.43 
  
 ;;; **NB** we redefine some function in order to support an version with scanning out. 
 ;;; we don't define a variable in the current compile-time-env, 
 ;;; just add a procedure to blacklist if it meets the conditions 
 ;;; (1. the current compile-time-env is top-level-environment 
 ;;;  2. it is open-code-procedure) 
 (define (define-compile-time-variable! var compile-time-env blacklist) 
   (if (and (top-level-environment? compile-time-env) 
            (open-code-procedure? var blacklist)) 
       (add-proc-to-blacklist var blacklist))) 
  
 ;;; setting up a compile time environment, 
 ;;; the top level environment of a compile time environment 
 ;;; is empty, which means all variables 
 ;;; in the global environment don't have a lexical address, 
 ;;; so we need compile those expressions with lookup-variable-value. 
 (define (setup-compile-environment) 
   '(())) 
  
 ;;; we modified this, since the top level environment is empty. 
 (define (variable-in-top-level? var compile-time-env) 
   (not (found? (find-variable var compile-time-env)))) 
  
 ;;; NOTE: the special handling of the global variables 
 (define (compile-variable exp compile-time-env target linkage) 
   (let* ([address (find-variable exp compile-time-env)] 
          [lookup (if (found? address) 'lexical-address-lookup 'lookup-variable-value)] 
          [object (if (found? address) address exp)] 
          [needed (if (found? address) '(env) '())] 
          [modified (if (found? address) (list target) (list target 'env))] 
          [maybe-change-env (if (found? address) 
                                '() 
                                '((assign env (op get-global-environment))))]) 
     (end-with-linkage linkage 
                       (make-instruction-sequence needed 
                                                  modified 
                                                  (append 
                                                   maybe-change-env 
                                                   `((assign ,target 
                                                             (op ,lookup) 
                                                             (const ,object) 
                                                             (reg env)))))))) 
  
  
 (define (compile-assignment exp compile-time-env blacklist target linkage) 
   (let* ([var (assignment-variable exp)] 
          [get-value-code 
           (compile (assignment-value exp) compile-time-env blacklist 'val 'next)] 
          [address (find-variable var compile-time-env)] 
          [setter (if (found? address) 'lexical-address-set! 'set-variable-value!)] 
          [object (if (found? address) address var)] 
          [needed (if (found? address) '(env val) '(val))] 
          [modified (if (found? address) (list target) (list target 'env))] 
          [maybe-change-env (if (found? address) 
                                '() 
                                '((assign env (op get-global-environment))))]) 
     (if (and (variable-in-top-level? var compile-time-env) 
              (open-code-procedure? var blacklist)) 
         (add-proc-to-blacklist var blacklist)) 
     (end-with-linkage linkage 
                       (preserving '(env) 
                                   get-value-code 
                                   (make-instruction-sequence needed 
                                                              modified 
                                                              (append 
                                                               maybe-change-env 
                                                               `((perform (op ,setter) 
                                                                          (const ,object) 
                                                                          (reg val) 
                                                                          (reg env)) 
                                                                 (assign ,target (const ok))))))))) 
 ;;; NOTE: we scan out internal definitions in lambda body here. 
 (define (compile-lambda-body exp compile-time-env blacklist proc-entry) 
   (let ((formals (lambda-parameters exp))) 
     (append-instruction-sequences 
      (make-instruction-sequence '(env proc argl) '(env) 
                                 `(,proc-entry 
                                   (assign env (op compiled-procedure-env) (reg proc)) 
                                   (assign env 
                                           (op extend-environment) 
                                           (const ,formals) 
                                           (reg argl) 
                                           (reg env)))) 
      (compile-sequence 
       (scan-out-defines                 ;** 
        (lambda-body exp))               ;** 
       compile-time-env 
       blacklist 
       'val 'return)))) 
  
  
  
 ;;; Exercise 5.44 
 (define (spread-arguments operands compile-time-env blacklist) 
   (let ([arg1-code (compile (first-operand operands) compile-time-env blacklist 'arg1 'next)] 
         (rest-codes (map (lambda (op) (compile op compile-time-env blacklist 'arg2 'next)) 
                          (rest-operands operands)))) 
     (if (>= (length operands) 2) 
         (cons arg1-code rest-codes) 
         (error "Unsupported arity!" operands)))) 
  
 (define (compile-open-code exp compile-time-env blacklist target linkage) 
   (define (compile-open-code-rest operand-codes) 
     (if (null? (cdr operand-codes)) 
         (preserving 
          '(arg1) 
          (car operand-codes) 
          (make-instruction-sequence 
           '(arg1 arg2)                  ;in fact, arg2 can be omitted. 
           (list target) 
           `((assign ,target (op ,(operator exp)) (reg arg1) (reg arg2))))) 
  
         (preserving 
          '(arg1 env) 
          (car operand-codes) 
          (append-instruction-sequences 
           (make-instruction-sequence 
            '(arg1 arg2)                 ;in fact, arg2 can be omitted. 
            '(arg1) 
            `((assign arg1 (op ,(operator exp)) (reg arg1) (reg arg2)))) 
           (compile-open-code-rest (cdr operand-codes)) 
           )))) 
  
   ;; we evaluate the first operand and the second operand, 
   ;; then assign the values to the corresponding registers sequentially. 
   ;; By accumulating arg2 into arg1, we have the accumulation of the first 
   ;; two operands. After that, we evaluate the third and put its value into 
   ;; arg2. As above, we accumulate arg2 into arg1 so that we have the 
   ;; accumulation of the first three operands. And so on, until we reach 
   ;; the last operand of the operands, this time, we put the accumulation 
   ;; of arg1 and arg2 into the target register. 
    
   (let ([operand-codes (spread-arguments (operands exp) compile-time-env blacklist)]) 
     (end-with-linkage 
      linkage 
      (preserving 
       '(env) 
       (car operand-codes) 
       (compile-open-code-rest (cdr operand-codes)))))) 
  
  
 ;;; Verification Support 
 (load "ch5-regsim.scm") 
  
 (define (lookup-prim symbol operations) 
   (let ((val (assoc symbol operations))) 
     (if val 
         (cadr val) 
         (eval symbol)))) 
  
 ;;; some expressions and its corresponding anwsers 
 (define exps 
   (list 
     
    '(begin 
       (define (factorial n) 
         (if (= n 1) 
             1 
             (* (factorial (- n 1)) n))) 
       (factorial 5)) 
    ;; => 120 
     
    '(begin (define + (lambda (x) (- 1 1))) 
            + 
            (+ 1)) 
    ;; => 0 
     
    '(((lambda (x y) 
         (lambda (a b c d e) 
           ((lambda (y z) (* x y z)) 
            (* a b x) 
            (+ c d x)))) 
       3 
       4) 
      1 7 3 4 5 
      ) 
    ;; => 630 
     
    '(let ((x 3) (y 4)) 
       ((lambda (a b c d e) 
          (let ((y (* a b x)) (z (+ c d x))) 
            (* x y z))) 
        1 7 3 4 5 
        )) 
    ;; => 630 
  
    '(begin 
       (define (square x) (* x x)) 
       (define x 4) 
       (+ (square 2) x x) 
       ) 
    ;; => 12 
  
    '((lambda (+ * a b x y) 
        (+ (* a x) (* b y))) 
      + * 1 2 3 4) 
    ;; => 11 
          
    '((lambda (+ * a b x y) 
        (+ (* a x) (* b y))) 
      * + 1 2 3 4) 
    ;; => 24 
          
    '(begin 
       ((lambda (+ * a b x y) 
          (+ (* a x) (* b y))) 
        * + 1 2 3 4) 
       (+ 1 3 4 5)) 
    ;; => 13 
          
    '(begin 
       (set! + 1) 
       +) 
    ;; => 1 
          
    '(begin 
       (define y 2) 
       (define - y) 
       (define + -) 
       (define (f x) 
         (set! x +) 
         (set! + *) 
         (+ x 3)) 
       (f 2)) 
    ;; => 6 
          
    '(begin 
       (define (f x) 
         (define + -) 
         1) 
       (f 2) 
       (+ 1 1)) 
  
    ;; => 2 
  
    '(begin 
       (define (f x) 
         (set! + -) 
         1) 
       (f 2) 
       (+ 1 1)) 
    ;; => 0 
  
    '(begin 
       (define + -) 
       (+ 1 1)) 
    ;; => 0 
          
    '(begin 
       (define (factorial n) 
         (define (iter product counter) 
           (if (> counter n) 
               product 
               (iter (* counter product) 
                     (+ counter 1)))) 
         (iter 1 1)) 
       (factorial 5)) 
    ;; => 120 
  
    '(begin 
       (set! + (begin 
                 (set! + -) 
                 (+ 1 1))) 
       +) 
    ;; => 0 
     
    '(begin 
       (set! + (begin 
                 (+ 1 1))) 
       +) 
    ;; => 2 
     
    )) 
  
 (define (make-blacklist) 
   (list '*HEAD*)) 
  
 (define (compile-and-print exp) 
    
   (define the-global-environment (setup-environment)) 
   (define (get-global-environment) 
     the-global-environment) 
  
   (define demo-machine 
     (make-machine 
      all-regs 
      (list 
       (list 'get-global-environment get-global-environment)) 
      (statements 
       (compile exp 
                (setup-compile-environment) 
                (make-blacklist) 
                'val 
                'next)))) 
  
   ;; Extra settings for Chez Scheme 
   (define new-env 
     (copy-environment (scheme-environment))) 
    
   (eval '(define + '()) new-env) 
   (eval '(define + (eval '+ (scheme-environment))) new-env) 
   (eval '(define - '()) new-env) 
   (eval '(define - (eval '- (scheme-environment))) new-env) 
   (eval '(define * '()) new-env) 
   (eval '(define * (eval '* (scheme-environment))) new-env) 
   (eval '(define / '()) new-env) 
   (eval '(define / (eval '/ (scheme-environment))) new-env) 
   (eval '(define = '()) new-env) 
   (eval '(define = (eval '= (scheme-environment))) new-env) 
      
   (set-register-contents! demo-machine 'env (get-global-environment)) 
  
   (start demo-machine) 
   (pretty-print exp) 
   (display ";; => ") 
   (pretty-print (get-register-contents demo-machine 'val)) 
    
   (if  
    (eq? (eval exp new-env) 
         (get-register-contents demo-machine 'val)) 
    (display "pass") 
    (begin 
      (display "fail") 
      (newline) 
      (display (eval exp new-env)))) 
    
   (newline) 
   (newline) 
   ) 
  
 (for-each compile-and-print exps) 
  
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
 ;;;;OUTPUT;;;;;;;;;;;;;;;;;;;;;;;;;;; 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
  
 (begin 
   (define (factorial n) 
     (if (= n 1) 1 (* (factorial (- n 1)) n))) 
   (factorial 5)) 
 ;; => 120 
 pass 
  
 (begin (define + (lambda (x) (- 1 1))) + (+ 1)) 
 ;; => 0 
 pass 
  
 (((lambda (x y) 
     (lambda (a b c d e) 
       ((lambda (y z) (* x y z)) (* a b x) (+ c d x)))) 
    3 
    4) 1 7 3 4 5) 
 ;; => 630 
 pass 
  
 (let ([x 3] [y 4]) 
   ((lambda (a b c d e) 
      (let ([y (* a b x)] [z (+ c d x)]) (* x y z))) 1 7 3 4 5)) 
 ;; => 630 
 pass 
  
 (begin 
   (define (square x) (* x x)) 
   (define x 4) 
   (+ (square 2) x x)) 
 ;; => 12 
 pass 
  
 ((lambda (+ * a b x y) (+ (* a x) (* b y))) + * 1 2 3 4) 
 ;; => 11 
 pass 
  
 ((lambda (+ * a b x y) (+ (* a x) (* b y))) * + 1 2 3 4) 
 ;; => 24 
 pass 
  
 (begin 
   ((lambda (+ * a b x y) (+ (* a x) (* b y))) * + 1 2 3 4) 
   (+ 1 3 4 5)) 
 ;; => 13 
 pass 
  
 (begin (set! + 1) +) 
 ;; => 1 
 pass 
  
 (begin 
   (define y 2) 
   (define - y) 
   (define + -) 
   (define (f x) (set! x +) (set! + *) (+ x 3)) 
   (f 2)) 
 ;; => 6 
 pass 
  
 (begin (define (f x) (define + -) 1) (f 2) (+ 1 1)) 
 ;; => 2 
 pass 
  
 (begin (define (f x) (set! + -) 1) (f 2) (+ 1 1)) 
 ;; => 0 
 pass 
  
 (begin (define + -) (+ 1 1)) 
 ;; => 0 
 pass 
  
 (begin 
   (define (factorial n) 
     (define (iter product counter) 
       (if (> counter n) 
           product 
           (iter (* counter product) (+ counter 1)))) 
     (iter 1 1)) 
   (factorial 5)) 
 ;; => 120 
 pass 
  
 (begin (set! + (begin (set! + -) (+ 1 1))) +) 
 ;; => 0 
 pass 
  
 (begin (set! + (begin (+ 1 1))) +) 
 ;; => 2 
 pass 
  
  
 ;;;;;;;;;;;;;;;;;;;;;;;;;; 
 ;;; a special test case: 
 ;;; raises an exception in version 1 
 ;;; works in version 2 
 ;;; You can test it yourself! 
 '(begin 
       (define (f) 
         (define (g) h) 
         (define (h) g) 
         ((h))) 
       (f)) 
 ;;;;;;;;;;;;;;;;;;;; 
 ;;;;;;;;;;;;;;;;;;;;