Add and export GUARANTEE-PROMISE.

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 836b5c91a3323cefb6c8b7254bc95019eb58f72c..d81887c41f275f7700e499cfbaaa3e55eafa480f 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -698,6 +698,7 @@ USA.
          environment-extension-procedure
          environment-extension?
          force
+         guarantee-promise
          interpreter-return-address?
          make-return-address
          microcode-error

diff --git a/src/runtime/udata.scm b/src/runtime/udata.scm
index d79fd96966b9dcee0a9079273f62c880117f9746..8f56c44dae86d85f8812b25263ad3b9e8abe93da 100644 (file)
--- a/src/runtime/udata.scm
+++ b/src/runtime/udata.scm
@@ -262,6 +262,8 @@ contains constants derived from the source program.
 (define-integrable (promise? object)
   (object-type? (ucode-type delayed) object))
 
+(define-guarantee promise "promise")
+
 (define-integrable (promise-forced? promise)
   (eq? #t (system-pair-car promise)))
 
@@ -288,8 +290,7 @@ contains constants derived from the source program.
   (system-pair-car promise))
 
 (define (force promise)
-  (if (not (promise? promise))
-      (error:wrong-type-argument promise "promise" 'FORCE))
+  (guarantee-promise promise 'FORCE)
   (case (system-pair-car promise)
     ((#T)
      (system-pair-cdr promise))