summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--GNUmakefile12
-rw-r--r--MLKArray.h71
-rw-r--r--MLKArray.m210
-rw-r--r--functions.h1
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);