From 25f02522d542b2be219dd5efaf8f2481c5dd8755 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Thu, 11 Jun 2015 22:57:00 -0400
Subject: [PATCH] Added (port?)

---
 cgen.scm       | 1 +
 eval.scm       | 1 +
 runtime.c      | 9 +++++++++
 runtime.h      | 2 ++
 transforms.scm | 6 ++++--
 5 files changed, 17 insertions(+), 2 deletions(-)

diff --git a/cgen.scm b/cgen.scm
index 47c3357e..788f0d7a 100644
--- a/cgen.scm
+++ b/cgen.scm
@@ -512,6 +512,7 @@
      ((eq? p 'integer?)      "Cyc_is_integer")
      ((eq? p 'pair?)         "Cyc_is_cons")
      ((eq? p 'procedure?)    "Cyc_is_procedure")
+     ((eq? p 'port?)         "Cyc_is_port")
      ((eq? p 'vector?)       "Cyc_is_vector")
      ((eq? p 'string?)       "Cyc_is_string")
      ((eq? p 'eof-object?)   "Cyc_is_eof_object")
diff --git a/eval.scm b/eval.scm
index df70d0e6..91372292 100644
--- a/eval.scm
+++ b/eval.scm
@@ -280,6 +280,7 @@
       (list 'real? real?)
       (list 'integer? integer?)
       (list 'pair? pair?)
+      (list 'port? port?)
       (list 'procedure? procedure?)
       (list 'vector? vector?)
       (list 'string? string?)
diff --git a/runtime.c b/runtime.c
index ebe64031..e052b6d5 100644
--- a/runtime.c
+++ b/runtime.c
@@ -606,6 +606,11 @@ object Cyc_is_vector(object o){
         return boolean_t;
     return boolean_f;}
 
+object Cyc_is_port(object o){
+    if (!nullp(o) && !is_value_type(o) && ((list)o)->tag == port_tag)
+        return boolean_t;
+    return boolean_f;}
+
 object Cyc_is_string(object o){
     if (!nullp(o) && !is_value_type(o) && ((list)o)->tag == string_tag)
         return boolean_t;
@@ -1143,6 +1148,8 @@ void _pair_127(object cont, object args) {
     return_funcall1(cont, Cyc_is_cons(car(args))); }
 void _procedure_127(object cont, object args) {
     return_funcall1(cont, Cyc_is_procedure(car(args))); }
+void _port_127(object cont, object args) {
+    return_funcall1(cont, Cyc_is_port(car(args))); }
 void _vector_127(object cont, object args) {
     return_funcall1(cont, Cyc_is_vector(car(args))); }
 void _string_127(object cont, object args) {
@@ -1949,6 +1956,7 @@ static primitive_type real_127_primitive = {primitive_tag, "real?", &_real_127};
 static primitive_type integer_127_primitive = {primitive_tag, "integer?", &_integer_127};
 static primitive_type pair_127_primitive = {primitive_tag, "pair?", &_pair_127};
 static primitive_type procedure_127_primitive = {primitive_tag, "procedure?", &_procedure_127};
+static primitive_type port_127_primitive = {primitive_tag, "port?", &_port_127};
 static primitive_type vector_127_primitive = {primitive_tag, "vector?", &_vector_127};
 static primitive_type string_127_primitive = {primitive_tag, "string?", &_string_127};
 static primitive_type symbol_127_primitive = {primitive_tag, "symbol?", &_symbol_127};
@@ -2054,6 +2062,7 @@ const object primitive_integer_127 = &integer_127_primitive;
 const object primitive_pair_127 = &pair_127_primitive;
 const object primitive_procedure_127 = &procedure_127_primitive;
 const object primitive_string_127 = &string_127_primitive;
+const object primitive_port_127 = &port_127_primitive;
 const object primitive_vector_127 = &vector_127_primitive;
 const object primitive_symbol_127 = &symbol_127_primitive;
 const object primitive_current_91input_91port = &current_91input_91port_primitive;
diff --git a/runtime.h b/runtime.h
index fc94fee9..d27303b8 100644
--- a/runtime.h
+++ b/runtime.h
@@ -119,6 +119,7 @@ object Cyc_is_number(object o);
 object Cyc_is_real(object o);
 object Cyc_is_integer(object o);
 object Cyc_is_vector(object o);
+object Cyc_is_port(object o);
 object Cyc_is_symbol(object o);
 object Cyc_is_string(object o);
 object Cyc_is_char(object o);
@@ -317,6 +318,7 @@ extern const object primitive_real_127;
 extern const object primitive_integer_127;
 extern const object primitive_pair_127;
 extern const object primitive_procedure_127;
+extern const object primitive_port_127;
 extern const object primitive_vector_127;
 extern const object primitive_string_127;
 extern const object primitive_symbol_127;
diff --git a/transforms.scm b/transforms.scm
index 5c5c3d23..bafc44d7 100644
--- a/transforms.scm
+++ b/transforms.scm
@@ -546,6 +546,7 @@
      real?
      integer?
      pair?
+     port?
      procedure?
      vector?
      string?
@@ -594,8 +595,9 @@
                   close-input-port
                   read-char
                   peek-char
-                  write
-                  display)))
+                  Cyc-write-char
+                  Cyc-write
+                  Cyc-display)))
     (call/cc
       (lambda (return)
         (for-each