Add MLKPrintToString along with a couple of fixnum handling functions.

13 files changed, 145 insertions, 49 deletions

diff --git a/GNUmakefile b/GNUmakefile
index 3a2dd9b..c412b34 100644
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -31,8 +31,9 @@ else
 ADDITIONAL_OBJCFLAGS = -Wall -ggdb3
 endif
 
-ToiletKit_OBJC_FILES = MLKBackquoteReader.m MLKBinding.m MLKCharacter.m	\
-                       MLKCommaReader.m MLKCons.m MLKDoubleFloat.m	\
+ToiletKit_OBJC_FILES = functions.m MLKBackquoteReader.m MLKBinding.m	\
+                       MLKCharacter.m MLKCommaReader.m MLKCons.m	\
+                       MLKDoubleFloat.m					\
                        MLKDispatchingMacroCharacterReader.m		\
                        MLKDynamicContext.m MLKEnvironment.m MLKFloat.m	\
                        MLKInteger.m MLKInterpretedClosure.m		\
diff --git a/MLKCons.m b/MLKCons.m
index d7063dc..469275b 100644
--- a/MLKCons.m
+++ b/MLKCons.m
@@ -102,15 +102,15 @@
 {
   if (!_cdr)
     return [NSString stringWithFormat:@"%@",
-                     (_car ? (id)[_car descriptionForLisp] : (id)@"()")];
+                     MLKPrintToString(_car)];
   else if ([_cdr isKindOfClass:[MLKCons class]])
     return [NSString stringWithFormat:@"%@ %@",
-                     (_car ? (id)[_car descriptionForLisp] : (id)@"()"),
+                     MLKPrintToString(_car),
                      [_cdr bareDescriptionForLisp]];
   else
     return [NSString stringWithFormat:@"%@ . %@",
-                     (_car ? (id)[_car descriptionForLisp] : (id)@"()"),
-                     [_cdr descriptionForLisp]];
+                     MLKPrintToString(_car),
+                     MLKPrintToString(_cdr)];
 }
 
 -(NSString *)descriptionForLisp
diff --git a/MLKEnvironment.m b/MLKEnvironment.m
index c557f79..215d3dc 100644
--- a/MLKEnvironment.m
+++ b/MLKEnvironment.m
@@ -25,6 +25,7 @@
 #import "MLKEnvironment.h"
 #import "NSObject-MLKPrinting.h"
 #import "runtime-compatibility.h"
+#import "util.h"
 
 
 @implementation MLKEnvironment
@@ -80,7 +81,7 @@
   if (!(binding = [self bindingForSymbol:symbol]))
     [NSException raise:@"MLKUnboundVariableError"
                  format:@"The variable %@ is unbound.",
-                       [symbol descriptionForLisp]];
+                       MLKPrintToString(symbol)];
 
   [binding setValue:value];
 }
@@ -92,7 +93,7 @@
   if (!(binding = [self bindingForSymbol:symbol]))
     [NSException raise:@"MLKUnboundVariableError"
                  format:@"The variable %@ is unbound.",
-                       [symbol descriptionForLisp]];
+                       MLKPrintToString(symbol)];
       
   return [binding value];
 }
@@ -158,7 +159,7 @@
   if (![self bindingForSymbol:symbol])
     [NSException raise:@"MLKUnboundVariableError"
                  format:@"The variable %@ is unbound.",
-                        [symbol descriptionForLisp]];
+                        MLKPrintToString(symbol)];
   [self addBinding:binding forSymbol:symbol];
 }
 
diff --git a/MLKInterpretedClosure.m b/MLKInterpretedClosure.m
index 3da152c..9f76cc6 100644
--- a/MLKInterpretedClosure.m
+++ b/MLKInterpretedClosure.m
@@ -78,7 +78,7 @@ static MLKSymbol *PROGN;
 
 -(NSString *) description
 {
-  return [self descriptionForLisp];
+  return MLKPrintToString(self);
 }
 
 -(NSString *) descriptionForLisp
diff --git a/MLKInterpreter.m b/MLKInterpreter.m
index d22ce09..e90249a 100644
--- a/MLKInterpreter.m
+++ b/MLKInterpreter.m
@@ -175,7 +175,7 @@ static MLKSymbol *MULTIPLE_VALUE_CALL;
     trace = YES;
 
   if (trace)
-    NSLog (@"; EVAL: %@", [program descriptionForLisp]);
+    NSLog (@"; EVAL: %@", MLKPrintToString(program));
 #endif  // TRACE_EVAL
 
   if (!program || [program isKindOfClass:[MLKSymbol class]])
