Changeset 14993 in project for chicken/trunk/scrutinizer.scm


Ignore:
Timestamp:
06/14/09 21:56:10 (11 years ago)
Author:
felix winkelmann
Message:

scrutinizer: types.db fixes; noreturn propagates so value-count check in conditional doesn't fail

File:
1 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/scrutinizer.scm

    r14874 r14993  
    238238                                     (cond ((and (pair? t) (eq? 'or (car t)))
    239239                                            (cdr t))
    240                                            ((eq? 'noreturn t) '())
     240                                           ;((eq? t 'noreturn) '())
    241241                                           ((eq? t 'undefined) (return 'undefined))
    242242                                           (else (list t)))))
     
    280280                 (else '(#!rest))))
    281281          ((eq? '#!rest (car ts1))
    282            (cond ((eq? '#!rest (car ts2))
     282           (cond ((and (pair? ts2) (eq? '#!rest (car ts2)))
    283283                  `(#!rest
    284284                    ,(simplify
     
    287287                 (else '(#!rest))))             ;XXX giving up
    288288          ((eq? '#!optional (car ts1))
    289            (cond ((eq? '#!optional (car ts2))
     289           (cond ((and (pair? ts2) (eq? '#!optional (car ts2)))
    290290                  `(#!optional
    291291                    ,(simplify `(or ,(cadr ts1) ,(cadr ts2)))
     
    546546                      (else (cons (car rt) (loop (cdr rt)))))))))
    547547          (else (bomb "not a procedure type: ~a" t))))
     548  (define (noreturn-type? t)
     549    (or (eq? 'noreturn t)
     550        (and (pair? t)
     551             (eq? 'or (car t))
     552             (any noreturn-type? (cdr t)))))
    548553  (define (walk n e loc dest)           ; returns result specifier
    549554    (let ((subs (node-subexpressions n))
     
    562567                       (let ((r1 (walk (second subs) e loc dest))
    563568                             (r2 (walk (third subs) e loc dest)))
    564                          (cond ((and (not (eq? r1 '*)) (not (eq? '* r2)))
    565                                 (when (not (= (length r1) (length r2)))
     569                         (cond ((and (not (eq? r1 '*))
     570                                     (not (eq? '* r2)) )
     571                                (when (and (not (any noreturn-type? r1))
     572                                           (not (any noreturn-type? r2))
     573                                           (not (= (length r1) (length r2))))
    566574                                  (report
    567575                                   loc
Note: See TracChangeset for help on using the changeset viewer.