From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 2 Jul 1987 20:35:58 +0000 (+0000)
Subject: Allow unused declarations to be passed through to next stage of
X-Git-Tag: 20090517-FFI~13302
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=dd441ab23be2773304ca2b535a54865a00fce6a2;p=mit-scheme.git

Allow unused declarations to be passed through to next stage of
compilation.  Fix bug that signalled warning twice for each such
declaration at top level.
---

diff --git a/v7/src/sf/cgen.scm b/v7/src/sf/cgen.scm
index 19d55ecb3..38dfa142b 100644
--- a/v7/src/sf/cgen.scm
+++ b/v7/src/sf/cgen.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/cgen.scm,v 3.3 1987/03/20 23:49:11 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/cgen.scm,v 3.4 1987/07/02 20:35:58 cph Rel $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -47,8 +47,10 @@ MIT in each case. |#
 (define (cgen/top-level quotation)
   (let ((block (quotation/block quotation))
 	(expression (quotation/expression quotation)))
-    (cgen/declaration (block/declarations block)
-		      (cgen/expression (list block) expression))))
+    (let ((result (cgen/expression (list block) expression)))
+      (if (open-block? expression)
+	  result
+	  (cgen/declaration (block/declarations block) result)))))
 
 (define (cgen/declaration declarations expression)
   (let ((declarations (maybe-flush-declarations declarations)))
@@ -63,13 +65,15 @@ MIT in each case. |#
       '()
       (let ((declarations (declarations/original declarations)))
 	(if flush-declarations?
-	    (begin (for-each (lambda (declaration)
-			       (if (not (declarations/known? declaration))
-				   (warn "Unused declaration" declaration)))
-			     declarations)
-		   '())
+	    (let loop ((declarations declarations))
+	      (cond ((null? declarations) '())
+		    ((declarations/known? (car declarations))
+		     (loop (cdr declarations)))
+		    (else
+		     (warn "Unused declaration" (car declarations))
+		     (cons (car declarations) (loop (cdr declarations))))))
 	    declarations))))
-
+
 (define (cgen/expressions interns expressions)
   (map (lambda (expression)
 	 (cgen/expression interns expression))