From: Joe Marshall <jmarshall@alum.mit.edu>
Date: Tue, 2 Mar 2010 16:26:38 +0000 (-0800)
Subject: Add GUARANTEE-INTEGRATION-INFO.
X-Git-Tag: 20100708-Gtk~142
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=5e9de19509c280f03c3619a58b1d9f2156f7ab9b;p=mit-scheme.git

Add GUARANTEE-INTEGRATION-INFO.
---

diff --git a/src/sf/object.scm b/src/sf/object.scm
index 26b5a10e1..a4c32a2ab 100644
--- a/src/sf/object.scm
+++ b/src/sf/object.scm
@@ -284,7 +284,7 @@ USA.
 	 (and (constant? operator)
 	      (let ((operator-value (constant/value operator)))
 		(and (memq operator-value primitive-boolean-predicates)
-		     (procedure-arity-valid? 
+		     (procedure-arity-valid?
 		      operator-value
 		      (length (combination/operands expression)))))))))
 
@@ -640,21 +640,25 @@ USA.
   (vector-ref dispatch-vector
 	      (enumeration/name->index enumeration/expression name)))
 
-(define-integrable (constant->integration-info constant)
-  (make-integration-info (constant/make #f constant)))
+;;; Integration Info
+(define integration-info-tag
+  (string-copy "integration-info"))
+
+(define-integrable (make-integration-info expression)
+  (cons integration-info-tag expression))
 
 (define-integrable (integration-info? object)
   (and (pair? object)
        (eq? integration-info-tag (car object))))
 
-(define-integrable (make-integration-info expression)
-  (cons integration-info-tag expression))
+(define-guarantee integration-info "Integration info")
 
-(define-integrable (integration-info/expression integration-info)
+(define (integration-info/expression integration-info)
+  (guarantee-integration-info integration-info 'integration-info/expression)
   (cdr integration-info))
 
-(define integration-info-tag
-  (string-copy "integration-info"))
+(define-integrable (constant->integration-info constant)
+  (make-integration-info (constant/make #f constant)))
 
 ;;; Returns #T if switch is not #F or 'warn.
 ;;; Additionally, prints text if switch is not #T.