summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Andreas Benkard <matthias@benkard.de>2008-07-28 01:18:23 +0200
committerMatthias Andreas Benkard <matthias@benkard.de>2008-07-28 01:18:23 +0200
commit9186189b62240acdae1f3bd6d4146cec00cddda3 (patch)
tree6a0c1845634cc5b254fa7977931713fd02132f76
parent92cb7b11a4db45597d321b4b0b80507d4dbf252a (diff)
Add PRIMITIVE-TYPE-OF.
-rw-r--r--MLKPackage.m1
-rw-r--r--MLKRoot.m39
2 files changed, 40 insertions, 0 deletions
diff --git a/MLKPackage.m b/MLKPackage.m
index 93dece3..c57dd7d 100644
--- a/MLKPackage.m
+++ b/MLKPackage.m
@@ -124,6 +124,7 @@ static NSMutableDictionary *packages = nil;
[sys export:[sys intern:@"FIND-OBJC-CLASS"]];
[sys export:[sys intern:@"NS-LOG"]];
[sys export:[sys intern:@"SYMBOL-NAME"]];
+ [sys export:[sys intern:@"PRIMITIVE-TYPE-OF"]];
[cl export:[cl intern:@"*BREAK-ON-SIGNALS*"]];
[cl export:[cl intern:@"*COMPILE-FILE-PATHNAME*"]];
diff --git a/MLKRoot.m b/MLKRoot.m
index 07cfe5f..3ad0f01 100644
--- a/MLKRoot.m
+++ b/MLKRoot.m
@@ -17,8 +17,10 @@
*/
#import "MLKBinding.h"
+#import "MLKCharacter.h"
#import "MLKCons.h"
#import "MLKDynamicContext.h"
+#import "MLKInterpretedClosure.h"
#import "MLKInterpreter.h"
#import "MLKNumber.h"
#import "MLKPackage.h"
@@ -452,4 +454,41 @@ static id truify (BOOL value)
MLKSymbol *symbol = denullify ([args objectAtIndex:0]);
RETURN_VALUE (symbol ? (id)[symbol name] : (id)@"NIL");
}
+
++(NSArray *) primitive_type_of:(NSArray *)args
+{
+ id object = denullify ([args objectAtIndex:0]);
+
+ if (!object)
+ { RETURN_VALUE ([cl intern:@"NULL"]); }
+ else if ([object isKindOfClass:[MLKSymbol class]])
+ { RETURN_VALUE ([cl intern:@"SYMBOL"]); }
+ else if ([object isKindOfClass:[MLKCons class]])
+ { RETURN_VALUE ([cl intern:@"CONS"]); }
+ else if ([object isKindOfClass:[MLKDoubleFloat class]])
+ { RETURN_VALUE ([cl intern:@"DOUBLE-FLOAT"]); }
+ else if ([object isKindOfClass:[MLKSingleFloat class]])
+ { RETURN_VALUE ([cl intern:@"SINGLE-FLOAT"]); }
+ else if ([object isKindOfClass:[MLKInteger class]])
+ { RETURN_VALUE ([cl intern:@"INTEGER"]); }
+ else if ([object isKindOfClass:[MLKCharacter class]])
+ //FIXME: STANDARD-CHAR
+ { RETURN_VALUE ([cl intern:@"BASE-CHAR"]); }
+ else if ([object isKindOfClass:[MLKInterpretedClosure class]])
+ { RETURN_VALUE ([cl intern:@"FUNCTION"]); }
+ else if ([object isKindOfClass:[MLKLexicalContext class]])
+ { RETURN_VALUE ([sys intern:@"LEXICAL-CONTEXT"]); }
+ else if ([object isKindOfClass:[MLKBinding class]])
+ { RETURN_VALUE ([sys intern:@"BINDING"]); }
+ else if ([object isKindOfClass:[MLKPackage class]])
+ { RETURN_VALUE ([cl intern:@"PACKAGE"]); }
+ else if ([object isKindOfClass:[MLKStream class]])
+ { RETURN_VALUE ([cl intern:@"STREAM"]); }
+ else if ([object isKindOfClass:[NSException class]])
+ { RETURN_VALUE ([sys intern:@"EXCEPTION"]); }
+ else if ([object isKindOfClass:[NSArray class]])
+ { RETURN_VALUE ([cl intern:@"ARRAY"]); }
+ else
+ { RETURN_VALUE ([cl intern:@"T"]); }
+}
@end