| blob | 4666292806d24872eb847515c70ffed0e420364f |
1 From: Tony Balinskt <ajbj@free.fr>
2 Subject: Allow inline construction of anonymous arrays and "named arguments"
4 Available as a patch:
6 http://sourceforge.net/tracker/index.php?func=detail&aid=1592340&group_id=11005&atid=311005
7 [ 1592340 ] Array literals and named arguments
8 anonArrayNamedArgs3.diff 2006-11-16 02:34
10 This patch allows arrays to be created in-line as anonymous entities. For
11 example:
13 my_array = { \
14 1, 2, 3, # assigns elements [0] to [2] \
15 ["word"] = "val", # assigns element ["word"] \
16 , # don't assign to [3] \
17 4, # assigns element [4] = 4 \
18 [7] = 7, 8, # assigns elements [7] and [8] \
19 ["sub"] = { "a", "b" } # assigns an array to element ["sub"] \
20 }
22 The anonymous array is available in contexts where a whole array is needed;
23 for example:
25 val0 = { [0] = "zero"}[0]
26 my_array += { [val0] = 4 + 5 - 9 }
28 The patch also allows macro functions to be called with array element style
29 assignments. These cannot use simple numeric or numeric string indices, but
30 multidimensional numeric indices are allowed.
32 The array element style ("named") arguments are inserted into the called
33 routine's $args array, and accessible using array syntax. Simple argument
34 expressions are counted from the first ($1), with numeric index 1 in $args,
35 up to $n_args. Note that $args[] and $n_args may now be different since the
36 former will include the count of "named" arguments.
38 For example:
40 define returnArgs {
41 return $args
42 }
43 a = returnArgs(1, 2, 3, 4, 5, [6,7]=8, ["hello"] = "hi")
44 b = { , 1, 2, 3, 4, 5, [6,7]=8, ["hello"] = "hi" }
46 Here the arrays a and b are equal. (Note the comma at the start of b's
47 assigned array.) But:
49 a = returnArgs(1, [2]="no") # fails: name for arg cannot be numeric
51 Finally, calling a built-in macro function always makes sure an extra
52 argument is present at argList[nArgs] - in calls using positional values
53 only, this argument will have a tag value of NO_TAG. If "named" arguments
54 have been passed, the argument will have tag ARRAY_TAG, and the named
55 arguments be present in the array, indexed by name. (The positional
56 arguments will not be in this array but can be added to it readily.) Use the
57 ArrayGet() function or iterate over entries as required.
59 ---
61 doc/help.etx | 100 ++++++++++-
62 source/interpret.c | 476 +++++++++++++++++++++++++++++++++++++++++++----------
63 source/ops.h | 8
64 source/parse.y | 97 ++++++++++
65 4 files changed, 585 insertions(+), 96 deletions(-)
67 diff --quilt old/doc/help.etx new/doc/help.etx
68 --- old/doc/help.etx
69 +++ new/doc/help.etx
70 @@ -2043,14 +2043,30 @@ Macro Language
72 The syntax of a function or subroutine call is:
74 function_name(arg1, arg2, ...)
76 - where arg1, arg2, etc. represent the argument values which are passed to
77 - the routine being called. A function or subroutine call can be on a line by
78 - itself, as above, or if it returns a value, can be invoked within a character
79 - or numeric expression:
80 + where arg1, arg2, etc. represent the arguments which are passed to
81 + the routine being called. Arguments can be one of two kinds: positional or
82 + named. A positional argument is passed as an expression in the argument
83 + list. A named argument is passed by indicating the name as an array key,
84 + between square brackets, followed by the "=" operator and an expression
85 + for the argument's value. Named arguments can use any valid array key value
86 + as long as it cannot be converted into an integer value.
87 +
88 + For example, the call
89 +
90 + result = func(["prompt"] = "Available values are:", \
91 + a, b, c, d, e, f, \
92 + ["buttons"] = { "OK", "Change", "Cancel" })
93 +
94 + provides six positional arguments (with the values of variables a, b, c, d, e
95 + and f), and the named arguments "prompt", with a string value, and "buttons"
96 + with an array value.
97 +
98 + A function or subroutine call can be on a line by itself, as above, or if it
99 + returns a value, can be invoked within a character or numeric expression:
101 a = fn1(b, c) + fn2(d)
102 dialog("fn3 says: " fn3())
104 Arguments are passed by value. This means that you cannot return values via
105 @@ -2093,15 +2109,18 @@ Macro Language
106 Subroutine definitions cannot appear within other definitions, nor within
107 macro menu item definitions. They can only appear in (macro) files, such as
108 the autoload macro file, cf. Preferences_. Macro files can be loaded with
109 File -> Load Macro File or with the load_macro_file() action.
111 - The arguments with which a user-defined subroutine or function was invoked,
112 - are presented as $1, $2, ... , $9 or $args[expr], where expr can be evaluated
113 - to an integer from 1 to the number of arguments. The number of arguments can
114 - be read from $n_args or $args[]. The array $args[expr] is the only way to
115 - access arguments beyond the first 9.
116 + Within the body of a user-defined subroutine or function, the first nine
117 + positional arguments can be retrieved using the identifiers $1, $2, ... , $9.
118 + Both positional and named arguments can be accessed using the $args array:
119 + if the key is numeric, the corresponding positional argument (numbered from 1)
120 + can be retrieved; otherwise the key is a name, and the name argument's value
121 + is retrieved. The identifier $n_args provides the number of positional
122 + arguments passed to the function. You can test for the presence of named
123 + arguments in the $args array using the "in" operator.
125 To return a value from a subroutine, and/or to exit from the subroutine
126 before the end of the subroutine body, use the return statement:
128 return <value to return>
129 @@ -2236,11 +2255,11 @@ Macro Language
130 When duplicate keys are encountered using the + and & operators, the values
131 from the array on the right side of the operators are used for the result.
132 All of the above operators are array only, meaning both the left and right
133 sides of the operator must be arrays. The results are also arrays.
135 - Array keys can also contain multiple dimensions:
136 + Array keys can contain multiple "dimensions":
138 x[1, 1, 1] = "string"
140 These are used in the expected way, e.g.:
142 @@ -2281,10 +2300,71 @@ Macro Language
143 if (("1" $sub_sep "2") in myArray)
144 {..}
146 does work.
148 + Note that if an array contains a value that is itself an array, you can
149 + apply the index operator more than once. For example
150 +
151 + subarray["a"] = "value"
152 + mainarray[1] = subarray
153 +
154 + for (i in mainarray) {
155 + if ("a" in mainarray[i])
156 + value_a = mainarray[i]["a"]
157 + ...
158 + }
159 +
160 +4>Array Initializing Expressions
161 +
162 + You can build arrays using array expressions. These are contained in braces,
163 + "{" and "}", and contain a list of possibly empty value assignments.
164 + For example
165 +
166 + myarray = { ["a"] = "first", \
167 + ["col" colno] = x * 5, \
168 + [x, y] = 2 * func() }
169 +
170 + If the keys are numeric (or convertible to plian integers) and in increasing
171 + sequence, only the first is required; thus
172 +
173 + myarray = { [5] = a, b, c, \
174 + [1,2] = "2-D key", \
175 + ["20"] = d, e }
176 +
177 + creates entries with keys "5", "6", "7", "20", "21" and ("1" $sub_sep "2").
178 + If no key value is given for the first entry, "0" is used. If you want to skip
179 + a value in a sequence, just provide an empty value, thus
180 +
181 + myarray = { a, b, , c }
182 +
183 + creates entries with keys "0", "1" and "3". The entry for key "2" is not
184 + created.
185 +
186 + If a later array entry has the same key value as an earlier one, the later
187 + value overwrites the earlier one. For example
188 +
189 + myarray = { a, b, c, [1] = d, e }
190 +
191 + overwrites the myarray["1"] entry, initialized with the value of b, with the
192 + value of d. Similarly the myarray["2"] entry is overwritten.
193 +
194 + You can use array initializing expressions as part of other expressions. They
195 + can be passed as arguments to functions:
196 +
197 + result = func({ ["message"] = "The value is", \
198 + ["value"] = 4, "OK" })
199 +
200 + Or you can use them to add to arrays, as in
201 +
202 + myarray += { [newkey] = newvalue }
203 +
204 + The built-in variable $empty_array evaluates to an empty array. You can also
205 + build an empty array using array initializing expressions as follows:
206 +
207 + myarray = {}
208 +
209 3>Looping and Conditionals
211 NEdit supports looping constructs: for and while, and conditional statements:
212 if and else, with essentially the same syntax as C:
214 diff --quilt old/source/interpret.c new/source/interpret.c
215 --- old/source/interpret.c
216 +++ new/source/interpret.c
217 @@ -84,13 +84,16 @@ static void restoreContext(RestartData *
219 #define OP(name, fn) static int fn(void);
220 #include "ops.h"
221 #undef OP
222 static int returnValOrNone(int valOnStack);
223 +static int branchIf(Boolean trueOrFalse);
224 +static int namedArg1orN(Boolean isFirst);
226 static int concatenateNwithSep(int nVals, const char *sep, char **result,
227 int leaveParams);
228 +static int makeArrayKeyFromArgs(int nArgs, char **keyString, int leaveParams);
229 static void freeSymbolTable(Symbol *symTab);
230 static int errCheck(const char *s);
231 static int execError(const char *s1, const char *s2);
232 static rbTreeNode *arrayEmptyAllocator(void);
233 static rbTreeNode *arrayAllocateNode(rbTreeNode *src);
234 @@ -175,20 +178,20 @@ static int (*OpFns[])() = {
235 #define OP(name, fn) fn,
236 #include "ops.h"
237 #undef OP
238 };
240 -/* Stack-> symN-sym0(FP), argArray, nArgs, oldFP, retPC, argN-arg1, next, ... */
241 -#define FP_ARG_ARRAY_INDEX (-1)
242 -#define FP_ARG_COUNT_INDEX (-2)
243 -#define FP_FUNCTION_NAME (-3) /* !! */
244 -#define FP_SYMBOL_TABLE (-4) /* !! */
245 -#define FP_OLD_FP_INDEX (-5)
246 -#define FP_RET_PC_INDEX (-6)
247 -#define FP_PROG_INDEX (-7)
248 +/* Stack-> symN-sym0(FP), nArgs, oldFP, retPC, argArray, argN-arg1, next, ... */
249 +#define FP_ARG_COUNT_INDEX (-1)
250 +#define FP_FUNCTION_NAME (-2) /* !! */
251 +#define FP_SYMBOL_TABLE (-3) /* !! */
252 +#define FP_OLD_FP_INDEX (-4)
253 +#define FP_RET_PC_INDEX (-5)
254 +#define FP_PROG_INDEX (-6)
255 +#define FP_ARG_ARRAY_INDEX (-7)
257 -#define FP_TO_ARGS_DIST (0 - FP_RET_PC_INDEX) /* should be 0 - (above index) */
258 +#define FP_TO_ARGS_DIST (0 - FP_ARG_ARRAY_INDEX) /* should be 0 - (above index) */
260 #define FP_GET_ITEM(xFrameP,xIndex) (*(xFrameP + xIndex))
261 #define FP_GET_ARG_ARRAY(xFrameP) (FP_GET_ITEM(xFrameP, FP_ARG_ARRAY_INDEX))
262 #define FP_GET_ARG_COUNT(xFrameP) (FP_GET_ITEM(xFrameP, FP_ARG_COUNT_INDEX).val.n)
263 #define FP_GET_OLD_FP(xFrameP) ((FP_GET_ITEM(xFrameP, FP_OLD_FP_INDEX)).val.dataval)
264 @@ -382,11 +385,11 @@ void SwapCode(Inst *start, Inst *boundar
265 {
266 #define reverseCode(L, H) \
267 do { register Inst t, *l = L, *h = H - 1; \
268 while (l < h) { t = *h; *h-- = *l; *l++ = t; } } while (0)
269 /* double-reverse method: reverse elements of both parts then whole lot */
270 - /* eg abcdefABCD -1-> edcbaABCD -2-> edcbaDCBA -3-> DCBAedcba */
271 + /* eg abcdeABCD -1-> edcbaABCD -2-> edcbaDCBA -3-> ABCDabcde */
272 reverseCode(start, boundary); /* 1 */
273 reverseCode(boundary, end); /* 2 */
274 reverseCode(start, end); /* 3 */
275 }
277 @@ -461,11 +464,12 @@ int ExecuteMacro(WindowInfo *window, Pro
278 {
279 RestartData *context;
280 static DataValue noValue = {NO_TAG, {0}};
281 Symbol *s;
282 int i;
283 -
284 + int haveNamedArgs;
285 +
286 /* Create an execution context (a stack, a stack pointer, a frame pointer,
287 and a program counter) which will retain the program state across
288 preemption and resumption of execution */
289 context = (RestartData *)XtMalloc(sizeof(RestartData));
290 context->stack = (DataValue *)XtMalloc(sizeof(DataValue) * STACK_SIZE);
291 @@ -473,13 +477,20 @@ int ExecuteMacro(WindowInfo *window, Pro
292 context->stackP = context->stack;
293 context->pc = prog->code;
294 context->runWindow = window;
295 context->focusWindow = window;
297 + haveNamedArgs = (nArgs < 0);
298 + if (haveNamedArgs)
299 + nArgs = -nArgs;
300 +
301 /* Push arguments and call information onto the stack */
302 for (i=0; i<nArgs; i++)
303 - *(context->stackP++) = args[i];
304 + *(context->stackP++) = args[i];
305 +
306 + if (!haveNamedArgs)
307 + *(context->stackP++) = noValue; /* cached arg array */
309 context->stackP->val.prog = NULL; /* prog, nothing to be free */
310 context->stackP->tag = NO_TAG;
311 context->stackP++;
313 @@ -496,16 +507,14 @@ int ExecuteMacro(WindowInfo *window, Pro
314 context->stackP->tag = STRING_TAG;
315 context->stackP->val.str.rep = prog->name ? prog->name : "<exec-macro>";
316 context->stackP->val.str.len = strlen(context->stackP->val.str.rep);
317 context->stackP++;
319 - context->stackP->tag = NO_TAG; /* nArgs */
320 - context->stackP->val.n = nArgs;
321 + context->stackP->tag = INT_TAG; /* nArgs */
322 + context->stackP->val.n = nArgs - haveNamedArgs;
323 context->stackP++;
325 - *(context->stackP++) = noValue; /* cached arg array */
326 -
327 context->frameP = context->stackP;
329 /* Initialize and make room on the stack for local variables */
330 for (s = prog->localSymList; s != NULL; s = s->next) {
331 FP_GET_SYM_VAL(context->frameP, s) = noValue;
332 @@ -574,23 +583,31 @@ int ContinueMacro(RestartData *continuat
333 }
334 }
335 }
337 /*
338 +** Set up a new stack frame, with no caller arguments, in the current context,
339 +** and set up execution for Program *prog.
340 +**
341 ** If a macro is already executing, and requests that another macro be run,
342 ** this can be called instead of ExecuteMacro to run it in the same context
343 ** as if it were a subroutine. This saves the caller from maintaining
344 ** separate contexts, and serializes processing of the two macros without
345 ** additional work.
346 */
347 +/* TODO: this function should really return a status (if fails PUSH_CHECK) */
348 void RunMacroAsSubrCall(Program *prog)
349 {
350 Symbol *s;
351 static DataValue noValue = {NO_TAG, {0}};
353 /* See subroutine "callSubroutine" for a description of the stack frame
354 for a subroutine call */
355 + /* if (!OK_TO_PUSH(5)) return MACRO_ERROR; */
356 +
357 + *(StackP++) = noValue; /* cached arg array */
358 +
359 StackP->tag = NO_TAG;
360 StackP->val.prog = prog; /* prog */
361 StackP++;
363 StackP->tag = NO_TAG;
364 @@ -608,22 +625,22 @@ void RunMacroAsSubrCall(Program *prog)
365 StackP->tag = STRING_TAG;
366 StackP->val.str.rep = prog->name ? prog->name : "<run-macro>";
367 StackP->val.str.len = strlen(StackP->val.str.rep);
368 StackP++;
370 - StackP->tag = NO_TAG; /* nArgs */
371 + StackP->tag = INT_TAG; /* nArgs */
372 StackP->val.n = 0;
373 StackP++;
375 - *(StackP++) = noValue; /* cached arg array */
376 -
377 FrameP = StackP;
378 PC = prog->code;
379 for (s = prog->localSymList; s != NULL; s = s->next) {
380 + /* if (!OK_TO_PUSH(1)) return MACRO_ERROR; */
381 FP_GET_SYM_VAL(FrameP, s) = noValue;
382 StackP++;
383 }
384 + /* return MACRO_DONE? MACRO_PREEMPT? MACRO_TIME_LIMIT? */
385 }
387 void FreeRestartData(RestartData *context)
388 {
389 XtFree((char *)context->stack);
390 @@ -1414,16 +1431,19 @@ static int pushArgArray(void)
391 nArgs = FP_GET_ARG_COUNT(FrameP);
392 resultArray = &FP_GET_ARG_ARRAY(FrameP);
393 if (resultArray->tag != ARRAY_TAG) {
394 resultArray->tag = ARRAY_TAG;
395 resultArray->val.arrayPtr = ArrayNew();
396 + }
398 + /* load arguments from positional arg list if not already done */
399 + if (nArgs && !ArrayGet(resultArray, longAsStr(argNum + 1), &argVal)) {
400 for (argNum = 0; argNum < nArgs; ++argNum) {
401 argVal = FP_GET_ARG_N(FrameP, argNum);
402 if (!ArrayInsert(resultArray, AllocStringOfNumber(argNum + 1),
403 &argVal)) {
404 - return(execError("array insertion failure", NULL));
405 + return(execError("argument array insertion failure", NULL));
406 }
407 }
408 }
409 PUSH(*resultArray);
410 return STAT_OK;
411 @@ -1475,10 +1495,278 @@ static int pushArraySymVal(void)
413 return STAT_OK;
414 }
416 /*
417 +** create an anonymous array and next index number value (0) on the stack (for
418 +** array construction expressions)
419 +**
420 +** Before: Prog-> [next], ...
421 +** TheStack-> next, ...
422 +** After: Prog-> [next], ...
423 +** TheStack-> [empty-array, 0], next, ...
424 +*/
425 +static int anonArrayOpen(void)
426 +{
427 + DataValue dataVal;
428 +
429 + DISASM_RT(PC-1, 1);
430 + STACKDUMP(0, 3);
431 +
432 + /* make an empty array */
433 + dataVal.tag = ARRAY_TAG;
434 + dataVal.val.arrayPtr = ArrayNew();
435 +
436 + /* push the default next index value first */
437 + PUSH_INT(0);
438 +
439 + /* and the empty array */
440 + PUSH(dataVal);
441 +
442 + return STAT_OK;
443 +}
444 +
445 +/*
446 +** cause the auto-incrementing next index number value to increase without
447 +** actually creating an entry in the anonymous array (for array construction
448 +** expressions)
449 +**
450 +** Before: Prog-> [next], ...
451 +** TheStack-> [anon-array, next-index], next, ...
452 +** After: Prog-> [next], ...
453 +** TheStack-> [anon-array, next-index+1], next, ...
454 +*/
455 +static int anonArraySkip(void)
456 +{
457 + DataValue anonArray;
458 + int nextIndex;
459 +
460 + DISASM_RT(PC-1, 1);
461 + STACKDUMP(2, 3);
462 +
463 + POP(anonArray);
464 + POP_INT(nextIndex);
465 +
466 + /* we need to increment the index for next time */
467 + ++nextIndex;
468 +
469 + /* push the default next index value first, then the array */
470 + PUSH_INT(nextIndex);
471 + PUSH(anonArray);
472 +
473 + return STAT_OK;
474 +}
475 +
476 +/*
477 +** add an entry to the anonymous array at the stack head, using the numeric
478 +** index just below that; restack the incremented index and anonymous array
479 +** (for array construction expressions)
480 +**
481 +** Before: Prog-> [next], ...
482 +** TheStack-> [expr, anon-array, next-index], next, ...
483 +** After: Prog-> [next], ...
484 +** TheStack-> [anon-array, next-index+1], next, ...
485 +*/
486 +static int anonArrayNextVal(void)
487 +{
488 + DataValue exprVal, anonArray;
489 + int nextIndex;
490 + char numString[TYPE_INT_STR_SIZE(int)];
491 +
492 + DISASM_RT(PC-1, 1);
493 + STACKDUMP(3, 3);
494 +
495 + POP(exprVal);
496 + POP(anonArray);
497 + POP_INT(nextIndex);
498 +
499 + sprintf(numString, "%d", nextIndex);
500 + if (!ArrayInsert(&anonArray, AllocStringCpy(numString), &exprVal)) {
501 + return(execError("array insertion failure", NULL));
502 + }
503 +
504 + /* we need to increment the index for next time */
505 + ++nextIndex;
506 +
507 + /* push the default next index value first, then the array */
508 + PUSH_INT(nextIndex);
509 + PUSH(anonArray);
510 +
511 + return STAT_OK;
512 +}
513 +
514 +/*
515 +**
516 +** Before: Prog-> [nDim], next, ...
517 +** TheStack-> [expr, indnDim, ... ind1, anon-array, next-index], next, ...
518 +** After: Prog-> nDim, [next], ...
519 +** TheStack-> [anon-array, new-next-index], next, ...
520 +*/
521 +static int anonArrayIndexVal(void)
522 +{
523 + int errNum;
524 + char *keyString = NULL;
525 + DataValue exprVal, anonArray;
526 + int nextIndex, index;
527 + int nDim;
528 +
529 + nDim = PC->value;
530 + PC++;
531 +
532 + DISASM_RT(PC-2, 2);
533 + STACKDUMP(nDim+3, 3);
534 +
535 + POP(exprVal);
536 +
537 + /* the next nDim stack entries form the index */
538 + errNum = makeArrayKeyFromArgs(nDim, &keyString, 0);
539 + if (errNum != STAT_OK) {
540 + return errNum;
541 + }
542 +
543 + POP(anonArray);
544 + POP_INT(nextIndex);
545 +
546 + /* if our index is numeric (or can be converted to a number) we must
547 + change the next index value */
548 + if (nDim == 1 && StringToNum(keyString, &index)) {
549 + nextIndex = index + 1;
550 + }
551 +
552 + if (!ArrayInsert(&anonArray, keyString, &exprVal)) {
553 + return(execError("array insertion failure", NULL));
554 + }
555 +
556 + /* push the default next index value first, then the array */
557 + PUSH_INT(nextIndex);
558 + PUSH(anonArray);
559 +
560 + return STAT_OK;
561 +}
562 +
563 +/*
564 +** finish building an anonymous array by removing the next index number value
565 +** from the stack (for array construction expressions)
566 +**
567 +** Before: Prog-> [next], ...
568 +** TheStack-> [anon-array, next-index], next, ...
569 +** After: Prog-> [next], ...
570 +** TheStack-> [anon-array], next, ...
571 +*/
572 +static int anonArrayClose(void)
573 +{
574 + DataValue anonArray;
575 + DataValue next_index;
576 +
577 + DISASM_RT(PC-1, 1);
578 + STACKDUMP(2, 3);
579 +
580 + /* remove top two elements */
581 + POP(anonArray);
582 + POP(next_index);
583 + /* put back the array content */
584 + PUSH(anonArray);
585 +
586 + return STAT_OK;
587 +}
588 +
589 +/*
590 +** create an $args array for the named arg with index of nDim elements, and
591 +** value expr; leave result on top of stack
592 +**
593 +** Before: Prog-> [nDim], next, ...
594 +** TheStack-> [expr, indnDim, ... ind1], argN-arg1, next, ...
595 +** After: Prog-> nDim, [next], ...
596 +** TheStack-> args, argN-arg1, next, ...
597 +*/
598 +static int namedArg1(void)
599 +{
600 + return namedArg1orN(True);
601 +}
602 +
603 +/*
604 +** add the named arg with index of nDim elements, and value expr to the $args
605 +** array at the top of the stack
606 +**
607 +** Before: Prog-> [nDim], next, ...
608 +** TheStack-> [expr, indnDim, ... ind1, args], argN-arg1, next, ...
609 +** After: Prog-> nDim, [next], ...
610 +** TheStack-> [args], argN-arg1, next, ...
611 +*/
612 +static int namedArgN()
613 +{
614 + return namedArg1orN(False);
615 +}
616 +
617 +/*
618 +** implementation for namedArg1(), namedArgN()
619 +*/
620 +static int namedArg1orN(Boolean isFirst)
621 +{
622 + int errNum;
623 + char *keyString = NULL;
624 + DataValue exprVal, argsArray;
625 + int nDim, index;
626 +
627 + nDim = (PC++)->value;
628 +
629 + DISASM_RT(PC-2, 2);
630 + STACKDUMP(nDim + (isFirst ? 2 : 1), 3);
631 +
632 + POP(exprVal);
633 +
634 + /* the next nDim stack entries form the index */
635 + errNum = makeArrayKeyFromArgs(nDim, &keyString, 0);
636 + if (errNum != STAT_OK) {
637 + return errNum;
638 + }
639 +
640 + /* if our index is numeric (or can be converted to a number) we must
641 + change the next index value */
642 + if (nDim == 1 && StringToNum(keyString, &index)) {
643 + return execError("named argument name must not be numeric", NULL);
644 + }
645 +
646 + if (isFirst) {
647 + /* make a new empty array */
648 + argsArray.tag = ARRAY_TAG;
649 + argsArray.val.arrayPtr = NULL;
650 + }
651 + else {
652 + /* use the array at the top of the stack */
653 + POP(argsArray);
654 + }
655 +
656 + if (!ArrayInsert(&argsArray, keyString, &exprVal)) {
657 + return(execError("named argument insertion failure", NULL));
658 + }
659 +
660 + /* and (re)push the array */
661 + PUSH(argsArray);
662 +
663 + return STAT_OK;
664 +}
665 +
666 +/*
667 +** exchange top two values on the stack
668 +*/
669 +static int swapTop2(void)
670 +{
671 + DataValue dv1, dv2;
672 +
673 + DISASM_RT(PC-1, 1);
674 + STACKDUMP(2, 3);
675 +
676 + POP(dv1);
677 + POP(dv2);
678 + PUSH(dv1);
679 + PUSH(dv2);
680 +
681 + return STAT_OK;
682 +}
683 +
684 +/*
685 ** assign top value to next symbol
686 **
687 ** Before: Prog-> [symbol], next, ...
688 ** TheStack-> [value], next, ...
689 ** After: Prog-> symbol, [next], ...
690 @@ -2110,53 +2398,62 @@ static int concat(void)
691 }
693 /*
694 ** Call a subroutine or function (user defined or built-in). Args are the
695 ** subroutine's symbol, and the number of arguments which have been pushed
696 -** on the stack.
697 +** on the stack. If this value is less than zero, use the absolute value,
698 +** but note that the last one is already the $args array so don't set aside
699 +** space for that.
700 **
701 ** For a macro subroutine, the return address, frame pointer, number of
702 ** arguments and space for local variables are added to the stack, and the
703 ** PC is set to point to the new function. For a built-in routine, the
704 ** arguments are popped off the stack, and the routine is just called.
705 **
706 ** Before: Prog-> [subrSym], nArgs, next, ...
707 -** TheStack-> argN-arg1, next, ...
708 +** TheStack-> argArray?, argN-arg1, next, ...
709 ** After: Prog-> next, ... -- (built-in called subr)
710 ** TheStack-> retVal?, next, ...
711 ** or: Prog-> (in called)next, ... -- (macro code called subr)
712 -** TheStack-> symN-sym1(FP), argArray, nArgs, oldFP, retPC, argN-arg1, next, ...
713 +** TheStack-> symN-sym1(FP), nArgs, oldFP, retPC, argArray, argN-arg1, next, ...
714 */
715 static int callSubroutine(void)
716 {
717 Symbol *sym, *s;
718 int i, nArgs;
719 static DataValue noValue = {NO_TAG, {0}};
720 Program *prog;
721 char *errMsg;
722 -
723 + int haveNamedArgs;
724 +
725 sym = PC->sym;
726 PC++;
727 nArgs = PC->value;
728 PC++;
729 -
730 +
731 + haveNamedArgs = (nArgs < 0);
732 + nArgs = (haveNamedArgs) ? -nArgs - 1 : nArgs;
733 +
734 DISASM_RT(PC-3, 3);
735 - STACKDUMP(nArgs, 3);
736 + STACKDUMP(nArgs + haveNamedArgs, 3);
738 /*
739 ** If the subroutine is built-in, call the built-in routine
740 */
741 if (sym->type == C_FUNCTION_SYM) {
742 DataValue result;
744 + if (!haveNamedArgs)
745 + PUSH(noValue); /* push dummy named arg array */
746 +
747 /* "pop" stack back to the first argument in the call stack */
748 - StackP -= nArgs;
749 + StackP -= nArgs + 1;
751 /* Call the function and check for preemption */
752 PreemptRequest = False;
753 - if (!sym->value.val.subr(FocusWindow, StackP,
754 - nArgs, &result, &errMsg))
755 + /* NB nArgs < 0 implies presence of named args array in last position */
756 + if (!sym->value.val.subr(FocusWindow, StackP, nArgs, &result, &errMsg))
757 return execError(errMsg, sym->name);
758 if (PC->func == fetchRetVal) {
759 if (result.tag == NO_TAG) {
760 return execError("%s does not return a value", sym->name);
761 }
762 @@ -2172,47 +2469,51 @@ static int callSubroutine(void)
763 ** Push all of the required information to resume, and make space on the
764 ** stack for local variables (and initialize them), on top of the argument
765 ** values which are already there.
766 */
767 if (sym->type == MACRO_FUNCTION_SYM) {
768 + PUSH_CHECK(5 + !haveNamedArgs);
769 +
770 prog = sym->value.val.prog;
772 + if (!haveNamedArgs)
773 + *(StackP++) = noValue; /* push dummy named arg array */
774 +
775 prog->refcount++;
776 StackP->tag = NO_TAG; /* prog */
777 StackP->val.prog = prog;
778 StackP++;
780 - StackP->tag = NO_TAG; /* return PC */
781 - StackP->val.inst = PC;
782 - StackP++;
783 -
784 - StackP->tag = NO_TAG; /* old FrameP */
785 - StackP->val.dataval = FrameP;
786 - StackP++;
787 -
788 - StackP->tag = NO_TAG;
789 - StackP->val.sym = prog->localSymList; /* symbol table */
790 - StackP++;
791 -
792 - StackP->tag = STRING_TAG;
793 - StackP->val.str.rep = sym->name; /* function name */
794 - StackP->val.str.len = strlen(sym->name);
795 - StackP++;
796 -
797 - StackP->tag = NO_TAG; /* nArgs */
798 - StackP->val.n = nArgs;
799 - StackP++;
800 -
801 - *(StackP++) = noValue; /* cached arg array */
802 -
803 - FrameP = StackP;
804 - PC = prog->code;
805 - for (s = prog->localSymList; s != NULL; s = s->next) {
806 - FP_GET_SYM_VAL(FrameP, s) = noValue;
807 - StackP++;
808 - }
809 - return STAT_OK;
810 + StackP->tag = NO_TAG; /* return PC */
811 + StackP->val.inst = PC;
812 + StackP++;
813 +
814 + StackP->tag = NO_TAG; /* old FrameP */
815 + StackP->val.dataval = FrameP;
816 + StackP++;
817 +
818 + StackP->tag = NO_TAG;
819 + StackP->val.sym = prog->localSymList; /* symbol table */
820 + StackP++;
821 +
822 + StackP->tag = STRING_TAG;
823 + StackP->val.str.rep = sym->name; /* function name */
824 + StackP->val.str.len = strlen(sym->name);
825 + StackP++;
826 +
827 + StackP->tag = NO_TAG; /* nArgs */
828 + StackP->val.n = nArgs;
829 + StackP++;
830 +
831 + FrameP = StackP;
832 + PC = prog->code;
833 + for (s = prog->localSymList; s != NULL; s = s->next) {
834 + PUSH_CHECK(1);
835 + FP_GET_SYM_VAL(FrameP, s) = noValue;
836 + StackP++;
837 + }
838 + return STAT_OK;
839 }
841 /*
842 ** Call an action routine
843 */
844 @@ -2220,11 +2521,17 @@ static int callSubroutine(void)
845 String *argList;
846 Cardinal numArgs = nArgs;
847 XKeyEvent key_event;
848 Display *disp;
849 Window win;
850 -
851 +
852 + if (haveNamedArgs) {
853 + return execError(
854 + "%s action routine called with named argument array",
855 + sym->name);
856 + }
857 +
858 /* Create a fake event with a timestamp suitable for actions which need
859 timestamps, a marker to indicate that the call was from a macro
860 (to stop shell commands from putting up their own separate banner) */
861 disp=XtDisplay(InitiatingWindow->shell);
862 win=XtWindow(InitiatingWindow->shell);
863 @@ -2281,11 +2588,11 @@ static int returnVal(void)
864 }
866 /*
867 ** Return from a subroutine call
868 ** Before: Prog-> [next], ...
869 -** TheStack-> retVal?, ...(FP), argArray, nArgs, oldFP, retPC, argN-arg1, next, ...
870 +** TheStack-> retVal?, ...(FP), nArgs, oldFP, retPC, argArray, argN-arg1, next, ...
871 ** After: Prog-> next, ..., (in caller)[FETCH_RET_VAL?], ...
872 ** TheStack-> retVal?, next, ...
873 */
874 static int returnValOrNone(int valOnStack)
875 {
876 @@ -2364,38 +2671,30 @@ static int branch(void)
877 ** After: either: Prog-> branchDest, [next], ...
878 ** After: or: Prog-> branchDest, next, ..., (branchdest)[next]
879 */
880 static int branchTrue(void)
881 {
882 - int value;
883 - Inst *addr;
884 -
885 - DISASM_RT(PC-1, 2);
886 - STACKDUMP(1, 3);
887 -
888 - POP_INT(value);
889 - addr = PC + PC->value;
890 - PC++;
891 -
892 - if (value)
893 - PC = addr;
894 - return STAT_OK;
895 + return branchIf(True);
896 }
897 static int branchFalse(void)
898 {
899 + return branchIf(False);
900 +}
901 +static int branchIf(Boolean trueOrFalse)
902 +{
903 int value;
904 Inst *addr;
905 -
906 +
907 DISASM_RT(PC-1, 2);
908 STACKDUMP(1, 3);
910 POP_INT(value);
911 addr = PC + PC->value;
912 PC++;
913 -
914 - if (!value)
915 - PC = addr;
916 +
917 + if (!value == !trueOrFalse)
918 + PC = addr;
919 return STAT_OK;
920 }
922 /*
923 ** Ignore the address following the instruction and continue. Why? So
924 @@ -3371,11 +3670,18 @@ static void disasmInternal(Inst *inst, i
925 else if (j == OP_CONCAT) {
926 printd("nExpr=%d", inst[i+1].value);
927 ++i;
928 }
929 else if (j == OP_SUBR_CALL) {
930 - printd("%s (%d arg)", inst[i+1].sym->name, inst[i+2].value);
931 + int args = inst[i+2].value;
932 + printd("%s ", inst[i+1].sym->name);
933 + if (args < 0) {
934 + printd("%d+args[] (%d)", -args - 1, args);
935 + }
936 + else {
937 + printd("%d args", args);
938 + }
939 i += 2;
940 }
941 else if (j == OP_BEGIN_ARRAY_ITER) {
942 printd("%s in", inst[i+1].sym->name);
943 ++i;
944 @@ -3385,12 +3691,16 @@ static void disasmInternal(Inst *inst, i
945 inst[i+1].sym->name,
946 inst[i+2].sym->name,
947 inst[i+3].value, &inst[i+3] + inst[i+3].value);
948 i += 3;
949 }
950 - else if (j == OP_ARRAY_REF || j == OP_ARRAY_DELETE ||
951 - j == OP_ARRAY_ASSIGN) {
952 + else if (j == OP_ARRAY_REF ||
953 + j == OP_ARRAY_DELETE ||
954 + j == OP_ARRAY_ASSIGN ||
955 + j == OP_ANONARRAY_INDEX_VAL ||
956 + j == OP_NAMED_ARG1 ||
957 + j == OP_NAMED_ARGN) {
958 printd("nDim=%d", inst[i+1].value);
959 ++i;
960 }
961 else if (j == OP_ARRAY_REF_ASSIGN_SETUP) {
962 printd("binOp=%s ", inst[i+1].value ? "true" : "false");
963 @@ -3422,11 +3732,11 @@ static void disasm(Inst *inst, int nInst
964 outPrintd();
965 }
966 #endif /* #ifdef DEBUG_DISASSEMBLER */
968 #ifdef DEBUG_STACK /* for run-time stack dumping */
969 -#define STACK_DUMP_ARG_PREFIX "Arg"
970 +#define STACK_DUMP_ARG_PREFIX " $"
971 static void stackdumpframe(DataValue *arrow, DataValue *outpt, DataValue *fp,
972 DataValue *sp, char topMark)
973 {
974 DataValue *baseF = &FP_GET_ITEM(fp, FP_OLD_FP_INDEX);
975 DataValue *oldFP = baseF ? baseF->val.dataval : NULL;
976 @@ -3479,17 +3789,17 @@ static void stackdumpframe(DataValue *ar
977 (dv == arg1) ? "----" :
978 (dv == fnNm) ? "====" : "";
979 printd("%4.4s", leadIn);
980 printd("%8p%c", dv, topMark);
981 switch (offset) {
982 - case FP_ARG_ARRAY_INDEX: pos = "args[]"; break; /* argument array */
983 case FP_ARG_COUNT_INDEX: pos = "NArgs"; break; /* num. arguments */
984 case FP_FUNCTION_NAME: pos = "FnName"; break;
985 case FP_SYMBOL_TABLE: pos = "FnSyms"; break;
986 case FP_OLD_FP_INDEX: pos = "OldFP"; break;
987 case FP_RET_PC_INDEX: pos = "RetPC"; break;
988 case FP_PROG_INDEX: pos = "Prog"; break;
989 + case FP_ARG_ARRAY_INDEX: pos = "args[]"; break; /* argument array */
990 default:
991 if (offset < -FP_TO_ARGS_DIST &&
992 offset >= -FP_TO_ARGS_DIST - nArgs)
993 {
994 sprintf(pos = buffer, STACK_DUMP_ARG_PREFIX "%d",
995 diff --quilt old/source/parse.y new/source/parse.y
996 --- old/source/parse.y
997 +++ new/source/parse.y
998 @@ -93,11 +93,11 @@ static int nextSymIsField = 0;
999 %token <sym> STRING SYMBOL FIELD
1000 %token <num> NUMBER
1001 %token DELETE ARG_LOOKUP
1002 %token IF WHILE DO ELSE FOR BREAK CONTINUE RETURN
1003 %token <acc> DEFINE
1004 -%type <num> arglistopt arglist catlist
1005 +%type <num> arglistopt arglist catlist fnarglsopt fnarglist fnarg
1006 %type <inst> cond comastmts comastmtlst for while do else and or arrayexpr mark
1007 %type <sym> evalsym
1008 %type <oper> operassign incrdecr
1009 %token <oper> '=' ADDEQ SUBEQ MULEQ DIVEQ MODEQ ANDEQ OREQ
1010 %token <oper> INCR DECR
1011 @@ -315,11 +315,11 @@ simpstmt: /* simple variable assignmen
1012 ADD_OP(OP_ARRAY_REF_ASSIGN_SETUP); ADD_IMMED(0); ADD_IMMED(1);
1013 ADD_OP($1);
1014 ADD_OP(OP_ARRAY_ASSIGN); ADD_IMMED(1);
1015 }
1016 /* function call */
1017 - | SYMBOL '(' arglistopt ')' {
1018 + | SYMBOL '(' fnarglsopt ')' {
1019 ADD_OP(OP_SUBR_CALL);
1020 ADD_SYM(PromoteToGlobal($1)); ADD_IMMED($3);
1021 }
1022 ;
1024 @@ -341,10 +341,63 @@ arglist: blank expr bla
1025 | arglist ',' blank expr blank { $$ = $1 + 1; }
1026 ;
1027 catlist: numexpr %prec CONCAT { $$ = 1; }
1028 | catlist numexpr %prec CONCAT { $$ = $1 + 1; }
1029 ;
1030 +fnarg: expr {
1031 + $$ = 0;
1032 + }
1033 + | '[' arglist ']' '=' expr {
1034 + $$ = $2; /* how many index elements to read? */
1035 + }
1036 + | dot field '=' expr {
1037 + $$ = 1; /* how many index elements to read? */
1038 + }
1039 + ;
1040 +fnarglsopt: blank { $$ = 0; }
1041 + | fnarglist { $$ = $1; }
1042 + ;
1043 +fnarglist: blank fnarg blank {
1044 + if ($2 > 0) {
1045 + /* named argument code already knows about index length (see
1046 + rule for arg: above); it needs to be assembled into an
1047 + array, which must be created. */
1048 + ADD_OP(OP_NAMED_ARG1); ADD_IMMED($2);
1049 + $$ = -1; /* negative single arg for named arg array */
1050 + }
1051 + else {
1052 + /* a normal positional argument - leave value on stack */
1053 + $$ = 1;
1054 + }
1055 + }
1056 + | fnarglist ',' blank fnarg blank {
1057 + if ($4 > 0) {
1058 + /* named arg: $4 == how many indices to process */
1059 + if ($1 >= 0) {
1060 + /* first named arg: create the array */
1061 + ADD_OP(OP_NAMED_ARG1); ADD_IMMED($4);
1062 + $$ = -($1 + 1); /* make arg count negative */
1063 + }
1064 + else {
1065 + /* another named arg: add to array */
1066 + ADD_OP(OP_NAMED_ARGN); ADD_IMMED($4);
1067 + $$ = $1; /* no new positional args */
1068 + }
1069 + }
1070 + else {
1071 + /* positional arg */
1072 + if ($1 < 0) {
1073 + ADD_OP(OP_SWAP_TOP2); /* keep arg array as last */
1074 + $$ = $1 - 1;
1075 + }
1076 + else {
1077 + $$ = $1 + 1; /* no named args yet */
1078 + }
1079 + }
1080 + }
1081 + ;
1082 +
1083 expr: catlist {
1084 if ($1 > 1) {
1085 ADD_OP(OP_CONCAT); ADD_IMMED($1);
1086 }
1087 }
1088 @@ -380,21 +433,58 @@ field: FIELD {
1089 ;
1090 arrayexpr: numexpr {
1091 $$ = GetPC();
1092 }
1093 ;
1094 + /* anonymous arrays eg: array = { , "hi", .a=2, ["b"]="three" } */
1095 +arrconstr0: '{' {
1096 + /* create an empty array into which to add things */
1097 + ADD_OP(OP_ANONARRAY_OPEN);
1098 + }
1099 + ;
1100 +arrconstr: arrconstr0 arrlistopt '}' {
1101 + /* we're done: the array is complete */
1102 + ADD_OP(OP_ANONARRAY_CLOSE);
1103 + }
1104 + ;
1105 +arrlistopt: arrlist
1106 + ;
1107 +arrlist: arrentry
1108 + | arrlist ',' arrentry
1109 + ;
1110 +arrentry: blank {
1111 + /* missing entry will skip an index value */
1112 + ADD_OP(OP_ANONARRAY_SKIP);
1113 + }
1114 + | blank expr blank {
1115 + /* make a suitable index >= 0 and add expr there */
1116 + ADD_OP(OP_ANONARRAY_NEXT_VAL);
1117 + }
1118 + | blank '[' arglist ']' blank '=' blank expr blank {
1119 + /* build the index from arglistopt and add expr there */
1120 + ADD_OP(OP_ANONARRAY_INDEX_VAL);
1121 + ADD_IMMED($3);
1122 + }
1123 + | blank dot field blank '=' blank expr blank {
1124 + /* build the index from arglistopt and add expr there */
1125 + ADD_OP(OP_ANONARRAY_INDEX_VAL);
1126 + ADD_IMMED(1);
1127 + }
1128 + ;
1129 numexpr: '(' blank expr blank ')'
1130 | NUMBER { ADD_OP(OP_PUSH_IMMED); ADD_IMMED($1); }
1131 | STRING { ADD_OP(OP_PUSH_SYM); ADD_SYM($1); }
1132 | SYMBOL { ADD_OP(OP_PUSH_SYM); ADD_SYM($1); }
1133 - | SYMBOL '(' arglistopt ')' {
1134 + | SYMBOL '(' fnarglsopt ')' {
1135 ADD_OP(OP_SUBR_CALL);
1136 ADD_SYM(PromoteToGlobal($1)); ADD_IMMED($3);
1137 ADD_OP(OP_FETCH_RET_VAL);
1138 }
1139 + /*
1140 | ARG_LOOKUP '[' blank numexpr blank ']' { ADD_OP(OP_PUSH_ARG); }
1141 | ARG_LOOKUP '[' blank ']' { ADD_OP(OP_PUSH_ARG_COUNT); }
1142 + */
1143 | ARG_LOOKUP { ADD_OP(OP_PUSH_ARG_ARRAY); }
1144 | numexpr '[' arglistopt ']' {
1145 ADD_OP(OP_ARRAY_REF); ADD_IMMED($3);
1146 }
1147 | numexpr dot field {
1148 @@ -472,10 +562,11 @@ or: OR {
1149 }
1150 ;
1151 dot: '.' %prec '.' {
1152 nextSymIsField = 1;
1153 }
1154 + | arrconstr
1155 ;
1156 blank: /* nothing */
1157 | blank '\n'
1158 ;
1160 diff --quilt old/source/ops.h new/source/ops.h
1161 --- old/source/ops.h
1162 +++ new/source/ops.h
1163 @@ -45,5 +45,13 @@ OP(ARRAY_DELETE, deleteArrayEl
1164 OP(PUSH_ARRAY_SYM, pushArraySymVal) /*s,i*/ /* if i: s.v=ary()), push(s.v) */
1165 OP(ARRAY_REF_ASSIGN_SETUP, arrayRefAndAssignSetup) /*op,N*/ /* pop(v,kN..a), a[k1..kN] op= v */
1166 OP(PUSH_ARG, pushArgVal) /* pop(num), push($num) */
1167 OP(PUSH_ARG_COUNT, pushArgCount) /* push($n_args) */
1168 OP(PUSH_ARG_ARRAY, pushArgArray) /* push($args) */
1169 +OP(ANONARRAY_OPEN, anonArrayOpen) /* push(0), push(ary()) */
1170 +OP(ANONARRAY_SKIP, anonArraySkip) /* pop(a,n), push(n+1,a) */
1171 +OP(ANONARRAY_NEXT_VAL, anonArrayNextVal) /* pop(v,a,n); a[n++]=v, push(n,a) */
1172 +OP(ANONARRAY_INDEX_VAL, anonArrayIndexVal) /*N*/ /* pop(v,kN..k1,a,n), a[k1..kN]=v, push(isNum(k1)?num(k1)+1:n,a) */
1173 +OP(ANONARRAY_CLOSE, anonArrayClose) /* pop(a,n), push(a) */
1174 +OP(NAMED_ARG1, namedArg1) /* N */ /* pop(v,kN..k1), a=ary(), a[k1..kN]=v, push(a) */
1175 +OP(NAMED_ARGN, namedArgN) /* N */ /* pop(v,kN..k1,a), a[k1..kN]=v, push(a) */
1176 +OP(SWAP_TOP2, swapTop2) /* pop(v1,v2), push(v1,v2) */