From 21beffd173c85cc243200101830fa4491d4cdeb7 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 29 Apr 2007 20:16:05 +0000
Subject: [PATCH] Eliminate useless compiler warnings.

---
 v7/src/compiler/back/linear.scm   |  4 ++--
 v7/src/compiler/fgopt/blktyp.scm  |  6 ++++--
 v7/src/compiler/fgopt/simapp.scm  | 15 ++++++++-------
 v7/src/compiler/rtlgen/rgproc.scm |  4 ++--
 4 files changed, 16 insertions(+), 13 deletions(-)

diff --git a/v7/src/compiler/back/linear.scm b/v7/src/compiler/back/linear.scm
index b19ad7066..4251d9c1d 100644
--- a/v7/src/compiler/back/linear.scm
+++ b/v7/src/compiler/back/linear.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: linear.scm,v 4.21 2007/01/05 21:19:20 cph Exp $
+$Id: linear.scm,v 4.22 2007/04/29 20:16:05 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -123,7 +123,7 @@ USA.
 			      ,@(lap:make-label-statement jlabel)
 			      ,@(linearize-next cn))))))))))
 	(cond ((eq? cn an)
-	       (warn "bblock-linearize-lap: Identical branches" pblock)
+	       ;;(warn "bblock-linearize-lap: Identical branches" pblock)
 	       (unspecial))
 	      ((sblock? cn)
 	       (let ((cnn (find-next (snode-next cn))))
diff --git a/v7/src/compiler/fgopt/blktyp.scm b/v7/src/compiler/fgopt/blktyp.scm
index c0d61ec7c..bbd2bb7ae 100644
--- a/v7/src/compiler/fgopt/blktyp.scm
+++ b/v7/src/compiler/fgopt/blktyp.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: blktyp.scm,v 4.20 2007/01/05 21:19:20 cph Exp $
+$Id: blktyp.scm,v 4.21 2007/04/29 20:16:05 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -133,9 +133,11 @@ USA.
 	  (if previously-trivial?
 	      (if (not (procedure/trivial-closure? procedure))
 		  (error "trivial procedure becoming non-trivial" procedure))
+	      #|
 	      (if (procedure/trivial-closure? procedure)
 		  (warn "non-trivial procedure becoming trivial"
-			procedure)))))))
+			procedure))
+	      |#)))))
 
 (define (attempt-child-graft block procedure update?)
   (let ((block* (block-nearest-closure-ancestor
diff --git a/v7/src/compiler/fgopt/simapp.scm b/v7/src/compiler/fgopt/simapp.scm
index 53cd80c10..e4e651dad 100644
--- a/v7/src/compiler/fgopt/simapp.scm
+++ b/v7/src/compiler/fgopt/simapp.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: simapp.scm,v 4.13 2007/01/05 21:19:20 cph Exp $
+$Id: simapp.scm,v 4.14 2007/04/29 20:16:05 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -51,7 +51,7 @@ USA.
   (make-method-table rvalue-types
 		     (lambda (old operator apply-operator)
 		       old apply-operator
-		       (warn "Possible inapplicable operator" operator)
+		       #|(warn "Possible inapplicable operator" operator)|#
 		       operator)))
 
 (let ((processor
@@ -110,15 +110,16 @@ USA.
 			    ((scode/procedure? value)
 			     (procedure-arity-valid? value argument-count))
 			    (else
+			     #|
 			     (if (not (unassigned-reference-trap? value))
 				 (warn "Possible inapplicable operator" value))
+			     |#
 			     true)))
-		     (warn
-		      "Procedure called with wrong number of arguments"
-		      value
-		      number-supplied))))
+		     (warn "Procedure called with wrong number of arguments"
+			   value
+			   number-supplied))))
 	      (else
-	       (warn "Possible inapplicable operator" operator)))))))
+	       #|(warn "Possible inapplicable operator" operator)|#))))))
 
 (define (initialize-lvalue-cache! lvalue)
   (set-lvalue-values-cache! lvalue (lvalue-values lvalue)))
diff --git a/v7/src/compiler/rtlgen/rgproc.scm b/v7/src/compiler/rtlgen/rgproc.scm
index c251462a3..012b40bad 100644
--- a/v7/src/compiler/rtlgen/rgproc.scm
+++ b/v7/src/compiler/rtlgen/rgproc.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: rgproc.scm,v 4.18 2007/01/05 21:19:23 cph Exp $
+$Id: rgproc.scm,v 4.19 2007/04/29 20:16:05 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -192,7 +192,7 @@ USA.
 	   ((TRIVIAL-CLOSURE)
 	    ;; This is not an error.
 	    ;; It can be the consequence of bad style.
-	    (warn "Letrec value is trivial closure" value)
+	    ;;(warn "Letrec value is trivial closure" value)
 	    (recvr (make-null-cfg)
 		   (make-trivial-closure-cons value)))
 	   ((OPEN-EXTERNAL OPEN-INTERNAL)
-- 
2.25.1