Handle IGNORE declarations in a much more reasonable way.

diff --git a/src/sf/cgen.scm b/src/sf/cgen.scm
index f81e6f3ce1cf21bbc7d79df0812accfee03d2b95..7cb7fb8a5c51281884a90e6dc2356b51c21d1a30 100644 (file)
--- a/src/sf/cgen.scm
+++ b/src/sf/cgen.scm
@@ -217,9 +217,6 @@ USA.
 
 (define-method/cgen 'REFERENCE
   (lambda (interns expression)
-    (if (variable/must-ignore? (reference/variable expression))
-       (warn "Variable declared IGNORE, but was used: " 
-             (variable/name (reference/variable expression))))
     (cgen/variable interns (reference/variable expression))))
 
 (define-method/cgen 'SEQUENCE

diff --git a/src/sf/pardec.scm b/src/sf/pardec.scm
index be338a14bebebe69bd5d54b645a8ff1a0fb4e79e..94fa19f483630a0bf7043c7060a934c810acfe5a 100644 (file)
--- a/src/sf/pardec.scm
+++ b/src/sf/pardec.scm
@@ -321,8 +321,7 @@ USA.
 
 ;; IGNORABLE suppresses warnings about the variable not being used.
 ;; This is useful in macros that bind variables that the body may
-;; not actually use.  Mentioning the variable in a sequence will
-;; have the effect of marking it ignorable.
+;; not actually use.
 (define-declaration 'IGNORABLE
   (lambda (block names)
     (for-each (lambda (variable)
@@ -332,14 +331,19 @@ USA.
     '()))
 
 ;; IGNORE causes warnings if an ignored variable actually ends
-;; up being used.
+;; up being used.  Mentioning the variable in a sequence will
+;; have the effect of marking it IGNORED.
 (define-declaration 'IGNORE
   (lambda (block names)
-    (for-each (lambda (variable)
-               (if variable
-                   (variable/must-ignore! variable)))
-             (block/lookup-names block names #f))
-    '()))
+    (let ((variables (block/lookup-names block names #f)))
+      (for-each (lambda (variable)
+                 (if variable
+                     (variable/must-ignore! variable)))
+               variables)
+      (make-declarations 'IGNORE
+                        variables
+                        'NO-VALUES
+                        'LOCAL))))
 \f
 ;;;; Reductions and Expansions
 ;;; See "reduct.scm" for description of REDUCE-OPERATOR and REPLACE-OPERATOR.

diff --git a/src/sf/subst.scm b/src/sf/subst.scm
index 616ba1e0821794d2887cb9483b9940e1b76e80aa..44ac901cf705881c0bef91b7fc7471b65237dc76 100644 (file)
--- a/src/sf/subst.scm
+++ b/src/sf/subst.scm
@@ -38,6 +38,12 @@ USA.
 ;;; descriptive.
 (define *current-block-names*)
 
+(define (ignored-variable-warning name)
+  (warn (string-append "Variable \""
+                      (symbol->string name)
+                      "\" was declared IGNORE, but used anyway.")
+       name *current-block-names*))
+
 (define (integrate/top-level block expression)
   (integrate/top-level* (object/scode expression) block expression))
 
@@ -75,12 +81,7 @@ USA.
        (list (if (eq? action open-block/value-marker)
                  action
                  (integrate/expression operations environment action)))
-       (cons (cond ((reference? action)
-                    ;; This clause lets you ignore a variable by
-                    ;; mentioning it in a sequence.
-                    (variable/may-ignore! (reference/variable action))
-                    action)
-                   ((eq? action open-block/value-marker)
+       (cons (cond ((eq? action open-block/value-marker)
                     action)
                    (else
                     (integrate/expression operations environment action)))
@@ -118,7 +119,9 @@ USA.
        (lambda (operation info)
          info                          ;ignore
          (case operation
-           ((INTEGRATE INTEGRATE-OPERATOR EXPAND)
+           ((IGNORE)
+            (ignored-variable-warning (variable/name variable)))
+           ((EXPAND INTEGRATE INTEGRATE-OPERATOR)
             (warn "Attempt to assign integrated name"
                   (variable/name variable)))
            (else (error "Unknown operation" operation))))
@@ -240,7 +243,10 @@ USA.
        (operations/lookup operations variable
         (lambda (operation info)
           (case operation
-            ((INTEGRATE-OPERATOR EXPAND)
+            ((IGNORE)
+             (ignored-variable-warning (variable/name variable))
+             (integration-failure))
+            ((EXPAND INTEGRATE-OPERATOR)
              (variable/reference! variable)
              expression)
             ((INTEGRATE)
@@ -414,6 +420,10 @@ USA.
                          (integrate/expression operations environment new-expression)))
                    (else (dont-integrate))))
 
+            ((IGNORE)
+             (ignored-variable-warning (variable/name variable))
+             (dont-integrate))
+
             ((INTEGRATE INTEGRATE-OPERATOR)
              (let ((new-operator
                     (reassign operator
@@ -545,6 +555,10 @@ USA.
                     (integrate/expression operations environment new-expression))
                   (integration-failure))))
 
+           ((IGNORE)
+            (ignored-variable-warning (variable/name variable))
+            (integration-failure))
+
            ((INTEGRATE INTEGRATE-OPERATOR)
             (let ((new-expression (integrate/name expression
                                                   operator info environment)))
@@ -566,7 +580,7 @@ USA.
 (define-method/integrate-combination 'THE-ENVIRONMENT
   (lambda (expression operations environment block operator operands)
     (warn "(THE-ENVIRONMENT) used as an operator.  Will cause a runtime error.")
-    (combination/make expression block 
+    (combination/make expression block
                      (integrate/expression operations environment operator)
                      operands)))
 

diff --git a/src/sf/xform.scm b/src/sf/xform.scm
index 4d28f379eba0d5ad7c820a7b0326f758c22470d3..47519ba78e08d6b06d80fbd63c2bb8e7b8a107ec 100644 (file)
--- a/src/sf/xform.scm
+++ b/src/sf/xform.scm
@@ -191,11 +191,29 @@ USA.
            (let ((environment
                   (environment/bind environment
                                     (block/bound-variables block))))
-             (procedure/make
-              expression block name required optional rest
-              (transform/procedure-body block
-                                        environment
-                                        body)))))))))
+             (build-procedure expression block name required optional rest
+                              (transform/procedure-body block environment body)))))))))
+
+;; If procedure body is a sequence, scan the first elements and turn variable
+;; references into IGNORE declarations.
+(define (build-procedure expression block name required optional rest body)
+  (if (sequence? body)
+      (do ((actions (sequence/actions body) (cdr actions))
+          (ignores '() (cons (variable/name (reference/variable (car actions))) ignores)))
+         ((or (null? (cdr actions))
+              (not (reference? (car actions))))
+          (let ((final-body (if (null? (cdr actions))
+                                (car actions)
+                                (sequence/make (object/scode body) actions))))
+            (procedure/make
+             expression block name required optional rest
+             (if (null? ignores)
+                 final-body
+                 (declaration/make #f (declarations/parse block `((ignore ,@ignores))) 
+                                   final-body))))))
+      (procedure/make
+       expression block name required optional rest
+       body)))
 
 (define (transform/procedure-body block environment expression)
   (if (scode-open-block? expression)