/[cmucl]/src/compiler/macros.lisp
ViewVC logotype

Diff of /src/compiler/macros.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.41.2.2 by dtc, Fri Jul 7 09:34:25 2000 UTC revision 1.41.2.3 by pw, Sat Mar 23 18:50:24 2002 UTC
# Line 23  Line 23 
23            def-boolean-attribute attributes-union attributes-intersection            def-boolean-attribute attributes-union attributes-intersection
24            attributes=))            attributes=))
25    
26  (proclaim '(special *wild-type* *universal-type* *compiler-error-context*))  (declaim (special *wild-type* *universal-type* *compiler-error-context*))
27    
28  ;;;; Deftypes:  ;;;; Deftypes:
29    
# Line 46  Line 46 
46    
47  ;;;; The Policy macro:  ;;;; The Policy macro:
48    
49  (proclaim '(special *lexical-environment*))  (declaim (special *lexical-environment*))
50    
51  (eval-when (compile load eval)  (eval-when (compile load eval)
52  (defconstant policy-parameter-slots  (defconstant policy-parameter-slots
# Line 109  Line 109 
109  ;;;    Concatenate together the names of some strings and symbols, producing  ;;;    Concatenate together the names of some strings and symbols, producing
110  ;;; a symbol in the current package.  ;;; a symbol in the current package.
111  ;;;  ;;;
112  (proclaim '(function symbolicate (&rest (or string symbol)) symbol))  (declaim (function symbolicate (&rest (or string symbol)) symbol))
113  (defun symbolicate (&rest things)  (defun symbolicate (&rest things)
114    (declare (values symbol))    (declare (values symbol))
115    (values (intern (reduce #'(lambda (x y)    (values (intern (reduce #'(lambda (x y)
# Line 132  Line 132 
132  ;;; Passed to parse-defmacro when we want compiler errors instead of real  ;;; Passed to parse-defmacro when we want compiler errors instead of real
133  ;;; errors.  ;;; errors.
134  ;;;  ;;;
135  (proclaim '(inline convert-condition-into-compiler-error))  (declaim (inline convert-condition-into-compiler-error))
136  (defun convert-condition-into-compiler-error (datum &rest stuff)  (defun convert-condition-into-compiler-error (datum &rest stuff)
137    (if (stringp datum)    (if (stringp datum)
138        (apply #'compiler-error datum stuff)        (apply #'compiler-error datum stuff)
# Line 167  Line 167 
167                                :environment n-env                                :environment n-env
168                                :error-fun 'convert-condition-into-compiler-error)                                :error-fun 'convert-condition-into-compiler-error)
169        `(progn        `(progn
170           (proclaim '(function ,fn-name (continuation continuation t) void))           (declaim (function ,fn-name (continuation continuation t) void))
171           (defun ,fn-name (,start-var ,cont-var ,n-form)           (defun ,fn-name (,start-var ,cont-var ,n-form)
172             (let ((,n-env *lexical-environment*))             (let ((,n-env *lexical-environment*))
173               ,@decls               ,@decls
# Line 922  Line 922 
922             `(logtest ,(compute-attribute-mask attribute-names ,const-name)             `(logtest ,(compute-attribute-mask attribute-names ,const-name)
923                       (the attributes ,attributes)))                       (the attributes ,attributes)))
924    
925           (define-setf-method ,test-name (place &rest attributes           (define-setf-expander ,test-name (place &rest attributes
926                                                 &environment env)                                                   &environment env)
927    
928             "Automagically generated boolean attribute setter.  See             "Automagically generated boolean attribute setter.  See
929              Def-Boolean-Attribute."              Def-Boolean-Attribute."
# Line 965  Line 965 
965    `(the attributes    `(the attributes
966          (logand ,@(mapcar #'(lambda (x) `(the attributes ,x)) attributes))))          (logand ,@(mapcar #'(lambda (x) `(the attributes ,x)) attributes))))
967  ;;;  ;;;
968  (proclaim '(inline attributes=))  (declaim (inline attributes=))
969  (defun attributes= (attr1 attr2)  (defun attributes= (attr1 attr2)
970    (declare (type attributes attr1 attr2))    (declare (type attributes attr1 attr2))
971    "Returns true if the attributes present in Attr1 are indentical to those in    "Returns true if the attributes present in Attr1 are indentical to those in
# Line 1074  Line 1074 
1074         (setf (gethash ',name *event-info*) ,var-name)         (setf (gethash ',name *event-info*) ,var-name)
1075         ',name)))         ',name)))
1076    
1077  (proclaim '(type unsigned-byte *event-note-threshold*))  (declaim (type unsigned-byte *event-note-threshold*))
1078  (defvar *event-note-threshold* 1  (defvar *event-note-threshold* 1
1079    "This variable is a non-negative integer specifying the lowest level of    "This variable is a non-negative integer specifying the lowest level of
1080    event that will print a Note when it occurs.")    event that will print a Note when it occurs.")
# Line 1120  Line 1120 
1120    
1121  ;;;; Generic list (?) functions:  ;;;; Generic list (?) functions:
1122    
1123  (proclaim '(inline find-in position-in map-in))  (declaim (inline find-in position-in map-in))
1124    
1125  ;;; Find-In  --  Interface  ;;; Find-In  --  Interface
1126  ;;;  ;;;

Legend:
Removed from v.1.41.2.2  
changed lines
  Added in v.1.41.2.3

  ViewVC Help
Powered by ViewVC 1.1.5