mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-07-01 15:20:34 +02:00
63317ff480
* am/bootstrap.am (SOURCES): * module/ice-9/promises.scm: New file. * libguile/promises.h: * libguile/promises.c: Delete. * libguile/deprecated.h: * libguile/deprecated.c: Add promises shims. * libguile/init.c: * libguile/Makefile.am: * libguile.h: Remove promises mentions. * module/ice-9/deprecated.scm: Add shims to include promises in the default environment. * module/ice-9/null.scm: * module/ice-9/safe-r5rs.scm: * module/ice-9/sandbox.scm: * module/language/bytecode.scm: * module/language/cps/guile-vm/reify-primitives.scm: * module/language/elisp/parser.scm: * module/rnrs/r5rs.scm: * test-suite/tests/00-initial-env.test: * test-suite/tests/eval.test: * test-suite/tests/r4rs.test: Import (ice-9 promises).
74 lines
2.3 KiB
Scheme
74 lines
2.3 KiB
Scheme
;;; 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
|
||
;;; <http://www.gnu.org/licenses/>.
|
||
|
||
;;; 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 <promise>
|
||
(%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))
|