]> git.rkrishnan.org Git - sicp.git/blob - src/sicp/ex4_4.rkt
Solution to 4.44. A bit too verbose. Can be improved by better
[sicp.git] / src / sicp / ex4_4.rkt
1 #lang racket
2
3 (define (tagged-list? exp tag)
4   (if (pair? exp)
5       (eq? (car exp) tag)
6       #f))
7
8 (define (make-if predicate consequent alternative)
9   (list 'if predicate consequent alternative))
10
11 ;; and
12 (define (and? expr) (tagged-list? expr 'and))
13 (define (eval-and expr env) (eval-and-predicates (cdr expr) env))
14
15 (define (eval-and-predicates expr env)
16   (cond ((null? expr) #t)
17         ((eval (car expr) env) (eval-and-predicates (cdr expr) env))
18         (else #f)))
19
20 ;; or
21 (define (or? expr) (tagged-list? expr 'or))
22 (define (eval-or expr env) (eval-or-predicates (cdr expr) env))
23
24 (define (eval-or-predicates expr env)
25   (cond ((null? expr) #f)
26         ((eval (car expr) env) #t)
27         (else (eval-or-predicates (cdr expr) env))))
28
29 ;; derived expressions
30 (define (and->if expr)
31   (expand-and-predicates (cdr expr)))
32
33 (define (expand-and-predicates expr)
34   (cond ((null? expr) '#t)
35         (else (make-if (car expr)
36                        (expand-and-predicates (cdr expr))
37                        '#f))))
38
39 (define (or->if expr)
40   (expand-or-predicates expr))
41
42 (define (expand-or-predicates expr)
43   (cond ((null? expr) '#f)
44         (else (make-if (car expr)
45                        '#t
46                        (expand-or-predicates (cdr expr))))))