blob: 8db3289f638652678a7145b7f92c14103316ee03 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
|
(add-to-load-path ".")
(add-to-load-path "util/")
(add-to-load-path "prelude/")
(use-modules (environment))
(use-modules (prelude/primitives))
(use-modules (util/alist))
(define (tagged? expr tag)
(if (pair? expr)
(eq? (car expr) tag)
#f))
;;; self-evaluating
(define (self-evaluating? expr)
(or (number? expr)
(string? expr)
(bool? expr)))
(define variable? symbol?)
;;; if-else
(define (make-if predicate consequent alternative)
(list 'if predicate consequent alternative))
(define (if-else? expr) (tagged? expr 'if))
(define (if-predicate expr) (cadr expr))
(define (if-consequent expr) (caddr expr))
(define (if-alternative expr)
(if (not (null? (cdddr expr)))
(cadddr expr)
'false))
;;; cond forms
(define (cond-form? expr) (tagged? expr 'cond))
(define (cond-clauses expr) (cdr expr))
(define (cond-predicate clause) (car clause))
(define (cond-consequent clause) (cadr clause))
(define (cond-else? clause) (tagged? clause 'else))
(define (last-clause? clauses) (null? (cdr clauses)))
(define (make-cond clauses) (cons 'cond clauses))
(define (cond->if expr)
(let ([clauses (cond-clauses expr)])
(cond
[(cond-else? (car clauses)) (cond-consequent (car clauses))]
[(last-clause? clauses) (make-if (cond-predicate (car clauses))
(cond-consequent (car clauses))
'())]
[else (make-if (cond-predicate (car clauses))
(cond-consequent (car clauses))
(cond->if (make-cond (cdr clauses))))])))
;;; function application
(define (function-application? expr) (pair? expr))
(define (operator expr) (car expr))
(define (operands expr) (cdr expr))
(define (no-operands? expr) (null? expr))
(define (list-of-values ls env)
(map (lambda (l) (eval-expr l env)) ls))
;;; quoted expressions
(define (quote-form? expr) (tagged? expr 'quote))
(define (quotation-text expr) (cadr expr))
;;; assignment
(define (assignment? expr) (tagged? expr 'set!))
(define (eval-expr expr env)
(cond
[(self-evaluating? expr) expr]
[(if-else? expr) (eval-if expr env)]
[(cond-form? expr) (eval-cond expr env)]
[(quote-form? expr) (quotation-text expr)]
[(function-application? expr)
(apply-expr (operator expr)
(list-of-values (operands expr) env))]))
(define (eval-if expr env)
(if (true? (eval-expr (if-predicate expr) env))
(eval-expr (if-consequent expr) env)
(eval-expr (if-alternative expr) env)))
(define (eval-cond expr env)
(eval-expr (cond->if expr) env))
(define (primitive? proc)
(is-elem-assoc-list proc primitives))
(define (apply-primitive-proc proc args)
(let ([p (lookup-assoc-list proc primitives)])
(apply p args)))
(define (apply-expr proc args)
(cond
[(primitive? proc) (apply-primitive-proc proc args)]
[else 'false]))
(define the-global-env (setup-environment))
(define input-prompt ";;; CIRCLE INPUT ")
(define output-prompt ";;; CIRCLE OUTPUT ")
(define (driver-loop)
(begin
(newline)
(display input-prompt)
(newline)
(let ([input (read)])
(let ([output (eval-expr input the-global-env)])
(begin
(display output-prompt)
(newline)
(show-lisp-expr output)
(newline)
(driver-loop))))))
(define (show-lisp-expr object)
(display object))
|
