-
Notifications
You must be signed in to change notification settings - Fork 3
/
core.clj
226 lines (195 loc) · 6.17 KB
/
core.clj
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
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
;;; Implementation of Lisp 1.5 in Clojure, as formally
;;; defined in p. 13 of "LISP 1.5 Programmer's Manual"
;;; by John McCarthy.
;;;
;;; Copyright (C) 2017 by Ariel Ortiz,
;;; Tecnologico de Monterrey, CEM.
;;;
;;; This program is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(ns lisp-one-point-five.core)
(declare $apply $eval $evcon $evlis)
(def $T
"Synonym for true."
true)
(def $F
"Synonym for false."
false)
(def $NIL
"Synonym for the empty (null) list."
())
(defmacro $cond
"Conditional expression of the form:
($cond
(p1 e1)
(p2 e2)
...
(pn en))
where each pi is an expression whose value may be truth
or falsity, and each ei is any expression. The meaning
of a conditional expression is: if p1 is true, then the
value of e1 is the value of the entire expression. If
p1 is false, then if p2 is true the value of e2 is
the value of the entire expression. The pi are searched
from left to right until the first true one is found.
Then the corresponding ei is selected. If none of the
pi are true, then the value of the entire expression
is undefined."
([[pred exp]]
`(if ~pred ~exp))
([[pred exp] & clauses]
`(if ~pred ~exp ($cond ~@clauses))))
(defn $cons
"Obtains a new word from the free storage list and places
its two arguments in the address and decrement of this word,
respectively."
[a b]
($cond
((seq? b) (cons a b))
($T (list a b))))
(defn $atom
"Returns true if its argument is an atomic symbol, and
false if its argument is composite. The empty list is
considered atomic."
[x]
($cond
((symbol? x) $T)
((and (seq? x) (empty? x)) $T)
($T $F)))
(defn $eq
"Returns true if both arguments are the same atomic
symbol, otherwise returns false. It is undefined for
non-atomic arguments."
[a b]
($cond
((and ($atom a) ($atom b))
(= a b))))
(def $car
"Returns the first part of its composite argument. The
car of an atomic symbol is undefined."
first)
(def $cdr
"Returns the second part (rest) of its composite
argument. The cdr of an atomic symbol is undefined."
rest)
(def $caar
"Equivalent to: ($car ($car x))."
(comp $car $car))
(def $cadr
"Equivalent to: ($car ($cdr x))."
(comp $car $cdr))
(def $cdar
"Equivalent to: ($cdr ($car x))."
(comp $cdr $car))
(def $caddr
"Equivalent to: ($car ($cdr ($cdr x)))."
(comp $car $cdr $cdr))
(def $cadar
"Equivalent to: ($car ($cdr ($car x)))."
(comp $car $cdr $car))
(def $null
"Returns true if its argument is an empty list, or false
otherwise."
empty?)
(defn $pairlis
"This function gives the list of pairs of corresponding
elements of the lists x and y, and appends this to the
list a."
[x y a]
($cond
(($null x) a)
($T ($cons
; Lisp 1.5 divergence: original creates dotted pair.
($cons ($car x) ($cons ($car y) $NIL))
($pairlis ($cdr x) ($cdr y) a)))))
(defn $assoc
"If a is an association list such as the one formed by
$pairlis, then $assoc will produce the first pair
whose first term is x. Thus it is a table searching
function."
[x a]
($cond
; Lisp 1.5 divergence: original uses equal instead of eq.
(($eq ($caar a) x) ($car a))
($T ($assoc x ($cdr a)))))
(defn $evalquote
"A universal Lisp function. When evalquote is given a
function fun and a list of arguments x for that
function, it computes the value of the function applied
to the arguments."
[fun x]
($apply fun x $NIL))
(defn $apply
"Handles a function fun and its arguments in the list x.
The argument a is used as an association list for
storing the values of bound variables and function
names."
[fun x a]
($cond
(($atom fun)
($cond
(($eq fun 'CAR) ($caar x))
(($eq fun 'CDR) ($cdar x))
(($eq fun 'CONS) ($cons ($car x) ($cadr x)))
(($eq fun 'ATOM) ($atom ($car x)))
(($eq fun 'EQ) ($eq ($car x) ($cadr x)))
($T ($apply ($eval fun a) x a))))
(($eq ($car fun) 'LAMBDA)
($eval ($caddr fun) ($pairlis ($cadr fun) x a)))
(($eq ($car fun) 'LABEL)
($apply
($caddr fun)
x
($cons ($cons
($cadr fun)
; Lisp 1.5 divergence: original creates dotted pair.
($cons ($caddr fun) $NIL))
a)))))
(defn $eval
"Handles the forms in e. The argument a is used as an
association list for storing the values of bound
variables and function names."
[e a]
($cond
(($atom e)
; Lisp 1.5 divergence: original uses cdr on dotted pair.
($cadr ($assoc e a)))
(($atom ($car e))
($cond
(($eq ($car e) 'QUOTE) ($cadr e))
(($eq ($car e) 'COND) ($evcon ($cdr e) a))
($T ($apply ($car e)
($evlis ($cdr e) a)
a))))
($T
($apply ($car e)
($evlis ($cdr e) a)
a))))
(defn $evcon
"Evaluates the propositional terms in order, and chooses
the form following the first true predicate. The argument
a is used as an association list for storing the values
of bound variables and function names."
[c a]
($cond
(($eval ($caar c) a) ($eval ($cadar c) a))
($T ($evcon ($cdr c) a))))
(defn $evlis
"Evaluate all expressions in list m. The argument a is
used as an association list for storing the values of
bound variables and function names."
[m a]
($cond
(($null m) $NIL)
($T ($cons ($eval ($car m) a)
($evlis ($cdr m) a)))))