From: Joe Marshall Date: Tue, 23 Feb 2010 21:32:05 +0000 (-0800) Subject: Handle IGNORE declarations in a much more reasonable way. X-Git-Tag: 20100708-Gtk~157 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=26d6461c451f0171fec30d61dc689d15b79be1d4;p=mit-scheme.git Handle IGNORE declarations in a much more reasonable way. --- diff --git a/src/sf/cgen.scm b/src/sf/cgen.scm index f81e6f3ce..7cb7fb8a5 100644 --- 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 be338a14b..94fa19f48 100644 --- 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)))) ;;;; 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 616ba1e08..44ac901cf 100644 --- 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 4d28f379e..47519ba78 100644 --- 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)