sicp-ex-4.9

woofy

  
  
  
 ; (while <predicate> <body>) 
 ; for example:  
 ; (while (< i 100)  
 ;     (display i)  
 ;     (set! i (+ i 1)))  
  
  
 (define (while? exp) (tagged-list? exp 'while)) 
 (define (while-predicate exp) (cadr exp)) 
 (define (while-body exp) (cddr exp)) 
  
 (define (make-procedure-definition name parameters body) 
     (cons 'define  (cons (cons name parameters) body))) 
 (define (make-procedure-application procedure arguments) 
     (cons procedure arguments)) 
  
  
 (define (while->combination exp) 
  
     (define (while->procedure-def procedure-name) 
         (make-procedure-definition  
             procedure-name 
             '() 
             (make-if 
                 (while-predicate exp) 
                 (sequence->exp 
                     (append (while-body exp) 
                             (make-procedure-application procedure-name '())))))) 
  
     ; wrap the procedure definition in a lambda to contrain its scope 
     (make-procedure-application 
         (make-lambda  
             '() 
             (list (while->procedure-def 'while-procedure) 
                   (make-procedure-application 'while-procedure '()))) 
         '())) 
  
  
 ; the whole thing will look like this: 
 ((lambda () 
     (define (while-procedure) 
         (if (< i 100) 
             (begin 
                 (display i) 
                 (set! (+ i 1) 
                 (while-procedure))))) 
     (while-procedure)))

meteorgan

  
  
 ;; i only implement while. 
 ;; add this to eval 
  ((while? expr) (evaln (while->combination  expr) env)) 
  
 ;; while expression 
 (define (while? expr) (tagged-list? expr 'while)) 
 (define (while-condition expr) (cadr expr)) 
 (define (while-body expr) (caddr expr)) 
 (define (while->combination expr) 
         (sequence->exp 
                 (list (list 'define  
                                 (list 'while-iter) 
                                         (make-if (while-condition expr)  
                                                          (sequence->exp (list (while-body expr)  
                                                                                        (list 'while-iter))) 
                                                          'true)) 
                           (list 'while-iter))))

karthikk

Because while has been implemented by meteorgan as a define expression, with a single name 'while-iter', it can cause serious nameclash issues if there are two while loops in a single procedure!

The alternative is to implement while with a lambda i.e. with a let expression as below (below assumes the let macro has been installed into eval procedure):

 (define (while? exp) (tagged-list? exp 'while)) 
 (define (while-pred exp)(cadr exp)) 
 (define (while-actions exp) (caddr exp)) 
  
 (define (make-single-binding var val)(list (list var val))) 
 (define (make-if-no-alt predicate consequent)(list 'if predicate consequent)) 
 (define (make-combination operator operands) (cons operator operands)) 
  
 (define (while->rec-func exp) 
   (list 'let (make-single-binding 'while-rec '(quote *unassigned*)) 
         (make-assignment 'while-rec 
              (make-lambda '() 
                     (list (make-if-no-alt  
                                 (while-pred exp) 
                                 (make-begin (append (while-actions exp) 
                                                       (list (make-combination 'while-rec '())))))))) 
         (make-combination 'while-rec '())))

djrochford

An alternative, not very clever way of dealing with the scope issue karthikk points out is to have a name to use in the procedure definition as part of the while construct -- i.e., have while syntax be something like this: `(while <name> <predicate> <body>)`. Unusual, but much cleaner.

joew

I was aware of the scope issue so I used the macro name as the define procedure name. Definitely a kludge but it actually works and you can even nest loops this way. My evaluator looks for the "while" tagged list and then I reuse while knowing the programmer can't use while as it's already a language construct.

There might be another way by just evaling each iteration without any defintion and not creating derived expressions, but I didn't bother.

 (define (make-definition label value)(list 'define label value)) 
  
 (define (while->lambda exp) 
   (let ((check (cadr exp)) 
         (body (caddr exp))) 
     (make-begin 
      (list (make-definition 'while 
                             (make-lambda '() 
                                          (list (make-if check 
                                                         (make-begin 
                                                          (list body 
                                                                (list 'while))) 
                                                         "done")))) 
      (list 'while)))))

jotti

Comparing my solution to the other ones here, I can't help but feel I may be missing something, I would be glad to hear if there are any flaws. I've implemented my while in terms of if and by recursively calling while again.

 (define (while? expr) 
   (tagged-list? expr 'while)) 
  
 (define (while-predicate expr) (cadr expr)) 
  
 (define (while-body expr) (caddr expr)) 
  
 (define (eval-while expr env) 
   (let ((pred (while-predicate expr)) 
         (body (while-body expr))) 
     (eval (make-if pred (sequence->exp (list body expr)) "done") env)))

squarebat

I implemented for loop evaluator as a derivation of named-let in previous exercise. It makes a few brave assumptions, like an already existing implementation of make-named-let, but it is simpler to understand

 ;e.g of a for loop 
 (for (i 0) (< i 10) (+ i 1) 
      sequence-of-exps) 
  
 ;e.g of while loop 
 (while (< var 10) sequence) 
  
 ;e.g of do while 
 (do ((exp1) 
      (exp2) 
      (...) 
      (expn)) 
     until (< var 10)) 
  
 ;convert for to the following form 
 (let for ((i 0) 
           (count 10) 
           (body (sequence->exp sequence-of-exps))) 
     (if (< i count) 
         (begin 
           (body) 
           (for (+ i 1) 10 body)))) 
  
 ;evaluator for for loop 
 ;syntax checking has not been implemented for simplicity (totally not because I don't want to) 
 (define (for? exp) (tagged-list? exp 'for)) 
 (define (for-body exp) (cddddr exp)) 
 (define (for-iter exp) (cadr exp)) 
 (define (for-count exp) (caddr (caddr exp))) 
 (define (for-predicate exp) (caddr exp)) 
 (define (for-change-iter exp) (cadddr exp)) 
 (define (for->named-let exp) 
   (make-named-let 'for 
                   (list 
                    (for-iter exp) 
                    (cons 'count (for-count exp)) 
                    (cons 'body (sequence->exp (for-body exp)))) 
                   (make-if (for-predicate exp) 
                            (make-begin '(body) 
                                        '(for (for-change-iter exp) 
                                              count 
                                              body)) 
                            'done)))