Be more specific about what kind of combination is considered to be an
authorChris Hanson <org/chris-hanson/cph>
Thu, 11 Aug 1988 20:13:27 +0000 (20:13 +0000)
committerChris Hanson <org/chris-hanson/cph>
Thu, 11 Aug 1988 20:13:27 +0000 (20:13 +0000)
`error-combination'.

v7/src/compiler/fggen/fggen.scm

index 0cc6b9181c20b1c13a77852b711232694d8a6719..bbf71baffd3ca9c48931f1e09a46e6f011667ede 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fggen/fggen.scm,v 4.7 1988/07/20 00:08:42 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fggen/fggen.scm,v 4.8 1988/08/11 20:13:27 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -733,10 +733,19 @@ MIT in each case. |#
                         (the-environment? (car operands))
                         (scode/symbol? (cadr operands)))
                    (generate/unassigned? block continuation expression))
-                  ((or (eq? operator (ucode-primitive error-procedure))
-                       (and (scode/absolute-reference? operator)
-                            (eq? (scode/absolute-reference-name operator)
-                                 'ERROR-PROCEDURE)))
+                  ((and (or (eq? operator (ucode-primitive error-procedure))
+                            (and (scode/absolute-reference? operator)
+                                 (eq? (scode/absolute-reference-name operator)
+                                      'ERROR-PROCEDURE)))
+                        (let ((irritants (cadr operands)))
+                          (or (null? irritants)
+                              (and (scode/absolute-combination? irritants)
+                                   (eq? (scode/absolute-combination-name
+                                         irritants)
+                                        'LIST))
+                              (and (scode/combination? irritants)
+                                   (eq? (scode/combination-operator irritants)
+                                        cons)))))
                    (generate/error-combination block continuation expression))
                   (else
                    (generate/combination block continuation expression))))))