commit b4b80374ad6c5875f11f158df8e063d23ca773a7
parent 9ad171b1c2435c8b4609a3879183ebdc473d9e7c
Author: Andres Navarro <canavarro82@gmail.com>
Date: Sun, 6 Mar 2011 23:51:19 -0300
Errors now use continuations. Improved repl code. Moved ground env init to a new file.
Diffstat:
17 files changed, 343 insertions(+), 218 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -9,7 +9,8 @@ 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
+ kcontinuation.o koperative.o kapplicative.o keval.o krepl.o \
+ kground.o
KRN_T= klisp
KRN_O= klisp.o
@@ -25,7 +26,7 @@ all: $(ALL_T)
o: $(ALL_O)
$(KRN_T): $(ALL_O)
- $(CC) -o $@ $(MYLDFLAGS) $(ALL_O) $(LIBS)
+ $(CC) $(CFLAGS) -o $@ $(MYLDFLAGS) $(ALL_O) $(LIBS)
clean:
$(RM) $(ALL_T) $(ALL_O)
@@ -46,9 +47,10 @@ ksymbol.o: ksymbol.c ksymbol.h kobject.h kpair.h kstate.h kmem.h klisp.h
kread.o: kread.c kread.h kobject.h ktoken.h kpair.h kstate.h kerror.h klisp.h
kwrite.o: kwrite.c kwrite.h kobject.h kpair.h kstring.h kstate.h kerror.h \
klisp.h
-kstate.o: kstate.c kstate.h klisp.h kobject.h kmem.h kstring.h klisp.h
+kstate.o: kstate.c kstate.h klisp.h kobject.h kmem.h kstring.h klisp.h \
+ kground.h
kmem.o: kmem.c kmem.h klisp.h kerror.h klisp.h
-kerror.o: kerror.c kerror.h klisp.h kstate.h klisp.h
+kerror.o: kerror.c kerror.h klisp.h kstate.h klisp.h kmem.h kstring.h
kauxlib.o: kauxlib.c kauxlib.h klisp.h kstate.h klisp.h
kenvironment.o: kenvironment.c kenvironment.h kpair.h kobject.h kerror.h \
kmem.h kstate.h klisp.h
@@ -61,4 +63,6 @@ kapplicative.o: kapplicative.c kapplicative.h kmem.h kstate.h kobject.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 \
- kread.h kwrite.h
-\ No newline at end of file
+ kread.h kwrite.h kenvironment.h
+kground.o: kground.c kground.h kstate.h kobject.h klisp.h kenvironment.h \
+ kpair.h kapplicative.h koperative.h ksymbol.h kerror.h
+\ No newline at end of file
diff --git a/src/kenvironment.c b/src/kenvironment.c
@@ -77,7 +77,7 @@ TValue kget_binding(klisp_State *K, TValue env, TValue sym)
env = kenv_parents(K, env);
}
- klispE_throw_extra(K, "Unbound symbol", ksymbol_buf(sym), true);
+ klispE_throw_extra(K, "Unbound symbol", ksymbol_buf(sym));
/* avoid warning */
return KINERT;
}
diff --git a/src/kerror.c b/src/kerror.c
@@ -1,23 +1,48 @@
#include <stdio.h>
+#include <string.h>
#include <stdlib.h>
-#include <stdbool.h>
-#include <setjmp.h>
#include "klisp.h"
#include "kstate.h"
+#include "kmem.h"
+#include "kstring.h"
-void klispE_throw(klisp_State *K, char *msg, bool can_cont)
+void clear_buffers(klisp_State *K)
{
- fprintf(stderr, "\n*ERROR*: %s\n", msg);
- K->error_can_cont = can_cont;
- longjmp(K->error_jb, 1);
+ /* XXX: clear stack and char buffer, clear shared dict */
+ /* TODO: put these in handlers for read-token, read and write */
+ ks_sclear(K);
+ ks_tbclear(K);
+ K->shared_dict = KNIL;
+}
+
+void klispE_throw(klisp_State *K, char *msg)
+{
+ TValue error_msg = kstring_new(K, msg, strlen(msg));
+ /* TEMP */
+ clear_buffers(K);
+
+ kcall_cont(K, K->error_cont, error_msg);
}
/* TEMP: for throwing with extra msg info */
-void klispE_throw_extra(klisp_State *K, char *msg, char *extra_msg,
- bool can_cont) {
- fprintf(stderr, "\n*ERROR*: %s %s\n", msg, extra_msg);
- K->error_can_cont = can_cont;
- longjmp(K->error_jb, 1);
+void klispE_throw_extra(klisp_State *K, char *msg, char *extra_msg) {
+ /* TODO */
+ int32_t l1 = strlen(msg);
+ int32_t l2 = strlen(extra_msg);
+
+ int32_t tl = l1+l2+1;
+
+ char *msg_buf = klispM_malloc(K, tl+1);
+ strcpy(msg_buf, msg);
+ msg_buf[l1] = ' ';
+ strcpy(msg_buf+l1+1, extra_msg);
+
+ TValue error_msg = kstring_new(K, msg_buf, tl);
+ klispM_freemem(K, msg_buf, tl+1);
+
+ clear_buffers(K);
+
+ kcall_cont(K, K->error_cont, error_msg);
}
diff --git a/src/kerror.h b/src/kerror.h
@@ -13,9 +13,8 @@
#include "klisp.h"
#include "kstate.h"
-void klispE_throw(klisp_State *K, char *msg, bool can_cont);
+void klispE_throw(klisp_State *K, char *msg);
/* TEMP: for throwing with extra msg info */
-void klispE_throw_extra(klisp_State *K, char *msg, char *extra_msg,
- bool can_cont);
+void klispE_throw_extra(klisp_State *K, char *msg, char *extra_msg);
#endif
diff --git a/src/keval.c b/src/keval.c
@@ -78,7 +78,7 @@ inline TValue make_arg_ls(klisp_State *K, TValue operands, TValue *tail)
*tail = KNIL;
} else {
clear_ls_marks(operands);
- klispE_throw(K, "Not a list in applicative combination", true);
+ klispE_throw(K, "Not a list in applicative combination");
return KINERT;
}
clear_ls_marks(operands);
@@ -120,7 +120,7 @@ void combine_cfn(klisp_State *K, TValue *xparams, TValue obj)
case K_TOPERATIVE:
ktail_call(K, obj, operands, env);
default:
- klispE_throw(K, "Not a combiner in combiner position", true);
+ klispE_throw(K, "Not a combiner in combiner position");
return;
}
}
diff --git a/src/kground.c b/src/kground.c
@@ -0,0 +1,84 @@
+/*
+** kground.h
+** Bindings in the ground environment
+** See Copyright Notice in klisp.h
+*/
+
+/* TODO: split in different files for each module */
+#include "kstate.h"
+#include "kobject.h"
+#include "kground.h"
+#include "kpair.h"
+#include "kenvironment.h"
+#include "kcontinuation.h"
+#include "ksymbol.h"
+#include "koperative.h"
+#include "kapplicative.h"
+#include "kerror.h"
+
+/* define helper */
+void match_cfn(klisp_State *K, TValue *xparams, TValue obj)
+{
+ /*
+ ** tparams[0]: ptree
+ ** tparams[1]: dynamic environment
+ */
+ TValue ptree = xparams[0];
+ TValue env = xparams[1];
+
+ /* TODO: allow general parameter trees */
+ if (!ttisignore(ptree)) {
+ kadd_binding(K, env, ptree, obj);
+ }
+ kapply_cc(K, KINERT);
+}
+
+/* the underlying function of a simple define */
+void def_ofn(klisp_State *K, TValue *xparams, TValue obj, TValue env)
+{
+ (void) xparams;
+ if (!ttispair(obj) || !ttispair(kcdr(obj)) || !ttisnil(kcdr(kcdr(obj)))) {
+ klispE_throw(K, "Bad syntax ($define!)");
+ return;
+ }
+ TValue ptree = kcar(obj);
+ TValue exp = kcar(kcdr(obj));
+ /* TODO: allow general ptrees */
+ if (!ttissymbol(ptree) && !ttisignore(ptree)) {
+ klispE_throw(K, "Not a symbol or ignore ($define!)");
+ return;
+ } else {
+ TValue new_cont = kmake_continuation(K, kget_cc(K), KNIL, KNIL,
+ &match_cfn, 2, ptree, env);
+ kset_cc(K, new_cont);
+ ktail_call(K, K->eval_op, exp, env);
+ }
+}
+
+/* the underlying function of cons */
+void cons_ofn(klisp_State *K, TValue *xparams, TValue obj, TValue env)
+{
+ if (!ttispair(obj) || !ttispair(kcdr(obj)) || !ttisnil(kcdr(kcdr(obj)))) {
+ klispE_throw(K, "Bad syntax (cons)");
+ return;
+ }
+ TValue car = kcar(obj);
+ TValue cdr = kcar(kcdr(obj));
+ TValue new_pair = kcons(K, car, cdr);
+ kapply_cc(K, new_pair);
+}
+
+TValue kmake_ground_env(klisp_State *K)
+{
+ TValue ground_env = kmake_empty_environment(K);
+
+ TValue g_define = kmake_operative(K, KNIL, KNIL, def_ofn, 0);
+ TValue s_define = ksymbol_new(K, "$define!");
+ kadd_binding(K, ground_env, s_define, g_define);
+
+ TValue g_cons = kwrap(K, kmake_operative(K, KNIL, KNIL, cons_ofn, 0));
+ TValue s_cons = ksymbol_new(K, "cons");
+ kadd_binding(K, ground_env, s_cons, g_cons);
+
+ return ground_env;
+}
diff --git a/src/kground.h b/src/kground.h
@@ -0,0 +1,14 @@
+/*
+** kground.h
+** Bindings in the ground environment
+** See Copyright Notice in klisp.h
+*/
+
+#ifndef kground_h
+#define kground_h
+
+#include "kstate.h"
+
+TValue kmake_ground_env(klisp_State *K);
+
+#endif
diff --git a/src/klisp.c b/src/klisp.c
@@ -31,110 +31,20 @@
#include "ksymbol.h"
#include "kerror.h"
-
-/* define helper */
-void match_cfn(klisp_State *K, TValue *xparams, TValue obj)
-{
- /*
- ** tparams[0]: ptree
- ** tparams[1]: dynamic environment
- */
- TValue ptree = xparams[0];
- TValue env = xparams[1];
-
- /* TODO: allow general parameter trees */
- if (!ttisignore(ptree)) {
- kadd_binding(K, env, ptree, obj);
- }
- kapply_cc(K, KINERT);
-}
-
-/* the underlying function of a simple define */
-void def_ofn(klisp_State *K, TValue *xparams, TValue obj, TValue env)
-{
- (void) xparams;
- if (!ttispair(obj) || !ttispair(kcdr(obj)) || !ttisnil(kcdr(kcdr(obj)))) {
- klispE_throw(K, "Bad syntax ($define!)", true);
- return;
- }
- TValue ptree = kcar(obj);
- TValue exp = kcar(kcdr(obj));
- /* TODO: allow general ptrees */
- if (!ttissymbol(ptree) && !ttisignore(ptree)) {
- klispE_throw(K, "Not a symbol or ignore ($define!)", true);
- return;
- } else {
- TValue new_cont = kmake_continuation(K, kget_cc(K), KNIL, KNIL,
- &match_cfn, 2, ptree, env);
- kset_cc(K, new_cont);
- ktail_call(K, K->eval_op, exp, env);
- }
-}
-
-/* the underlying function of cons */
-void cons_ofn(klisp_State *K, TValue *xparams, TValue obj, TValue env)
-{
- if (!ttispair(obj) || !ttispair(kcdr(obj)) || !ttisnil(kcdr(kcdr(obj)))) {
- klispE_throw(K, "Bad syntax (cons)", true);
- return;
- }
- TValue car = kcar(obj);
- TValue cdr = kcar(kcdr(obj));
- TValue new_pair = kcons(K, car, cdr);
- kapply_cc(K, new_pair);
-}
-
int main(int argc, char *argv[])
{
printf("Read/Write Test\n");
klisp_State *K = klispL_newstate();
-
- /* set up the continuations */
- K->eval_op = kmake_operative(K, KNIL, KNIL, keval_ofn, 0);
- TValue ground_env = kmake_empty_environment(K);
-
- TValue g_define = kmake_operative(K, KNIL, KNIL, def_ofn, 0);
- TValue s_define = ksymbol_new(K, "$define!");
- kadd_binding(K, ground_env, s_define, g_define);
-
- TValue g_cons = kwrap(K, kmake_operative(K, KNIL, KNIL, cons_ofn, 0));
- TValue s_cons = ksymbol_new(K, "cons");
- kadd_binding(K, ground_env, s_cons, g_cons);
-
- TValue std_env = kmake_environment(K, ground_env);
- TValue root_cont = kmake_continuation(K, KNIL, KNIL, KNIL,
- exit_fn, 0);
- TValue loop_cont = kmake_continuation(
- K, root_cont, KNIL, KNIL, &loop_fn, 1, std_env);
- TValue eval_cont = kmake_continuation(
- K, loop_cont, KNIL, KNIL, &eval_cfn, 1, std_env);
-
- kset_cc(K, eval_cont);
- /* NOTE: this will take effect only in the while (K->next_func) loop */
- klispS_apply_cc(K, kread(K));
+ kinit_repl(K);
int ret_value = 0;
bool done = false;
while(!done) {
if (setjmp(K->error_jb)) {
- /* error signaled */
- if (K->error_can_cont) {
- /* XXX: clear stack and char buffer, clear shared dict */
- /* TODO: put these in handlers for read-token, read and write */
- ks_sclear(K);
- ks_tbclear(K);
- K->shared_dict = KNIL;
-
- kset_cc(K, eval_cont);
- /* NOTE: this will take effect only in the while (K->next_func) loop */
- klispS_apply_cc(K, kread(K));
- } else {
- printf("Aborting...\n");
- ret_value = 1;
- done = true;
- }
+ /* continuation called */
+ /* TEMP: do nothing, the loop will call the continuation */
} else {
/* all ok, continue with next func */
while (K->next_func) {
diff --git a/src/kmem.c b/src/kmem.c
@@ -10,6 +10,7 @@
*/
#include <stddef.h>
+#include <stdio.h>
#include <assert.h>
#include "klisp.h"
@@ -43,8 +44,11 @@ void *klispM_realloc_ (klisp_State *K, void *block, size_t osize, size_t nsize)
klisp_assert((osize == 0) == (block == NULL));
block = (*K->frealloc)(K->ud, block, osize, nsize);
- if (block == NULL && nsize > 0)
- klispE_throw(K, MEMERRMSG, false);
+ if (block == NULL && nsize > 0) {
+ /* TODO: make this a catchable error */
+ fprintf(stderr, MEMERRMSG);
+ abort();
+ }
klisp_assert((nsize == 0) == (block == NULL));
K->totalbytes = (K->totalbytes - osize) + nsize;
return block;
diff --git a/src/kmem.h b/src/kmem.h
@@ -17,11 +17,11 @@
#define MEMERRMSG "not enough memory"
-#define klispM_freemem(L, b, s) klispM_realloc_(L, (b), (s), 0)
-#define klispM_free(L, b) klispM_realloc_(L, (b), sizeof(*(b)), 0)
+#define klispM_freemem(K, b, s) klispM_realloc_(K, (b), (s), 0)
+#define klispM_free(K, b) klispM_realloc_(K, (b), sizeof(*(b)), 0)
-#define klispM_malloc(L,t) klispM_realloc_(L, NULL, 0, (t))
-#define klispM_new(L,t) cast(t *, klispM_malloc(L, sizeof(t)))
+#define klispM_malloc(K,t) klispM_realloc_(K, NULL, 0, (t))
+#define klispM_new(K,t) cast(t *, klispM_malloc(K, sizeof(t)))
void *klispM_realloc_ (klisp_State *K, void *block, size_t oldsize,
size_t size);
diff --git a/src/kread.c b/src/kread.c
@@ -67,7 +67,7 @@ void kread_error(klisp_State *K, char *str)
{
/* clear the stack */
ks_sclear(K);
- klispE_throw(K, str, true);
+ klispE_throw(K, str);
}
/*
diff --git a/src/krepl.c b/src/krepl.c
@@ -10,9 +10,11 @@
#include "kstate.h"
#include "kobject.h"
#include "kcontinuation.h"
+#include "kenvironment.h"
#include "kerror.h"
-#include "kwrite.h"
#include "kread.h"
+#include "kwrite.h"
+#include "kstring.h"
#include "krepl.h"
/* the exit continuation, it exits the loop */
@@ -27,6 +29,18 @@ void exit_fn(klisp_State *K, TValue *xparams, TValue obj)
return;
}
+/* the underlying function of the read cont */
+void read_fn(klisp_State *K, TValue *xparams, TValue obj)
+{
+ (void) obj;
+ (void) xparams;
+
+ /* show prompt */
+ fprintf(stdout, "klisp> ");
+ obj = kread(K);
+ kapply_cc(K,obj);
+}
+
/* the underlying function of the eval cont */
void eval_cfn(klisp_State *K, TValue *xparams, TValue obj)
{
@@ -38,6 +52,21 @@ void eval_cfn(klisp_State *K, TValue *xparams, TValue obj)
ktail_call(K, K->eval_op, obj, denv);
}
+void loop_fn(klisp_State *K, TValue *xparams, TValue obj);
+
+/* this is called from both loop_fn and error_fn */
+inline void create_loop(klisp_State *K, TValue denv)
+{
+ TValue loop_cont = kmake_continuation(
+ K, K->root_cont, KNIL, KNIL, &loop_fn, 1, denv);
+ TValue eval_cont = kmake_continuation(
+ K, loop_cont, KNIL, KNIL, &eval_cfn, 1, denv);
+ TValue read_cont = kmake_continuation(
+ K, eval_cont, KNIL, KNIL, &read_fn, 0);
+ kset_cc(K, read_cont);
+ kapply_cc(K, KINERT);
+}
+
/* the underlying function of the write & loop cont */
void loop_fn(klisp_State *K, TValue *xparams, TValue obj)
{
@@ -51,13 +80,40 @@ void loop_fn(klisp_State *K, TValue *xparams, TValue obj)
kwrite(K, obj);
knewline(K);
TValue denv = xparams[0];
-
- TValue loop_cont = kmake_continuation(
- K, kget_cc(K), KNIL, KNIL, &loop_fn, 1, denv);
- TValue eval_cont = kmake_continuation(
- K, loop_cont, KNIL, KNIL, &eval_cfn, 1, denv);
- kset_cc(K, eval_cont);
- TValue robj = kread(K);
- kapply_cc(K, robj);
+ create_loop(K, denv);
}
}
+
+/* the underlying function of the error cont */
+void error_fn(klisp_State *K, TValue *xparams, TValue obj)
+{
+ /*
+ ** xparams[0]: dynamic environment
+ */
+ /* TEMP: obj should be a string */
+ /* TODO: create some kind of error object */
+ char *str = ttisstring(obj)?
+ kstring_buf(obj) : "not a string passed to error continuation";
+
+ fprintf(stderr, "\n*ERRROR*: %s\n", str);
+
+ TValue denv = xparams[0];
+ create_loop(K, denv);
+}
+
+/* call this to init the repl in a newly created klisp state */
+void kinit_repl(klisp_State *K)
+{
+ TValue std_env = kmake_environment(K, K->ground_env);
+
+ /* set up the continuations */
+ TValue root_cont = kmake_continuation(K, KNIL, KNIL, KNIL,
+ exit_fn, 0);
+ TValue error_cont = kmake_continuation(K, KNIL, KNIL, KNIL,
+ error_fn, 1, std_env);
+
+ K->root_cont = root_cont;
+ K->error_cont = error_cont;
+
+ create_loop(K, std_env);
+}
diff --git a/src/krepl.h b/src/krepl.h
@@ -11,8 +11,6 @@
#include "kstate.h"
#include "kobject.h"
-void loop_fn(klisp_State *K, TValue *xparams, TValue obj);
-void eval_cfn(klisp_State *K, TValue *xparams, TValue obj);
-void exit_fn(klisp_State *K, TValue *xparams, TValue obj);
+void kinit_repl(klisp_State *K);
#endif
diff --git a/src/kstate.c b/src/kstate.c
@@ -9,102 +9,129 @@
*/
#include <stddef.h>
+#include <setjmp.h>
#include "klisp.h"
#include "kstate.h"
+#include "kobject.h"
#include "kstring.h"
#include "kpair.h"
#include "kmem.h"
+#include "keval.h"
+#include "koperative.h"
+#include "kground.h"
+
/*
** State creation and destruction
*/
klisp_State *klisp_newstate (klisp_Alloc f, void *ud) {
- klisp_State *K;
- void *k = (*f)(ud, NULL, 0, state_size());
- if (k == NULL) return NULL;
- void *s = (*f)(ud, NULL, 0, KS_ISSIZE * sizeof(TValue));
- if (s == NULL) {
- (*f)(ud, k, state_size(), 0);
- return NULL;
- }
- void *b = (*f)(ud, NULL, 0, KS_ITBSIZE);
- if (b == NULL) {
- (*f)(ud, k, state_size(), 0);
- (*f)(ud, s, KS_ISSIZE * sizeof(TValue), 0);
- return NULL;
- }
-
- K = (klisp_State *) k;
-
- K->symbol_table = KNIL;
- /* TODO: create a continuation */
- K->curr_cont = KNIL;
-
- K->next_func = NULL;
- K->next_value = KINERT;
- K->next_env = KNIL;
- K->next_xparams = NULL;
-
- K->eval_op = KINERT;
-
- K->frealloc = f;
- K->ud = ud;
-
- /* current input and output */
- K->curr_in = stdin;
- K->curr_out = stdout;
- K->filename_in = "*STDIN*";
- K->filename_out = "*STDOUT*";
-
- /* TODO: more gc info */
- K->totalbytes = KS_ISSIZE + state_size();
-
- /* TEMP: err */
- /* do nothing for now */
-
- /* initialize strings */
- /* Empty string */
- /* TODO: make it uncollectible */
- K->empty_string = kstring_new_empty(K);
-
- /* initialize tokenizer */
-
- /* WORKAROUND: for stdin line buffering & reading of EOF */
- K->ktok_seen_eof = false;
-
- ks_tbsize(K) = KS_ITBSIZE;
- ks_tbidx(K) = 0; /* buffer is empty */
- ks_tbuf(K) = (char *)b;
-
- /* Special Tokens */
- K->ktok_lparen = kcons(K, ch2tv('('), KNIL);
- K->ktok_rparen = kcons(K, ch2tv(')'), KNIL);
- K->ktok_dot = kcons(K, ch2tv('.'), KNIL);
-
- /* TEMP: For now just hardcode it to 8 spaces tab-stop */
- K->ktok_source_info.tab_width = 8;
- K->ktok_source_info.filename = "*STDIN*";
- ktok_init(K);
- ktok_reset_source_info(K);
-
- /* initialize reader */
- K->shared_dict = KNIL;
-
- /* initialize writer */
-
- /* initialize temp stack */
- K->ssize = KS_ISSIZE;
- K->stop = 0; /* stack is empty */
- K->sbuf = (TValue *)s;
-
- return K;
+ klisp_State *K;
+ void *k = (*f)(ud, NULL, 0, state_size());
+ if (k == NULL) return NULL;
+ void *s = (*f)(ud, NULL, 0, KS_ISSIZE * sizeof(TValue));
+ if (s == NULL) {
+ (*f)(ud, k, state_size(), 0);
+ return NULL;
+ }
+ void *b = (*f)(ud, NULL, 0, KS_ITBSIZE);
+ if (b == NULL) {
+ (*f)(ud, k, state_size(), 0);
+ (*f)(ud, s, KS_ISSIZE * sizeof(TValue), 0);
+ return NULL;
+ }
+
+ K = (klisp_State *) k;
+
+ K->symbol_table = KNIL;
+ /* TODO: create a continuation */
+ K->curr_cont = KNIL;
+
+ K->next_func = NULL;
+ K->next_value = KINERT;
+ K->next_env = KNIL;
+ K->next_xparams = NULL;
+
+ K->eval_op = KINERT;
+ K->ground_env = KINERT;
+
+ K->frealloc = f;
+ K->ud = ud;
+
+ /* current input and output */
+ K->curr_in = stdin;
+ K->curr_out = stdout;
+ K->filename_in = "*STDIN*";
+ K->filename_out = "*STDOUT*";
+
+ /* TODO: more gc info */
+ K->totalbytes = KS_ISSIZE + state_size();
+
+ /* TEMP: err */
+ /* do nothing for now */
+
+ /* initialize strings */
+ /* Empty string */
+ /* TODO: make it uncollectible */
+ K->empty_string = kstring_new_empty(K);
+
+ /* initialize tokenizer */
+
+ /* WORKAROUND: for stdin line buffering & reading of EOF */
+ K->ktok_seen_eof = false;
+
+ ks_tbsize(K) = KS_ITBSIZE;
+ ks_tbidx(K) = 0; /* buffer is empty */
+ ks_tbuf(K) = (char *)b;
+
+ /* Special Tokens */
+ K->ktok_lparen = kcons(K, ch2tv('('), KNIL);
+ K->ktok_rparen = kcons(K, ch2tv(')'), KNIL);
+ K->ktok_dot = kcons(K, ch2tv('.'), KNIL);
+
+ /* TEMP: For now just hardcode it to 8 spaces tab-stop */
+ K->ktok_source_info.tab_width = 8;
+ K->ktok_source_info.filename = "*STDIN*";
+ ktok_init(K);
+ ktok_reset_source_info(K);
+
+ /* initialize reader */
+ K->shared_dict = KNIL;
+
+ /* initialize writer */
+
+ /* initialize temp stack */
+ K->ssize = KS_ISSIZE;
+ K->stop = 0; /* stack is empty */
+ K->sbuf = (TValue *)s;
+
+ /* create the ground environment and the eval operative */
+ K->eval_op = kmake_operative(K, KNIL, KNIL, keval_ofn, 0);
+ K->ground_env = kmake_ground_env(K);
+
+ return K;
}
void klisp_close (klisp_State *K)
{
/* TODO: free memory for all objects */
klispM_freemem(K, ks_sbuf(K), ks_ssize(K));
+ klispM_freemem(K, ks_tbuf(K), ks_tbsize(K));
/* NOTE: this needs to be done "by hand" */
(*(K->frealloc))(K->ud, K, state_size(), 0);
}
+
+
+void kcall_cont(klisp_State *K, TValue dst_cont, TValue obj)
+{
+ /* TODO: interceptions */
+ Continuation *cont = tv2cont(dst_cont);
+ K->next_func = cont->fn;
+ K->next_value = obj;
+ /* NOTE: this is needed to differentiate a return from a tail call */
+ K->next_env = KNIL;
+ K->next_xparams = cont->extra;
+ K->curr_cont = cont->parent;
+
+ longjmp(K->error_jb, 1);
+}
diff --git a/src/kstate.h b/src/kstate.h
@@ -51,6 +51,9 @@ struct klisp_State {
TValue *next_xparams;
TValue eval_op; /* the operative for evaluation */
+ TValue ground_env;
+ TValue root_cont;
+ TValue error_cont;
klisp_Alloc frealloc; /* function to reallocate memory */
void *ud; /* auxiliary data to `frealloc' */
@@ -58,9 +61,8 @@ struct klisp_State {
/* TODO: gc info */
int32_t totalbytes;
- /* TEMP:error handling */
+ /* TEMP: error handling */
jmp_buf error_jb;
- bool error_can_cont; /* can continue after error? */
/* standard input and output */
/* TODO: eventually these should be ports */
@@ -268,5 +270,7 @@ inline void klispS_tail_call(klisp_State *K, TValue top, TValue ptree,
#define ktail_call(K_, op_, p_, e_) \
klispS_tail_call((K_), (op_), (p_), (e_)); return
+void kcall_cont(klisp_State *K, TValue cont, TValue obj);
+
#endif
diff --git a/src/ktoken.c b/src/ktoken.c
@@ -222,7 +222,7 @@ void ktok_error(klisp_State *K, char *str)
{
/* clear the buffer before throwing an error */
ks_tbclear(K);
- klispE_throw(K, str, true);
+ klispE_throw(K, str);
}
diff --git a/src/kwrite.c b/src/kwrite.c
@@ -32,7 +32,7 @@
void kwrite_error(klisp_State *K, char *msg)
{
- klispE_throw(K, msg, true);
+ klispE_throw(K, msg);
}
/*
