commit b4f7355824d7fb78e36302fe13764edd592eda97
parent 5b3a758e511562b8c6fe34ae427f1791945f829f
Author: Andres Navarro <canavarro82@gmail.com>
Date: Wed, 16 Mar 2011 02:56:21 -0300
Added promise object definition, contructor & accessors. Added promise case to kwrite.
Diffstat:
6 files changed, 83 insertions(+), 1 deletion(-)
diff --git a/src/Makefile b/src/Makefile
@@ -10,7 +10,7 @@ MYLIBS=
CORE_O= kobject.o ktoken.o kpair.o kstring.o ksymbol.o kread.o \
kwrite.o kstate.o kmem.o kerror.o kauxlib.o kenvironment.o \
kcontinuation.o koperative.o kapplicative.o keval.o krepl.o \
- kencapsulation.o \
+ kencapsulation.o kpromise.o \
kground.o kghelpers.o kgbooleans.o kgeqp.o kgequalp.o \
kgsymbols.o kgcontrol.o kgpairs_lists.o kgpair_mut.o kgenvironments.o \
kgenv_mut.o kgcombiners.o kgcontinuations.o kgencapsulations.o
@@ -66,6 +66,8 @@ kapplicative.o: kapplicative.c kapplicative.h kmem.h kstate.h kobject.h \
klisp.h
kencapsulation.o: kencapsulation.c kencapsulation.h kmem.h kstate.h kobject.h \
klisp.h kpair.h
+kpromise.o: kpromise.c kpromise.h kmem.h kstate.h kobject.h \
+ klisp.h kpair.h
keval.o: keval.c keval.h kcontinuation.h kenvironment.h kstate.h kobject.h \
kpair.h kerror.h klisp.h
krepl.o: krepl.c krepl.h kcontinuation.h kstate.h kobject.h keval.h klisp.h \
diff --git a/src/kobject.h b/src/kobject.h
@@ -122,6 +122,7 @@ typedef struct __attribute__ ((__packed__)) GCheader {
#define K_TOPERATIVE 35
#define K_TAPPLICATIVE 36
#define K_TENCAPSULATION 37
+#define K_TPROMISE 38
#define K_MAKE_VTAG(t) (K_TAG_TAGGED | (t))
@@ -154,6 +155,7 @@ typedef struct __attribute__ ((__packed__)) GCheader {
#define K_TAG_OPERATIVE K_MAKE_VTAG(K_TOPERATIVE)
#define K_TAG_APPLICATIVE K_MAKE_VTAG(K_TAPPLICATIVE)
#define K_TAG_ENCAPSULATION K_MAKE_VTAG(K_TENCAPSULATION)
+#define K_TAG_PROMISE K_MAKE_VTAG(K_TPROMISE)
/*
@@ -191,6 +193,7 @@ typedef struct __attribute__ ((__packed__)) GCheader {
#define ttisenvironment(o) (tbasetype_(o) == K_TAG_ENVIRONMENT)
#define ttiscontinuation(o) (tbasetype_(o) == K_TAG_CONTINUATION)
#define ttisencapsulation(o) (tbasetype_(o) == K_TAG_ENCAPSULATION)
+#define ttispromise(o) (tbasetype_(o) == K_TAG_PROMISE)
/* macros to easily check boolean values */
#define kis_true(o_) (tv_equal((o_), KTRUE))
@@ -287,6 +290,18 @@ typedef struct __attribute__ ((__packed__)) {
TValue value; /* encapsulated object */
} Encapsulation;
+typedef struct __attribute__ ((__packed__)) {
+ CommonHeader;
+ TValue name;
+ TValue si; /* source code info (either () or (filename line col) */
+ TValue node; /* pair (exp . maybe-env) */
+ /* if maybe-env is nil, then the promise has determined exp,
+ otherwise the promise should eval exp in maybe-env when forced
+ It has to be a pair to allow sharing between different promises
+ So that determining one determines all the promises that are
+ sharing the pair */
+} Promise;
+
/*
** RATIONALE:
**
@@ -325,6 +340,7 @@ union GCObject {
Operative op;
Applicative app;
Encapsulation enc;
+ Promise prom;
};
@@ -385,6 +401,7 @@ const TValue keminf;
#define gc2op(o_) (gc2tv(K_TAG_OPERATIVE, o_))
#define gc2app(o_) (gc2tv(K_TAG_APPLICATIVE, o_))
#define gc2enc(o_) (gc2tv(K_TAG_ENCAPSULATION, o_))
+#define gc2prom(o_) (gc2tv(K_TAG_PROMISE, o_))
/* Macro to convert a TValue into a specific heap allocated object */
#define tv2pair(v_) ((Pair *) gcvalue(v_))
@@ -395,6 +412,7 @@ const TValue keminf;
#define tv2op(v_) ((Operative *) gcvalue(v_))
#define tv2app(v_) ((Applicative *) gcvalue(v_))
#define tv2enc(v_) ((Encapsulation *) gcvalue(v_))
+#define tv2prom(v_) ((Promise *) gcvalue(v_))
#define tv2gch(v_) ((GCheader *) gcvalue(v_))
#define tv2mgch(v_) ((MGCheader *) gcvalue(v_))
diff --git a/src/kpromise.c b/src/kpromise.c
@@ -0,0 +1,31 @@
+/*
+** kpromise.c
+** Kernel Promises
+** See Copyright Notice in klisp.h
+*/
+
+#include "kobject.h"
+#include "kstate.h"
+#include "kpromise.h"
+#include "kpair.h"
+#include "kmem.h"
+
+TValue kmake_promise(klisp_State *K, TValue name, TValue si,
+ TValue exp, TValue maybe_env)
+{
+ Promise *new_prom = klispM_new(K, Promise);
+
+ /* header + gc_fields */
+ new_prom->next = K->root_gc;
+ K->root_gc = (GCObject *)new_prom;
+ new_prom->gct = 0;
+ new_prom->tt = K_TPROMISE;
+ new_prom->flags = 0;
+
+ /* promise specific fields */
+ new_prom->name = name;
+ new_prom->si = si;
+ /* GC: root new_prom before cons */
+ new_prom->node = kcons(K, exp, maybe_env);
+ return gc2prom(new_prom);
+}
diff --git a/src/kpromise.h b/src/kpromise.h
@@ -0,0 +1,25 @@
+/*
+** kpromise.h
+** Kernel Promises
+** See Copyright Notice in klisp.h
+*/
+
+#ifndef kpromise_h
+#define kpromise_h
+
+#include "kobject.h"
+#include "kstate.h"
+#include "kpair.h"
+
+TValue kmake_promise(klisp_State *K, TValue name, TValue si,
+ TValue exp, TValue maybe_env);
+
+#define kpromise_node(p_) (tv2prom(p_)->node)
+inline void kdetermine_promise(TValue p, TValue obj)
+{
+ TValue node = kpromise_node(p);
+ kset_car(node, obj);
+ kset_cdr(node, KNIL);
+}
+
+#endif
diff --git a/src/kstate.c b/src/kstate.c
@@ -457,6 +457,9 @@ void klisp_close (klisp_State *K)
case K_TENCAPSULATION:
klispM_free(K, (Encapsulation *)obj);
break;
+ case K_TPROMISE:
+ klispM_free(K, (Promise *)obj);
+ break;
default:
/* shouldn't happen */
fprintf(stderr, "Unknown GCObject type: %d\n", type);
diff --git a/src/kwrite.c b/src/kwrite.c
@@ -216,6 +216,9 @@ void kwrite_simple(klisp_State *K, TValue obj)
/* TODO try to get the name */
kw_printf(K, "[encapsulation]");
break;
+ case K_TPROMISE:
+ kw_printf(K, "[promise]");
+ break;
default:
/* shouldn't happen */
kwrite_error(K, "unknown object type");
