add some important primitive macros such as cond, and, or, ...etc
This commit is contained in:
parent
207ec5bd24
commit
5e74caa7a5
|
@ -83,6 +83,30 @@
|
|||
(cons (f (car list))
|
||||
(map f (cdr list)))))
|
||||
|
||||
(define-macro let
|
||||
(lambda (bindings . body)
|
||||
(cons (cons 'lambda (cons (map car bindings) body)) (map cadr bindings))))
|
||||
(define-macro (let bindings . body)
|
||||
(cons (cons 'lambda (cons (map car bindings) body))
|
||||
(map cadr bindings)))
|
||||
|
||||
(define-macro (cond . clauses)
|
||||
(if (null? clauses)
|
||||
#f
|
||||
(let ((c (car clauses)))
|
||||
(let ((test (car c))
|
||||
(if-true (cons 'begin (cdr c)))
|
||||
(if-false (cons 'cond (cdr clauses))))
|
||||
(list 'if test if-true if-false)))))
|
||||
|
||||
(define-macro (and . exprs)
|
||||
(if (null? exprs)
|
||||
#t
|
||||
(let ((test (car exprs))
|
||||
(if-true (cons 'and (cdr exprs))))
|
||||
(list 'if test if-true #f))))
|
||||
|
||||
(define-macro (or . exprs)
|
||||
(if (null? exprs)
|
||||
#f
|
||||
(let ((test (car exprs))
|
||||
(if-false (cons 'or (cdr exprs))))
|
||||
(list 'let (list (list 'it test))
|
||||
(list 'if 'it 'it if-false)))))
|
||||
|
|
44
src/expand.c
44
src/expand.c
|
@ -60,9 +60,43 @@ expand(pic_state *pic, pic_value obj, struct syntactic_env *env)
|
|||
|
||||
sym = pic_sym(pic_car(pic, obj));
|
||||
if (sym == pic->sDEFINE_MACRO) {
|
||||
v = pic_apply(pic, pic_codegen(pic, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))), pic_nil_value());
|
||||
pic_value var, val;
|
||||
struct pic_proc *proc;
|
||||
|
||||
if (pic_length(pic, obj) < 2) {
|
||||
pic_error(pic, "syntax error");
|
||||
}
|
||||
|
||||
var = pic_car(pic, pic_cdr(pic, obj));
|
||||
if (pic_pair_p(var)) {
|
||||
val = pic_cons(pic, pic_symbol_value(pic->sLAMBDA),
|
||||
pic_cons(pic, pic_cdr(pic, var),
|
||||
pic_cdr(pic, pic_cdr(pic, obj))));
|
||||
var = pic_car(pic, var);
|
||||
}
|
||||
else {
|
||||
if (pic_length(pic, obj) != 3) {
|
||||
pic_error(pic, "syntax_error");
|
||||
}
|
||||
val = pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)));
|
||||
}
|
||||
if (! pic_symbol_p(var)) {
|
||||
pic_error(pic, "syntax error");
|
||||
}
|
||||
|
||||
proc = pic_codegen(pic, val);
|
||||
if (pic->errmsg) {
|
||||
printf("macroexpand error: %s\n", pic->errmsg);
|
||||
abort();
|
||||
}
|
||||
v = pic_apply(pic, proc, pic_nil_value());
|
||||
if (pic->errmsg) {
|
||||
printf("macroexpand error: %s\n", pic->errmsg);
|
||||
abort();
|
||||
}
|
||||
assert(pic_proc_p(v));
|
||||
define_macro(pic, pic_symbol_name(pic, pic_sym(pic_car(pic, pic_cdr(pic, obj)))), pic_proc_ptr(v));
|
||||
define_macro(pic, pic_symbol_name(pic, pic_sym(var)), pic_proc_ptr(v));
|
||||
|
||||
return pic_false_value();
|
||||
}
|
||||
macro = lookup_macro(pic, env, pic_symbol_name(pic, sym));
|
||||
|
@ -72,12 +106,12 @@ expand(pic_state *pic, pic_value obj, struct syntactic_env *env)
|
|||
printf("macroexpand error: %s\n", pic->errmsg);
|
||||
abort();
|
||||
}
|
||||
return v;
|
||||
return expand(pic, v, env);
|
||||
}
|
||||
}
|
||||
|
||||
v = pic_cons(pic, pic_car(pic, obj), pic_nil_value());
|
||||
for (obj = pic_cdr(pic, obj); ! pic_nil_p(obj); obj = pic_cdr(pic, obj)) {
|
||||
v = pic_nil_value();
|
||||
for (; ! pic_nil_p(obj); obj = pic_cdr(pic, obj)) {
|
||||
v = pic_cons(pic, expand(pic, pic_car(pic, obj), env), v);
|
||||
}
|
||||
v = pic_reverse(pic, v);
|
||||
|
|
Loading…
Reference in New Issue