diff --git a/GNUmakefile b/GNUmakefile index d42b6712..6c2a681a 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -33,7 +33,6 @@ mes.o: display.c display.h display.i display.environment.i mes.o: lib.c lib.h lib.i lib.environment.i mes.o: math.c math.h math.i math.environment.i mes.o: posix.c posix.h posix.i posix.environment.i -mes.o: quasiquote.c quasiquote.h quasiquote.i quasiquote.environment.i mes.o: reader.c reader.h reader.i reader.environment.i mes.o: string.c string.h string.i string.environment.i mes.o: type.c type.h type.i type.environment.i diff --git a/mes.c b/mes.c index eb39096c..785f95e6 100644 --- a/mes.c +++ b/mes.c @@ -29,9 +29,6 @@ #include #define DEBUG 0 -#define QUASIQUOTE 0 -#define QUASISYNTAX 0 -#define ENV_CACHE 0 #define FIXED_PRIMITIVES 1 #define READER 1 @@ -121,9 +118,6 @@ scm scm_symbol_current_module = {SYMBOL, "current-module"}; scm scm_symbol_primitive_load = {SYMBOL, "primitive-load"}; scm scm_symbol_read_input_file = {SYMBOL, "read-input-file"}; -scm scm_symbol_the_unquoters = {SYMBOL, "*the-unquoters*"}; -scm scm_symbol_the_unsyntaxers = {SYMBOL, "*the-unsyntaxers*"}; - scm scm_symbol_car = {SYMBOL, "car"}; scm scm_symbol_cdr = {SYMBOL, "cdr"}; scm scm_symbol_null_p = {SYMBOL, "null?"}; @@ -168,7 +162,6 @@ SCM r3 = 0; // param 3 #include "math.h" #include "mes.h" #include "posix.h" -#include "quasiquote.h" #include "reader.h" #include "string.h" #include "type.h" @@ -457,14 +450,6 @@ vm_eval_env () SCM x = eval_env (caddr (r1), r0); return set_env_x (cadr (r1), x, r0); } #endif -#if QUASIQUOTE - case cell_symbol_unquote: return eval_env (cadr (r1), r0); - case cell_symbol_quasiquote: return eval_quasiquote (cadr (r1), add_unquoters (r0)); -#endif //QUASIQUOTE -#if QUASISYNTAX - case cell_symbol_unsyntax: return eval_env (cadr (r1), r0); - case cell_symbol_quasisyntax: return eval_quasisyntax (cadr (r1), add_unsyntaxers (r0)); -#endif //QUASISYNTAX default: { SCM x = expand_macro_env (r1, r0); if (x != r1) @@ -1112,7 +1097,6 @@ mes_builtins (SCM a) #include "lib.i" #include "math.i" #include "posix.i" -#include "quasiquote.i" #include "reader.i" #include "string.i" #include "type.i" @@ -1122,28 +1106,10 @@ mes_builtins (SCM a) #include "math.environment.i" #include "mes.environment.i" #include "posix.environment.i" - //#include "quasiquote.environment.i" #include "reader.environment.i" #include "string.environment.i" #include "type.environment.i" -#if QUASIQUOTE - SCM cell_unquote = assq_ref_cache (cell_symbol_unquote, a); - SCM cell_unquote_splicing = assq_ref_cache (cell_symbol_unquote_splicing, a); - SCM the_unquoters = cons (cons (cell_symbol_unquote, cell_unquote), - cons (cons (cell_symbol_unquote_splicing, cell_unquote_splicing), - cell_nil)); - a = acons (cell_symbol_the_unquoters, the_unquoters, a); -#endif -#if QUASISYNTAX - SCM cell_unsyntax = assq_ref_cache (cell_symbol_unsyntax, a); - SCM cell_unsyntax_splicing = assq_ref_cache (cell_symbol_unsyntax_splicing, a); - SCM the_unsyntaxers = cons (cons (cell_symbol_unsyntax, cell_unsyntax), - cons (cons (cell_symbol_unsyntax_splicing, cell_unsyntax_splicing), - cell_nil)); - a = acons (cell_symbol_the_unsyntaxers, the_unsyntaxers, a); -#endif - a = add_environment (a, "*dot*", cell_dot); a = add_environment (a, "*foo-bar-baz*", cell_nil); // FIXME: some off-by one? @@ -1270,7 +1236,6 @@ dump () #include "lib.c" #include "math.c" #include "posix.c" -#include "quasiquote.c" #include "reader.c" #include "string.c" diff --git a/quasiquote.c b/quasiquote.c deleted file mode 100644 index 2188c433..00000000 --- a/quasiquote.c +++ /dev/null @@ -1,131 +0,0 @@ -/* -*-comment-start: "//";comment-end:""-*- - * Mes --- Maxwell Equations of Software - * Copyright © 2016 Jan Nieuwenhuizen - * - * 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 . - */ - -#if QUASIQUOTE -SCM -unquote (SCM x) ///((no-environment)) -{ - return cons (cell_symbol_unquote, x); -} - -SCM -unquote_splicing (SCM x) ///((no-environment)) -{ - return cons (cell_symbol_unquote_splicing, x); -} - -SCM -eval_quasiquote (SCM e, SCM a) -{ - return vm_call (vm_eval_quasiquote, e, cell_undefined, a); -} - -SCM -vm_eval_quasiquote () -{ - if (r1 == cell_nil) return r1; - else if (atom_p (r1) == cell_t) return r1; - else if (eq_p (car (r1), cell_symbol_unquote) == cell_t) - return eval_env (cadr (r1), r0); - else if (TYPE (r1) == PAIR && TYPE (car (r1)) == PAIR - && eq_p (caar (r1), cell_symbol_unquote_splicing) == cell_t) - { - r2 = eval_env (cadar (r1), r0); - return append2 (r2, eval_quasiquote (cdr (r1), r0)); - } - r2 = eval_quasiquote (car (r1), r0); - return cons (r2, eval_quasiquote (cdr (r1), r0)); -} - -SCM -add_unquoters (SCM a) -{ - SCM q = assq_ref_cache (cell_symbol_the_unquoters, a); - return append2 (q, a); -} -#else // !QUASIQUOTE - -SCM add_unquoters (SCM a){} -SCM eval_quasiquote (SCM e, SCM a){} - -SCM unquote (SCM x){} -SCM unquote_splicing (SCM x){} -SCM vm_eval_quasiquote () {} - -#endif // QUASIQUOTE - -#if QUASISYNTAX -SCM -syntax (SCM x) -{ - return cons (cell_symbol_syntax, x); -} - -SCM -unsyntax (SCM x) ///((no-environment)) -{ - return cons (cell_symbol_unsyntax, x); -} - -SCM -unsyntax_splicing (SCM x) ///((no-environment)) -{ - return cons (cell_symbol_unsyntax_splicing, x); -} - -SCM -eval_quasisyntax (SCM e, SCM a) -{ - return vm_call (vm_eval_quasisyntax, e, cell_undefined, a); -} - -SCM -vm_eval_quasisyntax () -{ - if (r1 == cell_nil) return r1; - else if (atom_p (r1) == cell_t) return r1; - else if (eq_p (car (r1), cell_symbol_unsyntax) == cell_t) - return eval_env (cadr (r1), r0); - else if (TYPE (r1) == PAIR && TYPE (car (r1)) == PAIR - && eq_p (caar (r1), cell_symbol_unsyntax_splicing) == cell_t) - { - r2 = eval_env (cadar (r1), r0); - return append2 (r2, eval_quasisyntax (cdr (r1), r0)); - } - r2 = eval_quasisyntax (car (r1), r0); - return cons (r2, eval_quasisyntax (cdr (r1), r0)); -} - -SCM -add_unsyntaxers (SCM a) -{ - SCM q = assq_ref_cache (cell_symbol_the_unsyntaxers, a); - return append2 (q, a); -} - -#else // !QUASISYNTAX -SCM syntax (SCM x){} -SCM unsyntax (SCM x){} -SCM unsyntax_splicing (SCM x){} -SCM add_unsyntaxers (SCM a){} -SCM eval_quasisyntax (SCM e, SCM a){} -SCM vm_eval_quasisyntax () {} - -#endif // !QUASISYNTAX