Zander671/glisp
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Macro expansion!

Browse Source
This commit is contained in:
Zander671
2026-09-04 05:45:48 -07:00
parent 3b2ecf2b16
commit 8024bcfee3
13 changed files with 373 additions and 56 deletions
Download Patch File Download Diff File Expand all files Collapse all files
lisp/kernel.gl
+5 -1
View File
@@ -1,3 +1,7 @@
;; -*- mode: lisp-data -*-
(function-arity (lambda (y &optional x x)))
(fset 'test (cons 'macro (lambda (x) (declare (name test)) (list 'princ x))))
(prin1 (macroexpand-all '(lambda () (test x))
'((test . (lambda (x) (test x))))))
(write-byte ?\n)
src/base.c
+2 -2
View File
@@ -282,8 +282,8 @@ static void check_handler_bind_handlers(LispVal *handlers) {
CHECK_TYPE(XCDR(handler), TYPE_FUNCTION);
if (LISTP(XCAR(handler))) {
// make sure each condition is a symbol
DOTAILS(rest, XCAR(handler)) {
CHECK_TYPE(XCAR(rest), TYPE_SYMBOL);
DOLIST_SAFE(e, XCAR(handler)) {
CHECK_TYPE(e, TYPE_SYMBOL);
}
} else if (!SYMBOLP(XCAR(handler))) {
// if the condition is not a list or symbol, it's an error
src/base.h
+2 -2
View File
@@ -1,5 +1,5 @@
#ifndef INCLUDED_TYPES_H
#define INCLUDED_TYPES_H
#ifndef INCLUDED_BASE_H
#define INCLUDED_BASE_H
#include "argcountmacro.h"
#include "gc.h"
src/function.c
+67 -45
View File
@@ -235,21 +235,6 @@ LispVal *make_builtin_function(LispVal *name, LispVal *(*cfunc)(void),
}
// Calling functions
static ALWAYS_INLINE LispVal *evaluate_function_arguments(LispVal *args) {
LispVal *start = Qnil;
LispVal *end = NULL;
DOLIST(arg, args) {
if (NILP(start)) {
start = CONS(Feval(arg, Vlexical_environment), Qnil);
end = start;
} else {
RPLACD(end, CONS(Feval(arg, Vlexical_environment), Qnil));
end = XCDR(end);
}
}
return start;
}
enum ProcessArgsResult {
PROCESS_ARGS_OK,
PROCESS_ARGS_TOO_FEW,
@@ -334,13 +319,7 @@ static noreturn void signal_argument_error(enum ProcessArgsResult res) {
lisp_signal(Qargument_error, LIST(msg));
}
static ALWAYS_INLINE LispVal *call_native(LispVal *orig_func,
LispFunction *fobj, LispVal *args) {
StackFrame *stack_ref = LISP_STACK_REF();
if (!fobj->impl.native.no_eval_args) {
args = evaluate_function_arguments(args);
}
set_stack_evaluated_args(LISP_STACK_REF(), fobj, args);
static ALWAYS_INLINE LispVal *call_native(LispFunction *fobj, LispVal *args) {
LispVal *arg_arr[MAX_NATIVE_FUNCTION_ARGS] = {NULL};
size_t count = NATIVE_FUNCTION_TOTAL_ARG_COUNT(fobj);
intptr_t rest_idx;
@@ -381,7 +360,7 @@ static ALWAYS_INLINE LispVal *call_native(LispVal *orig_func,
default:
abort();
}
return UNWIND_AND_RETURN(stack_ref, retval);
return retval;
}
static ALWAYS_INLINE void push_optional_argument_to_lexenv(LispVal *spec,
@@ -455,21 +434,17 @@ push_interpreted_args_to_lexenv(LispFunction *fobj, LispVal *args) {
return PROCESS_ARGS_OK;
}
static ALWAYS_INLINE LispVal *
call_interpreted(LispVal *orig_func, LispFunction *fobj, LispVal *args) {
StackFrame *stack_ref = LISP_STACK_REF();
LispVal *evaled_args = evaluate_function_arguments(args);
set_stack_evaluated_args(LISP_STACK_REF(), fobj, evaled_args);
static ALWAYS_INLINE LispVal *call_interpreted(LispFunction *fobj,
LispVal *args) {
push_dynamic_binding(Qlexical_environment, fobj->impl.interp.lexenv);
enum ProcessArgsResult par =
push_interpreted_args_to_lexenv(fobj, evaled_args);
enum ProcessArgsResult par = push_interpreted_args_to_lexenv(fobj, args);
if (par != PROCESS_ARGS_OK) {
signal_argument_error(par);
}
return UNWIND_AND_RETURN(stack_ref, Fprogn(fobj->impl.interp.body));
return Fprogn(fobj->impl.interp.body);
}
static LispFunction *coerce_to_function(LispVal *func) {
LispFunction *coerce_to_function(LispVal *orig_name, LispVal *func) {
LispFunction *fobj = func;
if (SYMBOLP(func)) {
fobj = Fsymbol_function(func, Qt);
@@ -477,29 +452,39 @@ static LispFunction *coerce_to_function(LispVal *func) {
fobj = Feval(func, Vlexical_environment);
}
if (NILP(fobj)) {
lisp_signal(Qvoid_function_error, LIST(orig_name));
} else if (!FUNCTIONP(fobj)) {
signal_type_error(fobj, LIST(Qcallable));
}
// include symbol here for the error message
CHECK_TYPE(fobj, TYPE_FUNCTION, TYPE_SYMBOL);
assert(FUNCTIONP(fobj));
return fobj;
}
DEFUN(funcall, "funcall", (LispVal * func, LispVal *args), "(func &rest args)",
"") {
StackFrame *stack_ref = LISP_STACK_REF();
push_call_frame(func, args);
LispFunction *fobj = coerce_to_function(func);
LispVal *raw_funcall(LispVal *func, LispVal *args) {
assert(FUNCTIONP(func));
LispFunction *fobj = func;
switch (fobj->type) {
case FUNCTION_NATIVE:
return UNWIND_AND_RETURN(stack_ref, call_native(func, fobj, args));
return call_native(fobj, args);
case FUNCTION_INTERP:
return UNWIND_AND_RETURN(stack_ref, call_interpreted(func, fobj, args));
return call_interpreted(fobj, args);
default:
abort();
}
}
DEFUN(funcall, "funcall", (LispVal * func, LispVal *args), "(func &rest args)",
"") {
LispVal *res = coerce_to_function(func, func);
if (!NILP(Fspecial_form_p(res))) {
signal_type_error(res, Qfunction);
}
StackFrame *stack_ref = LISP_STACK_REF();
push_call_frame(func, args);
set_stack_evaluated_args(LISP_STACK_REF(), res, args);
return UNWIND_AND_RETURN(stack_ref, raw_funcall(res, args));
}
static LispVal *parse_lambda_declare_form(LispFunction *fobj, LispVal *body) {
while (CONSP(body) && CONSP(XCAR(body)) && EQ(XCAR(XCAR(body)), Qdeclare)) {
LispVal *decls = XCDR(XCAR(body));
@@ -519,6 +504,18 @@ static LispVal *parse_lambda_declare_form(LispFunction *fobj, LispVal *body) {
return body;
}
static void macroexpand_lambda_list(struct LambdaList *restrict ll) {
DOLIST(ent, ll->opt) {
RPLACA(XCDR(ent), Fmacroexpand_all(SECOND(ent), Qnil));
}
if (HASH_TABLE_P(ll->kw)) {
HT_FOREACH_INDEX(ll->kw, i) {
LispVal *ent = HASH_VALUE(ll->kw, i);
RPLACA(XCDR(XCDR(ent)), Fmacroexpand_all(THIRD(ent), Qnil));
}
}
}
DEFSPECIAL(lambda, "lambda", (LispVal * args, LispVal *body),
"(args &rest body)", "") {
LambdaListParseResult llpr;
@@ -542,7 +539,8 @@ DEFSPECIAL(lambda, "lambda", (LispVal * args, LispVal *body),
fobj->docstr = Qnil;
}
body = parse_lambda_declare_form(fobj, body);
fobj->impl.interp.body = body;
macroexpand_lambda_list(&fobj->args);
fobj->impl.interp.body = macroexpand_list(body, Qnil);
fobj->impl.interp.lexenv = Vlexical_environment;
return fobj;
}
@@ -556,8 +554,9 @@ DEFUN(callablep, "callablep", (LispVal * obj), "(obj)", "") {
}
DEFUN(function_arity, "function-arity", (LispVal * func), "(func)",
"Return a list of the form (NUM-REQ NUM-OPT KW-NAMES HAS-REST).") {
LispFunction *fobj = coerce_to_function(func);
"Return a list of the form (NUM-REQ NUM-OPT KW-NAMES ALLOW-OTHER-KEYS "
"HAS-REST).") {
LispFunction *fobj = coerce_to_function(func, func);
LispVal *kw = Qnil;
if (HASH_TABLE_P(fobj->args.kw)) {
HT_FOREACH_INDEX(fobj->args.kw, i) {
@@ -565,7 +564,28 @@ DEFUN(function_arity, "function-arity", (LispVal * func), "(func)",
}
}
return LIST(MAKE_FIXNUM(fobj->args.n_req), MAKE_FIXNUM(fobj->args.n_opt),
kw, NILP(fobj->args.rest) ? Qnil : Qt);
kw, fobj->args.allow_other_keys ? Qt : Qnil,
NILP(fobj->args.rest) ? Qnil : Qt);
}
bool builtin_function_p(LispVal *val, bool special_form) {
if (SYMBOLP(val)) {
val = Fsymbol_function(val, Qt);
}
if (FUNCTIONP(val)) {
LispFunction *fobj = val;
return fobj->type == FUNCTION_NATIVE
&& fobj->impl.native.no_eval_args == special_form;
}
return false;
}
DEFUN(builtin_function_p, "builtin-function-p", (LispVal * val), "(val)", "") {
return builtin_function_p(val, false) ? Qt : Qnil;
}
DEFUN(special_form_p, "special-form-p", (LispVal * val), "(val)", "") {
return builtin_function_p(val, true) ? Qt : Qnil;
}
DEFINE_SYMBOL(declare, "declare");
@@ -574,6 +594,8 @@ DEFINE_SYMBOL(name, "name");
DEFINE_SYMBOL(callable, "callable");
DEFINE_SYMBOL(argument_error, "argument-error");
DEFINE_CONDITION_CLASS(argument_error, error);
DEFINE_SYMBOL(void_function_error, "void-function-error");
DEFINE_CONDITION_CLASS(void_function_error, error);
DEFINE_SYMBOL(function_definition_error, "function-definition-error");
DEFINE_CONDITION_CLASS(function_definition_error, error);
src/function.h
+9
View File
@@ -89,6 +89,9 @@ LispVal *make_builtin_function(LispVal *name, LispVal *(*func)(void),
make_lisp_string(internal_F##cname##_docstr, \
internal_F##cname##_docstr_len, false, false))
LispFunction *coerce_to_function(LispVal *orig_name, LispVal *func);
// Call a function object directly
LispVal *raw_funcall(LispVal *func, LispVal *args);
DECLARE_FUNCTION(funcall, (LispVal * func, LispVal *args));
#define CALL(func, ...) (Ffuncall((func), LIST(__VA_ARGS__)))
#define CALL0(func) (Ffuncall((func), Qnil))
@@ -97,12 +100,18 @@ DECLARE_FUNCTION(lambda, (LispVal * args, LispVal *body));
DECLARE_FUNCTION(callablep, (LispVal * obj));
DECLARE_FUNCTION(function_arity, (LispVal * func));
bool builtin_function_p(LispVal *val, bool special_form);
DECLARE_FUNCTION(builtin_function_p, (LispVal * val));
DECLARE_FUNCTION(special_form_p, (LispVal * val));
DECLARE_SYMBOL(declare);
DECLARE_SYMBOL(name);
DECLARE_SYMBOL(callable);
DECLARE_SYMBOL(argument_error);
MAKE_CONDITION_CLASS(argument_error);
DECLARE_SYMBOL(void_function_error);
MAKE_CONDITION_CLASS(void_function_error);
DECLARE_SYMBOL(function_definition_error);
MAKE_CONDITION_CLASS(function_definition_error);
src/gen-init-globals.awk
+1 -1
View File
@@ -72,7 +72,7 @@ function get_next_symbol() {
function maybe_emit_next_symbol(entity) {
name = get_next_symbol()
if (name) {
print " REGISTER_GLOBAL_" entity "(" get_next_symbol() ");";
print " REGISTER_GLOBAL_" entity "(" name ");";
}
}
src/lisp.c
+34 -2
View File
@@ -84,6 +84,22 @@ static inline LispVal *lookup_variable(LispSymbol *name, LispVal *lexenv) {
return SYMBOL_VALUE(name);
}
static ALWAYS_INLINE LispVal *evaluate_function_arguments(LispVal *args,
LispVal *lexenv) {
LispVal *start = Qnil;
LispVal *end = NULL;
DOLIST(arg, args) {
if (NILP(start)) {
start = CONS(Feval(arg, lexenv), Qnil);
end = start;
} else {
RPLACD(end, CONS(Feval(arg, lexenv), Qnil));
end = XCDR(end);
}
}
return start;
}
DEFUN(eval, "eval", (LispVal * form, LispVal *lexenv),
"(form &optional lexenv)", "") {
if (!OBJECTP(form)) {
@@ -109,8 +125,24 @@ DEFUN(eval, "eval", (LispVal * form, LispVal *lexenv),
}
case TYPE_SYMBOL:
return lookup_variable(form, lexenv);
case TYPE_CONS:
return Ffuncall(XCAR(form), XCDR(form));
case TYPE_CONS: {
LispVal *res = XCAR(form);
if (SYMBOLP(res)) {
res = Fsymbol_function(res, Qt);
}
if (!NILP(Fmacrop(res))) {
return Feval(Fmacroexpand_all(form, Qnil), lexenv);
}
LispVal *stack_ref = LISP_STACK_REF();
push_call_frame(XCAR(form), XCDR(form));
LispVal *evaled_args = XCDR(form);
if (NILP(Fspecial_form_p(res))) {
evaled_args = evaluate_function_arguments(XCDR(form), lexenv);
}
LispVal *fobj = coerce_to_function(XCAR(form), res);
set_stack_evaluated_args(LISP_STACK_REF(), fobj, evaled_args);
return UNWIND_AND_RETURN(stack_ref, raw_funcall(fobj, evaled_args));
}
case TYPE_FIXNUM:
case TYPE_FLOAT:
default:
src/lisp.h
+1
View File
@@ -6,6 +6,7 @@
#include "hashtable.h" // IWYU pragma: export
#include "lisp_string.h" // IWYU pragma: export
#include "list.h" // IWYU pragma: export
#include "macro.h" // IWYU pragma: export
#include "print.h" // IWYU pragma: export
#include "stack.h" // IWYU pragma: export
src/list.c
+57 -2
View File
@@ -35,6 +35,16 @@ DEFUN(cons, "cons", (LispVal * car, LispVal *cdr), "(car cdr)",
return CONS(car, cdr);
}
DEFUN(car, "car", (LispVal * list), "(list)", "") {
CHECK_LISTP(list);
return NILP(list) ? Qnil : XCAR(list);
}
DEFUN(cdr, "cdr", (LispVal * list), "(list)", "") {
CHECK_LISTP(list);
return NILP(list) ? Qnil : XCDR(list);
}
DEFUN(length, "length", (LispVal * list), "(list)", "") {
CHECK_LISTP(list);
intptr_t len = list_length(list);
@@ -96,11 +106,30 @@ DEFUN(list, "list", (LispVal * args), "(&rest args)", "") {
return args;
}
DEFUN(copy_list, "copy-list", (LispVal * list), "(list)", "") {
LispVal *start = Qnil;
LispVal *end = NULL;
DOTAILS(rest, list) {
if (!CONSP(rest)) {
RPLACD(end, rest);
break;
}
if (NILP(start)) {
start = CONS(XCAR(rest), Qnil);
end = start;
} else {
RPLACD(end, CONS(XCAR(rest), Qnil));
end = XCDR(end);
}
}
return start;
}
LispVal *nth(size_t n, LispVal *list) {
size_t i = 0;
DOTAILS(rest, list) {
DOLIST_SAFE(elt, list) {
if (i == n) {
return XCAR(rest);
return elt;
}
++i;
}
@@ -117,12 +146,14 @@ DEFUN(member, "member", (LispVal * elt, LispVal *list, LispVal *pred),
if (NILP(pred) || pred == Qeq) {
// fast case
DOTAILS(rest, list) {
CHECK_LISTP(rest);
if (elt == XCAR(rest)) {
return rest;
}
}
} else {
DOTAILS(rest, list) {
CHECK_LISTP(rest);
if (!NILP(CALL(pred, elt, XCAR(rest)))) {
return rest;
}
@@ -134,6 +165,7 @@ DEFUN(member, "member", (LispVal * elt, LispVal *list, LispVal *pred),
DEFUN(member_if, "member-if", (LispVal * pred, LispVal *list), "(pred list)",
"") {
DOTAILS(rest, list) {
CHECK_LISTP(rest);
if (!NILP(CALL(pred, XCAR(rest)))) {
return rest;
}
@@ -145,7 +177,9 @@ DEFUN(plist_put, "plist-put", (LispVal * plist, LispVal *prop, LispVal *value),
"(plist prop value)", "") {
CHECK_LISTP(plist);
DOTAILS(rest, plist) {
CHECK_LISTP(rest);
if (EQ(XCAR(rest), prop)) {
CHECK_TYPE(XCDR(rest), TYPE_CONS);
RPLACA(XCDR(rest), value);
return plist;
}
@@ -163,3 +197,24 @@ DEFUN(plist_get, "plist-get", (LispVal * plist, LispVal *prop, LispVal *def),
}
return def;
}
DEFUN(assoc, "assoc", (LispVal * key, LispVal *alist, LispVal *pred),
"(key alist &optional pred)", "") {
if (NILP(pred)) {
DOLIST_SAFE(ent, alist) {
CHECK_TYPE(ent, TYPE_CONS);
if (EQ(key, XCAR(ent))) {
return ent;
}
}
return Qnil;
} else {
DOLIST_SAFE(ent, alist) {
CHECK_TYPE(ent, TYPE_CONS);
if (!NILP(CALL(pred, key, XCAR(ent)))) {
return ent;
}
}
return Qnil;
}
}
src/list.h
+9
View File
@@ -106,6 +106,10 @@ static ALWAYS_INLINE LispVal *LIST_N(int count, ...) {
for (LispVal *_tail = (l), *v = XCAR(_tail); !NILP(_tail); \
_tail = XCDR(_tail), v = XCAR(_tail))
#define DOLIST_SAFE(v, l) \
for (LispVal *_tail = (l), *v = Fcar(_tail); !NILP(_tail); \
_tail = Fcdr(_tail), v = Fcar(_tail))
#define DOTAILS(v, l) for (LispVal *v = (l); !NILP(v); v = XCDR_SAFE(v))
DECLARE_SYMBOL(circular_list_error);
@@ -117,6 +121,8 @@ intptr_t list_length(LispVal *list);
bool list_length_eq(LispVal *list, intptr_t size);
DECLARE_FUNCTION(cons, (LispVal * car, LispVal *cdr));
DECLARE_FUNCTION(car, (LispVal * list));
DECLARE_FUNCTION(cdr, (LispVal * list));
DECLARE_FUNCTION(length, (LispVal * list));
DECLARE_FUNCTION(length_eq, (LispVal * list, LispVal *length));
DECLARE_FUNCTION(nreverse, (LispVal * list));
@@ -126,6 +132,7 @@ DECLARE_FUNCTION(proper_list_p, (LispVal * obj));
DECLARE_FUNCTION(circular_list_p, (LispVal * obj));
DECLARE_FUNCTION(dotted_list_p, (LispVal * obj));
DECLARE_FUNCTION(list, (LispVal * args));
DECLARE_FUNCTION(copy_list, (LispVal * list));
LispVal *nth(size_t n, LispVal *list);
DECLARE_FUNCTION(nth, (LispVal * n, LispVal *list));
static ALWAYS_INLINE void CHECK_LISTP(LispVal *obj) {
@@ -141,4 +148,6 @@ DECLARE_FUNCTION(member_if, (LispVal * pred, LispVal *list));
DECLARE_FUNCTION(plist_put, (LispVal * plist, LispVal *prop, LispVal *value));
DECLARE_FUNCTION(plist_get, (LispVal * plist, LispVal *prop, LispVal *def));
DECLARE_FUNCTION(assoc, (LispVal * key, LispVal *alist, LispVal *pred));
#endif
src/macro.c
+162
View File
@@ -0,0 +1,162 @@
#include "macro.h"
#include "function.h"
#include "lisp.h"
#include "list.h"
DEFINE_SYMBOL(macro, "macro");
DEFUN(macrop, "macrop", (LispVal * obj), "(obj)", "") {
if (SYMBOLP(obj)) {
obj = Fsymbol_function(obj, Qt);
}
if (CONSP(obj) && EQ(XCAR(obj), Qmacro) && !NILP(Fcallablep(XCDR(obj)))) {
return XCDR(obj);
}
return Qnil;
}
static LispVal *resolve_macro(LispVal *sym_or_list, LispVal *lexical_macros) {
if (SYMBOLP(sym_or_list)) {
LispVal *lexical_entry = Fassoc(sym_or_list, lexical_macros, Qnil);
if (CONSP(lexical_entry)) {
return XCDR(lexical_entry);
}
}
return Fmacrop(sym_or_list);
}
DEFUN(macroexpand_1, "macroexpand-1", (LispVal * form, LispVal *lexical_macros),
"(form &optional lexical-macros)", "") {
CHECK_LISTP(form);
if (NILP(form)) {
return Qnil;
}
LispVal *func = resolve_macro(XCAR(form), lexical_macros);
if (NILP(func)) {
return form;
}
return Ffuncall(func, XCDR(form));
}
DEFUN(macroexpand_toplevel, "macroexpand-toplevel",
(LispVal * form, LispVal *lexical_macros),
"(form &optional lexical-macros)", "") {
while (CONSP(form)
&& (!NILP(Fmacrop(XCAR(form)))
|| !NILP(Fassoc(XCAR(form), lexical_macros, Qnil)))) {
form = Fmacroexpand_1(form, lexical_macros);
}
return form;
}
LispVal *macroexpand_list(LispVal *list, LispVal *lexical_macros) {
LispVal *start = Qnil;
LispVal *end = NULL;
DOTAILS(rest, list) {
if (!LISTP(rest)) {
RPLACD(end, rest);
break;
}
LispVal *expanded = Fmacroexpand_all(XCAR(rest), lexical_macros);
if (NILP(start)) {
start = CONS(expanded, Qnil);
end = start;
} else {
RPLACD(end, CONS(expanded, Qnil));
end = XCDR(end);
}
}
return start;
}
static LispVal *macroexpand_lambda_form(LispVal *form,
LispVal *lexical_macros) {
LispVal *body = macroexpand_list(XCDR_SAFE(XCDR(form)), lexical_macros);
LispVal *lambda_list = Fcopy_list(XCAR_SAFE(XCDR(form)));
enum { REQ, OPT, KEY } state = REQ;
DOTAILS(rest, XCAR_SAFE(XCDR(form))) {
if (!CONSP(rest)) {
break;
}
LispVal *ent = XCAR(rest);
if (state == REQ && EQ(ent, Qand_optional)) {
state = OPT;
} else if (state == OPT && EQ(ent, Qand_key)) {
state = KEY;
} else if ((state == KEY || state == OPT) && CONSP(ent)
&& CONSP(XCDR(ent))) {
ent = Fcopy_list(ent);
RPLACA(rest, ent);
RPLACA(XCDR(ent), Fmacroexpand_all(SECOND(ent), lexical_macros));
}
}
return CONS(XCAR(form), CONS(lambda_list, body));
}
static LispVal *macroexpand_special_form(LispVal *fobj, LispVal *form,
LispVal *lexical_macros) {
assert(FUNCTIONP(fobj));
#define IS(n) (fobj == ((LispSymbol *) Q##n)->function)
if (IS(lambda)) {
return macroexpand_lambda_form(form, lexical_macros);
} else if (IS(quote)) {
return form;
} else if (IS(progn) || IS(if) || IS(and) || IS(or)) {
if (LISTP(XCDR(form))) {
return CONS(XCAR(form),
macroexpand_list(XCDR(form), lexical_macros));
}
return form;
} else if (IS(setq)) {
LispVal *args = Fcopy_list(XCDR(form));
bool expand = false;
DOTAILS(rest, args) {
if (expand) {
RPLACA(rest, Fmacroexpand_all(XCAR(rest), lexical_macros));
}
expand = !expand;
}
return CONS(XCAR(form), args);
} else if (IS(let)) {
LispVal *bindings = Fcopy_list(SECOND(form));
DOTAILS(rest, bindings) {
if (!LISTP(rest)) {
break;
}
LispVal *binding = XCAR(rest);
if (CONSP(binding) && CONSP(XCDR(binding))) {
RPLACA(XCDR(binding),
Fmacroexpand_all(SECOND(binding), lexical_macros));
}
}
LispVal *prog =
macroexpand_list(XCDR_SAFE(XCDR_SAFE(form)), lexical_macros);
return CONS(XCAR(form), CONS(bindings, prog));
}
abort();
#undef IS
}
DEFUN(macroexpand_all, "macroexpand-all",
(LispVal * form, LispVal *lexical_macros),
"(form &optional lexical-macros)", "") {
if (!CONSP(form)) {
return form;
}
LispVal *func = XCAR(form);
if (SYMBOLP(func)) {
func = Fsymbol_function(func, Qt);
}
if (builtin_function_p(func, true)) {
return macroexpand_special_form(func, form, lexical_macros);
} else {
form = Fmacroexpand_toplevel(form, lexical_macros);
if (CONSP(form) && CONSP(XCDR(form))) {
return CONS(XCAR(form),
macroexpand_list(XCDR(form), lexical_macros));
}
return form;
}
return Qnil;
}
src/macro.h
+15
View File
@@ -0,0 +1,15 @@
#ifndef INCLUDED_MACRO_H
#define INCLUDED_MACRO_H
#include "base.h"
DECLARE_SYMBOL(macro);
DECLARE_FUNCTION(macrop, (LispVal * obj));
DECLARE_FUNCTION(macroexpand_1, (LispVal * form, LispVal *lexical_macros));
DECLARE_FUNCTION(macroexpand_toplevel,
(LispVal * form, LispVal *lexical_macros));
LispVal *macroexpand_list(LispVal *list, LispVal *lexical_macros);
DECLARE_FUNCTION(macroexpand_all, (LispVal * form, LispVal *lexical_macros));
#endif
src/print.c
+9 -1
View File
@@ -349,7 +349,11 @@ static void print_function(struct PrintContext *restrict pc, LispVal *val) {
print_char(pc, '<');
switch (f->type) {
case FUNCTION_NATIVE:
PRINT_STATIC_BUFFER(pc, "native-function");
if (f->impl.native.no_eval_args) {
PRINT_STATIC_BUFFER(pc, "special-form");
} else {
PRINT_STATIC_BUFFER(pc, "native-function");
}
break;
case FUNCTION_INTERP:
PRINT_STATIC_BUFFER(pc, "interp-function");
@@ -358,6 +362,10 @@ static void print_function(struct PrintContext *restrict pc, LispVal *val) {
abort();
}
print_char(pc, ' ');
if (!NILP(f->name)) {
print_driver(pc, f->name);
print_char(pc, ' ');
}
// large enough for 32 or 64 bit word size
char buffer[32];
int written = snprintf(buffer, sizeof(buffer), "0x%jx", (uintmax_t) &f);