artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

core: Add compile time switch for quasisyntax.

Browse source 
* 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.
This commit is contained in:
Jan Nieuwenhuizen 2016-10-30 16:01:34 +01:00
parent ad717d4bba
commit d34dba24f2
2 changed files with 46 additions and 35 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
mes.c
View file

@ -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);
}

74
quasiquote.c
View 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