core: Add compile time switch for quasisyntax.
authorJan Nieuwenhuizen <janneke@gnu.org>
Sun, 30 Oct 2016 15:01:34 +0000 (16:01 +0100)
committerJan Nieuwenhuizen <janneke@gnu.org>
Mon, 12 Dec 2016 19:33:49 +0000 (20:33 +0100)
* mes.c [QUASISYNTAX]: New switch.  Default off.
 (builtin_eval) [QUASISYNTAX]: Handle syntax, unsyntax, quasisyntax.
* quasiquote.c (syntax, unsyntax, unsyntax_splicing, eval_quasisyntax,
  add_unsyntaxers) [QUASISYNTAX]: Available only.

mes.c
quasiquote.c

diff --git a/mes.c b/mes.c
index cfd834d1bbb9b766652db27872f4b9fe6a2e0077..d8e2fbfe85e1ab8be4841c042c600fa12eb0ee6d 100644 (file)
--- a/mes.c
+++ b/mes.c
@@ -29,6 +29,7 @@
 
 #define DEBUG 0
 #define QUASIQUOTE 1
+//#define QUASISYNTAX 0
 
 enum type {CHAR, MACRO, NUMBER, PAIR, SCM, STRING, SYMBOL, REF, VALUES, VECTOR,
            FUNCTION0, FUNCTION1, FUNCTION2, FUNCTION3, FUNCTIONn};
@@ -410,8 +411,10 @@ builtin_eval (scm *e, scm *a)
     {
       if (e->car == &symbol_quote)
         return cadr (e);
+#if QUASISYNTAX
       if (e->car == &symbol_syntax)
         return e;
+#endif
       if (e->car == &symbol_begin)
         return begin (e, a);
       if (e->car == &scm_lambda)
@@ -444,11 +447,13 @@ builtin_eval (scm *e, scm *a)
         return builtin_eval (cadr (e), a);
       if (e->car == &symbol_quasiquote)
         return eval_quasiquote (cadr (e), add_unquoters (a));
+#endif //QUASIQUOTE
+#if QUASISYNTAX
       if (e->car == &symbol_unsyntax)
         return builtin_eval (cadr (e), a);
       if (e->car == &symbol_quasisyntax)
         return eval_quasisyntax (cadr (e), add_unsyntaxers (a));
-#endif //QUASIQUOTE
+#endif //QUASISYNTAX
     }
   return apply_env (e->car, evlis_env (e->cdr, a), a);
 }
index f351aaa56c116a3e3548be609588c103647affe0..11a3d596383f11f4ed5ad599fda52489c7052c8e 100644 (file)
@@ -19,6 +19,8 @@
  */
 
 #if QUASIQUOTE
+scm *add_environment (scm *a, char const *name, scm *x);
+
 scm *
 unquote (scm *x) ///((no-environment))
 {
@@ -31,6 +33,39 @@ unquote_splicing (scm *x) ///((no-environment))
   return cons (&symbol_unquote_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 *
+the_unquoters = &scm_nil;
+
+scm *
+add_unquoters (scm *a)
+{
+  if (the_unquoters == &scm_nil)
+    the_unquoters = cons (cons (&symbol_unquote, &scm_unquote),
+                          cons (cons (&symbol_unquote_splicing, &scm_unquote_splicing),
+                                &scm_nil));
+  return append2 (the_unquoters, a);
+}
+#else // !QUASIQUOTE
+
+scm*add_unquoters (scm *a){}
+scm*eval_quasiquote (scm *e, scm *a){}
+
+#endif // QUASIQUOTE
+
+#if QUASISYNTAX
 scm *
 syntax (scm *x)
 {
@@ -49,19 +84,6 @@ 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)
 {
@@ -75,21 +97,6 @@ eval_quasisyntax (scm *e, scm *a)
   return cons (eval_quasisyntax (car (e), a), eval_quasisyntax (cdr (e), a));
 }
 
-scm *add_environment (scm *a, char const *name, scm *x);
-
-scm *
-the_unquoters = &scm_nil;
-
-scm *
-add_unquoters (scm *a)
-{
-  if (the_unquoters == &scm_nil)
-    the_unquoters = cons (cons (&symbol_unquote, &scm_unquote),
-                          cons (cons (&symbol_unquote_splicing, &scm_unquote_splicing),
-                                &scm_nil));
-  return append2 (the_unquoters, a);
-}
-
 scm *
 add_unsyntaxers (scm *a)
 {
@@ -98,13 +105,12 @@ add_unsyntaxers (scm *a)
   return a;
 }
 
-#else // !QUASIQUOTE
-
-scm*add_unquoters (scm *a){}
+#else // !QUASISYNTAX
+scm*syntax (scm *x){}
+scm*unsyntax (scm *x){}
+scm*unsyntax_splicing (scm *x){}
 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
-
+#endif // !QUASISYNTAX