@@ -208,7 +208,7 @@ static MLKSymbol *MULTIPLE_VALUE_CALL;
         }
       else if ([context variableIsLexical:program])
         {
-          //NSLog (@"Processing lexical variable %@.", [program descriptionForLisp]);
+          //NSLog (@"Processing lexical variable %@.", MLKPrintToString(program));
           //NSLog (@"Lexical environment: %@.", lexenv);
           //NSLog (@"Lexical variable value: %@.", [lexenv valueForSymbol:program]);
           if (expandOnly)
@@ -218,7 +218,7 @@ static MLKSymbol *MULTIPLE_VALUE_CALL;
         }
       else
         {
-          //NSLog (@"Processing special variable %@.", [program descriptionForLisp]);
+          //NSLog (@"Processing special variable %@.", MLKPrintToString(program));
           //NSLog (@"Dynamic context: %@.", dynamicContext);
           //NSLog (@"Special variable value: %@.", [dynamicContext valueForSymbol:program]);
           if (expandOnly)
@@ -1209,8 +1209,8 @@ static MLKSymbol *MULTIPLE_VALUE_CALL;
                 [[NSException exceptionWithName:@"MLKThrow"
                               reason:[NSString stringWithFormat:
                                                  @"THROW: tag %@, values %@.",
-                                               [catchTag descriptionForLisp],
-                                               [values descriptionForLisp]]
+                                               MLKPrintToString(catchTag),
+                                               MLKPrintToString(values)]
                               userInfo:userInfo] raise];
               else
                 // FIXME: This should really be a condition rather than
@@ -1218,8 +1218,8 @@ static MLKSymbol *MULTIPLE_VALUE_CALL;
                 [[NSException exceptionWithName:@"MLKControlError"
                               reason:[NSString stringWithFormat:
                                                  @"THROW without a corresponding CATCH: tag %@, values %@.",
-                                               [catchTag descriptionForLisp],
-                                               [values descriptionForLisp]]
+                                               MLKPrintToString(catchTag),
+                                               MLKPrintToString(values)]
                               userInfo:userInfo] raise];
 
               return nil;
@@ -1345,7 +1345,7 @@ static MLKSymbol *MULTIPLE_VALUE_CALL;
                     {
                       [NSException raise:@"MLKNoSuchOperatorException"
                                    format:@"%@ does not name a known operator.",
-                                          [car descriptionForLisp]];
+                                          MLKPrintToString(car)];
                       return nil;
                     }
                 }
@@ -1362,7 +1362,7 @@ static MLKSymbol *MULTIPLE_VALUE_CALL;
         {
           [NSException raise:@"MLKInvalidExpressionException"
                        format:@"%@ is not a valid operator name.",
-                       [car descriptionForLisp]];
+                       MLKPrintToString(car)];
           return nil;  
         }
     }
@@ -1384,7 +1384,7 @@ static MLKSymbol *MULTIPLE_VALUE_CALL;
       NSAutoreleasePool *pool;
 
       //NSLog (@"%@", code);
-      //NSLog (@"%@", [code descriptionForLisp]);
+      //NSLog (@"%@", MLKPrintToString(code));
       //NSLog (@"%@", stream);
       //NSLog (@"...");
 
@@ -1401,10 +1401,10 @@ static MLKSymbol *MULTIPLE_VALUE_CALL;
 
       if ([code isKindOfClass:[MLKCons class]] && [code cdr])
         formdesc = [NSString stringWithFormat:@"(%@ %@ ...)",
-                               [[code car] descriptionForLisp],
-                               [[[code cdr] car] descriptionForLisp]];
+                               MLKPrintToString([code car]),
+                               MLKPrintToString([[code cdr] car])];
       else
-        formdesc = [code descriptionForLisp];
+        formdesc = MLKPrintToString(code);
 
       //fprintf (stderr, "; COMPILE-MINIMALLY: %s\n", [formdesc UTF8String]);
       fprintf (stderr, "; LOAD: %s\n", [formdesc UTF8String]);
@@ -1419,10 +1419,10 @@ static MLKSymbol *MULTIPLE_VALUE_CALL;
 
       if ([code isKindOfClass:[MLKCons class]] && [code cdr])
         formdesc = [NSString stringWithFormat:@"(%@ %@ ...)",
-                               [[expansion car] descriptionForLisp],
-                               [[[expansion cdr] car] descriptionForLisp]];
+                               MLKPrintToString([expansion car]),
+                               MLKPrintToString([[expansion cdr] car])];
       else
-        formdesc = [expansion descriptionForLisp];
+        formdesc = MLKPrintToString(expansion);
 
       //fprintf (stderr, "; LOAD: %s\n", [formdesc UTF8String]);
       result = [MLKInterpreter
@@ -1438,7 +1438,7 @@ static MLKSymbol *MULTIPLE_VALUE_CALL;
         {
           //FIXME
           //NSLog (@"; LOAD: Fnord.  Primary value: %@",
-          //       [[result objectAtIndex:0] descriptionForLisp]);
+          //       MLKPrintToString([result objectAtIndex:0]));
         }
     }
 
