From 820c78beaccf784f710bdd91298401a745d93f2e Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Mon, 4 Aug 2008 15:32:37 +0200 Subject: Add MLKPrintToString along with a couple of fixnum handling functions. --- GNUmakefile | 5 ++-- MLKCons.m | 8 +++--- MLKEnvironment.m | 7 +++--- MLKInterpretedClosure.m | 2 +- MLKInterpreter.m | 34 ++++++++++++------------- MLKPackage.m | 20 +++++++-------- MLKReadEvalPrintLoop.m | 6 ++--- MLKReader.m | 2 +- MLKRoot.m | 10 ++++---- MLKSymbol.m | 3 ++- functions.h | 28 +++++++++++++++++++++ functions.m | 66 +++++++++++++++++++++++++++++++++++++++++++++++++ util.h | 3 ++- 13 files changed, 145 insertions(+), 49 deletions(-) create mode 100644 functions.h create mode 100644 functions.m 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:@"#", [[self name] descriptionForLisp]]; + return [NSString stringWithFormat:@"#", 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 #import @@ -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 #import @@ -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 . + */ + +#import +#include + + +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 . + */ + +#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 #import #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; } -- cgit v1.2.3