summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--main.scm26
1 files changed, 26 insertions, 0 deletions
diff --git a/main.scm b/main.scm
index 59dae1d..8db3289 100644
--- a/main.scm
+++ b/main.scm
@@ -20,6 +20,8 @@
20(define variable? symbol?) 20(define variable? symbol?)
21 21
22;;; if-else 22;;; if-else
23(define (make-if predicate consequent alternative)
24 (list 'if predicate consequent alternative))
23(define (if-else? expr) (tagged? expr 'if)) 25(define (if-else? expr) (tagged? expr 'if))
24(define (if-predicate expr) (cadr expr)) 26(define (if-predicate expr) (cadr expr))
25(define (if-consequent expr) (caddr expr)) 27(define (if-consequent expr) (caddr expr))
@@ -28,6 +30,26 @@
28 (cadddr expr) 30 (cadddr expr)
29 'false)) 31 'false))
30 32
33;;; cond forms
34(define (cond-form? expr) (tagged? expr 'cond))
35(define (cond-clauses expr) (cdr expr))
36(define (cond-predicate clause) (car clause))
37(define (cond-consequent clause) (cadr clause))
38(define (cond-else? clause) (tagged? clause 'else))
39(define (last-clause? clauses) (null? (cdr clauses)))
40(define (make-cond clauses) (cons 'cond clauses))
41(define (cond->if expr)
42 (let ([clauses (cond-clauses expr)])
43 (cond
44 [(cond-else? (car clauses)) (cond-consequent (car clauses))]
45 [(last-clause? clauses) (make-if (cond-predicate (car clauses))
46 (cond-consequent (car clauses))
47 '())]
48 [else (make-if (cond-predicate (car clauses))
49 (cond-consequent (car clauses))
50 (cond->if (make-cond (cdr clauses))))])))
51
52
31;;; function application 53;;; function application
32(define (function-application? expr) (pair? expr)) 54(define (function-application? expr) (pair? expr))
33(define (operator expr) (car expr)) 55(define (operator expr) (car expr))
@@ -47,6 +69,7 @@
47 (cond 69 (cond
48 [(self-evaluating? expr) expr] 70 [(self-evaluating? expr) expr]
49 [(if-else? expr) (eval-if expr env)] 71 [(if-else? expr) (eval-if expr env)]
72 [(cond-form? expr) (eval-cond expr env)]
50 [(quote-form? expr) (quotation-text expr)] 73 [(quote-form? expr) (quotation-text expr)]
51 [(function-application? expr) 74 [(function-application? expr)
52 (apply-expr (operator expr) 75 (apply-expr (operator expr)
@@ -57,6 +80,9 @@
57 (eval-expr (if-consequent expr) env) 80 (eval-expr (if-consequent expr) env)
58 (eval-expr (if-alternative expr) env))) 81 (eval-expr (if-alternative expr) env)))
59 82
83(define (eval-cond expr env)
84 (eval-expr (cond->if expr) env))
85
60(define (primitive? proc) 86(define (primitive? proc)
61 (is-elem-assoc-list proc primitives)) 87 (is-elem-assoc-list proc primitives))
62 88