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

eval: disarm lambda.

Browse source
This commit is contained in:
Jan Nieuwenhuizen 2016-07-09 22:47:36 +02:00
parent de2e9502cf
commit f89507414e
3 changed files with 10 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
mes.c
View file

@ -329,6 +329,8 @@ eval_ (scm *e, scm *a)
#endif // MACROS #endif // MACROS
if (car (e) == &scm_symbol_quote) if (car (e) == &scm_symbol_quote)
return cadr (e); return cadr (e);
if (car (e) == &scm_lambda)
return e;
#if QUASIQUOTE #if QUASIQUOTE
else if (car (e) == &scm_symbol_unquote) else if (car (e) == &scm_symbol_unquote)
return eval (cadr (e), a); return eval (cadr (e), a);
@ -904,7 +906,7 @@ initial_environment ()
} }
scm * scm *
define_lambda (scm *x, scm *a) define_lambda (scm *x)
{ {
return cons (caadr (x), cons (&scm_lambda, cons (cdadr (x), cddr (x)))); return cons (caadr (x), cons (&scm_lambda, cons (cdadr (x), cddr (x))));
} }
@ -914,7 +916,7 @@ define (scm *x, scm *a)
{ {
if (atom_p (cadr (x)) != &scm_f) if (atom_p (cadr (x)) != &scm_f)
return cons (cadr (x), eval (caddr (x), a)); return cons (cadr (x), eval (caddr (x), a));
return define_lambda (x, a); return define_lambda (x);
} }
scm * scm *
@ -923,20 +925,20 @@ define_macro (scm *x, scm *a)
#if DEBUG #if DEBUG
printf ("\nc:define_macro a="); printf ("\nc:define_macro a=");
scm *aa =cons (&scm_macro, scm *aa =cons (&scm_macro,
cons (define_lambda (x, a), cons (define_lambda (x),
cdr (assoc (&scm_macro, a)))); cdr (assoc (&scm_macro, a))));
display (aa); display (aa);
puts (""); puts ("");
#endif #endif
return cons (&scm_macro, return cons (&scm_macro,
cons (define_lambda (x, a), cons (define_lambda (x),
cdr (assoc (&scm_macro, a)))); cdr (assoc (&scm_macro, a))));
} }
scm * scm *
loop (scm *r, scm *e, scm *a) loop (scm *r, scm *e, scm *a)
{ {
#if DEBUG #if 0//DEBUG
printf ("\nc:loop e="); printf ("\nc:loop e=");
display (e); display (e);
puts (""); puts ("");

1
mes.mes
View file

@ -126,6 +126,7 @@
((atom (car e)) ((atom (car e))
(cond (cond
((eq (car e) 'quote) (cadr e)) ((eq (car e) 'quote) (cadr e))
((eq (car e) 'lambda) e)
((eq (car e) 'unquote) (eval (cadr e) a)) ((eq (car e) 'unquote) (eval (cadr e) a))
((eq (car e) 'quasiquote) (eval-quasiquote (cadr e) a)) ((eq (car e) 'quasiquote) (eval-quasiquote (cadr e) a))
((eq (car e) 'cond) (evcon (cdr e) a)) ((eq (car e) 'cond) (evcon (cdr e) a))

4
test.mes
View file

@ -100,10 +100,10 @@
(newline) (newline)
(map display '(1 2 3 4)) (map display '(1 2 3 4))
(newline) (newline)
(map '(lambda (x) (display x) (newline)) '(5 6 7 8)) (map (lambda (x) (display x) (newline)) '(5 6 7 8))
(newline) (newline)
(map '(lambda (i a) (display i) (display ':) (display a) (newline)) '(1 2 3 4) '(a b c d)) (map (lambda (i a) (display i) (display ':) (display a) (newline)) '(1 2 3 4) '(a b c d))
(newline) (newline)
'() '()