From eb968f738101d87b2d0e170d757ea10a27bbb867 Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Mon, 30 Jun 2008 21:04:34 +0200 Subject: Create environments upon binding when needed. --- GNUmakefile | 8 +++-- MLKDynamicContext.m | 14 +++++++++ MLKInterpreter.m | 14 +++++---- MLKLexicalContext.m | 79 +++++++++++++++++++++++++++++++++++-------------- MLKLexicalEnvironment.m | 21 +++++++++++++ MLKPackage.m | 1 + 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 )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 )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 )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"]]; -- cgit v1.2.3