diff --git a/MLKPackage.m b/MLKPackage.m
index bd19608..445bf86 100644
--- a/MLKPackage.m
+++ b/MLKPackage.m
@@ -268,9 +268,9 @@ static NSMutableDictionary *packages = nil;
         [NSException
           raise:@"MLKSymbolConflictError"
           format:@"Imported symbol %@ conflicts with accessible symbol %@ in package %@.",
-                 [symbol descriptionForLisp],
-                 [old_symbol descriptionForLisp],
-                 [self descriptionForLisp]];
+                 MLKPrintToString(symbol),
+                 MLKPrintToString(old_symbol),
+                 MLKPrintToString(self)];
     }
 
   [_accessible_symbols setObject:symbol forKey:name];
@@ -304,9 +304,9 @@ static NSMutableDictionary *packages = nil;
     [NSException
       raise:@"MLKSymbolConflictError"
       format:@"Inherited symbol %@ conflicts with accessible symbol %@ in package %@.",
-             [symbol descriptionForLisp],
-             [old_symbol descriptionForLisp],
-             [self descriptionForLisp]];
+             MLKPrintToString(symbol),
+             MLKPrintToString(old_symbol),
+             MLKPrintToString(self)];
 
   [_accessible_symbols setObject:symbol forKey:name];
   
@@ -352,9 +352,9 @@ static NSMutableDictionary *packages = nil;
         [NSException
           raise:@"MLKSymbolConflictError"
           format:@"Exported symbol %@ conflicts with accessible symbol %@ in package %@.",
-                 [symbol descriptionForLisp],
-                 [old_symbol descriptionForLisp],
-                 [package descriptionForLisp]];
+                 MLKPrintToString(symbol),
+                 MLKPrintToString(old_symbol),
+                 MLKPrintToString(package)];
     }
 
   for (i = 0; i < [_using_packages count]; i++)
@@ -475,7 +475,7 @@ static NSMutableDictionary *packages = nil;
 
 -(NSString *) descriptionForLisp
 {
-  return [NSString stringWithFormat:@"#<Package %@>", [[self name] descriptionForLisp]];
+  return [NSString stringWithFormat:@"#<Package %@>", MLKPrintToString ([self name])];
 }
 
 -(void) dealloc
diff --git a/MLKReadEvalPrintLoop.m b/MLKReadEvalPrintLoop.m
index f2a7803..2300b77 100644
--- a/MLKReadEvalPrintLoop.m
+++ b/MLKReadEvalPrintLoop.m
@@ -24,6 +24,7 @@
 #import "MLKReader.h"
 #import "NSObject-MLKPrinting.h"
 #import "runtime-compatibility.h"
+#import "util.h"
 
 #import <Foundation/NSAutoreleasePool.h>
 #import <Foundation/NSException.h>
@@ -143,10 +144,7 @@ static const char *prompt (EditLine *e) {
               for (i = 0; i < [results count]; i++)
                 {
                   id result = [results objectAtIndex:i];
-                  if (result != [NSNull null])
-                    printf ("%s\n", [[result descriptionForLisp] UTF8String]);
-                  else
-                    printf ("()\n");
+                  printf ("%s\n", [MLKPrintToString (denullify (result)) UTF8String]);
                 }
             }
           NS_HANDLER
diff --git a/MLKReader.m b/MLKReader.m
index abd8a43..7b4ba60 100644
--- a/MLKReader.m
+++ b/MLKReader.m
@@ -512,7 +512,7 @@ readingUninternedSymbol:(BOOL)readingUninternedSymbol
                     [NSException raise:@"MLKReaderError"
                                  format:@"Package %@ does not export symbol %@.",
                                         [package name],
-                                        [symbol descriptionForLisp]];
+                                        MLKPrintToString(symbol)];
                 }
             }
         }
diff --git a/MLKRoot.m b/MLKRoot.m
index e3680f3..689828e 100644
--- a/MLKRoot.m
+++ b/MLKRoot.m
@@ -345,7 +345,7 @@ static id truify (BOOL value)
     {
       [NSException raise:@"MLKNoSuchPackageError"
                    format:@"The package %@ does not exist",
-                          [name descriptionForLisp]];
+                          MLKPrintToString(name)];
       return nil;
     }
 }
