klisp

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

commit e0678d72256220d66159a2f43665af510db85d79
parent 145c7b439648b359c021a316a02144d5f6e74d8f
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Sat,  5 Mar 2011 16:37:01 -0300

Basic structure of a primitive REPL (added eval step, for now it is an identity fn).

Diffstat:
Msrc/klisp.c | 93+++++++++++++++++++++++++++++++++++++++++++++++++------------------------------
1 file changed, 58 insertions(+), 35 deletions(-)

diff --git a/src/klisp.c b/src/klisp.c @@ -25,20 +25,6 @@ #include "kenvironment.h" #include "koperative.h" -/* -** Simple read/write loop -*/ -void main_body(klisp_State *K) -{ - TValue obj = KNIL; - - while(!ttiseof(obj)) { - obj = kread(K); - kwrite(K, obj); - knewline(K); - } -} - /* the exit continuation, it exits the loop */ void exit_fn(klisp_State *K, TValue *xparams, TValue obj) { @@ -51,33 +37,62 @@ void exit_fn(klisp_State *K, TValue *xparams, TValue obj) return; } -/* the underlying function of the read operative */ -void read_fn(klisp_State *K, TValue *xparams, TValue ptree, TValue env) +/* the underlying function of the eval cont */ +void eval_ofn(klisp_State *K, TValue *xparams, TValue obj, TValue env) { - (void) ptree; - (void) env; (void) xparams; - TValue obj = kread(K); - kapply_cc(K, obj); + (void) env; + + switch(ttype(obj)) { + case K_TPAIR: + /* TODO */ + kapply_cc(K, obj); + break; + case K_TSYMBOL: + /* TODO */ + kapply_cc(K, obj); + break; + default: + kapply_cc(K, obj); + } +} + +/* the underlying function of the eval operative */ +void eval_cfn(klisp_State *K, TValue *xparams, TValue obj) +{ + /* + ** tparams[0]: eval operative + ** tparams[1]: dynamic environment + */ + TValue eval_op = xparams[0]; + TValue denv = xparams[1]; + + ktail_call(K, eval_op, obj, denv); } -/* the underlying function of the loop */ +/* the underlying function of the write & loop cont */ void loop_fn(klisp_State *K, TValue *xparams, TValue obj) { - /* tparams[0] is the read operative, - in tparams[1] a dummy environment */ + /* + ** tparams[0]: eval operative + ** tparams[1]: dynamic environment + */ if (ttiseof(obj)) { /* this will in turn call main_cont */ kapply_cc(K, obj); } else { kwrite(K, obj); knewline(K); - TValue read_op = *xparams; - TValue dummy_env = *xparams; - TValue new_cont = kmake_continuation( - K, kget_cc(K), KNIL, KNIL, &loop_fn, 2, read_op, dummy_env); - kset_cc(K, new_cont); - ktail_call(K, read_op, KNIL, dummy_env); + TValue eval_op = xparams[0]; + TValue denv = xparams[1]; + + TValue loop_cont = kmake_continuation( + K, kget_cc(K), KNIL, KNIL, &loop_fn, 2, eval_op, denv); + TValue eval_cont = kmake_continuation( + K, loop_cont, KNIL, KNIL, &eval_cfn, 2, eval_op, denv); + kset_cc(K, eval_cont); + TValue robj = kread(K); + kapply_cc(K, robj); } } @@ -88,15 +103,19 @@ int main(int argc, char *argv[]) klisp_State *K = klispL_newstate(); /* set up the continuations */ - TValue read_op = kmake_operative(K, KNIL, KNIL, read_fn, 0); - TValue dummy_env = kmake_empty_environment(K); + TValue eval_op = kmake_operative(K, KNIL, KNIL, eval_ofn, 0); + TValue ground_env = kmake_empty_environment(K); + 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, 2, read_op, dummy_env); - kset_cc(K, loop_cont); + TValue loop_cont = kmake_continuation( + K, root_cont, KNIL, KNIL, &loop_fn, 2, eval_op, std_env); + TValue eval_cont = kmake_continuation( + K, loop_cont, KNIL, KNIL, &eval_cfn, 2, eval_op, std_env); + + kset_cc(K, eval_cont); /* NOTE: this will take effect only in the while (K->next_func) loop */ - klispS_tail_call(K, read_op, KNIL, dummy_env); + klispS_apply_cc(K, kread(K)); int ret_value = 0; bool done = false; @@ -110,6 +129,10 @@ int main(int argc, char *argv[]) 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;