1 |
|
;;-*-Lisp-*- |
2 |
;;; CMPENV Environments of the Compiler. |
;;; CMPENV Environments of the Compiler. |
3 |
;;; |
;;; |
4 |
;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa |
;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa |
157 |
((< i 9) |
((< i 9) |
158 |
(let ((tem |
(let ((tem |
159 |
(type-filter (car al)))) |
(type-filter (car al)))) |
160 |
(if (eq 'integer tem) t tem))) |
(if (is-local-arg-type tem) tem t))) |
161 |
(t (if (eq (car al) '*) '* t))) |
(t (if (eq (car al) '*) '* t))) |
162 |
types))) |
types))) |
163 |
;;only type t args for var arg so far. |
;;only type t args for var arg so far. |
185 |
return-types)) |
return-types)) |
186 |
(nreverse result)) |
(nreverse result)) |
187 |
(let ((tem (if (eq (car v) '*) '* (type-filter (car v))))) |
(let ((tem (if (eq (car v) '*) '* (type-filter (car v))))) |
188 |
(if (eq tem 'integer) (setq tem t)) |
(unless (or (eq tem '*) (is-local-arg-type tem)) (setq tem t)) |
189 |
(push tem result)))))) |
(push tem result)))))) |
190 |
|
|
191 |
(defun put-procls (fname arg-types return-types procl) |
(defun put-procls (fname arg-types return-types procl) |
333 |
(if (consp (cdr decl)) |
(if (consp (cdr decl)) |
334 |
(proclaim-var (cadr decl) (cddr decl)) |
(proclaim-var (cadr decl) (cddr decl)) |
335 |
(warn "The type declaration ~s is illegal." decl))) |
(warn "The type declaration ~s is illegal." decl))) |
|
((fixnum character short-float long-float) |
|
|
(proclaim-var (car decl) (cdr decl))) |
|
336 |
(ftype |
(ftype |
337 |
(cond ((and (consp (cdr decl)) |
(cond ((and (consp (cdr decl)) |
338 |
(consp (cadr decl)) |
(consp (cadr decl)) |
364 |
(unless (member x *alien-declarations*) |
(unless (member x *alien-declarations*) |
365 |
(push x *alien-declarations*)) |
(push x *alien-declarations*)) |
366 |
(warn "The declaration specifier ~s is not a symbol." x)))) |
(warn "The declaration specifier ~s is not a symbol." x)))) |
367 |
|
;;FIXME |
368 |
((array atom bignum bit bit-vector character common compiled-function |
((array atom bignum bit bit-vector character common compiled-function |
369 |
complex cons double-float fixnum float hash-table integer keyword list |
complex cons double-float fixnum float hash-table integer keyword list |
370 |
long-float nil null number package pathname random-state ratio rational |
long-float nil null number package pathname random-state ratio rational |
648 |
(return nil)) |
(return nil)) |
649 |
(warn "The variable name ~s is not a symbol." var)))) |
(warn "The variable name ~s is not a symbol." var)))) |
650 |
(warn "The type declaration ~s is illegal." decl))) |
(warn "The type declaration ~s is illegal." decl))) |
|
((fixnum character short-float long-float) |
|
|
(let ((type (type-filter (car decl))) |
|
|
x) |
|
|
(dolist** (var (cdr decl) t) |
|
|
(if (symbolp var) |
|
|
(unless (and (setq x (get var 'cmp-type)) (equal x type)) |
|
|
(return nil)) |
|
|
(warn "The variable name ~s is not a symbol." var))))) |
|
651 |
(ftype |
(ftype |
652 |
(if (or (endp (cdr decl)) |
(if (or (endp (cdr decl)) |
653 |
(not (consp (cadr decl))) |
(not (consp (cadr decl))) |