From 83de9383420fe69ea9a1d232bc3e8b39a83aff1b Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Thu, 24 Oct 2013 22:56:04 +0900
Subject: [PATCH] add some port predicates

---
 include/picrin/port.h |   3 +-
 src/port.c            | 111 ++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 113 insertions(+), 1 deletion(-)

diff --git a/include/picrin/port.h b/include/picrin/port.h
index 0a0ff268..c421bb11 100644
--- a/include/picrin/port.h
+++ b/include/picrin/port.h
@@ -22,6 +22,7 @@ struct pic_port {
   enum pic_port_status status;
 };
 
-#define pic_port_ptr(v) ((struct pic_port_t *)v.u.data)
+#define pic_port_p(v) (pic_type(v) == PIC_TT_PORT)
+#define pic_port_ptr(v) ((struct pic_port *)(v).u.data)
 
 #endif
diff --git a/src/port.c b/src/port.c
index ece8ced6..3fcf6a0c 100644
--- a/src/port.c
+++ b/src/port.c
@@ -91,6 +91,110 @@ pic_debug(pic_state *pic, pic_value obj)
   write(pic, obj);
 }
 
+static pic_value
+pic_port_input_port_p(pic_state *pic)
+{
+  pic_value v;
+
+  pic_get_args(pic, "o", &v);
+
+  if (pic_port_p(v) && (pic_port_ptr(v)->flags & PIC_PORT_IN) != 0) {
+    return pic_true_value();
+  }
+  else {
+    return pic_false_value();
+  }
+}
+
+static pic_value
+pic_port_output_port_p(pic_state *pic)
+{
+  pic_value v;
+
+  pic_get_args(pic, "o", &v);
+
+  if (pic_port_p(v) && (pic_port_ptr(v)->flags & PIC_PORT_OUT) != 0) {
+    return pic_true_value();
+  }
+  else {
+    return pic_false_value();
+  }
+}
+
+static pic_value
+pic_port_textual_port_p(pic_state *pic)
+{
+  pic_value v;
+
+  pic_get_args(pic, "o", &v);
+
+  if (pic_port_p(v) && (pic_port_ptr(v)->flags & PIC_PORT_TEXT) != 0) {
+    return pic_true_value();
+  }
+  else {
+    return pic_false_value();
+  }
+}
+
+static pic_value
+pic_port_binary_port_p(pic_state *pic)
+{
+  pic_value v;
+
+  pic_get_args(pic, "o", &v);
+
+  if (pic_port_p(v) && (pic_port_ptr(v)->flags & PIC_PORT_BINARY) != 0) {
+    return pic_true_value();
+  }
+  else {
+    return pic_false_value();
+  }
+}
+
+static pic_value
+pic_port_port_p(pic_state *pic)
+{
+  pic_value v;
+
+  pic_get_args(pic, "o", &v);
+
+  return pic_bool_value(pic_port_p(v));
+}
+
+static pic_value
+pic_port_input_port_open_p(pic_state *pic)
+{
+  pic_value v;
+  struct pic_port *port;
+
+  pic_get_args(pic, "o", &v);
+
+  if (! pic_port_p(v))
+    return pic_false_value();
+  port = pic_port_ptr(v);
+  if ((port->flags & PIC_PORT_IN) == 0)
+    return pic_false_value();
+
+  return pic_bool_value(port->status == PIC_PORT_OPEN);
+}
+
+static pic_value
+pic_port_output_port_open_p(pic_state *pic)
+{
+  pic_value v;
+  struct pic_port *port;
+
+  pic_get_args(pic, "o", &v);
+
+  if (! pic_port_p(v))
+    return pic_false_value();
+  port = pic_port_ptr(v);
+  if ((port->flags & PIC_PORT_OUT) == 0)
+    return pic_false_value();
+
+  return pic_bool_value(port->status == PIC_PORT_OPEN);
+}
+
 static pic_value
 pic_port_write(pic_state *pic)
 {
@@ -139,6 +243,13 @@ pic_port_eof_object(pic_state *pic)
 void
 pic_init_port(pic_state *pic)
 {
+  pic_defun(pic, "input-port?", pic_port_input_port_p);
+  pic_defun(pic, "output-port?", pic_port_output_port_p);
+  pic_defun(pic, "textual-port?", pic_port_textual_port_p);
+  pic_defun(pic, "binary-port?", pic_port_binary_port_p);
+  pic_defun(pic, "port?", pic_port_port_p);
+  pic_defun(pic, "input-port-open?", pic_port_input_port_open_p);
+  pic_defun(pic, "output-port-open?", pic_port_output_port_open_p);
   pic_defun(pic, "write", pic_port_write);
   pic_defun(pic, "newline", pic_port_newline);
   pic_defun(pic, "eof-object?", pic_port_eof_object_p);