sicp-ex-4.9



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


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

Unless I'm mistaken, this can behave incorrectly if the evaluation environment already has an expression with the name while-procedure. Whether or not that's likely to happen, and whether or not it's easy to work around, it's probably not a good thing to let the implementation details of the evaluator leak in such a way.



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

How do you make your evaluator interpret this correctly? It seems to me that if the evaluator checks for while statements before it tries to interpret expressions as procedure applications, it will always interpret these inner occurrences of while as actual while statements, despite the new definition.



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

This solution might "do the right thing," but I don't think it qualifies as a derived expression.


I currently think this is the best solution on this page, despite/because of not being derived. Every other definition of while, as far as I can tell, introduces a let or define which risks name collision if the body of the while happens to refer to variables with the same name (i.e. the same problem @ce mentioned in response to @woofy).

The ways I can see around this issue are:

  1. Reserve additional keywords such as while-rec in the definition of the programming language;
  2. Implement special syntax for while as done here;
  3. Make the programmer specify a name for while loops (@djrochford's suggestion);
  4. Make the interpreter scan the code for all variable names before translating derived expressions, and guarantee that new variable names introduced in the translation of derived expressions are distinct from any used by the programmer.

Are there other alternatives?



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

x3v

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 '()) 
         '() 
         (cons 
          (eval (list 
                 (make-lambda 
                  (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) 

closeparen

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

krubar

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

haha

make pressions to evaluate in a same environment, no other binds

  
 (define (while->combination exp) 
   (let ((predicate-exp (while-predicate exp)) 
         (body-exps (while-body exp))) 
     (make-application 
      (make-lambda (list 'pred-proc 'body-proc) 
                   (list 
                    (make-define '(f) 
                                 (list 
                                  (make-if (make-application 'pred-proc 
                                                                  nil) 
                                                (make-begin (list 
                                                             (make-application 'body-proc 
                                                                               nil) 
                                                             (make-application 'f nil))) 
                                                ''done))) 
                    (make-application 'f nil))) 
      (list (make-lambda '() 
                         (list predicate-exp)) 
            (make-lambda '() 
                         body-exps))))) 
 ;; 
 print: (while->combination '(while (< n 10) (set! n (+ n 1)))) 
  
 ((lambda (pred-proc body-proc) (define (f) (if (pred-proc) (begin (body-proc) (f)) 'done)) (f)) 
  (lambda () (< n 10)) 
  (lambda () (set! n (+ n 1))))