klisp

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:
M
src/Makefile
 | 
2
+-
M
src/kgports.c
 | 
20
+++++++++++++++++++-
M
src/kgports.h
 | 
3
++-
M
src/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,