3b17d90f38a977220d77492ec83321e4c1c5ec91
[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/stringi-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     struct stringi_map *vars;
874     bool *expand;
875     bool *break_;
876     int nesting_countdown;
877   };
878
879 /* Each argument to a macro function is one of:
880
881        - A quoted string or other single literal token.
882
883        - An argument to the macro being expanded, e.g. !1 or a named argument.
884
885        - !*.
886
887        - A function invocation.
888
889    Each function invocation yields a character sequence to be turned into a
890    sequence of tokens.  The case where that character sequence is a single
891    quoted string is an important special case.
892 */
893 struct parse_macro_function_ctx
894   {
895     const struct macro_token *input;
896     size_t n_input;
897     const struct macro_expander *me;
898     const struct macro_expansion_stack *stack;
899   };
900
901 static void
902 macro_expand (const struct macro_tokens *, const struct macro_expander *,
903               const struct macro_expansion_stack *,
904               struct macro_tokens *);
905
906 static bool
907 expand_macro_function (struct parse_macro_function_ctx *ctx,
908                        struct string *output, size_t *input_consumed);
909
910 /* Returns true if the pair of tokens starting at offset OFS within MTS are !*,
911    false otherwise. */
912 static bool
913 is_bang_star (const struct macro_token *mts, size_t n, size_t ofs)
914 {
915   return (ofs + 1 < n
916           && mts[ofs].token.type == T_MACRO_ID
917           && ss_equals (mts[ofs].token.string, ss_cstr ("!"))
918           && mts[ofs + 1].token.type == T_ASTERISK);
919 }
920
921 static size_t
922 parse_function_arg (struct parse_macro_function_ctx *ctx,
923                     size_t i, struct string *farg)
924 {
925   const struct macro_token *tokens = ctx->input;
926   const struct token *token = &tokens[i].token;
927   if (token->type == T_MACRO_ID && ctx->me->macro)
928     {
929       const struct macro_param *param = macro_find_parameter_by_name (
930         ctx->me->macro, token->string);
931       if (param)
932         {
933           size_t param_idx = param - ctx->me->macro->params;
934           const struct macro_tokens *marg = ctx->me->args[param_idx];
935           for (size_t i = 0; i < marg->n; i++)
936             {
937               if (i)
938                 ds_put_byte (farg, ' ');
939               ds_put_substring (farg, marg->mts[i].representation);
940             }
941           return 1;
942         }
943
944       if (is_bang_star (ctx->input, ctx->n_input, i))
945         {
946           for (size_t i = 0; i < ctx->me->macro->n_params; i++)
947             {
948               if (!ctx->me->macro->params[i].positional)
949                 break;
950
951               const struct macro_tokens *marg = ctx->me->args[i];
952               for (size_t j = 0; j < marg->n; j++)
953                 {
954                   if (i || j)
955                     ds_put_byte (farg, ' ');
956                   ds_put_substring (farg, marg->mts[j].representation);
957                 }
958             }
959           return 2;
960         }
961
962       const char *value = stringi_map_find__ (ctx->me->vars,
963                                               token->string.string,
964                                               token->string.length);
965       if (value)
966         {
967           ds_put_cstr (farg, value);
968           return 1;
969         }
970
971       struct parse_macro_function_ctx subctx = {
972         .input = &ctx->input[i],
973         .n_input = ctx->n_input - i,
974         .me = ctx->me,
975         .stack = ctx->stack,
976       };
977       size_t subinput_consumed;
978       if (expand_macro_function (&subctx, farg, &subinput_consumed))
979         return subinput_consumed;
980     }
981
982   ds_put_substring (farg, tokens[i].representation);
983   return 1;
984 }
985
986 static bool
987 parse_macro_function (struct parse_macro_function_ctx *ctx,
988                       struct string_array *args,
989                       struct substring function,
990                       int min_args, int max_args,
991                       size_t *input_consumed)
992 {
993   const struct macro_token *tokens = ctx->input;
994   size_t n_tokens = ctx->n_input;
995
996   if (!n_tokens
997       || tokens[0].token.type != T_MACRO_ID
998       || !ss_equals_case (tokens[0].token.string, function)) /* XXX abbrevs allowed */
999     return false;
1000
1001   if (n_tokens < 2 || tokens[1].token.type != T_LPAREN)
1002     {
1003       macro_error (ctx->stack, n_tokens > 1 ? &tokens[1] : NULL,
1004                    _("`(' expected following %s."), function.string);
1005       return false;
1006     }
1007
1008   string_array_init (args);
1009
1010   for (size_t i = 2;; )
1011     {
1012       if (i >= n_tokens)
1013         goto unexpected_end;
1014       if (tokens[i].token.type == T_RPAREN)
1015         {
1016           *input_consumed = i + 1;
1017           if (args->n < min_args || args->n > max_args)
1018             {
1019               macro_error (ctx->stack, &tokens[i],
1020                            _("Wrong number of arguments to macro function %s."),
1021                            function.string);
1022               goto error;
1023             }
1024           return true;
1025         }
1026
1027       struct string s = DS_EMPTY_INITIALIZER;
1028       i += parse_function_arg (ctx, i, &s);
1029       if (i >= n_tokens)
1030         {
1031           ds_destroy (&s);
1032           goto unexpected_end;
1033         }
1034       string_array_append_nocopy (args, ds_steal_cstr (&s));
1035
1036       if (tokens[i].token.type == T_COMMA)
1037         i++;
1038       else if (tokens[i].token.type != T_RPAREN)
1039         {
1040           macro_error (ctx->stack, &tokens[i],
1041                        _("`,' or `)' expected in call to macro function %s."),
1042                        function.string);
1043           goto error;
1044         }
1045     }
1046
1047 unexpected_end:
1048   macro_error (ctx->stack, NULL, _("Missing `)' in call to macro function %s."),
1049                function.string);
1050   /* Fall through. */
1051 error:
1052   string_array_destroy (args);
1053   return false;
1054 }
1055
1056 static bool
1057 unquote_string (const char *s, enum segmenter_mode segmenter_mode,
1058                 struct string *content)
1059 {
1060   struct string_lexer slex;
1061   string_lexer_init (&slex, s, strlen (s), segmenter_mode, true);
1062
1063   struct token token1;
1064   if (!string_lexer_next (&slex, &token1))
1065     return false;
1066
1067   if (token1.type != T_STRING)
1068     {
1069       token_uninit (&token1);
1070       return false;
1071     }
1072
1073   struct token token2;
1074   if (string_lexer_next (&slex, &token2))
1075     {
1076       token_uninit (&token1);
1077       token_uninit (&token2);
1078       return false;
1079     }
1080
1081   ds_put_substring (content, token1.string);
1082   token_uninit (&token1);
1083   return true;
1084 }
1085
1086 static const char *
1087 unquote_string_in_place (const char *s, enum segmenter_mode segmenter_mode,
1088                          struct string *tmp)
1089 {
1090   ds_init_empty (tmp);
1091   return unquote_string (s, segmenter_mode, tmp) ? ds_cstr (tmp) : s;
1092 }
1093
1094 static bool
1095 parse_integer (const char *s, int *np)
1096 {
1097   errno = 0;
1098
1099   char *tail;
1100   long int n = strtol (s, &tail, 10);
1101   *np = n < INT_MIN ? INT_MIN : n > INT_MAX ? INT_MAX : n;
1102   tail += strspn (tail, CC_SPACES);
1103   return *tail == '\0' && errno != ERANGE && n == *np;
1104 }
1105
1106 static bool
1107 expand_macro_function (struct parse_macro_function_ctx *ctx,
1108                        struct string *output,
1109                        size_t *input_consumed)
1110 {
1111   struct string_array args;
1112
1113   if (parse_macro_function (ctx, &args, ss_cstr ("!LENGTH"), 1, 1,
1114                             input_consumed))
1115     ds_put_format (output, "%zu", strlen (args.strings[0]));
1116   else if (parse_macro_function (ctx, &args, ss_cstr ("!BLANKS"), 1, 1,
1117                                  input_consumed))
1118     {
1119       int n;
1120       if (!parse_integer (args.strings[0], &n))
1121         {
1122           macro_error (ctx->stack, NULL,
1123                        _("Argument to !BLANKS must be non-negative integer "
1124                          "(not \"%s\")."), args.strings[0]);
1125           string_array_destroy (&args);
1126           return false;
1127         }
1128
1129       ds_put_byte_multiple (output, ' ', n);
1130     }
1131   else if (parse_macro_function (ctx, &args, ss_cstr ("!CONCAT"), 1, INT_MAX,
1132                                  input_consumed))
1133     {
1134       for (size_t i = 0; i < args.n; i++)
1135         if (!unquote_string (args.strings[i], ctx->me->segmenter_mode, output))
1136           ds_put_cstr (output, args.strings[i]);
1137     }
1138   else if (parse_macro_function (ctx, &args, ss_cstr ("!HEAD"), 1, 1,
1139                                  input_consumed))
1140     {
1141       struct string tmp;
1142       const char *s = unquote_string_in_place (args.strings[0],
1143                                                ctx->me->segmenter_mode, &tmp);
1144
1145       struct macro_tokens mts = { .n = 0 };
1146       macro_tokens_from_string__ (&mts, ss_cstr (s), ctx->me->segmenter_mode,
1147                                   ctx->stack);
1148       if (mts.n > 0)
1149         ds_put_substring (output, mts.mts[0].representation);
1150       macro_tokens_uninit (&mts);
1151       ds_destroy (&tmp);
1152     }
1153   else if (parse_macro_function (ctx, &args, ss_cstr ("!INDEX"), 2, 2,
1154                                  input_consumed))
1155     {
1156       const char *haystack = args.strings[0];
1157       const char *needle = strstr (haystack, args.strings[1]);
1158       ds_put_format (output, "%zu", needle ? needle - haystack + 1 : 0);
1159     }
1160   else if (parse_macro_function (ctx, &args, ss_cstr ("!QUOTE"), 1, 1,
1161                                  input_consumed))
1162     {
1163       if (unquote_string (args.strings[0], ctx->me->segmenter_mode, NULL))
1164         ds_put_cstr (output, args.strings[0]);
1165       else
1166         {
1167           ds_extend (output, strlen (args.strings[0]) + 2);
1168           ds_put_byte (output, '\'');
1169           for (const char *p = args.strings[0]; *p; p++)
1170             {
1171               if (*p == '\'')
1172                 ds_put_byte (output, '\'');
1173               ds_put_byte (output, *p);
1174             }
1175           ds_put_byte (output, '\'');
1176         }
1177     }
1178   else if (parse_macro_function (ctx, &args, ss_cstr ("!SUBSTR"), 2, 3,
1179                                  input_consumed))
1180     {
1181       int start;
1182       if (!parse_integer (args.strings[1], &start) || start < 1)
1183         {
1184           macro_error (ctx->stack, NULL,
1185                        _("Second argument of !SUBSTR must be "
1186                          "positive integer (not \"%s\")."),
1187                        args.strings[1]);
1188           string_array_destroy (&args);
1189           return false;
1190         }
1191
1192       int count = INT_MAX;
1193       if (args.n > 2 && (!parse_integer (args.strings[2], &count) || count < 0))
1194         {
1195           macro_error (ctx->stack, NULL,
1196                        _("Third argument of !SUBSTR must be "
1197                          "non-negative integer (not \"%s\")."),
1198                        args.strings[2]);
1199           string_array_destroy (&args);
1200           return false;
1201         }
1202
1203       struct substring s = ss_cstr (args.strings[0]);
1204       ds_put_substring (output, ss_substr (s, start - 1, count));
1205     }
1206   else if (parse_macro_function (ctx, &args, ss_cstr ("!TAIL"), 1, 1,
1207                                  input_consumed))
1208     {
1209       struct string tmp;
1210       const char *s = unquote_string_in_place (args.strings[0],
1211                                                ctx->me->segmenter_mode, &tmp);
1212
1213       struct macro_tokens mts = { .n = 0 };
1214       macro_tokens_from_string__ (&mts, ss_cstr (s), ctx->me->segmenter_mode,
1215                                   ctx->stack);
1216       if (mts.n > 1)
1217         {
1218           struct macro_tokens tail = { .mts = mts.mts + 1, .n = mts.n - 1 };
1219           macro_tokens_to_representation (&tail, output, NULL, NULL);
1220         }
1221       macro_tokens_uninit (&mts);
1222       ds_destroy (&tmp);
1223     }
1224   else if (parse_macro_function (ctx, &args, ss_cstr ("!UNQUOTE"), 1, 1,
1225                                  input_consumed))
1226     {
1227       if (!unquote_string (args.strings[0], ctx->me->segmenter_mode, output))
1228         ds_put_cstr (output, args.strings[0]);
1229     }
1230   else if (parse_macro_function (ctx, &args, ss_cstr ("!UPCASE"), 1, 1,
1231                                  input_consumed))
1232     {
1233       struct string tmp;
1234       const char *s = unquote_string_in_place (args.strings[0],
1235                                                ctx->me->segmenter_mode, &tmp);
1236       char *upper = utf8_to_upper (s);
1237       ds_put_cstr (output, upper);
1238       free (upper);
1239       ds_destroy (&tmp);
1240     }
1241   else if (parse_macro_function (ctx, &args, ss_cstr ("!EVAL"), 1, 1,
1242                                  input_consumed))
1243     {
1244       struct macro_tokens mts = { .n = 0 };
1245       macro_tokens_from_string__ (&mts, ss_cstr (args.strings[0]),
1246                                   ctx->me->segmenter_mode, ctx->stack);
1247       struct macro_tokens exp = { .n = 0 };
1248       struct macro_expander subme = *ctx->me;
1249       subme.break_ = NULL;
1250       macro_expand (&mts, &subme,
1251                     &(struct macro_expansion_stack) {
1252                       .name = "!EVAL",
1253                       .next = ctx->stack,
1254                     }, &exp);
1255       macro_tokens_to_representation (&exp, output, NULL, NULL);
1256       macro_tokens_uninit (&exp);
1257       macro_tokens_uninit (&mts);
1258     }
1259   else if (ctx->n_input > 0
1260            && ctx->input[0].token.type == T_MACRO_ID
1261            && ss_equals_case (ctx->input[0].token.string, ss_cstr ("!NULL")))
1262     {
1263       *input_consumed = 1;
1264       return true;
1265     }
1266   else
1267     return false;
1268
1269   string_array_destroy (&args);
1270   return true;
1271 }
1272
1273 static char *macro_evaluate_or (const struct macro_expander *me,
1274                                 const struct macro_expansion_stack *stack,
1275                                 const struct macro_token **tokens,
1276                                 const struct macro_token *end);
1277
1278 static char *
1279 macro_evaluate_literal (const struct macro_expander *me,
1280                         const struct macro_expansion_stack *stack,
1281                         const struct macro_token **tokens,
1282                         const struct macro_token *end)
1283 {
1284   const struct macro_token *p = *tokens;
1285   if (p >= end)
1286     return NULL;
1287   if (p->token.type == T_LPAREN)
1288     {
1289       p++;
1290       char *value = macro_evaluate_or (me, stack, &p, end);
1291       if (!value)
1292         return NULL;
1293       if (p >= end || p->token.type != T_RPAREN)
1294         {
1295           free (value);
1296           macro_error (stack, p < end ? p : NULL,
1297                        _("Expecting ')' in macro expression."));
1298           return NULL;
1299         }
1300       p++;
1301       *tokens = p;
1302       return value;
1303     }
1304   else if (p->token.type == T_RPAREN)
1305     {
1306       macro_error (stack, p, _("Expecting literal or function invocation "
1307                                "in macro expression."));
1308       return NULL;
1309     }
1310
1311   struct parse_macro_function_ctx fctx = {
1312     .input = p,
1313     .n_input = end - p,
1314     .me = me,
1315     .stack = stack,
1316   };
1317   struct string function_output = DS_EMPTY_INITIALIZER;
1318   size_t function_consumed = parse_function_arg (&fctx, 0, &function_output);
1319   struct string unquoted = DS_EMPTY_INITIALIZER;
1320   if (unquote_string (ds_cstr (&function_output), me->segmenter_mode,
1321                       &unquoted))
1322     {
1323       ds_swap (&function_output, &unquoted);
1324       ds_destroy (&unquoted);
1325     }
1326   *tokens = p + function_consumed;
1327   return ds_steal_cstr (&function_output);
1328 }
1329
1330 /* Returns true if MT is valid as a macro operator.  Only operators written as
1331    symbols (e.g. <>) are usable in macro expressions, not operator written as
1332    letters (e.g. EQ). */
1333 static bool
1334 is_macro_operator (const struct macro_token *mt)
1335 {
1336   return (mt->representation.length > 0
1337           && !c_isalpha (mt->representation.string[0]));
1338 }
1339
1340 static enum token_type
1341 parse_relational_op (const struct macro_token *mt)
1342 {
1343   switch (mt->token.type)
1344     {
1345     case T_EQUALS:
1346       return T_EQ;
1347
1348     case T_NE:
1349     case T_LT:
1350     case T_GT:
1351     case T_LE:
1352     case T_GE:
1353       return is_macro_operator (mt) ? mt->token.type : T_STOP;
1354
1355     case T_MACRO_ID:
1356       return (ss_equals_case (mt->token.string, ss_cstr ("!EQ")) ? T_EQ
1357               : ss_equals_case (mt->token.string, ss_cstr ("!NE")) ? T_NE
1358               : ss_equals_case (mt->token.string, ss_cstr ("!LT")) ? T_LT
1359               : ss_equals_case (mt->token.string, ss_cstr ("!GT")) ? T_GT
1360               : ss_equals_case (mt->token.string, ss_cstr ("!LE")) ? T_LE
1361               : ss_equals_case (mt->token.string, ss_cstr ("!GE")) ? T_GE
1362               : T_STOP);
1363
1364     default:
1365       return T_STOP;
1366     }
1367 }
1368
1369 static char *
1370 macro_evaluate_relational (const struct macro_expander *me,
1371                            const struct macro_expansion_stack *stack,
1372                            const struct macro_token **tokens,
1373                            const struct macro_token *end)
1374 {
1375   const struct macro_token *p = *tokens;
1376   char *lhs = macro_evaluate_literal (me, stack, &p, end);
1377   if (!lhs)
1378     return NULL;
1379
1380   enum token_type op = p >= end ? T_STOP : parse_relational_op (p);
1381   if (op == T_STOP)
1382     {
1383       *tokens = p;
1384       return lhs;
1385     }
1386   p++;
1387
1388   char *rhs = macro_evaluate_literal (me, stack, &p, end);
1389   if (!rhs)
1390     {
1391       free (lhs);
1392       return NULL;
1393     }
1394
1395   struct string lhs_tmp, rhs_tmp;
1396   int cmp = strcmp (unquote_string_in_place (lhs, me->segmenter_mode,
1397                                              &lhs_tmp),
1398                     unquote_string_in_place (rhs, me->segmenter_mode,
1399                                              &rhs_tmp));
1400   ds_destroy (&lhs_tmp);
1401   ds_destroy (&rhs_tmp);
1402
1403   free (lhs);
1404   free (rhs);
1405
1406   bool b = (op == T_EQUALS || op == T_EQ ? !cmp
1407             : op == T_NE ? cmp
1408             : op == T_LT ? cmp < 0
1409             : op == T_GT ? cmp > 0
1410             : op == T_LE ? cmp <= 0
1411             : /* T_GE */ cmp >= 0);
1412
1413   *tokens = p;
1414   return xstrdup (b ? "1" : "0");
1415 }
1416
1417 static char *
1418 macro_evaluate_not (const struct macro_expander *me,
1419                     const struct macro_expansion_stack *stack,
1420                     const struct macro_token **tokens,
1421                     const struct macro_token *end)
1422 {
1423   const struct macro_token *p = *tokens;
1424
1425   unsigned int negations = 0;
1426   while (p < end
1427          && (ss_equals_case (p->representation, ss_cstr ("!NOT"))
1428              || ss_equals (p->representation, ss_cstr ("~"))))
1429     {
1430       p++;
1431       negations++;
1432     }
1433
1434   char *operand = macro_evaluate_relational (me, stack, &p, end);
1435   if (!operand || !negations)
1436     {
1437       *tokens = p;
1438       return operand;
1439     }
1440
1441   bool b = strcmp (operand, "0") ^ (negations & 1);
1442   free (operand);
1443   *tokens = p;
1444   return xstrdup (b ? "1" : "0");
1445 }
1446
1447 static char *
1448 macro_evaluate_and (const struct macro_expander *me,
1449                     const struct macro_expansion_stack *stack,
1450                     const struct macro_token **tokens,
1451                     const struct macro_token *end)
1452 {
1453   const struct macro_token *p = *tokens;
1454   char *lhs = macro_evaluate_not (me, stack, &p, end);
1455   if (!lhs)
1456     return NULL;
1457
1458   while (p < end
1459          && (ss_equals_case (p->representation, ss_cstr ("!AND"))
1460              || ss_equals (p->representation, ss_cstr ("&"))))
1461     {
1462       p++;
1463       char *rhs = macro_evaluate_not (me, stack, &p, end);
1464       if (!rhs)
1465         {
1466           free (lhs);
1467           return NULL;
1468         }
1469
1470       bool b = strcmp (lhs, "0") && strcmp (rhs, "0");
1471       free (lhs);
1472       free (rhs);
1473       lhs = xstrdup (b ? "1" : "0");
1474     }
1475   *tokens = p;
1476   return lhs;
1477 }
1478
1479 static char *
1480 macro_evaluate_or (const struct macro_expander *me,
1481                    const struct macro_expansion_stack *stack,
1482                    const struct macro_token **tokens,
1483                    const struct macro_token *end)
1484 {
1485   const struct macro_token *p = *tokens;
1486   char *lhs = macro_evaluate_and (me, stack, &p, end);
1487   if (!lhs)
1488     return NULL;
1489
1490   while (p < end
1491          && (ss_equals_case (p->representation, ss_cstr ("!OR"))
1492              || ss_equals (p->representation, ss_cstr ("|"))))
1493     {
1494       p++;
1495       char *rhs = macro_evaluate_and (me, stack, &p, end);
1496       if (!rhs)
1497         {
1498           free (lhs);
1499           return NULL;
1500         }
1501
1502       bool b = strcmp (lhs, "0") || strcmp (rhs, "0");
1503       free (lhs);
1504       free (rhs);
1505       lhs = xstrdup (b ? "1" : "0");
1506     }
1507   *tokens = p;
1508   return lhs;
1509 }
1510
1511 static char *
1512 macro_evaluate_expression (const struct macro_token **tokens, size_t n_tokens,
1513                            const struct macro_expander *me,
1514                            const struct macro_expansion_stack *stack)
1515 {
1516   return macro_evaluate_or (me, stack, tokens, *tokens + n_tokens);
1517 }
1518
1519 static bool
1520 macro_evaluate_number (const struct macro_token **tokens, size_t n_tokens,
1521                        const struct macro_expander *me,
1522                        const struct macro_expansion_stack *stack,
1523                        double *number)
1524 {
1525   char *s = macro_evaluate_expression (tokens, n_tokens, me, stack);
1526   if (!s)
1527     return false;
1528
1529   struct macro_tokens mts = { .n = 0 };
1530   macro_tokens_from_string__ (&mts, ss_cstr (s), me->segmenter_mode, stack);
1531   if (mts.n != 1 || !token_is_number (&mts.mts[0].token))
1532     {
1533       macro_error (stack, mts.n > 0 ? &mts.mts[0] : NULL,
1534                    _("Macro expression must evaluate to "
1535                      "a number (not \"%s\")."), s);
1536       free (s);
1537       macro_tokens_uninit (&mts);
1538       return false;
1539     }
1540
1541   *number = token_number (&mts.mts[0].token);
1542   free (s);
1543   macro_tokens_uninit (&mts);
1544   return true;
1545 }
1546
1547 static const struct macro_token *
1548 find_ifend_clause (const struct macro_token *p, const struct macro_token *end)
1549 {
1550   size_t nesting = 0;
1551   for (; p < end; p++)
1552     {
1553       if (p->token.type != T_MACRO_ID)
1554         continue;
1555
1556       if (ss_equals_case (p->token.string, ss_cstr ("!IF")))
1557         nesting++;
1558       else if (ss_equals_case (p->token.string, ss_cstr ("!IFEND")))
1559         {
1560           if (!nesting)
1561             return p;
1562           nesting--;
1563         }
1564       else if (ss_equals_case (p->token.string, ss_cstr ("!ELSE")) && !nesting)
1565         return p;
1566     }
1567   return NULL;
1568 }
1569
1570 static size_t
1571 macro_expand_if (const struct macro_token *tokens, size_t n_tokens,
1572                  const struct macro_expander *me,
1573                  const struct macro_expansion_stack *stack,
1574                  struct macro_tokens *exp)
1575 {
1576   const struct macro_token *p = tokens;
1577   const struct macro_token *end = tokens + n_tokens;
1578
1579   if (p >= end || !ss_equals_case (p->token.string, ss_cstr ("!IF")))
1580     return 0;
1581
1582   p++;
1583   char *result = macro_evaluate_expression (&p, end - p, me, stack);
1584   if (!result)
1585     return 0;
1586   bool b = strcmp (result, "0");
1587   free (result);
1588
1589   if (p >= end
1590       || p->token.type != T_MACRO_ID
1591       || !ss_equals_case (p->token.string, ss_cstr ("!THEN")))
1592     {
1593       macro_error (stack, p < end ? p : NULL,
1594                    _("!THEN expected in macro !IF construct."));
1595       return 0;
1596     }
1597
1598   const struct macro_token *start_then = p + 1;
1599   const struct macro_token *end_then = find_ifend_clause (start_then, end);
1600   if (!end_then)
1601     {
1602       macro_error (stack, NULL,
1603                    _("!ELSE or !IFEND expected in macro !IF construct."));
1604       return 0;
1605     }
1606
1607   const struct macro_token *start_else, *end_if;
1608   if (ss_equals_case (end_then->token.string, ss_cstr ("!ELSE")))
1609     {
1610       start_else = end_then + 1;
1611       end_if = find_ifend_clause (start_else, end);
1612       if (!end_if
1613           || !ss_equals_case (end_if->token.string, ss_cstr ("!IFEND")))
1614         {
1615           macro_error (stack, end_if ? end_if : NULL,
1616                        _("!IFEND expected in macro !IF construct."));
1617           return 0;
1618         }
1619     }
1620   else
1621     {
1622       start_else = NULL;
1623       end_if = end_then;
1624     }
1625
1626   const struct macro_token *start;
1627   size_t n;
1628   if (b)
1629     {
1630       start = start_then;
1631       n = end_then - start_then;
1632     }
1633   else if (start_else)
1634     {
1635       start = start_else;
1636       n = end_if - start_else;
1637     }
1638   else
1639     {
1640       start = NULL;
1641       n = 0;
1642     }
1643
1644   if (n)
1645     {
1646       struct macro_tokens mts = {
1647         .mts = CONST_CAST (struct macro_token *, start),
1648         .n = n,
1649       };
1650       macro_expand (&mts, me, &(struct macro_expansion_stack) {
1651                       .name = "!IF",
1652                       .next = stack,
1653                     },
1654                     exp);
1655     }
1656   return (end_if + 1) - tokens;
1657 }
1658
1659 static size_t
1660 macro_parse_let (const struct macro_token *tokens, size_t n_tokens,
1661                  const struct macro_expander *me,
1662                  const struct macro_expansion_stack *stack)
1663 {
1664   const struct macro_token *p = tokens;
1665   const struct macro_token *end = tokens + n_tokens;
1666
1667   if (p >= end || !ss_equals_case (p->token.string, ss_cstr ("!LET")))
1668     return 0;
1669   p++;
1670
1671   if (p >= end || p->token.type != T_MACRO_ID)
1672     {
1673       macro_error (stack, p < end ? p : NULL,
1674                    _("Expected macro variable name following !LET."));
1675       return 0;
1676     }
1677   const struct substring var_name = p->token.string;
1678   if (is_macro_keyword (var_name)
1679       || (me->macro && macro_find_parameter_by_name (me->macro, var_name)))
1680     {
1681       macro_error (stack, p < end ? p : NULL,
1682                    _("Cannot use argument name or macro keyword "
1683                      "\"%.*s\" as !LET variable."),
1684                    (int) var_name.length, var_name.string);
1685       return 0;
1686     }
1687   p++;
1688
1689   if (p >= end || p->token.type != T_EQUALS)
1690     {
1691       macro_error (stack, p < end ? p : NULL,
1692                    _("Expected `=' following !LET."));
1693       return 0;
1694     }
1695   p++;
1696
1697   char *value = macro_evaluate_expression (&p, end - p, me, stack);
1698   if (!value)
1699     return 0;
1700
1701   stringi_map_replace_nocopy (me->vars, ss_xstrdup (var_name), value);
1702   return p - tokens;
1703 }
1704
1705 static const struct macro_token *
1706 find_doend (const struct macro_expansion_stack *stack,
1707             const struct macro_token *p, const struct macro_token *end)
1708 {
1709   size_t nesting = 0;
1710   for (; p < end; p++)
1711     {
1712       if (p->token.type != T_MACRO_ID)
1713         continue;
1714
1715       if (ss_equals_case (p->token.string, ss_cstr ("!DO")))
1716         nesting++;
1717       else if (ss_equals_case (p->token.string, ss_cstr ("!DOEND")))
1718         {
1719           if (!nesting)
1720             return p;
1721           nesting--;
1722         }
1723     }
1724   macro_error (stack, NULL, _("Missing !DOEND."));
1725   return NULL;
1726 }
1727
1728 static size_t
1729 macro_expand_do (const struct macro_token *tokens, size_t n_tokens,
1730                  const struct macro_expander *me,
1731                  const struct macro_expansion_stack *stack,
1732                  struct macro_tokens *exp)
1733 {
1734   const struct macro_token *p = tokens;
1735   const struct macro_token *end = tokens + n_tokens;
1736
1737   if (p >= end || !ss_equals_case (p->token.string, ss_cstr ("!DO")))
1738     return 0;
1739   p++;
1740
1741   if (p >= end || p->token.type != T_MACRO_ID)
1742     {
1743       macro_error (stack, p < end ? p : NULL,
1744                    _("Expected macro variable name following !DO."));
1745       return 0;
1746     }
1747   const struct substring var_name = p->token.string;
1748   if (is_macro_keyword (var_name)
1749       || (me->macro && macro_find_parameter_by_name (me->macro, var_name)))
1750     {
1751       macro_error (stack, p, _("Cannot use argument name or macro "
1752                                "keyword as !DO variable."));
1753       return 0;
1754     }
1755   p++;
1756
1757   struct macro_expansion_stack next_stack = {
1758     .name = "!DO", .next = stack,
1759   };
1760   int miterate = settings_get_miterate ();
1761   if (p < end && p->token.type == T_MACRO_ID
1762       && ss_equals_case (p->token.string, ss_cstr ("!IN")))
1763     {
1764       p++;
1765       char *list = macro_evaluate_expression (&p, end - p, me, &next_stack);
1766       if (!list)
1767         return 0;
1768
1769       struct macro_tokens items = { .n = 0 };
1770       macro_tokens_from_string__ (&items, ss_cstr (list), me->segmenter_mode,
1771                                   stack);
1772       free (list);
1773
1774       const struct macro_token *do_end = find_doend (stack, p, end);
1775       if (!do_end)
1776         {
1777           macro_tokens_uninit (&items);
1778           return 0;
1779         }
1780
1781       const struct macro_tokens inner = {
1782         .mts = CONST_CAST (struct macro_token *, p),
1783         .n = do_end - p
1784       };
1785
1786       bool break_ = false;
1787       struct macro_expander subme = *me;
1788       subme.break_ = &break_;
1789
1790       for (size_t i = 0; i < items.n && !break_; i++)
1791         {
1792           if (i >= miterate)
1793             {
1794               macro_error (stack, NULL,
1795                            _("!DO loop over list exceeded "
1796                              "maximum number of iterations %d.  "
1797                              "(Use SET MITERATE to change the limit.)"),
1798                            miterate);
1799               break;
1800             }
1801           stringi_map_replace_nocopy (me->vars, ss_xstrdup (var_name),
1802                                       ss_xstrdup (items.mts[i].representation));
1803
1804           macro_expand (&inner, &subme, &next_stack, exp);
1805         }
1806       return do_end - tokens + 1;
1807     }
1808   else if (p < end && p->token.type == T_EQUALS)
1809     {
1810       p++;
1811       double first;
1812       if (!macro_evaluate_number (&p, end - p, me, &next_stack, &first))
1813         return 0;
1814
1815       if (p >= end || p->token.type != T_MACRO_ID
1816           || !ss_equals_case (p->token.string, ss_cstr ("!TO")))
1817         {
1818           macro_error (stack, p < end ? p : NULL,
1819                        _("Expected !TO in numerical !DO loop."));
1820           return 0;
1821         }
1822       p++;
1823
1824       double last;
1825       if (!macro_evaluate_number (&p, end - p, me, &next_stack, &last))
1826         return 0;
1827
1828       double by = 1.0;
1829       if (p < end && p->token.type == T_MACRO_ID
1830           && ss_equals_case (p->token.string, ss_cstr ("!BY")))
1831         {
1832           p++;
1833           if (!macro_evaluate_number (&p, end - p, me, &next_stack, &by))
1834             return 0;
1835
1836           if (by == 0.0)
1837             {
1838               macro_error (stack, NULL, _("!BY value cannot be zero."));
1839               return 0;
1840             }
1841         }
1842
1843       const struct macro_token *do_end = find_doend (stack, p, end);
1844       if (!do_end)
1845         return 0;
1846       const struct macro_tokens inner = {
1847         .mts = CONST_CAST (struct macro_token *, p),
1848         .n = do_end - p
1849       };
1850
1851       bool break_ = false;
1852       struct macro_expander subme = *me;
1853       subme.break_ = &break_;
1854
1855       if ((by > 0 && first <= last) || (by < 0 && first >= last))
1856         {
1857           int i = 0;
1858           for (double index = first;
1859                by > 0 ? (index <= last) : (index >= last) && !break_;
1860                index += by)
1861             {
1862               if (i++ > miterate)
1863                 {
1864                   macro_error (stack, NULL,
1865                                _("Numerical !DO loop exceeded "
1866                                  "maximum number of iterations %d.  "
1867                                  "(Use SET MITERATE to change the limit.)"),
1868                                miterate);
1869                   break;
1870                 }
1871
1872               char index_s[DBL_BUFSIZE_BOUND];
1873               c_dtoastr (index_s, sizeof index_s, 0, 0, index);
1874               stringi_map_replace_nocopy (me->vars, ss_xstrdup (var_name),
1875                                           xstrdup (index_s));
1876
1877               macro_expand (&inner, &subme, &next_stack, exp);
1878             }
1879         }
1880
1881       return do_end - tokens + 1;
1882     }
1883   else
1884     {
1885       macro_error (stack, p < end ? p : NULL,
1886                    _("Expected `=' or !IN in !DO loop."));
1887       return 0;
1888     }
1889 }
1890
1891 static void
1892 macro_expand (const struct macro_tokens *mts,
1893               const struct macro_expander *me,
1894               const struct macro_expansion_stack *stack,
1895               struct macro_tokens *exp)
1896 {
1897   if (me->nesting_countdown <= 0)
1898     {
1899       macro_error (stack, NULL, _("Maximum nesting level %d exceeded.  "
1900                                   "(Use SET MNEST to change the limit.)"),
1901                    settings_get_mnest ());
1902       for (size_t i = 0; i < mts->n; i++)
1903         macro_tokens_add (exp, &mts->mts[i]);
1904       return;
1905     }
1906
1907   for (size_t i = 0; i < mts->n && (!me->break_ || !*me->break_); i++)
1908     {
1909       const struct macro_token *mt = &mts->mts[i];
1910       const struct token *token = &mt->token;
1911       if (token->type == T_MACRO_ID && me->macro)
1912         {
1913           const struct macro_param *param = macro_find_parameter_by_name (
1914             me->macro, token->string);
1915           if (param)
1916             {
1917               const struct macro_tokens *arg
1918                 = me->args[param - me->macro->params];
1919               if (*me->expand && param->expand_arg)
1920                 {
1921                   struct stringi_map vars = STRINGI_MAP_INITIALIZER (vars);
1922                   struct macro_expander subme = {
1923                     .macros = me->macros,
1924                     .macro = NULL,
1925                     .args = NULL,
1926                     .segmenter_mode = me->segmenter_mode,
1927                     .expand = me->expand,
1928                     .break_ = NULL,
1929                     .vars = &vars,
1930                     .nesting_countdown = me->nesting_countdown,
1931                   };
1932                   macro_expand (arg, &subme, &(struct macro_expansion_stack) {
1933                                   .name = param->name,
1934                                   .next = stack,
1935                                 }, exp);
1936                   stringi_map_destroy (&vars);
1937                 }
1938               else
1939                 for (size_t i = 0; i < arg->n; i++)
1940                   macro_tokens_add (exp, &arg->mts[i]);
1941               continue;
1942             }
1943
1944           if (is_bang_star (mts->mts, mts->n, i))
1945             {
1946               for (size_t j = 0; j < me->macro->n_params; j++)
1947                 {
1948                   const struct macro_param *param = &me->macro->params[j];
1949                   if (!param->positional)
1950                     break;
1951
1952                   const struct macro_tokens *arg = me->args[j];
1953                   if (*me->expand && param->expand_arg)
1954                     {
1955                       struct stringi_map vars = STRINGI_MAP_INITIALIZER (vars);
1956                       struct macro_expander subme = {
1957                         .macros = me->macros,
1958                         .macro = NULL,
1959                         .args = NULL,
1960                         .segmenter_mode = me->segmenter_mode,
1961                         .expand = me->expand,
1962                         .break_ = NULL,
1963                         .vars = &vars,
1964                         .nesting_countdown = me->nesting_countdown,
1965                       };
1966                       macro_expand (arg, &subme,
1967                                     &(struct macro_expansion_stack) {
1968                                       .name = "!*",
1969                                       .next = stack,
1970                                     }, exp);
1971                       stringi_map_destroy (&vars);
1972                     }
1973                   else
1974                     for (size_t k = 0; k < arg->n; k++)
1975                       macro_tokens_add (exp, &arg->mts[k]);
1976                 }
1977               i++;
1978               continue;
1979             }
1980
1981           size_t n = macro_expand_if (&mts->mts[i], mts->n - i, me, stack,
1982                                       exp);
1983           if (n > 0)
1984             {
1985               i += n - 1;
1986               continue;
1987             }
1988         }
1989
1990       if (token->type == T_MACRO_ID)
1991         {
1992           const char *value = stringi_map_find__ (me->vars,
1993                                                   token->string.string,
1994                                                   token->string.length);
1995           if (value)
1996             {
1997               macro_tokens_from_string__ (exp, ss_cstr (value),
1998                                           me->segmenter_mode, stack);
1999               continue;
2000             }
2001         }
2002
2003       if (*me->expand)
2004         {
2005           struct macro_call *submc;
2006           int retval = macro_call_create (me->macros, token, &submc);
2007           for (size_t j = 1; !retval; j++)
2008             {
2009               const struct macro_token endcmd
2010                 = { .token = { .type = T_ENDCMD } };
2011               retval = macro_call_add (
2012                 submc, i + j < mts->n ? &mts->mts[i + j] : &endcmd);
2013             }
2014           if (retval > 0)
2015             {
2016               i += retval - 1;
2017               struct stringi_map vars = STRINGI_MAP_INITIALIZER (vars);
2018               struct macro_expander subme = {
2019                 .macros = submc->macros,
2020                 .macro = submc->macro,
2021                 .args = submc->args,
2022                 .segmenter_mode = me->segmenter_mode,
2023                 .expand = me->expand,
2024                 .break_ = NULL,
2025                 .vars = &vars,
2026                 .nesting_countdown = me->nesting_countdown - 1,
2027               };
2028               macro_expand (&submc->macro->body, &subme,
2029                             &(struct macro_expansion_stack) {
2030                               .name = submc->macro->name,
2031                               .file_name = submc->macro->file_name,
2032                               .first_line = submc->macro->first_line,
2033                               .last_line = submc->macro->last_line,
2034                               .next = stack,
2035                             }, exp);
2036               macro_call_destroy (submc);
2037               stringi_map_destroy (&vars);
2038               continue;
2039             }
2040
2041           macro_call_destroy (submc);
2042         }
2043
2044       if (token->type != T_MACRO_ID)
2045         {
2046           macro_tokens_add (exp, mt);
2047           continue;
2048         }
2049
2050       if (ss_equals_case (token->string, ss_cstr ("!break")))
2051         {
2052           if (!me->break_)
2053             macro_error (stack, mt, _("!BREAK outside !DO."));
2054           else
2055             {
2056               *me->break_ = true;
2057               break;
2058             }
2059         }
2060
2061       struct parse_macro_function_ctx ctx = {
2062         .input = &mts->mts[i],
2063         .n_input = mts->n - i,
2064         .me = me,
2065         .stack = stack,
2066       };
2067       struct string function_output = DS_EMPTY_INITIALIZER;
2068       size_t function_consumed;
2069       if (expand_macro_function (&ctx, &function_output, &function_consumed))
2070         {
2071           i += function_consumed - 1;
2072
2073           macro_tokens_from_string__ (exp, function_output.ss,
2074                                       me->segmenter_mode, stack);
2075           ds_destroy (&function_output);
2076
2077           continue;
2078         }
2079
2080       size_t n = macro_parse_let (&mts->mts[i], mts->n - i, me, stack);
2081       if (n > 0)
2082         {
2083           i += n - 1;
2084           continue;
2085         }
2086
2087       n = macro_expand_do (&mts->mts[i], mts->n - i, me, stack, exp);
2088       if (n > 0)
2089         {
2090           i += n - 1;
2091           continue;
2092         }
2093
2094       if (ss_equals_case (token->string, ss_cstr ("!onexpand")))
2095         *me->expand = true;
2096       else if (ss_equals_case (token->string, ss_cstr ("!offexpand")))
2097         *me->expand = false;
2098       else
2099         macro_tokens_add (exp, mt);
2100     }
2101 }
2102
2103 void
2104 macro_call_expand (struct macro_call *mc, enum segmenter_mode segmenter_mode,
2105                    struct macro_tokens *exp)
2106 {
2107   assert (mc->state == MC_FINISHED);
2108
2109   bool expand = true;
2110   struct stringi_map vars = STRINGI_MAP_INITIALIZER (vars);
2111   struct macro_expander me = {
2112     .macros = mc->macros,
2113     .macro = mc->macro,
2114     .args = mc->args,
2115     .segmenter_mode = segmenter_mode,
2116     .expand = &expand,
2117     .break_ = NULL,
2118     .vars = &vars,
2119     .nesting_countdown = settings_get_mnest (),
2120   };
2121
2122   struct macro_expansion_stack stack = {
2123     .name = mc->macro->name,
2124     .file_name = mc->macro->file_name,
2125     .first_line = mc->macro->first_line,
2126     .last_line = mc->macro->last_line,
2127   };
2128   macro_expand (&mc->macro->body, &me, &stack, exp);
2129
2130   stringi_map_destroy (&vars);
2131 }
2132