sicp-ex-5.24

  
  
  
 ev-cond 
 (assign expr (op cond-clauses) (reg expr)) 
 (test (op null?) (reg expr))   
 (branch (label ev-cond-end)) 
 (assign unev (op car) (reg expr)) 
 (assign expr (op cdr) (reg expr)) 
 (test (op cond-else-clauses?) (reg unev)) 
 (branch (label cond-else)) 
 (save env) 
 (save continue) 
 (save unev) 
 (save expr) 
 (assign continue (label ev-cond-loop)) 
 (assign expr (op cond-predicate) (reg unev)) 
 (goto (label ev-dispatch)) 
  
 ev-cond-loop 
 (restore expr) 
 (test (op true?) (reg val)) 
 (branch (label cond-result)) 
 (restore unev) 
 (restore continue) 
 (restore env) 
 (goto (label ev-cond)) 
  
 ; this does not restore continue so it wont return to the caller. 
 ; it also leaves env on the stack which would accumulate with 
 ; each call to a cond. 
 cond-result 
 (restore unev) 
 (assign expr (op cond-actions) (reg unev)) 
 (assign expr (op sequence->exp) (reg expr)) 
 (goto (label ev-dispatch)) 
  
 cond-else 
 (assign unev (op cond-actions) (reg unev)) 
 (assign expr (op sequence->exp) (reg unev)) 
 (goto (label ev-dispatch)) 
  
 ev-cond-end    
 (goto (reg continue)) 
  

  
      ev-cond 
        (save continue)                  ; save continue for ev-sequence 
        (assign unev (op cond-clauses) (reg exp)) 
      ev-cond-loop 
        (test (op null?) (reg unev))     ; no more clauses 
        (branch (label ev-cond-unspec))   
        (asssign exp (op cond-first-clause-predicate) (reg unev)) 
        (test (op cond-else-predicate?) (reg exp)) 
        (branch (label ev-cond-true)) 
        (save unev)                      ; save clauses 
        (save env)                       ; and env to evaluate each clause 
        (assign continue (label ev-cond-decide))  
        (goto (label eval-dispatch))     ; eval first-predicate 
      ev-cond-decide 
        (restore env)                    ; get the env 
        (restore unev)                   ; get the cluases 
        (test (op true?) (reg val))      ; if predicate evluates to true 
        (branch (label ev-cond-true))    ; goto ev-cond-true 
        (assign unev (op cond-rest-cluases) (reg unev)) 
        (goto (label ev-cond-loop)) 
      ev-cond-true                       ; we found a true cluase same as before 
        (assign unev (op cond-first-clause-actions) (reg unev))  
        (goto (label ev-sequence))       ; go to ev-sequence. 
 ; if there was no else, and no true clause 
 ; you could also leave val to be false here.  
 ; But in the implementations I tested 
 ; it was unspecified, or void. 
      ev-cond-unspec 
        (assign val (const 'unspecified)) ; assign val unspecified 
        (restore continue)               ; go directly to caller. 
        (goto (reg continue)) 
  

This is a longer version.

  ev-cond
    (save continue)                               ; save final destination
    (assign exp (op cond-clauses) (reg exp))      ; drop cond label
  ev-cond-have-clause?
    (test (op have-clause?) (reg exp))            ; any clauses?
    (branch (label ev-cond-check-clause))         ;      --> check clause
    (goto (label ev-cond-no-clauses))             ; --> no clauses

  ev-cond-check-clause
    (assign unev (op clauses-first) (reg exp))    ; get first clause
    (test (op cond-else-clause?) (reg unev))      ; else clause?
    (branch (label ev-cond-else))                 ;      --> else
    (save exp)                                    ; save clauses list
    (save unev)                                   ; save clause
    (save env)                                    ; save env
    (assign exp (op cond-predicate) (reg unev))   ; get predicate
    (assign continue (label ev-cond-after-predicate))
    (goto (label eval-dispatch))                  ; --> eval predicate

  ev-cond-after-predicate
    (restore env)                                 ; restore env
    (restore unev)                                ; restore clause
    (restore exp)                                 ; restore clauses list
    (test (op true?) (reg val))                   ; is predicate true?
    (branch (label ev-cond-actions))              ;      --> actions
    (assign exp (op clauses-rest) (reg exp))      ; drop first clause
    (goto (label ev-cond-have-clause?))           ; --> try-again

  ev-cond-else
    (assign val (op clauses-rest) (reg exp))      ; get clauses after else
    (test (op have-clause?) (reg val))            ; any clauses after else?
    (branch (label ev-cond-error-else-not-last))  ;      --> prepare error
  ev-cond-actions
    (assign unev (op cond-actions) (reg unev))    ; store actions for ev-seq
    (goto (label ev-sequence))                    ; --> ev-sequence

  ev-cond-no-clauses
    (restore continue)                            ; restore continue
    (assign exp (const false))                    ; name of false variable
    (goto (label ev-variable))                    ; --> lookup false value

  ev-cond-error-else-not-last
    (restore (reg continue))                      ; restore continue
    (assign val (const else-not-last-clause--COND))
    (goto (label signal-error))                   ; --> raise error


No Match: if there's no match I believe #f should be returned, because:
  1) that is what's returned by the metacirular evaluator,
  2) that is what eceval returns for an if without an alternate clause.

