fix for set! inside lambda.

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)
 {

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)))))
 

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))