190 |
) |
) |
191 |
|
|
192 |
|
|
193 |
(defun result-type-from-args (f args &aux tem) |
(defun result-type-from-args (f args) |
194 |
(when (and (setq tem (get f 'return-type)) |
(when (not (eq '* (get f 'return-type))) ;;FIXME make sure return-type and proclaimed-return-type are in sync |
|
(not (eq tem '*))) |
|
|
; (not (consp tem))) ;; propagate multiple-value types, CM 20041221 |
|
195 |
(let* ((be (get f 'type-propagator)) |
(let* ((be (get f 'type-propagator)) |
196 |
(ba (and be (apply be f (mapcar #'coerce-to-one-value args))))) |
(ba (and be (apply be f (mapcar #'coerce-to-one-value args))))) |
197 |
(when ba |
(when ba |
446 |
(cons (bind-all-vars (caddr form)) |
(cons (bind-all-vars (caddr form)) |
447 |
(if (cadddr form) (list (bind-all-vars (cadddr form)))))))) |
(if (cadddr form) (list (bind-all-vars (cadddr form)))))))) |
448 |
|
|
|
|
|
449 |
(defun c1symbol-fun (fname args &aux fd) |
(defun c1symbol-fun (fname args &aux fd) |
450 |
(cond ((setq fd (get fname 'c1special)) (funcall fd args)) |
(cond ((setq fd (get fname 'c1special)) (funcall fd args)) |
451 |
((and (setq fd (get fname 'co1special)) |
((and (setq fd (get fname 'co1special)) |
473 |
(setq forms (reverse fl))))) |
(setq forms (reverse fl))))) |
474 |
(list 'call-local info (cddr fd) forms)) |
(list 'call-local info (cddr fd) forms)) |
475 |
(c1expr (cmp-expand-macro fd fname args)))) |
(c1expr (cmp-expand-macro fd fname args)))) |
476 |
|
((let ((fn (get fname 'compiler-macro)) (res (cons fname args))) |
477 |
|
(and fn |
478 |
|
(let ((fd (cmp-eval `(funcall ',fn ',res nil)))) |
479 |
|
(and (not (eq res fd)) |
480 |
|
(c1expr fd)))))) |
481 |
((and (setq fd (get fname 'co1)) |
((and (setq fd (get fname 'co1)) |
482 |
(inline-possible fname) |
(inline-possible fname) |
483 |
(funcall fd fname args))) |
(funcall fd fname args))) |
499 |
;;continue |
;;continue |
500 |
((setq fd (macro-function fname)) |
((setq fd (macro-function fname)) |
501 |
(c1expr (cmp-expand-macro fd fname args))) |
(c1expr (cmp-expand-macro fd fname args))) |
|
((let ((fn (get fname 'compiler-macro)) res) |
|
|
(and fn |
|
|
(setq res (cons fname args)) |
|
|
(setq fd (cmp-eval `(funcall ',fn ',res nil))) |
|
|
(not (eq res fd)))) |
|
|
(c1expr fd)) |
|
502 |
((and (setq fd (get fname 'si::structure-access)) |
((and (setq fd (get fname 'si::structure-access)) |
503 |
(inline-possible fname) |
(inline-possible fname) |
504 |
;;; Structure hack. |
;;; Structure hack. |