summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Andreas Benkard <matthias@benkard.de>2008-07-08 15:43:06 +0200
committerMatthias Andreas Benkard <matthias@benkard.de>2008-07-08 15:43:06 +0200
commit0654d8d1017b202c5aa250c77626c54bf571a354 (patch)
treef1522576c8577de45d15482f788ebfccbdc195a9
parent13715775d26700ba8d0b3ccb2e29be7c2a60e869 (diff)
Implement IMPORT, INTERN, and MAKE-SYMBOL.
-rw-r--r--MLKPackage.m3
-rw-r--r--MLKRoot.m35
2 files changed, 38 insertions, 0 deletions
diff --git a/MLKPackage.m b/MLKPackage.m
index 85da3c1..00d6344 100644
--- a/MLKPackage.m
+++ b/MLKPackage.m
@@ -112,6 +112,9 @@ static NSMutableDictionary *packages = nil;
[sys export:[sys intern:@"FIND-PACKAGE"]];
[sys export:[sys intern:@"STRING"]];
[sys export:[sys intern:@"GENSYM"]];
+ [sys export:[sys intern:@"MAKE-SYMBOL"]];
+ [sys export:[sys intern:@"IMPORT"]];
+ [sys export:[sys intern:@"INTERN"]];
[cl export:[cl intern:@"*BREAK-ON-SIGNALS*"]];
[cl export:[cl intern:@"*COMPILE-FILE-PATHNAME*"]];
diff --git a/MLKRoot.m b/MLKRoot.m
index 645e92f..880b4e5 100644
--- a/MLKRoot.m
+++ b/MLKRoot.m
@@ -372,4 +372,39 @@ static id truify (BOOL value)
package:nil]));
}
++(NSArray *) make_symbol:(NSArray *)args
+{
+ NSString *name = [args objectAtIndex:0];
+
+ RETURN_VALUE ([MLKSymbol symbolWithName:name package:nil]);
+}
+
++(NSArray *) intern:(NSArray *)args
+{
+ NSString *name = [args objectAtIndex:0];
+ id package = denullify (([args count] > 1
+ ? [args objectAtIndex:1]
+ : [[MLKDynamicContext currentContext]
+ valueForSymbol:
+ [[MLKPackage findPackage:@"COMMON-LISP"]
+ intern:@"*PACKAGE*"]]));
+ MLKSymbol *symbol = [package intern:name];
+
+ return [NSArray arrayWithObjects:symbol, nil];
+}
+
++(NSArray *) import:(NSArray *)args
+{
+ MLKSymbol *symbol = [args objectAtIndex:0];
+ id package = denullify (([args count] > 1
+ ? [args objectAtIndex:1]
+ : [[MLKDynamicContext currentContext]
+ valueForSymbol:
+ [[MLKPackage findPackage:@"COMMON-LISP"]
+ intern:@"*PACKAGE*"]]));
+
+ [package import:symbol];
+
+ RETURN_VALUE ([cl intern:@"T"]);
+}
@end