<< Previous exercise (4.8) | Index | Next exercise (4.10) >>


 ; (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) 
                 (while-predicate exp) 
                     (append (while-body exp) 
                             (make-procedure-application procedure-name '())))))) 
     ; wrap the procedure definition in a lambda to contrain its scope 
             (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) 
                 (display i) 
                 (set! (+ i 1) 


 ;; 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) 
                 (list (list 'define  
                                 (list 'while-iter) 
                                         (make-if (while-condition expr)  
                                                          (sequence->exp (list (while-body expr)  
                                                                                        (list 'while-iter))) 
                           (list 'while-iter)))) 


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


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.


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))) 
      (list (make-definition 'while 
                             (make-lambda '() 
                                          (list (make-if check 
                                                          (list body 
                                                                (list 'while))) 
      (list 'while))))) 


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


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) 
 ;e.g of while loop 
 (while (< var 10) sequence) 
 ;e.g of do while 
 (do ((exp1) 
     until (< var 10)) 
 ;convert for to the following form 
 (let for ((i 0) 
           (count 10) 
           (body (sequence->exp sequence-of-exps))) 
     (if (< i count) 
           (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 
                    (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) 


Added syntax for python's list comprehensions, pretty simple tbh as it's very similar to map, so i might do one for while too.

Scheme list comprehension : ((* i i) for i in (list 1 2 3 4 5))

Python list comprehension : [i * i for i in [1, 2, 3, 4, 5]]

 (define (list-comp? exp) (and (pair? exp) (eq? (cadr exp) 'for))) 
 (define (list-comp-exp exp) (car exp)) 
 (define (list-comp-var exp) (caddr exp)) 
 (define (list-comp-iterable exp) (car (cddddr exp))) 
 (define (eval-list-comp exp env) 
   (define (iter iterable) 
     (if (eq? iterable '()) 
          (eval (list 
                  (list (list-comp-var exp)) 
                  (list (list-comp-exp exp))) 
                 (car iterable)) env) 
          (iter (cdr iterable))))) 
   (iter (eval (list-comp-iterable exp) env))) 
 (define list-comprehension-test 
   '((* i i) for i in (list 1 2 3 4 5))) 
 (eval list-comprehension-test test-env)  ;; (1 4 9 16 25) 


I accidentally did this one out of order with 4.08, so I had to come up with another way to make an anonymous recursive procedure. I also leveraged "quasiquoting," which I learned about out of turn, to make my solution very small. For those unfamiliar, backtick is like quote except you can escape from it with comma.

 (define (make-while test body) (list 'while test body)) 
 (define (while? exp) (tagged-list? exp 'while)) 
 (define (while-test exp) (cadr exp)) 
 (define (while-body exp) (caddr exp)) 
 (define (expand-while exp) 
   `(let ((iter (lambda (next)  
                        (if ,(while-test exp) (begin ,(while-body exp) (next next)))))) 
      (iter iter))) 


 ;; doseq from clojure, implemented in terms of named let from exercise 4.8 
 (define (doseq? exp) (tagged-list? exp 'doseq)) 
 (define (doseq->let exp) 
   (list 'let 'doseq (list (cadr exp)) 
         (list 'if (list 'pair? (car (bindings->params (list (cadr exp))))) 
               (sequence->exp (list 
                                (make-lambda (bindings->params (list (cadr exp))) 
                                             (list (let-body exp))) 
                                (list 'car (car (bindings->params (list (cadr exp)))))) 
                               (list 'doseq (list 'cdr (car (bindings->params (list (cadr exp))))))))))) 
 ; (let->combination (doseq->let '(doseq (x '(1 2 3 4 5)) (display x))))