commit 867e8fb255e341505761bf9538f2d0d5a57201a7
parent f3d9c6fd442e9272e6d35b26c26cebcd48cd6ecf
Author: Andres Navarro <canavarro82@gmail.com>
Date: Tue, 29 Nov 2011 02:45:36 -0300
Added read-line from the ground environment.
Diffstat:
8 files changed, 147 insertions(+), 5 deletions(-)
diff --git a/TODO b/TODO
@@ -19,6 +19,9 @@
* fix:
** fix/test the tty detection in the interpreter
** fix char-ready? and u8-ready? (r7rs)
+** eliminate kread_ignore_whitespace_and_commonts_from_port,
+ replace for a boolean flag to tell read to reset source info
+ after first token read.
* documentation
** fix some inconsistencies between the man page and the interpreter
behaviour.
@@ -34,7 +37,6 @@
* applicatives:
** number->string (r7rs)
** string->number (r7rs)
-** read-line (r7rs)
* reader
** symbol escapes (r7rs)
** string escapes (r7rs)
diff --git a/src/Makefile b/src/Makefile
@@ -265,7 +265,7 @@ kpromise.o: kpromise.c kobject.h klimits.h klisp.h klispconf.h kstate.h \
krational.o: krational.c krational.h kobject.h klimits.h klisp.h \
klispconf.h kstate.h ktoken.h kmem.h kinteger.h imath.h imrat.h kgc.h
kread.o: kread.c kread.h kobject.h klimits.h klisp.h klispconf.h kstate.h \
- ktoken.h kmem.h kpair.h kgc.h kerror.h ktable.h kport.h
+ ktoken.h kmem.h kpair.h kgc.h kerror.h ktable.h kport.h kstring.h
kreal.o: kreal.c kreal.h kobject.h klimits.h klisp.h klispconf.h kstate.h \
ktoken.h kmem.h kinteger.h imath.h krational.h imrat.h kgc.h kpair.h \
kerror.h
diff --git a/src/kgports.c b/src/kgports.c
@@ -869,6 +869,36 @@ void display(klisp_State *K)
kapply_cc(K, KINERT);
}
+void read_line(klisp_State *K)
+{
+ TValue *xparams = K->next_xparams;
+ TValue ptree = K->next_value;
+ TValue denv = K->next_env;
+ klisp_assert(ttisenvironment(K->next_env));
+
+ UNUSED(xparams);
+ UNUSED(denv);
+
+ TValue port = ptree;
+ if (!get_opt_tpar(K, port, "port", ttisport)) {
+ port = kcdr(K->kd_in_port_key); /* access directly */
+ }
+
+ if (!kport_is_input(port)) {
+ klispE_throw_simple(K, "the port should be an input port");
+ return;
+ } else if (!kport_is_textual(port)) {
+ klispE_throw_simple(K, "the port should be a textual port");
+ return;
+ } else if (kport_is_closed(port)) {
+ klispE_throw_simple(K, "the port is already closed");
+ return;
+ }
+
+ TValue obj = kread_line_from_port(K, port);
+ kapply_cc(K, obj);
+}
+
/* 15.1.? flush-output-port */
void flush(klisp_State *K)
{
@@ -1043,6 +1073,8 @@ void kinit_ports_ground_env(klisp_State *K)
/* 15.2.? display */
add_applicative(K, ground_env, "display", display, 0);
+ /* 15.1.? read-line */
+ add_applicative(K, ground_env, "read-line", read_line, 0);
/* 15.1.? flush-output-port */
add_applicative(K, ground_env, "flush-output-port", flush, 0);
diff --git a/src/klimits.h b/src/klimits.h
@@ -77,4 +77,9 @@
#define MINBYTEVECTORPORTBUFFER 256
#endif
+/* starting size for readline buffer */
+#ifndef MINREADLINEBUFFER
+#define MINREADLINEBUFFER 80
+#endif
+
#endif
diff --git a/src/kread.c b/src/kread.c
@@ -5,6 +5,7 @@
*/
#include <stdio.h>
+#include <string.h>
#include <stdlib.h>
#include "kread.h"
@@ -15,6 +16,7 @@
#include "kerror.h"
#include "ktable.h"
#include "kport.h"
+#include "kstring.h"
/*
@@ -704,22 +706,38 @@ TValue kread_from_port_g(klisp_State *K, TValue port, bool mut, bool listp)
return obj;
}
+/*
+** Reader Interface
+*/
+
TValue kread_from_port(klisp_State *K, TValue port, bool mut)
{
+ klisp_assert(ttisport(port));
+ klisp_assert(kport_is_input(port));
+ klisp_assert(kport_is_open(port));
+ klisp_assert(kport_is_textual(port));
return kread_from_port_g(K, port, mut, false);
}
TValue kread_list_from_port(klisp_State *K, TValue port, bool mut)
{
+ klisp_assert(ttisport(port));
+ klisp_assert(kport_is_input(port));
+ klisp_assert(kport_is_open(port));
+ klisp_assert(kport_is_textual(port));
return kread_from_port_g(K, port, mut, true);
}
TValue kread_peek_char_from_port(klisp_State *K, TValue port, bool peek)
{
+ klisp_assert(ttisport(port));
+ klisp_assert(kport_is_input(port));
+ klisp_assert(kport_is_open(port));
+ klisp_assert(kport_is_textual(port));
+
/* Reset the EOF flag in the tokenizer. The flag is shared,
by operations on all ports. */
K->ktok_seen_eof = false;
-
K->curr_port = port;
int ch;
if (peek) {
@@ -736,6 +754,11 @@ TValue kread_peek_char_from_port(klisp_State *K, TValue port, bool peek)
TValue kread_peek_u8_from_port(klisp_State *K, TValue port, bool peek)
{
+ klisp_assert(ttisport(port));
+ klisp_assert(kport_is_input(port));
+ klisp_assert(kport_is_open(port));
+ klisp_assert(kport_is_binary(port));
+
/* Reset the EOF flag in the tokenizer. The flag is shared,
by operations on all ports. */
K->ktok_seen_eof = false;
@@ -753,6 +776,59 @@ TValue kread_peek_u8_from_port(klisp_State *K, TValue port, bool peek)
return u8 == EOF? KEOF : i2tv(u8 & 0xff);
}
+TValue kread_line_from_port(klisp_State *K, TValue port)
+{
+ klisp_assert(ttisport(port));
+ klisp_assert(kport_is_input(port));
+ klisp_assert(kport_is_open(port));
+ klisp_assert(kport_is_textual(port));
+
+ /* Reset the EOF flag in the tokenizer. The flag is shared,
+ by operations on all ports. */
+ K->ktok_seen_eof = false;
+ K->curr_port = port;
+
+ uint32_t size = MINREADLINEBUFFER;
+ uint32_t i = 0;
+ int ch;
+ TValue new_str = kstring_new_s(K, size);
+ krooted_vars_push(K, &new_str);
+
+ char *buf = kstring_buf(new_str);
+ ktok_set_source_info(K, kport_filename(port),
+ kport_line(port), kport_col(port));
+ bool found_newline = false;
+ while(true) {
+ ch = ktok_getc(K);
+ if (ch == EOF) {
+ break;
+ } else if (ch == '\n') {
+ /* adjust string to the right size if necessary */
+ if (i < size) {
+ new_str = kstring_new_bs(K, kstring_buf(new_str), i);
+ }
+ found_newline = true;
+ break;
+ } else {
+ if (i == size) {
+ size *= 2;
+ char *old_buf = kstring_buf(new_str);
+ new_str = kstring_new_s(K, size);
+ buf = kstring_buf(new_str);
+ /* copy the data we have */
+ memcpy(buf, old_buf, i);
+ buf += i;
+ }
+ *buf++ = (char) ch;
+ ++i;
+ }
+ }
+ kport_update_source_info(port, K->ktok_source_info.line,
+ K->ktok_source_info.col);
+ krooted_vars_pop(K);
+ return found_newline? new_str : KEOF;
+}
+
/* This is needed by the repl to ignore trailing spaces (especially newlines)
that could affect the source info */
/* XXX This should be replaced somehow, as it doesn't work for sexp and
diff --git a/src/kread.h b/src/kread.h
@@ -17,7 +17,8 @@ TValue kread_from_port(klisp_State *K, TValue port, bool mut);
TValue kread_list_from_port(klisp_State *K, TValue port, bool mut);
TValue kread_peek_char_from_port(klisp_State *K, TValue port, bool peek);
TValue kread_peek_u8_from_port(klisp_State *K, TValue port, bool peek);
-
+TValue kread_line_from_port(klisp_State *K, TValue port);
+/* XXX soon to be replaced */
void kread_ignore_whitespace_and_comments_from_port(klisp_State *K,
TValue port);
diff --git a/src/kwrite.c b/src/kwrite.c
@@ -645,11 +645,16 @@ void kwrite_simple(klisp_State *K, TValue obj)
}
/*
-** Interface
+** Writer Interface
*/
void kwrite_display_to_port(klisp_State *K, TValue port, TValue obj,
bool displayp)
{
+ klisp_assert(ttisport(port));
+ klisp_assert(kport_is_output(port));
+ klisp_assert(kport_is_open(port));
+ klisp_assert(kport_is_textual(port));
+
K->curr_port = port;
K->write_displayp = displayp;
kwrite(K, obj);
@@ -657,6 +662,11 @@ void kwrite_display_to_port(klisp_State *K, TValue port, TValue obj,
void kwrite_simple_to_port(klisp_State *K, TValue port, TValue obj)
{
+ klisp_assert(ttisport(port));
+ klisp_assert(kport_is_output(port));
+ klisp_assert(kport_is_open(port));
+ klisp_assert(kport_is_textual(port));
+
K->curr_port = port;
K->write_displayp = false;
kwrite_simple(K, obj);
@@ -664,6 +674,10 @@ void kwrite_simple_to_port(klisp_State *K, TValue port, TValue obj)
void kwrite_newline_to_port(klisp_State *K, TValue port)
{
+ klisp_assert(ttisport(port));
+ klisp_assert(kport_is_output(port));
+ klisp_assert(kport_is_open(port));
+ klisp_assert(kport_is_textual(port));
K->curr_port = port; /* this isn't needed but all other
i/o functions set it */
kwrite_char_to_port(K, port, ch2tv('\n'));
@@ -671,6 +685,10 @@ void kwrite_newline_to_port(klisp_State *K, TValue port)
void kwrite_char_to_port(klisp_State *K, TValue port, TValue ch)
{
+ klisp_assert(ttisport(port));
+ klisp_assert(kport_is_output(port));
+ klisp_assert(kport_is_open(port));
+ klisp_assert(kport_is_textual(port));
K->curr_port = port; /* this isn't needed but all other
i/o functions set it */
@@ -706,6 +724,10 @@ void kwrite_char_to_port(klisp_State *K, TValue port, TValue ch)
void kwrite_u8_to_port(klisp_State *K, TValue port, TValue u8)
{
+ klisp_assert(ttisport(port));
+ klisp_assert(kport_is_output(port));
+ klisp_assert(kport_is_open(port));
+ klisp_assert(kport_is_binary(port));
K->curr_port = port; /* this isn't needed but all other
i/o functions set it */
if (ttisfport(port)) {
@@ -742,6 +764,9 @@ void kwrite_u8_to_port(klisp_State *K, TValue port, TValue u8)
void kwrite_flush_port(klisp_State *K, TValue port)
{
+ klisp_assert(ttisport(port));
+ klisp_assert(kport_is_output(port));
+ klisp_assert(kport_is_open(port));
K->curr_port = port; /* this isn't needed but all other
i/o functions set it */
if (ttisfport(port)) { /* only necessary for file ports */
diff --git a/src/tests/ports.k b/src/tests/ports.k
@@ -207,6 +207,7 @@
($check-error (call-with-closed-output-port ($lambda (p) (write 0 p))))
;; write-simple
+;; read-line
;; 15.2.1 call-with-input-file call-with-output-file
;; 15.2.2 load
;; 15.2.3 get-module
