klisp

an open source interpreter for the Kernel Programming Language.
git clone http://git.hanabi.in/repos/klisp.git
Log | Files | Refs | README

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:
Msrc/Makefile | 4+++-
Msrc/kobject.h | 18++++++++++++++++++
Asrc/kpromise.c | 31+++++++++++++++++++++++++++++++
Asrc/kpromise.h | 25+++++++++++++++++++++++++
Msrc/kstate.c | 3+++
Msrc/kwrite.c | 3+++
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");