mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-17 14:51:20 -08:00
Code Issues Projects Releases Packages Wiki Activity

PROPAGATE-TYPES understands complex function types

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2008-09-01 21:01:53 +02:00
parent e99db7acd5
commit 1abaeeec6f
2 changed files with 23 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

2
src/cmp/cmpenv.lsp
View file

@ -156,7 +156,7 @@
with minarg = 0
and maxarg = 0
and in-optionals = nil
do (cond ((member type '(* &rest &key &allow-other-keys))
do (cond ((member type '(* &rest &key &allow-other-keys) :test #'eq)
(return (values minarg call-arguments-limit)))
((eq type '&optional)
(setf in-optionals t maxarg minarg))

31
src/cmp/cmptype.lsp
View file

@ -388,22 +388,35 @@
fname
forms)
(when arg-types
(do ((fl forms (rest fl))
(al lisp-forms (rest al))
(i 1 (1+ i)))
((endp fl))
(unless (endp arg-types)
;; Check the type of the arguments.
(do* ((types arg-types (rest types))
(fl forms (rest fl))
(al lisp-forms (rest al))
(i 1 (1+ i))
(in-optionals nil))
((endp types)
(when types
(cmpwarn "Too many arguments passed to ~A" fname)))
(let ((expected-type (first types)))
(when (member expected-type '(* &rest &key &allow-other-keys) :test #'eq)
(return))
(when (eq expected-type '&optional)
(when in-optionals
(cmpwarn "Syntax error in type proclamation for function ~A.~&~A"
fname arg-types))
(setf in-optionals t))
(when (endp fl)
(unless in-optionals
(cmpwarn "Too few arguments for proclaimed function ~A" fname))
(return))
(let* ((form (first fl))
(lisp-form (first al))
(expected-type (pop arg-types))
(old-type (c1form-type form)))
(old-type (c1form-type form)))
(and-form-type expected-type form lisp-form
:safe "In the argument ~d of a call to ~a" i fname)
;; In safe mode, we cannot assume that the type of the
;; argument is going to be the right one.
(unless (zerop (cmp-env-optimization 'safety))
(setf (c1form-type form) old-type))))))
(setf (c1form-type form) old-type))))))
return-type))
(defmacro def-type-propagator (fname lambda-list &body body)