diff options
| -rw-r--r-- | GNUmakefile | 12 | ||||
| -rw-r--r-- | MLKArray.h | 71 | ||||
| -rw-r--r-- | MLKArray.m | 210 | ||||
| -rw-r--r-- | functions.h | 1 |
4 files changed, 290 insertions, 4 deletions
diff --git a/GNUmakefile b/GNUmakefile index 7cc4350..0cb2e7f 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -25,6 +25,9 @@ TOOL_NAME = etshell toilet FRAMEWORK_NAME = ToiletKit BUNDLE_NAME = Test +ADDITIONAL_OBJCFLAGS += $(CUSTOM_OBJCFLAGS) +ADDITIONAL_LDFLAGS += $(CUSTOM_LDFLAGS) + ifeq ($(DEBUG),YES) ADDITIONAL_OBJCFLAGS += -ggdb3 endif @@ -40,13 +43,14 @@ else ifeq ($(HAVE_FFI_FFI_H),YES) ADDITIONAL_OBJCFLAGS += -DHAVE_FFI_FFI_H else - $(error "Could not find ffi.h. Please install libffi and pass appropriate ADDITIONAL_OBJCFLAGS and ADDITIONAL_LDFLAGS to make.") + $(error "Could not find ffi.h. Please install libffi and pass appropriate CUSTOM_OBJCFLAGS and CUSTOM_LDFLAGS to make.") endif endif -ToiletKit_OBJC_FILES = functions.m globals.m MLKBackquoteReader.m \ - MLKBinding.m MLKCharacter.m MLKCommaReader.m \ - MLKCompiledProcedure.m MLKCons.m MLKDoubleFloat.m \ +ToiletKit_OBJC_FILES = functions.m globals.m MLKArray.m \ + MLKBackquoteReader.m MLKBinding.m MLKCharacter.m \ + MLKCommaReader.m MLKCompiledProcedure.m MLKCons.m \ + MLKDoubleFloat.m \ MLKDispatchingMacroCharacterReader.m \ MLKDynamicContext.m MLKEnvironment.m MLKFloat.m \ MLKForeignProcedure.m MLKInteger.m \ diff --git a/MLKArray.h b/MLKArray.h new file mode 100644 index 0000000..4cc7184 --- /dev/null +++ b/MLKArray.h @@ -0,0 +1,71 @@ +/* -*- mode: objc; coding: utf-8 -*- */ +/* Toilet Lisp, 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/NSArray.h> + +#define NSUInteger unsigned int + + +@interface MLKArray : NSMutableArray +{ + int _fillPointer; + int _size; + id *_data; + NSMutableArray *_dimensions; + NSArray *_displacement; +} + +-(id) initWithDimensions:(NSArray *)dimensions; + +// The following methods are like the similarly named +// NSArray/NSMutableArray methods but treat nil as just another object. +// Where nil would be returned otherwise, these methods throw an +// exception. +-(id) idAtIndex:(NSUInteger)index; +-(void) insertId:(id)anObject atIndex:(NSUInteger)index; +-(void) replaceIdAtIndex:(NSUInteger)index withId:(id)anObject; +-(void) addId:(id)anObject; + +// Methods to support ADJUST-ARRAY. +-(void) setSize:(int)size ofDimension:(int)dimension; + +// More stuff. +-(void) setFillPointer:(int)fillPointer; +-(int) fillPointer; + +-(void) setDisplacement:(NSArray *)array; +-(NSArray *) displacement; + +-(NSUInteger) indexOfObjectIdenticalTo:(id)anObject; +-(NSUInteger) indexOfObjectIdenticalTo:(id)anObject inRange:(NSRange)range; +-(NSUInteger) indexOfObject:(id)anObject; +-(NSUInteger) indexOfObject:(id)anObject inRange:(NSRange)range; + +// Must override for NSArray. +-(NSUInteger) count; +-(id) objectAtIndex:(NSUInteger)index; + +// Must override for NSMutableArray. +-(void) insertObject:(id)anObject atIndex:(NSUInteger)index; +-(void) removeObjectAtIndex:(NSUInteger)index; +-(void) addObject:(id)anObject; +-(void) removeLastObject; +-(void) replaceObjectAtIndex:(NSUInteger)index withObject:(id)anObject; + +-(void) dealloc; +@end diff --git a/MLKArray.m b/MLKArray.m new file mode 100644 index 0000000..995dfa8 --- /dev/null +++ b/MLKArray.m @@ -0,0 +1,210 @@ +/* -*- mode: objc; coding: utf-8 -*- */ +/* Toilet Lisp, 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 "MLKArray.h" +#import "functions.h" +#import "util.h" + +#import <Foundation/NSArray.h> +#import <Foundation/NSEnumerator.h> + +#include <stdio.h> +#include <search.h> + + +@implementation MLKArray +-(id) initWithDimensions:(NSArray *)dimensions +{ + NSEnumerator *e; + id el; + + _size = 1; + e = [dimensions objectEnumerator]; + while ((el = [e nextObject])) + { + el = denullify (el); + _size *= MLKIntWithInteger (el); + } + + LASSIGN (_dimensions, [dimensions mutableCopy]); + _data = calloc (_size, sizeof (id)); + _fillPointer = -1; + _displacement = nil; + + return self; +} + +-(id) idAtIndex:(NSUInteger)index +{ + if (index > _size || (_fillPointer != -1 && index > _fillPointer)) + [NSException raise:@"NSRangeException" + format:@"Array index out of bounds"]; + + return _data[index]; +} + +-(void) insertId:(id)anObject atIndex:(NSUInteger)index +{ + _size++; + if (_fillPointer != -1) + _fillPointer++; + + _data = realloc (_data, _size * sizeof (id)); + memmove (_data+index+1, _data+index, _size-index); + _data[index] = anObject; +} + +-(void) removeObjectAtIndex:(NSUInteger)index +{ + _size--; + if (_fillPointer != -1) + _fillPointer--; + + memmove (_data+index, _data+index+1, _size-index-1); + _data = realloc (_data, _size * sizeof (id)); +} + +-(void) replaceIdAtIndex:(NSUInteger)index withId:(id)anObject +{ + _data[index] = anObject; +} + +-(NSUInteger) indexOfObjectIdenticalTo:(id)anObject +{ + return [self indexOfObjectIdenticalTo:anObject + inRange:NSMakeRange(0, _size)]; +} + +static int eq (const void *x, const void *y) +{ + return (x == y ? 0 : 1); +} + +-(NSUInteger) indexOfObjectIdenticalTo:(id)anObject inRange:(NSRange)range +{ + // FIXME: How to treat [NSNull null]? + return ((id*)lfind (anObject, _data + range.location, &range.length, sizeof(id), eq) + - _data); +} + +-(NSUInteger) indexOfObject:(id)anObject +{ + return [self indexOfObject:anObject inRange:NSMakeRange(0, _size)]; +} + +static int equalp (const void *x, const void *y) +{ + // FIXME: Hmm... What about fixnums? What about nil? + return ([(id)x isEqual:(id)y] ? 0 : 1); +} + +-(NSUInteger) indexOfObject:(id)anObject inRange:(NSRange)range +{ + // FIXME: How to treat [NSNull null]? + return ((id*)lfind (anObject, _data + range.location, &range.length, sizeof(id), equalp) + - _data); +} + + +-(void) addId:(id)anObject +{ + [self insertId:anObject atIndex:(_fillPointer == -1 ? _size-1 : _fillPointer-1)]; +} + +-(void) setSize:(int)size ofDimension:(int)dimension +{ + // FIXME: ??? +} + +-(void) setFillPointer:(int)fillPointer +{ + _fillPointer = fillPointer; +} + +-(int) fillPointer +{ + return _fillPointer; +} + +-(void) setDisplacement:(NSArray *)array +{ + LASSIGN (_displacement, array); +} + +-(NSArray *) displacement +{ + return _displacement; +} + +-(NSUInteger) count +{ + return (_fillPointer == -1 ? _size : _fillPointer); +} + +-(id) objectAtIndex:(NSUInteger)index +{ + NS_DURING + { + NS_VALUERETURN (nullify([self idAtIndex:index]), id); + } + NS_HANDLER + { + if ([[localException name] isEqualToString:@"NSRangeException"]) + return nil; + else + [localException raise]; + return nil; + } + NS_ENDHANDLER; +} + +-(void) insertObject:(id)anObject atIndex:(NSUInteger)index +{ + [self insertId:denullify(anObject) atIndex:index]; +} + +-(void) addObject:(id)anObject +{ + [self addId:denullify(anObject)]; +} + +-(void) removeLastObject +{ + if (_fillPointer == -1) + [self removeObjectAtIndex:(_size-1)]; + else if (_fillPointer == 0) + [NSException raise:@"NSRangeException" + format:@"Tried to remove an object from an empty array"]; + else + _fillPointer--; +} + +-(void) replaceObjectAtIndex:(NSUInteger)index withObject:(id)anObject +{ + [self replaceIdAtIndex:index withId:anObject]; +} + +-(void) dealloc +{ + free (_data); + LDESTROY (_dimensions); + LDESTROY (_displacement); + [super dealloc]; +} +@end diff --git a/functions.h b/functions.h index 102565b..6539b21 100644 --- a/functions.h +++ b/functions.h @@ -34,6 +34,7 @@ BOOL MLKFixnumP (id thing); BOOL MLKInstanceP (id thing); intptr_t MLKIntWithFixnum (id fixnum); +intptr_t MLKIntWithInteger (id integer); id MLKFixnumWithInt (intptr_t value); id MLKIntegerWithInt (intptr_t value); id MLKCanoniseInteger (MLKInteger *x); |