diff --git a/mes.c b/mes.c index 58b0f425..777a55f9 100644 --- a/mes.c +++ b/mes.c @@ -191,9 +191,6 @@ quasiquote (scm *x) { return cons (&scm_symbol_quasiquote, x); } - -scm *eval_quasiquote (scm *, scm *); - #endif //Library functions @@ -210,8 +207,6 @@ scm *cadar (scm *x) {return car (cdr (car (x)));} scm *cddar (scm *x) {return cdr (cdr (car (x)));} scm *cdddr (scm *x) {return cdr (cdr (cdr (x)));} -scm* make_atom (char const *); - scm * pairlis (scm *x, scm *y, scm *a) { @@ -244,21 +239,12 @@ assoc (scm *x, scm *a) return assoc (x, cdr (a)); } -scm *apply (scm*, scm*, scm*); -scm *eval_ (scm*, scm*); -scm *apply_ (scm*, scm*, scm*); - scm * eval_quote (scm *fn, scm *x) { return apply (fn, x, &scm_nil); } -scm *builtin_p (scm*); -scm *call (scm *, scm*); -scm *display (scm*); -scm *newline (); - scm * apply_ (scm *fn, scm *x, scm *a) { @@ -277,22 +263,22 @@ apply_ (scm *fn, scm *x, scm *a) return call (fn, x); return apply (eval (fn, a), x, a); } - else if (car (fn) == &scm_lambda) { - scm *body = cddr (fn); - scm *ca = cadr (fn); - scm *ax = pairlis (cadr (fn), x, a); - scm *result = eval (car (body), ax); - if (cdr (body) == &scm_nil) - return result; - return apply (cons (car (fn), cons (cadr (fn), cdddr (fn))), x, ax); - } + else if (car (fn) == &scm_lambda) + return begin_env (cddr (fn), pairlis (cadr (fn), x, a)); else if (car (fn) == &scm_label) return apply (caddr (fn), x, cons (cons (cadr (fn), caddr (fn)), a)); return &scm_unspecified; } -scm *evcon (scm*, scm*); -scm *evlis (scm*, scm*); +scm * +begin_env (scm *body, scm *a) +{ + if (body == &scm_nil) return &scm_unspecified; + scm *result = eval (car (body), a); + if (cdr (body) == &scm_nil) + return result; + return begin_env (cdr (body), a); +} scm * eval_ (scm *e, scm *a) @@ -638,8 +624,6 @@ readblock (int c) return readblock (getchar ()); } -scm *readlis (scm *a); - scm * readword (int c, char* w, scm *a) { diff --git a/mes.mes b/mes.mes index fff0484c..a59afa3d 100644 --- a/mes.mes +++ b/mes.mes @@ -98,13 +98,7 @@ (call fn x)) (#t (apply (eval fn a) x a)))) ((eq? (car fn) 'lambda) - (cond ((null? (cdr (cddr fn))) - (eval (caddr fn) (pairlis (cadr fn) x a))) - (#t - (eval (caddr fn) (pairlis (cadr fn) x a)) - (apply (cons (car fn) (cons (cadr fn) (cdddr fn))) - x - (pairlis (cadr fn) x a))))) + (begin-env (cddr fn) (pairlis (cadr fn) x a))) ((eq? (car fn) 'label) (apply (caddr fn) x (cons (cons (cadr fn) (caddr fn)) a))))) diff --git a/test.mes b/test.mes index 96a0fe23..bf9dfacb 100644 --- a/test.mes +++ b/test.mes @@ -115,6 +115,19 @@ (display a) (newline) +(display + ((lambda (x) + (display 'x:) + (display x) + (newline) + (display 'setting-x=2) + (newline) + (set! x 2) + (display 'x:) + (display x) + (newline)) + 1)) + (display (+ 11 12)) (newline) (display (* 3 3))