diff options
| -rw-r--r-- | MLKDynamicContext.m | 26 | ||||
| -rw-r--r-- | MLKLexicalContext.m | 1 | ||||
| -rw-r--r-- | MLKPackage.h | 33 | ||||
| -rw-r--r-- | MLKPackage.m | 236 | ||||
| -rw-r--r-- | MLKSymbol.h | 2 | ||||
| -rw-r--r-- | MLKSymbol.m | 5 |
6 files changed, 243 insertions, 60 deletions
diff --git a/MLKDynamicContext.m b/MLKDynamicContext.m index 31f23b7..efc8da4 100644 --- a/MLKDynamicContext.m +++ b/MLKDynamicContext.m @@ -53,35 +53,15 @@ static MLKDynamicContext *global_context; +(void) initialize { NSMutableDictionary *vars = [NSMutableDictionary dictionaryWithCapacity:64]; - MLKPackage *cl = [MLKPackage packageWithName:@"COMMON-LISP" - nicknames:[NSSet setWithObject:@"CL"]]; - MLKPackage *clUser = [MLKPackage packageWithName:@"COMMON-LISP-USER" - nicknames:[NSSet setWithObject:@"CL-USER"]]; - MLKPackage *keyword = [MLKPackage packageWithName:@"KEYWORD" - nicknames:[NSSet set]]; - MLKPackage *sys = [MLKPackage packageWithName:@"TOILET-SYSTEM" - nicknames:[NSSet setWithObjects: - @"TL-SYS", nil]]; - MLKPackage *toilet = [MLKPackage packageWithName:@"TOILET-LISP" - nicknames:[NSSet setWithObjects: - @"TL", @"TOILET", nil]]; - MLKPackage *tlUser = [MLKPackage packageWithName:@"TOILET-LISP-USER" - nicknames:[NSSet setWithObjects: - @"TL-USER", - @"TOILET-USER", - nil]]; + MLKPackage *cl = [MLKPackage findPackage:@"COMMON-LISP"]; + MLKPackage *clUser = [MLKPackage findPackage:@"COMMON-LISP-USER"]; + MLKPackage *keyword = [MLKPackage findPackage:@"KEYWORD"]; MLKSymbol *t = [cl intern:@"T"]; MLKReadtable *readtable = [[MLKReadtable alloc] init]; unichar ch; id NIL = [NSNull null]; - [cl export:[cl intern:@"IF"]]; - - [sys intern:@"%DEFMACRO"]; - [tlUser usePackage:clUser]; - //[toilet import:nil]; - // Build the initial readtable. [readtable setSyntaxType:WHITESPACE forCharacter:'\t']; [readtable setConstituentTrait:INVALID forCharacter:'\t']; diff --git a/MLKLexicalContext.m b/MLKLexicalContext.m index d7511fb..eb0afed 100644 --- a/MLKLexicalContext.m +++ b/MLKLexicalContext.m @@ -59,7 +59,6 @@ static MLKSymbol *LEXICAL; @implementation MLKLexicalContext +(void) initialize { - /* MLKDynamicContext *dynamic_context = */ [MLKDynamicContext globalContext]; MLKLexicalEnvironment *globalenv = [MLKLexicalEnvironment globalEnvironment]; cl = [MLKPackage findPackage:@"COMMON-LISP"]; sys = [MLKPackage findPackage:@"TOILET-SYSTEM"]; diff --git a/MLKPackage.h b/MLKPackage.h index 5c5e5b6..f5c1ec5 100644 --- a/MLKPackage.h +++ b/MLKPackage.h @@ -18,15 +18,24 @@ #import "MLKLispValue.h" -@class MLKSymbol, NSMutableDictionary, NSMutableSet, NSSet, NSString; +#import <Foundation/NSArray.h> +#import <Foundation/NSDictionary.h> +#import <Foundation/NSSet.h> +#import <Foundation/NSString.h> + +@class MLKSymbol; @interface MLKPackage : MLKLispValue { - NSMutableDictionary *_symbols; + NSMutableDictionary *_accessible_symbols; + NSMutableSet *_present_symbols; + // NSMutableSet *_inherited_symbols; NSMutableSet *_exported_symbols; - NSMutableSet *_shadowed_symbols; + NSMutableSet *_shadowing_symbols; NSMutableSet *_nicknames; + NSMutableArray *_used_packages; + NSMutableArray *_using_packages; NSString *_name; } @@ -40,10 +49,14 @@ +(MLKPackage *) findPackage:(NSString *)name; --(void) usePackage:(MLKPackage *)aPackage; --(void) import:(MLKSymbol *)aSymbol; --(void) export:(MLKSymbol *)aSymbol; --(void) shadow:(MLKSymbol *)aSymbol; +-(void) usePackage:(MLKPackage *)package; +-(void) unusePackage:(MLKPackage *)package; +-(void) import:(MLKSymbol *)symbol; +-(void) inherit:(MLKSymbol *)symbol; +-(void) uninherit:(MLKSymbol *)symbol; +-(void) export:(MLKSymbol *)symbol; +-(void) unexport:(MLKSymbol *)symbol; +-(void) shadow:(NSString *)symbolName; -(void) unintern:(MLKSymbol *)aSymbol; -(MLKSymbol *) intern:(NSString*)symbolName; -(MLKSymbol *) findSymbol:(NSString*)symbolName; @@ -51,6 +64,10 @@ -(NSString *) name; -(NSSet *) nicknames; -(NSSet *) exportedSymbols; --(NSSet *) shadowedSymbols; +-(NSSet *) shadowingSymbols; -(NSSet *) allSymbols; +-(NSArray *) usedPackages; +-(NSArray *) usingPackages; + +-(void) dealloc; @end diff --git a/MLKPackage.m b/MLKPackage.m index b6c0b33..f243877 100644 --- a/MLKPackage.m +++ b/MLKPackage.m @@ -19,12 +19,11 @@ #import "MLKPackage.h" #import "MLKSymbol.h" #import "MLKError.h" +#import "NSObject-MLKPrinting.h" #import "runtime-compatibility.h" -#import <Foundation/NSDictionary.h> -#import <Foundation/NSSet.h> -#import <Foundation/NSString.h> -#import <Foundation/NSArray.h> +#import <Foundation/NSException.h> +#import <Foundation/NSNull.h> static NSMutableDictionary *packages = nil; @@ -34,6 +33,36 @@ static NSMutableDictionary *packages = nil; +(void) initialize { packages = [[NSMutableDictionary alloc] init]; + + MLKPackage *cl = [MLKPackage packageWithName:@"COMMON-LISP" + nicknames:[NSSet setWithObject:@"CL"]]; + MLKPackage *clUser = [MLKPackage packageWithName:@"COMMON-LISP-USER" + nicknames:[NSSet setWithObject:@"CL-USER"]];; + MLKPackage *sys = [MLKPackage packageWithName:@"TOILET-SYSTEM" + nicknames:[NSSet setWithObjects: + @"TL-SYS", nil]]; + MLKPackage *toilet = [MLKPackage packageWithName:@"TOILET-LISP" + nicknames:[NSSet setWithObjects: + @"TL", @"TOILET", nil]]; + MLKPackage *tlUser = [MLKPackage packageWithName:@"TOILET-LISP-USER" + nicknames:[NSSet setWithObjects: + @"TL-USER", + @"TOILET-USER", + nil]]; + + [MLKPackage packageWithName:@"KEYWORD" nicknames:[NSSet set]]; + + [tlUser usePackage:toilet]; + [tlUser usePackage:cl]; + [clUser usePackage:cl]; + + [cl import:nil]; + [cl export:nil]; + [cl export:[cl intern:@"T"]]; + + [sys intern:@"%DEFMACRO"]; + [tlUser usePackage:clUser]; + [cl export:[cl intern:@"IF"]]; } -(MLKPackage *) initWithName:(NSString *)name @@ -52,10 +81,13 @@ static NSMutableDictionary *packages = nil; [packages setObject:self forKey:[e objectAtIndex:i]]; } - _symbols = [[NSMutableDictionary alloc] init]; + _present_symbols = [[NSMutableSet alloc] init]; + _accessible_symbols = [[NSMutableDictionary alloc] init]; _exported_symbols = [[NSMutableSet alloc] init]; - _shadowed_symbols = [[NSMutableSet alloc] init]; + _shadowing_symbols = [[NSMutableSet alloc] init]; _nicknames = [[NSMutableSet alloc] initWithSet:nicknames]; + _used_packages = [[NSMutableArray alloc] init]; + _using_packages = [[NSMutableArray alloc] init]; ASSIGN (_name, name); return self; @@ -72,60 +104,185 @@ static NSMutableDictionary *packages = nil; return [packages objectForKey:name]; } --(void) usePackage:(MLKPackage *)aPackage +-(void) usePackage:(MLKPackage *)package { int i; NSArray *symbols; - symbols = [[aPackage allSymbols] allObjects]; + symbols = [[package exportedSymbols] allObjects]; for (i = 0; i < [symbols count]; i++) - [self import:[symbols objectAtIndex:i]]; + { + [self inherit:[symbols objectAtIndex:i]]; + } + + [_used_packages addObject:package]; + [package->_using_packages addObject:self]; } --(void) import:(MLKSymbol *)aSymbol +-(void) unusePackage:(MLKPackage *)package { - // FIXME: Check for conflicts. + int i; + NSArray *symbols; + + symbols = [[package exportedSymbols] allObjects]; + + for (i = 0; i < [symbols count]; i++) + { + [self uninherit:[symbols objectAtIndex:i]]; + } + + [_used_packages removeObject:package]; + [package->_using_packages removeObject:self]; +} + +-(void) import:(MLKSymbol *)symbol +{ + id old_symbol; + NSString *name; + + name = symbol ? [symbol name] : (NSString *)@"NIL"; + symbol = symbol ? (id)symbol : (id)[NSNull null]; + + if ((old_symbol = [_accessible_symbols objectForKey:name])) + { + if (old_symbol != symbol) + [NSException + raise:@"MLKSymbolConflictError" + format:@"Imported symbol %@ conflicts with accessible symbol %@.", + [symbol descriptionForLisp], + [old_symbol descriptionForLisp]]; + } - // FIXME: What to do about exported and shadowed symbols that conflict - // with the new one? - [_symbols setObject:aSymbol forKey:[aSymbol name]]; + [_accessible_symbols setObject:symbol forKey:name]; + [_present_symbols addObject:symbol]; } --(void) export:(MLKSymbol *)aSymbol +-(void) inherit:(MLKSymbol *)symbol { - [_exported_symbols addObject:aSymbol]; + id old_symbol; + NSString *name; + + name = symbol ? [symbol name] : (NSString *)@"NIL"; + symbol = symbol ? (id)symbol : (id)[NSNull null]; + + if ((old_symbol = [_accessible_symbols objectForKey:name]) + && old_symbol != symbol + && ![_shadowing_symbols containsObject:old_symbol]) + [NSException + raise:@"MLKSymbolConflictError" + format:@"Inherited symbol %@ conflicts with accessible symbol %@.", + [symbol descriptionForLisp], + [old_symbol descriptionForLisp]]; + + [_accessible_symbols setObject:symbol forKey:name]; } --(void) shadow:(MLKSymbol *)aSymbol +-(void) uninherit:(MLKSymbol *)symbol { - [_shadowed_symbols addObject:aSymbol]; + NSString *name; + + name = symbol ? [symbol name] : (NSString *)@"NIL"; + symbol = symbol ? (id)symbol : (id)[NSNull null]; + + if (![_present_symbols containsObject:symbol]) + [_accessible_symbols removeObjectForKey:name]; +} + +-(void) export:(MLKSymbol *)symbol +{ + int i; + NSString *name; + + name = symbol ? [symbol name] : (NSString *)@"NIL"; + symbol = symbol ? (id)symbol : (id)[NSNull null]; + + for (i = 0; i < [_using_packages count]; i++) + { + MLKPackage *package = [_using_packages objectAtIndex:i]; + id old_symbol = [package->_accessible_symbols objectForKey:name]; + + if (old_symbol + && (old_symbol != symbol) + && ![_shadowing_symbols containsObject:old_symbol]) + [NSException + raise:@"MLKSymbolConflictError" + format:@"Inherited symbol %@ conflicts with accessible symbol %@ in package %@.", + [symbol descriptionForLisp], + [old_symbol descriptionForLisp], + [package descriptionForLisp]]; + } + + for (i = 0; i < [_using_packages count]; i++) + { + [[_using_packages objectAtIndex:i] + inherit:(symbol == (id)[NSNull null] ? nil : (id)symbol)]; + } + + [_exported_symbols addObject:symbol]; +} + +-(void) unexport:(MLKSymbol *)symbol +{ + int i; + + symbol = symbol ? (id)symbol : (id)[NSNull null]; + + [_exported_symbols removeObject:symbol]; + + for (i = 0; i < [_using_packages count]; i++) + { + [[_using_packages objectAtIndex:i] uninherit:symbol]; + } +} + +-(void) shadow:(NSString *)symbolName +{ + MLKSymbol *symbol; + + symbol = [_accessible_symbols objectForKey:symbolName]; + if (!symbol) + { + symbol = [MLKSymbol symbolWithName:symbolName package:self]; + } + [_shadowing_symbols addObject:symbol]; } -(void) unintern:(MLKSymbol *)aSymbol { - [_symbols removeObjectForKey:[aSymbol name]]; + // FIXME: Check for conflicts. + if ([_present_symbols containsObject:aSymbol]) + { + [_present_symbols removeObject:aSymbol]; + [_accessible_symbols removeObjectForKey:[aSymbol name]]; + [_shadowing_symbols removeObject:aSymbol]; + } } -(MLKSymbol *) intern:(NSString *)symbolName { - if ([[_symbols allKeys] containsObject:symbolName]) - return [_symbols objectForKey:symbolName]; + MLKSymbol *symbol; + if ((symbol = [_accessible_symbols objectForKey:symbolName])) + return (symbol == (id)[NSNull null] ? nil : (id)symbol); else { MLKSymbol *symbol = [[MLKSymbol alloc] initWithName:symbolName package:self]; - [_symbols setObject:symbol forKey:symbolName]; + [self import:symbol]; return symbol; } } -(MLKSymbol *) findSymbol:(NSString *)symbolName { - if ([[_symbols allKeys] containsObject:symbolName]) - return [_symbols objectForKey:symbolName]; + MLKSymbol *symbol; + if ((symbol = [_accessible_symbols objectForKey:symbolName])) + return (symbol == (id)[NSNull null] ? nil : (id)symbol); else - [[MLKError errorWithMessage:@"Symbol not found."] raise]; + [NSException raise:@"MLKNoSuchSymbolError" + format:@"The package %@ does not contain a symbol named %@.", + self, + symbolName]; return nil; } @@ -145,13 +302,36 @@ static NSMutableDictionary *packages = nil; return _exported_symbols; } --(NSSet *) shadowedSymbols +-(NSSet *) shadowingSymbols { - return _shadowed_symbols; + return _shadowing_symbols; } -(NSSet *) allSymbols { - return [NSSet setWithArray:[_symbols allValues]]; + return [NSSet setWithArray:[_accessible_symbols allValues]]; +} + +-(NSArray *) usedPackages +{ + return _used_packages; +} + +-(NSArray *) usingPackages +{ + return _using_packages; +} + +-(void) dealloc +{ + RELEASE (_present_symbols); + RELEASE (_accessible_symbols); + RELEASE (_exported_symbols); + RELEASE (_shadowing_symbols); + RELEASE (_nicknames); + RELEASE (_used_packages); + RELEASE (_using_packages); + RELEASE (_name); + [super dealloc]; } @end diff --git a/MLKSymbol.h b/MLKSymbol.h index 80d18b4..4f294ff 100644 --- a/MLKSymbol.h +++ b/MLKSymbol.h @@ -32,6 +32,8 @@ -(MLKSymbol *) initWithName:(id)aName package:(id)aPackage; ++(MLKSymbol *) symbolWithName:(id)aName package:(id)aPackage; + -(NSString *) name; -(MLKPackage *) homePackage; -(void) setHomePackage:(MLKPackage *)aPackage; diff --git a/MLKSymbol.m b/MLKSymbol.m index 8b385eb..48892f8 100644 --- a/MLKSymbol.m +++ b/MLKSymbol.m @@ -32,6 +32,11 @@ return self; } ++(MLKSymbol *) symbolWithName:(id)aName package:(id)aPackage +{ + return AUTORELEASE ([[self alloc] initWithName:aName package:aPackage]); +} + -(id) copyWithZone:(NSZone *)zone { MLKSymbol *copy = [MLKSymbol allocWithZone:zone]; |