Slight simplification in the detection of alien declarations

This commit is contained in:
Juan Jose Garcia Ripoll 2013-06-22 20:41:28 +02:00
parent 914ce253d1
commit 6ffd74aa05
3 changed files with 10 additions and 9 deletions

View file

@ -70,8 +70,8 @@ that are susceptible to be changed by PROCLAIM."
(cmp-env-variables env))
env)
(defun cmp-env-extend-declaration (type arguments &optional (env *cmp-env*))
(let ((x (cmp-env-search-declaration type)))
(defun cmp-env-extend-declaration (type arguments &optional (env *cmp-env*) default)
(let ((x (cmp-env-search-declaration type env default)))
(cmp-env-add-declaration type (append arguments x) env)
env))
@ -202,10 +202,11 @@ that are susceptible to be changed by PROCLAIM."
when (and (consp i) (var-p (fourth i)))
collect (fourth i)))
(defun cmp-env-search-declaration (kind &optional (env *cmp-env*))
(defun cmp-env-search-declaration (kind &optional (env *cmp-env*) default)
(loop for i in (car env)
when (and (consp i)
(eq (first i) :declare)
(eq (second i) kind))
return (cddr i)))
return (cddr i)
finally (return default)))

View file

@ -37,8 +37,9 @@
new-declaration))))
(defun alien-declaration-p (name &optional (env *cmp-env*))
(or (member name si::*alien-declarations*)
(member name (cmp-env-search-declaration 'alien env))))
(and (symbolp name)
(member name (cmp-env-search-declaration 'alien env si::*alien-declarations*)
:test 'eq)))
(defun parse-ignore-declaration (decl-args expected-ref-number tail)
(declare (si::c-local))
@ -145,7 +146,7 @@ special variable declarations, as these have been extracted before."
env)
(DECLARATION
(validate-alien-declaration (rest decl) #'cmperr)
(cmp-env-extend-declaration 'alien (rest decl) env))
(cmp-env-extend-declaration 'alien (rest decl) env si::*alien-declarations*))
((SI::C-LOCAL SI::C-GLOBAL SI::NO-CHECK-TYPE :READ-ONLY)
env)
((DYNAMIC-EXTENT IGNORABLE SI:FUNCTION-BLOCK-NAME)

View file

@ -73,8 +73,7 @@
(error "Not a valid function name ~s in ~s proclamation" var decl-name))))
(DECLARATION
(validate-alien-declaration (rest decl) #'error)
(setf si::*alien-declarations*
(append (rest decl) si:*alien-declarations*)))
(setf si::*alien-declarations* (append (rest decl) si:*alien-declarations*)))
(SI::C-EXPORT-FNAME
(dolist (x (cdr decl))
(cond ((symbolp x)