From 6de9b1a2dbaf602b6e928178cc860fc22ada6184 Mon Sep 17 00:00:00 2001 From: Joe Marshall Date: Mon, 28 Mar 2011 10:41:18 -0700 Subject: [PATCH] Add and export GUARANTEE-PROMISE. --- src/runtime/runtime.pkg | 1 + src/runtime/udata.scm | 5 +++-- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg index 836b5c91a..d81887c41 100644 --- 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 d79fd9696..8f56c44da 100644 --- 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)) -- 2.25.1