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

support cond without match, define-macro x (lambda)).

Browse source
This commit is contained in:
Jan Nieuwenhuizen 2016-07-16 07:56:01 +02:00
parent 141012f5c0
commit cf0c3ef42e
2 changed files with 6 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
mes.c
View file

@ -373,6 +373,7 @@ evcon_ (scm *c, scm *a)
display (car (c)); display (car (c));
puts (""); puts ("");
#endif #endif
if (c == &scm_nil) return &scm_unspecified;
if (eval (caar (c), a) != &scm_f) { if (eval (caar (c), a) != &scm_f) {
#if DEBUG #if DEBUG
//if (fn != &scm_display && fn != &scm_call) //if (fn != &scm_display && fn != &scm_call)
@ -1152,6 +1153,10 @@ define_macro (scm *x, scm *a)
display (aa); display (aa);
puts (""); puts ("");
#endif #endif
if (atom_p (cadr (x)) != &scm_f)
return cons (&scm_macro,
cons (cons (cadr (x), eval (caddr (x), a)),
cdr (assq (&scm_macro, a))));
return cons (&scm_macro, return cons (&scm_macro,
cons (define_lambda (x), cons (define_lambda (x),
cdr (assq (&scm_macro, a)))); cdr (assq (&scm_macro, a))));

1
mes.mes
View file

@ -57,6 +57,7 @@
(define (evcon c a) (define (evcon c a)
;;(debug "evcon c=~a a=~a\n" c a) ;;(debug "evcon c=~a a=~a\n" c a)
(cond (cond
((null? c) *unspecified*)
;; single-statement cond ;; single-statement cond
;; ((eval (caar c) a) (eval (cadar c) a)) ;; ((eval (caar c) a) (eval (cadar c) a))
((eval (caar c) a) ((eval (caar c) a)