Ignore:
Timestamp:
03/16/09 13:07:00 (11 years ago)
Author:
felix winkelmann
Message:

argc check and assignment handling for local vars

File:
1 edited

Legend:

Unmodified
Added
Removed
  • chicken/branches/scrutiny/scrutinizer.scm

    r13755 r13782  
    108108          (else '*)))
    109109  (define (variable-result id e)
    110     (cond ((assq id e) =>
     110    (cond ((get db id 'assigned) '*)
     111          ((assq id e) =>
    111112           (lambda (a) (list (cdr a))))
    112113          (else (global-result id e))))
     
    250251             (first tv)))))
    251252  (define (call-result args e loc)
    252     (let ((ptype (car args)))
     253    (let ((ptype (car args))
     254          (nargs (length (cdr args))))
    253255      (check
    254256       `(procedure ,(make-list (length (sub1 args)) '*) '*)
    255257       ptype
    256258       loc "a procedure")
    257       (for-each
    258        (lambda (arg argt)
    259          (check argt arg loc "argument") )
    260        (procedure-argument-types ptype (length (cdr args)))
    261        (cdr args))
    262       (procedure-result-type ptype)))
     259      (let ((atypes (procedure-argument-types ptype (length (cdr args)))))
     260        (unless (= (length atypes) nargs)
     261          (report
     262           loc
     263           (sprintf "~a arguments" nargs)
     264           (sprintf "~a arguments" (length atypes))
     265           "procedure call"))
     266        (for-each
     267         (lambda (arg argt)
     268           (check argt arg loc "argument") )
     269         atypes
     270         (cdr args))
     271        (procedure-result-type ptype))))
    263272  (define (procedure-argument-types t n)
    264273    (cond ((or (memq t '(* procedure))
Note: See TracChangeset for help on using the changeset viewer.