summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--MLKPackage.m6
-rw-r--r--MLKRoot.m78
2 files changed, 83 insertions, 1 deletions
diff --git a/MLKPackage.m b/MLKPackage.m
index 1e445b3..eace2a7 100644
--- a/MLKPackage.m
+++ b/MLKPackage.m
@@ -39,7 +39,8 @@ static NSMutableDictionary *packages = nil;
nicknames:[NSSet setWithObject:@"CL-USER"]];;
MLKPackage *sys = [MLKPackage packageWithName:@"TOILET-SYSTEM"
nicknames:[NSSet setWithObjects:
- @"TL-SYS", nil]];
+ @"TL-SYS", @"SYSTEM",
+ @"SYS", nil]];
MLKPackage *toilet = [MLKPackage packageWithName:@"TOILET-LISP"
nicknames:[NSSet setWithObjects:
@"TL", @"TOILET", nil]];
@@ -100,6 +101,9 @@ static NSMutableDictionary *packages = nil;
[sys export:[sys intern:@"DIVIDE"]];
[sys export:[sys intern:@"LIST"]];
[sys export:[sys intern:@"MACROEXPAND-1"]];
+ [sys export:[sys intern:@"EXPORT"]];
+ [sys export:[sys intern:@"SHADOW"]];
+ [sys export:[sys intern:@"UNEXPORT"]];
[cl export:[cl intern:@"*BREAK-ON-SIGNALS*"]];
[cl export:[cl intern:@"*COMPILE-FILE-PATHNAME*"]];
diff --git a/MLKRoot.m b/MLKRoot.m
index a9e15d3..7ef7339 100644
--- a/MLKRoot.m
+++ b/MLKRoot.m
@@ -17,6 +17,7 @@
*/
#import "MLKCons.h"
+#import "MLKDynamicContext.h"
#import "MLKInterpreter.h"
#import "MLKPackage.h"
#import "MLKRoot.h"
@@ -47,6 +48,17 @@ static id truify (BOOL value)
return (value ? (id) [cl intern:@"T"] : nil);
}
+static id stringify (id thing)
+{
+ // FIXME.
+ if (!thing)
+ return @"NIL";
+ if ([thing isKindOfClass:[NSString class]])
+ return thing;
+ else if ([thing isKindOfClass:[MLKSymbol class]])
+ return [thing name];
+}
+
#define RETURN_VALUE(thing) \
return [NSArray arrayWithObject:nullify(thing)];
@@ -227,4 +239,70 @@ static id truify (BOOL value)
RETURN_VALUE (form);
}
+
++(NSArray *) shadow:(NSArray *)args
+{
+ id symbols = denullify ([args objectAtIndex:0]);
+ id package = denullify (([args count] > 1
+ ? [args objectAtIndex:1]
+ : [[MLKDynamicContext currentContext]
+ valueForSymbol:
+ [[MLKPackage findPackage:@"COMMON-LISP"]
+ intern:@"*PACKAGE*"]]));
+
+ if (![symbols isKindOfClass:[MLKCons class]])
+ symbols = [MLKCons cons:symbols with:nil];
+
+ do
+ {
+ [package shadow:stringify([symbols car])];
+ }
+ while ((symbols = [symbols cdr]));
+
+ RETURN_VALUE ([cl intern:@"T"]);
+}
+
++(NSArray *) export:(NSArray *)args
+{
+ id symbols = denullify ([args objectAtIndex:0]);
+ id package = denullify (([args count] > 1
+ ? [args objectAtIndex:1]
+ : [[MLKDynamicContext currentContext]
+ valueForSymbol:
+ [[MLKPackage findPackage:@"COMMON-LISP"]
+ intern:@"*PACKAGE*"]]));
+
+ if (![symbols isKindOfClass:[MLKCons class]])
+ symbols = [MLKCons cons:symbols with:nil];
+
+ do
+ {
+ [package export:[symbols car]];
+ }
+ while ((symbols = [symbols cdr]));
+
+ RETURN_VALUE ([cl intern:@"T"]);
+}
+
++(NSArray *) unexport:(NSArray *)args
+{
+ id symbols = denullify ([args objectAtIndex:0]);
+ id package = denullify (([args count] > 1
+ ? [args objectAtIndex:1]
+ : [[MLKDynamicContext currentContext]
+ valueForSymbol:
+ [[MLKPackage findPackage:@"COMMON-LISP"]
+ intern:@"*PACKAGE*"]]));
+
+ if (![symbols isKindOfClass:[MLKCons class]])
+ symbols = [MLKCons cons:symbols with:nil];
+
+ do
+ {
+ [package unexport:[symbols car]];
+ }
+ while ((symbols = [symbols cdr]));
+
+ RETURN_VALUE ([cl intern:@"T"]);
+}
@end