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

@@ -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
 

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
 

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

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

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)

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)
 {

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 */