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 | ||
7d1a9782 DK |
21 | (define-module (language elisp runtime macro-slot) |
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 | ||
29 | ;;; The prog1 and prog2 constructs can easily be defined as macros using | |
30 | ;;; progn and some lexical-let's to save the intermediate value to | |
31 | ;;; return at the end. | |
e6042c08 DK |
32 | |
33 | (built-in-macro prog1 | |
34 | (lambda (form1 . rest) | |
35 | (let ((temp (gensym))) | |
36 | `(without-void-checks (,temp) | |
37 | (lexical-let ((,temp ,form1)) | |
38 | ,@rest | |
39 | ,temp))))) | |
fb66a47a DK |
40 | |
41 | (built-in-macro prog2 | |
42 | (lambda (form1 form2 . rest) | |
43 | `(progn ,form1 (prog1 ,form2 ,@rest)))) | |
44 | ||
c983a199 | 45 | ;;; Define the conditionals when and unless as macros. |
7d1a9782 DK |
46 | |
47 | (built-in-macro when | |
48 | (lambda (condition . thens) | |
49 | `(if ,condition (progn ,@thens) nil))) | |
50 | ||
51 | (built-in-macro unless | |
52 | (lambda (condition . elses) | |
53 | `(if ,condition nil (progn ,@elses)))) | |
54 | ||
c983a199 BT |
55 | ;;; Impement the cond form as nested if's. A special case is a |
56 | ;;; (condition) subform, in which case we need to return the condition | |
57 | ;;; itself if it is true and thus save it in a local variable before | |
58 | ;;; testing it. | |
e6042c08 DK |
59 | |
60 | (built-in-macro cond | |
61 | (lambda (. clauses) | |
62 | (let iterate ((tail clauses)) | |
63 | (if (null? tail) | |
f4e5e411 BT |
64 | 'nil |
65 | (let ((cur (car tail)) | |
66 | (rest (iterate (cdr tail)))) | |
67 | (prim cond | |
68 | ((prim or (not (list? cur)) (null? cur)) | |
69 | (macro-error "invalid clause in cond" cur)) | |
70 | ((null? (cdr cur)) | |
71 | (let ((var (gensym))) | |
72 | `(without-void-checks (,var) | |
73 | (lexical-let ((,var ,(car cur))) | |
74 | (if ,var | |
75 | ,var | |
76 | ,rest))))) | |
77 | (else | |
78 | `(if ,(car cur) | |
79 | (progn ,@(cdr cur)) | |
80 | ,rest)))))))) | |
e6042c08 | 81 | |
c983a199 | 82 | ;;; The and and or forms can also be easily defined with macros. |
e6042c08 DK |
83 | |
84 | (built-in-macro and | |
474060a2 AW |
85 | (case-lambda |
86 | (() 't) | |
87 | ((x) x) | |
88 | ((x . args) | |
89 | (let iterate ((x x) (tail args)) | |
90 | (if (null? tail) | |
91 | x | |
92 | `(if ,x | |
93 | ,(iterate (car tail) (cdr tail)) | |
94 | nil)))))) | |
e6042c08 DK |
95 | |
96 | (built-in-macro or | |
474060a2 AW |
97 | (case-lambda |
98 | (() 'nil) | |
99 | ((x) x) | |
100 | ((x . args) | |
101 | (let iterate ((x x) (tail args)) | |
102 | (if (null? tail) | |
103 | x | |
104 | (let ((var (gensym))) | |
105 | `(without-void-checks | |
f4e5e411 BT |
106 | (,var) |
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) | |
146 | (without-void-checks (,tailvar) | |
147 | (lexical-let ((,tailvar ,iter-list)) | |
148 | (while ((guile-primitive not) | |
149 | ((guile-primitive null?) ,tailvar)) | |
150 | (setq ,var ((guile-primitive car) ,tailvar)) | |
151 | ,@body | |
152 | (setq ,tailvar ((guile-primitive cdr) ,tailvar))) | |
153 | ,@(if (= (length args) 3) | |
154 | (list (caddr args)) | |
155 | '()))))))))) | |
e6042c08 | 156 | |
c983a199 BT |
157 | ;;; Exception handling. unwind-protect and catch are implemented as |
158 | ;;; macros (throw is a built-in function). | |
f4dc86f1 | 159 | |
c983a199 BT |
160 | ;;; catch and throw can mainly be implemented directly using Guile's |
161 | ;;; primitives for exceptions, the only difficulty is that the keys used | |
162 | ;;; within Guile must be symbols, while elisp allows any value and | |
163 | ;;; checks for matches using eq (eq?). We handle this by using always #t | |
164 | ;;; as key for the Guile primitives and check for matches inside the | |
165 | ;;; handler; if the elisp keys are not eq?, we rethrow the exception. | |
abcf4a9e | 166 | |
f4dc86f1 DK |
167 | (built-in-macro catch |
168 | (lambda (tag . body) | |
169 | (if (null? body) | |
f4e5e411 | 170 | (macro-error "catch with empty body")) |
f4dc86f1 DK |
171 | (let ((tagsym (gensym))) |
172 | `(lexical-let ((,tagsym ,tag)) | |
173 | ((guile-primitive catch) | |
f4e5e411 BT |
174 | #t |
175 | (lambda () ,@body) | |
176 | ,(let* ((dummy-key (gensym)) | |
177 | (elisp-key (gensym)) | |
178 | (value (gensym)) | |
179 | (arglist `(,dummy-key ,elisp-key ,value))) | |
180 | `(with-always-lexical | |
181 | ,arglist | |
182 | (lambda ,arglist | |
183 | (if (eq ,elisp-key ,tagsym) | |
f4dc86f1 DK |
184 | ,value |
185 | ((guile-primitive throw) ,dummy-key ,elisp-key | |
f4e5e411 | 186 | ,value)))))))))) |
f4dc86f1 | 187 | |
c983a199 BT |
188 | ;;; unwind-protect is just some weaker construct as dynamic-wind, so |
189 | ;;; straight-forward to implement. | |
abcf4a9e | 190 | |
f4dc86f1 DK |
191 | (built-in-macro unwind-protect |
192 | (lambda (body . clean-ups) | |
193 | (if (null? clean-ups) | |
f4e5e411 | 194 | (macro-error "unwind-protect without cleanup code")) |
f4dc86f1 | 195 | `((guile-primitive dynamic-wind) |
f4e5e411 BT |
196 | (lambda () nil) |
197 | (lambda () ,body) | |
198 | (lambda () ,@clean-ups)))) | |
f4dc86f1 | 199 | |
c983a199 | 200 | ;;; Pop off the first element from a list or push one to it. |
f614ca12 DK |
201 | |
202 | (built-in-macro pop | |
203 | (lambda (list-name) | |
204 | `(prog1 (car ,list-name) | |
205 | (setq ,list-name (cdr ,list-name))))) | |
206 | ||
207 | (built-in-macro push | |
208 | (lambda (new-el list-name) | |
209 | `(setq ,list-name (cons ,new-el ,list-name)))) |