From 2283b43f733d95fe1c95fd0b7b838a1d450b007a Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Tue, 24 Jun 2008 16:16:11 +0200 Subject: Make the environment handling system aware of bindings as first-class values. --- GNUmakefile | 1 - MLKDynamicContext.m | 8 +-- MLKEnvironment.h | 14 ++--- MLKEnvironment.m | 128 ++++++++++++++++++++-------------------- MLKLexicalContext.h | 12 ++-- MLKLexicalContext.m | 46 ++++++--------- MLKLexicalEnvironment.m | 2 +- MLKUndefinedVariableException.h | 34 ----------- MLKUndefinedVariableException.m | 39 ------------ 9 files changed, 101 insertions(+), 183 deletions(-) delete mode 100644 MLKUndefinedVariableException.h delete mode 100644 MLKUndefinedVariableException.m diff --git a/GNUmakefile b/GNUmakefile index 31b6576..f88f6c2 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -36,7 +36,6 @@ ToiletKit_OBJC_FILES = MLKCharacter.m MLKCons.m MLKBinding.m \ MLKSingleFloat.m MLKStream.m \ MLKStringInputStream.m MLKSymbol.m \ MLKThrowException.m \ - MLKUndefinedVariableException.m \ NSObject-MLKPrinting.m NSString-MLKPrinting.m ToiletKit_LDFLAGS = -lgmp #LIBRARIES_DEPEND_UPON diff --git a/MLKDynamicContext.m b/MLKDynamicContext.m index 630b505..31f23b7 100644 --- a/MLKDynamicContext.m +++ b/MLKDynamicContext.m @@ -42,7 +42,7 @@ initWithParent:(parent \ ? (id) parent_member \ : nil) \ - bindings:variable] \ + values:variable] \ : (id) (parent ? (id) RETAIN (parent_member) : nil)); @@ -330,7 +330,7 @@ static MLKDynamicContext *global_context; } NS_HANDLER { - if ([[localException name] isEqualToString: @"MLKUndefinedVariableException"]) + if ([[localException name] isEqualToString: @"MLKUnboundVariableError"]) NS_VALUERETURN (nil, id); else [localException raise]; @@ -351,7 +351,7 @@ static MLKDynamicContext *global_context; } NS_HANDLER { - if ([[localException name] isEqualToString: @"MLKUndefinedVariableException"]) + if ([[localException name] isEqualToString: @"MLKUnboundVariableError"]) NS_VALUERETURN (nil, id); else [localException raise]; @@ -369,7 +369,7 @@ static MLKDynamicContext *global_context; } NS_HANDLER { - if ([[localException name] isEqualToString: @"MLKUndefinedVariableException"]) + if ([[localException name] isEqualToString: @"MLKUnboundVariableError"]) NS_VALUERETURN (nil, id); else [localException raise]; diff --git a/MLKEnvironment.h b/MLKEnvironment.h index ef357f6..0789b1a 100644 --- a/MLKEnvironment.h +++ b/MLKEnvironment.h @@ -17,6 +17,7 @@ */ #import "MLKLispValue.h" +#import "MLKBinding.h" @class NSMutableDictionary, MLKSymbol, NSSet; @@ -27,28 +28,25 @@ NSMutableDictionary *_bindings; } -+(void) initialize; - -(MLKEnvironment *) init; -(MLKEnvironment *) initWithParent:(MLKEnvironment *)parent; --(MLKEnvironment *) initWithBindings:(NSDictionary *)bindings; --(MLKEnvironment *) initWithParent:(MLKEnvironment *)parent bindings:(NSDictionary *)bindings; +-(MLKEnvironment *) initWithValues:(NSDictionary *)bindings; +-(MLKEnvironment *) initWithParent:(MLKEnvironment *)parent + values:(NSDictionary *)bindings; -(MLKEnvironment *) parent; -(NSSet *) bindings; -(void) addBindingForSymbol:(MLKSymbol *)symbol; -(void) addBindings:(NSDictionary *)bindings; +-(void) addValues:(NSDictionary *)bindings; -(void) addValue:(id)value forSymbol:(MLKSymbol *)symbol; -(void) setValue:(id)value forSymbol:(MLKSymbol *)symbol; +-(MLKBinding *) bindingForSymbol:(MLKSymbol *)symbol; -(id) valueForSymbol:(MLKSymbol *)symbol; -(MLKEnvironment *) environmentForSymbol:(MLKSymbol *)symbol; -// Private methods. --(void) setBinding:(MLKSymbol *)symbol to:(id)value inEnvironment:(MLKEnvironment *)env; --(id) valueForSymbol:(MLKSymbol *)symbol inEnvironment:(MLKEnvironment *)env; - -(BOOL) boundp:(MLKSymbol *)symbol; -(void) makunbound:(MLKSymbol *)symbol; diff --git a/MLKEnvironment.m b/MLKEnvironment.m index 73ea749..29f7740 100644 --- a/MLKEnvironment.m +++ b/MLKEnvironment.m @@ -18,45 +18,39 @@ #import #import +#import #import #import #import "MLKEnvironment.h" -#import "MLKUndefinedVariableException.h" +#import "NSObject-MLKPrinting.h" #import "runtime-compatibility.h" -static id UNBOUND; - - @implementation MLKEnvironment -+(void) initialize -{ - UNBOUND = [[NSObject alloc] init]; -} - -(MLKEnvironment *) init { - return [self initWithParent:nil bindings:nil]; + return [self initWithParent:nil values:nil]; } --(MLKEnvironment *) initWithParent:(MLKEnvironment *)parent bindings:(NSDictionary *)bindings +-(MLKEnvironment *) initWithParent:(MLKEnvironment *)parent + values:(NSDictionary *)bindings { self = [super init]; _bindings = [[NSMutableDictionary alloc] initWithCapacity:10]; ASSIGN (_parent, parent); - [self addBindings: bindings]; + [self addValues:bindings]; return self; } -(MLKEnvironment *) initWithParent:(MLKEnvironment *)parent { - return [self initWithParent:parent bindings:nil]; + return [self initWithParent:parent values:nil]; } --(MLKEnvironment *) initWithBindings:(NSDictionary *)bindings +-(MLKEnvironment *) initWithValues:(NSDictionary *)bindings { - return [self initWithParent:nil bindings:bindings]; + return [self initWithParent:nil values:bindings]; } -(MLKEnvironment *) parent @@ -74,54 +68,41 @@ static id UNBOUND; -(void) setValue:(id)value forSymbol:(MLKSymbol *)symbol; { - [self setBinding:(symbol ? (id)symbol : (id)[NSNull null]) - to:value - inEnvironment:self]; -} + MLKBinding *binding; --(void) setBinding:(MLKSymbol *)symbol to:(id)value inEnvironment:(MLKEnvironment *)env -{ - value = value ? value : (id) [NSNull null]; - if ([_bindings objectForKey:symbol]) - [_bindings setObject:value forKey:symbol]; - else - if (_parent) - [_parent setBinding:symbol to:value inEnvironment:env]; - else - [[[MLKUndefinedVariableException alloc] initWithEnvironment:env - variableName:symbol] - raise]; + if (!(binding = [self bindingForSymbol:symbol])) + [NSException raise:@"MLKUnboundVariableError" + format:@"The variable %@ is unbound.", + [symbol descriptionForLisp]]; + + [binding setValue:value]; } -(id) valueForSymbol:(MLKSymbol *)symbol { - return [self valueForSymbol:(symbol ? (id)symbol : (id)[NSNull null]) - inEnvironment:self]; + MLKBinding *binding; + + if (!(binding = [self bindingForSymbol:symbol])) + [NSException raise:@"MLKUnboundVariableError" + format:@"The variable %@ is unbound.", + [symbol descriptionForLisp]]; + + return [binding value]; } --(id) valueForSymbol:(MLKSymbol *)symbol inEnvironment:(MLKEnvironment *)env +-(MLKBinding*) bindingForSymbol:(MLKSymbol *)symbol { - id value; - if ((value = [_bindings objectForKey:symbol])) - { - if (value == [NSNull null]) - return nil; - else if (value == UNBOUND) - [[[MLKUndefinedVariableException alloc] initWithEnvironment:env - variableName:symbol] - raise]; - else - return value; - } + MLKBinding *binding; + + symbol = symbol ? (id)symbol : (id)[NSNull null]; + + if ((binding = [_bindings objectForKey:symbol])) + return binding; else if (_parent) - return [_parent valueForSymbol:symbol]; + return [_parent bindingForSymbol:symbol]; else - [[[MLKUndefinedVariableException alloc] initWithEnvironment:env - variableName:symbol] - raise]; - - return nil; // avoid a stupid compiler warning + return nil; } -(void) addBindings:(NSDictionary *)bindings @@ -129,15 +110,35 @@ static id UNBOUND; [_bindings addEntriesFromDictionary:bindings]; } +-(void) addValues:(NSDictionary *)bindings +{ + int i; + NSArray *keys; + + keys = [bindings allKeys]; + for (i = 0; i < [keys count]; i++) + { + id key = [keys objectAtIndex:i]; + id value = [bindings objectForKey:key]; + + value = (value == [NSNull null]) ? nil : value; + + [_bindings setObject:[MLKBinding bindingWithValue:value] + forKey:key]; + } +} + -(void) addValue:(id)value forSymbol:(MLKSymbol *)symbol; { - value = value ? value : (id) [NSNull null]; - [_bindings setObject:value forKey:symbol]; + symbol = symbol ? (id)symbol : (id)[NSNull null]; + [_bindings setObject:[MLKBinding bindingWithValue:value] + forKey:symbol]; } -(void) addBindingForSymbol:(MLKSymbol *)symbol { - [_bindings setObject:UNBOUND forKey:(symbol ? (id)symbol : (id)[NSNull null])]; + [_bindings setObject:[MLKBinding binding] + forKey:(symbol ? (id)symbol : (id)[NSNull null])]; } -(MLKEnvironment *) environmentForSymbol:(MLKSymbol *)symbol @@ -152,21 +153,20 @@ static id UNBOUND; -(BOOL) boundp:(MLKSymbol *)symbol { - id value; - if ((value = [_bindings objectForKey:symbol])) - return (value != UNBOUND); - else if (_parent) - return [_parent boundp:symbol]; + MLKBinding *binding; + + if ((binding = [self bindingForSymbol:symbol])) + return [binding boundp]; else return NO; } -(void) makunbound:(MLKSymbol *)symbol { - if ([_bindings objectForKey:symbol]) - [_bindings setObject:UNBOUND forKey:symbol]; - else if (_parent) - return [_parent makunbound:symbol]; + MLKBinding *binding; + + if ((binding = [self bindingForSymbol:symbol])) + [binding makunbound]; } -(void) dealloc diff --git a/MLKLexicalContext.h b/MLKLexicalContext.h index 5eca3d6..2bf2bc4 100644 --- a/MLKLexicalContext.h +++ b/MLKLexicalContext.h @@ -18,6 +18,8 @@ #import "MLKLispValue.h" +#import + @class MLKEnvironment, MLKLexicalEnvironment, MLKSymbol, NSLinkedList, NSSet, NSMutableDictionary, NSString, MLKCons, MLKFuncallable; @@ -29,8 +31,8 @@ MLKEnvironment *_macros; MLKEnvironment *_symbolMacros; MLKEnvironment *_goTags; - NSMutableDictionary *_functionLocations; - NSMutableDictionary *_variableLocations; + NSMutableSet *_functions; + NSMutableSet *_variables; id _declarations; MLKLexicalContext *_parent; } @@ -58,10 +60,10 @@ -(void) setSymbolMacro:(MLKFuncallable *)function forSymbol:(MLKSymbol *)symbol; -(id) goTagForSymbol:(MLKSymbol *)symbol; --(id) variableLocationForSymbol:(MLKSymbol *)symbol; --(MLKLexicalEnvironment *) instantiateWithVariables:(NSDictionary *)variables - functions:(NSDictionary *)functions; +// FIXME? +//-(MLKLexicalEnvironment *) instantiateWithVariables:(NSDictionary *)variables +// functions:(NSDictionary *)functions; -(void) addVariable:(MLKSymbol *)symbol; -(void) addFunction:(MLKSymbol *)symbol; diff --git a/MLKLexicalContext.m b/MLKLexicalContext.m index 5b664f4..d7511fb 100644 --- a/MLKLexicalContext.m +++ b/MLKLexicalContext.m @@ -43,7 +43,7 @@ initWithParent:(parent \ ? (id) parent_member \ : nil) \ - bindings:variable] \ + values:variable] \ : (id) (parent ? (id) RETAIN (parent_member) : nil)); @@ -59,7 +59,7 @@ static MLKSymbol *LEXICAL; @implementation MLKLexicalContext +(void) initialize { - MLKDynamicContext *dynamic_context = [MLKDynamicContext globalContext]; + /* MLKDynamicContext *dynamic_context = */ [MLKDynamicContext globalContext]; MLKLexicalEnvironment *globalenv = [MLKLexicalEnvironment globalEnvironment]; cl = [MLKPackage findPackage:@"COMMON-LISP"]; sys = [MLKPackage findPackage:@"TOILET-SYSTEM"]; @@ -84,26 +84,12 @@ static MLKSymbol *LEXICAL; symbolMacros:(NSDictionary *)symbolMacros declarations:(id)declarations { - int i; - NSArray *e; - self = [super init]; ASSIGN (_parent, (aContext ? aContext : [MLKLexicalContext globalContext])); - ASSIGN (_variableLocations, [NSMutableDictionary dictionary]); - e = [vars allObjects]; - for (i = 0; i < [e count]; i++) - { - [self addVariable:[e objectAtIndex:i]]; - } - - ASSIGN (_functionLocations, [NSMutableDictionary dictionary]); - e = [functions allObjects]; - for (i = 0; i < [e count]; i++) - { - [self addFunction:[e objectAtIndex:i]]; - } + ASSIGN (_variables, [NSMutableSet setWithSet:vars]); + ASSIGN (_functions, [NSMutableSet setWithSet:functions]); _goTags = MAKE_ENVIRONMENT (goTags, _parent, _parent->_goTags); _macros = MAKE_ENVIRONMENT (macros, _parent, _parent->_macros); @@ -148,9 +134,10 @@ static MLKSymbol *LEXICAL; -(BOOL) symbolNamesFunction:(MLKSymbol *)symbol { - if ([_functionLocations objectForKey:(symbol ? (id)symbol : (id)[NSNull null])]) + symbol = symbol ? (id)symbol : (id)[NSNull null]; + if ([_functions containsObject:symbol]) return YES; - else if ([_knownMacros containsObject:(symbol ? (id)symbol : (id)[NSNull null])]) + else if ([_knownMacros containsObject:symbol]) return NO; else return (_parent && [_parent symbolNamesFunction:symbol]); @@ -158,9 +145,10 @@ static MLKSymbol *LEXICAL; -(BOOL) symbolNamesMacro:(MLKSymbol *)symbol { - if ([_functionLocations objectForKey:(symbol ? (id)symbol : (id)[NSNull null])]) + symbol = symbol ? (id)symbol : (id)[NSNull null]; + if ([_functions containsObject:symbol]) return NO; - else if ([_knownMacros containsObject:(symbol ? (id)symbol : (id)[NSNull null])]) + else if ([_knownMacros containsObject:symbol]) return YES; else return (_parent && [_parent symbolNamesMacro:symbol]); @@ -168,9 +156,10 @@ static MLKSymbol *LEXICAL; -(BOOL) symbolNamesSymbolMacro:(MLKSymbol *)symbol { - if ([_variableLocations objectForKey:(symbol ? (id)symbol : (id)[NSNull null])]) + symbol = symbol ? (id)symbol : (id)[NSNull null]; + if ([_variables containsObject:symbol]) return NO; - else if ([_knownSymbolMacros containsObject:(symbol ? (id)symbol : (id)[NSNull null])]) + else if ([_knownSymbolMacros containsObject:symbol]) return YES; else return (_parent && [_parent symbolNamesSymbolMacro:symbol]); @@ -214,12 +203,14 @@ static MLKSymbol *LEXICAL; -(void) addVariable:(MLKSymbol *)symbol { - [_variableLocations setObject:[NSNull null] forKey:symbol]; + symbol = symbol ? (id)symbol : (id)[NSNull null]; + [_variables addObject:symbol]; } -(void) addFunction:(MLKSymbol *)symbol { - [_functionLocations setObject:[NSNull null] forKey:symbol]; + symbol = symbol ? (id)symbol : (id)[NSNull null]; + [_functions addObject:symbol]; } -(void) dealloc @@ -229,7 +220,8 @@ static MLKSymbol *LEXICAL; RELEASE (_knownSymbolMacros); RELEASE (_symbolMacros); RELEASE (_goTags); - RELEASE (_functionLocations); + RELEASE (_functions); + RELEASE (_variables); RELEASE (_declarations); RELEASE (_parent); [super dealloc]; diff --git a/MLKLexicalEnvironment.m b/MLKLexicalEnvironment.m index 62ff1d7..66d5cb2 100644 --- a/MLKLexicalEnvironment.m +++ b/MLKLexicalEnvironment.m @@ -42,7 +42,7 @@ initWithParent:(parent \ ? (id) parent_member \ : nil) \ - bindings:variable] \ + values:variable] \ : (id) (parent ? (id) RETAIN (parent_member) : nil)); diff --git a/MLKUndefinedVariableException.h b/MLKUndefinedVariableException.h deleted file mode 100644 index 1fe7e86..0000000 --- a/MLKUndefinedVariableException.h +++ /dev/null @@ -1,34 +0,0 @@ -/* -*- mode: objc; coding: utf-8 -*- */ -/* Étoilisp/Mulklisp, a Common Lisp subset for the Étoilé runtime. - * Copyright (C) 2008 Matthias Andreas Benkard. - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation, either version 3 of the License, or (at - * your option) any later version. - * - * This program is distributed in the hope that it will be useful, but - * WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - * General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program. If not, see . - */ - -#import - -@class MLKSymbol, MLKEnvironment; - - -@interface MLKUndefinedVariableException : NSException -{ - MLKSymbol *variableName; - MLKEnvironment *environment; -} - --(MLKUndefinedVariableException *) initWithEnvironment:(id)environment - variableName:(id)symbol; - --(void) dealloc; -@end diff --git a/MLKUndefinedVariableException.m b/MLKUndefinedVariableException.m deleted file mode 100644 index 6e43262..0000000 --- a/MLKUndefinedVariableException.m +++ /dev/null @@ -1,39 +0,0 @@ -/* -*- mode: objc; coding: utf-8 -*- */ -/* Étoilisp/Mulklisp, a Common Lisp subset for the Étoilé runtime. - * Copyright (C) 2008 Matthias Andreas Benkard. - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation, either version 3 of the License, or (at - * your option) any later version. - * - * This program is distributed in the hope that it will be useful, but - * WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - * General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program. If not, see . - */ - -#import "MLKUndefinedVariableException.h" -#import "runtime-compatibility.h" - - -@implementation MLKUndefinedVariableException --(MLKUndefinedVariableException *) initWithEnvironment:(id)anEnvironment - variableName:(id)aSymbol -{ - self = [super init]; - variableName = aSymbol; - environment = anEnvironment; - return self; -} - --(void) dealloc -{ - RELEASE (variableName); - RELEASE (environment); - [super dealloc]; -} -@end -- cgit v1.2.3