/* [<][>][^][v][top][bottom][index][help] */
DEFINITIONS
This source file includes following definitions.
- ScmPromiseContent
- promise_print
- Scm_MakePromise
- force_cc
- Scm_Force
1 /*
2 * promise.c - promise object
3 *
4 * Copyright (c) 2000-2003 Shiro Kawai, All rights reserved.
5 *
6 * Redistribution and use in source and binary forms, with or without
7 * modification, are permitted provided that the following conditions
8 * are met:
9 *
10 * 1. Redistributions of source code must retain the above copyright
11 * notice, this list of conditions and the following disclaimer.
12 *
13 * 2. Redistributions in binary form must reproduce the above copyright
14 * notice, this list of conditions and the following disclaimer in the
15 * documentation and/or other materials provided with the distribution.
16 *
17 * 3. Neither the name of the authors nor the names of its contributors
18 * may be used to endorse or promote products derived from this
19 * software without specific prior written permission.
20 *
21 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
24 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
25 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
26 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
27 * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
28 * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
29 * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
30 * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
31 * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
32 *
33 * $Id: promise.c,v 1.14 2005/07/16 19:37:53 shirok Exp $
34 */
35
36 #define LIBGAUCHE_BODY
37 #include "gauche.h"
38
39 /* NB: We adopted the semantics described in srfi-45.
40 * http://srfi.schemers.org/srfi-45/srfi-45.html
41 *
42 * The 'forced' flag indicates one of two state of a promise.
43 *
44 * forced == TRUE: the promise is in 'eager' state. code has a value.
45 * forced == FALSE: the promise is in 'lazy' state. code has a thunk.
46 *
47 * [syntax] lazy expr : Promise a -> Promise a
48 * Creates a lazy promise, delaying evaluation of expr.
49 * [procedure] eager expr : a -> Promise a
50 * Creates a eager promise, encapsulating the result of evaluation of expr.
51 * [syntax] delay expr : a -> Promise a
52 * (lazy (eager expr))
53 * [procedure] force expr : Promise a -> a
54 *
55 * One might want to create a subtype of promise; for example, srfi-40
56 * requires the stream type to be distinct from other types, although
57 * it is essentially a promise with a specific usage pattern. To realize
58 * that portably, one need effectively reimplement force/delay mechanism
59 * (since 'eager' operation is required to return Stream instread of Promise),
60 * which is kind of shame.
61 *
62 * Gauche experimentally tries to address this problem by allowing the
63 * program to add a specific KIND object to a promise instance.
64 *
65 */
66
67 /*
68 * The body of promise
69 */
70 typedef struct ScmPromiseContentRec {
71 int forced; /* TRUE if code has a thunk */
72 ScmObj code;
73 } ScmPromiseContent;
74
75 /*
76 * class stuff
77 */
78
79 static void promise_print(ScmObj obj, ScmPort *port, ScmWriteContext *ctx)
80 {
81 ScmPromise *p = (ScmPromise*)obj;
82 const char *forced = p->content->forced? " (forced)" : "";
83 if (SCM_FALSEP(p->kind)) {
84 Scm_Printf(port, "#<promise %p%s>", p, forced);
85 } else {
86 Scm_Printf(port, "#<promise(%S) %p%s>", p->kind, p, forced);
87 }
88 }
89
90 SCM_DEFINE_BUILTIN_CLASS_SIMPLE(Scm_PromiseClass, promise_print);
91
92 /*
93 * promise object
94 */
95
96 ScmObj Scm_MakePromise(int forced, ScmObj code)
97 {
98 ScmPromise *p = SCM_NEW(ScmPromise);
99 ScmPromiseContent *c = SCM_NEW(ScmPromiseContent);
100 SCM_SET_CLASS(p, SCM_CLASS_PROMISE);
101 c->forced = forced;
102 c->code = code;
103 p->content = c;
104 p->kind = SCM_FALSE;
105 return SCM_OBJ(p);
106 }
107
108 /*
109 * force
110 */
111
112 static ScmObj force_cc(ScmObj result, void **data)
113 {
114 ScmPromise *p = (ScmPromise*)data[0];
115
116 /* Check if the original promise is forced by evaluating
117 the delayed expr to detect recursive force situation */
118 if (!p->content->forced) {
119 if (SCM_PROMISEP(result)) {
120 /* Deal with a recursive promise introduced by lazy operation.
121 See srfi-45 for the details. */
122 p->content->forced = SCM_PROMISE(result)->content->forced;
123 p->content->code = SCM_PROMISE(result)->content->code;
124 SCM_PROMISE(result)->content = p->content;
125 } else {
126 /* This isn't supposed to happen if 'lazy' is used properly
127 on the promise-yielding procedure, but we can't prevent
128 one from writing (lazy 3). So play safe. */
129 p->content->forced = TRUE;
130 p->content->code = result;
131 }
132 }
133 SCM_RETURN(Scm_Force(SCM_OBJ(p)));
134 }
135
136 ScmObj Scm_Force(ScmObj obj)
137 {
138 if (!SCM_PROMISEP(obj)) {
139 SCM_RETURN(obj);
140 } else {
141 ScmPromise *p = (ScmPromise*)obj;
142 if (p->content->forced) SCM_RETURN(p->content->code);
143 else {
144 Scm_VMPushCC(force_cc, (void**)&p, 1);
145 SCM_RETURN(Scm_VMApply0(p->content->code));
146 }
147 }
148 }
149
150