klisp

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

commit f0a444c02b25d86024b30729e62f0cd5bf172388
parent 9eedfc4afa2c930bab72a94e132e86e3ce649e46
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Wed, 23 Mar 2011 17:30:08 -0300

Added get-current-input-port & get-current-output-port to the ground environment.

Diffstat:
Msrc/Makefile | 2+-
Msrc/kgports.c | 20+++++++++++++++++++-
Msrc/kgports.h | 3++-
Msrc/kground.c | 5++++-
4 files changed, 26 insertions(+), 4 deletions(-)

diff --git a/src/Makefile b/src/Makefile @@ -127,7 +127,7 @@ kgks_vars.o: kgks_vars.c kgks_vars.h kghelpers.h kstate.h klisp.h \ kgports.o: kgports.c kgports.h kghelpers.h kstate.h klisp.h \ kobject.h kerror.h kapplicative.h koperative.h kcontinuation.h \ kport.h ksymbol.h kread.h kwrite.h ktoken.h kgcontinuations.h \ - kpair.h kenvironment.h + kpair.h kenvironment.h kgcontrol.h kgkd_vars.h kgchars.o: kgchars.c kgchars.h kghelpers.h kstate.h klisp.h \ kobject.h kerror.h kapplicative.h koperative.h kcontinuation.h kgnumbers.o: kgnumbers.c kgnumbers.h kghelpers.h kstate.h klisp.h \ diff --git a/src/kgports.c b/src/kgports.c @@ -29,6 +29,7 @@ #include "kgports.h" #include "kgcontinuations.h" /* for guards */ #include "kgcontrol.h" /* for evaling in sequence */ +#include "kgkd_vars.h" /* for dynamic input/output port */ /* 15.1.1 port? */ /* uses typep */ @@ -40,7 +41,24 @@ /* TODO */ /* 15.1.4 get-current-input-port, get-current-output-port */ -/* TODO */ +void get_current_port(klisp_State *K, TValue *xparams, TValue ptree, + TValue denv) +{ + /* + ** xparams[0]: symbol name + ** xparams[1]: dynamic key + */ + UNUSED(denv); + + char *name = ksymbol_buf(xparams[0]); + TValue key = xparams[1]; + + check_0p(K, name, ptree); + + /* can access directly, no need to call do_access */ + kapply_cc(K, kcdr(key)); +} + /* 15.1.5 open-input-file, open-output-file */ void open_file(klisp_State *K, TValue *xparams, TValue ptree, TValue denv) diff --git a/src/kgports.h b/src/kgports.h @@ -28,7 +28,8 @@ /* TODO */ /* 15.1.4 get-current-input-port, get-current-output-port */ -/* TODO */ +void get_current_port(klisp_State *K, TValue *xparams, TValue ptree, + TValue denv); /* 15.1.5 open-input-file, open-output-file */ void open_file(klisp_State *K, TValue *xparams, TValue ptree, TValue denv); diff --git a/src/kground.c b/src/kground.c @@ -770,7 +770,10 @@ void kinit_ground_env(klisp_State *K) /* TODO */ /* 15.1.4 get-current-input-port, get-current-output-port */ - /* TODO */ + add_applicative(K, ground_env, "get-current-input-port", get_current_port, + 2, symbol, K->kd_in_port_key); + add_applicative(K, ground_env, "get-current-output-port", get_current_port, + 2, symbol, K->kd_out_port_key); /* 15.1.5 open-input-file, open-output-file */ add_applicative(K, ground_env, "open-input-file", open_file, 2, symbol,