164 |
;;; Symbols. |
;;; Symbols. |
165 |
|
|
166 |
(defvar *gensym-counter*) |
(defvar *gensym-counter*) |
167 |
(defun gensym (&optional arg) |
(defun gensym (&optional prefix) |
168 |
"Generate a new uninterned symbol. |
"Generate a new uninterned symbol. |
169 |
The name is made by appending a number to PREFIX, default \"G\"." |
The name is made by appending a number to PREFIX, default \"G\"." |
170 |
(let ((prefix (if (stringp arg) arg "G")) |
(let ((pfix (if (stringp prefix) prefix "G")) |
171 |
(num (if (integerp arg) arg |
(num (if (integerp prefix) prefix |
172 |
(prog1 *gensym-counter* |
(prog1 *gensym-counter* |
173 |
(setq *gensym-counter* (1+ *gensym-counter*)))))) |
(setq *gensym-counter* (1+ *gensym-counter*)))))) |
174 |
(make-symbol (format "%s%d" prefix num)))) |
(make-symbol (format "%s%d" pfix num)))) |
175 |
|
|
176 |
(defun gentemp (&optional arg) |
(defun gentemp (&optional prefix) |
177 |
"Generate a new interned symbol with a unique name. |
"Generate a new interned symbol with a unique name. |
178 |
The name is made by appending a number to PREFIX, default \"G\"." |
The name is made by appending a number to PREFIX, default \"G\"." |
179 |
(let ((prefix (if (stringp arg) arg "G")) |
(let ((pfix (if (stringp prefix) prefix "G")) |
180 |
name) |
name) |
181 |
(while (intern-soft (setq name (format "%s%d" prefix *gensym-counter*))) |
(while (intern-soft (setq name (format "%s%d" pfix *gensym-counter*))) |
182 |
(setq *gensym-counter* (1+ *gensym-counter*))) |
(setq *gensym-counter* (1+ *gensym-counter*))) |
183 |
(intern name))) |
(intern name))) |
184 |
|
|
1177 |
|
|
1178 |
(defmacro do (steps endtest &rest body) |
(defmacro do (steps endtest &rest body) |
1179 |
"The Common Lisp `do' loop. |
"The Common Lisp `do' loop. |
1180 |
Format is: (do ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" |
|
1181 |
|
\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" |
1182 |
(cl-expand-do-loop steps endtest body nil)) |
(cl-expand-do-loop steps endtest body nil)) |
1183 |
|
|
1184 |
(defmacro do* (steps endtest &rest body) |
(defmacro do* (steps endtest &rest body) |
1185 |
"The Common Lisp `do*' loop. |
"The Common Lisp `do*' loop. |
1186 |
Format is: (do* ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" |
|
1187 |
|
\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" |
1188 |
(cl-expand-do-loop steps endtest body t)) |
(cl-expand-do-loop steps endtest body t)) |
1189 |
|
|
1190 |
(defun cl-expand-do-loop (steps endtest body star) |
(defun cl-expand-do-loop (steps endtest body star) |
2400 |
((eq (car type) 'satisfies) (list (cadr type) val)) |
((eq (car type) 'satisfies) (list (cadr type) val)) |
2401 |
(t (error "Bad type spec: %s" type))))) |
(t (error "Bad type spec: %s" type))))) |
2402 |
|
|
2403 |
(defun typep (val type) ; See compiler macro below. |
(defun typep (object type) ; See compiler macro below. |
2404 |
"Check that OBJECT is of type TYPE. |
"Check that OBJECT is of type TYPE. |
2405 |
TYPE is a Common Lisp-style type specifier." |
TYPE is a Common Lisp-style type specifier." |
2406 |
(eval (cl-make-type-test 'val type))) |
(eval (cl-make-type-test 'object type))) |
2407 |
|
|
2408 |
(defmacro check-type (form type &optional string) |
(defmacro check-type (form type &optional string) |
2409 |
"Verify that FORM is of type TYPE; signal an error if not. |
"Verify that FORM is of type TYPE; signal an error if not. |
2440 |
nil)))) |
nil)))) |
2441 |
|
|
2442 |
(defmacro ignore-errors (&rest body) |
(defmacro ignore-errors (&rest body) |
2443 |
"Execute FORMS; if an error occurs, return nil. |
"Execute BODY; if an error occurs, return nil. |
2444 |
Otherwise, return result of last FORM." |
Otherwise, return result of last form in BODY." |
2445 |
`(condition-case nil (progn ,@body) (error nil))) |
`(condition-case nil (progn ,@body) (error nil))) |
2446 |
|
|
2447 |
|
|