Move quasiquote to quasiquote.c.

* mes.c (unquote, unquote_splicing, syntax, unsyntax,
  unsyntax_splicing, eval_quasiquote, eval_quasisyntax, add_unquoters,
  add_unsyntaxers): Move to quasiquote.c
* quasiquote.c: New file.
* GNUmakefile (mes.o): Depend on quasiquote snarf output.

diff --git a/GNUmakefile b/GNUmakefile
index a939d8e50e29bdd654c0fc1dee8fed2d45fe0f2d..a5fbe16e6d995ffa650a7ce0515b579346689ec5 100644 (file)
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -24,6 +24,7 @@ all: mes
 
 mes.o: mes.c
 mes.o: mes.c mes.environment.h mes.environment.i mes.symbols.i
+mes.o: quasiquote.c quasiquote.environment.h quasiquote.environment.i
 mes.o: type.c type.environment.h type.environment.i
 
 clean:

diff --git a/mes.c b/mes.c
index dbf4a7e7412d19dd9536670b56bb23973c3dc941..84a7cabe05ed02942b87110c4bd78ca274344dad 100644 (file)
--- a/mes.c
+++ b/mes.c
@@ -29,7 +29,7 @@
 #include <stdbool.h>
 
 #define DEBUG 0
-#define BUILTIN_QUASIQUOTE 1 // 6x speedup for mescc
+#define QUASIQUOTE 1
 
 enum type {CHAR, MACRO, NUMBER, PAIR, SCM, STRING, SYMBOL, VALUES, VECTOR,
            FUNCTION0, FUNCTION1, FUNCTION2, FUNCTION3, FUNCTIONn};
@@ -63,6 +63,7 @@ typedef struct scm_t {
 scm temp_number = {NUMBER, .name="nul", .value=0};
 
 #include "type.environment.h"
+#include "quasiquote.environment.h"
 #include "mes.environment.h"
 
 scm *display_ (FILE* f, scm *x);
@@ -192,38 +193,7 @@ quasisyntax (scm *x)
 }
 
 #include "type.c"
-
-#if BUILTIN_QUASIQUOTE
-scm *
-unquote (scm *x) ///((no-environment))
-{
-  return cons (&symbol_unquote, x);
-}
-
-scm *
-unquote_splicing (scm *x) ///((no-environment))
-{
-  return cons (&symbol_unquote_splicing, x);
-}
-
-scm *
-syntax (scm *x)
-{
-  return cons (&symbol_syntax, x);
-}
-
-scm *
-unsyntax (scm *x) ///((no-environment))
-{
-  return cons (&symbol_unsyntax, x);
-}
-
-scm *
-unsyntax_splicing (scm *x) ///((no-environment))
-{
-  return cons (&symbol_unsyntax_splicing, x);
-}
-#endif // BUILTIN_QUASIQUOTE
+#include "quasiquote.c"
 
 //Library functions
 
@@ -450,7 +420,7 @@ builtin_eval (scm *e, scm *a)
 #endif
       if (e->car == &symbol_set_x)
         return set_env_x (cadr (e), builtin_eval (caddr (e), a), a);
-#if BUILTIN_QUASIQUOTE
+#if QUASIQUOTE
       if (e->car == &symbol_unquote)
         return builtin_eval (cadr (e), a);
       if (e->car == &symbol_quasiquote)
@@ -459,7 +429,7 @@ builtin_eval (scm *e, scm *a)
         return builtin_eval (cadr (e), a);
       if (e->car == &symbol_quasisyntax)
         return eval_quasisyntax (cadr (e), add_unsyntaxers (a));
-#endif //BUILTIN_QUASIQUOTE
+#endif //QUASIQUOTE
     }
   return apply_env (e->car, evlis_env (e->cdr, a), a);
 }
@@ -495,41 +465,6 @@ builtin_if (scm *e, scm *a)
   return &scm_unspecified;
 }
 
-#if BUILTIN_QUASIQUOTE
-scm *
-eval_quasiquote (scm *e, scm *a)
-{
-  if (e == &scm_nil) return e;
-  else if (atom_p (e) == &scm_t) return e;
-  else if (eq_p (car (e), &symbol_unquote) == &scm_t)
-    return builtin_eval (cadr (e), a);
-  else if (e->type == PAIR && e->car->type == PAIR
-           && eq_p (caar (e), &symbol_unquote_splicing) == &scm_t)
-      return append2 (builtin_eval (cadar (e), a), eval_quasiquote (cdr (e), a));
-  return cons (eval_quasiquote (car (e), a), eval_quasiquote (cdr (e), a));
-}
-
-scm *
-eval_quasisyntax (scm *e, scm *a)
-{
-  if (e == &scm_nil) return e;
-  else if (atom_p (e) == &scm_t) return e;
-  else if (eq_p (car (e), &symbol_unsyntax) == &scm_t)
-    return builtin_eval (cadr (e), a);
-  else if (e->type == PAIR && e->car->type == PAIR
-           && eq_p (caar (e), &symbol_unsyntax_splicing) == &scm_t)
-      return append2 (builtin_eval (cadar (e), a), eval_quasisyntax (cdr (e), a));
-  return cons (eval_quasisyntax (car (e), a), eval_quasisyntax (cdr (e), a));
-}
-
-#else
-scm*add_unquoters (scm *a){}
-scm*add_unsyntaxers (scm *a){}
-scm*eval_unsyntax (scm *e, scm *a){}
-scm*eval_quasiquote (scm *e, scm *a){}
-scm*eval_quasisyntax (scm *e, scm *a){}
-#endif // BUILTIN_QUASIQUOTE
-
 //Helpers
 
 scm *
