mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-01-11 11:42:51 -08:00
135 lines
3 KiB
D
135 lines
3 KiB
D
/*
|
|
macros.c -- Macros.
|
|
*/
|
|
/*
|
|
Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
|
|
Copyright (c) 1990, Giuseppe Attardi.
|
|
Copyright (c) 2001, Juan Jose Garcia Ripoll.
|
|
|
|
ECL is free software; you can redistribute it and/or
|
|
modify it under the terms of the GNU Library General Public
|
|
License as published by the Free Software Foundation; either
|
|
version 2 of the License, or (at your option) any later version.
|
|
|
|
See file '../Copyright' for full details.
|
|
*/
|
|
|
|
#include "ecl.h"
|
|
|
|
/******************************* REQUIRES ******************************/
|
|
|
|
/* Requires expand-defmacro, from lsp/defmacro.lsp */
|
|
|
|
/******************************* ------- ******************************/
|
|
|
|
/*
|
|
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)
|
|
{
|
|
cl_object record = assq(name, CAR(env));
|
|
if (Null(record))
|
|
return get(name, @'si::symbol-macro', Cnil);
|
|
else if (CADR(record) == @'si::symbol-macro')
|
|
return CADDR(record);
|
|
else
|
|
return Cnil;
|
|
}
|
|
|
|
cl_object
|
|
search_macro(cl_object name, cl_object env)
|
|
{
|
|
cl_object record = assq(name, CDR(env));
|
|
if (CONSP(record) && CADR(record) == @'macro')
|
|
return CADDR(record);
|
|
return Cnil;
|
|
}
|
|
|
|
static cl_object
|
|
macro_def(cl_object form, 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;
|
|
}
|
|
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;
|
|
@
|
|
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)
|
|
@)
|
|
|
|
@(defun macroexpand_1 (form &optional (env Cnil))
|
|
cl_object new_form;
|
|
@
|
|
new_form = macro_expand1(form, env);
|
|
@(return new_form (new_form == form? Cnil : Ct))
|
|
@)
|
|
|
|
/*
|
|
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).
|
|
*/
|
|
cl_object
|
|
macro_expand1(cl_object form, cl_object env)
|
|
{
|
|
cl_object hook, lex;
|
|
cl_object 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;
|
|
}
|
|
|
|
void
|
|
init_macros(void)
|
|
{
|
|
SYM_VAL(@'*macroexpand-hook*') = @'funcall';
|
|
}
|