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