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 /MLKRoot.m | |
parent | 92cb7b11a4db45597d321b4b0b80507d4dbf252a (diff) |
Add PRIMITIVE-TYPE-OF.
Diffstat (limited to 'MLKRoot.m')
-rw-r--r-- | MLKRoot.m | 39 |
1 files changed, 39 insertions, 0 deletions
@@ -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 |