~ chicken-core (chicken-5) 1e78858365295e0807646eff12edba9634ccbc1f
commit 1e78858365295e0807646eff12edba9634ccbc1f
Author: felix <bunny351@gmail.com>
AuthorDate: Wed May 26 13:41:13 2010 +0200
Commit: felix <bunny351@gmail.com>
CommitDate: Wed May 26 13:41:13 2010 +0200
- compiler gives notice about assigned globals that are externally visible and
declared unsafe
- procedure check and global-access or done as C_inline functions
- use `safe-globals' instead of `no-procedure-checks-for-toplevel-bindings'
(still this is somewhat unsafe)
- compiler and interpreter gives notice about assignment to imported value binding
- documented `safe-globals' declaration
- disabled notice about dropped toplevel assignments
- fixed invalid calls to `##sys#stat' in posixwin.scm
- DATADIR wasn't always created on install
- various trivial fixes
- tests/benchmarks use more aggressive optimization options
diff --git a/batch-driver.scm b/batch-driver.scm
index edc83333..d7bb607e 100644
--- a/batch-driver.scm
+++ b/batch-driver.scm
@@ -591,6 +591,7 @@
(let ((f inline-output-file))
(dribble "Generating global inline file `~a' ..." f)
(emit-global-inline-file f db) ) )
+ (check-for-unsafe-toplevel-procedure-calls node2 db)
(begin-time)
(set! node2 (perform-closure-conversion node2 db))
(end-time "closure conversion")
diff --git a/c-backend.scm b/c-backend.scm
index 6b6c2323..916a87df 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -191,7 +191,7 @@
(gen "lf[" index "]")
(gen "C_retrieve2(lf[" index "]," (c-ify-string (symbol->string (fourth params))) #\)) ) ]
[safe (gen "*((C_word*)lf[" index "]+1)")]
- [else (gen "C_retrieve(lf[" index "])")] ) ) )
+ [else (gen "C_fast_retrieve(lf[" index "])")] ) ) )
((##core#setglobal)
(let ((index (first params))
@@ -287,17 +287,17 @@
(block
(set! carg (string-append "lf[" (number->string index) "]"))
(if safe
- (gen "C_retrieve_proc(" carg ")")
+ (gen "C_fast_retrieve_proc(" carg ")")
(gen "C_retrieve2_symbol_proc(" carg ","
(c-ify-string (symbol->string (fourth gparams))) #\)) ) )
(safe
(set! carg
(string-append "*((C_word*)lf[" (number->string index) "]+1)"))
- (gen "C_retrieve_proc(" carg ")"))
+ (gen "C_fast_retrieve_proc(" carg ")"))
(else
(set! carg
(string-append "*((C_word*)lf[" (number->string index) "]+1)"))
- (gen "C_retrieve_symbol_proc(lf[" index "])") ))
+ (gen "C_fast_retrieve_symbol_proc(lf[" index "])") ))
(gen ")(" nf #\, carg #\,)
(expr-args args i)
(gen ");") ) )
@@ -308,7 +308,7 @@
"((C_proc" nf ")")
(if (or unsafe no-procedure-checks (first params))
(gen "(void*)(*((C_word*)t" nc "+1))")
- (gen "C_retrieve_proc(t" nc ")") )
+ (gen "C_fast_retrieve_proc(t" nc ")") )
(gen ")(" nf ",t" nc #\,)
(expr-args args i)
(gen ");") ) ) ) )
diff --git a/chicken.h b/chicken.h
index bb7c8d94..7bd068f4 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1576,6 +1576,7 @@ C_fctexport C_word C_fcall C_mutate(C_word *slot, C_word val) C_regparm;
C_fctexport void C_fcall C_reclaim(void *trampoline, void *proc) C_regparm C_noret;
C_fctexport void C_save_and_reclaim(void *trampoline, void *proc, int n, ...) C_noret;
C_fctexport void C_fcall C_rereclaim2(C_uword size, int double_plus) C_regparm;
+C_fctexport void C_unbound_variable(C_word sym);
C_fctexport C_word C_fcall C_retrieve(C_word sym) C_regparm;
C_fctexport C_word C_fcall C_retrieve2(C_word val, char *name) C_regparm;
C_fctexport void *C_fcall C_retrieve_proc(C_word closure) C_regparm;
@@ -1623,6 +1624,7 @@ C_fctexport void C_use_private_repository(C_char *path);
C_fctexport C_char *C_private_repository_path();
C_fctimport void C_ccall C_toplevel(C_word c, C_word self, C_word k) C_noret;
+C_fctimport void C_ccall C_invalid_procedure(int c, C_word self, ...) C_noret;
C_fctexport void C_ccall C_stop_timer(C_word c, C_word closure, C_word k) C_noret;
C_fctexport void C_ccall C_apply(C_word c, C_word closure, C_word k, C_word fn, ...) C_noret;
C_fctexport void C_ccall C_do_apply(C_word n, C_word closure, C_word k) C_noret;
@@ -2215,6 +2217,35 @@ C_inline C_word C_u_i_assq(C_word x, C_word lst)
}
+C_inline C_word
+C_fast_retrieve(C_word sym)
+{
+ C_word val = C_block_item(sym, 0);
+
+ if(val == C_SCHEME_UNBOUND)
+ C_unbound_variable(sym);
+
+ return val;
+}
+
+
+C_inline void *
+C_fast_retrieve_proc(C_word closure)
+{
+ if(C_immediatep(closure) || C_header_bits(closure) != C_CLOSURE_TYPE)
+ return (void *)C_invalid_procedure;
+ else
+ return (void *)C_block_item(closure, 0);
+}
+
+
+C_inline void *
+C_fast_retrieve_symbol_proc(C_word sym)
+{
+ return C_fast_retrieve_proc(C_fast_retrieve(sym));
+}
+
+
#ifdef C_PRIVATE_REPOSITORY
# if defined(C_MACOSX) && defined(C_GUI)
# include <CoreFoundation/CoreFoundation.h>
diff --git a/common-declarations.scm b/common-declarations.scm
index 4b197173..65665bb3 100644
--- a/common-declarations.scm
+++ b/common-declarations.scm
@@ -1,6 +1,6 @@
;;;; common-declarations.scm - settings for core libraries
;
-; Copyright (c) 2008-2010, The Chicken Team
+; Copyright (c) 2010, The Chicken Team
; All rights reserved.
;
; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following
@@ -38,8 +38,8 @@
(apply print arg1 more)))))
(else
(declare
- (no-bound-checks)
- (no-procedure-checks-for-toplevel-bindings))
+ (safe-globals)
+ (no-bound-checks))
(define-syntax d (syntax-rules () ((_ . _) (void))))))
(define-syntax define-alias
diff --git a/compiler-namespace.scm b/compiler-namespace.scm
index 6a419c99..5f869cf8 100644
--- a/compiler-namespace.scm
+++ b/compiler-namespace.scm
@@ -44,6 +44,7 @@
canonicalize-begin-body
canonicalize-expression
check-and-open-input-file
+ check-for-unsafe-toplevel-procedure-calls
check-signature
chop-extension
chop-separator
diff --git a/compiler.scm b/compiler.scm
index b2557671..254982e9 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -59,7 +59,6 @@
; (inline-limit <limit>)
; (keep-shadowed-macros)
; (lambda-lift)
-; (link-options {<opt>})
; (no-argc-checks)
; (no-bound-checks)
; (no-procedure-checks)
@@ -921,17 +920,17 @@
(when safe-globals-flag
(mark-variable var '##compiler#always-bound-to-procedure)
(mark-variable var '##compiler#always-bound)))
- (when (##sys#macro? var)
- (compiler-warning
- 'var "assigned global variable `~S' is a macro ~A"
- var
- (if ln (sprintf "(~a)" ln) "") )
- (when undefine-shadowed-macros (##sys#undefine-macro! var) ) )
+ (cond ((##sys#macro? var)
+ (compiler-warning
+ 'var "assigned global variable `~S' is syntax ~A"
+ var
+ (if ln (sprintf "(~a)" ln) "") )
+ (when undefine-shadowed-macros (##sys#undefine-macro! var) ) )
+ ((and ##sys#notices-enabled
+ (assq var (##sys#current-environment)))
+ (##sys#notice "assignment to imported value binding" var)))
(when (keyword? var)
(compiler-warning 'syntax "assignment to keyword `~S'" var) )
- (when (pair? var) ; macro
- (syntax-error
- 'set! "assignment to syntactic identifier" var))
`(set! ,var ,(walk val e se var0))))))
((##core#inline)
@@ -1372,7 +1371,7 @@
[(interrupts-enabled) (set! insert-timer-checks #f)]
[(safe) (set! unsafe #t)]
[else (compiler-warning 'syntax "illegal declaration specifier `~s'" id)]))]))
- ((compile-syntax )
+ ((compile-syntax)
(set! ##sys#enable-runtime-macros #t))
((block-global hide)
(let ([syms (stripa (cdr spec))])
@@ -1682,8 +1681,8 @@
;;; Perform source-code analysis:
(define (analyze-expression node)
- (let ([db (make-vector analysis-database-size '())]
- [explicitly-consed '()] )
+ (let ((db (make-vector analysis-database-size '()))
+ (explicitly-consed '()) )
(define (grow n)
(set! current-program-size (+ current-program-size n)) )
@@ -1706,7 +1705,7 @@
((not (get db var 'global))
(put! db var 'global #t) ) ) ) ) )
- ((##core#global-ref)
+ ((##core#global-ref) ; not really needed anymore
(let ((var (first params)))
(ref var n)
(grow 1)
@@ -1720,7 +1719,7 @@
(grow 1)
(let ([fun (car subs)])
(when (eq? '##core#variable (node-class fun))
- (let ([name (first (node-parameters fun))])
+ (let ((name (first (node-parameters fun))))
(collect! db name 'call-sites (cons here n))))
(walk (first subs) env localenv here #t)
(walkeach (cdr subs) env localenv here #f) ) )
@@ -1778,8 +1777,8 @@
(set-car! (cdddr (node-parameters n)) (- current-program-size size0)) ) ) ) ) )
((set! ##core#set!)
- (let* ([var (first params)]
- [val (car subs)] )
+ (let* ((var (first params))
+ (val (car subs)) )
(when first-analysis
(case (variable-mark var '##compiler#intrinsic)
((standard)
@@ -1799,7 +1798,7 @@
(walk (car subs) env localenv here #f) ) )
((##core#primitive ##core#inline)
- (let ([id (first params)])
+ (let ((id (first params)))
(when (and first-analysis here (symbol? id) (##sys#hash-table-ref real-name-table id))
(set-real-name! id here) )
(walkeach subs env localenv here #f) ) )
@@ -2064,9 +2063,45 @@
;; Set original program-size, if this is the first analysis-pass:
(unless original-program-size
(set! original-program-size current-program-size) )
+
+ ;; return database
db) )
+;;; Collect unsafe global procedure calls that are assigned:
+
+(define (check-for-unsafe-toplevel-procedure-calls node db)
+ (let ((procs '()))
+
+ (define (walk n)
+ (let ((subs (node-subexpressions n))
+ (params (node-parameters n))
+ (class (node-class n)) )
+ (case class
+ ((##core#call)
+ (let ((fun (first subs)))
+ (when (memq (node-class fun) '(##core#variable ##core#global-ref))
+ (let ((name (first (node-parameters fun))))
+ (when (and ##sys#notices-enabled
+ (get db name 'global)
+ (get db name 'assigned)
+ (or no-global-procedure-checks
+ (variable-mark name '##compiler#always-bound-to-procedure))
+ (not unsafe))
+ (set! procs (lset-adjoin eq? procs name))))))
+ (for-each walk subs))
+ (else (for-each walk subs)))))
+
+ (when ##sys#notices-enabled
+ (walk node)
+ (when (pair? procs)
+ (##sys#notice
+ "the following non-intrinsic global procedures where declared to be safe but are externally visible:")
+ (newline (current-error-port))
+ (for-each (cute fprintf (current-error-port) " ~S~%" <>) procs)
+ (flush-output (current-error-port))))))
+
+
;;; Convert closures to explicit data structures (effectively flattens function-binding structure):
(define (perform-closure-conversion node db)
diff --git a/eval.scm b/eval.scm
index 60b0acd0..1fe54b48 100644
--- a/eval.scm
+++ b/eval.scm
@@ -357,13 +357,18 @@
(receive (i j) (lookup var e se)
(let ((val (compile (caddr x) e var tf cntr se)))
(cond [(not i)
+ (when ##sys#notices-enabled
+ (and-let* ((a (assq var (##sys#current-environment)))
+ ((symbol? (cdr a))))
+ (##sys#notice "assignment to imported value binding" var)))
(let ((var (##sys#alias-global-hook j #t)))
(if ##sys#eval-environment
(let ([loc (##sys#hash-table-location
##sys#eval-environment
var
##sys#environment-is-mutable) ] )
- (unless loc (##sys#error "assignment of undefined identifier" var))
+ (unless loc
+ (##sys#error "assignment to undefined identifier" var))
(if (##sys#slot loc 2)
(lambda (v) (##sys#setslot loc 1 (##core#app val v)))
(lambda v (##sys#error "assignment to immutable variable" var)) ) )
diff --git a/manual/Declarations b/manual/Declarations
index b59b0db6..96e417e6 100644
--- a/manual/Declarations
+++ b/manual/Declarations
@@ -262,6 +262,15 @@ Equivalent to the compiler option of the same name - macros defined in the compi
runtime.
+=== safe-globals
+
+ [declaration specifier] (safe-globals)
+
+Assumes variables assigned in the current compilation unit are always bound and
+that any calls to these variables can always be assumed to be calls to proper
+procedures.
+
+
=== scrutinize
[declaration specifier] (scrutinize)
diff --git a/optimizer.scm b/optimizer.scm
index b50f8bae..5d287621 100644
--- a/optimizer.scm
+++ b/optimizer.scm
@@ -90,7 +90,8 @@
(scan val e)
(let ((p (alist-ref var previous)))
(when (and p (not (memq var unsafe)))
- (##sys#notice
+ ;; disabled for the moment - this doesn't really look like it's helpful
+ #;(##sys#notice
(sprintf "dropping assignment of unused value to global variable `~s'"
var))
(copy-node!
diff --git a/posixunix.scm b/posixunix.scm
index 87ffe1ad..837487ef 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -751,7 +751,8 @@ EOF
(if link
(##core#inline "C_lstat" path)
(##core#inline "C_stat" path) ) ) ]
- [else (##sys#signal-hook #:type-error "bad argument type - not a fixnum or string" file)] ) ] )
+ [else
+ (##sys#signal-hook #:type-error loc "bad argument type - not a fixnum or string" file)] ) ] )
(when (fx< r 0)
(posix-error #:file-error loc "cannot access file" file) ) ) )
diff --git a/posixwin.scm b/posixwin.scm
index 4cb9461e..1c2150a3 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -1070,16 +1070,17 @@ EOF
(define-foreign-variable _stat_st_uid unsigned-int "C_statbuf.st_uid")
(define-foreign-variable _stat_st_mode unsigned-int "C_statbuf.st_mode")
-(define (##sys#stat file)
+(define (##sys#stat file link loc) ; link is ignored
(let ([r (cond [(fixnum? file) (##core#inline "C_fstat" file)]
[(string? file) (##core#inline "C_stat" (##sys#make-c-string (##sys#expand-home-path file)))]
- [else (##sys#signal-hook #:type-error "bad argument type - not a fixnum or string" file)] ) ] )
+ [else
+ (##sys#signal-hook #:type-error loc "bad argument type - not a fixnum or string" file)] ) ] )
(when (fx< r 0)
(##sys#update-errno)
- (##sys#signal-hook #:file-error "cannot access file" file) ) ) )
+ (##sys#signal-hook #:file-error loc "cannot access file" file) ) ) )
(define (file-stat f #!optional link)
- (##sys#stat f)
+ (##sys#stat f #f 'file-stat)
(vector _stat_st_ino _stat_st_mode _stat_st_nlink
_stat_st_uid _stat_st_gid _stat_st_size
_stat_st_atime _stat_st_ctime _stat_st_mtime
diff --git a/rules.make b/rules.make
index ceaf32c9..d0d146cd 100644
--- a/rules.make
+++ b/rules.make
@@ -621,6 +621,7 @@ install-dev: install-libs
$(MAKEDIR_COMMAND) $(MAKEDIR_COMMAND_OPTIONS) "$(DESTDIR)$(ISHAREDIR)"
$(MAKEDIR_COMMAND) $(MAKEDIR_COMMAND_OPTIONS) "$(DESTDIR)$(IEGGDIR)"
$(MAKEDIR_COMMAND) $(MAKEDIR_COMMAND_OPTIONS) "$(DESTDIR)$(IINCDIR)"
+ $(MAKEDIR_COMMAND) $(MAKEDIR_COMMAND_OPTIONS) "$(DESTDIR)$(IDATADIR)"
$(INSTALL_PROGRAM) $(INSTALL_PROGRAM_STATIC_LIBRARY_OPTIONS) libchicken$(A) "$(DESTDIR)$(ILIBDIR)"
ifneq ($(POSTINSTALL_STATIC_LIBRARY),true)
$(POSTINSTALL_STATIC_LIBRARY) $(POSTINSTALL_STATIC_LIBRARY_FLAGS) "$(ILIBDIR)$(SEP)libchicken$(A)"
diff --git a/runtime.c b/runtime.c
index e0b732e0..4540c848 100644
--- a/runtime.c
+++ b/runtime.c
@@ -3485,14 +3485,16 @@ void handle_interrupt(void *trampoline, void *proc)
}
-C_regparm C_word C_fcall C_retrieve(C_word sym)
+void
+C_unbound_variable(C_word sym)
{
- C_word val = C_block_item(sym, 0);
+ barf(C_UNBOUND_VARIABLE_ERROR, NULL, sym);
+}
- if(val == C_SCHEME_UNBOUND)
- barf(C_UNBOUND_VARIABLE_ERROR, NULL, sym);
- return val;
+C_regparm C_word C_fcall C_retrieve(C_word sym) /* OBSOLETE */
+{
+ return C_fast_retrieve(sym);
}
@@ -3506,17 +3508,22 @@ C_regparm C_word C_fcall C_retrieve2(C_word val, char *name)
/* this is ok: we won't return from `C_retrieve2'
* (or the value isn't needed). */
p = C_alloc(C_SIZEOF_STRING(len));
- barf(C_UNBOUND_VARIABLE_ERROR, NULL, C_string2(&p, name));
+ C_unbound_variable(C_string2(&p, name));
}
return val;
}
-static C_word resolve_procedure(C_word closure, C_char *where)
+void C_ccall
+C_invalid_procedure(int c, C_word self, ...)
{
- C_word s;
+ barf(C_NOT_A_CLOSURE_ERROR, NULL, self);
+}
+
+static C_word resolve_procedure(C_word closure, C_char *where) /* OBSOLETE */
+{
if(C_immediatep(closure) || C_header_bits(closure) != C_CLOSURE_TYPE) {
barf(C_NOT_A_CLOSURE_ERROR, where, closure);
}
@@ -3525,29 +3532,25 @@ static C_word resolve_procedure(C_word closure, C_char *where)
}
-C_regparm void *C_fcall C_retrieve_proc(C_word closure)
+C_regparm void *C_fcall C_retrieve_proc(C_word closure) /* OBSOLETE */
{
- closure = resolve_procedure(closure, NULL);
- return (void *)C_block_item(closure, 0);
+ return C_fast_retrieve_proc(closure);
}
-C_regparm void *C_fcall C_retrieve_symbol_proc(C_word sym)
+C_regparm void *C_fcall C_retrieve_symbol_proc(C_word sym) /* OBSOLETE */
{
C_word val = C_block_item(sym, 0);
- C_word closure;
if(val == C_SCHEME_UNBOUND)
barf(C_UNBOUND_VARIABLE_ERROR, NULL, sym);
- closure = resolve_procedure(val, NULL);
- return (void *)C_block_item(closure, 0);
+ return C_fast_retrieve_proc(val);
}
C_regparm void *C_fcall C_retrieve2_symbol_proc(C_word val, char *name)
{
- C_word closure;
C_word *p;
int len;
@@ -3558,8 +3561,7 @@ C_regparm void *C_fcall C_retrieve2_symbol_proc(C_word val, char *name)
barf(C_UNBOUND_VARIABLE_ERROR, NULL, C_string2(&p, name));
}
- closure = resolve_procedure(val, NULL);
- return (void *)C_block_item(closure, 0);
+ return C_fast_retrieve_proc(val);
}
diff --git a/tests/runbench.sh b/tests/runbench.sh
index e1e675f6..95c8a1d9 100644
--- a/tests/runbench.sh
+++ b/tests/runbench.sh
@@ -10,6 +10,7 @@ export DYLD_LIBRARY_PATH=${TEST_DIR}/..
export LD_LIBRARY_PATH=${TEST_DIR}/..
CHICKEN=../chicken
+COMPILE_OPTIONS="-O5 -d0 -disable-interrupts -b"
if test -n "$MSYSTEM"; then
CHICKEN="..\\chicken.exe"
@@ -31,31 +32,31 @@ run()
echo
compiler_options="-C -Wa,-W"
-compile="../csc -w -compiler $CHICKEN -I.. -L.. -include-path .. -o a.out $compiler_options"
+compile="../csc -w -compiler $CHICKEN -I.. -L.. -include-path .. -o a.out $COMPILE_OPTIONS"
echo -n "null ... "
$compile null.scm -O5
run
echo -n "compilation ... "
-/usr/bin/time $timeopts $compile compiler.scm -O5
+/usr/bin/time $timeopts $compile compiler.scm
echo -n "compiler ... "
run
echo -n "slatex ... "
-$compile slatex.scm -O5
+$compile slatex.scm
mkdir -p slatexdir
rm -f slatexdir/*
run
echo -n "grep ... "
-$compile sgrep.scm -O5
+$compile sgrep.scm
run
echo -n "fft/boxed ... "
-$compile fft.scm -O5
+$compile fft.scm
run
echo -n "fft/unboxed ... "
-$compile fft.scm -O5 -D unboxed
+$compile fft.scm -D unboxed
run
diff --git a/tests/runtests.sh b/tests/runtests.sh
index d28da238..74e0e328 100644
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -29,9 +29,12 @@ done
"${TEST_DIR}/../chicken-install" -init test-repository export
CHICKEN_REPOSITORY=${TEST_DIR}/test-repository
CHICKEN=../chicken
+ASMFLAGS=
+FAST_OPTIONS="-O5 -d0 -b -disable-interrupts"
if test -n "$MSYSTEM"; then
CHICKEN="..\\chicken.exe"
+ ASMFLAGS=-Wa,-w
# make compiled tests use proper library on Windows
cp ../libchicken.dll .
fi
@@ -242,22 +245,22 @@ PATH=$PWD/tmp:$PATH xxx $PWD/tmp
#PATH=$PATH:$PWD/tmp xxx $PWD/tmp
echo "======================================== timing compilation ..."
-time $compile compiler.scm -O5 -debug pb -v
+time $compile compiler.scm $FAST_OPTIONS -debug pb -v -C "$ASMFLAGS"
echo "executing ..."
time ./a.out
echo "======================================== running slatex ..."
-$compile slatex.scm -O5
+$compile slatex.scm $FAST_OPTIONS
mkdir -p slatexdir
rm -f slatexdir/*
time ./a.out
echo "======================================== running floating-point benchmark ..."
echo "boxed:"
-$compile fft.scm -O5
+$compile fft.scm $FAST_OPTIONS
time ./a.out
echo "unboxed:"
-$compile fft.scm -O5 -D unboxed -debug oxi | tee fft.out
+$compile fft.scm $FAST_OPTIONS -D unboxed -debug oxi | tee fft.out
time ./a.out
echo "======================================== done."
diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index fb93ae60..e2d77ff8 100644
--- a/tests/scrutiny.expected
+++ b/tests/scrutiny.expected
@@ -8,15 +8,15 @@ Warning: in local procedure `c',
expected value of type boolean in conditional but were given a value of
type `number' which is always true:
-(if x2 '1 '2)
+(if x3 '1 '2)
Warning: in toplevel procedure `foo':
branches in conditional expression differ in the number of results:
-(if x3 (values '1 '2) (values '1 '2 (+ ...)))
+(if x5 (values '1 '2) (values '1 '2 (+ ...)))
Warning: at toplevel:
- scrutiny-tests.scm:18: in procedure call to `bar4', expected argument #2 of type `number', but where given an argument of type `symbol'
+ scrutiny-tests.scm:18: in procedure call to `bar6', expected argument #2 of type `number', but where given an argument of type `symbol'
Warning: at toplevel:
scrutiny-tests.scm:20: in procedure call to `pp', expected 1 argument, but where given 0 arguments
@@ -28,7 +28,7 @@ Warning: at toplevel:
expected in argument #1 of procedure call `(print (values))' a single result, but were given zero results
Warning: at toplevel:
- scrutiny-tests.scm:26: in procedure call to `x5', expected a value of type `(procedure () *)', but were given a value of type `fixnum'
+ scrutiny-tests.scm:26: in procedure call to `x7', expected a value of type `(procedure () *)', but were given a value of type `fixnum'
Warning: at toplevel:
scrutiny-tests.scm:28: in procedure call to `+', expected argument #1 of type `number', but where given an argument of type `symbol'
@@ -40,9 +40,9 @@ Warning: at toplevel:
assignment of value of type `fixnum' to toplevel variable `car' does not match declared type `(procedure car (pair) *)'
Warning: at toplevel:
- expected in `let' binding of `g6' a single result, but were given 2 results
+ expected in `let' binding of `g8' a single result, but were given 2 results
Warning: at toplevel:
- g67: in procedure call to `g67', expected a value of type `(procedure () *)', but were given a value of type `fixnum'
+ g89: in procedure call to `g89', expected a value of type `(procedure () *)', but were given a value of type `fixnum'
Warning: redefinition of standard binding `car'
Trap