Allow unused declarations to be passed through to next stage of
authorChris Hanson <org/chris-hanson/cph>
Thu, 2 Jul 1987 20:35:58 +0000 (20:35 +0000)
committerChris Hanson <org/chris-hanson/cph>
Thu, 2 Jul 1987 20:35:58 +0000 (20:35 +0000)
compilation.  Fix bug that signalled warning twice for each such
declaration at top level.

v7/src/sf/cgen.scm

index 19d55ecb38804c412b1dcb9a90c4cf0cc09fad9b..38dfa142bce0590712afecbae9857cff0269bf9c 100644 (file)
@@ -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))))
-
+\f
 (define (cgen/expressions interns expressions)
   (map (lambda (expression)
         (cgen/expression interns expression))