guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] 09/10: Warning and optimization levels always small inte


From: Andy Wingo
Subject: [Guile-commits] 09/10: Warning and optimization levels always small integers
Date: Fri, 8 May 2020 11:13:44 -0400 (EDT)

wingo pushed a commit to branch master
in repository guile.

commit e9c0f3071dedb0f6b39757e920cdc182435c8725
Author: Andy Wingo <address@hidden>
AuthorDate: Fri May 8 16:32:40 2020 +0200

    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 ddcbfe5..2753b69 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 7b5612b..c63d161 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 ea6377b..7b6daea 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 8ffbb29..7ec2da3 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 bd07fb3..b44f15a 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 c326f60..863157a 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)))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]