From 1da953b6ab01610980cdf97891ecb41ab53cd446 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Sun, 10 Jul 2016 13:45:54 +0200
Subject: [PATCH] fix for set! inside lambda.

---
 mes.c    | 38 +++++++++++---------------------------
 mes.mes  |  8 +-------
 test.mes | 13 +++++++++++++
 3 files changed, 25 insertions(+), 34 deletions(-)

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