test: Add psyntax closure tests.

[mes.git] / quasiquote.c

diff --git a/quasiquote.c b/quasiquote.c
index f724fe2aed0db9ae9556dbf9bcbd6fa7c9492475..e2518e72e6228aee8056132b04e513927dd3415a 100644 (file)
--- a/quasiquote.c
+++ b/quasiquote.c
@@ -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 eval_env (cadr (e), a);
+  else if (e->type == PAIR && e->car->type == PAIR
+           && eq_p (caar (e), &symbol_unquote_splicing) == &scm_t)
+      return append2 (eval_env (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,42 +84,19 @@ 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);
+    return eval_env (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 append2 (eval_env (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)
 {
@@ -93,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