commit 1fd77306e1272028f751d976d666cf682e43e9dd
parent 317177e992151c6ba0e5ce27ad86cf019ed1ea2f
Author: Andres Navarro <canavarro82@gmail.com>
Date: Thu, 17 Mar 2011 16:32:22 -0300
Added write and read to the ground environment. BUG: the check for [EOF] of the repl is after eval instead of after read so when EOF is evaluated in the repl the repl exits.
Diffstat:
8 files changed, 90 insertions(+), 13 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -123,4 +123,4 @@ kgks_vars.o: kgks_vars.c kgks_vars.h kghelpers.h kstate.h klisp.h \
kpair.h kenvironment.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
+ kport.h ksymbol.h kread.h kwrite.h
diff --git a/src/kgports.c b/src/kgports.c
@@ -18,6 +18,8 @@
#include "kcontinuation.h"
#include "kerror.h"
#include "ksymbol.h"
+#include "kread.h"
+#include "kwrite.h"
#include "kghelpers.h"
#include "kgports.h"
@@ -67,6 +69,57 @@ void close_file(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
}
}
+/* 15.1.7 read */
+/* TEMP: the port parameter is not optional yet */
+void read(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+{
+ UNUSED(xparams);
+ UNUSED(denv);
+
+ bind_1tp(K, "read", ptree, "port", ttisport, port);
+
+ if (!kport_is_input(port)) {
+ klispE_throw(K, "read: the port should be an input port");
+ return;
+ } else if (kport_is_closed(port)) {
+ klispE_throw(K, "read: the port is already closed");
+ return;
+ }
+
+ /* TEMP: for now set this by hand */
+ K->curr_in = tv2port(port)->file;
+ ktok_reset_source_info(K); /* this should be saved in the port
+ and restored before the call to
+ read and saved after it */
+ TValue obj = kread(K); /* this may throw an error, that's ok */
+ kapply_cc(K, obj);
+}
+
+/* 15.1.8 write */
+/* TEMP: the port parameter is not optional yet */
+void write(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+{
+ UNUSED(xparams);
+ UNUSED(denv);
+
+ bind_2tp(K, "write", ptree, "any", anytype, obj,
+ "port", ttisport, port);
+
+ if (!kport_is_output(port)) {
+ klispE_throw(K, "write: the port should be an output port");
+ return;
+ } else if (kport_is_closed(port)) {
+ klispE_throw(K, "write: the port is already closed");
+ return;
+ }
+
+ /* TEMP: for now set this by hand */
+ K->curr_out = tv2port(port)->file;
+
+ kwrite(K, obj);
+ kapply_cc(K, KINERT);
+}
+
/* 15.2.1 call-with-input-file, call-with-output-file */
/* TODO */
diff --git a/src/kgports.h b/src/kgports.h
@@ -36,6 +36,12 @@ void open_file(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.7 read */
+void read(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+
+/* 15.1.8 write */
+void write(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+
/* 15.2.1 call-with-input-file, call-with-output-file */
/* TODO */
diff --git a/src/kground.c b/src/kground.c
@@ -513,10 +513,10 @@ void kinit_ground_env(klisp_State *K)
b2tv(true));
/* 15.1.7 read */
- /* TODO */
+ add_applicative(K, ground_env, "read", read, 0);
/* 15.1.8 write */
- /* TODO */
+ add_applicative(K, ground_env, "write", write, 0);
/*
** 15.2 Library features
diff --git a/src/kread.c b/src/kread.c
@@ -65,8 +65,10 @@ typedef enum {
*/
void kread_error(klisp_State *K, char *str)
{
- /* clear the stack */
+ /* clear up before throwing */
+ ks_tbclear(K);
ks_sclear(K);
+ clear_shared_dict(K);
klispE_throw(K, str);
}
@@ -74,12 +76,8 @@ void kread_error(klisp_State *K, char *str)
** Shared Reference Management (srfi-38)
*/
-/* This is called after kread to clear the shared alist */
-void clear_shared_dict(klisp_State *K)
-{
- K->shared_dict = KNIL;
-}
-
+/* clear_shared_dict is defined in ktoken to allow cleaning up before errors */
+/* It is called after kread to clear the shared alist */
TValue try_shared_ref(klisp_State *K, TValue ref_token)
{
/* TEMP: for now, only allow fixints in shared tokens */
@@ -466,8 +464,7 @@ TValue kread(klisp_State *K)
{
TValue obj;
- /* TEMP: for now assume we are in the repl: reset source info */
- ktok_reset_source_info(K);
+ assert(ttisnil(K->shared_dict));
obj = kread_fsm(K);
diff --git a/src/krepl.c b/src/krepl.c
@@ -38,6 +38,11 @@ void read_fn(klisp_State *K, TValue *xparams, TValue obj)
/* show prompt */
fprintf(stdout, "klisp> ");
+
+ /* TEMP: for now set this by hand */
+ K->curr_in = stdin;
+ ktok_reset_source_info(K);
+
obj = kread(K);
kapply_cc(K,obj);
}
@@ -78,6 +83,9 @@ void loop_fn(klisp_State *K, TValue *xparams, TValue obj)
/* this will in turn call main_cont */
kapply_cc(K, obj);
} else {
+ /* TEMP: for now set this by hand */
+ K->curr_out = stdout;
+
kwrite(K, obj);
knewline(K);
TValue denv = xparams[0];
diff --git a/src/ktoken.c b/src/ktoken.c
@@ -218,10 +218,18 @@ TValue ktok_get_source_info(klisp_State *K)
/*
** Error management
*/
+
+void clear_shared_dict(klisp_State *K)
+{
+ K->shared_dict = KNIL;
+}
+
void ktok_error(klisp_State *K, char *str)
{
- /* clear the buffer before throwing an error */
+ /* clear up before throwing */
ks_tbclear(K);
+ ks_sclear(K);
+ clear_shared_dict(K);
klispE_throw(K, str);
}
@@ -623,3 +631,4 @@ TValue ktok_read_identifier(klisp_State *K)
return new_sym;
}
+
diff --git a/src/ktoken.h b/src/ktoken.h
@@ -20,4 +20,8 @@ TValue ktok_read_token(klisp_State *K);
void ktok_reset_source_info(klisp_State *K);
TValue ktok_get_source_info(klisp_State *K);
+/* This is needed here to allow cleanup of shared dict from tokenizer */
+void clear_shared_dict(klisp_State *K);
+
+
#endif
