Create environments upon binding when needed.

6 files changed, 107 insertions, 30 deletions

diff --git a/GNUmakefile b/GNUmakefile
index 997c23b..f781996 100644
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -17,6 +17,8 @@
 
 include $(GNUSTEP_MAKEFILES)/common.make
 
+default: ToiletKit toilet
+
 #all:: ToiletKit etshell Test
 
 TOOL_NAME = etshell toilet
@@ -65,13 +67,15 @@ include $(GNUSTEP_MAKEFILES)/tool.make
 
 before-all:: before-etshell before-toilet
 
-before-toilet::
+before-toilet:: ToiletKit
 	rm -f obj/toilet
 
-before-etshell::
+before-etshell:: ToiletKit
 	rm -f obj/etshell
 	mkdir -p $(GNUSTEP_OBJ_DIR)/StepTalkShell
 
+before-Test:: ToiletKit
+
 #after-clean::
 #	-rmdir $(GNUSTEP_OBJ_DIR)/StepTalkShell
 
diff --git a/MLKDynamicContext.m b/MLKDynamicContext.m
index 7b102e6..d4e1ab6 100644
--- a/MLKDynamicContext.m
+++ b/MLKDynamicContext.m
@@ -373,11 +373,25 @@ static MLKDynamicContext *global_context;
 
 -(void) addValue:(id)value forSymbol:(MLKSymbol *)symbol
 {
+  if (_parent && _environment == _parent->_environment)
+    _environment = [[MLKEnvironment alloc] initWithParent:_parent->_environment
+                                           values:nil];
+  else if (!_environment)
+    _environment = [[MLKEnvironment alloc] initWithParent:nil
+                                           values:nil];
+
   [[self environment] addValue:value forSymbol:symbol];
 }
 
 -(void) addBindingForSymbol:(MLKSymbol *)symbol
 {
+  if (_parent && _environment == _parent->_environment)
+    _environment = [[MLKEnvironment alloc] initWithParent:_parent->_environment
+                                           values:nil];
+  else if (!_environment)
+    _environment = [[MLKEnvironment alloc] initWithParent:nil
+                                           values:nil];
+
   [[self environment] addBindingForSymbol:symbol];
 }
 
diff --git a/MLKInterpreter.m b/MLKInterpreter.m
index e276982..2f9aba3 100644
--- a/MLKInterpreter.m
+++ b/MLKInterpreter.m
@@ -121,12 +121,16 @@ static MLKSymbol *_LAMBDA;
         }
       else if ([context variableIsLexical:program])
         {
-          //NSLog (@"Processing lexical variable.");
+          //NSLog (@"Processing lexical variable %@.", [program descriptionForLisp]);
+          //NSLog (@"Lexical environment: %@.", lexenv);
+          //NSLog (@"Lexical variable value: %@.", [lexenv valueForSymbol:program]);
           return [NSArray arrayWithObject:nullify([lexenv valueForSymbol:program])];
         }
       else
         {
-          //NSLog (@"Processing special variable.");
+          //NSLog (@"Processing special variable %@.", [program descriptionForLisp]);
+          //NSLog (@"Dynamic context: %@.", dynamicContext);
+          //NSLog (@"Special variable value: %@.", [dynamicContext valueForSymbol:program]);
           return [NSArray arrayWithObject:nullify([dynamicContext valueForSymbol:program])];
         }
     }
@@ -271,9 +275,9 @@ static MLKSymbol *_LAMBDA;
                                           objectAtIndex:0]);
                     }
 
+                  [ctx addVariable:variable];
                   if ([ctx variableIsLexical:variable])
                     {
-                      [ctx addVariable:variable];
                       [env addValue:value forSymbol:variable];
                     }
                   else