Else Last Error: to match the behaviour of the metacircular evaluator, 
checks if the else clause is the last clause.


Sample
======

  (define (on-dice? n)
    (cond ((< n 1) false)
          (else (< n 7))))

Returns first clause:
---------------------
  (cond
    ((on-dice? 1) "Hello from First Clause")
    ((on-dice? 2) "Hello from Second Clause")
    (else "Hello from Else Clause"))

Output:  eceval DONE - val: Hello from First Clause


Returns other clause:
---------------------
  (cond
    ((on-dice? 9) "Hello from First Clause")
    ((on-dice? 2) "Hello from Second Clause")
    (else "Hello from Else Clause"))

Output:  eceval DONE - val: Hello from Second Clause


Returns else clause:
--------------------
  (cond
    ((on-dice? 0) "Hello from First Clause")
    ((on-dice? 7) "Hello from Second Clause")
    (else "Hello from Else Clause"))))

Output:  eceval DONE - val: Hello from Else Clause


Returns false if no match:
--------------------------
  (cond
    ((on-dice? 0) "Hello from First Clause")
    ((on-dice? 7) "Hello from Second Clause"))

Output:  eceval DONE - val: #f


Error if else is not last clause
--------------------------------
  (cond
    ((on-dice? 0) "Hello from First Clause")
    (else "Hello from Else Clause")
    ((on-dice? 2) "Hello from Third Clause"))

Output:  ERROR: ELSE-clause-isnt-last--COND

  
  
  
  
  
  
   ;;; Exercise 5.24 
 ev-cond 
   (save continue) 
   ;; extract the clauses 
   (assign unev (op cond-clauses) (reg exp)) 
   ;; set default value for cond 
   (assgin val (const '<void>)) 
    
 ev-cond-loop 
   ;; test for empty clauses 
   (test (op empty-clauses?) (reg unev)) 
   (branch (label ev-cond-return)) 
    
   ;; extract the first 
   (assign exp (op first-clause) (reg unev)) 
   (test (op cond-else-clause?) (reg exp)) 
   (branch (label ev-cond-actions)) 
  
   ;; save the first 
   (save exp) 
   ;; save the clauses 
   (save unev) 
   (save env) 
    
   (assign exp (op cond-predicate) (reg exp)) 
   (assign continue (label ev-predicate-decide)) 
   (goto (label eval-dispatch)) 
    
 ev-predicate-decide 
   (restore env) 
   (restore unev) 
   (restore exp) 
  
   (test (op true?) (reg val)) 
   (branch (label ev-cond-actions)) 
  
   (assign unev (op rest-clauses) (reg unev)) 
   (goto (label ev-cond-loop)) 
  
 ev-cond-actions 
   (assign unev (op cond-actions) (reg exp)) 
   ;; (save continue) ignored, since we have saved it before. 
   (goto (label ev-sequence)) 
  
 ev-cond-return 
   (restore continue) 
   (goto (reg continue))