/[gcl]/gcl/cmpnew/gcl_cmpenv.lsp
ViewVC logotype

Diff of /gcl/cmpnew/gcl_cmpenv.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.13 by camm, Fri Jun 10 15:05:03 2005 UTC revision 1.14 by camm, Fri Jul 8 06:02:47 2005 UTC
# Line 1  Line 1 
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
# Line 156  Line 157 
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.
# Line 184  Line 185 
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)
# Line 332  Line 333 
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))
# Line 365  Line 364 
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
# Line 648  Line 648 
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)))

Legend:
Removed from v.1.13  
changed lines
  Added in v.1.14

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26