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: () 
  

revc

  
  
  
  
  
 ;;; Exercise 4.33 
  
  
 ;;; redefined text-of-quotation will transform the exp into its corresponding  
 ;;; expression of meta-circular evaluator, such as '(cons <quotation> (cons   
 ;;; <quotation> (cons ...))) or '<quotation>, and then evaluate that expression. 
 ;;; 
 (define (text-of-quotation exp) 
   (if (pair? (cadr exp)) 
       (eval (text->lazy-conses-exp (cadr exp)) the-global-environment) 
       (cadr exp))) 
  
 (define (text->lazy-conses-exp exp) 
   (cond [(pair? exp) 
          `(cons ,(text->lazy-conses-exp (car exp)) ,(text->lazy-conses-exp (cdr exp)))] 
         [else (list 'quote exp)])) 
  
  
 ;;; add desired procedure to the-global-environment 
 (eval '(define (cons x y) 
          (lambda (m) (m x y))) the-global-environment) 
  
 (eval '(define (car z) 
          (z (lambda (p q) p))) the-global-environment) 
  
 (eval '(define (cdr z) 
          (z (lambda (p q) q))) the-global-environment) 
  
  
 (eval '(define (list-ref items n) 
          (if (= n 0) 
              (car items) 
              (list-ref (cdr items) (- n 1)))) the-global-environment) 
  
 (eval '(define (map proc items) 
          (if (null? items) 
              '() 
              (cons (proc (car items)) 
                    (map proc (cdr items))))) the-global-environment) 
  
 (eval '(define (scale-list items factor) 
          (map (lambda (x) (* x factor)) 
               items)) the-global-environment) 
  
 (eval '(define (add-lists list1 list2) 
          (cond ((null? list1) list2) 
                ((null? list2) list1) 
                (else (cons (+ (car list1) (car list2)) 
                            (add-lists (cdr list1) (cdr list2)))))) the-global-environment)