X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=ecmalisp.lisp;h=65c2c1a95209ac68197222bc5866dfd2c0f294f4;hb=baf8e770607ac10996b840f14bae07bbfd15b88c;hp=d417a870feec9d17a1c5126b50917becf1aead93;hpb=84d4526bebde9bfdae9cb932aad8e0e4cde4cebf;p=jscl.git

diff --git a/ecmalisp.lisp b/ecmalisp.lisp
index d417a87..65c2c1a 100644
--- a/ecmalisp.lisp
+++ b/ecmalisp.lisp
@@ -52,8 +52,7 @@
 
   (defmacro defvar (name value &optional docstring)
     `(progn
-       (unless (boundp ',name)
-	 (setq ,name ,value))
+       (unless (boundp ',name) (setq ,name ,value))
        ,@(when (stringp docstring) `((oset ',name "vardoc" ,docstring)))
        ',name))
 
@@ -846,9 +845,9 @@
         (push-to-lexenv b *environment* namespace)
         b)))
 
-(defun claims (symbol namespace)
+(defun claimp (symbol namespace claim)
   (let ((b (lookup-in-lexenv symbol *environment* namespace)))
-    (and b (binding-declarations b))))
+    (and b (member claim (binding-declarations b)))))
 
 (defun !proclaim (decl)
   (case (car decl)
@@ -1538,7 +1537,7 @@
 
 (defun compile-funcall (function args)
   (if (and (symbolp function)
-           (member 'non-overridable (claims function 'function)))
+           (claimp function 'function 'non-overridable))
       (concat (ls-compile `',function) ".function("
               (join (mapcar #'ls-compile args)
                     ", ")
@@ -1563,7 +1562,7 @@
        (cond
          ((eq (binding-type b) 'lexical-variable)
           (binding-value b))
-         ((member 'constant (binding-declarations b))
+         ((claimp sexp 'variable 'constant)
           (concat (ls-compile `',sexp) ".value"))
          (t
           (ls-compile `(symbol-value ',sexp))))))
@@ -1579,8 +1578,7 @@
             (apply comp args)))
          ;; Built-in functions
          ((and (assoc name *builtins*)
-               (or (not (lookup-in-lexenv name *environment* 'function))
-                   (member 'notinline (claims name 'function))))
+               (not (claimp name 'function 'notinline)))
           (let ((comp (second (assoc name *builtins*))))
             (apply comp args)))
          (t