Mercurial > emacs
comparison lisp/emacs-lisp/cl-macs.el @ 55449:a0ba84563db6
(do, do*): Put usage info in a format usable by `describe-function'.
(gensym, gentemp, typep, ignore-errors): Make argument names match their
use in docstring.
author | Juanma Barranquero <lekktu@gmail.com> |
---|---|
date | Sat, 08 May 2004 17:23:08 +0000 |
parents | 43366e9eb88a |
children | 65bbc782c81c 4c90ffeb71c5 |
comparison
equal
deleted
inserted
replaced
55448:f9d03e5c67f3 | 55449:a0ba84563db6 |
---|---|
162 (or (not (cl-safe-expr-p x)) (cl-expr-contains-any x y)))) | 162 (or (not (cl-safe-expr-p x)) (cl-expr-contains-any x y)))) |
163 | 163 |
164 ;;; Symbols. | 164 ;;; Symbols. |
165 | 165 |
166 (defvar *gensym-counter*) | 166 (defvar *gensym-counter*) |
167 (defun gensym (&optional arg) | 167 (defun gensym (&optional prefix) |
168 "Generate a new uninterned symbol. | 168 "Generate a new uninterned symbol. |
169 The name is made by appending a number to PREFIX, default \"G\"." | 169 The name is made by appending a number to PREFIX, default \"G\"." |
170 (let ((prefix (if (stringp arg) arg "G")) | 170 (let ((pfix (if (stringp prefix) prefix "G")) |
171 (num (if (integerp arg) arg | 171 (num (if (integerp prefix) prefix |
172 (prog1 *gensym-counter* | 172 (prog1 *gensym-counter* |
173 (setq *gensym-counter* (1+ *gensym-counter*)))))) | 173 (setq *gensym-counter* (1+ *gensym-counter*)))))) |
174 (make-symbol (format "%s%d" prefix num)))) | 174 (make-symbol (format "%s%d" pfix num)))) |
175 | 175 |
176 (defun gentemp (&optional arg) | 176 (defun gentemp (&optional prefix) |
177 "Generate a new interned symbol with a unique name. | 177 "Generate a new interned symbol with a unique name. |
178 The name is made by appending a number to PREFIX, default \"G\"." | 178 The name is made by appending a number to PREFIX, default \"G\"." |
179 (let ((prefix (if (stringp arg) arg "G")) | 179 (let ((pfix (if (stringp prefix) prefix "G")) |
180 name) | 180 name) |
181 (while (intern-soft (setq name (format "%s%d" prefix *gensym-counter*))) | 181 (while (intern-soft (setq name (format "%s%d" pfix *gensym-counter*))) |
182 (setq *gensym-counter* (1+ *gensym-counter*))) | 182 (setq *gensym-counter* (1+ *gensym-counter*))) |
183 (intern name))) | 183 (intern name))) |
184 | 184 |
185 | 185 |
186 ;;; Program structure. | 186 ;;; Program structure. |
1175 | 1175 |
1176 ;;; Other iteration control structures. | 1176 ;;; Other iteration control structures. |
1177 | 1177 |
1178 (defmacro do (steps endtest &rest body) | 1178 (defmacro do (steps endtest &rest body) |
1179 "The Common Lisp `do' loop. | 1179 "The Common Lisp `do' loop. |
1180 Format is: (do ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" | 1180 |
1181 \(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" | |
1181 (cl-expand-do-loop steps endtest body nil)) | 1182 (cl-expand-do-loop steps endtest body nil)) |
1182 | 1183 |
1183 (defmacro do* (steps endtest &rest body) | 1184 (defmacro do* (steps endtest &rest body) |
1184 "The Common Lisp `do*' loop. | 1185 "The Common Lisp `do*' loop. |
1185 Format is: (do* ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" | 1186 |
1187 \(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" | |
1186 (cl-expand-do-loop steps endtest body t)) | 1188 (cl-expand-do-loop steps endtest body t)) |
1187 | 1189 |
1188 (defun cl-expand-do-loop (steps endtest body star) | 1190 (defun cl-expand-do-loop (steps endtest body star) |
1189 (list 'block nil | 1191 (list 'block nil |
1190 (list* (if star 'let* 'let) | 1192 (list* (if star 'let* 'let) |
2396 ((memq (car type) '(member member*)) | 2398 ((memq (car type) '(member member*)) |
2397 (list 'and (list 'member* val (list 'quote (cdr type))) t)) | 2399 (list 'and (list 'member* val (list 'quote (cdr type))) t)) |
2398 ((eq (car type) 'satisfies) (list (cadr type) val)) | 2400 ((eq (car type) 'satisfies) (list (cadr type) val)) |
2399 (t (error "Bad type spec: %s" type))))) | 2401 (t (error "Bad type spec: %s" type))))) |
2400 | 2402 |
2401 (defun typep (val type) ; See compiler macro below. | 2403 (defun typep (object type) ; See compiler macro below. |
2402 "Check that OBJECT is of type TYPE. | 2404 "Check that OBJECT is of type TYPE. |
2403 TYPE is a Common Lisp-style type specifier." | 2405 TYPE is a Common Lisp-style type specifier." |
2404 (eval (cl-make-type-test 'val type))) | 2406 (eval (cl-make-type-test 'object type))) |
2405 | 2407 |
2406 (defmacro check-type (form type &optional string) | 2408 (defmacro check-type (form type &optional string) |
2407 "Verify that FORM is of type TYPE; signal an error if not. | 2409 "Verify that FORM is of type TYPE; signal an error if not. |
2408 STRING is an optional description of the desired type." | 2410 STRING is an optional description of the desired type." |
2409 (and (or (not (cl-compiling-file)) | 2411 (and (or (not (cl-compiling-file)) |
2436 (list 'signal '(quote cl-assertion-failed) | 2438 (list 'signal '(quote cl-assertion-failed) |
2437 (list* 'list (list 'quote form) sargs)))) | 2439 (list* 'list (list 'quote form) sargs)))) |
2438 nil)))) | 2440 nil)))) |
2439 | 2441 |
2440 (defmacro ignore-errors (&rest body) | 2442 (defmacro ignore-errors (&rest body) |
2441 "Execute FORMS; if an error occurs, return nil. | 2443 "Execute BODY; if an error occurs, return nil. |
2442 Otherwise, return result of last FORM." | 2444 Otherwise, return result of last form in BODY." |
2443 `(condition-case nil (progn ,@body) (error nil))) | 2445 `(condition-case nil (progn ,@body) (error nil))) |
2444 | 2446 |
2445 | 2447 |
2446 ;;; Compiler macros. | 2448 ;;; Compiler macros. |
2447 | 2449 |