@@ -370,7 +370,7 @@ static id truify (BOOL value)
       if ([x isKindOfClass:[NSString class]])
         {
           prefix = x;
-          suffix = [[gensymCounter value] descriptionForLisp];
+          suffix = MLKPrintToString([gensymCounter value]);
           [gensymCounter
             setValue:[[gensymCounter value]
                        add:[MLKInteger integerWithInt:1]]];
@@ -379,7 +379,7 @@ static id truify (BOOL value)
         {
           // x must be an integer.
           prefix = @"G";
-          suffix = [x descriptionForLisp];
+          suffix = MLKPrintToString(x);
         }
       else
         [NSException raise:@"MLKTypeError"
@@ -388,7 +388,7 @@ static id truify (BOOL value)
   else
     {
       prefix = @"G";
-      suffix = [[gensymCounter value] descriptionForLisp];
+      suffix = MLKPrintToString([gensymCounter value]);
       [gensymCounter
         setValue:[[gensymCounter value]
                    add:[MLKInteger integerWithInt:1]]];
@@ -454,7 +454,7 @@ static id truify (BOOL value)
 
 +(NSArray *) ns_log:(NSArray *)args
 {
-  NSString *description = [[args objectAtIndex:0] descriptionForLisp];
+  NSString *description = MLKPrintToString([args objectAtIndex:0]);
   NSLog (@"%@", description);
   RETURN_VALUE ([args objectAtIndex:0]);
 }
diff --git a/MLKSymbol.m b/MLKSymbol.m
index d84dc18..c5af052 100644
--- a/MLKSymbol.m
+++ b/MLKSymbol.m
@@ -22,6 +22,7 @@
 #import "MLKReadtable.h"
 #import "MLKSymbol.h"
 #import "runtime-compatibility.h"
+#import "util.h"
 
 #import <Foundation/NSException.h>
 #import <Foundation/NSString.h>
@@ -153,7 +154,7 @@
 
 -(NSString *) description
 {
-  return [self descriptionForLisp];
+  return MLKPrintToString(self);
 }
 
 -(BOOL) isEqual:(id)object
diff --git a/functions.h b/functions.h
new file mode 100644
index 0000000..a4989cc
--- /dev/null
+++ b/functions.h
@@ -0,0 +1,28 @@
+/* -*- mode: objc; coding: utf-8 -*- */
+/* Étoilisp/Mulklisp, a Common Lisp subset for the Étoilé runtime.
+ * Copyright (C) 2008  Matthias Andreas Benkard.
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or (at
+ * your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#import <Foundation/NSString.h>
+#include <stdint.h>
+
+
+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);
diff --git a/functions.m b/functions.m
new file mode 100644
index 0000000..136c2da
--- /dev/null
+++ b/functions.m
@@ -0,0 +1,66 @@
+/* -*- mode: objc; coding: utf-8 -*- */
+/* Étoilisp/Mulklisp, a Common Lisp subset for the Étoilé runtime.
+ * Copyright (C) 2008  Matthias Andreas Benkard.
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or (at
+ * your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#import "functions.h"
+#import "MLKInteger.h"
+
+NSString *MLKPrintToString (id object)
+{
+  if (object == nil)
+    return @"()";
+  else if (MLKInstanceP (object))
+    return [object descriptionForLisp];
+  else if (MLKFixnumP (object))
+    return MLKPrintToString ([MLKInteger
+                               integerWithInt:(MLKIntWithFixnum (object))]);
+  else
+    {
+      NSLog (@"MLKPrintToString: Encountered a really weird object at address %p",
+             object);
+      return @"<??\?>";
+    }
+}
+
+intptr_t MLKIntWithFixnum (id fixnum)
+{
+  return ((intptr_t)fixnum >> 1);
+}
+
+id MLKFixnumWithInt (intptr_t value)
+{
+  return (id)((value << 1) | 1);
+}
+
+id MLKIntegerWithInt (intptr_t value)
+{
+  intptr_t maybeFixnum = ((intptr_t)value << 1) | 1;
+  if (value == (maybeFixnum >> 1))
+    return (id)maybeFixnum;
+  else
+    return [MLKInteger integerWithInt:value];
+}
+ 
+BOOL MLKFixnumP (id thing)
+{
+  return ((intptr_t)thing & 1);
+}
+
+BOOL MLKInstanceP (id thing)
+{
+  return !((intptr_t)thing & 1);
+}
diff --git a/util.h b/util.h
index 0a93aaf..91cd92c 100644
--- a/util.h
+++ b/util.h
@@ -1,4 +1,5 @@
 #import "runtime-compatibility.h"
+#import "functions.h"
 #import <Foundation/NSException.h>
 #import <Foundation/NSNull.h>
 #import "MLKSymbol.h"
@@ -49,7 +50,7 @@ static id stringify (id thing)
     return [thing name];
 
   [NSException raise:@"MLKTypeError" format:@"Can't coerce %@ to a string.",
-                                            [thing descriptionForLisp]];
+                                            MLKPrintToString(thing)];
 
   return nil;
 }