From 6ecb05deb926a6f1a171d5dcf41d613663289d22 Mon Sep 17 00:00:00 2001 From: jgarcia Date: Sat, 20 May 2006 22:17:03 +0000 Subject: [PATCH] Reduced the number of functions dealing with macros. The second value of MACROEXPAND-1 is T whenever the macro function was called. MACROEXPAND detects some infinite loops. --- msvc/ecl-threads.def | 6 +- msvc/ecl.def | 6 +- src/CHANGELOG | 5 ++ src/c/compiler.d | 2 +- src/c/macros.d | 138 +++++++++++++++++++------------------------ src/c/reference.d | 16 ----- src/h/external.h | 7 +-- 7 files changed, 69 insertions(+), 111 deletions(-) diff --git a/msvc/ecl-threads.def b/msvc/ecl-threads.def index f7d2ce293..3351c479c 100755 --- a/msvc/ecl-threads.def +++ b/msvc/ecl-threads.def @@ -513,10 +513,7 @@ EXPORTS cl_macroexpand cl_macroexpand_1 - - search_macro - macro_expand1 - macro_expand + cl_macro_function ; main.c @@ -908,7 +905,6 @@ EXPORTS cl_symbol_value cl_boundp cl_special_operator_p - cl_macro_function ecl_fdefinition diff --git a/msvc/ecl.def b/msvc/ecl.def index 173d1e479..5772936e6 100644 --- a/msvc/ecl.def +++ b/msvc/ecl.def @@ -514,10 +514,7 @@ EXPORTS cl_macroexpand cl_macroexpand_1 - - search_macro - macro_expand1 - macro_expand + cl_macro_function ; main.c @@ -909,7 +906,6 @@ EXPORTS cl_symbol_value cl_boundp cl_special_operator_p - cl_macro_function ecl_fdefinition diff --git a/src/CHANGELOG b/src/CHANGELOG index 4f148d22d..e33be4590 100644 --- a/src/CHANGELOG +++ b/src/CHANGELOG @@ -113,6 +113,11 @@ ECL 0.9i constants. The only case where this fail is when the "unreadable" constant is part of a circular structure (contributed by Brian Spilsbury). + - The second value of MACROEXPAND-1 is true whenever a macroexpansion + happened; in other words, whenever an macro function was called. MACROEXPAND + on the additionally checks whether the macroexpanded form is eq to the + original one and complains of the infinite loop that results. + * MOP compatibility: - SLOT-VALUE, SLOT-BOUNDP, etc, together with MOP SLOT*-USING-CLASS generic diff --git a/src/c/compiler.d b/src/c/compiler.d index c8c3a00b7..acdae4836 100644 --- a/src/c/compiler.d +++ b/src/c/compiler.d @@ -329,7 +329,7 @@ c_register_function(cl_object name) static cl_object c_macro_expand1(cl_object stmt) { - return macro_expand1(stmt, CONS(ENV->variables, ENV->macros)); + return cl_macroexpand_1(2, stmt, CONS(ENV->variables, ENV->macros)); } static void diff --git a/src/c/macros.d b/src/c/macros.d index 08fb04d5c..b8250f9d7 100644 --- a/src/c/macros.d +++ b/src/c/macros.d @@ -23,11 +23,6 @@ /******************************* ------- ******************************/ -/* - MACRO_DEF is an internal function which, given a form, returns - the expansion function if the form is a macro form. Otherwise, - MACRO_DEF returns NIL. -*/ static cl_object search_symbol_macro(cl_object name, cl_object env) { @@ -40,93 +35,80 @@ search_symbol_macro(cl_object name, cl_object env) return Cnil; } -cl_object -search_macro(cl_object name, cl_object env) -{ - cl_object record = assq(name, CDR(env)); - if (CONSP(record) && CADR(record) == @'si::macro') - return CADDR(record); - return Cnil; -} - static cl_object -macro_def(cl_object form, cl_object env) +search_macro_function(cl_object name, cl_object env) { - cl_object head, fd; - - if (ATOM(form)) { - if (!SYMBOLP(form)) - return Cnil; - /* First look for SYMBOL-MACROLET definitions */ - fd = search_symbol_macro(form, env); - return fd; + if (!SYMBOLP(name)) + FEtype_error_symbol(name); + if (env != Cnil) { + cl_object record = assq(name, CDR(env)); + if (CONSP(record)) { + cl_object tag = CADR(record); + if (tag == @'si::macro') + return CADDR(record); + if (tag == @'function') + return Cnil; + } + } + if (name->symbol.mflag) { + return SYM_FUN(name); + } else { + return Cnil; } - head = CAR(form); - if (!SYMBOLP(head)) - return(Cnil); - fd = search_macro(head, env); - if (!Null(fd)) - return fd; - else if (head->symbol.mflag) - return(SYM_FUN(head)); - else - return(Cnil); } -@(defun macroexpand (form &optional (env Cnil)) - cl_object new_form = OBJNULL; - cl_object done = Cnil; +@(defun macro_function (sym &optional env) @ - new_form = macro_expand1(form, env); - while (new_form != form) { - done = Ct; - form = new_form; - new_form = macro_expand(form, env); - } - @(return new_form done) + @(return (search_macro_function(sym, env))) @) +/* + Analyze a form and expand it once if it is a macro form. + VALUES(0) contains either the expansion or the original form. + VALUES(1) is true when there was a macroexpansion. +*/ + @(defun macroexpand_1 (form &optional (env Cnil)) - cl_object new_form; + cl_object exp_fun = Cnil; @ - new_form = macro_expand1(form, env); - @(return new_form (new_form == form? Cnil : Ct)) + if (ATOM(form)) { + if (SYMBOLP(form)) + exp_fun = search_symbol_macro(form, env); + } else { + cl_object head = CAR(form); + if (SYMBOLP(head)) + exp_fun = search_macro_function(head, env); + } + if (!Null(exp_fun)) { + cl_object hook = symbol_value(@'*macroexpand-hook*'); + if (hook == @'funcall') + form = funcall(3, exp_fun, form, env); + else + form = funcall(4, hook, exp_fun, form, env); + } + @(return form exp_fun) @) /* - MACRO_EXPAND1 is an internal function which simply applies the - function EXP_FUN to FORM. On return, the expanded form is stored - in VALUES(0). + Expands a form as many times as possible and returns the + finally expanded form. */ -cl_object -macro_expand1(cl_object form, cl_object env) -{ - cl_object hook, exp_fun; - - exp_fun = macro_def(form, env); - if (Null(exp_fun)) - return form; - hook = symbol_value(@'*macroexpand-hook*'); - if (hook == @'funcall') - return funcall(3, exp_fun, form, env); - else - return funcall(4, hook, exp_fun, form, env); -} - -/* - MACRO_EXPAND expands a form as many times as possible and returns - the finally expanded form. -*/ -cl_object -macro_expand(cl_object form, cl_object env) -{ - cl_object new_form; - - for (new_form = OBJNULL; new_form != form; form = new_form) { - new_form = macro_expand1(form, env); - } - return new_form; -} +@(defun macroexpand (form &optional env) + cl_object done, old_form; +@ + done = Cnil; + do { + form = cl_macroexpand_1(2, old_form = form, env); + if (VALUES(1) == Cnil) { + break; + } else if (old_form == form) { + FEerror("Infinite loop when expanding macro form ~A", 1, old_form); + } else { + done = Ct; + } + } while (1); + @(return form done) +@) static cl_object or_macro(cl_object whole, cl_object env) diff --git a/src/c/reference.d b/src/c/reference.d index 826735db9..61c1a9d6f 100644 --- a/src/c/reference.d +++ b/src/c/reference.d @@ -134,22 +134,6 @@ cl_boundp(cl_object sym) @(return ((SYM_VAL(sym) == OBJNULL)? Cnil : Ct)) } -@(defun macro_function (sym &optional env) - cl_object fd; -@ - if (!SYMBOLP(sym)) - FEtype_error_symbol(sym); - if (Null(env)) - fd = Cnil; - else { - fd = search_macro(sym, env); - if (!Null(fd)) @(return fd) - } - if (sym->symbol.mflag) - fd = SYM_FUN(sym); - @(return fd) -@) - cl_object cl_special_operator_p(cl_object form) { diff --git a/src/h/external.h b/src/h/external.h index 2ed009e84..f54f5a91a 100644 --- a/src/h/external.h +++ b/src/h/external.h @@ -776,10 +776,7 @@ extern cl_object cl_load _ARGS((cl_narg narg, cl_object pathname, ...)); extern cl_object cl_macroexpand _ARGS((cl_narg narg, cl_object form, ...)); extern cl_object cl_macroexpand_1 _ARGS((cl_narg narg, cl_object form, ...)); - -extern cl_object search_macro(cl_object name, cl_object env); -extern cl_object macro_expand1(cl_object form, cl_object env); -extern cl_object macro_expand(cl_object form, cl_object env); +extern cl_object cl_macro_function _ARGS((cl_narg narg, cl_object sym, ...)); /* main.c */ @@ -1196,8 +1193,6 @@ extern cl_object si_coerce_to_function(cl_object form); extern cl_object cl_symbol_value(cl_object sym); extern cl_object cl_boundp(cl_object sym); extern cl_object cl_special_operator_p(cl_object form); -extern cl_object cl_macro_function _ARGS((cl_narg narg, cl_object sym, ...)); - extern cl_object ecl_fdefinition(cl_object fname); /* sequence.c */