commit 3486269dd38eb67af5f92cce4e5c64b2bf3d5d91
parent 9c39568328b10196ccf2c35c29d008d297ba9c4b
Author: Andres Navarro <canavarro82@gmail.com>
Date: Thu, 17 Mar 2011 15:58:25 -0300
Added open-input-file, open-output-file, close-input-file & close-output-file to the ground environment.
Diffstat:
4 files changed, 142 insertions(+), 5 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -14,7 +14,7 @@ CORE_O= kobject.o ktoken.o kpair.o kstring.o ksymbol.o kread.o \
kground.o kghelpers.o kgbooleans.o kgeqp.o kgequalp.o \
kgsymbols.o kgcontrol.o kgpairs_lists.o kgpair_mut.o kgenvironments.o \
kgenv_mut.o kgcombiners.o kgcontinuations.o kgencapsulations.o \
- kgpromises.o kgkd_vars.o kgks_vars.o
+ kgpromises.o kgkd_vars.o kgks_vars.o kgports.o
KRN_T= klisp
KRN_O= klisp.o
@@ -80,7 +80,7 @@ kground.o: kground.c kground.h kstate.h kobject.h klisp.h kenvironment.h \
kgbooleans.h kgeqp.h kgequalp.h kgsymbols.h kgpairs_lists.h \
kgpair_mut.h kgenvironments.h kgenv_mut.h kgcombiners.h \
kgcontinuations.h kgencapsulations.h kgpromises.h kgkd_vars.h \
- kgks_vars.h
+ kgks_vars.h kgports.h
kghelpers.o: kghelpers.c kghelpers.h kstate.h kstate.h klisp.h kpair.h \
kapplicative.h koperative.h kerror.h kobject.h ksymbol.h
kgbooleans.o: kgbooleans.c kgbooleans.c kghelpers.h kstate.h klisp.h \
@@ -121,3 +121,6 @@ kgkd_vars.o: kgkd_vars.c kgkd_vars.h kghelpers.h kstate.h klisp.h \
kgks_vars.o: kgks_vars.c kgks_vars.h kghelpers.h kstate.h klisp.h \
kobject.h kerror.h kapplicative.h koperative.h kcontinuation.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
diff --git a/src/kgports.c b/src/kgports.c
@@ -0,0 +1,77 @@
+/*
+** kgports.h
+** Ports features for the ground environment
+** See Copyright Notice in klisp.h
+*/
+
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdbool.h>
+#include <stdint.h>
+
+#include "kstate.h"
+#include "kobject.h"
+#include "kport.h"
+#include "kapplicative.h"
+#include "koperative.h"
+#include "kcontinuation.h"
+#include "kerror.h"
+#include "ksymbol.h"
+
+#include "kghelpers.h"
+#include "kgports.h"
+
+/* 15.1.1 port? */
+/* uses typep */
+
+/* 15.1.2 input-port?, output-port? */
+/* use ftypep */
+
+/* 15.1.3 with-input-from-file, with-ouput-to-file */
+/* TODO */
+
+/* 15.1.4 get-current-input-port, get-current-output-port */
+/* TODO */
+
+/* 15.1.5 open-input-file, open-output-file */
+void open_file(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+{
+ char *name = ksymbol_buf(xparams[0]);
+ bool writep = bvalue(xparams[1]);
+ UNUSED(denv);
+
+ bind_1tp(K, name, ptree, "string", ttisstring, filename);
+
+ TValue new_port = kmake_port(K, filename, writep, KNIL, KNIL);
+ kapply_cc(K, new_port);
+}
+
+/* 15.1.6 close-input-file, close-output-file */
+void close_file(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+{
+ char *name = ksymbol_buf(xparams[0]);
+ bool writep = bvalue(xparams[1]);
+ UNUSED(denv);
+
+ bind_1tp(K, name, ptree, "port", ttisport, port);
+
+ bool dir_ok = writep? kport_is_output(port) : kport_is_input(port);
+
+ if (dir_ok) {
+ kclose_port(K, port);
+ kapply_cc(K, KINERT);
+ } else {
+ klispE_throw_extra(K, name, ": wrong input/output direction");
+ return;
+ }
+}
+
+/* 15.2.1 call-with-input-file, call-with-output-file */
+/* TODO */
+
+/* 15.2.2 load */
+/* TODO */
+
+/* 15.2.3 get-module */
+/* TODO */
diff --git a/src/kgports.h b/src/kgports.h
@@ -0,0 +1,48 @@
+/*
+** kgports.h
+** Ports features for the ground environment
+** See Copyright Notice in klisp.h
+*/
+
+#ifndef kgports_h
+#define kgports_h
+
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdbool.h>
+#include <stdint.h>
+
+#include "kobject.h"
+#include "klisp.h"
+#include "kstate.h"
+#include "kghelpers.h"
+
+/* 15.1.1 port? */
+/* uses typep */
+
+/* 15.1.2 input-port?, output-port? */
+/* use ftypep */
+
+/* 15.1.3 with-input-from-file, with-ouput-to-file */
+/* TODO */
+
+/* 15.1.4 get-current-input-port, get-current-output-port */
+/* TODO */
+
+/* 15.1.5 open-input-file, open-output-file */
+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.2.1 call-with-input-file, call-with-output-file */
+/* TODO */
+
+/* 15.2.2 load */
+/* TODO */
+
+/* 15.2.3 get-module */
+/* TODO */
+
+#endif
diff --git a/src/kground.c b/src/kground.c
@@ -35,6 +35,7 @@
#include "kgpromises.h"
#include "kgkd_vars.h"
#include "kgks_vars.h"
+#include "kgports.h"
/*
** BEWARE: this is highly unhygienic, it assumes variables "symbol" and
@@ -496,12 +497,20 @@ void kinit_ground_env(klisp_State *K)
/* TODO */
/* 15.1.5 open-input-file, open-output-file */
- /* TODO */
+ add_applicative(K, ground_env, "open-input-file", open_file, 2, symbol,
+ b2tv(false));
+
+ add_applicative(K, ground_env, "open-output-file", open_file, 2, symbol,
+ b2tv(true));
+ /* 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 */
- /* 15.1.5 close-input-file, close-output-file */
- /* TODO */
+ add_applicative(K, ground_env, "close-input-file", close_file, 2, symbol,
+ b2tv(false));
+
+ add_applicative(K, ground_env, "close-output-file", close_file, 2, symbol,
+ b2tv(true));
/* 15.1.7 read */
/* TODO */
