/[cmucl]/src/compiler/checkgen.lisp
ViewVC logotype

Diff of /src/compiler/checkgen.lisp

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

revision 1.8 by ram, Tue May 22 13:14:58 1990 UTC revision 1.9 by ram, Fri Jun 1 13:43:03 1990 UTC
# Line 118  Line 118 
118                 *universal-type*)))))                 *universal-type*)))))
119    
120    
121    ;;; NO-FUNCTION-VALUES-TYPES  --  Internal
122    ;;;
123    ;;;    Like VALUES-TYPES, only mash any complex function types to FUNCTION.
124    ;;;
125    (defun no-function-values-types (type)
126      (declare (type ctype type))
127      (multiple-value-bind (res count)
128                           (values-types type)
129        (values (mapcar #'(lambda (type)
130                            (if (function-type-p type)
131                                (specifier-type 'function)
132                                type))
133                        res)
134                count)))
135    
136    
137  ;;; MAYBE-NEGATE-CHECK  --  Internal  ;;; MAYBE-NEGATE-CHECK  --  Internal
138  ;;;  ;;;
139  ;;;    Cont is a continuation we are doing a type check on and Types is a list  ;;;    Cont is a continuation we are doing a type check on and Types is a list
# Line 133  Line 149 
149  ;;;  ;;;
150  (defun maybe-negate-check (cont types)  (defun maybe-negate-check (cont types)
151    (declare (type continuation cont) (list types))    (declare (type continuation cont) (list types))
152    (multiple-value-bind (ptypes count)    (multiple-value-bind
153                         (values-types (continuation-proven-type cont))        (ptypes count)
154          (no-function-values-types (continuation-proven-type cont))
155      (if (eq count :unknown)      (if (eq count :unknown)
156          (if (every #'type-check-template types)          (if (every #'type-check-template types)
157              (values :simple types)              (values :simple types)
# Line 190  Line 207 
207          (dest (continuation-dest cont)))          (dest (continuation-dest cont)))
208      (assert (not (eq type *wild-type*)))      (assert (not (eq type *wild-type*)))
209      (multiple-value-bind (types count)      (multiple-value-bind (types count)
210                           (values-types type)                           (no-function-values-types type)
211        (cond ((not (eq count :unknown))        (cond ((not (eq count :unknown))
212               (maybe-negate-check cont types))               (maybe-negate-check cont types))
213              ((and (mv-combination-p dest)              ((and (mv-combination-p dest)

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

  ViewVC Help
Powered by ViewVC 1.1.5