@@ -1345,26 +1280,6 @@ logior (scm *x) ///((args . n))
   return make_number (n);
 }
 
-scm *add_environment (scm *a, char const *name, scm *x);
-
-#if BUILTIN_QUASIQUOTE
-scm *
-add_unquoters (scm *a)
-{
-  a = cons (cons (&symbol_unquote, &scm_unquote), a);
-  a = cons (cons (&symbol_unquote_splicing, &scm_unquote_splicing), a);
-  return a;
-}
-
-scm *
-add_unsyntaxers (scm *a)
-{
-  a = cons (cons (&symbol_unsyntax, &scm_unsyntax), a);
-  a = cons (cons (&symbol_unsyntax_splicing, &scm_unsyntax_splicing), a);
-  return a;
-}
-#endif // BUILTIN_QUASIQUOTE
-
 scm *
 add_environment (scm *a, char const *name, scm *x)
 {

diff --git a/quasiquote.c b/quasiquote.c
new file mode 100644 (file)
index 0000000..f724fe2
--- /dev/null
+++ b/quasiquote.c
@@ -0,0 +1,105 @@
+/* -*-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/>.
+ */
+
+#if QUASIQUOTE
+scm *
+unquote (scm *x) ///((no-environment))
+{
+  return cons (&symbol_unquote, x);
+}
+
+scm *
+unquote_splicing (scm *x) ///((no-environment))
+{
+  return cons (&symbol_unquote_splicing, x);
+}
+
+scm *
+syntax (scm *x)
+{
+  return cons (&symbol_syntax, x);
+}
+
+scm *
+unsyntax (scm *x) ///((no-environment))
+{
+  return cons (&symbol_unsyntax, x);
+}
+
+scm *
+unsyntax_splicing (scm *x) ///((no-environment))
+{
+  return cons (&symbol_unsyntax_splicing, x);
+}
+
+scm *
+eval_quasiquote (scm *e, scm *a)
+{
+  if (e == &scm_nil) return e;
+  else if (atom_p (e) == &scm_t) return e;
+  else if (eq_p (car (e), &symbol_unquote) == &scm_t)
+    return builtin_eval (cadr (e), a);
+  else if (e->type == PAIR && e->car->type == PAIR
+           && eq_p (caar (e), &symbol_unquote_splicing) == &scm_t)
+      return append2 (builtin_eval (cadar (e), a), eval_quasiquote (cdr (e), a));
+  return cons (eval_quasiquote (car (e), a), eval_quasiquote (cdr (e), a));
+}
+
+scm *
+eval_quasisyntax (scm *e, scm *a)
+{
+  if (e == &scm_nil) return e;
+  else if (atom_p (e) == &scm_t) return e;
+  else if (eq_p (car (e), &symbol_unsyntax) == &scm_t)
+    return builtin_eval (cadr (e), a);
+  else if (e->type == PAIR && e->car->type == PAIR
+           && eq_p (caar (e), &symbol_unsyntax_splicing) == &scm_t)
+      return append2 (builtin_eval (cadar (e), a), eval_quasisyntax (cdr (e), a));
+  return cons (eval_quasisyntax (car (e), a), eval_quasisyntax (cdr (e), a));
+}
+
+scm *add_environment (scm *a, char const *name, scm *x);
+
+scm *
+add_unquoters (scm *a)
+{
+  a = cons (cons (&symbol_unquote, &scm_unquote), a);
+  a = cons (cons (&symbol_unquote_splicing, &scm_unquote_splicing), a);
+  return a;
+}
+
+scm *
+add_unsyntaxers (scm *a)
+{
+  a = cons (cons (&symbol_unsyntax, &scm_unsyntax), a);
+  a = cons (cons (&symbol_unsyntax_splicing, &scm_unsyntax_splicing), a);
+  return a;
+}
+
+#else // !QUASIQUOTE
+
+scm*add_unquoters (scm *a){}
+scm*add_unsyntaxers (scm *a){}
+scm*eval_unsyntax (scm *e, scm *a){}
+scm*eval_quasiquote (scm *e, scm *a){}
+scm*eval_quasisyntax (scm *e, scm *a){}
+
+#endif // !QUASIQUOTE
+