From e9c0f3071dedb0f6b39757e920cdc182435c8725 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Fri, 8 May 2020 16:32:40 +0200
Subject: [PATCH] Warning and optimization levels always small integers

* module/language/tree-il/analyze.scm (make-analyzer): Expect an int for
  optimization level.
* module/scripts/compile.scm (%options, show-warning-help): No more
  -Wnone / Wall; use -W0 or -W9 instead.
* module/system/base/compile.scm (level-validator): Validate small int.
  (compute-analyzer, add-default-optimizations): Likewise.
* test-suite/tests/optargs.test (without-compiler-warnings):
* test-suite/tests/tree-il.test (call-with-warnings): Parameterize level
  to 0, not #f.
* bootstrap/Makefile.am (GUILE_WARNINGS): Use -W0, not -Wnone.
---
 bootstrap/Makefile.am               |  2 +-
 module/language/tree-il/analyze.scm |  5 +----
 module/scripts/compile.scm          | 10 ++--------
 module/system/base/compile.scm      | 13 +++++++------
 test-suite/tests/optargs.test       |  2 +-
 test-suite/tests/tree-il.test       |  2 +-
 6 files changed, 13 insertions(+), 21 deletions(-)

diff --git a/bootstrap/Makefile.am b/bootstrap/Makefile.am
index ddcbfe54a..2753b6950 100644
--- a/bootstrap/Makefile.am
+++ b/bootstrap/Makefile.am
@@ -21,7 +21,7 @@
 ##   Fifth Floor, Boston, MA 02110-1301 USA
 
 
-GUILE_WARNINGS = -Wnone
+GUILE_WARNINGS = -W0
 # Loading eval.go happens before boot and therefore before modules are
 # resolved.  For some reason if compiled without resolve-primitives,
 # attempts to resolve primitives at boot fail; weird.  Should fix this
diff --git a/module/language/tree-il/analyze.scm b/module/language/tree-il/analyze.scm
index 7b5612bcf..c63d161be 100644
--- a/module/language/tree-il/analyze.scm
+++ b/module/language/tree-il/analyze.scm
@@ -1098,10 +1098,7 @@ resort, return #t when EXP refers to the global variable SPECIAL-NAME."
     #(format                      1 ,format-analysis)))
 
 (define (make-analyzer warning-level warnings)
-  (define (enabled-for-level? level)
-    (match warning-level
-      ((? boolean?) warning-level)
-      ((? exact-integer?) (>= warning-level level))))
+  (define (enabled-for-level? level) (<= level warning-level))
   (let ((analyses (filter-map (match-lambda
                                (#(kind level analysis)
                                 (and (or (enabled-for-level? level)
diff --git a/module/scripts/compile.scm b/module/scripts/compile.scm
index ea6377b48..7b6daea85 100644
--- a/module/scripts/compile.scm
+++ b/module/scripts/compile.scm
@@ -87,12 +87,6 @@
                     ("help"
                      (show-warning-help)
                      (exit 0))
-                    ("all"
-                     (alist-cons 'warning-level #t
-                                 (alist-delete 'warning-level result)))
-                    ("none"
-                     (alist-cons 'warning-level #f
-                                 (alist-delete 'warning-level result)))
                     ((? string->number)
                      (let ((n (string->number arg)))
                        (unless (and (exact-integer? n) (<= 0 n))
@@ -176,8 +170,8 @@ There is NO WARRANTY, to the extent permitted by law.~%"))
                       (warning-type-description wt)))
             %warning-types)
   (format #t "~%")
-  (format #t "You may also specify warning levels as `-Wnone', `-W0`, `-W1',~%")
-  (format #t "`-W2', `-W3', or `-Wall`.  The default is `-W1'.~%"))
+  (format #t "You may also specify warning levels as `-W0`, `-W1',~%")
+  (format #t "`-W2', or `-W3'.  The default is `-W1'.~%"))
 
 (define (show-optimization-help)
   (format #t "The available optimizations are:~%~%")
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index 8ffbb294f..7ec2da3c2 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -34,12 +34,11 @@
 
 
 (define (level-validator x)
-  (match x
-    ((? boolean?) x)
-    ((and (? exact-integer?) (not (? negative?))) x)
-    (_ (error
-        "bad warning or optimization level: expected #f, #t, or integer >= 0"
-        x))))
+  (unless (and (exact-integer? x) (<= 0 x 9))
+    (error
+     "bad warning or optimization level: expected integer between 0 and 9"
+     x))
+  x)
 
 (define default-warning-level (make-parameter 1 level-validator))
 (define default-optimization-level (make-parameter 2 level-validator))
@@ -215,6 +214,7 @@
 ;;;
 
 (define (compute-analyzer lang warning-level opts)
+  (level-validator warning-level)
   (match (language-analyzer lang)
     (#f (lambda (exp env) (values)))
     (proc (proc warning-level
@@ -225,6 +225,7 @@
                     ((_ _ . opts) (lp opts))))))))
 
 (define (add-default-optimizations lang optimization-level opts)
+  (level-validator optimization-level)
   (match (language-optimizations-for-level lang)
     (#f opts)
     (get-opts (append opts (get-opts optimization-level)))))
diff --git a/test-suite/tests/optargs.test b/test-suite/tests/optargs.test
index bd07fb3e4..b44f15a9a 100644
--- a/test-suite/tests/optargs.test
+++ b/test-suite/tests/optargs.test
@@ -48,7 +48,7 @@
 ;;;
 
 (define-syntax-rule (without-compiler-warnings exp ...)
-  (parameterize ((default-warning-level #f)) exp ...))
+  (parameterize ((default-warning-level 0)) exp ...))
 
 (without-compiler-warnings
  (with-test-prefix/c&e "let-keywords"
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index c326f6031..863157a09 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -242,7 +242,7 @@
 (define (call-with-warnings thunk)
   (let ((port (open-output-string)))
     ;; Disable any warnings added by default.
-    (parameterize ((default-warning-level #f))
+    (parameterize ((default-warning-level 0))
       (with-fluids ((*current-warning-port*   port)
                     (*current-warning-prefix* ""))
         (thunk)))