From bdfe4801295945b92f84b8c03cb2e0be485ae4f0 Mon Sep 17 00:00:00 2001
From: Matthias Andreas Benkard <matthias@benkard.de>
Date: Mon, 18 Aug 2008 01:19:06 +0200
Subject: Promote special operator APPLY to an intrinsic function.

---
 MLKForm.m         |  3 +--
 MLKInterpreter.m  | 29 +----------------------------
 MLKPackage.m      |  2 +-
 MLKRoot.m         | 22 +++++++++++++++++++---
 special-symbols.h |  2 --
 5 files changed, 22 insertions(+), 36 deletions(-)

diff --git a/MLKForm.m b/MLKForm.m
index d8f72bc..ee5139f 100644
--- a/MLKForm.m
+++ b/MLKForm.m
@@ -129,8 +129,7 @@
 {
   id car = [object car];
 
-  if (car == APPLY) return [MLKFunctionCallForm class];
-  else if (car == CATCH) return [MLKCatchForm class];
+  if (car == CATCH) return [MLKCatchForm class];
   else if (car == EVAL) return [MLKFunctionCallForm class];
   else if (car == EVAL_WHEN) return [MLKEvalWhenForm class];
   else if (car == _FOREIGN_LAMBDA) return [MLKForeignLambdaForm class];
diff --git a/MLKInterpreter.m b/MLKInterpreter.m
index 540b9b5..0cdf904 100644
--- a/MLKInterpreter.m
+++ b/MLKInterpreter.m
@@ -193,34 +193,7 @@
                 }
             }
 
-          if (car == APPLY)
-            {
-              MLKCons *rest = denullify([[self eval:[[[program cdr] cdr] car]
-                                               inLexicalContext:context
-                                               withEnvironment:lexenv
-                                               expandOnly:expandOnly]
-                                          objectAtIndex:0]);
-
-              id function = denullify([[self eval:[[program cdr] car]
-                                             inLexicalContext:context
-                                             withEnvironment:lexenv
-                                             expandOnly:expandOnly]
-                                        objectAtIndex:0]);
-
-              if (expandOnly)
-                RETURN_VALUE ([MLKCons cons:APPLY
-                                       with:[MLKCons cons:function
-                                                     with:[MLKCons cons:rest
-                                                                   with:nil]]]);
-
-              if ([function isKindOfClass:[MLKSymbol class]])
-                function = [lexenv functionForSymbol:function];
-
-              return [function applyToArray:(rest
-                                             ? (id)[rest array]
-                                             : (id)[NSArray array])];
-            }
-          else if (car == CATCH)
+          if (car == CATCH)
             {
               id catchTag;
               NSArray *values;
diff --git a/MLKPackage.m b/MLKPackage.m
index c86f8a6..6d97652 100644
--- a/MLKPackage.m
+++ b/MLKPackage.m
@@ -92,7 +92,6 @@ static NSMutableDictionary *packages = nil;
   [cl export:[cl intern:@"FUNCALL"]];
   [cl export:[cl intern:@"FUNCTION"]];
   [cl export:[cl intern:@"PROGN"]];
-  [cl export:[cl intern:@"APPLY"]];
   [cl export:[cl intern:@"PROGV"]];
   [cl export:[cl intern:@"SETQ"]];
   [cl export:[cl intern:@"SETF"]];
@@ -155,6 +154,7 @@ static NSMutableDictionary *packages = nil;
   [sys export:[sys intern:@"DECLARATIONS-AND-FORMS"]];
   [sys export:[sys intern:@"COMPILE"]];
   [sys export:[sys intern:@"SET"]];
+  [sys export:[sys intern:@"APPLY"]];
 
   [sys export:[sys intern:@"OBJC-CLASS-OF"]];
   [sys export:[sys intern:@"OBJC-SUBCLASSP"]];
diff --git a/MLKRoot.m b/MLKRoot.m
index b12cd17..0db7483 100644
--- a/MLKRoot.m
+++ b/MLKRoot.m
@@ -711,11 +711,11 @@ as provided by method %@ of object %@",
 #ifdef USE_LLVM
 +(NSArray *) compile:(NSArray *)args
 {
-  NSLog (@"Compiling lambda form.");
+  //NSLog (@"Compiling lambda form.");
   id thing = [MLKLLVMCompiler compile:denullify([args objectAtIndex:0])
                               inContext:[MLKLexicalContext globalContext]];
-  NSLog (@"Compilation done.");
-  NSLog (@"Compiled: %@", thing);
+  //NSLog (@"Compilation done.");
+  //NSLog (@"Compiled: %@", thing);
   RETURN_VALUE (thing);
 }
 #endif
@@ -757,4 +757,20 @@ as provided by method %@ of object %@",
 
   RETURN_VALUE (value);
 }
+
++(NSArray *) apply:(NSArray *)args
+{
+  id function = denullify ([args objectAtIndex:0]);
+  id arglist = denullify ([args objectAtIndex:1]);
+
+  if (!function || [function isKindOfClass:[MLKSymbol class]])
+    {
+      function = [[MLKLexicalEnvironment globalEnvironment]
+                   functionForSymbol:function];
+    }
+
+  return [function applyToArray:(arglist
+                                 ? (id)[arglist array]
+                                 : (id)[NSArray array])];
+}
 @end
diff --git a/special-symbols.h b/special-symbols.h
index 9427181..d7e7351 100644
--- a/special-symbols.h
+++ b/special-symbols.h
@@ -36,7 +36,6 @@ static MLKSymbol *_MACROLET;
 static MLKSymbol *LAMBDA;
 static MLKSymbol *LET;
 static MLKSymbol *LOCALLY;
-static MLKSymbol *APPLY;
 static MLKSymbol *FUNCALL;
 static MLKSymbol *FUNCTION;
 static MLKSymbol *EVAL;
@@ -84,7 +83,6 @@ ensure_symbols ()
   _FLET = [sys intern:@"%FLET"];
   _MACROLET = [sys intern:@"%MACROLET"];
   _LOOP = [sys intern:@"%LOOP"];
-  APPLY = [cl intern:@"APPLY"];
   EVAL = [cl intern:@"EVAL"];
   EVAL_WHEN = [cl intern:@"EVAL-WHEN"];
   FUNCALL = [cl intern:@"FUNCALL"];
-- 
cgit v1.2.3