Add class MLKArray.

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);