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

Diff of /gcl/cmpnew/gcl_cmplet.lsp

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

revision 1.7 by camm, Tue Dec 14 12:28:45 2004 UTC revision 1.8 by camm, Tue Dec 21 04:50:36 2004 UTC
# Line 113  Line 113 
113                           (and (symbolp proc) proc)))))                           (and (symbolp proc) proc)))))
114          (t t)))          (t t)))
115    
116    (defun coerce-to-one-value (type)
117      (if (and (consp type) (eq (car type) 'values))
118          (cadr type)
119        type))
120    
121  (defun binding-decls (bindings body star)  (defun binding-decls (bindings body star)
122    (cond ((atom bindings) nil)    (cond ((atom bindings) nil)
123          ((atom (car bindings)) (binding-decls (cdr bindings) body star))          ((atom (car bindings)) (binding-decls (cdr bindings) body star))
# Line 124  Line 129 
129                   (exp (and (consp (cadr bf)) (eq (caadr bf) 'the) (cadadr bf)))                   (exp (and (consp (cadr bf)) (eq (caadr bf) 'the) (cadadr bf)))
130                   (frt (and (consp (cadr bf))                   (frt (and (consp (cadr bf))
131                             (symbolp (caadr bf))                             (symbolp (caadr bf))
132                             (t-to-nil (fun-ret-type (cadr bf)))))                             (t-to-nil (coerce-to-one-value (fun-ret-type (cadr bf))))))
133                   (dec (var-is-declared var body))                   (dec (var-is-declared var body))
134                   (chb (var-is-changed var body))                   (chb (var-is-changed var body))
135                   (chc (and star (var-is-changed var (cdr bindings)))))                   (chc (and star (var-is-changed var (cdr bindings)))))

Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8

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