diff options
| -rw-r--r-- | MLKInteger.h | 8 | ||||
| -rw-r--r-- | MLKInteger.m | 39 | ||||
| -rw-r--r-- | MLKInterpreter.m | 11 | ||||
| -rw-r--r-- | MLKPackage.m | 6 | ||||
| -rw-r--r-- | MLKReader.m | 34 | ||||
| -rw-r--r-- | MLKRoot.m | 48 | ||||
| -rw-r--r-- | functions.h | 12 | ||||
| -rw-r--r-- | functions.m | 65 | ||||
| -rw-r--r-- | types.lisp | 19 | ||||
| -rw-r--r-- | util.h | 8 | ||||
| -rw-r--r-- | util.lisp | 2 |
11 files changed, 213 insertions, 39 deletions
diff --git a/MLKInteger.h b/MLKInteger.h index 25eea87..ce6d38a 100644 --- a/MLKInteger.h +++ b/MLKInteger.h @@ -19,6 +19,7 @@ #import "MLKNumber.h" #include <stdarg.h> +#include <stdint.h> #include <stdio.h> #include <gmp.h> @@ -35,12 +36,19 @@ negative:(BOOL)negative base:(unsigned int)base; -(MLKInteger *) initWithInt:(int)intValue; +-(MLKInteger *) initWithIntptr_t:(intptr_t)intptr_t_value; +-(MLKInteger *) initWithFixnum:(id)fixnum; +(MLKInteger *) integerWithMPZ:(mpz_t)mpz; +(MLKInteger *) integerWithString:(NSString *)string negative:(BOOL)negative base:(unsigned int)base; +(MLKInteger *) integerWithInt:(int)intValue; ++(MLKInteger *) integerWithIntptr_t:(intptr_t)intptr_t_value; ++(MLKInteger *) integerWithFixnum:(id)fixnum; + +-(BOOL) fitsIntoFixnum; +-(id) fixnumValue; -(int) intValue; -(double) doubleValue; diff --git a/MLKInteger.m b/MLKInteger.m index 2837b5b..43af24d 100644 --- a/MLKInteger.m +++ b/MLKInteger.m @@ -39,6 +39,19 @@ return self; } +-(MLKInteger *) initWithIntptr_t:(intptr_t)intptr_t_value +{ + self = [super init]; + mpz_init_set_si (value, intptr_t_value); + return self; +} + +-(MLKInteger *) initWithFixnum:(id)fixnum +{ + self = [self initWithIntptr_t:MLKIntWithFixnum(fixnum)]; + return self; +} + -(MLKInteger *) initWithString:(NSString *)string negative:(BOOL)negative base:(unsigned int)base @@ -51,21 +64,31 @@ +(MLKInteger *) integerWithMPZ:(mpz_t)mpz { - return LAUTORELEASE ([[MLKInteger alloc] initWithMPZ:mpz]); + return AUTORELEASE ([[MLKInteger alloc] initWithMPZ:mpz]); } +(MLKInteger *) integerWithString:(NSString *)string negative:(BOOL)negative base:(unsigned int)base { - return LAUTORELEASE ([[MLKInteger alloc] initWithString:string + return AUTORELEASE ([[MLKInteger alloc] initWithString:string negative:negative base:base]); } +(MLKInteger *) integerWithInt:(int)intValue { - return LAUTORELEASE ([[MLKInteger alloc] initWithInt:intValue]); + return AUTORELEASE ([[MLKInteger alloc] initWithInt:intValue]); +} + ++(MLKInteger *) integerWithIntptr_t:(intptr_t)intptr_t_value +{ + return AUTORELEASE ([[MLKInteger alloc] initWithIntptr_t:intptr_t_value]); +} + ++(MLKInteger *) integerWithFixnum:(id)fixnum +{ + return AUTORELEASE ([[MLKInteger alloc] initWithFixnum:fixnum]); } @@ -140,6 +163,16 @@ DEFINE_MPZ_TWOARG_INTONLY_OPERATION (lcm:, mpz_lcm) return obj; } +-(BOOL) fitsIntoFixnum +{ + return (mpz_sizeinbase (self->value, 2) <= (sizeof (id)) * 8 - 2); +} + +-(id) fixnumValue +{ + return MLKFixnumWithInt ([self intValue]); +} + -(int) intValue { return mpz_get_si (value); diff --git a/MLKInterpreter.m b/MLKInterpreter.m index cfb70a9..ad472b9 100644 --- a/MLKInterpreter.m +++ b/MLKInterpreter.m @@ -178,7 +178,16 @@ static MLKSymbol *MULTIPLE_VALUE_CALL; NSLog (@"; EVAL: %@", MLKPrintToString(program)); #endif // TRACE_EVAL - if (!program || [program isKindOfClass:[MLKSymbol class]]) + if (MLKFixnumP (program)) + { + // Fixnums evaluate to themselves. + // + // We need to get this case out of the way as early as possible, + // as we're going to repeatedly send messages to `program' after + // this point. + RETURN_VALUE (program); + } + else if (!program || [program isKindOfClass:[MLKSymbol class]]) { if (mode == compile_time_too_mode) { diff --git a/MLKPackage.m b/MLKPackage.m index cfe8932..1be467b 100644 --- a/MLKPackage.m +++ b/MLKPackage.m @@ -111,11 +111,16 @@ static NSMutableDictionary *packages = nil; [sys export:[sys intern:@"LISTP"]]; [sys export:[sys intern:@"CONSP"]]; [sys export:[sys intern:@"SYMBOLP"]]; + [sys export:[sys intern:@"FIXNUMP"]]; [sys export:[sys intern:@"NULL"]]; [sys export:[sys intern:@"ADD"]]; [sys export:[sys intern:@"SUBTRACT"]]; [sys export:[sys intern:@"MULTIPLY"]]; [sys export:[sys intern:@"DIVIDE"]]; + [sys export:[sys intern:@"ADD-FIXNUMS"]]; + [sys export:[sys intern:@"SUBTRACT-FIXNUMS"]]; + [sys export:[sys intern:@"MULTIPLY-FIXNUMS"]]; + [sys export:[sys intern:@"DIVIDE-FIXNUMS"]]; [sys export:[sys intern:@"LIST"]]; [sys export:[sys intern:@"MACROEXPAND-1"]]; [sys export:[sys intern:@"MACROEXPAND-ALL"]]; @@ -129,6 +134,7 @@ static NSMutableDictionary *packages = nil; [sys export:[sys intern:@"IMPORT"]]; [sys export:[sys intern:@"INTERN"]]; [sys export:[sys intern:@"SYMBOL-NAME"]]; + [sys export:[sys intern:@"FIXNUM-EQ"]]; [sys export:[sys intern:@"OBJC-CLASS-OF"]]; [sys export:[sys intern:@"OBJC-SUBCLASSP"]]; diff --git a/MLKReader.m b/MLKReader.m index 28ac141..86fc60c 100644 --- a/MLKReader.m +++ b/MLKReader.m @@ -29,6 +29,7 @@ #import "MLKInteger.h" #import "MLKRatio.h" #import "MLKStringInputStream.h" +#import "functions.h" #import "runtime-compatibility.h" #import "util.h" @@ -306,11 +307,12 @@ readingUninternedSymbol:(BOOL)readingUninternedSymbol if (i == [token length]) { //NSLog (@"..."); - return [MLKInteger integerWithString: - [token substringWithRange: - NSMakeRange (firstNum, [token length] - firstNum)] - negative:negative - base:10]; + return MLKCanoniseInteger ([MLKInteger integerWithString: + [token substringWithRange: + NSMakeRange (firstNum, + [token length] - firstNum)] + negative:negative + base:10]); } firstSeparator = [token characterAtIndex:i]; @@ -325,11 +327,12 @@ readingUninternedSymbol:(BOOL)readingUninternedSymbol if (i == [token length] && [readtable isDecimalPoint:firstSeparator]) { //NSLog (@"+++"); - return [MLKInteger integerWithString: - [token substringWithRange: - NSMakeRange (firstNum, [token length] - firstNum - 1)] - negative:negative - base:10]; + return MLKCanoniseInteger ([MLKInteger integerWithString: + [token substringWithRange: + NSMakeRange (firstNum, + [token length] - firstNum - 1)] + negative:negative + base:10]); } else { @@ -425,11 +428,12 @@ readingUninternedSymbol:(BOOL)readingUninternedSymbol if (i == [token length]) { //NSLog (@"###"); - return [MLKInteger integerWithString: - [token substringWithRange: - NSMakeRange (firstNum, [token length] - firstNum)] - negative:negative - base:base]; + return MLKCanoniseInteger ([MLKInteger integerWithString: + [token substringWithRange: + NSMakeRange (firstNum, + [token length] - firstNum)] + negative:negative + base:base]); } // Assume token[i] is a slash. @@ -168,6 +168,12 @@ static id truify (BOOL value) RETURN_VALUE (truify ([args objectAtIndex:0] == [args objectAtIndex:1])); } ++(NSArray *) fixnum_eq:(NSArray *)args +{ + RETURN_VALUE (truify (denullify([args objectAtIndex:0]) + == denullify([args objectAtIndex:1]))); +} + +(NSArray *) symbolp:(NSArray *)args { id arg0 = [args objectAtIndex:0]; @@ -199,6 +205,12 @@ static id truify (BOOL value) RETURN_VALUE (truify ([args objectAtIndex:0] == [NSNull null])); } ++(NSArray *) fixnump:(NSArray *)args +{ + id arg0 = denullify ([args objectAtIndex:0]); + RETURN_VALUE (truify (MLKFixnumP (arg0))); +} + +(NSArray *) add:(NSArray *)args { RETURN_VALUE ([((MLKNumber*)[args objectAtIndex:0]) add:[args objectAtIndex:1]]); @@ -219,6 +231,30 @@ static id truify (BOOL value) RETURN_VALUE ([((MLKNumber*)[args objectAtIndex:0]) divideBy:[args objectAtIndex:1]]); } ++(NSArray *) add_fixnums:(NSArray *)args +{ + RETURN_VALUE (MLKAddFixnums (denullify([args objectAtIndex:0]), + denullify([args objectAtIndex:1]))); +} + ++(NSArray *) subtract_fixnums:(NSArray *)args +{ + RETURN_VALUE (MLKSubtractFixnums (denullify([args objectAtIndex:0]), + denullify([args objectAtIndex:1]))); +} + ++(NSArray *) multiply_fixnums:(NSArray *)args +{ + RETURN_VALUE (MLKMultiplyFixnums (denullify([args objectAtIndex:0]), + denullify([args objectAtIndex:1]))); +} + ++(NSArray *) idivide_fixnums:(NSArray *)args +{ + RETURN_VALUE (MLKIDivideFixnums (denullify([args objectAtIndex:0]), + denullify([args objectAtIndex:1]))); +} + +(NSArray *) list:(NSArray *)args { RETURN_VALUE ([MLKCons listWithArray:args]); @@ -471,6 +507,8 @@ static id truify (BOOL value) if (!object) { RETURN_VALUE ([cl intern:@"NULL"]); } + else if (MLKFixnumP (object)) + { RETURN_VALUE ([cl intern:@"FIXNUM"]); } else if ([object isKindOfClass:[MLKSymbol class]]) { RETURN_VALUE ([cl intern:@"SYMBOL"]); } else if ([object isKindOfClass:[MLKCons class]]) @@ -511,6 +549,9 @@ static id truify (BOOL value) NSMethodSignature *signature; int i; + if (MLKFixnumP (object)) + object = [MLKInteger integerWithFixnum:object]; + selector = NSSelectorFromString (methodName); if (!selector) { @@ -538,7 +579,9 @@ static id truify (BOOL value) if (strcmp (type, @encode(unichar)) == 0) { unichar arg; - if ([argument isKindOfClass:[MLKCharacter class]]) + if (MLKFixnumP (argument)) + arg = MLKIntWithFixnum (argument); + else if ([argument isKindOfClass:[MLKCharacter class]]) arg = [argument unicharValue]; else if ([argument isKindOfClass:[MLKInteger class]]) arg = [argument intValue]; @@ -550,6 +593,9 @@ static id truify (BOOL value) } else { + if (MLKFixnumP (argument)) + argument = [MLKInteger integerWithFixnum:argument]; + [invocation setArgument:&argument atIndex:i]; } } diff --git a/functions.h b/functions.h index a4989cc..aac32e0 100644 --- a/functions.h +++ b/functions.h @@ -16,13 +16,23 @@ * along with this program. If not, see <http://www.gnu.org/licenses/>. */ +#import "MLKInteger.h" + #import <Foundation/NSString.h> #include <stdint.h> +NSString *MLKPrintToString (id object); + BOOL MLKFixnumP (id thing); BOOL MLKInstanceP (id thing); + intptr_t MLKIntWithFixnum (id fixnum); id MLKFixnumWithInt (intptr_t value); id MLKIntegerWithInt (intptr_t value); -NSString *MLKPrintToString (id object); +id MLKCanoniseInteger (MLKInteger *x); + +id MLKAddFixnums (id x, id y); +id MLKSubtractFixnums (id x, id y); +id MLKIDivideFixnums (id x, id y); +id MLKMultiplyFixnums (id x, id y); diff --git a/functions.m b/functions.m index 136c2da..068d217 100644 --- a/functions.m +++ b/functions.m @@ -27,7 +27,7 @@ NSString *MLKPrintToString (id object) return [object descriptionForLisp]; else if (MLKFixnumP (object)) return MLKPrintToString ([MLKInteger - integerWithInt:(MLKIntWithFixnum (object))]); + integerWithIntptr_t:(MLKIntWithFixnum (object))]); else { NSLog (@"MLKPrintToString: Encountered a really weird object at address %p", @@ -48,13 +48,13 @@ id MLKFixnumWithInt (intptr_t value) id MLKIntegerWithInt (intptr_t value) { - intptr_t maybeFixnum = ((intptr_t)value << 1) | 1; + intptr_t maybeFixnum = (value << 1) | 1; if (value == (maybeFixnum >> 1)) return (id)maybeFixnum; else - return [MLKInteger integerWithInt:value]; + return [MLKInteger integerWithIntptr_t:value]; } - + BOOL MLKFixnumP (id thing) { return ((intptr_t)thing & 1); @@ -64,3 +64,60 @@ BOOL MLKInstanceP (id thing) { return !((intptr_t)thing & 1); } + +id MLKCanoniseInteger (MLKInteger *x) +{ + if (MLKFixnumP (x)) + { + return x; + } + else if (MLKInstanceP (x)) + { + if ([x fitsIntoFixnum]) + return [x fixnumValue]; + else + return x; + } + else + { + NSLog (@"MLKCanoniseInteger: Encountered a really weird object at address %p", + x); + return 0; + } +} + +id MLKAddFixnums (id x, id y) +{ + intptr_t ix = MLKIntWithFixnum (x); + intptr_t iy = MLKIntWithFixnum (y); + intptr_t result = ix + iy; + + return MLKIntegerWithInt (result); +} + +id MLKSubtractFixnums (id x, id y) +{ + intptr_t ix = MLKIntWithFixnum (x); + intptr_t iy = MLKIntWithFixnum (y); + intptr_t result = ix - iy; + + return MLKIntegerWithInt (result); +} + +id MLKIDivideFixnums (id x, id y) +{ + intptr_t ix = MLKIntWithFixnum (x); + intptr_t iy = MLKIntWithFixnum (y); + intptr_t result = ix / iy; + + return MLKIntegerWithInt (result); +} + +id MLKMultiplyFixnums (id x, id y) +{ + id ix = [MLKInteger integerWithFixnum:x]; + id iy = [MLKInteger integerWithFixnum:y]; + id result = [ix multiplyWith:iy]; + + return MLKCanoniseInteger (result); +} @@ -73,8 +73,12 @@ "dictionary")) -(setq most-positive-fixnum 32767) -(setq most-negative-fixnum -32768) +(%shadowing-export fixnump) +(defun fixnump (thing) + (sys::fixnump thing)) + +;; (setq most-positive-fixnum 32767) +;; (setq most-negative-fixnum -32768) (defun type-of (thing) @@ -82,15 +86,8 @@ (case primitive-type ((null symbol cons single-float double-float function package) primitive-type) - (integer - (if (and (send-by-name -1 "isEqual:" (send-by-name thing - "compare:" - most-positive-fixnum)) - (send-by-name -1 "isEqual:" (send-by-name most-negative-fixnum - "compare:" - thing))) - 'fixnum - 'bignum)) + (fixnum 'fixnum) + (integer 'bignum) (base-char 'base-char) ;FIXME (sys::lexical-context 'sys::lexical-context) (sys::binding 'sys::binding) @@ -45,7 +45,7 @@ #define LRELEASE(VALUE) \ ({ id __object = VALUE; \ - if (__object) RELEASE(__object); }) + if (MLKInstanceP (__object)) RELEASE(__object); }) #define LRETAIN(VALUE) \ ({ id __object = VALUE; \ @@ -58,7 +58,9 @@ static id stringify (id value) __attribute__ ((pure, unused)); static id nullify (id value) { - if (value) + if (MLKFixnumP (value)) + return [MLKInteger integerWithFixnum:value]; + else if (value) return value; else return [NSNull null]; @@ -68,6 +70,8 @@ static id denullify (id value) { if (value == [NSNull null]) return nil; + else if ([value isKindOfClass:[MLKInteger class]]) + return MLKCanoniseInteger (value); else return value; } @@ -159,7 +159,7 @@ (%append lists)) (%defun* %zerop (integer) - (send-by-name integer "isEqual:" 0)) + (fixnum-eq integer 0)) (%defun* %= (int1 int2) (send-by-name int1 "isEqual:" int2)) |