Commit | Line | Data |
---|---|---|
eb80072d LC |
1 | ;;; Guile Emacs Lisp |
2 | ||
474060a2 | 3 | ;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. |
eb80072d LC |
4 | ;;; |
5 | ;;; This library is free software; you can redistribute it and/or | |
6 | ;;; modify it under the terms of the GNU Lesser General Public | |
7 | ;;; License as published by the Free Software Foundation; either | |
8 | ;;; version 3 of the License, or (at your option) any later version. | |
9 | ;;; | |
10 | ;;; This library 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 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 02110-1301 USA | |
74c009da DK |
18 | |
19 | ;;; Code: | |
20 | ||
8295b7c4 | 21 | (define-module (language elisp runtime macros) |
7d1a9782 | 22 | #:use-module (language elisp runtime)) |
74c009da | 23 | |
c983a199 BT |
24 | ;;; This module contains the macro definitions of elisp symbols. In |
25 | ;;; contrast to the other runtime modules, those are used directly | |
26 | ;;; during compilation, of course, so not really in runtime. But I | |
27 | ;;; think it fits well to the others here. | |
28 | ||
44ae163d BT |
29 | (built-in-macro lambda |
30 | (lambda cdr | |
31 | `(function (lambda ,@cdr)))) | |
32 | ||
c983a199 BT |
33 | ;;; The prog1 and prog2 constructs can easily be defined as macros using |
34 | ;;; progn and some lexical-let's to save the intermediate value to | |
35 | ;;; return at the end. | |
e6042c08 DK |
36 | |
37 | (built-in-macro prog1 | |
38 | (lambda (form1 . rest) | |
39 | (let ((temp (gensym))) | |
3f70b2dc BT |
40 | `(lexical-let ((,temp ,form1)) |
41 | ,@rest | |
42 | ,temp)))) | |
fb66a47a DK |
43 | |
44 | (built-in-macro prog2 | |
45 | (lambda (form1 form2 . rest) | |
46 | `(progn ,form1 (prog1 ,form2 ,@rest)))) | |
47 | ||
c983a199 | 48 | ;;; Define the conditionals when and unless as macros. |
7d1a9782 DK |
49 | |
50 | (built-in-macro when | |
51 | (lambda (condition . thens) | |
52 | `(if ,condition (progn ,@thens) nil))) | |
53 | ||
54 | (built-in-macro unless | |
55 | (lambda (condition . elses) | |
56 | `(if ,condition nil (progn ,@elses)))) | |
57 | ||
c983a199 BT |
58 | ;;; Impement the cond form as nested if's. A special case is a |
59 | ;;; (condition) subform, in which case we need to return the condition | |
60 | ;;; itself if it is true and thus save it in a local variable before | |
61 | ;;; testing it. | |
e6042c08 DK |
62 | |
63 | (built-in-macro cond | |
64 | (lambda (. clauses) | |
65 | (let iterate ((tail clauses)) | |
66 | (if (null? tail) | |
f4e5e411 BT |
67 | 'nil |
68 | (let ((cur (car tail)) | |
69 | (rest (iterate (cdr tail)))) | |
70 | (prim cond | |
71 | ((prim or (not (list? cur)) (null? cur)) | |
72 | (macro-error "invalid clause in cond" cur)) | |
73 | ((null? (cdr cur)) | |
74 | (let ((var (gensym))) | |
3f70b2dc BT |
75 | `(lexical-let ((,var ,(car cur))) |
76 | (if ,var | |
77 | ,var | |
78 | ,rest)))) | |
f4e5e411 BT |
79 | (else |
80 | `(if ,(car cur) | |
81 | (progn ,@(cdr cur)) | |
82 | ,rest)))))))) | |
e6042c08 | 83 | |
c983a199 | 84 | ;;; The and and or forms can also be easily defined with macros. |
e6042c08 DK |
85 | |
86 | (built-in-macro and | |
474060a2 AW |
87 | (case-lambda |
88 | (() 't) | |
89 | ((x) x) | |
90 | ((x . args) | |
91 | (let iterate ((x x) (tail args)) | |
92 | (if (null? tail) | |
93 | x | |
94 | `(if ,x | |
95 | ,(iterate (car tail) (cdr tail)) | |
96 | nil)))))) | |
e6042c08 DK |
97 | |
98 | (built-in-macro or | |
474060a2 AW |
99 | (case-lambda |
100 | (() 'nil) | |
101 | ((x) x) | |
102 | ((x . args) | |
103 | (let iterate ((x x) (tail args)) | |
104 | (if (null? tail) | |
105 | x | |
106 | (let ((var (gensym))) | |
3f70b2dc BT |
107 | `(lexical-let ((,var ,x)) |
108 | (if ,var | |
109 | ,var | |
110 | ,(iterate (car tail) (cdr tail)))))))))) | |
e6042c08 | 111 | |
c983a199 | 112 | ;;; Define the dotimes and dolist iteration macros. |
7d1a9782 DK |
113 | |
114 | (built-in-macro dotimes | |
115 | (lambda (args . body) | |
f4e5e411 BT |
116 | (if (prim or |
117 | (not (list? args)) | |
118 | (< (length args) 2) | |
119 | (> (length args) 3)) | |
120 | (macro-error "invalid dotimes arguments" args) | |
121 | (let ((var (car args)) | |
122 | (count (cadr args))) | |
123 | (if (not (symbol? var)) | |
124 | (macro-error "expected symbol as dotimes variable")) | |
125 | `(let ((,var 0)) | |
126 | (while ((guile-primitive <) ,var ,count) | |
127 | ,@body | |
128 | (setq ,var ((guile-primitive 1+) ,var))) | |
129 | ,@(if (= (length args) 3) | |
130 | (list (caddr args)) | |
131 | '())))))) | |
f614ca12 | 132 | |
e6042c08 DK |
133 | (built-in-macro dolist |
134 | (lambda (args . body) | |
f4e5e411 BT |
135 | (if (prim or |
136 | (not (list? args)) | |
137 | (< (length args) 2) | |
138 | (> (length args) 3)) | |
139 | (macro-error "invalid dolist arguments" args) | |
140 | (let ((var (car args)) | |
141 | (iter-list (cadr args)) | |
142 | (tailvar (gensym))) | |
143 | (if (not (symbol? var)) | |
144 | (macro-error "expected symbol as dolist variable") | |
145 | `(let (,var) | |
3f70b2dc BT |
146 | (lexical-let ((,tailvar ,iter-list)) |
147 | (while ((guile-primitive not) | |
148 | ((guile-primitive null?) ,tailvar)) | |
149 | (setq ,var ((guile-primitive car) ,tailvar)) | |
150 | ,@body | |
151 | (setq ,tailvar ((guile-primitive cdr) ,tailvar))) | |
152 | ,@(if (= (length args) 3) | |
153 | (list (caddr args)) | |
154 | '())))))))) | |
e6042c08 | 155 | |
c983a199 BT |
156 | ;;; Exception handling. unwind-protect and catch are implemented as |
157 | ;;; macros (throw is a built-in function). | |
f4dc86f1 | 158 | |
c983a199 BT |
159 | ;;; catch and throw can mainly be implemented directly using Guile's |
160 | ;;; primitives for exceptions, the only difficulty is that the keys used | |
161 | ;;; within Guile must be symbols, while elisp allows any value and | |
162 | ;;; checks for matches using eq (eq?). We handle this by using always #t | |
163 | ;;; as key for the Guile primitives and check for matches inside the | |
164 | ;;; handler; if the elisp keys are not eq?, we rethrow the exception. | |
abcf4a9e | 165 | |
f4dc86f1 DK |
166 | (built-in-macro catch |
167 | (lambda (tag . body) | |
168 | (if (null? body) | |
f4e5e411 | 169 | (macro-error "catch with empty body")) |
f4dc86f1 DK |
170 | (let ((tagsym (gensym))) |
171 | `(lexical-let ((,tagsym ,tag)) | |
172 | ((guile-primitive catch) | |
f4e5e411 BT |
173 | #t |
174 | (lambda () ,@body) | |
175 | ,(let* ((dummy-key (gensym)) | |
176 | (elisp-key (gensym)) | |
177 | (value (gensym)) | |
178 | (arglist `(,dummy-key ,elisp-key ,value))) | |
179 | `(with-always-lexical | |
180 | ,arglist | |
181 | (lambda ,arglist | |
182 | (if (eq ,elisp-key ,tagsym) | |
f4dc86f1 DK |
183 | ,value |
184 | ((guile-primitive throw) ,dummy-key ,elisp-key | |
f4e5e411 | 185 | ,value)))))))))) |
f4dc86f1 | 186 | |
c983a199 BT |
187 | ;;; unwind-protect is just some weaker construct as dynamic-wind, so |
188 | ;;; straight-forward to implement. | |
abcf4a9e | 189 | |
f4dc86f1 DK |
190 | (built-in-macro unwind-protect |
191 | (lambda (body . clean-ups) | |
192 | (if (null? clean-ups) | |
f4e5e411 | 193 | (macro-error "unwind-protect without cleanup code")) |
f4dc86f1 | 194 | `((guile-primitive dynamic-wind) |
f4e5e411 BT |
195 | (lambda () nil) |
196 | (lambda () ,body) | |
197 | (lambda () ,@clean-ups)))) | |
f4dc86f1 | 198 | |
c983a199 | 199 | ;;; Pop off the first element from a list or push one to it. |
f614ca12 DK |
200 | |
201 | (built-in-macro pop | |
202 | (lambda (list-name) | |
203 | `(prog1 (car ,list-name) | |
204 | (setq ,list-name (cdr ,list-name))))) | |
205 | ||
206 | (built-in-macro push | |
207 | (lambda (new-el list-name) | |
208 | `(setq ,list-name (cons ,new-el ,list-name)))) |