Add class MLKDictionary.

5 files changed, 219 insertions, 7 deletions

diff --git a/GNUmakefile b/GNUmakefile
index c6bc134..d41fef9 100644
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -65,10 +65,10 @@ ToiletKit_OBJC_FILES = functions.m globals.m MLKArray.m				\
                        MLKBinaryStreamCharacterStream.m MLKBinding.m		\
                        MLKCharacter.m MLKCharacterStream.m			\
                        MLKCommaReader.m MLKCompiledClosure.m MLKCons.m		\
-                       MLKDoubleFloat.m						\
+                       MLKDictionary.m						\
                        MLKDispatchingMacroCharacterReader.m			\
-                       MLKDynamicContext.m MLKEnvironment.m			\
-                       MLKFileHandleStream.m MLKFloat.m				\
+                       MLKDoubleFloat.m MLKDynamicContext.m			\
+                       MLKEnvironment.m MLKFileHandleStream.m MLKFloat.m	\
                        MLKForeignProcedure.m MLKForm.m MLKInteger.m		\
                        MLKInterpretedClosure.m MLKInterpreter.m			\
                        MLKLexicalContext.m MLKLexicalEnvironment.m		\
diff --git a/MLKDictionary.h b/MLKDictionary.h
new file mode 100644
index 0000000..cf3b03a
--- /dev/null
+++ b/MLKDictionary.h
@@ -0,0 +1,48 @@
+/* -*- mode: objc; coding: utf-8 -*- */
+/* Toilet Lisp, a Common Lisp subset for the Étoilé runtime.
+ * Copyright (C) 2008, 2009  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/Foundation.h>
+
+#define NSUInteger unsigned int
+
+
+@interface MLKDictionary : NSMutableDictionary
+{
+  NSMapTable *m_table;
+}
+
++(void) initialize;
+
++(id) dictionary;
+-(id) init;
+-(id) initEqTable;
+-(id) initEqlTable;
+-(id) initEqualTable;
+-(id) initEqualPTable;
+//-(id) initWithPredicate:(id <MLKFuncallable>)predicate
+//      hash:(id <MLKFuncallable>)hash;
+
+
+-(NSUInteger) count;
+-(NSEnumerator *) keyEnumerator;
+-(id) objectForKey:(id)key;
+-(void) setObject:(id)object forKey:(id)key;
+
+-(void) dealloc;
+-(void) finalize;
+@end
diff --git a/MLKDictionary.m b/MLKDictionary.m
new file mode 100644
index 0000000..f80b886
--- /dev/null
+++ b/MLKDictionary.m
@@ -0,0 +1,164 @@
+/* -*- mode: objc; coding: utf-8 -*- */
+/* Toilet Lisp, a Common Lisp subset for the Étoilé runtime.
+ * Copyright (C) 2008, 2009  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 "MLKDictionary.h"
+#import "functions.h"
+#import "globals.h"
+#import "util.h"
+
+#import <Foundation/Foundation.h>
+
+#include <stdio.h>
+#include <search.h>
+#include <string.h>
+
+
+static NSMapTableValueCallBacks value_callbacks;
+
+static NSMapTableKeyCallBacks
+  eq_callbacks, eql_callbacks, equal_callbacks, equalp_callbacks;
+
+
+static void retain (NSMapTable *table, const void *x)
+{
+  id y = (id) x;
+  LRETAIN (y);
+}
+
+static void release (NSMapTable *table, void *x)
+{
+  LRELEASE (x);
+}
+
+NSString *describe (NSMapTable *table, const void *x)
+{
+  return MLKPrintToString ((id) x);
+}
+
+static BOOL eql (NSMapTable *table, const void *p_x, const void *p_y)
+{
+  id x = (id)p_x, y = (id)p_y;
+
+  if ((MLKInstanceP (x) && ![x isKindOfClass:[MLKInteger class]])
+      || (MLKInstanceP (y) && ![x isKindOfClass:[MLKInteger class]]))
+    return x == y;
+  else
+    {
+      x = MLKCanoniseInteger (x);
+      y = MLKCanoniseInteger (y);
+
+      if (MLKFixnumP (x) && MLKFixnumP (y))
+        return x == y;
+      else if (MLKInstanceP (x) && MLKInstanceP (y))
+        return [x isEqual:y];
+      else
+        return NO;
+    }
+}
+
+static unsigned eql_hash (NSMapTable *table, const void *x)
+{
+  if (MLKInstanceP ((id) x))
+    return (unsigned) x;
+  else
+    return (unsigned) MLKCanoniseInteger(x);
+}
+
+static BOOL equal (NSMapTable *table, const void *x, const void *y)
+{
+  // FIXME
+}
+
+static unsigned equal_hash (NSMapTable *table, const void *x)
+{
+  // FIXME
+}
+
+static BOOL equalp (NSMapTable *table, const void *x, const void *y)
+{
+  // FIXME
+}
+
+static unsigned equalp_hash (NSMapTable *table, const void *x)
+{
+  // FIXME
+}
+
+
+@implementation MLKDictionary
++(void) initialize
+{
+  value_callbacks.retain = retain;
+  value_callbacks.release = release;
+  value_callbacks.describe = describe;
+
+  eq_callbacks.hash = NULL;
+  eq_callbacks.isEqual = NULL;
+  eq_callbacks.retain = retain;
+  eq_callbacks.release = release;
+  eq_callbacks.describe = describe;
+  eq_callbacks.notAKeyMarker = MLKEndOfArgumentsMarker;
+
+  eql_callbacks.hash = eql_hash;
+  eql_callbacks.isEqual = eql;
+  eql_callbacks.retain = retain;
+  eql_callbacks.release = release;
+  eql_callbacks.describe = describe;
+  eql_callbacks.notAKeyMarker = MLKEndOfArgumentsMarker;
+
+  equal_callbacks.hash = equal_hash;
+  equal_callbacks.isEqual = equal;
+  equal_callbacks.retain = retain;
+  equal_callbacks.release = release;
+  equal_callbacks.describe = describe;
+  equal_callbacks.notAKeyMarker = MLKEndOfArgumentsMarker;
+
+  equalp_callbacks.hash = equalp_hash;
+  equalp_callbacks.isEqual = equalp;
+  equalp_callbacks.retain = retain;
+  equalp_callbacks.release = release;
+  equalp_callbacks.describe = describe;
+  equalp_callbacks.notAKeyMarker = MLKEndOfArgumentsMarker;
+}
+
++(id) dictionary
+{
+  return LAUTORELEASE ([[self alloc] init]);
+}
+
+-(id) init
+{
+  return [self initEqlTable];
+}
+
+-(id) initEqlTable
+{
+  m_table = NSCreateMapTable (eql_callbacks, value_callbacks, 0);
+  return self;
+}
+
+-(void) dealloc
+{
+  NSFreeMapTable (m_table);
+}
+
+-(void) finalize
+{
+  NSFreeMapTable (m_table);
+}
+@end
diff --git a/functions.h b/functions.h
index 55de17f..607a4d1 100644
--- a/functions.h
+++ b/functions.h
@@ -1,6 +1,6 @@
 /* -*- mode: objc; coding: utf-8 -*- */
 /* Toilet Lisp, a Common Lisp subset for the Étoilé runtime.
- * Copyright (C) 2008  Matthias Andreas Benkard.
+ * Copyright (C) 2008, 2009  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
@@ -87,7 +87,7 @@ id MLKIntegerWithInt (intptr_t value);
 
    Test whether a Toilet Lisp integer is an MLKInteger that is too big,
    and if so, convert it to a fixnum. */
-id MLKCanoniseInteger (MLKInteger *x);
+id MLKCanoniseInteger (const MLKInteger *x);
 
 
 /* Section: Fixnum arithmetic */
diff --git a/functions.m b/functions.m
index 3c0c2f9..16fa271 100644
--- a/functions.m
+++ b/functions.m
@@ -1,6 +1,6 @@
 /* -*- mode: objc; coding: utf-8 -*- */
 /* Toilet Lisp, a Common Lisp subset for the Étoilé runtime.
- * Copyright (C) 2008  Matthias Andreas Benkard.
+ * Copyright (C) 2008, 2009  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
@@ -92,7 +92,7 @@ BOOL MLKInstanceP (id thing)
   return !((intptr_t)thing & 1);
 }
 
-id MLKCanoniseInteger (MLKInteger *x)
+id MLKCanoniseInteger (const MLKInteger *x)
 {
   if (MLKFixnumP (x))
     {