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

Diff of /gcl/cmpnew/gcl_collectfn.lsp

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

revision 1.4 by camm, Thu Sep 16 21:08:18 2004 UTC revision 1.5 by camm, Fri Jan 7 17:58:33 2005 UTC
# Line 63  Line 63 
63    
64  (defun emit-fn (flag) (setq *record-call-info* flag))  (defun emit-fn (flag) (setq *record-call-info* flag))
65    
66  (defun type-or (a b)  (defun promote-inlines (x)
67    (if (eq b '*) '*    (if (eq x 'inline) t
68      (case a      (if (si::memq x '(inline-fixnum fixnum-value)) 'fixnum
69        ((nil) b)        x)))
       ((t inline) t)  
       ((fixnum inline-fixnum fixnum-value) (if (eq b 'fixnum) 'fixnum  
                                              (type-or t b)))  
       (otherwise '*)  
       )))  
70    
71    (defun type-or (a b)
72      (let ((a (promote-inlines a)))
73        (if (type>= b a) b
74          (if (type>= a b) a
75            '*))))
76          
77  (defun current-fn ()  (defun current-fn ()
78    (cond ((and (consp *current-form*)    (cond ((and (consp *current-form*)
79                (member (car *current-form*) '(defun defmacro))                (member (car *current-form*) '(defun defmacro))

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5

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