Use definition of `compiler:default-top-level-declarations'. Add new
authorChris Hanson <org/chris-hanson/cph>
Wed, 2 Nov 1988 21:54:15 +0000 (21:54 +0000)
committerChris Hanson <org/chris-hanson/cph>
Wed, 2 Nov 1988 21:54:15 +0000 (21:54 +0000)
class of variables: `assigned'.  Add two new declarations:
`ignore-assignment-traps' and  `ignore-reference-traps'.

v7/src/compiler/fggen/declar.scm

index 0b5ad9c880f45cce13749fa311f0b3c43731dc91..839a2b09b3e2db75b9d89ce640cf1407b007cc0d 100644 (file)
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fggen/declar.scm,v 1.2 1987/10/05 20:44:08 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fggen/declar.scm,v 1.3 1988/11/02 21:54:15 cph Exp $
 
-Copyright (c) 1987 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -39,10 +39,15 @@ MIT in each case. |#
 (define (process-top-level-declarations! block declarations)
   (process-declarations!
    block
-   ;; Kludge!
-   (if (assq 'UUO-LINK declarations)
-       declarations
-       (cons '(UUO-LINK ALL) declarations))))
+   (let loop
+       ((declarations declarations)
+       (defaults compiler:default-top-level-declarations))
+     (if (null? defaults)
+        declarations
+        (loop (if (assq (caar defaults) declarations)
+                  declarations
+                  (cons (car defaults) declarations))
+              (cdr defaults))))))
 
 (define (process-declarations! block declarations)
   (for-each (lambda (declaration)
@@ -83,6 +88,11 @@ MIT in each case. |#
   (let loop ((specification specification))
     (cond ((eq? specification 'BOUND) (block-bound-variables block))
          ((eq? specification 'FREE) (block-free-variables block))
+         ((eq? specification 'ASSIGNED)
+          (list-transform-positive
+              (append (block-bound-variables block)
+                      (block-free-variables block))
+            variable-assigned?))
          ((eq? specification 'NONE) '())
          ((eq? specification 'ALL)
           (append (block-bound-variables block)
@@ -125,6 +135,8 @@ MIT in each case. |#
           (symbol-list? (cdr object)))))
 
 )
-\f
+
 (define-declaration 'UUO-LINK boolean-variable-property)
-(define-declaration 'CONSTANT boolean-variable-property)
\ No newline at end of file
+(define-declaration 'CONSTANT boolean-variable-property)
+(define-declaration 'IGNORE-REFERENCE-TRAPS boolean-variable-property)
+(define-declaration 'IGNORE-ASSIGNMENT-TRAPS boolean-variable-property)
\ No newline at end of file