From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 5 Jun 1987 21:36:53 +0000 (+0000)
Subject: Must treat error-combination specially here to prevent block from
X-Git-Tag: 20090517-FFI~13404
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=081ae6a5489d7dd8719ae021e35a6c291fe3257a;p=mit-scheme.git

Must treat error-combination specially here to prevent block from
being marked unsafe.
---

diff --git a/v7/src/sf/make.scm b/v7/src/sf/make.scm
index 1340447f6..6be9d8ef5 100644
--- a/v7/src/sf/make.scm
+++ b/v7/src/sf/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/make.scm,v 3.8 1987/05/09 23:23:51 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/make.scm,v 3.9 1987/06/05 21:36:53 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -60,7 +60,7 @@ MIT in each case. |#
     (make-environment
       (define :name "SF")
       (define :version 3)
-      (define :modification 8)
+      (define :modification 9)
       (define :files)
 
       (define :files-lists
diff --git a/v7/src/sf/xform.scm b/v7/src/sf/xform.scm
index 70bf91727..1c4eeb992 100644
--- a/v7/src/sf/xform.scm
+++ b/v7/src/sf/xform.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/xform.scm,v 3.3 1987/03/20 23:49:46 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/xform.scm,v 3.4 1987/06/05 21:36:10 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -223,6 +223,15 @@ MIT in each case. |#
        (transform/expression block environment predicate)
        (transform/expression block environment alternative)))))
 
+(define (transform/error-combination block environment expression)
+  (combination-components expression
+    (lambda (operator operands)
+      (combination/make
+       (transform/expression block environment operator)
+       (list (transform/expression block environment (car operands))
+	     (transform/expression block environment (cadr operands))
+	     (the-environment/make block))))))
+
 (define (transform/in-package block environment expression)
   (in-package-components expression
     (lambda (environment* expression)
@@ -239,11 +248,11 @@ MIT in each case. |#
 (define (transform/sequence block environment expression)
   (sequence/make
    (transform/expressions block environment (sequence-actions expression))))
-
+
 (define (transform/the-environment block environment expression)
   (block/unsafe! block)
   (the-environment/make block))
-
+
 (define transform/dispatch
   (make-type-dispatcher
    `((,access-type ,transform/access)
@@ -255,6 +264,7 @@ MIT in each case. |#
      (,definition-type ,transform/definition)
      (,delay-type ,transform/delay)
      (,disjunction-type ,transform/disjunction)
+     (,error-combination-type ,transform/error-combination)
      (,in-package-type ,transform/in-package)
      (,lambda-type ,transform/lambda)
      (,open-block-type ,transform/open-block)
diff --git a/v8/src/sf/make.scm b/v8/src/sf/make.scm
index ccca750c9..2d69c630d 100644
--- a/v8/src/sf/make.scm
+++ b/v8/src/sf/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/sf/make.scm,v 3.8 1987/05/09 23:23:51 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/sf/make.scm,v 3.9 1987/06/05 21:36:53 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -60,7 +60,7 @@ MIT in each case. |#
     (make-environment
       (define :name "SF")
       (define :version 3)
-      (define :modification 8)
+      (define :modification 9)
       (define :files)
 
       (define :files-lists