exercise-4.scm (2356B)
1 (define-library (sicp solutions chapter-4 exercise-4) 2 (import (schemb base) 3 (ice-9 match)) 4 5 (begin 6 (define (eval exp env) 7 (cond ((self-evaluating? exp) exp) 8 ((variable? exp) (lookup-variable-value exp env)) 9 ((quoted? exp) (text-of-quotation exp)) 10 ((assignment? exp) (eval-assignment exp env)) 11 ((definition? exp) (eval-definition exp env)) 12 ((if? exp) (eval-if exp env)) 13 ((lambda? exp) 14 (make-procedure (lambda-parameters exp) 15 (lambda-body exp) 16 env)) 17 ((begin? exp) 18 (eval-sequence (begin-actions exp) env)) 19 ((cond? exp) (eval (cond->if exp) env)) 20 ((and? exp) (eval-and (cdr exp) env)) 21 ((or? exp) (eval-or (cdr exp) env)) 22 ((application? exp) 23 (apply (eval (operator exp) env) 24 (list-of-values (operands exp) env))) 25 (else 26 (error "Unknown expression type -- EVAL" exp)))) 27 28 (define (and? exp) (tagged-list? exp 'and)) 29 (define (or? exp) (tagged-list? exp 'or)) 30 31 (define (eval-and exp env) 32 (match exp 33 ((and) 34 'true) 35 ((and ,head ,rest ...) 36 (let ((head-value (eval rest env))) 37 (if (eqv? head-value 'true) 38 head-value 39 (eval-and rest env)))))) 40 41 (define (eval-or exp env) 42 (match exp 43 ((or) 44 'false) 45 ((or ,head ,rest ...) 46 (let ((head-value (eval rest env))) 47 (if (eqv? head-value 'true) 48 (eval-or rest env) 49 'false))))) 50 51 (define (eval-and-2 exp env) 52 (eval 53 `(if (null? ,exp) 54 'true 55 ((lambda (car-value) 56 (if (true? car-value) 57 (if (null? ,(cdr exp)) 58 car-value 59 (and ,(cdr exp))) 60 'false)) 61 ,(car exp))) 62 env)) 63 64 (define (eval-or-2 exp env) 65 (eval 66 `(if (null? ,exp) 67 'false 68 ((lambda (car-value) 69 (if (true? car-value) 70 car-value 71 (if (null? ,(cdr exp)) 72 'false 73 (or ,(cdr exp))))) 74 ,(car exp))) 75 env))))