From 3658d999dab28812d1a1b6c3527ed386a668b9e7 Mon Sep 17 00:00:00 2001
From: Matthias Andreas Benkard <matthias@benkard.de>
Date: Mon, 7 Jul 2008 20:39:34 +0200
Subject: Implement GENSYM.

---
 MLKPackage.m |  1 +
 MLKRoot.m    | 47 +++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 48 insertions(+)

diff --git a/MLKPackage.m b/MLKPackage.m
index b4de534..85da3c1 100644
--- a/MLKPackage.m
+++ b/MLKPackage.m
@@ -111,6 +111,7 @@ static NSMutableDictionary *packages = nil;
   [sys export:[sys intern:@"UNEXPORT"]];
   [sys export:[sys intern:@"FIND-PACKAGE"]];
   [sys export:[sys intern:@"STRING"]];
+  [sys export:[sys intern:@"GENSYM"]];
 
   [cl export:[cl intern:@"*BREAK-ON-SIGNALS*"]];
   [cl export:[cl intern:@"*COMPILE-FILE-PATHNAME*"]];
diff --git a/MLKRoot.m b/MLKRoot.m
index cad22a4..645e92f 100644
--- a/MLKRoot.m
+++ b/MLKRoot.m
@@ -16,6 +16,7 @@
  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  */
 
+#import "MLKBinding.h"
 #import "MLKCons.h"
 #import "MLKDynamicContext.h"
 #import "MLKInterpreter.h"
@@ -325,4 +326,50 @@ static id truify (BOOL value)
 {
   RETURN_VALUE (stringify (denullify ([args objectAtIndex:0])));
 }
+
++(NSArray *) gensym:(NSArray *)args
+{
+  NSString *prefix;
+  NSString *suffix;
+  MLKBinding *gensymCounter = [[MLKDynamicContext currentContext]
+                                bindingForSymbol:
+                                  [[MLKPackage findPackage:@"COMMON-LISP"]
+                                    intern:@"*GENSYM-COUNTER*"]];
+
+  if ([args count] > 0)
+    {
+      id x = [args objectAtIndex:0];
+      if ([x isKindOfClass:[NSString class]])
+        {
+          prefix = x;
+          suffix = [[gensymCounter value] descriptionForLisp];
+          [gensymCounter
+            setValue:[[gensymCounter value]
+                       add:[MLKInteger integerWithInt:1]]];
+        }
+      else if ([x isKindOfClass:[MLKInteger class]])
+        {
+          // x must be an integer.
+          prefix = @"G";
+          suffix = [x descriptionForLisp];
+        }
+      else
+        [NSException raise:@"MLKTypeError"
+                     format:@"%@ is not of type (OR INTEGER STRING).", x];
+    }
+  else
+    {
+      prefix = @"G";
+      suffix = [[gensymCounter value] descriptionForLisp];
+      [gensymCounter
+        setValue:[[gensymCounter value]
+                   add:[MLKInteger integerWithInt:1]]];
+    }
+
+  RETURN_VALUE (([MLKSymbol symbolWithName:[NSString stringWithFormat:@"%@%@",
+                                                                      prefix,
+                                                                      suffix]
+                            package:nil]));
+}
+
 @end
-- 
cgit v1.2.3