sicp-ex-4.33



<< Previous exercise (4.32) | Index | Next exercise (4.34) >>


meteorgan

  
  
 ;; '(a b c) is equal to (quote (a b c)). so we should change the code in text-of-quotation like this. 
  
  
 (define prev-eval eval) 
  
 (define (eval expr env) 
     (if (quoted? expr) 
         (text-of-quotation expr env) 
         (prev-eval expr env))) 
  
 (define (quoted? expr) (tagged-list? expr 'quote)) 
  
 (define (text-of-quotation expr env)  
         (let ((text (cadr expr))) 
                 (if (pair? text) 
                         (evaln (make-list text) env) 
                         text))) 
 (define (make-list expr) 
         (if (null? expr) 
                 (list 'quote '()) 
                 (list 'cons 
                           (list 'quote (car expr)) 
                           (make-list (cdr expr))))) 

Felix021

  
  
 ;; this version relies on the implementation of cons/car/cdr. 
 (define (text-of-quotation expr) 
  
     (define (new-list pair) 
         (if (null? pair) 
             '() 
             (make-procedure 
                 '(m) 
                 (list (list 'm 'car-value 'cdr-value)) 
                 (extend-environment 
                     (list 'car-value 'cdr-value) 
                     (list (car pair) (new-list (cdr pair))) 
                     the-empty-environment)))) 
  
     (let ((text (cadr expr))) 
         (if (not (pair? text)) 
             text 
             (new-list text)))) 

atupal

Support nested list:

  
 (define (text-of-quotation-lazy exp) 
   (define (quotation->cons exp) 
     (if (null? exp) 
       ''() 
       (if (pair? exp) 
         (list 'cons (quotation->cons (car exp)) (quotation->cons (cdr exp))) 
         `',exp))) 
   (let ((env (cons (make-frame '() '()) '()))) 
     (eval '(define (cons x y) (lambda (m) (m x y))) env) 
     (eval '(define (car z) (z (lambda (p q) p))) env) 
     (eval '(define (cdr z) (z (lambda (p q) q))) env) 
     (let ((text (cadr exp))) 
       (if (pair? text) 
         (eval (quotation->cons text) env) 
         text)))) 
 ; if do so, all of the cons will be the lazy one even if they have been defined already 
 (define text-of-quotation text-of-quotation-lazy) 
  
 ;(car '(a b c)) 
 ; output: 'a 
 ; 
 ;(car (car '((a b) (c (d e))))) 
 ; output: a 
 ; 
 ;'() 
 ; output: ()