summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--GNUmakefile5
-rw-r--r--MLKCons.m8
-rw-r--r--MLKEnvironment.m7
-rw-r--r--MLKInterpretedClosure.m2
-rw-r--r--MLKInterpreter.m34
-rw-r--r--MLKPackage.m20
-rw-r--r--MLKReadEvalPrintLoop.m6
-rw-r--r--MLKReader.m2
-rw-r--r--MLKRoot.m10
-rw-r--r--MLKSymbol.m3
-rw-r--r--functions.h28
-rw-r--r--functions.m66
-rw-r--r--util.h3
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;
}
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 06:21:39 +0000