diff options
| -rw-r--r-- | MLKForm.h | 4 | ||||
| -rw-r--r-- | MLKForm.m | 15 | ||||
| -rw-r--r-- | MLKInterpreter.m | 15 | ||||
| -rw-r--r-- | control-flow.lisp | 8 | ||||
| -rw-r--r-- | special-symbols.h | 4 |
5 files changed, 20 insertions, 26 deletions
@@ -238,9 +238,9 @@ @end -@interface MLKMultipleValueCallForm : MLKBodyForm +@interface MLKMultipleValueListForm : MLKCompoundForm { - MLKForm *_functionForm; + MLKForm *_listForm; } @end @@ -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"]; |