Add support for fixnums.

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.
diff --git a/MLKRoot.m b/MLKRoot.m
index e367241..5f70830 100644
--- a/MLKRoot.m
+++ b/MLKRoot.m
@@ -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);
+}
diff --git a/types.lisp b/types.lisp
index a73741f..0b4ccb3 100644
--- a/types.lisp
+++ b/types.lisp
@@ -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)
diff --git a/util.h b/util.h
index fbde2b2..861a74d 100644
--- a/util.h
+++ b/util.h
@@ -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;
 }
diff --git a/util.lisp b/util.lisp
index 62d9e79..af3cec0 100644
--- a/util.lisp
+++ b/util.lisp
@@ -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))