1 |
|
;;-*-Lisp-*- |
2 |
;;; CMPCALL Function call. |
;;; CMPCALL Function call. |
3 |
;;; |
;;; |
4 |
;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa |
;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa |
27 |
|
|
28 |
(eval-when (compile eval) |
(eval-when (compile eval) |
29 |
(defmacro link-arg-p (x) |
(defmacro link-arg-p (x) |
30 |
`(let ((.u ,x)) |
`(or (is-global-arg-type ,x) (not (is-local-arg-type ,x))))) |
|
(not (member .u '(character boolean long-float short-float))))) |
|
|
) |
|
31 |
|
|
32 |
(defun fast-link-proclaimed-type-p (fname &optional args) |
(defun fast-link-proclaimed-type-p (fname &optional args) |
33 |
(and |
(and |
261 |
*do-tail-recursion* |
*do-tail-recursion* |
262 |
*tail-recursion-info* |
*tail-recursion-info* |
263 |
(eq (car *tail-recursion-info*) fname) |
(eq (car *tail-recursion-info*) fname) |
264 |
(member *exit* |
(or (eq *exit* 'return) |
265 |
'(RETURN RETURN-FIXNUM RETURN-CHARACTER RETURN-SHORT-FLOAT |
(rassoc *exit* +return-alist+)) |
|
RETURN-LONG-FLOAT RETURN-OBJECT)) |
|
266 |
(tail-recursion-possible) |
(tail-recursion-possible) |
267 |
(= (length args) (length (cdr *tail-recursion-info*)))) |
(= (length args) (length (cdr *tail-recursion-info*)))) |
268 |
(let* ((*value-to-go* 'trash) |
(let* ((*value-to-go* 'trash) |