@@ -289,8 +293,8 @@ static MLKSymbol *_LAMBDA;
               NS_DURING
                 {
                   result = [self eval:[MLKCons cons:PROGN with:body]
-                                 inLexicalContext:context
-                                 withEnvironment:lexenv];
+                                 inLexicalContext:ctx
+                                 withEnvironment:env];
                 }
               NS_HANDLER
                 {
diff --git a/MLKLexicalContext.m b/MLKLexicalContext.m
index f41b05c..545c3c1 100644
--- a/MLKLexicalContext.m
+++ b/MLKLexicalContext.m
@@ -138,6 +138,13 @@ static MLKSymbol *LEXICAL;
 
 -(void) addMacro:(id <MLKFuncallable>)value forSymbol:(MLKSymbol *)symbol
 {
+  if (_parent && _macros == _parent->_macros)
+    _macros = [[MLKEnvironment alloc] initWithParent:_parent->_macros
+                                      values:nil];
+  else if (!_macros)
+    _macros = [[MLKEnvironment alloc] initWithParent:nil
+                                      values:nil];
+
   [_knownMacros addObject:symbol];
   [_macros addValue:value forSymbol:symbol];
 }
@@ -154,6 +161,13 @@ static MLKSymbol *LEXICAL;
 
 -(void) addCompilerMacro:(id <MLKFuncallable>)value forSymbol:(MLKSymbol *)symbol
 {
+  if (_parent && _compilerMacros == _parent->_compilerMacros)
+    _compilerMacros = [[MLKEnvironment alloc] initWithParent:_parent->_compilerMacros
+                                              values:nil];
+  else if (!_compilerMacros)
+    _compilerMacros = [[MLKEnvironment alloc] initWithParent:nil
+                                              values:nil];
+
   [_knownCompilerMacros addObject:symbol];
   [_compilerMacros addValue:value forSymbol:symbol];
 }
@@ -170,6 +184,13 @@ static MLKSymbol *LEXICAL;
 
 -(void) addSymbolMacro:(id <MLKFuncallable>)value forSymbol:(MLKSymbol *)symbol
 {
+  if (_parent && _symbolMacros == _parent->_symbolMacros)
+    _symbolMacros = [[MLKEnvironment alloc] initWithParent:_parent->_symbolMacros
+                                            values:nil];
+  else if (!_symbolMacros)
+    _symbolMacros = [[MLKEnvironment alloc] initWithParent:nil
+                                            values:nil];
+
   [_knownSymbolMacros addObject:symbol];
   [_symbolMacros addValue:value forSymbol:symbol];
 }
@@ -221,36 +242,48 @@ static MLKSymbol *LEXICAL;
 {
   id rest;
 
-  rest = _declarations;
-  while (rest)
+  symbol = symbol ? (id)symbol : (id)[NSNull null];
+
+  if ([_variables containsObject:symbol])
     {
-      id item = [rest car];
-      if ([item isKindOfClass:[MLKCons class]] && [[item cdr] car] == symbol)
+      // The variable was introduced in this lexical context.
+      rest = _declarations;
+      while (rest)
         {
-          if ([item car] == LEXICAL)
-            return YES;
-          else if ([item car] == SPECIAL)
-            return NO;
+          id item = [rest car];
+          if ([item isKindOfClass:[MLKCons class]] && [[item cdr] car] == symbol)
+            {
+              if ([item car] == LEXICAL)
+                return YES;
+              else if ([item car] == SPECIAL)
+                return NO;
+            }
+          rest = [rest cdr];
         }
-      rest = [rest cdr];
-    }
 
-  // Has the variable been globally proclaimed special?
-  rest = [MLKLexicalContext globalContext]->_declarations;
-  while (rest)
-    {
-      id item = [rest car];
-      if ([[item cdr] car] == symbol)
+      // Has the variable been globally proclaimed special?
+      rest = [MLKLexicalContext globalContext]->_declarations;
+      while (rest)
         {
-          if ([item car] == LEXICAL)
-            return YES;
-          else if ([item car] == SPECIAL)
-            return NO;
+          id item = [rest car];
+          if ([[item cdr] car] == symbol)
+            {
+              if ([item car] == LEXICAL)
+                return YES;
+              else if ([item car] == SPECIAL)
+                return NO;
+            }
+          rest = [rest cdr];
         }
-      rest = [rest cdr];
-    }
 
-  return YES;
+      // The variable is apparently neither locally nor pervasively
+      // special.
+      return YES;
+    }
+  // We don't know anything about a variable of the given name.  Ask the
+  // parent environment.  If there is no parent, nobody seems to know
+  // anything about the variable, so we assume it's a special one.
+  else return (_parent && [_parent variableIsLexical:symbol]);
 }
 
 -(void) addVariable:(MLKSymbol *)symbol
diff --git a/MLKLexicalEnvironment.m b/MLKLexicalEnvironment.m
index 1f7d920..78a3b93 100644
--- a/MLKLexicalEnvironment.m
+++ b/MLKLexicalEnvironment.m
@@ -115,11 +115,25 @@ static MLKLexicalEnvironment *global_environment;
 
 -(void) addValue:(id)value forSymbol:(MLKSymbol *)symbol
 {
+  if (_parent && _variables == _parent->_variables)
+    _variables = [[MLKEnvironment alloc] initWithParent:_parent->_variables
+                                         values:nil];
+  else if (!_variables)
+    _variables = [[MLKEnvironment alloc] initWithParent:nil
+                                         values:nil];
+
   [_variables addValue:value forSymbol:symbol];
 }
 
 -(void) addBindingForSymbol:(MLKSymbol *)symbol
 {
+  if (_parent && _variables == _parent->_variables)
+    _variables = [[MLKEnvironment alloc] initWithParent:_parent->_variables
+                                         values:nil];
+  else if (!_variables)
+    _variables = [[MLKEnvironment alloc] initWithParent:nil
+                                         values:nil];
+
   [_variables addBindingForSymbol:symbol];
 }
 
@@ -145,6 +159,13 @@ static MLKLexicalEnvironment *global_environment;
 
 -(void) addFunction:(id)value forSymbol:(MLKSymbol *)symbol
 {
+  if (_parent && _functions == _parent->_functions)
+    _functions = [[MLKEnvironment alloc] initWithParent:_parent->_functions
+                                         values:nil];
+  else if (!_functions)
+    _functions = [[MLKEnvironment alloc] initWithParent:nil
+                                         values:nil];
+
   [_functions addValue:value forSymbol:symbol];
 }
 
diff --git a/MLKPackage.m b/MLKPackage.m
index 117ff94..f45cd75 100644
--- a/MLKPackage.m
+++ b/MLKPackage.m
@@ -73,6 +73,7 @@ static NSMutableDictionary *packages = nil;
   [cl export:[cl intern:@"QUOTE"]];
   [cl export:[cl intern:@"VALUES"]];
   [cl export:[cl intern:@"EVAL"]];
+  [cl export:[cl intern:@"SPECIAL"]];
 
   [sys export:[sys intern:@"%DEFMACRO"]];
   [sys export:[sys intern:@"%LAMBDA"]];