posix: Implement open-input-file.

* posix.c: New file.
* mes.c: Include posix.environment.h, posix.environment.i, posix.environment.c.
  (read_input_file_env): Rename from read_file_env.  Update
  callers.
  (load_env): Rename from load_file_env.  Update callers.
* GNUmakefile (mes.o): Add posix.c, posix.environment.h,
  posix.environment.i dependencies.

diff --git a/GNUmakefile b/GNUmakefile
index 57402eb84e45c7bce2aaf69481bea2e76da95f69..b86c4906ebac1ee6da9940532bf20f4ebe827a57 100644 (file)
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -27,6 +27,7 @@ mes.o: mes.c mes.environment.h mes.environment.i mes.symbols.i
 mes.o: define.c define.environment.h define.environment.i
 mes.o: lib.c lib.environment.h lib.environment.i
 mes.o: math.c math.environment.h math.environment.i
+mes.o: posix.c posix.environment.h posix.environment.i
 mes.o: quasiquote.c quasiquote.environment.h quasiquote.environment.i
 mes.o: string.c string.environment.h string.environment.i
 mes.o: type.c type.environment.h type.environment.i

diff --git a/mes.c b/mes.c
index 74980c7ed39e75cb17526d46b4b36dee806903dc..a0f5a751b304f6b687a2ee4e9183b1d9926fcc14 100644 (file)
--- a/mes.c
+++ b/mes.c
@@ -67,6 +67,7 @@ typedef struct scm_t {
 #include "lib.environment.h"
 #include "math.environment.h"
 #include "mes.environment.h"
+#include "posix.environment.h"
 #include "quasiquote.environment.h"
 #include "string.environment.h"
 #include "type.environment.h"
@@ -1127,10 +1128,12 @@ mes_environment () ///((internal))
 #endif
   a = cons (cons (&symbol_begin, &scm_begin), a);
 
+#include "posix.environment.i"
 #include "string.environment.i"
 #include "math.environment.i"
 #include "lib.environment.i"
 #include "mes.environment.i"
+//#include "quasiquote.environment.i"
 #include "define.environment.i"
 #include "type.environment.i"
 
@@ -1162,22 +1165,23 @@ lookup_macro (scm *x, scm *a)
 }
 
 scm *
-read_file_env (scm *e, scm *a)
+read_input_file_env (scm *e, scm *a)
 {
   if (e == &scm_nil) return e;
-  return cons (e, read_file_env (read_env (a), a));
+  return cons (e, read_input_file_env (read_env (a), a));
 }
 
 scm *
-load_file_env (scm *a)
+load_env (scm *a)
 {
-  return begin_env (read_file_env (read_env (a), a), a);
+  return begin_env (read_input_file_env (read_env (a), a), a);
 }
 
 #include "type.c"
 #include "define.c"
 #include "lib.c"
 #include "math.c"
+#include "posix.c"
 #include "quasiquote.c"
 #include "string.c"
 
@@ -1188,7 +1192,7 @@ main (int argc, char *argv[])
   if (argc > 1 && !strcmp (argv[1], "--version")) return puts ("Mes 0.1\n");
   g_stdin = stdin;
   scm *a = mes_environment ();
-  display_ (stderr, load_file_env (a));
+  display_ (stderr, load_env (a));
   fputs ("", stderr);
   return 0;
 }

diff --git a/posix.c b/posix.c
new file mode 100644 (file)
index 0000000..042fc94
--- /dev/null
+++ b/posix.c
@@ -0,0 +1,54 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * Mes --- Maxwell Equations of Software
+ * Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of Mes.
+ *
+ * Mes is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or (at
+ * your option) any later version.
+ *
+ * Mes is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include <fcntl.h>
+
+char const*
+string_to_cstring (scm *s)
+{
+  static char buf[1024];
+  char *p = buf;
+  s = s->string;
+  while (s != &scm_nil)
+    {
+      *p++ = s->car->value;
+      s = s->cdr;
+    }
+  *p = 0;
+  return buf;
+}
+
+scm *
+open_input_file (scm *file_name)
+{
+  return make_number (open (string_to_cstring (file_name), O_RDONLY));
+}
+
+scm *
+current_input_port ()
+{
+  return make_number (fileno (g_stdin));
+}
+
+scm *
+set_current_input_port (scm *port)
+{
+  g_stdin = fdopen (port->value, "r");
+}