summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Andreas Benkard <matthias@benkard.de>2008-06-22 22:12:31 +0200
committerMatthias Andreas Benkard <matthias@benkard.de>2008-06-22 22:12:31 +0200
commitbbd50fa93b66cfee268c3c7f038d855b953c7eb1 (patch)
tree89a5147f2df02a4809171d72f233f533bafb7234
parent29b9ca1a3a9d1f6291af51ab2f6150039b2d5619 (diff)
Improve error reporting in the reader.
-rw-r--r--MLKDynamicContext.m2
-rw-r--r--MLKLowLevelTests.m10
-rw-r--r--MLKPackage.h1
-rw-r--r--MLKPackage.m5
-rw-r--r--MLKReader.m7
-rw-r--r--MLKSymbol.h1
-rw-r--r--MLKSymbol.m9
7 files changed, 30 insertions, 5 deletions
diff --git a/MLKDynamicContext.m b/MLKDynamicContext.m
index b76d92b..71b5e0e 100644
--- a/MLKDynamicContext.m
+++ b/MLKDynamicContext.m
@@ -76,6 +76,8 @@ static MLKDynamicContext *global_context;
id NIL = [NSNull null];
+ [cl export:[cl intern:@"IF"]];
+
[sys intern:@"%DEFMACRO"];
[tlUser usePackage:clUser];
//[toilet import:nil];
diff --git a/MLKLowLevelTests.m b/MLKLowLevelTests.m
index 34d0296..498369c 100644
--- a/MLKLowLevelTests.m
+++ b/MLKLowLevelTests.m
@@ -171,9 +171,17 @@
UKStringsEqual ([[MLKReader readFromString:@"|Class Name|"] name], @"Class Name");
UKStringsEqual ([[MLKReader readFromString:@"class\\ name"] name], @"CLASS NAME");
UKStringsEqual ([[MLKReader readFromString:@"\\100"] name], @"100");
-
+
UKStringsEqual ([[MLKReader readFromString:@"a b c d e"] name], @"A");
+ UKObjectKindOf ([MLKReader readFromString:@"cl::if"], MLKSymbol);
+ UKObjectKindOf ([MLKReader readFromString:@"cl:if"], MLKSymbol);
+ UKObjectKindOf ([MLKReader readFromString:@"cl-user::mulk"], MLKSymbol);
+ UKObjectsSame ([MLKReader readFromString:@"common-lisp-user::a"],
+ [MLKReader readFromString:@"cl-user::a"]);
+ UKObjectsSame ([MLKReader readFromString:@"a"],
+ [MLKReader readFromString:@"cl-user::a"]);
+
return nil;
}
diff --git a/MLKPackage.h b/MLKPackage.h
index 35f8f32..5c5e5b6 100644
--- a/MLKPackage.h
+++ b/MLKPackage.h
@@ -42,6 +42,7 @@
-(void) usePackage:(MLKPackage *)aPackage;
-(void) import:(MLKSymbol *)aSymbol;
+-(void) export:(MLKSymbol *)aSymbol;
-(void) shadow:(MLKSymbol *)aSymbol;
-(void) unintern:(MLKSymbol *)aSymbol;
-(MLKSymbol *) intern:(NSString*)symbolName;
diff --git a/MLKPackage.m b/MLKPackage.m
index e6d6175..b6c0b33 100644
--- a/MLKPackage.m
+++ b/MLKPackage.m
@@ -92,6 +92,11 @@ static NSMutableDictionary *packages = nil;
[_symbols setObject:aSymbol forKey:[aSymbol name]];
}
+-(void) export:(MLKSymbol *)aSymbol
+{
+ [_exported_symbols addObject:aSymbol];
+}
+
-(void) shadow:(MLKSymbol *)aSymbol
{
[_shadowed_symbols addObject:aSymbol];
diff --git a/MLKReader.m b/MLKReader.m
index 1edc651..edf682f 100644
--- a/MLKReader.m
+++ b/MLKReader.m
@@ -456,8 +456,11 @@
// A single package marker means we have to check whether
// the symbol is external in the package.
symbolName = [token substringFromIndex:(packageMarker+1)];
- if (![[package exportedSymbols] containsObject:[package intern:token]])
- [[[MLKReaderError alloc] init] raise];
+ symbol = [package intern:symbolName];
+ if (![[package exportedSymbols] containsObject:symbol])
+ [NSException raise:@"MLKReaderError"
+ format:@"Package %@ does not export symbol %@.",
+ package, symbol];
}
}
diff --git a/MLKSymbol.h b/MLKSymbol.h
index 3cc9859..80d18b4 100644
--- a/MLKSymbol.h
+++ b/MLKSymbol.h
@@ -36,6 +36,7 @@
-(MLKPackage *) homePackage;
-(void) setHomePackage:(MLKPackage *)aPackage;
+-(NSString *)description;
-(NSString *)descriptionForLisp;
// PLEASE DO NOT USE THIS.
diff --git a/MLKSymbol.m b/MLKSymbol.m
index 534debf..8b385eb 100644
--- a/MLKSymbol.m
+++ b/MLKSymbol.m
@@ -59,12 +59,17 @@
ASSIGN (homePackage, aPackage);
}
--(NSString *)descriptionForLisp
+-(NSString *) descriptionForLisp
{
// NOTE: Need to take *PRINT-GENSYM* into account.
//
// FIXME: This is wrong in more than one way.
- return [NSString stringWithFormat:@"|%@|", name];
+ return [NSString stringWithFormat:@"|%@::%@|", [homePackage name], name];
+}
+
+-(NSString *) description
+{
+ return [NSString stringWithFormat:@"|%@::%@|", [homePackage name], name];
}
-(BOOL) isEqual:(id)object