artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

support define-macro inside eval (i.e., inside define-macro)

Browse source
This commit is contained in:
Jan Nieuwenhuizen 2016-07-16 23:35:07 +02:00
parent d1a089caed
commit be12facd6d
3 changed files with 61 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
GNUmakefile
View file

@ -47,3 +47,6 @@ run: all
syntax: all syntax: all
cat scm.mes syntax.mes | ./mes cat scm.mes syntax.mes | ./mes
macro: all
cat macro.mes | ./mes

38
macro.mes Normal file
View file

@ -0,0 +1,38 @@
;; (define (run x)
;; (define (test? y) (display "testing:") (display y) (newline) (eq? x y))
;; (test? 3)
;; )
;; (display "(run 3):")
;; (display (run 3))
;; (newline)
;; (display "(run 4):")
;; (display (run 4))
;; (newline)
(define (fm a)
(define-macro (a b)
(display b)
(newline)))
(display "f-define-macro...")
(fm 'dinges)
(a c)
(newline)
(define-macro (m a)
`(define-macro (,a) ;;;(,a b) b: todo
(display "b") ;; (display b) ;; todo
(newline)))
(display "define-macro...")
(m dinges)
(display "running dinges...")
(dinges)
(newline)
(newline)
3

27
mes.c
View file

@ -346,8 +346,20 @@ eval_ (scm *e, scm *a)
else if (car (e) == &scm_symbol_cond) else if (car (e) == &scm_symbol_cond)
return evcon (cdr (e), a); return evcon (cdr (e), a);
#if MACROS #if MACROS
else if ((macro = assq (car (e), cdr (assq (&scm_macro, a)))) != &scm_f) else if (eq_p (car (e), &scm_symbol_define_macro) == &scm_t)
return define_macro (e, a);
else if ((macro = assq (car (e), cdr (assq (&scm_macro, a)))) != &scm_f) {
#if DEBUG
printf ("GOTTA MACRO! name=");
display (car (e));
printf (" body=");
display (cdr (macro));
printf (" args=");
display (cdr (e));
puts ("");
#endif
return eval (apply_env_ (cdr (macro), cdr (e), a), a); return eval (apply_env_ (cdr (macro), cdr (e), a), a);
}
#endif // MACROS #endif // MACROS
return apply_env (car (e), evlis (cdr (e), a), a); return apply_env (car (e), evlis (cdr (e), a), a);
} }
@ -1178,13 +1190,14 @@ define_macro (scm *x, scm *a)
display (aa); display (aa);
puts (""); puts ("");
#endif #endif
scm *macros = assq (&scm_macro, a);
scm *macro;
if (atom_p (cadr (x)) != &scm_f) if (atom_p (cadr (x)) != &scm_f)
return cons (&scm_macro, macro = cons (cadr (x), eval (caddr (x), a));
cons (cons (cadr (x), eval (caddr (x), a)), else
cdr (assq (&scm_macro, a)))); macro = cons (caadr(x), make_lambda (cdadr (x), cddr (x)));
return cons (&scm_macro, set_cdr_x (macros, cons (macro, cdr (macros)));
cons (cons (caadr(x), make_lambda (cdadr (x), cddr (x))), return a;
cdr (assq (&scm_macro, a))));
} }
scm * scm *