Commit | Line | Data |
---|---|---|
8295b7c4 BT |
1 | ;;; Guile Emacs Lisp |
2 | ||
3 | ;;; Copyright (C) 2009 Free Software Foundation, Inc. | |
4 | ;;; | |
5 | ;;; This library is free software; you can redistribute it and/or modify | |
6 | ;;; it under the terms of the GNU Lesser General Public License as | |
7 | ;;; published by the Free Software Foundation; either version 3 of the | |
8 | ;;; License, or (at your option) any later version. | |
9 | ;;; | |
10 | ;;; This library is distributed in the hope that it will be useful, but | |
11 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
12 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
13 | ;;; Lesser General Public License for more details. | |
14 | ;;; | |
15 | ;;; You should have received a copy of the GNU Lesser General Public | |
16 | ;;; License along with this library; if not, write to the Free Software | |
17 | ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA | |
18 | ;;; 02110-1301 USA | |
19 | ||
20 | ;;; Code: | |
21 | ||
22 | (define-module (language elisp runtime subrs) | |
23 | #:use-module (language elisp runtime) | |
24 | #:use-module (system base compile)) | |
25 | ||
26 | ;;; This module contains the function-slots of elisp symbols. Elisp | |
27 | ;;; built-in functions are implemented as predefined function bindings | |
28 | ;;; here. | |
29 | ||
30 | ;;; Equivalence and equalness predicates. | |
31 | ||
32 | (built-in-func eq | |
33 | (lambda (a b) | |
34 | (elisp-bool (eq? a b)))) | |
35 | ||
36 | (built-in-func equal | |
37 | (lambda (a b) | |
38 | (elisp-bool (equal? a b)))) | |
39 | ||
40 | ;;; Number predicates. | |
41 | ||
42 | (built-in-func floatp | |
43 | (lambda (num) | |
44 | (elisp-bool (and (real? num) | |
45 | (or (inexact? num) | |
46 | (prim not (integer? num))))))) | |
47 | ||
48 | (built-in-func integerp | |
49 | (lambda (num) | |
50 | (elisp-bool (and (exact? num) | |
51 | (integer? num))))) | |
52 | ||
53 | (built-in-func numberp | |
54 | (lambda (num) | |
55 | (elisp-bool (real? num)))) | |
56 | ||
57 | (built-in-func wholenump | |
58 | (lambda (num) | |
59 | (elisp-bool (and (exact? num) | |
60 | (integer? num) | |
61 | (prim >= num 0))))) | |
62 | ||
63 | (built-in-func zerop | |
64 | (lambda (num) | |
65 | (elisp-bool (prim = num 0)))) | |
66 | ||
67 | ;;; Number comparisons. | |
68 | ||
69 | (built-in-func = | |
70 | (lambda (num1 num2) | |
71 | (elisp-bool (prim = num1 num2)))) | |
72 | ||
73 | (built-in-func /= | |
74 | (lambda (num1 num2) | |
75 | (elisp-bool (prim not (prim = num1 num2))))) | |
76 | ||
77 | (built-in-func < | |
78 | (lambda (num1 num2) | |
79 | (elisp-bool (prim < num1 num2)))) | |
80 | ||
81 | (built-in-func <= | |
82 | (lambda (num1 num2) | |
83 | (elisp-bool (prim <= num1 num2)))) | |
84 | ||
85 | (built-in-func > | |
86 | (lambda (num1 num2) | |
87 | (elisp-bool (prim > num1 num2)))) | |
88 | ||
89 | (built-in-func >= | |
90 | (lambda (num1 num2) | |
91 | (elisp-bool (prim >= num1 num2)))) | |
92 | ||
93 | (built-in-func max | |
94 | (lambda (. nums) | |
95 | (prim apply (@ (guile) max) nums))) | |
96 | ||
97 | (built-in-func min | |
98 | (lambda (. nums) | |
99 | (prim apply (@ (guile) min) nums))) | |
100 | ||
101 | (built-in-func abs | |
102 | (@ (guile) abs)) | |
103 | ||
104 | ;;; Number conversion. | |
105 | ||
106 | (built-in-func float | |
107 | (lambda (num) | |
108 | (if (exact? num) | |
109 | (exact->inexact num) | |
110 | num))) | |
111 | ||
112 | ;;; TODO: truncate, floor, ceiling, round. | |
113 | ||
114 | ;;; Arithmetic functions. | |
115 | ||
116 | (built-in-func 1+ (@ (guile) 1+)) | |
117 | ||
118 | (built-in-func 1- (@ (guile) 1-)) | |
119 | ||
120 | (built-in-func + (@ (guile) +)) | |
121 | ||
122 | (built-in-func - (@ (guile) -)) | |
123 | ||
124 | (built-in-func * (@ (guile) *)) | |
125 | ||
126 | (built-in-func % (@ (guile) modulo)) | |
127 | ||
128 | ;;; TODO: / with correct integer/real behaviour, mod (for floating-piont | |
129 | ;;; values). | |
130 | ||
131 | ;;; Floating-point rounding operations. | |
132 | ||
133 | (built-in-func ffloor (@ (guile) floor)) | |
134 | ||
135 | (built-in-func fceiling (@ (guile) ceiling)) | |
136 | ||
137 | (built-in-func ftruncate (@ (guile) truncate)) | |
138 | ||
139 | (built-in-func fround (@ (guile) round)) | |
140 | ||
141 | ;;; List predicates. | |
142 | ||
143 | (built-in-func consp | |
144 | (lambda (el) | |
145 | (elisp-bool (pair? el)))) | |
146 | ||
147 | (built-in-func atomp | |
148 | (lambda (el) | |
149 | (elisp-bool (prim not (pair? el))))) | |
150 | ||
151 | (built-in-func listp | |
152 | (lambda (el) | |
153 | (elisp-bool (or (pair? el) (null? el))))) | |
154 | ||
155 | (built-in-func nlistp | |
156 | (lambda (el) | |
157 | (elisp-bool (and (prim not (pair? el)) | |
158 | (prim not (null? el)))))) | |
159 | ||
160 | (built-in-func null | |
161 | (lambda (el) | |
162 | (elisp-bool (null? el)))) | |
163 | ||
164 | ;;; Accessing list elements. | |
165 | ||
166 | (built-in-func car | |
167 | (lambda (el) | |
168 | (if (null? el) | |
169 | nil-value | |
170 | (prim car el)))) | |
171 | ||
172 | (built-in-func cdr | |
173 | (lambda (el) | |
174 | (if (null? el) | |
175 | nil-value | |
176 | (prim cdr el)))) | |
177 | ||
178 | (built-in-func car-safe | |
179 | (lambda (el) | |
180 | (if (pair? el) | |
181 | (prim car el) | |
182 | nil-value))) | |
183 | ||
184 | (built-in-func cdr-safe | |
185 | (lambda (el) | |
186 | (if (pair? el) | |
187 | (prim cdr el) | |
188 | nil-value))) | |
189 | ||
190 | (built-in-func nth | |
191 | (lambda (n lst) | |
192 | (if (negative? n) | |
193 | (prim car lst) | |
194 | (let iterate ((i n) | |
195 | (tail lst)) | |
196 | (cond | |
197 | ((null? tail) nil-value) | |
198 | ((zero? i) (prim car tail)) | |
199 | (else (iterate (prim 1- i) (prim cdr tail)))))))) | |
200 | ||
201 | (built-in-func nthcdr | |
202 | (lambda (n lst) | |
203 | (if (negative? n) | |
204 | lst | |
205 | (let iterate ((i n) | |
206 | (tail lst)) | |
207 | (cond | |
208 | ((null? tail) nil-value) | |
209 | ((zero? i) tail) | |
210 | (else (iterate (prim 1- i) (prim cdr tail)))))))) | |
211 | ||
212 | (built-in-func length (@ (guile) length)) | |
213 | ||
214 | ;;; Building lists. | |
215 | ||
216 | (built-in-func cons (@ (guile) cons)) | |
217 | ||
218 | (built-in-func list (@ (guile) list)) | |
219 | ||
220 | (built-in-func make-list | |
221 | (lambda (len obj) | |
222 | (prim make-list len obj))) | |
223 | ||
224 | (built-in-func append (@ (guile) append)) | |
225 | ||
226 | (built-in-func reverse (@ (guile) reverse)) | |
227 | ||
228 | (built-in-func copy-tree (@ (guile) copy-tree)) | |
229 | ||
230 | (built-in-func number-sequence | |
231 | (lambda (from . rest) | |
232 | (if (prim > (prim length rest) 2) | |
233 | (runtime-error "too many arguments for number-sequence" | |
234 | (prim cdddr rest)) | |
235 | (if (null? rest) | |
236 | `(,from) | |
237 | (let ((to (prim car rest)) | |
238 | (sep (if (or (null? (prim cdr rest)) | |
239 | (eq? nil-value (prim cadr rest))) | |
240 | 1 | |
241 | (prim cadr rest)))) | |
242 | (cond | |
243 | ((or (eq? nil-value to) (prim = to from)) `(,from)) | |
244 | ((and (zero? sep) (prim not (prim = from to))) | |
245 | (runtime-error "infinite list in number-sequence")) | |
246 | ((prim < (prim * to sep) (prim * from sep)) '()) | |
247 | (else | |
248 | (let iterate ((i (prim + | |
249 | from | |
250 | (prim * | |
251 | sep | |
252 | (prim quotient | |
253 | (prim abs | |
254 | (prim - | |
255 | to | |
256 | from)) | |
257 | (prim abs sep))))) | |
258 | (result '())) | |
259 | (if (prim = i from) | |
260 | (prim cons i result) | |
261 | (iterate (prim - i sep) | |
262 | (prim cons i result))))))))))) | |
263 | ||
264 | ;;; Changing lists. | |
265 | ||
266 | (built-in-func setcar | |
267 | (lambda (cell val) | |
b41a673d BT |
268 | (if (and (null? cell) (null? val)) |
269 | #nil | |
270 | (prim set-car! cell val)) | |
8295b7c4 BT |
271 | val)) |
272 | ||
273 | (built-in-func setcdr | |
274 | (lambda (cell val) | |
b41a673d BT |
275 | (if (and (null? cell) (null? val)) |
276 | #nil | |
277 | (prim set-cdr! cell val)) | |
8295b7c4 BT |
278 | val)) |
279 | ||
280 | ;;; Accessing symbol bindings for symbols known only at runtime. | |
281 | ||
282 | (built-in-func symbol-value | |
283 | (lambda (sym) | |
3f70b2dc | 284 | (reference-variable value-slot-module sym))) |
8295b7c4 BT |
285 | |
286 | (built-in-func symbol-function | |
287 | (lambda (sym) | |
3f70b2dc | 288 | (reference-variable function-slot-module sym))) |
8295b7c4 BT |
289 | |
290 | (built-in-func set | |
291 | (lambda (sym value) | |
292 | (set-variable! value-slot-module sym value))) | |
293 | ||
294 | (built-in-func fset | |
295 | (lambda (sym value) | |
296 | (set-variable! function-slot-module sym value))) | |
297 | ||
298 | (built-in-func makunbound | |
299 | (lambda (sym) | |
3f70b2dc BT |
300 | (if (module-bound? (resolve-interface value-slot-module) sym) |
301 | (let ((var (module-variable (resolve-module value-slot-module) | |
302 | sym))) | |
303 | (if (and (variable-bound? var) (fluid? (variable-ref var))) | |
304 | (fluid-unset! (variable-ref var)) | |
305 | (variable-unset! var)))) | |
8295b7c4 BT |
306 | sym)) |
307 | ||
308 | (built-in-func fmakunbound | |
309 | (lambda (sym) | |
3f70b2dc BT |
310 | (if (module-bound? (resolve-interface function-slot-module) sym) |
311 | (let ((var (module-variable | |
312 | (resolve-module function-slot-module) | |
313 | sym))) | |
314 | (if (and (variable-bound? var) (fluid? (variable-ref var))) | |
315 | (fluid-unset! (variable-ref var)) | |
316 | (variable-unset! var)))) | |
8295b7c4 BT |
317 | sym)) |
318 | ||
319 | (built-in-func boundp | |
320 | (lambda (sym) | |
3f70b2dc BT |
321 | (elisp-bool |
322 | (and | |
323 | (module-bound? (resolve-interface value-slot-module) sym) | |
324 | (let ((var (module-variable (resolve-module value-slot-module) | |
325 | sym))) | |
326 | (and (variable-bound? var) | |
327 | (if (fluid? (variable-ref var)) | |
328 | (fluid-bound? (variable-ref var)) | |
329 | #t))))))) | |
8295b7c4 BT |
330 | |
331 | (built-in-func fboundp | |
332 | (lambda (sym) | |
3f70b2dc BT |
333 | (elisp-bool |
334 | (and | |
335 | (module-bound? (resolve-interface function-slot-module) sym) | |
336 | (let* ((var (module-variable (resolve-module function-slot-module) | |
337 | sym))) | |
338 | (and (variable-bound? var) | |
339 | (if (fluid? (variable-ref var)) | |
340 | (fluid-bound? (variable-ref var)) | |
341 | #t))))))) | |
8295b7c4 BT |
342 | |
343 | ;;; Function calls. These must take care of special cases, like using | |
344 | ;;; symbols or raw lambda-lists as functions! | |
345 | ||
346 | (built-in-func apply | |
347 | (lambda (func . args) | |
348 | (let ((real-func (cond | |
349 | ((symbol? func) | |
3f70b2dc | 350 | (reference-variable function-slot-module func)) |
8295b7c4 BT |
351 | ((list? func) |
352 | (if (and (prim not (null? func)) | |
353 | (eq? (prim car func) 'lambda)) | |
354 | (compile func #:from 'elisp #:to 'value) | |
355 | (runtime-error "list is not a function" | |
356 | func))) | |
357 | (else func)))) | |
358 | (prim apply (@ (guile) apply) real-func args)))) | |
359 | ||
360 | (built-in-func funcall | |
c6920dc8 BT |
361 | (lambda (func . args) |
362 | (apply func args))) | |
8295b7c4 BT |
363 | |
364 | ;;; Throw can be implemented as built-in function. | |
365 | ||
366 | (built-in-func throw | |
367 | (lambda (tag value) | |
368 | (prim throw 'elisp-exception tag value))) | |
369 | ||
370 | ;;; Miscellaneous. | |
371 | ||
372 | (built-in-func not | |
373 | (lambda (x) | |
374 | (if x nil-value t-value))) | |
375 | ||
376 | (built-in-func eval | |
377 | (lambda (form) | |
378 | (compile form #:from 'elisp #:to 'value))) | |
9efe5b23 BT |
379 | |
380 | (built-in-func load | |
381 | (lambda* (file) | |
382 | (compile-file file #:from 'elisp #:to 'value) | |
383 | #t)) |