Added some declarations for the new type check model.

parent e63a78ce
......@@ -370,4 +370,4 @@ from the function in which it appears." name))))
(dolist (record (macrolet-functions definitions old-env))
(push (list (first record) 'si::macro (second record))
macros))
(rplacd old-env macros)))
(rplacd (the cons old-env) macros)))
......@@ -123,7 +123,7 @@ VARIABLE doc and can be retrieved by (DOCUMENTATION 'SYMBOL 'VARIABLE)."
',name)))
(defun compiler-macro-function (name &optional env)
(declare (ignore env))
(declare (ignorable env))
(get-sysprop name 'sys::compiler-macro))
;;; Each of the following macros is also defined as a special form,
......@@ -246,11 +246,10 @@ FORM returns no value, NIL."
(do ((vl vars (cdr vl))
(sym (gensym))
(forms nil)
(n 0 (1+ n)))
(n 0 (the fixnum (1+ n))))
((endp vl) `(LET ((,sym (MULTIPLE-VALUE-LIST ,form))) ,@forms))
(declare (fixnum n))
(push `(SETQ ,(car vl) (NTH ,n ,sym)) forms))
)
(declare (fixnum n))
(push `(SETQ ,(car vl) (NTH ,n ,sym)) forms)))
;; We do not use this macroexpanso, and thus we do not care whether
;; it is efficiently compiled by ECL or not.
......@@ -260,6 +259,7 @@ FORM returns no value, NIL."
Evaluates INIT and binds the N-th VAR to the N-th value of INIT or, if INIT
returns less than N values, to NIL. Then evaluates FORMs, and returns all
values of the last FORM. If no FORM is given, returns NIL."
(declare (notinline mapcar))
`(multiple-value-call #'(lambda (&optional ,@(mapcar #'list vars)) ,@body) ,form))
(defun while-until (test body jmp-op)
......
......@@ -60,6 +60,7 @@
path)))
(defun search-help-file (key path &aux (pos 0))
(declare (ext:type-assertions nil))
(when (not (or (stringp key) (symbolp key)))
(return-from search-help-file nil))
(labels ((bin-search (file start end &aux (delta 0) (middle 0) sym)
......
......@@ -759,9 +759,9 @@ if not possible."
;; us in recognizing these supertypes.
;;
(defun update-types (type-mask new-tag)
(declare (ext:assume-no-errors))
(maybe-save-types)
(dolist (i *elementary-types*)
(declare (cons i))
(unless (zerop (logand (cdr i) type-mask))
(setf (cdr i) (logior new-tag (cdr i))))))
......@@ -851,7 +851,8 @@ if not possible."
(number-member-type object)))))
(defun simple-member-type (object)
(declare (si::c-local))
(declare (si::c-local)
(ext:assume-no-errors))
(let* ((tag (new-type-tag)))
(maybe-save-types)
(setq *member-types* (acons object tag *member-types*))
......@@ -871,7 +872,8 @@ if not possible."
(register-interval-type type))))
(defun push-type (type tag)
(declare (si::c-local))
(declare (si::c-local)
(ext:assume-no-errors))
(dolist (i *member-types*)
(declare (cons i))
(when (typep (car i) type)
......@@ -1264,7 +1266,8 @@ if not possible."
(push-type name tag))))))
(defun extend-type-tag (tag minimal-supertype-tag)
(declare (si::c-local))
(declare (si::c-local)
(ext:assume-no-errors))
(dolist (type *elementary-types*)
(let ((other-tag (cdr type)))
(when (zerop (logandc2 minimal-supertype-tag other-tag))
......@@ -1403,9 +1406,8 @@ if not possible."
(return-from subtypep (values (subclassp t1 t2) t)))
;; Finally, cached results.
(let* ((cache *subtypep-cache*)
(hash (logand (hash-eql t1 t2) 255))
(hash (the (integer 0 255) (logand (hash-eql t1 t2) 255)))
(elt (aref cache hash)))
(declare (type (integer 0 255) hash))
(when (and elt (eq (caar elt) t1) (eq (cdar elt) t2))
(setf elt (cdr elt))
(return-from subtypep (values (car elt) (cdr elt))))
......
......@@ -131,11 +131,7 @@ default value of INITIAL-ELEMENT depends on TYPE."
(setq sequence (sys:make-vector (if (eq element-type '*) T element-type)
size nil nil nil nil))
(when iesp
(do ((i 0 (1+ i))
(size size))
((>= i size))
(declare (fixnum i size))
(setf (elt sequence i) initial-element)))
(si::fill-array-with-elt sequence initial-element 0 nil))
(unless (or (eql length '*) (eql length size))
(error-sequence-length sequence type size))))
sequence))
......@@ -230,7 +226,7 @@ default value of INITIAL-ELEMENT depends on TYPE."
(let* ((final-length (if (eq length '*) (length object) length)))
(setf output (make-vector elt-type final-length nil nil nil 0))
(do ((i (make-seq-iterator object) (seq-iterator-next output i))
(j 0 (1+ j)))
(j 0 (the index (1+ j))))
((= j final-length)
(setf object output))
(declare (index j))
......
......@@ -47,11 +47,13 @@
(do-setf-method-expansion name setf-lambda args)))
(defun do-defsetf (access-fn function)
(declare (type-assertions nil))
(if (symbolp function)
(do-defsetf access-fn #'(lambda (store &rest args) `(,function ,@args ,store)))
(do-define-setf-method access-fn (setf-method-wrapper access-fn function))))
(defun do-define-setf-method (access-fn function)
(declare (type-assertions nil))
(put-sysprop access-fn 'SETF-METHOD function))
;;; DEFSETF macro.
......@@ -127,6 +129,7 @@ by (DOCUMENTATION 'SYMBOL 'SETF)."
"Args: (form)
Returns the 'five gangs' (see DEFINE-SETF-EXPANDER) for PLACE as five values.
Does not check if the third gang is a single-element list."
(declare (check-arguments-type nil))
;; Note that macroexpansion of SETF arguments can only be done via
;; MACROEXPAND-1 [ANSI 5.1.2.7]
(cond ((symbolp form)
......@@ -340,7 +343,8 @@ Does not check if the third gang is a single-element list."
;;; The expansion function for SETF.
(defun setf-expand-1 (place newvalue env)
(declare (si::c-local))
(declare (si::c-local)
(notinline mapcar))
(multiple-value-bind (vars vals stores store-form access-form)
(get-setf-expansion place env)
(cond ((trivial-setf-form place vars stores store-form access-form)
......@@ -396,6 +400,7 @@ Each PLACE may be any one of the following:
"Syntax: (psetf {place form}*)
Similar to SETF, but evaluates all FORMs first, and then assigns each value to
the corresponding PLACE. Returns NIL."
(declare (notinline mapcar))
(cond ((endp rest) nil)
((endp (cdr rest)) (error "~S is an illegal PSETF form." rest))
((endp (cddr rest))
......@@ -427,6 +432,7 @@ the corresponding PLACE. Returns NIL."
Saves the values of PLACE and FORM, and then assigns the value of each PLACE
to the PLACE on its left. The rightmost PLACE gets the value of FORM.
Returns the original value of the leftmost PLACE."
(declare (notinline mapcar))
(do ((r rest (cdr r))
(pairs nil)
(stores nil)
......@@ -457,6 +463,7 @@ Returns the original value of the leftmost PLACE."
Saves the values of PLACEs, and then assigns to each PLACE the saved value of
the PLACE to its right. The rightmost PLACE gets the value of the leftmost
PLACE. Returns NIL."
(declare (notinline mapcar))
(do ((r rest (cdr r))
(pairs nil)
(stores nil)
......@@ -521,7 +528,9 @@ retrieved by (DOCUMENTATION 'SYMBOL 'FUNCTION)."
) )
) )
(setq varlist (nreverse varlist))
`(DEFMACRO ,name (&ENVIRONMENT ENV %REFERENCE ,@lambdalist) ,docstring
`(DEFMACRO ,name (&ENVIRONMENT ENV %REFERENCE ,@lambdalist)
,@(and docstring (list docstring))
(DECLARE (NOTINLINE MAPCAR))
(MULTIPLE-VALUE-BIND (VARS VALS STORES SETTER GETTER)
(GET-SETF-EXPANSION %REFERENCE ENV)
(LET ((ALL-VARS (MAPCAR #'(LAMBDA (V) (LIST (GENSYM) V)) (LIST* ,@varlist ,restvar))))
......@@ -585,6 +594,7 @@ retrieved by (DOCUMENTATION 'SYMBOL 'FUNCTION)."
"Syntax: (remf place form)
Removes the property specified by FORM from the property list stored in PLACE.
Returns T if the property list had the specified property; NIL otherwise."
(declare (notinline mapcar))
(multiple-value-bind (vars vals stores store-form access-form)
(get-setf-expansion place env)
(let ((s (gensym)))
......@@ -607,6 +617,7 @@ Decrements the value of PLACE by the value of FORM. FORM defaults to 1.")
"Syntax: (push form place)
Evaluates FORM, conses the value of FORM to the value stored in PLACE, and
makes it the new value of PLACE. Returns the new value of PLACE."
(declare (notinline mapcar))
(multiple-value-bind (vars vals stores store-form access-form)
(get-setf-expansion place env)
(when (trivial-setf-form place vars stores store-form access-form)
......@@ -629,6 +640,7 @@ does nothing. Else, conses the value onto the list and makes the result the
new value of PLACE. Returns NIL. KEYWORD-FORMs and VALUE-FORMs are used to
check if the value of FORM is already in PLACE as if their values are passed
to MEMBER."
(declare (notinline mapcar))
(multiple-value-bind (vars vals stores store-form access-form)
(get-setf-expansion place env)
(when (trivial-setf-form place vars stores store-form access-form)
......@@ -649,6 +661,7 @@ to MEMBER."
"Syntax: (pop place)
Gets the cdr of the value stored in PLACE and makes it the new value of PLACE.
Returns the car of the old value in PLACE."
(declare (notinline mapcar))
(multiple-value-bind (vars vals stores store-form access-form)
(get-setf-expansion place env)
(let ((store-var (first stores)))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment