~ chicken-core (chicken-5) 1c6368a21315767d440523618571053f1417abc1
commit 1c6368a21315767d440523618571053f1417abc1
Author: felix <bunny351@gmail.com>
AuthorDate: Fri May 28 09:29:43 2010 +0200
Commit: felix <bunny351@gmail.com>
CommitDate: Fri May 28 09:29:43 2010 +0200
removed option and declararation to disable warnings
diff --git a/batch-driver.scm b/batch-driver.scm
index d7bb607e..0d09320f 100644
--- a/batch-driver.scm
+++ b/batch-driver.scm
@@ -26,8 +26,7 @@
(declare
- (unit driver)
- (disable-warning var))
+ (unit driver))
(include "compiler-namespace")
(include "tweaks")
@@ -198,7 +197,6 @@
(set! enable-inline-files #t)
(set! inline-locally #t)
(set! inline-globally #t))
- (set! disabled-warnings (map string->symbol (collect-options 'disable-warning)))
(when (or verbose do-scrutinize)
(set! ##sys#notices-enabled #t))
(when (memq 'no-warnings options)
@@ -228,8 +226,6 @@
(dribble "Identifiers and symbols are case insensitive")
(register-feature! 'case-insensitive)
(case-sensitive #f) )
- (when (memq 'compress-literals options)
- (compiler-warning 'usage "`the -compress-literals' option is obsolete") )
(when kwstyle
(let ([val (option-arg kwstyle)])
(cond [(string=? "prefix" val) (keyword-style #:prefix)]
diff --git a/c-platform.scm b/c-platform.scm
index 9eb46674..d1332b34 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -96,7 +96,9 @@
(define valid-compiler-options-with-argument
'(debug
output-file include-path heap-size stack-size unit uses keyword-style require-extension
- inline-limit profile-name disable-warning parenthesis-synonyms
+ inline-limit profile-name
+ disable-warning ; OBSOLETE
+ parenthesis-synonyms
prelude postlude prologue epilogue nursery extend feature types
emit-import-library emit-inline-file static-extension consult-inline-file
heap-growth heap-shrinkage heap-initial-size ffi-define ffi-include-path) )
diff --git a/chicken.scm b/chicken.scm
index 961516a0..41f39f65 100644
--- a/chicken.scm
+++ b/chicken.scm
@@ -106,8 +106,7 @@
(case level
((0) (set! options (cons* 'no-lambda-info 'no-trace options)))
((1) (set! options (cons 'no-trace options)))
- ((2) (set! options (cons 'scrutinize options)))
- (else (compiler-warning 'usage "invalid debug level ~S - ignored" (car rest))) )
+ (else (set! options (cons 'scrutinize options))))
(loop (cdr rest)) ) )
((memq o valid-compiler-options) (loop rest))
((memq o valid-compiler-options-with-argument)
@@ -115,8 +114,8 @@
(loop (cdr rest))
(quit "missing argument to `-~s' option" o) ) )
(else
- (compiler-warning
- 'usage "invalid compiler option `~a' - ignored"
+ (warning
+ "invalid compiler option (gnored)"
(if (string? o) o (conc "-" o)) )
(loop rest) ) ) ) ) )
(apply compile-source-file filename options)
diff --git a/common-declarations.scm b/common-declarations.scm
index 65665bb3..7ed21869 100644
--- a/common-declarations.scm
+++ b/common-declarations.scm
@@ -25,7 +25,6 @@
(declare
- (disable-warning var redef)
(usual-integrations)
(hide d))
diff --git a/compiler-namespace.scm b/compiler-namespace.scm
index 5f869cf8..bd07f5d6 100644
--- a/compiler-namespace.scm
+++ b/compiler-namespace.scm
@@ -58,7 +58,6 @@
compiler-source-file
compiler-syntax-enabled
compiler-syntax-statistics
- compiler-warning
compute-database-statistics
constant-declarations
constant-table
diff --git a/compiler-syntax.scm b/compiler-syntax.scm
index 1e03af4f..4b8437c2 100644
--- a/compiler-syntax.scm
+++ b/compiler-syntax.scm
@@ -184,12 +184,11 @@
(args (cdr args)))
(define (fail ret? msg . args)
(let ((ln (get-line x)))
- (compiler-warning
- 'syntax
- "`~a', in format string ~s~a, ~?"
- func fstr
- (if ln (sprintf "(~a)" ln) "")
- msg args) )
+ (warning
+ (sprintf "`~a', in format string ~s~a, ~?"
+ func fstr
+ (if ln (sprintf "(~a)" ln) "")
+ msg args) ))
(when ret? (return #f)))
(let ((code '())
(index 0)
diff --git a/compiler.scm b/compiler.scm
index 9f621600..a7d1612d 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -50,7 +50,6 @@
; (c-options {<opt>})
; (compile-syntax)
; (disable-interrupts)
-; (disable-warning <class> ...)
; (emit-import-library {<module> | (<module> <filename>)})
; (export {<name>})
; (fixnum-arithmetic)
@@ -256,8 +255,7 @@
(declare
- (unit compiler)
- (disable-warning var) )
+ (unit compiler))
(include "compiler-namespace")
@@ -510,9 +508,8 @@
(cond ((symbol? x)
(cond ((keyword? x) `(quote ,x))
((memq x unlikely-variables)
- (compiler-warning
- 'var
- "reference to variable `~s' possibly unintended" x) ))
+ (warning
+ (sprintf "reference to variable `~s' possibly unintended" x) )))
(resolve-variable x e se dest))
((not-pair? x)
(if (constant? x)
@@ -603,8 +600,8 @@
(##sys#canonicalize-extension-path
id 'require-extension)
#f)) ) )
- (compiler-warning
- 'ext "extension `~A' is currently not installed" id))
+ (warning
+ (sprintf "extension `~A' is currently not installed" id)))
`(##core#begin ,exp ,(loop (cdr ids))) ) ) ) )
e se dest) ) )
@@ -888,10 +885,9 @@
[ln (get-line x)]
[val (caddr x)] )
(when (memq var unlikely-variables)
- (compiler-warning
- 'var
- "assignment to variable `~s' possibly unintended"
- var))
+ (warning
+ (sprintf "assignment to variable `~s' possibly unintended"
+ var)))
(cond ((assq var foreign-variables)
=> (lambda (fv)
(let ([type (second fv)]
@@ -921,16 +917,16 @@
(mark-variable var '##compiler#always-bound-to-procedure)
(mark-variable var '##compiler#always-bound)))
(cond ((##sys#macro? var)
- (compiler-warning
- 'var "assigned global variable `~S' is syntax ~A"
- var
- (if ln (sprintf "(~a)" ln) "") )
+ (warning
+ (sprintf "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) )
+ (warning (sprintf "assignment to keyword `~S'" var) ))
`(set! ,var ,(walk val e se var0))))))
((##core#inline)
@@ -1209,7 +1205,7 @@
((constant? (car x))
(emit-syntax-trace-info x #f)
- (compiler-warning 'syntax "literal in operator position: ~S" x)
+ (warning "literal in operator position" x)
(mapwalk x e se) )
(else
@@ -1269,7 +1265,7 @@
(let* ([u (stripu (cadr spec))]
[un (string->c-identifier (stringify u))] )
(when (and unit-name (not (string=? unit-name un)))
- (compiler-warning 'usage "unit was already given a name (new name is ignored)") )
+ (warning "unit was already given a name (new name is ignored)") )
(set! unit-name un) ) )
((standard-bindings)
(if (null? (cdr spec))
@@ -1299,9 +1295,6 @@
((no-procedure-checks) (set! no-procedure-checks #t))
((interrupts-enabled) (set! insert-timer-checks #t))
((disable-interrupts) (set! insert-timer-checks #f))
- ((disable-warning)
- (set! disabled-warnings
- (append (strip (cdr spec)) disabled-warnings)))
((always-bound)
(for-each (cut mark-variable <> '##compiler#always-bound) (stripa (cdr spec))))
((safe-globals) (set! safe-globals-flag #t))
@@ -1370,7 +1363,7 @@
(case id
[(interrupts-enabled) (set! insert-timer-checks #f)]
[(safe) (set! unsafe #t)]
- [else (compiler-warning 'syntax "illegal declaration specifier `~s'" id)]))]))
+ [else (warning "unsupported declaration specifier" id)]))]))
((compile-syntax)
(set! ##sys#enable-runtime-macros #t))
((block-global hide)
@@ -1396,9 +1389,9 @@
(let ([n (cadr spec)])
(if (number? n)
(set! inline-max-size n)
- (compiler-warning
- 'syntax
- "invalid argument to `inline-limit' declaration: ~s" spec) ) ) )
+ (warning
+ "invalid argument to `inline-limit' declaration"
+ spec) ) ) )
((constant)
(let ((syms (cdr spec)))
(if (every symbol? syms)
@@ -1415,9 +1408,8 @@
(symbol? (car il)) (string (cadr il)))
(cons (car il) (cadr il)))
(else
- (compiler-warning
- 'syntax
- "invalid import-library specification: ~s" il))))
+ (warning
+ "invalid import-library specification" il))))
(strip (cdr spec))))))
((profile)
(set! emit-profile #t)
@@ -1450,11 +1442,11 @@
(##sys#put! (car spec) '##core#type (cadr spec))
(##sys#put! (car spec) '##core#declared-type #t))
(else
- (compiler-warning 'syntax "illegal `type' declaration item `~s'" spec))))
+ (warning "illegal `type' declaration item" spec))))
(cdr spec)))
((scrutinize)
(set! do-scrutinize #t))
- (else (compiler-warning 'syntax "illegal declaration specifier `~s'" spec)) )
+ (else (warning "illegal declaration specifier" spec)) )
'(##core#undefined) ) ) )
@@ -1782,9 +1774,9 @@
(when first-analysis
(case (variable-mark var '##compiler#intrinsic)
((standard)
- (compiler-warning 'redef "redefinition of standard binding `~S'" var) )
+ (warning "redefinition of standard binding" var) )
((extended)
- (compiler-warning 'redef "redefinition of extended binding `~S'" var) ) )
+ (warning "redefinition of extended binding" var) ) )
(put! db var 'potential-value val) )
(unless (memq var localenv)
(grow 1)
@@ -2594,9 +2586,10 @@
((number? c)
(cond ((eq? 'fixnum number-type)
(cond ((and (integer? c) (not (big-fixnum? c)))
- (compiler-warning
- 'type
- "coerced inexact literal number `~S' to fixnum ~S" c (inexact->exact c))
+ (warning
+ (sprintf
+ "coerced inexact literal number `~S' to fixnum ~S"
+ c (inexact->exact c)))
(immediate-literal (inexact->exact c)) )
(else (quit "cannot coerce inexact literal `~S' to fixnum" c)) ) )
(else (make-node '##core#literal (list (literal c)) '())) ) )
diff --git a/csc.scm b/csc.scm
index d0ce4236..dedeb830 100644
--- a/csc.scm
+++ b/csc.scm
@@ -142,7 +142,9 @@
(define-constant complex-options
'(-debug -output-file -heap-size -nursery -stack-size -compiler -unit -uses -keyword-style
-optimize-level -include-path -database-size -extend -prelude -postlude -prologue -epilogue
- -inline-limit -profile-name -disable-warning -emit-inline-file -types
+ -inline-limit -profile-name
+ -disable-warning ; OBSOLETE
+ -emit-inline-file -types
-feature -debug-level -heap-growth -heap-shrinkage -heap-initial-size -consult-inline-file
-emit-import-library -static-extension))
@@ -337,7 +339,6 @@ Usage: #{csc} FILENAME | OPTION ...
Debugging options:
-w -no-warnings disable warnings
- -disable-warning CLASS disable specific class of warnings
-d0 -d1 -d2 -debug-level NUMBER
set level of available debugging information
-no-trace disable rudimentary debugging information
diff --git a/csi.scm b/csi.scm
index 5f424f6b..4cd15990 100644
--- a/csi.scm
+++ b/csi.scm
@@ -29,7 +29,6 @@
(uses chicken-syntax srfi-69 ports extras)
(usual-integrations)
(disable-interrupts)
- (disable-warning var)
(compile-syntax)
(foreign-declare #<<EOF
#if (defined(_MSC_VER) && defined(_WIN32)) || defined(HAVE_DIRECT_H)
diff --git a/manual/Declarations b/manual/Declarations
index 96e417e6..3d1527ed 100644
--- a/manual/Declarations
+++ b/manual/Declarations
@@ -95,14 +95,6 @@ Disable timer-interrupts checks in the compiled program. Threads can
not be preempted in main- or library-units that contain this declaration.
-=== disable-warning
-
- [declaration specifier] (disable-warning CLASS ...)
-
-Disable warnings of type {{CLASS ...}} (equivalent to the {{-disable-warning CLASS}}
-compiler option).
-
-
=== emit-import-library
[declaration specifier] (emit-import-library MODULENAME | (MODULENAME FILENAME) ...)
diff --git a/manual/Using the compiler b/manual/Using the compiler
index c9113776..b3579064 100644
--- a/manual/Using the compiler
+++ b/manual/Using the compiler
@@ -76,18 +76,6 @@ the source text should be read from standard input.
; -disable-stack-overflow-checks : Disables detection of stack overflows. This is equivalent to running the compiled executable with the {{-:o}} runtime option.
-; -disable-warning CLASS : Disables specific class of warnings, may be given multiple times. The following classes are defined:
-
- usage warnings related to command-line arguments
- type warnings related to type-conversion
- ext warnings related to extension libraries
- var warnings related to variable- and syntax-definitions and use
- const warnings related to constant-definitions
- syntax syntax-related warnings
- redef warnings about redefinitions of standard- or extended-bindings
- call warnings related to known procedure calls
- ffi warnings related to the foreign function interface
-
; -dynamic : This option should be used when compiling files intended to be loaded dynamically into a running Scheme program.
; -epilogue FILENAME : Includes the file named {{FILENAME}} at the end of the compiled source file. The include-path is not searched. This option may be given multiple times.
diff --git a/regex.scm b/regex.scm
index f0d7783b..2112f866 100644
--- a/regex.scm
+++ b/regex.scm
@@ -29,7 +29,6 @@
(declare
(disable-interrupts)
-; (disable-warning var)
(fixnum)
(export
regexp? regexp
diff --git a/scrutinizer.scm b/scrutinizer.scm
index abe52418..06ba52a3 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -386,10 +386,8 @@
what n (multiples n)))
(first tv))))))
(define (report loc desc)
- (compiler-warning
- 'scrutiny
- "~a~a"
- (location-name loc) desc))
+ (warning
+ (conc (location-name loc) desc)))
(define (location-name loc)
(define (lname loc1)
(if loc1
diff --git a/srfi-1.scm b/srfi-1.scm
index ec33df82..16041e65 100644
--- a/srfi-1.scm
+++ b/srfi-1.scm
@@ -7,7 +7,6 @@
(declare
(unit srfi-1)
(disable-interrupts)
- (disable-warning redef)
(hide ##srfi1#cars+cdrs/no-test ##srfi1#cdrs ##srfi1#cars+ ##srfi1#really-append-map ##srfi1#cars+cdrs+
##srfi1#cars+cdrs ##srfi1#lset2<=)
(not standard-bindings member assoc))
diff --git a/support.scm b/support.scm
index 3a2b60b9..057386ce 100644
--- a/support.scm
+++ b/support.scm
@@ -61,12 +61,6 @@
(flush-output)
#t) ) )
-(define (compiler-warning class msg . args)
- (when (and ##sys#warnings-enabled (not (memq class disabled-warnings)))
- (let ((out (current-error-port)))
- (apply fprintf out (string-append "\nWarning: " msg) args)
- (newline out) ) ) )
-
(define (quit msg . args)
(let ([out (current-error-port)])
(apply fprintf out (string-append "\nError: " msg) args)
@@ -478,9 +472,8 @@
(eq? 'fixnum number-type)
(not (integer? c)) )
(begin
- (compiler-warning
- 'type
- "literal '~s' is out of range - will be truncated to integer" c)
+ (warning
+ "literal is out of range - will be truncated to integer" c)
(inexact->exact (truncate c)) )
c) ) ) )
((let)
@@ -1235,7 +1228,6 @@ Usage: chicken FILENAME OPTION ...
Debugging options:
-no-warnings disable warnings
- -disable-warning CLASS disable specific class of warnings
-debug-level NUMBER set level of available debugging information
-no-trace disable tracing information
-profile executable emits profiling information
Trap