Move other post-boot and derived functions to lib.c.
authorJan Nieuwenhuizen <janneke@gnu.org>
Sat, 22 Oct 2016 18:51:32 +0000 (20:51 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Sat, 22 Oct 2016 18:51:32 +0000 (20:51 +0200)
* mes.c (c*r, length, last_pair, builtin_list, vector_to_list,
  integer_to_char, char_to_integer, builtin_exit): Move to lib.c.
* lib.c: New file.
* GNUmakefile (mes.o): Depend on lib snarf output.

GNUmakefile
lib.c [new file with mode: 0644]
mes.c

index 5f23d70beffdab6f7416ff0fd904678bd790bf02..a6f843217a76cbd3fbffafd3456ea23a631bfc8c 100644 (file)
@@ -25,6 +25,7 @@ all: mes
 mes.o: mes.c
 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: quasiquote.c quasiquote.environment.h quasiquote.environment.i
 mes.o: string.c string.environment.h string.environment.i
diff --git a/lib.c b/lib.c
new file mode 100644 (file)
index 0000000..4d7a617
--- /dev/null
+++ b/lib.c
@@ -0,0 +1,87 @@
+/* -*-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/>.
+ */
+
+scm *caar (scm *x) {return car (car (x));}
+scm *cadr (scm *x) {return car (cdr (x));}
+scm *cdar (scm *x) {return cdr (car (x));}
+scm *cddr (scm *x) {return cdr (cdr (x));}
+scm *caaar (scm *x) {return car (car (car (x)));}
+scm *caadr (scm *x) {return car (car (cdr (x)));}
+scm *caddr (scm *x) {return car (cdr (cdr (x)));}
+scm *cdadr (scm *x) {return cdr (car (cdr (x)));}
+scm *cadar (scm *x) {return car (cdr (car (x)));}
+scm *cddar (scm *x) {return cdr (cdr (car (x)));}
+scm *cdddr (scm *x) {return cdr (cdr (cdr (x)));}
+
+scm *
+length (scm *x)
+{
+  int n = 0;
+  while (x != &scm_nil)
+    {
+      n++;
+      x = cdr (x);
+    }
+  return make_number (n);
+}
+
+scm *
+last_pair (scm *x)
+{
+  while (x != &scm_nil && cdr (x) != &scm_nil)
+    x = cdr (x);
+  return x;
+}
+
+scm *
+list (scm *x) ///((args . n))
+{
+  return x;
+}
+
+scm *
+vector_to_list (scm *v)
+{
+  scm *x = &scm_nil;
+  for (int i = 0; i < v->length; i++)
+    x = append2 (x, cons (v->vector[i], &scm_nil));
+  return x;
+}
+
+scm *
+integer_to_char (scm *x)
+{
+  assert (x->type == NUMBER);
+  return make_char (x->value);
+}
+
+scm *
+char_to_integer (scm *x)
+{
+  assert (x->type == CHAR);
+  return make_number (x->value);
+}
+
+scm *
+builtin_exit (scm *x)
+{
+  assert (x->type == NUMBER);
+  exit (x->value);
+}
diff --git a/mes.c b/mes.c
index 7c6d0ba9e3bd692f50536136998f211856b2e1b0..8ea278a36678874f84aface1c246ab0a7b2138b2 100644 (file)
--- a/mes.c
+++ b/mes.c
@@ -62,12 +62,13 @@ typedef struct scm_t {
 
 scm temp_number = {NUMBER, .name="nul", .value=0};
 
-#include "type.environment.h"
 #include "define.environment.h"
-#include "quasiquote.environment.h"
+#include "lib.environment.h"
 #include "math.environment.h"
-#include "string.environment.h"
 #include "mes.environment.h"
+#include "quasiquote.environment.h"
+#include "string.environment.h"
+#include "type.environment.h"
 
 scm *display_ (FILE* f, scm *x);
 scm *display_helper (FILE*, scm*, bool, char const*, bool);
@@ -195,21 +196,6 @@ quasisyntax (scm *x)
   return cons (&symbol_quasisyntax, x);
 }
 
-//Library functions
-
-// Derived, non-primitives
-scm *caar (scm *x) {return car (car (x));}
-scm *cadr (scm *x) {return car (cdr (x));}
-scm *cdar (scm *x) {return cdr (car (x));}
-scm *cddr (scm *x) {return cdr (cdr (x));}
-scm *caaar (scm *x) {return car (car (car (x)));}
-scm *caadr (scm *x) {return car (car (cdr (x)));}
-scm *caddr (scm *x) {return car (cdr (cdr (x)));}
-scm *cdadr (scm *x) {return cdr (car (cdr (x)));}
-scm *cadar (scm *x) {return car (cdr (car (x)));}
-scm *cddar (scm *x) {return cdr (cdr (car (x)));}
-scm *cdddr (scm *x) {return cdr (cdr (cdr (x)));}
-
 scm *
 pairlis (scm *x, scm *y, scm *a)
 {
@@ -594,34 +580,6 @@ make_vector (scm *n)
   return p;
 }
 
-scm *
-length (scm *x)
-{
-  int n = 0;
-  while (x != &scm_nil)
-    {
-      n++;
-      x = cdr (x);
-    }
-  return make_number (n);
-}
-
-scm *
-last_pair (scm *x)
-{
-  //if (x != &scm_nil && cdr (x) != &scm_nil)
-  //return last_pair (cdr (x));
-  while (x != &scm_nil && cdr (x) != &scm_nil)
-    x = cdr (x);
-  return x;
-}
-
-scm *
-builtin_list (scm *x) ///((args . n))
-{
-  return x;
-}
-
 scm *
 values (scm *x) ///((args . n))
 {
@@ -700,21 +658,6 @@ lookup_char (int c, scm *a)
   return lookup (buf, a);
 }
 
-char const *
-list2str (scm *l)
-{
-  static char buf[STRING_MAX];
-  char *p = buf;
-  while (l != &scm_nil) {
-    scm *c = car (l);
-    assert (c->type == NUMBER);
-    *p++ = c->value;
-    l = cdr (l);
-  }
-  *p = 0;
-  return buf;
-}
-
 scm *
 list_to_vector (scm *x)
 {
@@ -729,36 +672,6 @@ list_to_vector (scm *x)
   return v;
 }
 
-scm *
-integer_to_char (scm *x)
-{
-  assert (x->type == NUMBER);
-  return make_char (x->value);
-}
-
-scm *
-char_to_integer (scm *x)
-{
-  assert (x->type == CHAR);
-  return make_number (x->value);
-}
-
-scm *
-builtin_exit (scm *x)
-{
-  assert (x->type == NUMBER);
-  exit (x->value);
-}
-
-scm *
-vector_to_list (scm *v)
-{
-  scm *x = &scm_nil;
-  for (int i = 0; i < v->length; i++)
-    x = append2 (x, cons (v->vector[i], &scm_nil));
-  return x;
-}
-
 scm *
 newline (scm *p) ///((args . n))
 {
@@ -1078,6 +991,7 @@ mes_environment () ///((internal))
 
 #include "string.environment.i"
 #include "math.environment.i"
+#include "lib.environment.i"
 #include "mes.environment.i"
 #include "define.environment.i"
 #include "type.environment.i"
@@ -1121,6 +1035,7 @@ read_file (scm *e, scm *a)
 
 #include "type.c"
 #include "define.c"
+#include "lib.c"
 #include "math.c"
 #include "quasiquote.c"
 #include "string.c"