mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2025-12-06 02:40:26 -08:00
Code Issues Projects Releases Packages Wiki Activity

PROCLAIM/DECLAIM understand user-defined and complex types in declarations

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2008-08-26 22:34:37 +02:00
parent 6fd4cd8cdb
commit 71caf39a61
2 changed files with 19 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

3
src/CHANGELOG
View file

@ -68,6 +68,9 @@ ECL 0.9l-p1:
- The MSVC port can be built with support for unicode characters.
- PROCLAIM/DECLAIM now understand the abbreviated form of type declarations
user-defined and complex types.
;;; Local Variables: ***
;;; mode:text ***
;;; fill-column:79 ***

28
src/cmp/cmpenv.lsp
View file

@ -169,10 +169,10 @@
(and (symbolp fname) (get-sysprop fname 'CMP-NOTINLINE)))))
#-:CCL
(defun proclaim (decl)
(defun proclaim (decl &aux decl-name)
(unless (listp decl)
(error "The proclamation specification ~s is not a list" decl))
(case (car decl)
(case (setf decl-name (car decl))
(SPECIAL
(dolist (var (cdr decl))
(if (symbolp var)
@ -219,7 +219,7 @@
;; FIXME! IGNORED!
(dolist (var (cdr decl))
(unless (si::valid-function-name-p var)
(error "Not a valid function name ~s in ~s proclamation" fun (car decl)))))
(error "Not a valid function name ~s in ~s proclamation" fun decl-name))))
(DECLARATION
(do-declaration (rest decl) #'error))
(SI::C-EXPORT-FNAME
@ -243,16 +243,20 @@
READTABLE SEQUENCE SHORT-FLOAT SIMPLE-ARRAY SIMPLE-BIT-VECTOR
SIMPLE-STRING SIMPLE-VECTOR SINGLE-FLOAT STANDARD-CHAR STREAM STRING
SYMBOL T VECTOR SIGNED-BYTE UNSIGNED-BYTE FUNCTION)
(proclaim-var (car decl) (cdr decl)))
(proclaim-var decl-name (cdr decl)))
(otherwise
(unless (member (car decl) si:*alien-declarations*)
(warn "The declaration specifier ~s is unknown." (car decl)))
(and (functionp (get-sysprop (car decl) :proclaim))
(dolist (v (cdr decl))
(funcall (get-sysprop (car decl) :proclaim) v))))
)
nil
)
(cond ((member (car decl) si:*alien-declarations*))
((multiple-value-bind (ok type)
(valid-type-specifier decl-name)
(when ok
(proclaim-var type (rest decl))
t)))
((let ((proclaimer (get-sysprop (car decl) :proclaim)))
(when (functionp proclaimer)
(mapc proclaimer (rest decl))
t)))
(t
(warn "The declaration specifier ~s is unknown." decl-name))))))
(defun type-name-p (name)
(or (get-sysprop name 'SI::DEFTYPE-DEFINITION)