From 64988d63eb7ff9f324395a03fc6a927b2639bb5e Mon Sep 17 00:00:00 2001
From: Matthias Andreas Benkard <matthias@benkard.de>
Date: Thu, 31 Jul 2008 16:00:47 +0200
Subject: Minimal compiler: In a LET, do not forget to macroexpand the variable
 clauses.

---
 MLKInterpreter.m | 111 ++++++++++++++++++++++++++++++++-----------------------
 1 file changed, 64 insertions(+), 47 deletions(-)

(limited to 'MLKInterpreter.m')

diff --git a/MLKInterpreter.m b/MLKInterpreter.m
index 5e11637..343246c 100644
--- a/MLKInterpreter.m
+++ b/MLKInterpreter.m
@@ -606,6 +606,7 @@ static MLKSymbol *_LOOP;
               id clauses;
               id body;
               NSArray *result;
+              NSMutableArray *new_clauses;
               MLKLexicalContext *ctx;
               MLKLexicalEnvironment *env;
               MLKDynamicContext *dynctx;
@@ -622,29 +623,6 @@ static MLKSymbol *_LOOP;
                   declarations = nil;
                 }
 
-              if (expandOnly)
-                {
-                  id body_expansion = denullify([[self eval:[MLKCons cons:PROGN
-                                                                     with:body]
-                                                       inLexicalContext:context
-                                                       withEnvironment:lexenv
-                                                       expandOnly:expandOnly]
-                                                  objectAtIndex:0]);
-                  RETURN_VALUE ([MLKCons
-                                  cons:LET
-                                  with:[MLKCons
-                                         cons:[[program cdr] car]
-                                         with:[MLKCons
-                                                cons:declarations
-                                                with:[MLKCons cons:body_expansion
-                                                              with:nil]]]]);
-                }
-
-              env = AUTORELEASE ([[MLKLexicalEnvironment alloc]
-                                   initWithParent:lexenv
-                                   variables:nil
-                                   functions:nil]);
-
               ctx = AUTORELEASE ([[MLKLexicalContext alloc]
                                    initWithParent:context
                                    variables:nil
@@ -655,15 +633,24 @@ static MLKSymbol *_LOOP;
                                    symbolMacros:nil
                                    declarations:declarations]);
 
-              dynctx = [[MLKDynamicContext alloc]
-                         initWithParent:dynamicContext
-                         variables:nil
-                         handlers:nil
-                         restarts:nil
-                         catchTags:nil
-                         activeHandlerEnvironment:nil];
+              if (!expandOnly)
+                {
+                  env = AUTORELEASE ([[MLKLexicalEnvironment alloc]
+                                       initWithParent:lexenv
+                                       variables:nil
+                                       functions:nil]);
+
+                  dynctx = [[MLKDynamicContext alloc]
+                             initWithParent:dynamicContext
+                             variables:nil
+                             handlers:nil
+                             restarts:nil
+                             catchTags:nil
+                             activeHandlerEnvironment:nil];
+                }
 
               clauses = [[program cdr] car];
+              new_clauses = [NSMutableArray array];
               while (clauses)
                 {
                   id clause = [clauses car];
@@ -684,42 +671,72 @@ static MLKSymbol *_LOOP;
                       variable = [clause car];
                       value = denullify([[self eval:[[clause cdr] car]
                                                inLexicalContext:context
-                                               withEnvironment:lexenv]
+                                               withEnvironment:lexenv
+                                               expandOnly:expandOnly]
                                           objectAtIndex:0]);
                     }
 
-                  [ctx addVariable:variable];
-                  if ([ctx variableIsLexical:variable])
+                  if (expandOnly)
                     {
-                      [env addValue:value forSymbol:variable];
+                      [new_clauses addObject:[MLKCons cons:variable
+                                                      with:[MLKCons cons:value
+                                                                    with:nil]]];
                     }
                   else
                     {
-                      [dynctx addValue:value forSymbol:variable];
+                      [ctx addVariable:variable];
+                      if ([ctx variableIsLexical:variable])
+                        {
+                          [env addValue:value forSymbol:variable];
+                        }
+                      else
+                        {
+                          [dynctx addValue:value forSymbol:variable];
+                        }
                     }
 
                   clauses = [clauses cdr];
                 }
 
-              [dynctx pushContext];
-
-              NS_DURING
+              if (expandOnly)
                 {
                   result = [self eval:[MLKCons cons:PROGN with:body]
                                  inLexicalContext:ctx
-                                 withEnvironment:env];
+                                 withEnvironment:env
+                                 expandOnly:YES];
+
+                  RETURN_VALUE ([MLKCons
+                                  cons:LET
+                                  with:[MLKCons
+                                         cons:[MLKCons listWithArray:new_clauses]
+                                         with:[MLKCons
+                                                cons:[MLKCons cons:DECLARE
+                                                              with:declarations]
+                                                with:[[result objectAtIndex:0] cdr]]]]);
                 }
-              NS_HANDLER
+              else
                 {
-                  [MLKDynamicContext popContext];
-                  [localException raise];
-                }
-              NS_ENDHANDLER;
+                  [dynctx pushContext];
 
-              [MLKDynamicContext popContext];
-              RELEASE (dynctx);
+                  NS_DURING
+                    {
+                      result = [self eval:[MLKCons cons:PROGN with:body]
+                                     inLexicalContext:ctx
+                                     withEnvironment:env
+                                     expandOnly:NO];
+                    }
+                  NS_HANDLER
+                    {
+                      [MLKDynamicContext popContext];
+                      [localException raise];
+                    }
+                  NS_ENDHANDLER;
+
+                  [MLKDynamicContext popContext];
+                  RELEASE (dynctx);
 
-              return result;
+                  return result;
+                }
             }
           else if (car == _LOOP)
             {
-- 
cgit v1.2.3