Merge remote-tracking branch 'origin/stable-2.0'

[bpt/guile.git] / module / srfi / srfi-45.scm

diff --git a/module/srfi/srfi-45.scm b/module/srfi/srfi-45.scm
index 29b0393..6f7ba7e 100644 (file)
--- a/module/srfi/srfi-45.scm
+++ b/module/srfi/srfi-45.scm
@@ -1,6 +1,6 @@
 ;;; srfi-45.scm -- Primitives for Expressing Iterative Lazy Algorithms
 
-;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010, 2011, 2013 Free Software Foundation, Inc.
 ;; Copyright (C) 2003 André van Tonder. All Rights Reserved.
 
 ;; Permission is hereby granted, free of charge, to any person
@@ -25,8 +25,8 @@
 
 ;;; Commentary:
 
-;; This is the code of the reference implementation of SRFI-45, slightly
-;; modified to use SRFI-9.
+;; This is the code of the reference implementation of SRFI-45, modified
+;; to use SRFI-9 and to add 'promise?' to the list of exports.
 
 ;; This module is documented in the Guile Reference Manual.
 
@@ -36,9 +36,13 @@
   #:export (delay
              lazy
              force
-             eager)
-  #:replace (delay force)
-  #:use-module (srfi srfi-9))
+             eager
+             promise?)
+  #:replace (delay force promise?)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-9 gnu))
+
+(cond-expand-provide (current-module) '(srfi-45))
 
 (define-record-type promise (make-promise val) promise?
   (val promise-val promise-val-set!))
@@ -73,3 +77,17 @@
 ;; (*) These two lines re-fetch and check the original promise in case
 ;;     the first line of the let* caused it to be forced.  For an example
 ;;     where this happens, see reentrancy test 3 below.
+
+(define* (promise-visit promise #:key on-eager on-lazy)
+  (define content (promise-val promise))
+  (case (value-tag content)
+    ((eager) (on-eager (value-proc content)))
+    ((lazy)  (on-lazy (value-proc content)))))
+
+(set-record-type-printer! promise
+  (lambda (promise port)
+    (promise-visit promise
+      #:on-eager (lambda (value)
+                   (format port "#<promise = ~s>" value))
+      #:on-lazy  (lambda (proc)
+                   (format port "#<promise => ~s>" proc)))))