Changeset 13782 in project for chicken


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

argc check and assignment handling for local vars

Location:
chicken/branches/scrutiny
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • chicken/branches/scrutiny/rules.make

    r13191 r13782  
    5151
    5252COMPILER_OBJECTS_1 = \
    53        chicken batch-driver compiler optimizer support \
     53       chicken batch-driver compiler optimizer scrutinizer support \
    5454       c-platform c-backend
    5555COMPILER_OBJECTS        = $(COMPILER_OBJECTS_1:=$(O))
     
    584584          $(C_COMPILER_COMPILE_OPTION) $(C_COMPILER_OPTIMIZATION_OPTIONS) $(C_COMPILER_SHARED_OPTIONS) $< \
    585585          $(C_COMPILER_OUTPUT)
     586scrutinizer$(O): scrutinizer.c chicken.h $(CHICKEN_CONFIG_H)
     587        $(C_COMPILER) $(C_COMPILER_OPTIONS) $(C_COMPILER_PTABLES_OPTIONS) $(INCLUDES) \
     588          $(C_COMPILER_COMPILE_OPTION) $(C_COMPILER_OPTIMIZATION_OPTIONS) $(C_COMPILER_SHARED_OPTIONS) $< \
     589          $(C_COMPILER_OUTPUT)
    586590chicken$(O): chicken.c chicken.h $(CHICKEN_CONFIG_H)
    587591        $(C_COMPILER) $(C_COMPILER_OPTIONS) $(C_COMPILER_PTABLES_OPTIONS) $(INCLUDES) \
     
    624628          $(C_COMPILER_COMPILE_OPTION) $(C_COMPILER_OPTIMIZATION_OPTIONS) $< $(C_COMPILER_OUTPUT)
    625629optimizer-static$(O): optimizer.c chicken.h $(CHICKEN_CONFIG_H)
     630        $(C_COMPILER) $(C_COMPILER_OPTIONS) $(C_COMPILER_PTABLES_OPTIONS) $(INCLUDES) \
     631          $(C_COMPILER_STATIC_OPTIONS) \
     632          $(C_COMPILER_COMPILE_OPTION) $(C_COMPILER_OPTIMIZATION_OPTIONS) $< $(C_COMPILER_OUTPUT)
     633scrutinizer-static$(O): scrutinizer.c chicken.h $(CHICKEN_CONFIG_H)
    626634        $(C_COMPILER) $(C_COMPILER_OPTIONS) $(C_COMPILER_PTABLES_OPTIONS) $(INCLUDES) \
    627635          $(C_COMPILER_STATIC_OPTIONS) \
     
    11931201optimizer.c: $(SRCDIR)optimizer.scm $(SRCDIR)private-namespace.scm $(SRCDIR)tweaks.scm
    11941202        $(CHICKEN) $< $(CHICKEN_COMPILER_OPTIONS) -output-file $@
     1203scrutinizer.c: $(SRCDIR)scrutinzer.scm $(SRCDIR)private-namespace.scm $(SRCDIR)tweaks.scm
     1204        $(CHICKEN) $< $(CHICKEN_COMPILER_OPTIONS) -output-file $@
    11951205batch-driver.c: $(SRCDIR)batch-driver.scm $(SRCDIR)private-namespace.scm $(SRCDIR)tweaks.scm
    11961206        $(CHICKEN) $< $(CHICKEN_COMPILER_OPTIONS) -output-file $@
     
    12341244        usrfi-18.c usrfi-69.c uposixunix.c uposixwin.c uregex.c \
    12351245        chicken-profile.c chicken-install.c chicken-uninstall.c chicken-status.c \
    1236         csc.c csi.c chicken.c batch-driver.c compiler.c optimizer.c support.c \
     1246        csc.c csi.c chicken.c batch-driver.c compiler.c optimizer.c scrutinizer.c support.c \
    12371247        c-platform.c c-backend.c chicken-bug.c $(IMPORT_LIBRARIES:=.import.c)
    12381248
     
    12731283          usrfi-18.c usrfi-69.c uposixunix.c uposixwin.c uregex.c chicken-profile.c chicken-bug.c \
    12741284          csc.c csi.c chicken-install.c chicken-uninstall.c chicken-status.c \
    1275           chicken.c batch-driver.c compiler.c optimizer.c support.c \
     1285          chicken.c batch-driver.c compiler.c optimizer.c scrutinizer.c support.c \
    12761286          c-platform.c c-backend.c \
    12771287          $(IMPORT_LIBRARIES:=.import.c)
  • 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.