From fb6b62914bc23c0b01411cf8e8ce968b7dd4dae1 Mon Sep 17 00:00:00 2001
From: Matthias Andreas Benkard <matthias@benkard.de>
Date: Sun, 3 Aug 2008 12:38:42 +0200
Subject: Add MULTIPLE-VALUE-CALL.

---
 MLKInterpreter.m | 35 +++++++++++++++++++++++++++++++++++
 1 file changed, 35 insertions(+)

(limited to 'MLKInterpreter.m')

diff --git a/MLKInterpreter.m b/MLKInterpreter.m
index 188b583..48a4bc9 100644
--- a/MLKInterpreter.m
+++ b/MLKInterpreter.m
@@ -80,6 +80,7 @@ static MLKSymbol *COMPILE;
 static MLKSymbol *LOAD_TOPLEVEL;
 static MLKSymbol *LOAD;
 static MLKSymbol *EXECUTE;
+static MLKSymbol *MULTIPLE_VALUE_CALL;
 
 
 @implementation MLKInterpreter
@@ -121,6 +122,7 @@ static MLKSymbol *EXECUTE;
   _DEFMACRO = [sys intern:@"%DEFMACRO"];
   _LAMBDA = [sys intern:@"%LAMBDA"];
   V_INITP = [sys intern:@"*SYSTEM-INITIALISED-P*"];
+  MULTIPLE_VALUE_CALL = [cl intern:@"MULTIPLE-VALUE-CALL"];
 
   COMPILE_TOPLEVEL = [keyword intern:@"COMPILE-TOPLEVEL"];
   COMPILE = [cl intern:@"COMPILE"];
@@ -904,6 +906,39 @@ static MLKSymbol *EXECUTE;
 
               RETURN_VALUE (nil);  // never reached
             }
+          else if (car == MULTIPLE_VALUE_CALL)
+            {
+              NSMutableArray *results = [NSMutableArray array];
+              id rest = [program cdr];
+              id function = [[self eval:[rest car]
+                                   inLexicalContext:context
+                                   withEnvironment:lexenv
+                                   mode:mode]
+                              objectAtIndex:0];
+
+              while ((rest = [rest cdr]))
+                {
+                  id values = [self eval:[rest car]
+                                    inLexicalContext:context
+                                    withEnvironment:lexenv
+                                    mode:mode];
+                  [results addObjectsFromArray:values];
+                }
+
+              if (expandOnly)
+                {
+                  RETURN_VALUE ([MLKCons
+                                  cons:MULTIPLE_VALUE_CALL
+                                  with:[MLKCons
+                                         cons:function
+                                         with:[MLKCons
+                                                listWithArray:results]]]);
+                }
+              else
+                {
+                  return [function applyToArray:results];
+                }
+            }
           else if (car == PROGN)
             {
               id result = nil;
-- 
cgit v1.2.3