Commit | Line | Data |
---|---|---|
74c009da DK |
1 | ;;; Guile Emac Lisp |
2 | ||
3 | ;; Copyright (C) 2001 Free Software Foundation, Inc. | |
4 | ||
5 | ;; This program is free software; you can redistribute it and/or modify | |
6 | ;; it under the terms of the GNU General Public License as published by | |
7 | ;; the Free Software Foundation; either version 2, or (at your option) | |
8 | ;; any later version. | |
9 | ;; | |
10 | ;; This program is distributed in the hope that it will be useful, | |
11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
13 | ;; GNU General Public License for more details. | |
14 | ;; | |
15 | ;; You should have received a copy of the GNU General Public License | |
16 | ;; along with this program; see the file COPYING. If not, write to | |
17 | ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
18 | ;; Boston, MA 02111-1307, USA. | |
19 | ||
20 | ;;; Code: | |
21 | ||
7d1a9782 DK |
22 | (define-module (language elisp runtime macro-slot) |
23 | #:use-module (language elisp runtime)) | |
74c009da DK |
24 | |
25 | ; This module contains the macro definitions of elisp symbols. In contrast to | |
26 | ; the other runtime modules, those are used directly during compilation, of | |
27 | ; course, so not really in runtime. But I think it fits well to the others | |
28 | ; here. | |
7d1a9782 DK |
29 | |
30 | ||
e6042c08 DK |
31 | ; The prog1 and prog2 constructs can easily be defined as macros using progn |
32 | ; and some lexical-let's to save the intermediate value to return at the end. | |
33 | ||
34 | (built-in-macro prog1 | |
35 | (lambda (form1 . rest) | |
36 | (let ((temp (gensym))) | |
37 | `(without-void-checks (,temp) | |
38 | (lexical-let ((,temp ,form1)) | |
39 | ,@rest | |
40 | ,temp))))) | |
fb66a47a DK |
41 | |
42 | (built-in-macro prog2 | |
43 | (lambda (form1 form2 . rest) | |
44 | `(progn ,form1 (prog1 ,form2 ,@rest)))) | |
45 | ||
46 | ||
7d1a9782 DK |
47 | ; Define the conditionals when and unless as macros. |
48 | ||
49 | (built-in-macro when | |
50 | (lambda (condition . thens) | |
51 | `(if ,condition (progn ,@thens) nil))) | |
52 | ||
53 | (built-in-macro unless | |
54 | (lambda (condition . elses) | |
55 | `(if ,condition nil (progn ,@elses)))) | |
56 | ||
57 | ||
e6042c08 DK |
58 | ; Impement the cond form as nested if's. A special case is a (condition) |
59 | ; subform, in which case we need to return the condition itself if it is true | |
60 | ; and thus save it in a local variable before testing it. | |
61 | ||
62 | (built-in-macro cond | |
63 | (lambda (. clauses) | |
64 | (let iterate ((tail clauses)) | |
65 | (if (null? tail) | |
66 | 'nil | |
67 | (let ((cur (car tail)) | |
68 | (rest (iterate (cdr tail)))) | |
69 | (prim cond | |
70 | ((prim or (not (list? cur)) (null? cur)) | |
71 | (macro-error "invalid clause in cond" cur)) | |
72 | ((null? (cdr cur)) | |
73 | (let ((var (gensym))) | |
74 | `(without-void-checks (,var) | |
75 | (lexical-let ((,var ,(car cur))) | |
76 | (if ,var | |
77 | ,var | |
78 | ,rest))))) | |
79 | (else | |
80 | `(if ,(car cur) | |
81 | (progn ,@(cdr cur)) | |
82 | ,rest)))))))) | |
83 | ||
84 | ||
85 | ; The and and or forms can also be easily defined with macros. | |
86 | ||
87 | (built-in-macro and | |
88 | (lambda (. args) | |
89 | (if (null? args) | |
90 | 't | |
91 | (let iterate ((tail args)) | |
92 | (if (null? (cdr tail)) | |
93 | (car tail) | |
94 | `(if ,(car tail) | |
95 | ,(iterate (cdr tail)) | |
96 | nil)))))) | |
97 | ||
98 | (built-in-macro or | |
99 | (lambda (. args) | |
100 | (let iterate ((tail args)) | |
101 | (if (null? tail) | |
102 | 'nil | |
103 | (let ((var (gensym))) | |
104 | `(without-void-checks (,var) | |
105 | (lexical-let ((,var ,(car tail))) | |
106 | (if ,var | |
107 | ,var | |
108 | ,(iterate (cdr tail)))))))))) | |
109 | ||
110 | ||
111 | ; Define the dotimes and dolist iteration macros. | |
7d1a9782 DK |
112 | |
113 | (built-in-macro dotimes | |
114 | (lambda (args . body) | |
e6042c08 DK |
115 | (if (prim or (not (list? args)) |
116 | (< (length args) 2) | |
117 | (> (length args) 3)) | |
7d1a9782 DK |
118 | (macro-error "invalid dotimes arguments" args) |
119 | (let ((var (car args)) | |
120 | (count (cadr args))) | |
121 | (if (not (symbol? var)) | |
122 | (macro-error "expected symbol as dotimes variable")) | |
123 | `(let ((,var 0)) | |
bfd472a7 | 124 | (while ((guile-primitive <) ,var ,count) |
7d1a9782 | 125 | ,@body |
bfd472a7 | 126 | (setq ,var ((guile-primitive 1+) ,var))) |
7d1a9782 DK |
127 | ,@(if (= (length args) 3) |
128 | (list (caddr args)) | |
129 | '())))))) | |
f614ca12 | 130 | |
e6042c08 DK |
131 | (built-in-macro dolist |
132 | (lambda (args . body) | |
133 | (if (prim or (not (list? args)) | |
134 | (< (length args) 2) | |
135 | (> (length args) 3)) | |
136 | (macro-error "invalid dolist arguments" args) | |
137 | (let ((var (car args)) | |
138 | (iter-list (cadr args)) | |
139 | (tailvar (gensym))) | |
140 | (if (not (symbol? var)) | |
141 | (macro-error "expected symbol as dolist variable") | |
142 | `(let (,var) | |
143 | (without-void-checks (,tailvar) | |
144 | (lexical-let ((,tailvar ,iter-list)) | |
bfd472a7 DK |
145 | (while ((guile-primitive not) |
146 | ((guile-primitive null?) ,tailvar)) | |
147 | (setq ,var ((guile-primitive car) ,tailvar)) | |
e6042c08 | 148 | ,@body |
bfd472a7 | 149 | (setq ,tailvar ((guile-primitive cdr) ,tailvar))) |
e6042c08 DK |
150 | ,@(if (= (length args) 3) |
151 | (list (caddr args)) | |
152 | '()))))))))) | |
153 | ||
f614ca12 DK |
154 | |
155 | ; Pop off the first element from a list or push one to it. | |
156 | ||
157 | (built-in-macro pop | |
158 | (lambda (list-name) | |
159 | `(prog1 (car ,list-name) | |
160 | (setq ,list-name (cdr ,list-name))))) | |
161 | ||
162 | (built-in-macro push | |
163 | (lambda (new-el list-name) | |
164 | `(setq ,list-name (cons ,new-el ,list-name)))) |