diff options
| author | Matthias Andreas Benkard <matthias@benkard.de> | 2008-07-28 01:18:23 +0200 |
|---|---|---|
| committer | Matthias Andreas Benkard <matthias@benkard.de> | 2008-07-28 01:18:23 +0200 |
| commit | 9186189b62240acdae1f3bd6d4146cec00cddda3 (patch) | |
| tree | 6a0c1845634cc5b254fa7977931713fd02132f76 | |
| parent | 92cb7b11a4db45597d321b4b0b80507d4dbf252a (diff) | |
Add PRIMITIVE-TYPE-OF.
| -rw-r--r-- | MLKPackage.m | 1 | ||||
| -rw-r--r-- | MLKRoot.m | 39 |
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*"]]; @@ -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 |