klisp

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

commit e58ca3bbd097080d48bbd680984e3fc7987f963b
parent fbd1b69b68cc68b9b48a251d26b3e1bb28dde7ef
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Fri, 18 Nov 2011 14:35:10 -0300

Added get-string-buffer, get-bytevector-buffer, file-port?, string-port? and bytevector-port? to the ground environment.

Diffstat:
Msrc/Makefile | 4++--
Msrc/kgports.c | 86++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-------------
Msrc/kgports.h | 13+++++++++++++
Msrc/klimits.h | 2+-
Msrc/kport.c | 15+++++++++++++++
Msrc/kport.h | 3+++
6 files changed, 106 insertions(+), 17 deletions(-)

diff --git a/src/Makefile b/src/Makefile @@ -207,7 +207,7 @@ kgports.o: kgports.c kstate.h klimits.h klisp.h kobject.h klispconf.h \ ktoken.h kmem.h kport.h kenvironment.h kapplicative.h koperative.h \ kcontinuation.h kpair.h kgc.h kerror.h ksymbol.h kstring.h kread.h \ kwrite.h kghelpers.h kgports.h kgcontinuations.h kgcontrol.h kgkd_vars.h \ - kscript.h + kscript.h kbytevector.h kgpromises.o: kgpromises.c kstate.h klimits.h klisp.h kobject.h \ klispconf.h ktoken.h kmem.h kpromise.h kpair.h kgc.h kapplicative.h \ koperative.h kcontinuation.h kerror.h kghelpers.h kenvironment.h \ @@ -249,7 +249,7 @@ koperative.o: koperative.c koperative.h kobject.h klimits.h klisp.h \ kpair.o: kpair.c kpair.h kobject.h klimits.h klisp.h klispconf.h kstate.h \ ktoken.h kmem.h kgc.h kport.o: kport.c kport.h kobject.h klimits.h klisp.h klispconf.h kstate.h \ - ktoken.h kmem.h kerror.h kstring.h kgc.h + ktoken.h kmem.h kerror.h kstring.h kbytevector.h kgc.h kpromise.o: kpromise.c kobject.h klimits.h klisp.h klispconf.h kstate.h \ ktoken.h kmem.h kpromise.h kpair.h kgc.h krational.o: krational.c krational.h kobject.h klimits.h klisp.h \ diff --git a/src/kgports.c b/src/kgports.c @@ -13,6 +13,8 @@ #include "kstate.h" #include "kobject.h" #include "kport.h" +#include "kstring.h" +#include "kbytevector.h" #include "kenvironment.h" #include "kapplicative.h" #include "koperative.h" @@ -39,6 +41,12 @@ /* 15.1.2 input-port?, output-port? */ /* use ftypep */ +/* 15.1.? binary-port?, textual-port? */ +/* use ftypep */ + +/* 15.1.? file-port?, string-port?, bytevector-port? */ +/* use ftypep */ + /* 15.1.? port-open? */ /* uses ftyped_predp */ @@ -162,7 +170,10 @@ void open_mport(klisp_State *K, TValue *xparams, TValue ptree, TValue denv) /* 15.1.6 close-input-file, close-output-file */ void close_file(klisp_State *K, TValue *xparams, TValue ptree, TValue denv) { - bool writep = bvalue(xparams[1]); + /* + ** xparams[0]: write? + */ + bool writep = bvalue(xparams[0]); UNUSED(denv); bind_1tp(K, ptree, "file port", ttisfport, port); @@ -181,8 +192,12 @@ void close_file(klisp_State *K, TValue *xparams, TValue ptree, TValue denv) /* 15.1.? close-input-port, close-output-port, close-port */ void close_port(klisp_State *K, TValue *xparams, TValue ptree, TValue denv) { - bool readp = bvalue(xparams[1]); - bool writep = bvalue(xparams[2]); + /* + ** xparams[0]: read? + ** xparams[1]: write? + */ + bool readp = bvalue(xparams[0]); + bool writep = bvalue(xparams[1]); UNUSED(denv); bind_1tp(K, ptree, "port", ttisport, port); @@ -199,6 +214,36 @@ void close_port(klisp_State *K, TValue *xparams, TValue ptree, TValue denv) } } +/* 15.1.? get-output-string, get-output-bytevector */ +void get_output_buffer(klisp_State *K, TValue *xparams, TValue ptree, + TValue denv) +{ + /* + ** xparams[0]: binary? + */ + bool binaryp = bvalue(xparams[0]); + UNUSED(denv); + bind_1tp(K, ptree, "port", ttisport, port); + + if (binaryp && !kport_is_binary(port)) { + klispE_throw_simple(K, "the port should be a bytevector port"); + return; + } else if (!binaryp && !kport_is_textual(port)) { + klispE_throw_simple(K, "the port should be a string port"); + return; + } else if (!kport_is_output(port)) { + klispE_throw_simple(K, "the port should be an output port"); + return; + } + + TValue ret = binaryp? + kbytevector_new_bs(K, + kbytevector_buf(kmport_buf(port)), + kmport_off(port)) : + kstring_new_bs(K, kstring_buf(kmport_buf(port)), kmport_off(port)); + kapply_cc(K, ret); +} + /* 15.1.7 read */ void read(klisp_State *K, TValue *xparams, TValue ptree, TValue denv) { @@ -829,6 +874,10 @@ void rename_file(klisp_State *K, TValue *xparams, TValue ptree, TValue denv) /* init ground */ void kinit_ports_ground_env(klisp_State *K) { + /* + ** Some of these are from r7rs scheme + */ + TValue ground_env = K->ground_env; TValue symbol, value; @@ -845,6 +894,13 @@ void kinit_ports_ground_env(klisp_State *K) p2tv(kbinary_portp)); add_applicative(K, ground_env, "textual-port?", ftypep, 2, symbol, p2tv(ktextual_portp)); + /* 15.1.2 file-port?, string-port?, bytevector-port? */ + add_applicative(K, ground_env, "file-port?", ftypep, 2, symbol, + p2tv(kfile_portp)); + add_applicative(K, ground_env, "string-port?", ftypep, 2, symbol, + p2tv(kstring_portp)); + add_applicative(K, ground_env, "bytevector-port?", ftypep, 2, symbol, + p2tv(kbytevector_portp)); /* 15.1.? port-open? */ add_applicative(K, ground_env, "port-open?", ftyped_predp, 3, symbol, p2tv(kportp), p2tv(kport_openp)); @@ -889,27 +945,29 @@ void kinit_ports_ground_env(klisp_State *K) /* 15.1.6 close-input-file, close-output-file */ /* ASK John: should this be called close-input-port & close-ouput-port like in r5rs? that doesn't seem consistent with open thou */ - add_applicative(K, ground_env, "close-input-file", close_file, 2, symbol, + add_applicative(K, ground_env, "close-input-file", close_file, 1, b2tv(false)); - add_applicative(K, ground_env, "close-output-file", close_file, 2, symbol, + add_applicative(K, ground_env, "close-output-file", close_file, 1, b2tv(true)); /* 15.1.? Use the r7rs names, in preparation for other kind of ports */ - add_applicative(K, ground_env, "close-input-port", close_port, 3, symbol, + add_applicative(K, ground_env, "close-input-port", close_port, 2, b2tv(true), b2tv(false)); - add_applicative(K, ground_env, "close-output-port", close_port, 3, symbol, + add_applicative(K, ground_env, "close-output-port", close_port, 2, b2tv(false), b2tv(true)); - add_applicative(K, ground_env, "close-port", close_port, 3, symbol, + add_applicative(K, ground_env, "close-port", close_port, 2, b2tv(false), b2tv(false)); + /* 15.1.? get-output-string, get-output-bytevector */ + add_applicative(K, ground_env, "get-output-string", get_output_buffer, 1, + b2tv(false)); + add_applicative(K, ground_env, "get-output-bytevector", get_output_buffer, + 1, b2tv(true)); + /* 15.1.7 read */ add_applicative(K, ground_env, "read", read, 0); /* 15.1.8 write */ add_applicative(K, ground_env, "write", write, 0); - /* - ** These are from scheme (r5rs) - */ - /* 15.1.? eof-object? */ add_applicative(K, ground_env, "eof-object?", typep, 2, symbol, i2tv(K_TEOF)); @@ -955,11 +1013,11 @@ void kinit_ports_ground_env(klisp_State *K) /* 15.2.? display */ add_applicative(K, ground_env, "display", display, 0); - /* r7rs */ - /* 15.1.? flush-output-port */ add_applicative(K, ground_env, "flush-output-port", flush, 0); + /* REFACTOR move to system module */ + /* 15.1.? file-exists? */ add_applicative(K, ground_env, "file-exists?", file_existsp, 0); diff --git a/src/kgports.h b/src/kgports.h @@ -24,6 +24,12 @@ /* 15.1.2 input-port?, output-port? */ /* use ftypep */ +/* 15.1.? binary-port?, textual-port? */ +/* use ftypep */ + +/* 15.1.? file-port?, string-port?, bytevector-port? */ +/* use ftypep */ + /* 15.1.? port-open? */ /* uses ftyped_predp */ @@ -47,6 +53,13 @@ void open_mport(klisp_State *K, TValue *xparams, TValue ptree, TValue denv); /* 15.1.6 close-input-file, close-output-file */ void close_file(klisp_State *K, TValue *xparams, TValue ptree, TValue denv); +/* 15.1.? close-port, close-input-port, close-output-port */ +void close_port(klisp_State *K, TValue *xparams, TValue ptree, TValue denv); + +/* 15.1.? get-output-string, get-output-bytevector */ +void get_output_buffer(klisp_State *K, TValue *xparams, TValue ptree, + TValue denv); + /* 15.1.7 read */ void read(klisp_State *K, TValue *xparams, TValue ptree, TValue denv); diff --git a/src/klimits.h b/src/klimits.h @@ -72,7 +72,7 @@ #define MINSTRINGPORTBUFFER 256 #endif -/* starting size for bytebuffer port buffers */ +/* starting size for bytevector port buffers */ #ifndef MINBYTEVECTORPORTBUFFER #define MINBYTEVECTORPORTBUFFER 256 #endif diff --git a/src/kport.c b/src/kport.c @@ -42,6 +42,21 @@ bool ktextual_portp(TValue o) return ttisport(o) && kport_is_textual(o); } +bool kfile_portp(TValue o) +{ + return ttisfport(o); +} + +bool kstring_portp(TValue o) +{ + return ttismport(o) && kport_is_textual(o); +} + +bool kbytevector_portp(TValue o) +{ + return ttismport(o) && kport_is_binary(o); +} + bool kport_openp(TValue o) { klisp_assert(ttisport(o)); diff --git a/src/kport.h b/src/kport.h @@ -19,6 +19,9 @@ bool kinput_portp(TValue o); bool koutput_portp(TValue o); bool kbinary_portp(TValue o); bool ktextual_portp(TValue o); +bool kfile_portp(TValue o); +bool kstring_portp(TValue o); +bool kbytevector_portp(TValue o); bool kport_openp(TValue o); bool kport_closedp(TValue o);