diff --git a/am/bootstrap.am b/am/bootstrap.am
index 15eec8c0a..48134cfd5 100644
--- a/am/bootstrap.am
+++ b/am/bootstrap.am
@@ -175,6 +175,7 @@ SOURCES = \
ice-9/ports.scm \
ice-9/posix.scm \
ice-9/pretty-print.scm \
+ ice-9/promises.scm \
ice-9/q.scm \
ice-9/r5rs.scm \
ice-9/rdelim.scm \
diff --git a/libguile.h b/libguile.h
index dbcae11e9..eb0326604 100644
--- a/libguile.h
+++ b/libguile.h
@@ -80,7 +80,6 @@ extern "C" {
#include "libguile/posix.h"
#include "libguile/print.h"
#include "libguile/procprop.h"
-#include "libguile/promises.h"
#include "libguile/procs.h"
#include "libguile/r6rs-ports.h"
#include "libguile/random.h"
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index c9f792467..23d18f40a 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -201,7 +201,6 @@ libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES = \
procprop.c \
procs.c \
programs.c \
- promises.c \
r6rs-ports.c \
random.c \
rdelim.c \
@@ -307,7 +306,6 @@ DOT_X_FILES = \
procprop.x \
procs.x \
programs.x \
- promises.x \
r6rs-ports.x \
random.x \
rdelim.x \
@@ -400,7 +398,6 @@ DOT_DOC_FILES = \
print.doc \
procprop.doc \
procs.doc \
- promises.doc \
r6rs-ports.doc \
random.doc \
rdelim.doc \
@@ -651,7 +648,6 @@ modinclude_HEADERS = \
print.h \
procprop.h \
procs.h \
- promises.h \
pthread-threads.h \
r6rs-ports.h \
random.h \
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index ea932d4e9..cfec1d729 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -641,6 +641,52 @@ scm_get_print_state (SCM port)
return SCM_BOOL_F;
}
+
+
+static SCM make_promise_var;
+static SCM force_var;
+static SCM promise_p_var;
+
+static void
+init_promise_vars (void)
+{
+ make_promise_var = scm_c_public_lookup ("ice-9 promises", "make-promise");
+ force_var = scm_c_public_lookup ("ice-9 promises", "force");
+ promise_p_var = scm_c_public_lookup ("ice-9 promises", "promise?");
+}
+
+static void
+init_promise_functions (void)
+{
+ static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
+ scm_c_issue_deprecation_warning
+ ("Using the SCM promise functions from C is deprecated. Invoke"
+ "force, etc. from (ice-9 promises) or (srfi srfi-45) instead.");
+ scm_i_pthread_once (&once, init_promise_vars);
+}
+
+SCM
+scm_make_promise (SCM thunk)
+{
+ init_promise_functions ();
+ return scm_call_1 (scm_variable_ref (make_promise_var), thunk);
+}
+
+SCM
+scm_promise_p (SCM x)
+{
+ init_promise_functions ();
+ return scm_call_1 (scm_variable_ref (promise_p_var), x);
+}
+
+SCM
+scm_force (SCM promise)
+{
+ init_promise_functions ();
+ return scm_call_1 (scm_variable_ref (force_var), promise);
+}
+
+
void
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index eaa1340ba..0403f7e59 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -109,6 +109,10 @@ SCM_DEPRECATED SCM scm_get_print_state (SCM port);
#define SCM_COERCE_OUTPORT(p) (scm_coerce_outport (p))
#define SCM_VALIDATE_OPORT_VALUE(pos, port) SCM_VALIDATE_OPOUTPORT(pos, port)
+SCM_DEPRECATED SCM scm_make_promise (SCM thunk);
+SCM_DEPRECATED SCM scm_force (SCM x);
+SCM_DEPRECATED SCM scm_promise_p (SCM x);
+
/* Deprecated declarations go here. */
void scm_i_init_deprecated (void);
diff --git a/libguile/init.c b/libguile/init.c
index 29a3dbc43..0118c8a99 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -106,7 +106,6 @@
#include "procprop.h"
#include "procs.h"
#include "programs.h"
-#include "promises.h"
#ifdef ENABLE_REGEX
#include "regex-posix.h"
#endif
@@ -393,7 +392,6 @@ scm_i_init_guile (struct gc_stack_addr base)
scm_init_hash ();
scm_init_hashtab ();
scm_init_deprecation ();
- scm_init_promises (); /* requires smob_prehistory */
scm_init_stime ();
scm_init_gc (); /* Requires hooks and `get_internal_run_time' */
scm_init_gc_protect_object (); /* requires threads_prehistory */
diff --git a/libguile/promises.c b/libguile/promises.c
deleted file mode 100644
index 8502728c3..000000000
--- a/libguile/promises.c
+++ /dev/null
@@ -1,135 +0,0 @@
-/* Copyright 1995-2011,2018,2025
- Free Software Foundation, Inc.
-
- This file is part of Guile.
-
- Guile is free software: you can redistribute it and/or modify it
- under the terms of the GNU Lesser General Public License as published
- by the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
-
- Guile is distributed in the hope that it will be useful, but WITHOUT
- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
- FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
- License for more details.
-
- You should have received a copy of the GNU Lesser General Public
- License along with Guile. If not, see
- . */
-
-
-
-#ifdef HAVE_CONFIG_H
-# include
-#endif
-
-#include
-
-#include "alist.h"
-#include "async.h"
-#include "continuations.h"
-#include "debug.h"
-#include "deprecation.h"
-#include "dynwind.h"
-#include "eq.h"
-#include "eval.h"
-#include "feature.h"
-#include "fluids.h"
-#include "goops.h"
-#include "gsubr.h"
-#include "hash.h"
-#include "hashtab.h"
-#include "list.h"
-#include "macros.h"
-#include "memoize.h"
-#include "modules.h"
-#include "ports.h"
-#include "print.h"
-#include "procprop.h"
-#include "procs.h"
-#include "programs.h"
-#include "smob.h"
-#include "stackchk.h"
-#include "strings.h"
-#include "threads.h"
-#include "throw.h"
-#include "values.h"
-
-#include "promises.h"
-
-
-
-
-scm_t_bits scm_tc16_promise;
-
-SCM_DEFINE (scm_make_promise, "make-promise", 1, 0, 0,
- (SCM thunk),
- "Create a new promise object.\n\n"
- "@code{make-promise} is a procedural form of @code{delay}.\n"
- "These two expressions are equivalent:\n"
- "@lisp\n"
- "(delay @var{exp})\n"
- "(make-promise (lambda () @var{exp}))\n"
- "@end lisp\n")
-#define FUNC_NAME s_scm_make_promise
-{
- SCM_VALIDATE_THUNK (1, thunk);
- SCM_RETURN_NEWSMOB2 (scm_tc16_promise,
- SCM_UNPACK (thunk),
- SCM_UNPACK (scm_make_recursive_mutex ()));
-}
-#undef FUNC_NAME
-
-static int
-promise_print (SCM exp, SCM port, scm_print_state *pstate)
-{
- scm_puts ("#', port);
- return !0;
-}
-
-SCM_DEFINE (scm_force, "force", 1, 0, 0,
- (SCM promise),
- "If @var{promise} has not been computed yet, compute and\n"
- "return @var{promise}, otherwise just return the previously computed\n"
- "value.")
-#define FUNC_NAME s_scm_force
-{
- SCM_VALIDATE_SMOB (1, promise, promise);
- scm_lock_mutex (SCM_PROMISE_MUTEX (promise));
- if (!SCM_PROMISE_COMPUTED_P (promise))
- {
- SCM ans = scm_call_0 (SCM_PROMISE_DATA (promise));
- if (!SCM_PROMISE_COMPUTED_P (promise))
- {
- SCM_SET_PROMISE_DATA (promise, ans);
- SCM_SET_PROMISE_COMPUTED (promise);
- }
- }
- scm_unlock_mutex (SCM_PROMISE_MUTEX (promise));
- return SCM_PROMISE_DATA (promise);
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_promise_p, "promise?", 1, 0, 0,
- (SCM obj),
- "Return true if @var{obj} is a promise, i.e. a delayed computation\n"
- "(@pxref{Delayed evaluation,,,r5rs.info,The Revised^5 Report on Scheme}).")
-#define FUNC_NAME s_scm_promise_p
-{
- return scm_from_bool (SCM_TYP16_PREDICATE (scm_tc16_promise, obj));
-}
-#undef FUNC_NAME
-
-void
-scm_init_promises ()
-{
- scm_tc16_promise = scm_make_smob_type ("promise", 0);
- scm_set_smob_print (scm_tc16_promise, promise_print);
-
-#include "promises.x"
-
- scm_add_feature ("delay");
-}
diff --git a/libguile/promises.h b/libguile/promises.h
deleted file mode 100644
index dcb736d6b..000000000
--- a/libguile/promises.h
+++ /dev/null
@@ -1,53 +0,0 @@
-#ifndef SCM_PROMISES_H
-#define SCM_PROMISES_H
-
-/* Copyright 1995-1996,1998-2004,2008-2009,2018
- Free Software Foundation, Inc.
-
- This file is part of Guile.
-
- Guile is free software: you can redistribute it and/or modify it
- under the terms of the GNU Lesser General Public License as published
- by the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
-
- Guile is distributed in the hope that it will be useful, but WITHOUT
- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
- FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
- License for more details.
-
- You should have received a copy of the GNU Lesser General Public
- License along with Guile. If not, see
- . */
-
-
-
-#include "libguile/smob.h"
-
-
-
-/* {Promises}
- */
-
-#define SCM_F_PROMISE_COMPUTED (1L << 0)
-#define SCM_PROMISE_COMPUTED_P(promise) \
- (SCM_F_PROMISE_COMPUTED & SCM_SMOB_FLAGS (promise))
-#define SCM_SET_PROMISE_COMPUTED(promise) \
- SCM_SET_SMOB_FLAGS ((promise), SCM_F_PROMISE_COMPUTED)
-#define SCM_PROMISE_MUTEX SCM_SMOB_OBJECT_2
-#define SCM_PROMISE_DATA SCM_SMOB_OBJECT
-#define SCM_SET_PROMISE_DATA SCM_SET_SMOB_OBJECT
-
-
-SCM_API scm_t_bits scm_tc16_promise;
-
-
-
-SCM_API SCM scm_make_promise (SCM thunk);
-SCM_API SCM scm_force (SCM x);
-SCM_API SCM scm_promise_p (SCM x);
-
-SCM_INTERNAL void scm_init_promises (void);
-
-
-#endif /* SCM_PROMISES_H */
diff --git a/libguile/scm.h b/libguile/scm.h
index e9d24bed1..8e2903917 100644
--- a/libguile/scm.h
+++ b/libguile/scm.h
@@ -515,8 +515,6 @@ typedef uintptr_t scm_t_bits;
#define scm_tc16_directory 0x047f
#define scm_tc16_syntax_transformer 0x057f
/*
-#define scm_tc16_malloc 0x0b7f
-#define scm_tc16_port_with_print_state 0x0d7f
#define scm_tc16_promise 0x0e7f
#define scm_tc16_random_state 0x0f7f
#define scm_tc16_regexp 0x107f
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 096a644f5..e3aed3afe 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -661,9 +661,6 @@ If returning early, return the return value of F."
(set! dummy #f) ; blackhole dummy
v))))))))
-(define-syntax-rule (delay exp)
- (make-promise (lambda () exp)))
-
(define-syntax with-fluids
(lambda (stx)
(define (emit-with-fluids bindings body)
diff --git a/module/ice-9/deprecated.scm b/module/ice-9/deprecated.scm
index 39ffe3100..bdf3beb75 100644
--- a/module/ice-9/deprecated.scm
+++ b/module/ice-9/deprecated.scm
@@ -23,6 +23,7 @@
#:use-module (ice-9 weak-tables)
#:use-module (ice-9 arrays)
#:use-module (ice-9 scm-style-repl)
+ #:use-module (ice-9 promises)
#:use-module (system repl hooks)
#:use-module (system repl reader)
#:use-module (srfi srfi-14)
@@ -134,7 +135,11 @@
(reset-hook!* . reset-hook!)
(run-hook* . run-hook)
(hook->list* . hook->list)
- module-defined-hook))
+ module-defined-hook
+ (make-promise* . make-promise)
+ (promise? . promise?)
+ (delay* . delay)
+ (force* . force)))
(define-syntax define-deprecated/stx
(lambda (stx)
@@ -374,3 +379,9 @@
(lambda (m)
(run-hook module-defined-hook m)
(prev m))))
+
+(define-deprecated-trampolines (ice-9 promises)
+ (promise? x)
+ (make-promise thunk)
+ (force promise))
+(define-deprecated*/stx (ice-9 promises) delay)
diff --git a/module/ice-9/null.scm b/module/ice-9/null.scm
index 8f87239fe..cf88b0fd0 100644
--- a/module/ice-9/null.scm
+++ b/module/ice-9/null.scm
@@ -1,4 +1,4 @@
-;;;; Copyright (C) 2000, 2001, 2006, 2019 Free Software Foundation, Inc.
+;;;; Copyright (C) 2000, 2001, 2006, 2019, 2025 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -18,6 +18,7 @@
;;;; The null environment - only syntactic bindings
(define-module (ice-9 null)
+ #:use-module (ice-9 promises)
#:re-export-syntax (define quote lambda if set!
cond case => _ ... else
diff --git a/module/ice-9/promises.scm b/module/ice-9/promises.scm
new file mode 100644
index 000000000..98c3ddb56
--- /dev/null
+++ b/module/ice-9/promises.scm
@@ -0,0 +1,74 @@
+;;; Copyright (C) 2025 Free Software Foundation, Inc.
+;;;
+;;; This library is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU Lesser General Public License as
+;;; published by the Free Software Foundation, either version 3 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; This library is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;; Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this program. If not, see
+;;; .
+
+;;; Commentary:
+;;;
+;;;
+;;; Code:
+
+
+(define-module (ice-9 promises)
+ #:use-module (srfi srfi-9)
+ #:use-module (ice-9 threads)
+ ;; FIXME: #:export instead of #:replace when deprecated code removed
+ #:replace (make-promise
+ force
+ delay
+ promise?))
+
+(define-record-type
+ (%make-promise computed? data lock)
+ %promise?
+ (computed? promise-computed? set-promise-computed?!)
+ (data promise-data set-promise-data!)
+ (lock promise-lock))
+
+(define (make-promise thunk)
+
+ "Create a new promise object.
+
+@code{make-promise} is a procedural form of @code{delay}.
+
+These two expressions are equivalent:
+@lisp
+(delay @var{exp})
+(make-promise (lambda () @var{exp}))
+@end lisp"
+ (%make-promise #f thunk (make-recursive-mutex)))
+
+(define-syntax-rule (delay exp)
+ (make-promise (lambda () exp)))
+
+(define (force promise)
+ "If @var{promise} has not been computed yet, compute and return
+@var{promise}, otherwise just return the previously computed value."
+ (with-mutex (promise-lock promise)
+ (if (promise-computed? promise)
+ (promise-data promise)
+ (let* ((thunk (promise-data promise))
+ (ans (thunk)))
+ (if (promise-computed? promise)
+ (promise-data promise)
+ (begin
+ (set-promise-computed?! promise #t)
+ (set-promise-data! promise ans)
+ ans))))))
+
+(define (promise? x)
+ "Return true if @var{obj} is a promise, i.e. a delayed
+computation (@pxref{Delayed evaluation,,,r5rs.info,The Revised^5 Report
+on Scheme})."
+ (%promise? x))
diff --git a/module/ice-9/safe-r5rs.scm b/module/ice-9/safe-r5rs.scm
index 8bc20e712..b646aba6f 100644
--- a/module/ice-9/safe-r5rs.scm
+++ b/module/ice-9/safe-r5rs.scm
@@ -1,4 +1,4 @@
-;;;; Copyright (C) 2000-2001,2004,2006,2008-2010,2019
+;;;; Copyright (C) 2000-2001,2004,2006,2008-2010,2019,2025
;;;; Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
@@ -24,6 +24,7 @@
#:use-module (ice-9 ports)
#:use-module ((guile) #:select ((_ . ^_)
(... . ^...)))
+ #:use-module (ice-9 promises)
#:re-export (quote
quasiquote
unquote unquote-splicing
diff --git a/module/ice-9/sandbox.scm b/module/ice-9/sandbox.scm
index 2c384bf26..e633c9a99 100644
--- a/module/ice-9/sandbox.scm
+++ b/module/ice-9/sandbox.scm
@@ -1257,7 +1257,7 @@ allocation limit is exceeded, an exception will be thrown to the
vector-set!)))
(define promise-bindings
- '(((guile)
+ '(((ice-9 promises)
force
delay
make-promise
diff --git a/module/language/bytecode.scm b/module/language/bytecode.scm
index e9cbb7ea0..ce0d88800 100644
--- a/module/language/bytecode.scm
+++ b/module/language/bytecode.scm
@@ -20,6 +20,7 @@
(define-module (language bytecode)
#:use-module (ice-9 match)
+ #:use-module (ice-9 promises)
#:use-module ((srfi srfi-1) #:select (fold))
#:export (instruction-list
builtin-name->index
diff --git a/module/language/cps/guile-vm/reify-primitives.scm b/module/language/cps/guile-vm/reify-primitives.scm
index 9dff9d1c3..7e5a47568 100644
--- a/module/language/cps/guile-vm/reify-primitives.scm
+++ b/module/language/cps/guile-vm/reify-primitives.scm
@@ -26,6 +26,7 @@
(define-module (language cps guile-vm reify-primitives)
#:use-module (ice-9 match)
+ #:use-module (ice-9 promises)
#:use-module ((language tree-il primitives)
#:select ((primitive-module . tree-il:primitive-module)))
#:use-module (language cps)
diff --git a/module/language/elisp/parser.scm b/module/language/elisp/parser.scm
index 586abbf7e..86b4b175e 100644
--- a/module/language/elisp/parser.scm
+++ b/module/language/elisp/parser.scm
@@ -20,6 +20,7 @@
(define-module (language elisp parser)
#:use-module (ice-9 source-properties)
+ #:use-module (ice-9 promises)
#:use-module (language elisp lexer)
#:export (read-elisp))
diff --git a/module/rnrs/r5rs.scm b/module/rnrs/r5rs.scm
index ab7485407..3ae541ffd 100644
--- a/module/rnrs/r5rs.scm
+++ b/module/rnrs/r5rs.scm
@@ -1,6 +1,6 @@
;;; r5rs.scm --- The R6RS / R5RS compatibility library
-;; Copyright (C) 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2010, 2025 Free Software Foundation, Inc.
;;
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
@@ -26,9 +26,7 @@
null-environment scheme-report-environment)
(import (only (guile) exact->inexact inexact->exact
-
- quotient remainder modulo
-
- delay force)
+ quotient remainder modulo)
+ (only (ice-9 promises) delay force)
(only (ice-9 r5rs) scheme-report-environment)
(only (ice-9 safe-r5rs) null-environment)))
diff --git a/test-suite/tests/00-initial-env.test b/test-suite/tests/00-initial-env.test
index c57079e68..4638e40a6 100644
--- a/test-suite/tests/00-initial-env.test
+++ b/test-suite/tests/00-initial-env.test
@@ -1,6 +1,6 @@
;;;; 00-initial-env.test --- Roots. -*- mode: scheme; coding: utf-8; -*-
;;;;
-;;;; Copyright (C) 2010 Free Software Foundation, Inc.
+;;;; Copyright (C) 2010, 2025 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -17,6 +17,7 @@
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
(define-module (the-initial-env)
+ #:use-module (ice-9 promises)
#:use-module (test-suite lib))
;;; A set of tests to run early. The file name is to have `check-guile' pick
diff --git a/test-suite/tests/eval.test b/test-suite/tests/eval.test
index 968c78d12..2ac2c0d81 100644
--- a/test-suite/tests/eval.test
+++ b/test-suite/tests/eval.test
@@ -24,6 +24,7 @@
:use-module (ice-9 documentation)
:use-module (ice-9 exceptions)
:use-module (ice-9 guardians)
+ :use-module (ice-9 promises)
:use-module (ice-9 local-eval))
diff --git a/test-suite/tests/r4rs.test b/test-suite/tests/r4rs.test
index f6455a207..5f07f647a 100644
--- a/test-suite/tests/r4rs.test
+++ b/test-suite/tests/r4rs.test
@@ -1,5 +1,5 @@
;;;; r4rs.test --- tests for R4RS compliance -*- scheme -*-
-;;;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1999, 2001, 2006, 2023 Free Software Foundation, Inc.
+;;;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1999, 2001, 2006, 2023, 2025 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -16,8 +16,9 @@
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
(define-module (test-suite test-r4rs)
- :use-module (test-suite lib)
- :use-module (test-suite guile-test))
+ #:use-module (ice-9 promises)
+ #:use-module (test-suite lib)
+ #:use-module (test-suite guile-test))
;;;; ============= NOTE =============