From 2009d6d234c6bdc871109cf6b35c3ac2070f8d11 Mon Sep 17 00:00:00 2001
From: Matthias Benkard <mulk@minimulk.mst-plus>
Date: Thu, 2 Oct 2008 16:36:14 +0200
Subject: Interpreter: Implement MULTIPLE-VALUE-LIST instead of
 MULTIPLE-VALUE-CALL.

---
 MLKForm.h         |  4 ++--
 MLKForm.m         | 15 +++++++--------
 MLKInterpreter.m  | 15 +++------------
 control-flow.lisp |  8 ++++++--
 special-symbols.h |  4 ++--
 5 files changed, 20 insertions(+), 26 deletions(-)

diff --git a/MLKForm.h b/MLKForm.h
index 60b5428..ff48e98 100644
--- a/MLKForm.h
+++ b/MLKForm.h
@@ -238,9 +238,9 @@
 @end
 
 
-@interface MLKMultipleValueCallForm : MLKBodyForm
+@interface MLKMultipleValueListForm : MLKCompoundForm
 {
-  MLKForm *_functionForm;
+  MLKForm *_listForm;
 }
 @end
 
diff --git a/MLKForm.m b/MLKForm.m
index 30ae6ee..8e8bf02 100644
--- a/MLKForm.m
+++ b/MLKForm.m
@@ -185,7 +185,7 @@
   else if (car == _FLET) return [MLKSimpleFletForm class];
   else if (car == LET) return [MLKLetForm class];
   else if (car == _LOOP) return [MLKSimpleLoopForm class];
-  else if (car == MULTIPLE_VALUE_CALL) return [MLKMultipleValueCallForm class];
+  else if (car == MULTIPLE_VALUE_LIST) return [MLKMultipleValueListForm class];
   else if (car == PROGN) return [MLKProgNForm class];
   else if (car == PROGV) return [MLKProgVForm class];
   else if (car == QUOTE) return [MLKQuoteForm class];
@@ -898,25 +898,24 @@
 @end
 
 
-@implementation MLKMultipleValueCallForm
+@implementation MLKMultipleValueListForm
 -(id) complete
 {
   self = [super complete];
-  LASSIGN (_functionForm, [MLKForm formWithObject:[_tail car]
-                                   inContext:_context
-                                   forCompiler:_compiler]);
-  [self processBody:[_tail cdr]];
+  LASSIGN (_listForm, [MLKForm formWithObject:[_tail car]
+                                    inContext:_context
+                                  forCompiler:_compiler]);
   return self;
 }
 
 -(NSArray *) subforms
 {
-  return [[super subforms] arrayByAddingObject:_functionForm];
+  return [[super subforms] arrayByAddingObject:_listForm];
 }
 
 -(void) dealloc
 {
-  LDESTROY (_functionForm);
+  LDESTROY (_listForm);
   [super dealloc];
 }
 @end
diff --git a/MLKInterpreter.m b/MLKInterpreter.m
index 027e2f7..e7e95ba 100644
--- a/MLKInterpreter.m
+++ b/MLKInterpreter.m
@@ -473,20 +473,11 @@ PRIMARY (NSArray *array)
 @end
 
 
-@implementation MLKMultipleValueCallForm (MLKInterpretation)
+@implementation MLKMultipleValueListForm (MLKInterpretation)
 -(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env
 {
-  NSMutableArray *results = [NSMutableArray array];
-  int i;
-  id <MLKFuncallable> function = PRIMARY ([_functionForm interpretWithEnvironment:env]);
-
-  for (i = 0; i < [_bodyForms count]; i++)
-    {
-      NSArray *values = [[_bodyForms objectAtIndex:i] interpretWithEnvironment:env];
-      [results addObjectsFromArray:values];
-    }
-  
-  return [function applyToArray:results];
+  NSArray *results = [_listForm interpretWithEnvironment:env];
+  return [NSArray arrayWithObject:[MLKCons listWithArray:results]];
 }
 @end
 
diff --git a/control-flow.lisp b/control-flow.lisp
index bcd8e23..f429a1a 100644
--- a/control-flow.lisp
+++ b/control-flow.lisp
@@ -215,8 +215,12 @@
      ,@body))
 
 
-(defmacro multiple-value-list (expression)
-  `(multiple-value-call #'list ,expression))
+(defmacro multiple-value-call (function-form &rest forms)
+  (let ((args `(mapcan 'identity (list ,@(mapcar (lambda (form) `(multiple-value-list ,form)))))))
+    `(apply ,function-form ,args)))
+
+;;(defmacro multiple-value-list (expression)
+;;  `(multiple-value-call #'list ,expression))
 
 (defmacro multiple-value-bind ((&rest vars) expression &body forms)
   `(destructuring-bind ,vars (multiple-value-list ,expression)
diff --git a/special-symbols.h b/special-symbols.h
index 752e1e9..ebdcbb7 100644
--- a/special-symbols.h
+++ b/special-symbols.h
@@ -56,7 +56,7 @@ static MLKSymbol *COMPILE;
 static MLKSymbol *LOAD_TOPLEVEL;
 static MLKSymbol *LOAD;
 static MLKSymbol *EXECUTE;
-static MLKSymbol *MULTIPLE_VALUE_CALL;
+static MLKSymbol *MULTIPLE_VALUE_LIST;
 static MLKSymbol *INLINE;
 static MLKSymbol *NOTINLINE;
 static MLKSymbol *SPECIAL;
@@ -106,7 +106,7 @@ ensure_symbols ()
   _FOREIGN_LAMBDA = [sys intern:@"%FOREIGN-LAMBDA"];
   _LAMBDA = [sys intern:@"%LAMBDA"];
   V_INITP = [sys intern:@"*SYSTEM-INITIALISED-P*"];
-  MULTIPLE_VALUE_CALL = [cl intern:@"MULTIPLE-VALUE-CALL"];
+  MULTIPLE_VALUE_LIST = [cl intern:@"MULTIPLE-VALUE-LIST"];
   INLINE = [cl intern:@"INLINE"];
   NOTINLINE = [cl intern:@"NOTINLINE"];
   SPECIAL = [cl intern:@"INLINE"];
-- 
cgit v1.2.3