Improve error reporting (but it's mostly untested).
[pspp] / src / language / lexer / macro.c
1 /* PSPP - a program for statistical analysis.
2    Copyright (C) 2021 Free Software Foundation, Inc.
3
4    This program is free software: you can redistribute it and/or modify
5    it under the terms of the GNU General Public License as published by
6    the Free Software Foundation, either version 3 of the License, or
7    (at your option) any later version.
8
9    This program is distributed in the hope that it will be useful,
10    but WITHOUT ANY WARRANTY; without even the implied warranty of
11    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12    GNU General Public License for more details.
13
14    You should have received a copy of the GNU General Public License
15    along with this program.  If not, see <http://www.gnu.org/licenses/>. */
16
17 #include <config.h>
18
19 #include "language/lexer/macro.h"
20
21 #include <errno.h>
22 #include <limits.h>
23 #include <stdlib.h>
24
25 #include "data/settings.h"
26 #include "language/lexer/segment.h"
27 #include "language/lexer/scan.h"
28 #include "libpspp/assertion.h"
29 #include "libpspp/cast.h"
30 #include "libpspp/i18n.h"
31 #include "libpspp/message.h"
32 #include "libpspp/str.h"
33 #include "libpspp/string-array.h"
34 #include "libpspp/string-map.h"
35 #include "libpspp/stringi-set.h"
36
37 #include "gl/c-ctype.h"
38 #include "gl/ftoastr.h"
39
40 #include "gettext.h"
41 #define _(msgid) gettext (msgid)
42
43 void
44 macro_token_copy (struct macro_token *dst, const struct macro_token *src)
45 {
46   token_copy (&dst->token, &src->token);
47   ss_alloc_substring (&dst->representation, src->representation);
48 }
49
50 void
51 macro_token_uninit (struct macro_token *mt)
52 {
53   token_uninit (&mt->token);
54   ss_dealloc (&mt->representation);
55 }
56
57 void
58 macro_token_to_representation (struct macro_token *mt, struct string *s)
59 {
60   ds_put_substring (s, mt->representation);
61 }
62
63 bool
64 is_macro_keyword (struct substring s)
65 {
66   static struct stringi_set keywords = STRINGI_SET_INITIALIZER (keywords);
67   if (stringi_set_is_empty (&keywords))
68     {
69       static const char *kws[] = {
70         "BREAK",
71         "CHAREND",
72         "CMDEND",
73         "DEFAULT",
74         "DO",
75         "DOEND",
76         "ELSE",
77         "ENCLOSE",
78         "ENDDEFINE",
79         "IF",
80         "IFEND",
81         "IN",
82         "LET",
83         "NOEXPAND",
84         "OFFEXPAND",
85         "ONEXPAND",
86         "POSITIONAL",
87         "THEN",
88         "TOKENS",
89       };
90       for (size_t i = 0; i < sizeof kws / sizeof *kws; i++)
91         stringi_set_insert (&keywords, kws[i]);
92     }
93
94   ss_ltrim (&s, ss_cstr ("!"));
95   return stringi_set_contains_len (&keywords, s.string, s.length);
96 }
97
98 void
99 macro_tokens_copy (struct macro_tokens *dst, const struct macro_tokens *src)
100 {
101   *dst = (struct macro_tokens) {
102     .mts = xmalloc (src->n * sizeof *dst->mts),
103     .n = src->n,
104     .allocated = src->n,
105   };
106   for (size_t i = 0; i < src->n; i++)
107     macro_token_copy (&dst->mts[i], &src->mts[i]);
108 }
109
110 void
111 macro_tokens_uninit (struct macro_tokens *mts)
112 {
113   for (size_t i = 0; i < mts->n; i++)
114     macro_token_uninit (&mts->mts[i]);
115   free (mts->mts);
116 }
117
118 struct macro_token *
119 macro_tokens_add_uninit (struct macro_tokens *mts)
120 {
121   if (mts->n >= mts->allocated)
122     mts->mts = x2nrealloc (mts->mts, &mts->allocated, sizeof *mts->mts);
123   return &mts->mts[mts->n++];
124 }
125
126 void
127 macro_tokens_add (struct macro_tokens *mts, const struct macro_token *mt)
128 {
129   macro_token_copy (macro_tokens_add_uninit (mts), mt);
130 }
131
132 void
133 macro_tokens_from_string (struct macro_tokens *mts, const struct substring src,
134                           enum segmenter_mode mode)
135 {
136   struct state
137     {
138       struct segmenter segmenter;
139       struct substring body;
140     };
141
142   struct state state = {
143     .segmenter = segmenter_init (mode, true),
144     .body = src,
145   };
146   struct state saved = state;
147
148   while (state.body.length > 0)
149     {
150       struct macro_token mt = {
151         .token = { .type = T_STOP },
152         .representation = { .string = state.body.string },
153       };
154       struct token *token = &mt.token;
155
156       struct scanner scanner;
157       scanner_init (&scanner, token);
158
159       for (;;)
160         {
161           enum segment_type type;
162           int seg_len = segmenter_push (&state.segmenter, state.body.string,
163                                         state.body.length, true, &type);
164           assert (seg_len >= 0);
165
166           struct substring segment = ss_head (state.body, seg_len);
167           ss_advance (&state.body, seg_len);
168
169           enum scan_result result = scanner_push (&scanner, type, segment, token);
170           if (result == SCAN_SAVE)
171             saved = state;
172           else if (result == SCAN_BACK)
173             {
174               state = saved;
175               break;
176             }
177           else if (result == SCAN_DONE)
178             break;
179         }
180
181       /* We have a token in 'token'. */
182       if (is_scan_type (token->type))
183         {
184           if (token->type != SCAN_SKIP)
185             {
186               printf ("error\n");
187               /* XXX report error */
188             }
189         }
190       else
191         {
192           mt.representation.length = state.body.string - mt.representation.string;
193           macro_tokens_add (mts, &mt);
194         }
195       token_uninit (token);
196     }
197 }
198
199 void
200 macro_tokens_print (const struct macro_tokens *mts, FILE *stream)
201 {
202   for (size_t i = 0; i < mts->n; i++)
203     token_print (&mts->mts[i].token, stream);
204 }
205
206 enum token_class
207   {
208     TC_ENDCMD,                  /* No space before or after (new-line after). */
209     TC_BINOP,                   /* Space on both sides. */
210     TC_COMMA,                   /* Space afterward. */
211     TC_ID,                      /* Don't need spaces except sequentially. */
212     TC_PUNCT,                   /* Don't need spaces except sequentially. */
213   };
214
215 static bool
216 needs_space (enum token_class prev, enum token_class next)
217 {
218   /* Don't need a space before or after the end of a command.
219      (A new-line is needed afterward as a special case.) */
220   if (prev == TC_ENDCMD || next == TC_ENDCMD)
221     return false;
222
223   /* Binary operators always have a space on both sides. */
224   if (prev == TC_BINOP || next == TC_BINOP)
225     return true;
226
227   /* A comma always has a space afterward. */
228   if (prev == TC_COMMA)
229     return true;
230
231   /* Otherwise, PREV is TC_ID or TC_PUNCT, which only need a space if there are
232      two or them in a row. */
233   return prev == next;
234 }
235
236 static enum token_class
237 classify_token (enum token_type type)
238 {
239   switch (type)
240     {
241     case T_ID:
242     case T_MACRO_ID:
243     case T_POS_NUM:
244     case T_NEG_NUM:
245     case T_STRING:
246       return TC_ID;
247
248     case T_STOP:
249       return TC_PUNCT;
250
251     case T_ENDCMD:
252       return TC_ENDCMD;
253
254     case T_LPAREN:
255     case T_RPAREN:
256     case T_LBRACK:
257     case T_RBRACK:
258       return TC_PUNCT;
259
260     case T_PLUS:
261     case T_DASH:
262     case T_ASTERISK:
263     case T_SLASH:
264     case T_EQUALS:
265     case T_AND:
266     case T_OR:
267     case T_NOT:
268     case T_EQ:
269     case T_GE:
270     case T_GT:
271     case T_LE:
272     case T_LT:
273     case T_NE:
274     case T_ALL:
275     case T_BY:
276     case T_TO:
277     case T_WITH:
278     case T_EXP:
279     case T_MACRO_PUNCT:
280       return TC_BINOP;
281
282     case T_COMMA:
283       return TC_COMMA;
284     }
285
286   NOT_REACHED ();
287 }
288
289 void
290 macro_tokens_to_representation (struct macro_tokens *mts, struct string *s,
291                                 size_t *ofs, size_t *len)
292 {
293   assert ((ofs != NULL) == (len != NULL));
294
295   if (!mts->n)
296     return;
297
298   for (size_t i = 0; i < mts->n; i++)
299     {
300       if (i > 0)
301         {
302           enum token_type prev = mts->mts[i - 1].token.type;
303           enum token_type next = mts->mts[i].token.type;
304
305           if (prev == T_ENDCMD)
306             ds_put_byte (s, '\n');
307           else
308             {
309               enum token_class pc = classify_token (prev);
310               enum token_class nc = classify_token (next);
311               if (needs_space (pc, nc))
312                 ds_put_byte (s, ' ');
313             }
314         }
315
316       if (ofs)
317         ofs[i] = s->ss.length;
318       macro_token_to_representation (&mts->mts[i], s);
319       if (len)
320         len[i] = s->ss.length - ofs[i];
321     }
322 }
323
324 void
325 macro_destroy (struct macro *m)
326 {
327   if (!m)
328     return;
329
330   free (m->name);
331   free (m->file_name);
332   for (size_t i = 0; i < m->n_params; i++)
333     {
334       struct macro_param *p = &m->params[i];
335       free (p->name);
336
337       macro_tokens_uninit (&p->def);
338
339       switch (p->arg_type)
340         {
341         case ARG_N_TOKENS:
342           break;
343
344         case ARG_CHAREND:
345           token_uninit (&p->charend);
346           break;
347
348         case ARG_ENCLOSE:
349           token_uninit (&p->enclose[0]);
350           token_uninit (&p->enclose[1]);
351           break;
352
353         case ARG_CMDEND:
354           break;
355         }
356     }
357   free (m->params);
358   macro_tokens_uninit (&m->body);
359   free (m);
360 }
361 \f
362 struct macro_set *
363 macro_set_create (void)
364 {
365   struct macro_set *set = xmalloc (sizeof *set);
366   *set = (struct macro_set) {
367     .macros = HMAP_INITIALIZER (set->macros),
368   };
369   return set;
370 }
371
372 void
373 macro_set_destroy (struct macro_set *set)
374 {
375   if (!set)
376     return;
377
378   struct macro *macro, *next;
379   HMAP_FOR_EACH_SAFE (macro, next, struct macro, hmap_node, &set->macros)
380     {
381       hmap_delete (&set->macros, &macro->hmap_node);
382       macro_destroy (macro);
383     }
384   hmap_destroy (&set->macros);
385   free (set);
386 }
387
388 static unsigned int
389 hash_macro_name (const char *name)
390 {
391   return utf8_hash_case_string (name, 0);
392 }
393
394 static struct macro *
395 macro_set_find__ (struct macro_set *set, const char *name)
396 {
397   struct macro *macro;
398   HMAP_FOR_EACH_WITH_HASH (macro, struct macro, hmap_node,
399                            hash_macro_name (name), &set->macros)
400     if (!utf8_strcasecmp (macro->name, name))
401       return macro;
402
403   return NULL;
404 }
405
406 const struct macro *
407 macro_set_find (const struct macro_set *set, const char *name)
408 {
409   return macro_set_find__ (CONST_CAST (struct macro_set *, set), name);
410 }
411
412 /* Adds M to SET.  M replaces any existing macro with the same name.  Takes
413    ownership of M. */
414 void
415 macro_set_add (struct macro_set *set, struct macro *m)
416 {
417   struct macro *victim = macro_set_find__ (set, m->name);
418   if (victim)
419     {
420       hmap_delete (&set->macros, &victim->hmap_node);
421       macro_destroy (victim);
422     }
423
424   hmap_insert (&set->macros, &m->hmap_node, hash_macro_name (m->name));
425 }
426 \f
427 struct macro_expansion_stack
428   {
429     const struct macro_expansion_stack *next;
430     const char *name;
431     const char *file_name;
432     int first_line;
433     int last_line;
434   };
435
436 static void PRINTF_FORMAT (2, 3)
437 macro_error (const struct macro_expansion_stack *stack,
438              const char *format, ...)
439 {
440   struct msg_stack **ms = NULL;
441   size_t allocated_ms = 0;
442   size_t n_ms = 0;
443
444   for (const struct macro_expansion_stack *p = stack; p; p = p->next)
445     {
446       if (n_ms >= allocated_ms)
447         ms = x2nrealloc (ms, &allocated_ms, sizeof *ms);
448
449       ms[n_ms] = xmalloc (sizeof *ms[n_ms]);
450       *ms[n_ms] = (struct msg_stack) {
451         .location = {
452           .file_name = xstrdup_if_nonnull (p->file_name),
453           .first_line = p->first_line,
454           .last_line = p->last_line,
455         },
456         .description = (
457           p == stack
458           /* TRANSLATORS: These strings are used for explaining the context of
459              an error.  The "While expanding" message appears first, followed
460              by zero or more of the "inside expansion" messages, like this:
461
462              foo.sps:12: While expanding 'innermost',
463              foo.sps:23: inside expansion of 'next_inner',
464              foo.sps:34: inside expansion of 'next_inner2',
465              foo.sps:45: inside expansion of 'outermost',
466              foo.sps:76: This is the actual error message. */
467           ? xasprintf (_("While expanding \"%s\","), p->name)
468           : xasprintf (_("inside expansion of \"%s\","), p->name))
469       };
470       n_ms++;
471     }
472
473   va_list args;
474   va_start (args, format);
475
476   struct msg *m = xmalloc (sizeof *m);
477   *m = (struct msg) {
478     .category = MSG_C_SYNTAX,
479     .severity = MSG_S_ERROR,
480     .stack = ms,
481     .n_stack = n_ms,
482     .text = xvasprintf (format, args),
483   };
484   msg_emit (m);
485
486   va_end (args);
487 }
488
489 enum me_state
490   {
491     /* Error state. */
492     ME_ERROR,
493
494     /* Accumulating tokens in me->params toward the end of any type of
495        argument. */
496     ME_ARG,
497
498     /* Expecting the opening delimiter of an ARG_ENCLOSE argument. */
499     ME_ENCLOSE,
500
501     /* Expecting a keyword for a keyword argument. */
502     ME_KEYWORD,
503
504     /* Expecting an equal sign for a keyword argument. */
505     ME_EQUALS,
506   };
507
508
509 struct macro_expander
510   {
511     const struct macro_set *macros;
512
513     enum me_state state;
514     size_t n_tokens;
515
516     const struct macro *macro;
517     struct macro_tokens **args;
518     const struct macro_param *param;
519   };
520
521 static int
522 me_finished (struct macro_expander *me)
523 {
524   for (size_t i = 0; i < me->macro->n_params; i++)
525     if (!me->args[i])
526       {
527         me->args[i] = xmalloc (sizeof *me->args[i]);
528         macro_tokens_copy (me->args[i], &me->macro->params[i].def);
529       }
530   return me->n_tokens;
531 }
532
533 static int
534 me_next_arg (struct macro_expander *me)
535 {
536   if (!me->param)
537     {
538       assert (!me->macro->n_params);
539       return me_finished (me);
540     }
541   else if (me->param->positional)
542     {
543       me->param++;
544       if (me->param >= &me->macro->params[me->macro->n_params])
545         return me_finished (me);
546       else
547         {
548           me->state = (!me->param->positional ? ME_KEYWORD
549                        : me->param->arg_type == ARG_ENCLOSE ? ME_ENCLOSE
550                        : ME_ARG);
551           return 0;
552         }
553     }
554   else
555     {
556       for (size_t i = 0; i < me->macro->n_params; i++)
557         if (!me->args[i])
558           {
559             me->state = ME_KEYWORD;
560             return 0;
561           }
562       return me_finished (me);
563     }
564 }
565
566 static int
567 me_error (struct macro_expander *me)
568 {
569   me->state = ME_ERROR;
570   return -1;
571 }
572
573 static int
574 me_add_arg (struct macro_expander *me, const struct macro_token *mt)
575 {
576   const struct macro_param *p = me->param;
577
578   const struct token *token = &mt->token;
579   if ((token->type == T_ENDCMD || token->type == T_STOP)
580       && p->arg_type != ARG_CMDEND)
581     {
582       msg (SE, _("Unexpected end of command reading argument %s "
583                  "to macro %s."), me->param->name, me->macro->name);
584
585       return me_error (me);
586     }
587
588   me->n_tokens++;
589
590   struct macro_tokens **argp = &me->args[p - me->macro->params];
591   if (!*argp)
592     *argp = xzalloc (sizeof **argp);
593   struct macro_tokens *arg = *argp;
594   if (p->arg_type == ARG_N_TOKENS)
595     {
596       macro_tokens_add (arg, mt);
597       if (arg->n >= p->n_tokens)
598         return me_next_arg (me);
599       return 0;
600     }
601   else if (p->arg_type == ARG_CMDEND)
602     {
603       if (token->type == T_ENDCMD || token->type == T_STOP)
604         return me_next_arg (me);
605       macro_tokens_add (arg, mt);
606       return 0;
607     }
608   else
609     {
610       const struct token *end
611         = p->arg_type == ARG_CHAREND ? &p->charend : &p->enclose[1];
612       if (token_equal (token, end))
613         return me_next_arg (me);
614       macro_tokens_add (arg, mt);
615       return 0;
616     }
617 }
618
619 static int
620 me_expected (struct macro_expander *me, const struct macro_token *actual,
621              const struct token *expected)
622 {
623   const struct substring actual_s
624     = (actual->representation.length ? actual->representation
625        : ss_cstr (_("<end of input>")));
626   char *expected_s = token_to_string (expected);
627   msg (SE, _("Found `%.*s' while expecting `%s' reading argument %s "
628              "to macro %s."),
629        (int) actual_s.length, actual_s.string, expected_s,
630        me->param->name, me->macro->name);
631   free (expected_s);
632
633   return me_error (me);
634 }
635
636 static int
637 me_enclose (struct macro_expander *me, const struct macro_token *mt)
638 {
639   const struct token *token = &mt->token;
640   me->n_tokens++;
641
642   if (token_equal (&me->param->enclose[0], token))
643     {
644       me->state = ME_ARG;
645       return 0;
646     }
647
648   return me_expected (me, mt, &me->param->enclose[0]);
649 }
650
651 static const struct macro_param *
652 macro_find_parameter_by_name (const struct macro *m, struct substring name)
653 {
654   ss_ltrim (&name, ss_cstr ("!"));
655
656   for (size_t i = 0; i < m->n_params; i++)
657     {
658       const struct macro_param *p = &m->params[i];
659       struct substring p_name = ss_cstr (p->name + 1);
660       if (!utf8_strncasecmp (p_name.string, p_name.length,
661                              name.string, name.length))
662         return p;
663     }
664   return NULL;
665 }
666
667 static int
668 me_keyword (struct macro_expander *me, const struct macro_token *mt)
669 {
670   const struct token *token = &mt->token;
671   if (token->type != T_ID)
672     return me_finished (me);
673
674   const struct macro_param *p = macro_find_parameter_by_name (me->macro,
675                                                               token->string);
676   if (p)
677     {
678       size_t arg_index = p - me->macro->params;
679       me->param = p;
680       if (me->args[arg_index])
681         {
682           msg (SE,
683                _("Argument %s multiply specified in call to macro %s."),
684                p->name, me->macro->name);
685           return me_error (me);
686         }
687
688       me->n_tokens++;
689       me->state = ME_EQUALS;
690       return 0;
691     }
692
693   return me_finished (me);
694 }
695
696 static int
697 me_equals (struct macro_expander *me, const struct macro_token *mt)
698 {
699   const struct token *token = &mt->token;
700   me->n_tokens++;
701
702   if (token->type == T_EQUALS)
703     {
704       me->state = ME_ARG;
705       return 0;
706     }
707
708   return me_expected (me, mt, &(struct token) { .type = T_EQUALS });
709 }
710
711 int
712 macro_expander_create (const struct macro_set *macros,
713                        const struct token *token,
714                        struct macro_expander **mep)
715 {
716   *mep = NULL;
717   if (macro_set_is_empty (macros))
718     return -1;
719   if (token->type != T_ID && token->type != T_MACRO_ID)
720     return -1;
721
722   const struct macro *macro = macro_set_find (macros, token->string.string);
723   if (!macro)
724     return -1;
725
726   struct macro_expander *me = xmalloc (sizeof *me);
727   *me = (struct macro_expander) {
728     .macros = macros,
729     .n_tokens = 1,
730     .macro = macro,
731   };
732   *mep = me;
733
734   if (!macro->n_params)
735     return 1;
736   else
737     {
738       me->state = (!macro->params[0].positional ? ME_KEYWORD
739                    : macro->params[0].arg_type == ARG_ENCLOSE ? ME_ENCLOSE
740                    : ME_ARG);
741       me->args = xcalloc (macro->n_params, sizeof *me->args);
742       me->param = macro->params;
743       return 0;
744     }
745 }
746
747 void
748 macro_expander_destroy (struct macro_expander *me)
749 {
750   if (!me)
751     return;
752
753   for (size_t i = 0; i < me->macro->n_params; i++)
754     if (me->args[i])
755       {
756         macro_tokens_uninit (me->args[i]);
757         free (me->args[i]);
758       }
759   free (me->args);
760   free (me);
761 }
762
763 /* Adds TOKEN to the collection of tokens in ME that potentially need to be
764    macro expanded.
765
766    Returns -1 if the tokens added do not actually invoke a macro.  The caller
767    should consume the first token without expanding it.
768
769    Returns 0 if the macro expander needs more tokens, for macro arguments or to
770    decide whether this is actually a macro invocation.  The caller should call
771    macro_expander_add() again with the next token.
772
773    Returns a positive number to indicate that the returned number of tokens
774    invoke a macro.  The number returned might be less than the number of tokens
775    added because it can take a few tokens of lookahead to determine whether the
776    macro invocation is finished.  The caller should call
777    macro_expander_get_expansion() to obtain the expansion. */
778 int
779 macro_expander_add (struct macro_expander *me, const struct macro_token *mt)
780 {
781   switch (me->state)
782     {
783     case ME_ERROR:
784       return -1;
785
786     case ME_ARG:
787       return me_add_arg (me, mt);
788
789     case ME_ENCLOSE:
790       return me_enclose (me, mt);
791
792     case ME_KEYWORD:
793       return me_keyword (me, mt);
794
795     case ME_EQUALS:
796       return me_equals (me, mt);
797
798     default:
799       NOT_REACHED ();
800     }
801 }
802
803 /* Each argument to a macro function is one of:
804
805        - A quoted string or other single literal token.
806
807        - An argument to the macro being expanded, e.g. !1 or a named argument.
808
809        - !*.
810
811        - A function invocation.
812
813    Each function invocation yields a character sequence to be turned into a
814    sequence of tokens.  The case where that character sequence is a single
815    quoted string is an important special case.
816 */
817 struct parse_macro_function_ctx
818   {
819     const struct macro_token *input;
820     size_t n_input;
821     int nesting_countdown;
822     const struct macro_set *macros;
823     const struct macro_expander *me;
824     const struct macro_expansion_stack *stack;
825     struct string_map *vars;
826     bool *expand;
827   };
828
829 static void
830 macro_expand (const struct macro_tokens *,
831               int nesting_countdown, const struct macro_set *,
832               const struct macro_expander *, struct string_map *vars,
833               const struct macro_expansion_stack *stack,
834               bool *expand, bool *break_,
835               struct macro_tokens *exp);
836
837 static bool
838 expand_macro_function (struct parse_macro_function_ctx *ctx,
839                        struct string *output, size_t *input_consumed);
840
841 /* Returns true if the pair of tokens starting at offset OFS within MTS are !*,
842    false otherwise. */
843 static bool
844 is_bang_star (const struct macro_token *mts, size_t n, size_t ofs)
845 {
846   return (ofs + 1 < n
847           && mts[ofs].token.type == T_MACRO_ID
848           && ss_equals (mts[ofs].token.string, ss_cstr ("!"))
849           && mts[ofs + 1].token.type == T_ASTERISK);
850 }
851
852 static size_t
853 parse_function_arg (struct parse_macro_function_ctx *ctx,
854                     size_t i, struct string *farg)
855 {
856   const struct macro_token *tokens = ctx->input;
857   const struct token *token = &tokens[i].token;
858   if (token->type == T_MACRO_ID)
859     {
860       const struct macro_param *param = macro_find_parameter_by_name (
861         ctx->me->macro, token->string);
862       if (param)
863         {
864           size_t param_idx = param - ctx->me->macro->params;
865           const struct macro_tokens *marg = ctx->me->args[param_idx];
866           for (size_t i = 0; i < marg->n; i++)
867             {
868               if (i)
869                 ds_put_byte (farg, ' ');
870               ds_put_substring (farg, marg->mts[i].representation);
871             }
872           return 1;
873         }
874
875       if (is_bang_star (ctx->input, ctx->n_input, i))
876         {
877           for (size_t i = 0; i < ctx->me->macro->n_params; i++)
878             {
879               if (!ctx->me->macro->params[i].positional)
880                 break;
881
882               const struct macro_tokens *marg = ctx->me->args[i];
883               for (size_t j = 0; j < marg->n; j++)
884                 {
885                   if (i || j)
886                     ds_put_byte (farg, ' ');
887                   ds_put_substring (farg, marg->mts[j].representation);
888                 }
889             }
890           return 2;
891         }
892
893       if (ctx->vars)
894         {
895           const char *value = string_map_find__ (ctx->vars,
896                                                  token->string.string,
897                                                  token->string.length);
898           if (value)
899             {
900               ds_put_cstr (farg, value);
901               return 1;
902             }
903         }
904
905       struct parse_macro_function_ctx subctx = {
906         .input = &ctx->input[i],
907         .n_input = ctx->n_input - i,
908         .nesting_countdown = ctx->nesting_countdown,
909         .macros = ctx->macros,
910         .me = ctx->me,
911         .stack = ctx->stack,
912         .vars = ctx->vars,
913         .expand = ctx->expand,
914       };
915       size_t subinput_consumed;
916       if (expand_macro_function (&subctx, farg, &subinput_consumed))
917         return subinput_consumed;
918     }
919
920   ds_put_substring (farg, tokens[i].representation);
921   return 1;
922 }
923
924 static bool
925 parse_macro_function (struct parse_macro_function_ctx *ctx,
926                       struct string_array *args,
927                       struct substring function,
928                       int min_args, int max_args,
929                       size_t *input_consumed)
930 {
931   const struct macro_token *tokens = ctx->input;
932   size_t n_tokens = ctx->n_input;
933
934   if (!n_tokens
935       || tokens[0].token.type != T_MACRO_ID
936       || !ss_equals_case (tokens[0].token.string, function)) /* XXX abbrevs allowed */
937     return false;
938
939   if (n_tokens < 2 || tokens[1].token.type != T_LPAREN)
940     {
941       macro_error (ctx->stack, _("`(' expected following %s"), function.string);
942       return false;
943     }
944
945   string_array_init (args);
946
947   for (size_t i = 2;; )
948     {
949       if (i >= n_tokens)
950         goto unexpected_end;
951       if (tokens[i].token.type == T_RPAREN)
952         {
953           *input_consumed = i + 1;
954           if (args->n < min_args || args->n > max_args)
955             {
956               macro_error (ctx->stack,
957                            _("Wrong number of arguments to macro function %s."),
958                            function.string);
959               goto error;
960             }
961           return true;
962         }
963
964       struct string s = DS_EMPTY_INITIALIZER;
965       i += parse_function_arg (ctx, i, &s);
966       if (i >= n_tokens)
967         {
968           ds_destroy (&s);
969           goto unexpected_end;
970         }
971       string_array_append_nocopy (args, ds_steal_cstr (&s));
972
973       if (tokens[i].token.type == T_COMMA)
974         i++;
975       else if (tokens[i].token.type != T_RPAREN)
976         {
977           macro_error (ctx->stack,
978                        _("`,' or `)' expected in call to macro function %s."),
979                        function.string);
980           goto error;
981         }
982     }
983
984 unexpected_end:
985   macro_error (ctx->stack, _("Missing `)' in call to macro function %s."),
986                function.string);
987   /* Fall through. */
988 error:
989   string_array_destroy (args);
990   return false;
991 }
992
993 static bool
994 unquote_string (const char *s, struct string *content)
995 {
996   struct string_lexer slex;
997   string_lexer_init (&slex, s, strlen (s), SEG_MODE_INTERACTIVE /* XXX */,
998                      true);
999
1000   struct token token1;
1001   if (!string_lexer_next (&slex, &token1))
1002     return false;
1003
1004   if (token1.type != T_STRING)
1005     {
1006       token_uninit (&token1);
1007       return false;
1008     }
1009
1010   struct token token2;
1011   if (string_lexer_next (&slex, &token2))
1012     {
1013       token_uninit (&token1);
1014       token_uninit (&token2);
1015       return false;
1016     }
1017
1018   ds_put_substring (content, token1.string);
1019   token_uninit (&token1);
1020   return true;
1021 }
1022
1023 static const char *
1024 unquote_string_in_place (const char *s, struct string *tmp)
1025 {
1026   ds_init_empty (tmp);
1027   return unquote_string (s, tmp) ? ds_cstr (tmp) : s;
1028 }
1029
1030 static bool
1031 parse_integer (const char *s, int *np)
1032 {
1033   errno = 0;
1034
1035   char *tail;
1036   long int n = strtol (s, &tail, 10);
1037   *np = n < INT_MIN ? INT_MIN : n > INT_MAX ? INT_MAX : n;
1038   tail += strspn (tail, CC_SPACES);
1039   return *tail == '\0' && errno != ERANGE && n == *np;
1040 }
1041
1042 static bool
1043 expand_macro_function (struct parse_macro_function_ctx *ctx,
1044                        struct string *output,
1045                        size_t *input_consumed)
1046 {
1047   struct string_array args;
1048
1049   if (parse_macro_function (ctx, &args, ss_cstr ("!length"), 1, 1,
1050                             input_consumed))
1051     ds_put_format (output, "%zu", strlen (args.strings[0]));
1052   else if (parse_macro_function (ctx, &args, ss_cstr ("!blanks"), 1, 1,
1053                                  input_consumed))
1054     {
1055       int n;
1056       if (!parse_integer (args.strings[0], &n))
1057         {
1058           macro_error (ctx->stack,
1059                        _("Argument to !BLANKS must be non-negative integer "
1060                          "(not \"%s\")"), args.strings[0]);
1061           string_array_destroy (&args);
1062           return false;
1063         }
1064
1065       ds_put_byte_multiple (output, ' ', n);
1066     }
1067   else if (parse_macro_function (ctx, &args, ss_cstr ("!concat"), 1, INT_MAX,
1068                                  input_consumed))
1069     {
1070       for (size_t i = 0; i < args.n; i++)
1071         if (!unquote_string (args.strings[i], output))
1072           ds_put_cstr (output, args.strings[i]);
1073     }
1074   else if (parse_macro_function (ctx, &args, ss_cstr ("!head"), 1, 1,
1075                                  input_consumed))
1076     {
1077       struct string tmp;
1078       const char *s = unquote_string_in_place (args.strings[0], &tmp);
1079
1080       struct macro_tokens mts = { .n = 0 };
1081       macro_tokens_from_string (&mts, ss_cstr (s), SEG_MODE_INTERACTIVE /* XXX */);
1082       if (mts.n > 0)
1083         ds_put_substring (output, mts.mts[0].representation);
1084       macro_tokens_uninit (&mts);
1085       ds_destroy (&tmp);
1086     }
1087   else if (parse_macro_function (ctx, &args, ss_cstr ("!index"), 2, 2,
1088                                  input_consumed))
1089     {
1090       const char *haystack = args.strings[0];
1091       const char *needle = strstr (haystack, args.strings[1]);
1092       ds_put_format (output, "%zu", needle ? needle - haystack + 1 : 0);
1093     }
1094   else if (parse_macro_function (ctx, &args, ss_cstr ("!quote"), 1, 1,
1095                                  input_consumed))
1096     {
1097       if (unquote_string (args.strings[0], NULL))
1098         ds_put_cstr (output, args.strings[0]);
1099       else
1100         {
1101           ds_extend (output, strlen (args.strings[0]) + 2);
1102           ds_put_byte (output, '\'');
1103           for (const char *p = args.strings[0]; *p; p++)
1104             {
1105               if (*p == '\'')
1106                 ds_put_byte (output, '\'');
1107               ds_put_byte (output, *p);
1108             }
1109           ds_put_byte (output, '\'');
1110         }
1111     }
1112   else if (parse_macro_function (ctx, &args, ss_cstr ("!substr"), 2, 3,
1113                                  input_consumed))
1114     {
1115       int start;
1116       if (!parse_integer (args.strings[1], &start) || start < 1)
1117         {
1118           macro_error (ctx->stack, _("Second argument of !SUBSTR must be "
1119                                      "positive integer (not \"%s\")"),
1120                        args.strings[1]);
1121           string_array_destroy (&args);
1122           return false;
1123         }
1124
1125       int count = INT_MAX;
1126       if (args.n > 2 && (!parse_integer (args.strings[2], &count) || count < 0))
1127         {
1128           macro_error (ctx->stack, _("Third argument of !SUBSTR must be "
1129                                      "non-negative integer (not \"%s\")"),
1130                        args.strings[1]);
1131           string_array_destroy (&args);
1132           return false;
1133         }
1134
1135       struct substring s = ss_cstr (args.strings[0]);
1136       ds_put_substring (output, ss_substr (s, start - 1, count));
1137     }
1138   else if (parse_macro_function (ctx, &args, ss_cstr ("!tail"), 1, 1,
1139                                  input_consumed))
1140     {
1141       struct string tmp;
1142       const char *s = unquote_string_in_place (args.strings[0], &tmp);
1143
1144       struct macro_tokens mts = { .n = 0 };
1145       macro_tokens_from_string (&mts, ss_cstr (s), SEG_MODE_INTERACTIVE /* XXX */);
1146       if (mts.n > 1)
1147         {
1148           struct macro_tokens tail = { .mts = mts.mts + 1, .n = mts.n - 1 };
1149           macro_tokens_to_representation (&tail, output, NULL, NULL);
1150         }
1151       macro_tokens_uninit (&mts);
1152       ds_destroy (&tmp);
1153     }
1154   else if (parse_macro_function (ctx, &args, ss_cstr ("!unquote"), 1, 1,
1155                                  input_consumed))
1156     {
1157       if (!unquote_string (args.strings[0], output))
1158         ds_put_cstr (output, args.strings[0]);
1159     }
1160   else if (parse_macro_function (ctx, &args, ss_cstr ("!upcase"), 1, 1,
1161                                  input_consumed))
1162     {
1163       struct string tmp;
1164       const char *s = unquote_string_in_place (args.strings[0], &tmp);
1165       char *upper = utf8_to_upper (s);
1166       ds_put_cstr (output, upper);
1167       free (upper);
1168       ds_destroy (&tmp);
1169     }
1170   else if (parse_macro_function (ctx, &args, ss_cstr ("!eval"), 1, 1,
1171                                  input_consumed))
1172     {
1173       struct macro_tokens mts = { .n = 0 };
1174       macro_tokens_from_string (&mts, ss_cstr (args.strings[0]),
1175                                 SEG_MODE_INTERACTIVE /* XXX */);
1176       struct macro_tokens exp = { .n = 0 };
1177       macro_expand (&mts, ctx->nesting_countdown - 1, ctx->macros, ctx->me,
1178                     ctx->vars,
1179                     &(struct macro_expansion_stack) {
1180                       .name = "!EVAL",
1181                       .next = ctx->stack,
1182                     }, ctx->expand, NULL, &exp);
1183       macro_tokens_to_representation (&exp, output, NULL, NULL);
1184       macro_tokens_uninit (&exp);
1185       macro_tokens_uninit (&mts);
1186     }
1187   else if (ctx->n_input > 0
1188            && ctx->input[0].token.type == T_MACRO_ID
1189            && ss_equals_case (ctx->input[0].token.string, ss_cstr ("!null")))
1190     {
1191       *input_consumed = 1;
1192       return true;
1193     }
1194   else
1195     return false;
1196
1197   string_array_destroy (&args);
1198   return true;
1199 }
1200
1201 struct expr_context
1202   {
1203     int nesting_countdown;
1204     const struct macro_set *macros;
1205     const struct macro_expander *me;
1206     const struct macro_expansion_stack *stack;
1207     struct string_map *vars;
1208     bool *expand;
1209   };
1210
1211 static char *macro_evaluate_or (const struct expr_context *ctx,
1212                                 const struct macro_token **tokens,
1213                                 const struct macro_token *end);
1214
1215 static char *
1216 macro_evaluate_literal (const struct expr_context *ctx,
1217                         const struct macro_token **tokens,
1218                         const struct macro_token *end)
1219 {
1220   const struct macro_token *p = *tokens;
1221   if (p >= end)
1222     return NULL;
1223   if (p->token.type == T_LPAREN)
1224     {
1225       p++;
1226       char *value = macro_evaluate_or (ctx, &p, end);
1227       if (!value)
1228         return NULL;
1229       if (p >= end || p->token.type != T_RPAREN)
1230         {
1231           free (value);
1232           macro_error (ctx->stack, _("Expecting ')' in macro expression."));
1233           return NULL;
1234         }
1235       p++;
1236       *tokens = p;
1237       return value;
1238     }
1239
1240   struct parse_macro_function_ctx fctx = {
1241     .input = p,
1242     .n_input = end - p,
1243     .nesting_countdown = ctx->nesting_countdown,
1244     .macros = ctx->macros,
1245     .me = ctx->me,
1246     .stack = ctx->stack,
1247     .vars = ctx->vars,
1248     .expand = ctx->expand,
1249   };
1250   struct string function_output = DS_EMPTY_INITIALIZER;
1251   size_t function_consumed = parse_function_arg (&fctx, 0, &function_output);
1252   struct string unquoted = DS_EMPTY_INITIALIZER;
1253   if (unquote_string (ds_cstr (&function_output), &unquoted))
1254     {
1255       ds_swap (&function_output, &unquoted);
1256       ds_destroy (&unquoted);
1257     }
1258   *tokens = p + function_consumed;
1259   return ds_steal_cstr (&function_output);
1260 }
1261
1262 /* Returns true if MT is valid as a macro operator.  Only operators written as
1263    symbols (e.g. <>) are usable in macro expressions, not operator written as
1264    letters (e.g. EQ). */
1265 static bool
1266 is_macro_operator (const struct macro_token *mt)
1267 {
1268   return (mt->representation.length > 0
1269           && !c_isalpha (mt->representation.string[0]));
1270 }
1271
1272 static enum token_type
1273 parse_relational_op (const struct macro_token *mt)
1274 {
1275   switch (mt->token.type)
1276     {
1277     case T_EQUALS:
1278       return T_EQ;
1279
1280     case T_NE:
1281     case T_LT:
1282     case T_GT:
1283     case T_LE:
1284     case T_GE:
1285       return is_macro_operator (mt) ? mt->token.type : T_STOP;
1286
1287     case T_MACRO_ID:
1288       return (ss_equals_case (mt->token.string, ss_cstr ("!EQ")) ? T_EQ
1289               : ss_equals_case (mt->token.string, ss_cstr ("!NE")) ? T_NE
1290               : ss_equals_case (mt->token.string, ss_cstr ("!LT")) ? T_LT
1291               : ss_equals_case (mt->token.string, ss_cstr ("!GT")) ? T_GT
1292               : ss_equals_case (mt->token.string, ss_cstr ("!LE")) ? T_LE
1293               : ss_equals_case (mt->token.string, ss_cstr ("!GE")) ? T_GE
1294               : T_STOP);
1295
1296     default:
1297       return T_STOP;
1298     }
1299 }
1300
1301 static char *
1302 macro_evaluate_relational (const struct expr_context *ctx,
1303                            const struct macro_token **tokens,
1304                            const struct macro_token *end)
1305 {
1306   const struct macro_token *p = *tokens;
1307   char *lhs = macro_evaluate_literal (ctx, &p, end);
1308   if (!lhs)
1309     return NULL;
1310
1311   enum token_type op = p >= end ? T_STOP : parse_relational_op (p);
1312   if (op == T_STOP)
1313     {
1314       *tokens = p;
1315       return lhs;
1316     }
1317   p++;
1318
1319   char *rhs = macro_evaluate_literal (ctx, &p, end);
1320   if (!rhs)
1321     {
1322       free (lhs);
1323       return NULL;
1324     }
1325
1326   struct string lhs_tmp, rhs_tmp;
1327   int cmp = strcmp/*XXX*/ (unquote_string_in_place (lhs, &lhs_tmp),
1328                            unquote_string_in_place (rhs, &rhs_tmp));
1329   ds_destroy (&lhs_tmp);
1330   ds_destroy (&rhs_tmp);
1331
1332   free (lhs);
1333   free (rhs);
1334
1335   bool b = (op == T_EQUALS || op == T_EQ ? !cmp
1336             : op == T_NE ? cmp
1337             : op == T_LT ? cmp < 0
1338             : op == T_GT ? cmp > 0
1339             : op == T_LE ? cmp <= 0
1340             :/*op == T_GE*/cmp >= 0);
1341
1342   *tokens = p;
1343   return xstrdup (b ? "1" : "0");
1344 }
1345
1346 static char *
1347 macro_evaluate_not (const struct expr_context *ctx,
1348                     const struct macro_token **tokens,
1349                     const struct macro_token *end)
1350 {
1351   const struct macro_token *p = *tokens;
1352
1353   unsigned int negations = 0;
1354   while (p < end
1355          && (ss_equals_case (p->representation, ss_cstr ("!NOT"))
1356              || ss_equals (p->representation, ss_cstr ("~"))))
1357     {
1358       p++;
1359       negations++;
1360     }
1361
1362   char *operand = macro_evaluate_relational (ctx, &p, end);
1363   if (!operand || !negations)
1364     {
1365       *tokens = p;
1366       return operand;
1367     }
1368
1369   bool b = strcmp (operand, "0") ^ (negations & 1);
1370   free (operand);
1371   *tokens = p;
1372   return xstrdup (b ? "1" : "0");
1373 }
1374
1375 static char *
1376 macro_evaluate_and (const struct expr_context *ctx,
1377                     const struct macro_token **tokens,
1378                     const struct macro_token *end)
1379 {
1380   const struct macro_token *p = *tokens;
1381   char *lhs = macro_evaluate_not (ctx, &p, end);
1382   if (!lhs)
1383     return NULL;
1384
1385   while (p < end
1386          && (ss_equals_case (p->representation, ss_cstr ("!AND"))
1387              || ss_equals (p->representation, ss_cstr ("&"))))
1388     {
1389       p++;
1390       char *rhs = macro_evaluate_not (ctx, &p, end);
1391       if (!rhs)
1392         {
1393           free (lhs);
1394           return NULL;
1395         }
1396
1397       bool b = strcmp (lhs, "0") && strcmp (rhs, "0");
1398       free (lhs);
1399       free (rhs);
1400       lhs = xstrdup (b ? "1" : "0");
1401     }
1402   *tokens = p;
1403   return lhs;
1404 }
1405
1406 static char *
1407 macro_evaluate_or (const struct expr_context *ctx,
1408                    const struct macro_token **tokens,
1409                    const struct macro_token *end)
1410 {
1411   const struct macro_token *p = *tokens;
1412   char *lhs = macro_evaluate_and (ctx, &p, end);
1413   if (!lhs)
1414     return NULL;
1415
1416   while (p < end
1417          && (ss_equals_case (p->representation, ss_cstr ("!OR"))
1418              || ss_equals (p->representation, ss_cstr ("|"))))
1419     {
1420       p++;
1421       char *rhs = macro_evaluate_and (ctx, &p, end);
1422       if (!rhs)
1423         {
1424           free (lhs);
1425           return NULL;
1426         }
1427
1428       bool b = strcmp (lhs, "0") || strcmp (rhs, "0");
1429       free (lhs);
1430       free (rhs);
1431       lhs = xstrdup (b ? "1" : "0");
1432     }
1433   *tokens = p;
1434   return lhs;
1435 }
1436
1437 static char *
1438 macro_evaluate_expression (const struct macro_token **tokens, size_t n_tokens,
1439                            int nesting_countdown, const struct macro_set *macros,
1440                            const struct macro_expander *me,
1441                            const struct macro_expansion_stack *stack,
1442                            struct string_map *vars, bool *expand)
1443 {
1444   const struct expr_context ctx = {
1445     .nesting_countdown = nesting_countdown,
1446     .macros = macros,
1447     .me = me,
1448     .stack = stack,
1449     .vars = vars,
1450     .expand = expand,
1451   };
1452   return macro_evaluate_or (&ctx, tokens, *tokens + n_tokens);
1453 }
1454
1455 static bool
1456 macro_evaluate_number (const struct macro_token **tokens, size_t n_tokens,
1457                        int nesting_countdown, const struct macro_set *macros,
1458                        const struct macro_expander *me,
1459                        const struct macro_expansion_stack *stack,
1460                        struct string_map *vars,
1461                        bool *expand, double *number)
1462 {
1463   char *s = macro_evaluate_expression (tokens, n_tokens, nesting_countdown,
1464                                        macros, me, stack, vars, expand);
1465   if (!s)
1466     return false;
1467
1468   struct macro_tokens mts = { .n = 0 };
1469   macro_tokens_from_string (&mts, ss_cstr (s), SEG_MODE_INTERACTIVE /* XXX */);
1470   if (mts.n != 1 || !token_is_number (&mts.mts[0].token))
1471     {
1472       macro_tokens_print (&mts, stdout);
1473       macro_error (stack, _("Macro expression must evaluate to "
1474                             "a number (not \"%s\")"), s);
1475       free (s);
1476       macro_tokens_uninit (&mts);
1477       return false;
1478     }
1479
1480   *number = token_number (&mts.mts[0].token);
1481   free (s);
1482   macro_tokens_uninit (&mts);
1483   return true;
1484 }
1485
1486 static const struct macro_token *
1487 find_ifend_clause (const struct macro_token *p, const struct macro_token *end)
1488 {
1489   size_t nesting = 0;
1490   for (; p < end; p++)
1491     {
1492       if (p->token.type != T_MACRO_ID)
1493         continue;
1494
1495       if (ss_equals_case (p->token.string, ss_cstr ("!IF")))
1496         nesting++;
1497       else if (ss_equals_case (p->token.string, ss_cstr ("!IFEND")))
1498         {
1499           if (!nesting)
1500             return p;
1501           nesting--;
1502         }
1503       else if (ss_equals_case (p->token.string, ss_cstr ("!ELSE")) && !nesting)
1504         return p;
1505     }
1506   return NULL;
1507 }
1508
1509 static size_t
1510 macro_expand_if (const struct macro_token *tokens, size_t n_tokens,
1511                  int nesting_countdown, const struct macro_set *macros,
1512                  const struct macro_expander *me,
1513                  const struct macro_expansion_stack *stack,
1514                  struct string_map *vars,
1515                  bool *expand, bool *break_, struct macro_tokens *exp)
1516 {
1517   const struct macro_token *p = tokens;
1518   const struct macro_token *end = tokens + n_tokens;
1519
1520   if (p >= end || !ss_equals_case (p->token.string, ss_cstr ("!IF")))
1521     return 0;
1522
1523   p++;
1524   char *result = macro_evaluate_expression (&p, end - p,
1525                                             nesting_countdown, macros, me,
1526                                             stack, vars, expand);
1527   if (!result)
1528     return 0;
1529   bool b = strcmp (result, "0");
1530   free (result);
1531
1532   if (p >= end
1533       || p->token.type != T_MACRO_ID
1534       || !ss_equals_case (p->token.string, ss_cstr ("!THEN")))
1535     {
1536       macro_error (stack, _("!THEN expected in macro !IF construct."));
1537       return 0;
1538     }
1539
1540   const struct macro_token *start_then = p + 1;
1541   const struct macro_token *end_then = find_ifend_clause (start_then, end);
1542   if (!end_then)
1543     {
1544       macro_error (stack,
1545                    _("!ELSE or !IFEND expected in macro !IF construct."));
1546       return 0;
1547     }
1548
1549   const struct macro_token *start_else, *end_if;
1550   if (ss_equals_case (end_then->token.string, ss_cstr ("!ELSE")))
1551     {
1552       start_else = end_then + 1;
1553       end_if = find_ifend_clause (start_else, end);
1554       if (!end_if
1555           || !ss_equals_case (end_if->token.string, ss_cstr ("!IFEND")))
1556         {
1557           macro_error (stack, _("!IFEND expected in macro !IF construct."));
1558           return 0;
1559         }
1560     }
1561   else
1562     {
1563       start_else = NULL;
1564       end_if = end_then;
1565     }
1566
1567   const struct macro_token *start;
1568   size_t n;
1569   if (b)
1570     {
1571       start = start_then;
1572       n = end_then - start_then;
1573     }
1574   else if (start_else)
1575     {
1576       start = start_else;
1577       n = end_if - start_else;
1578     }
1579   else
1580     {
1581       start = NULL;
1582       n = 0;
1583     }
1584
1585   if (n)
1586     {
1587       struct macro_tokens mts = {
1588         .mts = CONST_CAST (struct macro_token *, start),
1589         .n = n,
1590       };
1591       macro_expand (&mts, nesting_countdown, macros, me, vars,
1592                     &(struct macro_expansion_stack) {
1593                       .name = "!IF",
1594                       .next = stack,
1595                     },
1596                     expand, break_, exp);
1597     }
1598   return (end_if + 1) - tokens;
1599 }
1600
1601 static size_t
1602 macro_parse_let (const struct macro_token *tokens, size_t n_tokens,
1603                  int nesting_countdown, const struct macro_set *macros,
1604                  const struct macro_expander *me,
1605                  const struct macro_expansion_stack *stack,
1606                  struct string_map *vars, bool *expand)
1607 {
1608   const struct macro_token *p = tokens;
1609   const struct macro_token *end = tokens + n_tokens;
1610
1611   if (p >= end || !ss_equals_case (p->token.string, ss_cstr ("!LET")))
1612     return 0;
1613   p++;
1614
1615   if (p >= end || p->token.type != T_MACRO_ID)
1616     {
1617       macro_error (stack, _("Expected macro variable name following !LET."));
1618       return 0;
1619     }
1620   const struct substring var_name = p->token.string;
1621   if (is_macro_keyword (var_name)
1622       || macro_find_parameter_by_name (me->macro, var_name))
1623     {
1624       macro_error (stack, _("Cannot use argument name or macro keyword "
1625                             "\"%.*s\" as !LET variable"),
1626                    (int) var_name.length, var_name.string);
1627       return 0;
1628     }
1629   p++;
1630
1631   if (p >= end || p->token.type != T_EQUALS)
1632     {
1633       macro_error (stack, _("Expected `=' following !LET"));
1634       return 0;
1635     }
1636   p++;
1637
1638   char *value = macro_evaluate_expression (&p, end - p,
1639                                            nesting_countdown, macros, me, stack,
1640                                            vars, expand);
1641   if (!value)
1642     return 0;
1643
1644   string_map_replace_nocopy (vars, ss_xstrdup (var_name), value);
1645   return p - tokens;
1646 }
1647
1648 static const struct macro_token *
1649 find_doend (const struct macro_expansion_stack *stack,
1650             const struct macro_token *p, const struct macro_token *end)
1651 {
1652   size_t nesting = 0;
1653   for (; p < end; p++)
1654     {
1655       if (p->token.type != T_MACRO_ID)
1656         continue;
1657
1658       if (ss_equals_case (p->token.string, ss_cstr ("!DO")))
1659         nesting++;
1660       else if (ss_equals_case (p->token.string, ss_cstr ("!DOEND")))
1661         {
1662           if (!nesting)
1663             return p;
1664           nesting--;
1665         }
1666     }
1667   macro_error (stack, _("Missing !DOEND."));
1668   return NULL;
1669 }
1670
1671 static size_t
1672 macro_expand_do (const struct macro_token *tokens, size_t n_tokens,
1673                  int nesting_countdown, const struct macro_set *macros,
1674                  const struct macro_expander *me,
1675                  const struct macro_expansion_stack *stack,
1676                  struct string_map *vars,
1677                  bool *expand, struct macro_tokens *exp)
1678 {
1679   const struct macro_token *p = tokens;
1680   const struct macro_token *end = tokens + n_tokens;
1681
1682   if (p >= end || !ss_equals_case (p->token.string, ss_cstr ("!DO")))
1683     return 0;
1684   p++;
1685
1686   if (p >= end || p->token.type != T_MACRO_ID)
1687     {
1688       macro_error (stack, _("Expected macro variable name following !DO"));
1689       return 0;
1690     }
1691   const struct substring var_name = p->token.string;
1692   if (is_macro_keyword (var_name)
1693       || macro_find_parameter_by_name (me->macro, var_name))
1694     {
1695       macro_error (stack, _("Cannot use argument name or macro "
1696                             "keyword \"%.*s\" as !DO variable"),
1697                    (int) var_name.length, var_name.string);
1698       return 0;
1699     }
1700   p++;
1701
1702   struct macro_expansion_stack next_stack = {
1703     .name = "!DO", .next = stack,
1704   };
1705   int miterate = settings_get_miterate ();
1706   if (p < end && p->token.type == T_MACRO_ID
1707       && ss_equals_case (p->token.string, ss_cstr ("!IN")))
1708     {
1709       p++;
1710       char *list = macro_evaluate_expression (&p, end - p,
1711                                               nesting_countdown, macros, me,
1712                                               &next_stack, vars, expand);
1713       if (!list)
1714         return 0;
1715
1716       struct macro_tokens items = { .n = 0 };
1717       macro_tokens_from_string (&items, ss_cstr (list),
1718                                 SEG_MODE_INTERACTIVE /* XXX */);
1719       free (list);
1720
1721       const struct macro_token *do_end = find_doend (stack, p, end);
1722       if (!do_end)
1723         {
1724           macro_tokens_uninit (&items);
1725           return 0;
1726         }
1727
1728       const struct macro_tokens inner = {
1729         .mts = CONST_CAST (struct macro_token *, p),
1730         .n = do_end - p
1731       };
1732       for (size_t i = 0; i < items.n; i++)
1733         {
1734           if (i >= miterate)
1735             {
1736               macro_error (stack, _("!DO loop over list exceeded "
1737                                     "maximum number of iterations %d.  "
1738                                     "(Use SET MITERATE to change the limit.)"),
1739                            miterate);
1740               break;
1741             }
1742           string_map_replace_nocopy (vars, ss_xstrdup (var_name),
1743                                      ss_xstrdup (items.mts[i].representation));
1744
1745           bool break_ = false;
1746           macro_expand (&inner, nesting_countdown, macros,
1747                         me, vars, &next_stack, expand, &break_, exp);
1748           if (break_)
1749             break;
1750         }
1751       return do_end - tokens + 1;
1752     }
1753   else if (p < end && p->token.type == T_EQUALS)
1754     {
1755       p++;
1756       double first;
1757       if (!macro_evaluate_number (&p, end - p, nesting_countdown, macros, me,
1758                                   &next_stack, vars, expand, &first))
1759         return 0;
1760
1761       if (p >= end || p->token.type != T_MACRO_ID
1762           || !ss_equals_case (p->token.string, ss_cstr ("!TO")))
1763         {
1764           macro_error (stack, _("Expected !TO in numerical !DO loop"));
1765           return 0;
1766         }
1767       p++;
1768
1769       double last;
1770       if (!macro_evaluate_number (&p, end - p, nesting_countdown, macros, me,
1771                                   &next_stack, vars, expand, &last))
1772         return 0;
1773
1774       double by = 1.0;
1775       if (p < end && p->token.type == T_MACRO_ID
1776           && ss_equals_case (p->token.string, ss_cstr ("!BY")))
1777         {
1778           p++;
1779           if (!macro_evaluate_number (&p, end - p, nesting_countdown, macros, me,
1780                                       &next_stack, vars, expand, &by))
1781             return 0;
1782
1783           if (by == 0.0)
1784             {
1785               macro_error (stack, _("!BY value cannot be zero."));
1786               return 0;
1787             }
1788         }
1789
1790       const struct macro_token *do_end = find_doend (stack, p, end);
1791       if (!do_end)
1792         return 0;
1793       const struct macro_tokens inner = {
1794         .mts = CONST_CAST (struct macro_token *, p),
1795         .n = do_end - p
1796       };
1797
1798       if ((by > 0 && first <= last) || (by < 0 && first >= last))
1799         {
1800           int i = 0;
1801           for (double index = first;
1802                by > 0 ? (index <= last) : (index >= last);
1803                index += by)
1804             {
1805               if (i++ > miterate)
1806                 {
1807                   macro_error (stack,
1808                                _("Numerical !DO loop exceeded "
1809                                  "maximum number of iterations %d.  "
1810                                  "(Use SET MITERATE to change the limit.)"),
1811                                miterate);
1812                   break;
1813                 }
1814
1815               char index_s[DBL_BUFSIZE_BOUND];
1816               c_dtoastr (index_s, sizeof index_s, 0, 0, index);
1817               string_map_replace_nocopy (vars, ss_xstrdup (var_name),
1818                                          xstrdup (index_s));
1819
1820               bool break_ = false;
1821               macro_expand (&inner, nesting_countdown, macros,
1822                             me, vars, &next_stack, expand, &break_, exp);
1823               if (break_)
1824                 break;
1825             }
1826         }
1827
1828       return do_end - tokens + 1;
1829     }
1830   else
1831     {
1832       macro_error (stack, _("Expected `=' or !IN in !DO loop."));
1833       return 0;
1834     }
1835 }
1836
1837 static void
1838 macro_expand (const struct macro_tokens *mts,
1839               int nesting_countdown, const struct macro_set *macros,
1840               const struct macro_expander *me, struct string_map *vars,
1841               const struct macro_expansion_stack *stack,
1842               bool *expand, bool *break_, struct macro_tokens *exp)
1843 {
1844   if (nesting_countdown <= 0)
1845     {
1846       macro_error (stack, _("Maximum nesting level %d exceeded."),
1847                    settings_get_mnest ());
1848       for (size_t i = 0; i < mts->n; i++)
1849         macro_tokens_add (exp, &mts->mts[i]);
1850       return;
1851     }
1852
1853   struct string_map own_vars = STRING_MAP_INITIALIZER (own_vars);
1854   if (!vars)
1855     vars = &own_vars;
1856
1857   for (size_t i = 0; i < mts->n && (!break_ || !*break_); i++)
1858     {
1859       const struct macro_token *mt = &mts->mts[i];
1860       const struct token *token = &mt->token;
1861       if (token->type == T_MACRO_ID && me)
1862         {
1863           const struct macro_param *param = macro_find_parameter_by_name (
1864             me->macro, token->string);
1865           if (param)
1866             {
1867               const struct macro_tokens *arg = me->args[param - me->macro->params];
1868               if (*expand && param->expand_arg)
1869                 macro_expand (arg, nesting_countdown, macros, NULL, NULL,
1870                               &(struct macro_expansion_stack) {
1871                                 .name = param->name,
1872                                 .next = stack,
1873                               }, expand, break_, exp);
1874               else
1875                 for (size_t i = 0; i < arg->n; i++)
1876                   macro_tokens_add (exp, &arg->mts[i]);
1877               continue;
1878             }
1879
1880           if (is_bang_star (mts->mts, mts->n, i))
1881             {
1882               for (size_t j = 0; j < me->macro->n_params; j++)
1883                 {
1884                   const struct macro_param *param = &me->macro->params[j];
1885                   if (!param->positional)
1886                     break;
1887
1888                   const struct macro_tokens *arg = me->args[j];
1889                   if (*expand && param->expand_arg)
1890                     macro_expand (arg, nesting_countdown, macros, NULL, NULL,
1891                                   &(struct macro_expansion_stack) {
1892                                     .name = "!*",
1893                                     .next = stack,
1894                                   }, expand, break_, exp);
1895                   else
1896                     for (size_t k = 0; k < arg->n; k++)
1897                       macro_tokens_add (exp, &arg->mts[k]);
1898                 }
1899               i++;
1900               continue;
1901             }
1902
1903           size_t n = macro_expand_if (&mts->mts[i], mts->n - i,
1904                                       nesting_countdown, macros, me, stack,
1905                                       vars, expand, break_, exp);
1906           if (n > 0)
1907             {
1908               i += n - 1;
1909               continue;
1910             }
1911         }
1912
1913       if (token->type == T_MACRO_ID && vars)
1914         {
1915           const char *value = string_map_find__ (vars, token->string.string,
1916                                                  token->string.length);
1917           if (value)
1918             {
1919               macro_tokens_from_string (exp, ss_cstr (value),
1920                                         SEG_MODE_INTERACTIVE /* XXX */);
1921               continue;
1922             }
1923         }
1924
1925       if (*expand)
1926         {
1927           struct macro_expander *subme;
1928           int retval = macro_expander_create (macros, token, &subme);
1929           for (size_t j = 1; !retval; j++)
1930             {
1931               const struct macro_token endcmd = { .token = { .type = T_ENDCMD } };
1932               retval = macro_expander_add (
1933                 subme, i + j < mts->n ? &mts->mts[i + j] : &endcmd);
1934             }
1935           if (retval > 0)
1936             {
1937               i += retval - 1;
1938               macro_expand (&subme->macro->body, nesting_countdown - 1, macros,
1939                             subme, NULL,
1940                             &(struct macro_expansion_stack) {
1941                               .name = subme->macro->name,
1942                               .file_name = subme->macro->file_name,
1943                               .first_line = subme->macro->first_line,
1944                               .last_line = subme->macro->last_line,
1945                               .next = stack,
1946                             }, expand, break_, exp);
1947               macro_expander_destroy (subme);
1948               continue;
1949             }
1950
1951           macro_expander_destroy (subme);
1952         }
1953
1954       if (token->type != T_MACRO_ID)
1955         {
1956           macro_tokens_add (exp, mt);
1957           continue;
1958         }
1959
1960       if (ss_equals_case (token->string, ss_cstr ("!break")))
1961         {
1962           if (!break_)
1963             macro_error (stack, _("!BREAK outside !DO."));
1964           else
1965             {
1966               *break_ = true;
1967               break;
1968             }
1969         }
1970
1971       struct parse_macro_function_ctx ctx = {
1972         .input = &mts->mts[i],
1973         .n_input = mts->n - i,
1974         .nesting_countdown = nesting_countdown,
1975         .macros = macros,
1976         .me = me,
1977         .stack = stack,
1978         .vars = vars,
1979         .expand = expand,
1980       };
1981       struct string function_output = DS_EMPTY_INITIALIZER;
1982       size_t function_consumed;
1983       if (expand_macro_function (&ctx, &function_output, &function_consumed))
1984         {
1985           i += function_consumed - 1;
1986
1987           macro_tokens_from_string (exp, function_output.ss,
1988                                     SEG_MODE_INTERACTIVE /* XXX */);
1989           ds_destroy (&function_output);
1990
1991           continue;
1992         }
1993
1994       size_t n = macro_parse_let (&mts->mts[i], mts->n - i,
1995                                   nesting_countdown, macros, me, stack,
1996                                   vars, expand);
1997       if (n > 0)
1998         {
1999           i += n - 1;
2000           continue;
2001         }
2002
2003       n = macro_expand_do (&mts->mts[i], mts->n - i,
2004                            nesting_countdown, macros, me, stack, vars,
2005                            expand, exp);
2006       if (n > 0)
2007         {
2008           i += n - 1;
2009           continue;
2010         }
2011
2012       if (ss_equals_case (token->string, ss_cstr ("!onexpand")))
2013         *expand = true;
2014       else if (ss_equals_case (token->string, ss_cstr ("!offexpand")))
2015         *expand = false;
2016       else
2017         macro_tokens_add (exp, mt);
2018     }
2019   if (vars == &own_vars)
2020     string_map_destroy (&own_vars);
2021 }
2022
2023 void
2024 macro_expander_get_expansion (struct macro_expander *me, struct macro_tokens *exp)
2025 {
2026   bool expand = true;
2027   struct macro_expansion_stack stack = {
2028     .name = me->macro->name,
2029     .file_name = me->macro->file_name,
2030     .first_line = me->macro->first_line,
2031     .last_line = me->macro->last_line,
2032   };
2033   macro_expand (&me->macro->body, settings_get_mnest (),
2034                 me->macros, me, NULL, &stack, &expand, NULL, exp);
2035 }
2036