Reimplement the package system.

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];