<< Previous exercise (4.3) | Index | Next exercise (4.5) >>
a.
;; procedures to extract the parts of the expressions (define (and-clauses exp) (cdr exp)) (define (or-clauses exp) (cdr exp)) (define (first-exp seq) (car seq)) (define (rest-exp seq) (cdr seq)) (define (empty-exp? seq) (null? seq)) (define (last-exp? seq) (null? (cdr seq))) ;; (and (list? '()) (number? 2) 3) => 3 (define (eval-and exps env) (cond ((empty-exp? exps) #t) (else (let ((first (eval (first-expt exps) env))) (cond ((last-exp? exps) first) (first (eval-and (rest-exp exps) env)) (else #f)))))) (define (eval-or exps env) (cond ((empty-exp? exps) #f) (else (let ((first (eval (first-exp exps) env))) (cond ((last-exp? exps) first) (first #t) (else (eval-or (rest-exp exps) env)))))))
b.
;; (and (list? '()) (number? 2) 3) ;; derived into "if" ;; (if (list? '()) ;; (if (number? 2) ;; 3 ;; #f) ;; #f) (define (and->if exp) (expand-and-clauses (and-clauses exp))) (define (expand-and-clauses clauses) (cond ((empty-exp? clauses) 'false) ((last-exp? clauses) (first-exp clauses)) (else (make-if (first-exp clauses) (expand-and-clauses (rest-exp clauses)) #f)))) (define (or->if exp) (expand-or-clauses (or-clauses exp))) (define (expand-or-clauses clauses) (cond ((empty-exp? clauses) 'false) ((last-exp? clauses) (first-exp clauses)) (else (make-if (first-exp clauses) #t (expand-or-clauses (rest-exp clauses))))))
(define (and? exp) (tagged-list? exp 'and)) (define (and-expressions exp) (cadr exp)) (define (first-expression exps) (car exps)) (define (rest-expressions exps) (cdr exps)) (define (and-eval-exps exps env) (cond ((null? exps) 'true) ((null? (rest-expressions exps)) (eval (first-expression exps) env)) ((true? (eval (first-expression exps) env)) (and-eval-exps (rest-expressions exps) env)) (else 'false))) (and-eval-exps (and-expressions exp) env) (define (or? exp) (tagged-list? exp 'or)) (define (or-expressions exp) (cadr exp)) (define (or-eval-exps exps env) (cond ((null? exps) 'false) ((true? (eval (first-expression exps) env)) 'true) (else (or-eval-exps (rest-expressions exps) env)))) (or-eval-exps (or-expressions exp) env)
Sticking to the book's use of 'false and 'true rather than explicitly assigning it as a boolean.
(define (and? exp) (tagged-list? exp 'and)) (define (or? exp) (tagged-list? exp 'or)) (define (eval-and exp env) (cond ((no-operands? exp) true) ((eq? false (eval (first-operand exp) env)) false) (else (eval-and (rest-operands exp) env)))) (define (eval-or exp env) (cond ((no-operands? exp) false) ((eq? (eval (first-operand exp) env) true) true) (else (eval-or (rest-operands exp) env))))
For the "and" part, some of the answers above don't return the value of the last expression if all expressions evaluate to true. For example, evaluating (and 1 2) should return 2. Similar case for "or". Test cases are provided below.
Note: In scheme, only "the explicit false" object will be evaluated to false, everything else evaluates to true. See Ch 4.1.3.
;; helper functions to make my life easier (define (true? x) (not (eq? x false))) (define (false? x) (eq? x false)) (define false #f) (define test-env user-initial-environment) (define (and? exp) (tagged-list exp 'and)) (define (and-preds exp) (cdr exp)) (define (first-pred pred-seq) (car pred-seq)) (define (rest-preds pred-seq) (cdr pred-seq)) (define (no-preds? pred-seq) (eq? pred-seq '())) (define (eval-and-preds pred-seq env) (let ((val (eval (first-pred pred-seq) env))) (cond ((no-preds? (rest-preds pred-seq)) val) ((not (true? val)) 'false) (else (eval-and-preds (rest-preds pred-seq) env))))) (define (eval-and exp env) (let ((pred-seq (and-preds exp))) (if (no-preds? pred-seq) 'true (eval-and-preds pred-seq env)))) ;; test and (eval-and '(and 1 2) user-initial-environment) ;; 2 (eval-and '(and false 2) user-initial-environment) ;; false (define (or? exp) (tagged-list exp 'or)) (define (or-preds exp) (cdr exp)) (define (eval-or-preds pred-seq env) (let ((val (eval (first-pred pred-seq) env))) (cond ((no-preds? (rest-preds pred-seq)) val) ((true? val) val) (else (eval-or-preds (rest-preds pred-seq) env))))) (define (eval-or exp env) (let ((pred-seq (or-preds exp))) (if (no-preds? pred-seq) 'false (eval-or-preds pred-seq env)))) ;; test or (eval-or '(or 1 2) user-initial-environment) ;; 1 (eval-or '(or false 2) user-initial-environment) ;; 2 (eval-or '(or false false) user-initial-environment) ;; #f
;; as derived expressions (define (eval-and exp env) (eval (and->if exp) env)) (define (eval-or exp env) (eval (or->if exp) env)) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (and->if exp) (expand-and (cdr exp))) (define (expand-and terms) (if (null? terms) #t (let ((first (car terms)) (rest (cdr terms))) (if (null? rest) (make-if first first #f) (make-if first (expand-and rest) #f))))) (define (or->if exp) (expand-or (cdr exp))) (define (expand-or terms) (if (null? terms) #f (let ((first (car terms)) (rest (cdr terms))) (make-if first first (expand-or rest))))) (define env (null-environment 5)) (eval-or '(or #f 2) env) ;; -> 2 (eval-or '(or #f) env) ;; -> #f (eval-or '(or) env) ;; -> #f (eval-and '(and 1 2) env) ;; -> 2 (eval-and '(and #f 2) env) ;; -> #f (eval-and '(and) env) ;; -> #t
For the derived or-expression, woofy's solution doesn't return the actual value and krubar's solution evaluates the true value twice, which is incorrect for a language with assignment.
Since we cannot explicitly evaluate the expression inside our local language's let-expression, as it makes each expression to be evaluated during expansion, we need to emulate it with the provided application and lambda abstractions:
(define (or->if exp) (expand-or (or-exps exp))) (define (expand-or exps) (cond ((null? exps) 'false) ((last-exp? exps) (first-exp exps)) (else (make-application (make-lambda '(e) (make-if 'e 'e (expand-or (rest-exps exps)))) (first-exp (car exps))))))
woofy