[pspp] / src / language / lexer / macro.c

/* PSPP - a program for statistical analysis.
   Copyright (C) 2021 Free Software Foundation, Inc.

   This program is free software: you can redistribute it and/or modify
   it under the terms of the GNU General Public License as published by
   the Free Software Foundation, either version 3 of the License, or
   (at your option) any later version.

   This program is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.

   You should have received a copy of the GNU General Public License
   along with this program.  If not, see <http://www.gnu.org/licenses/>. */

#include <config.h>

#include "language/lexer/macro.h"

#include <errno.h>
#include <limits.h>
#include <stdlib.h>

#include "data/settings.h"
#include "language/lexer/lexer.h"
#include "language/lexer/segment.h"
#include "language/lexer/scan.h"
#include "libpspp/assertion.h"
#include "libpspp/cast.h"
#include "libpspp/i18n.h"
#include "libpspp/message.h"
#include "libpspp/str.h"
#include "libpspp/string-array.h"
#include "libpspp/string-map.h"
#include "libpspp/stringi-set.h"

#include "gl/c-ctype.h"
#include "gl/ftoastr.h"

#include "gettext.h"
#define _(msgid) gettext (msgid)

/* An entry in the stack of macros and macro directives being expanded.  The
   stack is maintained as a linked list.  Entries are not dynamically allocated
   but on the program stack. */
struct macro_expansion_stack
  {
    /* Points to an outer stack entry, or NULL if this is the outermost. */
    const struct macro_expansion_stack *next;

    /* A macro name or !IF, !DO, etc. */
    const char *name;

    /* Location of the macro definition, if available. */
    const char *file_name;
    int first_line;
    int last_line;
  };

/* Reports an error during macro expansion.  STACK is the stack for reporting
   the location of the error, MT is the optional token at which the error was
   detected, and FORMAT along with the varargs is the message to report. */
static void PRINTF_FORMAT (3, 4)
macro_error (const struct macro_expansion_stack *stack,
             const struct macro_token *mt,
             const char *format, ...)
{
  struct msg_stack **ms = NULL;
  size_t allocated_ms = 0;
  size_t n_ms = 0;

  for (const struct macro_expansion_stack *p = stack; p; p = p->next)
    {
      if (n_ms >= allocated_ms)
        ms = x2nrealloc (ms, &allocated_ms, sizeof *ms);

      /* TRANSLATORS: These strings are used for explaining the context of an
         error.  The "While expanding" message appears first, followed by zero
         or more of the "inside expansion" messages.  `innermost',
         `next_inner`, etc., are names of macros, and `foobar' is a piece of
         PSPP syntax:

         foo.sps:12: At `foobar' in the expansion of 'innermost',
         foo.sps:23: inside the expansion of 'next_inner',
         foo.sps:34: inside the expansion of 'next_inner2',
         foo.sps:45: inside the expansion of 'outermost',
         foo.sps:76: This is the actual error message. */
      char *description;
      if (p == stack)
        {
          if (mt && mt->representation.length)
            {
              char syntax[64];
              str_ellipsize (mt->representation, syntax, sizeof syntax);
              description = xasprintf (_("At `%s' in the expansion of `%s',"),
                                       syntax, p->name);
            }
          else
            description = xasprintf (_("In the expansion of `%s',"), p->name);
        }
      else
        description = xasprintf (_("inside the expansion of `%s',"), p->name);

      ms[n_ms] = xmalloc (sizeof *ms[n_ms]);
      *ms[n_ms] = (struct msg_stack) {
        .location = {
          .file_name = xstrdup_if_nonnull (p->file_name),
          .first_line = p->first_line,
          .last_line = p->last_line,
        },
        .description = description,
      };
      n_ms++;
    }

  va_list args;
  va_start (args, format);
  char *s = xvasprintf (format, args);
  va_end (args);

  struct msg *m = xmalloc (sizeof *m);
  *m = (struct msg) {
    .category = MSG_C_SYNTAX,
    .severity = MSG_S_ERROR,
    .stack = ms,
    .n_stack = n_ms,
    .text = s,
  };
  msg_emit (m);
}

void
macro_token_copy (struct macro_token *dst, const struct macro_token *src)
{
  token_copy (&dst->token, &src->token);
  ss_alloc_substring (&dst->representation, src->representation);
}

void
macro_token_uninit (struct macro_token *mt)
{
  token_uninit (&mt->token);
  ss_dealloc (&mt->representation);
}

void
macro_token_to_representation (struct macro_token *mt, struct string *s)
{
  ds_put_substring (s, mt->representation);
}
bool
is_macro_keyword (struct substring s)
{
  static struct stringi_set keywords = STRINGI_SET_INITIALIZER (keywords);
  if (stringi_set_is_empty (&keywords))
    {
      static const char *kws[] = {
        "BREAK",
        "CHAREND",
        "CMDEND",
        "DEFAULT",
        "DO",
        "DOEND",
        "ELSE",
        "ENCLOSE",
        "ENDDEFINE",
        "IF",
        "IFEND",
        "IN",
        "LET",
        "NOEXPAND",
        "OFFEXPAND",
        "ONEXPAND",
        "POSITIONAL",
        "THEN",
        "TOKENS",
      };
      for (size_t i = 0; i < sizeof kws / sizeof *kws; i++)
        stringi_set_insert (&keywords, kws[i]);
    }

  ss_ltrim (&s, ss_cstr ("!"));
  return stringi_set_contains_len (&keywords, s.string, s.length);
}
\f
void
macro_tokens_copy (struct macro_tokens *dst, const struct macro_tokens *src)
{
  *dst = (struct macro_tokens) {
    .mts = xmalloc (src->n * sizeof *dst->mts),
    .n = src->n,
    .allocated = src->n,
  };
  for (size_t i = 0; i < src->n; i++)
    macro_token_copy (&dst->mts[i], &src->mts[i]);
}

void
macro_tokens_uninit (struct macro_tokens *mts)
{
  for (size_t i = 0; i < mts->n; i++)
    macro_token_uninit (&mts->mts[i]);
  free (mts->mts);
}

struct macro_token *
macro_tokens_add_uninit (struct macro_tokens *mts)
{
  if (mts->n >= mts->allocated)
    mts->mts = x2nrealloc (mts->mts, &mts->allocated, sizeof *mts->mts);
  return &mts->mts[mts->n++];
}

void
macro_tokens_add (struct macro_tokens *mts, const struct macro_token *mt)
{
  macro_token_copy (macro_tokens_add_uninit (mts), mt);
}

/* Tokenizes SRC according to MODE and appends the tokens to MTS.  Uses STACK,
   if nonull, for error reporting. */
static void
macro_tokens_from_string__ (struct macro_tokens *mts, const struct substring src,
                            enum segmenter_mode mode,
                            const struct macro_expansion_stack *stack)
{
  struct state
    {
      struct segmenter segmenter;
      struct substring body;
    };

  struct state state = {
    .segmenter = segmenter_init (mode, true),
    .body = src,
  };
  struct state saved = state;

  while (state.body.length > 0)
    {
      struct macro_token mt = {
        .token = { .type = T_STOP },
        .representation = { .string = state.body.string },
      };
      struct token *token = &mt.token;

      struct scanner scanner;
      scanner_init (&scanner, token);

      for (;;)
        {
          enum segment_type type;
          int seg_len = segmenter_push (&state.segmenter, state.body.string,
                                        state.body.length, true, &type);
          assert (seg_len >= 0);

          struct substring segment = ss_head (state.body, seg_len);
          ss_advance (&state.body, seg_len);

          enum scan_result result = scanner_push (&scanner, type, segment, token);
          if (result == SCAN_SAVE)
            saved = state;
          else if (result == SCAN_BACK)
            {
              state = saved;
              break;
            }
          else if (result == SCAN_DONE)
            break;
        }

      /* We have a token in 'token'. */
      mt.representation.length = state.body.string - mt.representation.string;
      if (is_scan_type (token->type))
        {
          if (token->type != SCAN_SKIP)
            {
              char *s = scan_token_to_error (token);
              if (stack)
                {
                  mt.token.type = T_STRING;
                  macro_error (stack, &mt, "%s", s);
                }
              else
                msg (SE, "%s", s);
              free (s);
            }
        }
      else
        macro_tokens_add (mts, &mt);
      token_uninit (token);
    }
}

/* Tokenizes SRC according to MODE and appends the tokens to MTS. */
void
macro_tokens_from_string (struct macro_tokens *mts, const struct substring src,
                          enum segmenter_mode mode)
{
  macro_tokens_from_string__ (mts, src, mode, NULL);
}

void
macro_tokens_print (const struct macro_tokens *mts, FILE *stream)
{
  for (size_t i = 0; i < mts->n; i++)
    token_print (&mts->mts[i].token, stream);
}

enum token_class
  {
    TC_ENDCMD,                  /* No space before or after (new-line after). */
    TC_BINOP,                   /* Space on both sides. */
    TC_COMMA,                   /* Space afterward. */
    TC_ID,                      /* Don't need spaces except sequentially. */
    TC_PUNCT,                   /* Don't need spaces except sequentially. */
  };

static bool
needs_space (enum token_class prev, enum token_class next)
{
  /* Don't need a space before or after the end of a command.
     (A new-line is needed afterward as a special case.) */
  if (prev == TC_ENDCMD || next == TC_ENDCMD)
    return false;

  /* Binary operators always have a space on both sides. */
  if (prev == TC_BINOP || next == TC_BINOP)
    return true;

  /* A comma always has a space afterward. */
  if (prev == TC_COMMA)
    return true;

  /* Otherwise, PREV is TC_ID or TC_PUNCT, which only need a space if there are
     two or them in a row. */
  return prev == next;
}

static enum token_class
classify_token (enum token_type type)
{
  switch (type)
    {
    case T_ID:
    case T_MACRO_ID:
    case T_POS_NUM:
    case T_NEG_NUM:
    case T_STRING:
      return TC_ID;

    case T_STOP:
      return TC_PUNCT;

    case T_ENDCMD:
      return TC_ENDCMD;

    case T_LPAREN:
    case T_RPAREN:
    case T_LBRACK:
    case T_RBRACK:
      return TC_PUNCT;

    case T_PLUS:
    case T_DASH:
    case T_ASTERISK:
    case T_SLASH:
    case T_EQUALS:
    case T_AND:
    case T_OR:
    case T_NOT:
    case T_EQ:
    case T_GE:
    case T_GT:
    case T_LE:
    case T_LT:
    case T_NE:
    case T_ALL:
    case T_BY:
    case T_TO:
    case T_WITH:
    case T_EXP:
    case T_MACRO_PUNCT:
      return TC_BINOP;

    case T_COMMA:
      return TC_COMMA;
    }

  NOT_REACHED ();
}

/* Appends a syntax representation of the tokens in MTS to S.  If OFS and LEN
   are nonnull, sets OFS[i] to the offset within S of the start of token 'i' in
   MTS and LEN[i] to its length.  OFS[i] + LEN[i] is not necessarily OFS[i + 1]
   because some tokens are separated by white space.  */
void
macro_tokens_to_representation (struct macro_tokens *mts, struct string *s,
                                size_t *ofs, size_t *len)
{
  assert ((ofs != NULL) == (len != NULL));

  if (!mts->n)
    return;

  for (size_t i = 0; i < mts->n; i++)
    {
      if (i > 0)
        {
          enum token_type prev = mts->mts[i - 1].token.type;
          enum token_type next = mts->mts[i].token.type;

          if (prev == T_ENDCMD)
            ds_put_byte (s, '\n');
          else
            {
              enum token_class pc = classify_token (prev);
              enum token_class nc = classify_token (next);
              if (needs_space (pc, nc))
                ds_put_byte (s, ' ');
            }
        }

      if (ofs)
        ofs[i] = s->ss.length;
      macro_token_to_representation (&mts->mts[i], s);
      if (len)
        len[i] = s->ss.length - ofs[i];
    }
}

void
macro_destroy (struct macro *m)
{
  if (!m)
    return;

  free (m->name);
  free (m->file_name);
  for (size_t i = 0; i < m->n_params; i++)
    {
      struct macro_param *p = &m->params[i];
      free (p->name);

      macro_tokens_uninit (&p->def);

      switch (p->arg_type)
        {
        case ARG_N_TOKENS:
          break;

        case ARG_CHAREND:
          token_uninit (&p->charend);
          break;

        case ARG_ENCLOSE:
          token_uninit (&p->enclose[0]);
          token_uninit (&p->enclose[1]);
          break;

        case ARG_CMDEND:
          break;
        }
    }
  free (m->params);
  macro_tokens_uninit (&m->body);
  free (m);
}
\f
struct macro_set *
macro_set_create (void)
{
  struct macro_set *set = xmalloc (sizeof *set);
  *set = (struct macro_set) {
    .macros = HMAP_INITIALIZER (set->macros),
  };
  return set;
}

void
macro_set_destroy (struct macro_set *set)
{
  if (!set)
    return;

  struct macro *macro, *next;
  HMAP_FOR_EACH_SAFE (macro, next, struct macro, hmap_node, &set->macros)
    {
      hmap_delete (&set->macros, &macro->hmap_node);
      macro_destroy (macro);
    }
  hmap_destroy (&set->macros);
  free (set);
}

static unsigned int
hash_macro_name (const char *name)
{
  return utf8_hash_case_string (name, 0);
}

static struct macro *
macro_set_find__ (struct macro_set *set, const char *name)
{
  if (macro_set_is_empty (set))
    return NULL;

  struct macro *macro;
  HMAP_FOR_EACH_WITH_HASH (macro, struct macro, hmap_node,
                           hash_macro_name (name), &set->macros)
    if (!utf8_strcasecmp (macro->name, name))
      return macro;

  return NULL;
}

const struct macro *
macro_set_find (const struct macro_set *set, const char *name)
{
  return macro_set_find__ (CONST_CAST (struct macro_set *, set), name);
}

/* Adds M to SET.  M replaces any existing macro with the same name.  Takes
   ownership of M. */
void
macro_set_add (struct macro_set *set, struct macro *m)
{
  struct macro *victim = macro_set_find__ (set, m->name);
  if (victim)
    {
      hmap_delete (&set->macros, &victim->hmap_node);
      macro_destroy (victim);
    }

  hmap_insert (&set->macros, &m->hmap_node, hash_macro_name (m->name));
}
\f
/* Macro call parsing.. */

enum mc_state
  {
    /* Error state. */
    MC_ERROR,

    /* Accumulating tokens in mc->params toward the end of any type of
       argument. */
    MC_ARG,

    /* Expecting the opening delimiter of an ARG_ENCLOSE argument. */
    MC_ENCLOSE,

    /* Expecting a keyword for a keyword argument. */
    MC_KEYWORD,

    /* Expecting an equal sign for a keyword argument. */
    MC_EQUALS,

    /* Macro fully parsed and ready for expansion. */
    MC_FINISHED,
  };

/* Parsing macro calls.  This is a FSM driven by macro_call_create() and
   macro_call_add() to identify the macro being called and obtain its
   arguments.  'state' identifies the FSM state. */
struct macro_call
  {
    const struct macro_set *macros;
    const struct macro *macro;
    struct macro_tokens **args;

    enum mc_state state;
    size_t n_tokens;
    const struct macro_param *param; /* Parameter currently being parsed. */
  };

/* Completes macro expansion by initializing arguments that weren't supplied to
   their defaults. */
static int
mc_finished (struct macro_call *mc)
{
  mc->state = MC_FINISHED;
  for (size_t i = 0; i < mc->macro->n_params; i++)
    if (!mc->args[i])
      mc->args[i] = &mc->macro->params[i].def;
  return mc->n_tokens;
}

static int
mc_next_arg (struct macro_call *mc)
{
  if (!mc->param)
    {
      assert (!mc->macro->n_params);
      return mc_finished (mc);
    }
  else if (mc->param->positional)
    {
      mc->param++;
      if (mc->param >= &mc->macro->params[mc->macro->n_params])
        return mc_finished (mc);
      else
        {
          mc->state = (!mc->param->positional ? MC_KEYWORD
                       : mc->param->arg_type == ARG_ENCLOSE ? MC_ENCLOSE
                       : MC_ARG);
          return 0;
        }
    }
  else
    {
      for (size_t i = 0; i < mc->macro->n_params; i++)
        if (!mc->args[i])
          {
            mc->state = MC_KEYWORD;
            return 0;
          }
      return mc_finished (mc);
    }
}

static int
mc_error (struct macro_call *mc)
{
  mc->state = MC_ERROR;
  return -1;
}

static int
mc_add_arg (struct macro_call *mc, const struct macro_token *mt)
{
  const struct macro_param *p = mc->param;

  const struct token *token = &mt->token;
  if ((token->type == T_ENDCMD || token->type == T_STOP)
      && p->arg_type != ARG_CMDEND)
    {
      msg (SE, _("Unexpected end of command reading argument %s "
                 "to macro %s."), mc->param->name, mc->macro->name);

      return mc_error (mc);
    }

  mc->n_tokens++;

  struct macro_tokens **argp = &mc->args[p - mc->macro->params];
  if (!*argp)
    *argp = xzalloc (sizeof **argp);
  struct macro_tokens *arg = *argp;
  if (p->arg_type == ARG_N_TOKENS)
    {
      macro_tokens_add (arg, mt);
      if (arg->n >= p->n_tokens)
        return mc_next_arg (mc);
      return 0;
    }
  else if (p->arg_type == ARG_CMDEND)
    {
      if (token->type == T_ENDCMD || token->type == T_STOP)
        return mc_next_arg (mc);
      macro_tokens_add (arg, mt);
      return 0;
    }
  else
    {
      const struct token *end
        = p->arg_type == ARG_CHAREND ? &p->charend : &p->enclose[1];
      if (token_equal (token, end))
        return mc_next_arg (mc);
      macro_tokens_add (arg, mt);
      return 0;
    }
}

static int
mc_expected (struct macro_call *mc, const struct macro_token *actual,
             const struct token *expected)
{
  const struct substring actual_s
    = (actual->representation.length ? actual->representation
       : ss_cstr (_("<end of input>")));
  char *expected_s = token_to_string (expected);
  msg (SE, _("Found `%.*s' while expecting `%s' reading argument %s "
             "to macro %s."),
       (int) actual_s.length, actual_s.string, expected_s,
       mc->param->name, mc->macro->name);
  free (expected_s);

  return mc_error (mc);
}

static int
mc_enclose (struct macro_call *mc, const struct macro_token *mt)
{
  const struct token *token = &mt->token;
  mc->n_tokens++;

  if (token_equal (&mc->param->enclose[0], token))
    {
      mc->state = MC_ARG;
      return 0;
    }

  return mc_expected (mc, mt, &mc->param->enclose[0]);
}

static const struct macro_param *
macro_find_parameter_by_name (const struct macro *m, struct substring name)
{
  ss_ltrim (&name, ss_cstr ("!"));

  for (size_t i = 0; i < m->n_params; i++)
    {
      const struct macro_param *p = &m->params[i];
      struct substring p_name = ss_cstr (p->name + 1);
      if (!utf8_strncasecmp (p_name.string, p_name.length,
                             name.string, name.length))
        return p;
    }
  return NULL;
}

static int
mc_keyword (struct macro_call *mc, const struct macro_token *mt)
{
  const struct token *token = &mt->token;
  if (token->type != T_ID)
    return mc_finished (mc);

  const struct macro_param *p = macro_find_parameter_by_name (mc->macro,
                                                              token->string);
  if (p)
    {
      size_t arg_index = p - mc->macro->params;
      mc->param = p;
      if (mc->args[arg_index])
        {
          msg (SE,
               _("Argument %s multiply specified in call to macro %s."),
               p->name, mc->macro->name);
          return mc_error (mc);
        }

      mc->n_tokens++;
      mc->state = MC_EQUALS;
      return 0;
    }

  return mc_finished (mc);
}

static int
mc_equals (struct macro_call *mc, const struct macro_token *mt)
{
  const struct token *token = &mt->token;
  mc->n_tokens++;

  if (token->type == T_EQUALS)
    {
      mc->state = MC_ARG;
      return 0;
    }

  return mc_expected (mc, mt, &(struct token) { .type = T_EQUALS });
}

/* If TOKEN is the first token of a call to a macro in MACROS, create a new
   macro expander, initializes *MCP to it.  Returns 0 if more tokens are needed
   and should be added via macro_call_add() or 1 if the caller should next call
   macro_call_get_expansion().

   If TOKEN is not the first token of a macro call, returns -1 and sets *MCP to
   NULL. */
int
macro_call_create (const struct macro_set *macros,
                   const struct token *token,
                   struct macro_call **mcp)
{
  const struct macro *macro = (token->type == T_ID || token->type == T_MACRO_ID
                               ? macro_set_find (macros, token->string.string)
                               : NULL);
  if (!macro)
    {
      *mcp = NULL;
      return -1;
    }

  struct macro_call *mc = xmalloc (sizeof *mc);
  *mc = (struct macro_call) {
    .macros = macros,
    .macro = macro,
    .n_tokens = 1,
    .state = (!macro->n_params ? MC_FINISHED
              : !macro->params[0].positional ? MC_KEYWORD
              : macro->params[0].arg_type == ARG_ENCLOSE ? MC_ENCLOSE
              : MC_ARG),
    .args = macro->n_params ? xcalloc (macro->n_params, sizeof *mc->args) : NULL,
    .param = macro->params,
  };
  *mcp = mc;

  return mc->state == MC_FINISHED ? 1 : 0;
}

void
macro_call_destroy (struct macro_call *mc)
{
  if (!mc)
    return;

  for (size_t i = 0; i < mc->macro->n_params; i++)
    {
      struct macro_tokens *a = mc->args[i];
      if (a && a != &mc->macro->params[i].def)
        {
          macro_tokens_uninit (a);
          free (a);
        }
    }
  free (mc->args);
  free (mc);
}

/* Adds TOKEN to the collection of tokens in MC that potentially need to be
   macro expanded.

   Returns -1 if the tokens added do not actually invoke a macro.  The caller
   should consume the first token without expanding it.  (Later tokens might
   invoke a macro so it's best to feed the second token into a new expander.)

   Returns 0 if the macro expander needs more tokens, for macro arguments or to
   decide whether this is actually a macro invocation.  The caller should call
   macro_call_add() again with the next token.

   Returns a positive number to indicate that the returned number of tokens
   invoke a macro.  The number returned might be less than the number of tokens
   added because it can take a few tokens of lookahead to determine whether the
   macro invocation is finished.  The caller should call
   macro_call_get_expansion() to obtain the expansion. */
int
macro_call_add (struct macro_call *mc, const struct macro_token *mt)
{
  switch (mc->state)
    {
    case MC_ERROR:
      return -1;

    case MC_ARG:
      return mc_add_arg (mc, mt);

    case MC_ENCLOSE:
      return mc_enclose (mc, mt);

    case MC_KEYWORD:
      return mc_keyword (mc, mt);

    case MC_EQUALS:
      return mc_equals (mc, mt);

    default:
      NOT_REACHED ();
    }
}
\f
/* Macro expansion. */

struct macro_expander
  {
    const struct macro_set *macros;
    const struct macro *macro;
    struct macro_tokens **args;
    enum segmenter_mode segmenter_mode;
    bool *expand;
  };

/* Each argument to a macro function is one of:

       - A quoted string or other single literal token.

       - An argument to the macro being expanded, e.g. !1 or a named argument.

       - !*.

       - A function invocation.

   Each function invocation yields a character sequence to be turned into a
   sequence of tokens.  The case where that character sequence is a single
   quoted string is an important special case.
*/
struct parse_macro_function_ctx
  {
    const struct macro_token *input;
    size_t n_input;
    int nesting_countdown;
    const struct macro_expander *me;
    const struct macro_expansion_stack *stack;
    struct string_map *vars;
    bool *expand;
  };

static void
macro_expand (const struct macro_tokens *, int nesting_countdown,
              const struct macro_expander *, struct string_map *vars,
              const struct macro_expansion_stack *stack,
              bool *break_, struct macro_tokens *exp);

static bool
expand_macro_function (struct parse_macro_function_ctx *ctx,
                       struct string *output, size_t *input_consumed);

/* Returns true if the pair of tokens starting at offset OFS within MTS are !*,
   false otherwise. */
static bool
is_bang_star (const struct macro_token *mts, size_t n, size_t ofs)
{
  return (ofs + 1 < n
          && mts[ofs].token.type == T_MACRO_ID
          && ss_equals (mts[ofs].token.string, ss_cstr ("!"))
          && mts[ofs + 1].token.type == T_ASTERISK);
}

static size_t
parse_function_arg (struct parse_macro_function_ctx *ctx,
                    size_t i, struct string *farg)
{
  const struct macro_token *tokens = ctx->input;
  const struct token *token = &tokens[i].token;
  if (token->type == T_MACRO_ID && ctx->me->macro)
    {
      const struct macro_param *param = macro_find_parameter_by_name (
        ctx->me->macro, token->string);
      if (param)
        {
          size_t param_idx = param - ctx->me->macro->params;
          const struct macro_tokens *marg = ctx->me->args[param_idx];
          for (size_t i = 0; i < marg->n; i++)
            {
              if (i)
                ds_put_byte (farg, ' ');
              ds_put_substring (farg, marg->mts[i].representation);
            }
          return 1;
        }

      if (is_bang_star (ctx->input, ctx->n_input, i))
        {
          for (size_t i = 0; i < ctx->me->macro->n_params; i++)
            {
              if (!ctx->me->macro->params[i].positional)
                break;

              const struct macro_tokens *marg = ctx->me->args[i];
              for (size_t j = 0; j < marg->n; j++)
                {
                  if (i || j)
                    ds_put_byte (farg, ' ');
                  ds_put_substring (farg, marg->mts[j].representation);
                }
            }
          return 2;
        }

      if (ctx->vars)
        {
          const char *value = string_map_find__ (ctx->vars,
                                                 token->string.string,
                                                 token->string.length);
          if (value)
            {
              ds_put_cstr (farg, value);
              return 1;
            }
        }

      struct parse_macro_function_ctx subctx = {
        .input = &ctx->input[i],
        .n_input = ctx->n_input - i,
        .nesting_countdown = ctx->nesting_countdown,
        .me = ctx->me,
        .stack = ctx->stack,
        .vars = ctx->vars,
      };
      size_t subinput_consumed;
      if (expand_macro_function (&subctx, farg, &subinput_consumed))
        return subinput_consumed;
    }

  ds_put_substring (farg, tokens[i].representation);
  return 1;
}

static bool
parse_macro_function (struct parse_macro_function_ctx *ctx,
                      struct string_array *args,
                      struct substring function,
                      int min_args, int max_args,
                      size_t *input_consumed)
{
  const struct macro_token *tokens = ctx->input;
  size_t n_tokens = ctx->n_input;

  if (!n_tokens
      || tokens[0].token.type != T_MACRO_ID
      || !ss_equals_case (tokens[0].token.string, function)) /* XXX abbrevs allowed */
    return false;

  if (n_tokens < 2 || tokens[1].token.type != T_LPAREN)
    {
      macro_error (ctx->stack, n_tokens > 1 ? &tokens[1] : NULL,
                   _("`(' expected following %s."), function.string);
      return false;
    }

  string_array_init (args);

  for (size_t i = 2;; )
    {
      if (i >= n_tokens)
        goto unexpected_end;
      if (tokens[i].token.type == T_RPAREN)
        {
          *input_consumed = i + 1;
          if (args->n < min_args || args->n > max_args)
            {
              macro_error (ctx->stack, &tokens[i],
                           _("Wrong number of arguments to macro function %s."),
                           function.string);
              goto error;
            }
          return true;
        }

      struct string s = DS_EMPTY_INITIALIZER;
      i += parse_function_arg (ctx, i, &s);
      if (i >= n_tokens)
        {
          ds_destroy (&s);
          goto unexpected_end;
        }
      string_array_append_nocopy (args, ds_steal_cstr (&s));

      if (tokens[i].token.type == T_COMMA)
        i++;
      else if (tokens[i].token.type != T_RPAREN)
        {
          macro_error (ctx->stack, &tokens[i],
                       _("`,' or `)' expected in call to macro function %s."),
                       function.string);
          goto error;
        }
    }

unexpected_end:
  macro_error (ctx->stack, NULL, _("Missing `)' in call to macro function %s."),
               function.string);
  /* Fall through. */
error:
  string_array_destroy (args);
  return false;
}

static bool
unquote_string (const char *s, enum segmenter_mode segmenter_mode,
                struct string *content)
{
  struct string_lexer slex;
  string_lexer_init (&slex, s, strlen (s), segmenter_mode, true);

  struct token token1;
  if (!string_lexer_next (&slex, &token1))
    return false;

  if (token1.type != T_STRING)
    {
      token_uninit (&token1);
      return false;
    }

  struct token token2;
  if (string_lexer_next (&slex, &token2))
    {
      token_uninit (&token1);
      token_uninit (&token2);
      return false;
    }

  ds_put_substring (content, token1.string);
  token_uninit (&token1);
  return true;
}

static const char *
unquote_string_in_place (const char *s, enum segmenter_mode segmenter_mode,
                         struct string *tmp)
{
  ds_init_empty (tmp);
  return unquote_string (s, segmenter_mode, tmp) ? ds_cstr (tmp) : s;
}

static bool
parse_integer (const char *s, int *np)
{
  errno = 0;

  char *tail;
  long int n = strtol (s, &tail, 10);
  *np = n < INT_MIN ? INT_MIN : n > INT_MAX ? INT_MAX : n;
  tail += strspn (tail, CC_SPACES);
  return *tail == '\0' && errno != ERANGE && n == *np;
}

static bool
expand_macro_function (struct parse_macro_function_ctx *ctx,
                       struct string *output,
                       size_t *input_consumed)
{
  struct string_array args;

  if (parse_macro_function (ctx, &args, ss_cstr ("!LENGTH"), 1, 1,
                            input_consumed))
    ds_put_format (output, "%zu", strlen (args.strings[0]));
  else if (parse_macro_function (ctx, &args, ss_cstr ("!BLANKS"), 1, 1,
                                 input_consumed))
    {
      int n;
      if (!parse_integer (args.strings[0], &n))
        {
          macro_error (ctx->stack, NULL,
                       _("Argument to !BLANKS must be non-negative integer "
                         "(not \"%s\")."), args.strings[0]);
          string_array_destroy (&args);
          return false;
        }

      ds_put_byte_multiple (output, ' ', n);
    }
  else if (parse_macro_function (ctx, &args, ss_cstr ("!CONCAT"), 1, INT_MAX,
                                 input_consumed))
    {
      for (size_t i = 0; i < args.n; i++)
        if (!unquote_string (args.strings[i], ctx->me->segmenter_mode, output))
          ds_put_cstr (output, args.strings[i]);
    }
  else if (parse_macro_function (ctx, &args, ss_cstr ("!HEAD"), 1, 1,
                                 input_consumed))
    {
      struct string tmp;
      const char *s = unquote_string_in_place (args.strings[0],
                                               ctx->me->segmenter_mode, &tmp);

      struct macro_tokens mts = { .n = 0 };
      macro_tokens_from_string__ (&mts, ss_cstr (s), ctx->me->segmenter_mode,
                                  ctx->stack);
      if (mts.n > 0)
        ds_put_substring (output, mts.mts[0].representation);
      macro_tokens_uninit (&mts);
      ds_destroy (&tmp);
    }
  else if (parse_macro_function (ctx, &args, ss_cstr ("!INDEX"), 2, 2,
                                 input_consumed))
    {
      const char *haystack = args.strings[0];
      const char *needle = strstr (haystack, args.strings[1]);
      ds_put_format (output, "%zu", needle ? needle - haystack + 1 : 0);
    }
  else if (parse_macro_function (ctx, &args, ss_cstr ("!QUOTE"), 1, 1,
                                 input_consumed))
    {
      if (unquote_string (args.strings[0], ctx->me->segmenter_mode, NULL))
        ds_put_cstr (output, args.strings[0]);
      else
        {
          ds_extend (output, strlen (args.strings[0]) + 2);
          ds_put_byte (output, '\'');
          for (const char *p = args.strings[0]; *p; p++)
            {
              if (*p == '\'')
                ds_put_byte (output, '\'');
              ds_put_byte (output, *p);
            }
          ds_put_byte (output, '\'');
        }
    }
  else if (parse_macro_function (ctx, &args, ss_cstr ("!SUBSTR"), 2, 3,
                                 input_consumed))
    {
      int start;
      if (!parse_integer (args.strings[1], &start) || start < 1)
        {
          macro_error (ctx->stack, NULL,
                       _("Second argument of !SUBSTR must be "
                         "positive integer (not \"%s\")."),
                       args.strings[1]);
          string_array_destroy (&args);
          return false;
        }

      int count = INT_MAX;
      if (args.n > 2 && (!parse_integer (args.strings[2], &count) || count < 0))
        {
          macro_error (ctx->stack, NULL,
                       _("Third argument of !SUBSTR must be "
                         "non-negative integer (not \"%s\")."),
                       args.strings[2]);
          string_array_destroy (&args);
          return false;
        }

      struct substring s = ss_cstr (args.strings[0]);
      ds_put_substring (output, ss_substr (s, start - 1, count));
    }
  else if (parse_macro_function (ctx, &args, ss_cstr ("!TAIL"), 1, 1,
                                 input_consumed))
    {
      struct string tmp;
      const char *s = unquote_string_in_place (args.strings[0],
                                               ctx->me->segmenter_mode, &tmp);

      struct macro_tokens mts = { .n = 0 };
      macro_tokens_from_string__ (&mts, ss_cstr (s), ctx->me->segmenter_mode,
                                  ctx->stack);
      if (mts.n > 1)
        {
          struct macro_tokens tail = { .mts = mts.mts + 1, .n = mts.n - 1 };
          macro_tokens_to_representation (&tail, output, NULL, NULL);
        }
      macro_tokens_uninit (&mts);
      ds_destroy (&tmp);
    }
  else if (parse_macro_function (ctx, &args, ss_cstr ("!UNQUOTE"), 1, 1,
                                 input_consumed))
    {
      if (!unquote_string (args.strings[0], ctx->me->segmenter_mode, output))
        ds_put_cstr (output, args.strings[0]);
    }
  else if (parse_macro_function (ctx, &args, ss_cstr ("!UPCASE"), 1, 1,
                                 input_consumed))
    {
      struct string tmp;
      const char *s = unquote_string_in_place (args.strings[0],
                                               ctx->me->segmenter_mode, &tmp);
      char *upper = utf8_to_upper (s);
      ds_put_cstr (output, upper);
      free (upper);
      ds_destroy (&tmp);
    }
  else if (parse_macro_function (ctx, &args, ss_cstr ("!EVAL"), 1, 1,
                                 input_consumed))
    {
      struct macro_tokens mts = { .n = 0 };
      macro_tokens_from_string__ (&mts, ss_cstr (args.strings[0]),
                                  ctx->me->segmenter_mode, ctx->stack);
      struct macro_tokens exp = { .n = 0 };
      macro_expand (&mts, ctx->nesting_countdown - 1, ctx->me, ctx->vars,
                    &(struct macro_expansion_stack) {
                      .name = "!EVAL",
                      .next = ctx->stack,
                    }, NULL, &exp);
      macro_tokens_to_representation (&exp, output, NULL, NULL);
      macro_tokens_uninit (&exp);
      macro_tokens_uninit (&mts);
    }
  else if (ctx->n_input > 0
           && ctx->input[0].token.type == T_MACRO_ID
           && ss_equals_case (ctx->input[0].token.string, ss_cstr ("!NULL")))
    {
      *input_consumed = 1;
      return true;
    }
  else
    return false;

  string_array_destroy (&args);
  return true;
}

struct expr_context
  {
    int nesting_countdown;
    const struct macro_expander *me;
    const struct macro_expansion_stack *stack;
    struct string_map *vars;
  };

static char *macro_evaluate_or (const struct expr_context *ctx,
                                const struct macro_token **tokens,
                                const struct macro_token *end);

static char *
macro_evaluate_literal (const struct expr_context *ctx,
                        const struct macro_token **tokens,
                        const struct macro_token *end)
{
  const struct macro_token *p = *tokens;
  if (p >= end)
    return NULL;
  if (p->token.type == T_LPAREN)
    {
      p++;
      char *value = macro_evaluate_or (ctx, &p, end);
      if (!value)
        return NULL;
      if (p >= end || p->token.type != T_RPAREN)
        {
          free (value);
          macro_error (ctx->stack, p < end ? p : NULL,
                       _("Expecting ')' in macro expression."));
          return NULL;
        }
      p++;
      *tokens = p;
      return value;
    }
  else if (p->token.type == T_RPAREN)
    {
      macro_error (ctx->stack, p, _("Expecting literal or function invocation "
                                    "in macro expression."));
      return NULL;
    }

  struct parse_macro_function_ctx fctx = {
    .input = p,
    .n_input = end - p,
    .nesting_countdown = ctx->nesting_countdown,
    .me = ctx->me,
    .stack = ctx->stack,
    .vars = ctx->vars,
  };
  struct string function_output = DS_EMPTY_INITIALIZER;
  size_t function_consumed = parse_function_arg (&fctx, 0, &function_output);
  struct string unquoted = DS_EMPTY_INITIALIZER;
  if (unquote_string (ds_cstr (&function_output), ctx->me->segmenter_mode,
                      &unquoted))
    {
      ds_swap (&function_output, &unquoted);
      ds_destroy (&unquoted);
    }
  *tokens = p + function_consumed;
  return ds_steal_cstr (&function_output);
}

/* Returns true if MT is valid as a macro operator.  Only operators written as
   symbols (e.g. <>) are usable in macro expressions, not operator written as
   letters (e.g. EQ). */
static bool
is_macro_operator (const struct macro_token *mt)
{
  return (mt->representation.length > 0
          && !c_isalpha (mt->representation.string[0]));
}

static enum token_type
parse_relational_op (const struct macro_token *mt)
{
  switch (mt->token.type)
    {
    case T_EQUALS:
      return T_EQ;

    case T_NE:
    case T_LT:
    case T_GT:
    case T_LE:
    case T_GE:
      return is_macro_operator (mt) ? mt->token.type : T_STOP;

    case T_MACRO_ID:
      return (ss_equals_case (mt->token.string, ss_cstr ("!EQ")) ? T_EQ
              : ss_equals_case (mt->token.string, ss_cstr ("!NE")) ? T_NE
              : ss_equals_case (mt->token.string, ss_cstr ("!LT")) ? T_LT
              : ss_equals_case (mt->token.string, ss_cstr ("!GT")) ? T_GT
              : ss_equals_case (mt->token.string, ss_cstr ("!LE")) ? T_LE
              : ss_equals_case (mt->token.string, ss_cstr ("!GE")) ? T_GE
              : T_STOP);

    default:
      return T_STOP;
    }
}

static char *
macro_evaluate_relational (const struct expr_context *ctx,
                           const struct macro_token **tokens,
                           const struct macro_token *end)
{
  const struct macro_token *p = *tokens;
  char *lhs = macro_evaluate_literal (ctx, &p, end);
  if (!lhs)
    return NULL;

  enum token_type op = p >= end ? T_STOP : parse_relational_op (p);
  if (op == T_STOP)
    {
      *tokens = p;
      return lhs;
    }
  p++;

  char *rhs = macro_evaluate_literal (ctx, &p, end);
  if (!rhs)
    {
      free (lhs);
      return NULL;
    }

  struct string lhs_tmp, rhs_tmp;
  int cmp = strcmp (unquote_string_in_place (lhs, ctx->me->segmenter_mode,
                                             &lhs_tmp),
                    unquote_string_in_place (rhs, ctx->me->segmenter_mode,
                                             &rhs_tmp));
  ds_destroy (&lhs_tmp);
  ds_destroy (&rhs_tmp);

  free (lhs);
  free (rhs);

  bool b = (op == T_EQUALS || op == T_EQ ? !cmp
            : op == T_NE ? cmp
            : op == T_LT ? cmp < 0
            : op == T_GT ? cmp > 0
            : op == T_LE ? cmp <= 0
            : /* T_GE */ cmp >= 0);

  *tokens = p;
  return xstrdup (b ? "1" : "0");
}

static char *
macro_evaluate_not (const struct expr_context *ctx,
                    const struct macro_token **tokens,
                    const struct macro_token *end)
{
  const struct macro_token *p = *tokens;

  unsigned int negations = 0;
  while (p < end
         && (ss_equals_case (p->representation, ss_cstr ("!NOT"))
             || ss_equals (p->representation, ss_cstr ("~"))))
    {
      p++;
      negations++;
    }

  char *operand = macro_evaluate_relational (ctx, &p, end);
  if (!operand || !negations)
    {
      *tokens = p;
      return operand;
    }

  bool b = strcmp (operand, "0") ^ (negations & 1);
  free (operand);
  *tokens = p;
  return xstrdup (b ? "1" : "0");
}

static char *
macro_evaluate_and (const struct expr_context *ctx,
                    const struct macro_token **tokens,
                    const struct macro_token *end)
{
  const struct macro_token *p = *tokens;
  char *lhs = macro_evaluate_not (ctx, &p, end);
  if (!lhs)
    return NULL;

  while (p < end
         && (ss_equals_case (p->representation, ss_cstr ("!AND"))
             || ss_equals (p->representation, ss_cstr ("&"))))
    {
      p++;
      char *rhs = macro_evaluate_not (ctx, &p, end);
      if (!rhs)
        {
          free (lhs);
          return NULL;
        }

      bool b = strcmp (lhs, "0") && strcmp (rhs, "0");
      free (lhs);
      free (rhs);
      lhs = xstrdup (b ? "1" : "0");
    }
  *tokens = p;
  return lhs;
}

static char *
macro_evaluate_or (const struct expr_context *ctx,
                   const struct macro_token **tokens,
                   const struct macro_token *end)
{
  const struct macro_token *p = *tokens;
  char *lhs = macro_evaluate_and (ctx, &p, end);
  if (!lhs)
    return NULL;

  while (p < end
         && (ss_equals_case (p->representation, ss_cstr ("!OR"))
             || ss_equals (p->representation, ss_cstr ("|"))))
    {
      p++;
      char *rhs = macro_evaluate_and (ctx, &p, end);
      if (!rhs)
        {
          free (lhs);
          return NULL;
        }

      bool b = strcmp (lhs, "0") || strcmp (rhs, "0");
      free (lhs);
      free (rhs);
      lhs = xstrdup (b ? "1" : "0");
    }
  *tokens = p;
  return lhs;
}

static char *
macro_evaluate_expression (const struct macro_token **tokens, size_t n_tokens,
                           int nesting_countdown,
                           const struct macro_expander *me,
                           const struct macro_expansion_stack *stack,
                           struct string_map *vars)
{
  const struct expr_context ctx = {
    .nesting_countdown = nesting_countdown,
    .me = me,
    .stack = stack,
    .vars = vars,
  };
  return macro_evaluate_or (&ctx, tokens, *tokens + n_tokens);
}

static bool
macro_evaluate_number (const struct macro_token **tokens, size_t n_tokens,
                       int nesting_countdown,
                       const struct macro_expander *me,
                       const struct macro_expansion_stack *stack,
                       struct string_map *vars, double *number)
{
  char *s = macro_evaluate_expression (tokens, n_tokens, nesting_countdown,
                                       me, stack, vars);
  if (!s)
    return false;

  struct macro_tokens mts = { .n = 0 };
  macro_tokens_from_string__ (&mts, ss_cstr (s), me->segmenter_mode, stack);
  if (mts.n != 1 || !token_is_number (&mts.mts[0].token))
    {
      macro_error (stack, mts.n > 0 ? &mts.mts[0] : NULL,
                   _("Macro expression must evaluate to "
                     "a number (not \"%s\")."), s);
      free (s);
      macro_tokens_uninit (&mts);
      return false;
    }

  *number = token_number (&mts.mts[0].token);
  free (s);
  macro_tokens_uninit (&mts);
  return true;
}

static const struct macro_token *
find_ifend_clause (const struct macro_token *p, const struct macro_token *end)
{
  size_t nesting = 0;
  for (; p < end; p++)
    {
      if (p->token.type != T_MACRO_ID)
        continue;

      if (ss_equals_case (p->token.string, ss_cstr ("!IF")))
        nesting++;
      else if (ss_equals_case (p->token.string, ss_cstr ("!IFEND")))
        {
          if (!nesting)
            return p;
          nesting--;
        }
      else if (ss_equals_case (p->token.string, ss_cstr ("!ELSE")) && !nesting)
        return p;
    }
  return NULL;
}

static size_t
macro_expand_if (const struct macro_token *tokens, size_t n_tokens,
                 int nesting_countdown, const struct macro_expander *me,
                 const struct macro_expansion_stack *stack,
                 struct string_map *vars,
                 bool *break_, struct macro_tokens *exp)
{
  const struct macro_token *p = tokens;
  const struct macro_token *end = tokens + n_tokens;

  if (p >= end || !ss_equals_case (p->token.string, ss_cstr ("!IF")))
    return 0;

  p++;
  char *result = macro_evaluate_expression (&p, end - p, nesting_countdown,
                                            me, stack, vars);
  if (!result)
    return 0;
  bool b = strcmp (result, "0");
  free (result);

  if (p >= end
      || p->token.type != T_MACRO_ID
      || !ss_equals_case (p->token.string, ss_cstr ("!THEN")))
    {
      macro_error (stack, p < end ? p : NULL,
                   _("!THEN expected in macro !IF construct."));
      return 0;
    }

  const struct macro_token *start_then = p + 1;
  const struct macro_token *end_then = find_ifend_clause (start_then, end);
  if (!end_then)
    {
      macro_error (stack, NULL,
                   _("!ELSE or !IFEND expected in macro !IF construct."));
      return 0;
    }

  const struct macro_token *start_else, *end_if;
  if (ss_equals_case (end_then->token.string, ss_cstr ("!ELSE")))
    {
      start_else = end_then + 1;
      end_if = find_ifend_clause (start_else, end);
      if (!end_if
          || !ss_equals_case (end_if->token.string, ss_cstr ("!IFEND")))
        {
          macro_error (stack, end_if ? end_if : NULL,
                       _("!IFEND expected in macro !IF construct."));
          return 0;
        }
    }
  else
    {
      start_else = NULL;
      end_if = end_then;
    }

  const struct macro_token *start;
  size_t n;
  if (b)
    {
      start = start_then;
      n = end_then - start_then;
    }
  else if (start_else)
    {
      start = start_else;
      n = end_if - start_else;
    }
  else
    {
      start = NULL;
      n = 0;
    }

  if (n)
    {
      struct macro_tokens mts = {
        .mts = CONST_CAST (struct macro_token *, start),
        .n = n,
      };
      macro_expand (&mts, nesting_countdown, me, vars,
                    &(struct macro_expansion_stack) {
                      .name = "!IF",
                      .next = stack,
                    },
                    break_, exp);
    }
  return (end_if + 1) - tokens;
}

static size_t
macro_parse_let (const struct macro_token *tokens, size_t n_tokens,
                 int nesting_countdown, const struct macro_expander *me,
                 const struct macro_expansion_stack *stack,
                 struct string_map *vars)
{
  const struct macro_token *p = tokens;
  const struct macro_token *end = tokens + n_tokens;

  if (p >= end || !ss_equals_case (p->token.string, ss_cstr ("!LET")))
    return 0;
  p++;

  if (p >= end || p->token.type != T_MACRO_ID)
    {
      macro_error (stack, p < end ? p : NULL,
                   _("Expected macro variable name following !LET."));
      return 0;
    }
  const struct substring var_name = p->token.string;
  if (is_macro_keyword (var_name)
      || (me->macro && macro_find_parameter_by_name (me->macro, var_name)))
    {
      macro_error (stack, p < end ? p : NULL,
                   _("Cannot use argument name or macro keyword "
                     "\"%.*s\" as !LET variable."),
                   (int) var_name.length, var_name.string);
      return 0;
    }
  p++;

  if (p >= end || p->token.type != T_EQUALS)
    {
      macro_error (stack, p < end ? p : NULL,
                   _("Expected `=' following !LET."));
      return 0;
    }
  p++;

  char *value = macro_evaluate_expression (&p, end - p, nesting_countdown,
                                           me, stack, vars);
  if (!value)
    return 0;

  string_map_replace_nocopy (vars, ss_xstrdup (var_name), value);
  return p - tokens;
}

static const struct macro_token *
find_doend (const struct macro_expansion_stack *stack,
            const struct macro_token *p, const struct macro_token *end)
{
  size_t nesting = 0;
  for (; p < end; p++)
    {
      if (p->token.type != T_MACRO_ID)
        continue;

      if (ss_equals_case (p->token.string, ss_cstr ("!DO")))
        nesting++;
      else if (ss_equals_case (p->token.string, ss_cstr ("!DOEND")))
        {
          if (!nesting)
            return p;
          nesting--;
        }
    }
  macro_error (stack, NULL, _("Missing !DOEND."));
  return NULL;
}

static size_t
macro_expand_do (const struct macro_token *tokens, size_t n_tokens,
                 int nesting_countdown, const struct macro_expander *me,
                 const struct macro_expansion_stack *stack,
                 struct string_map *vars, struct macro_tokens *exp)
{
  const struct macro_token *p = tokens;
  const struct macro_token *end = tokens + n_tokens;

  if (p >= end || !ss_equals_case (p->token.string, ss_cstr ("!DO")))
    return 0;
  p++;

  if (p >= end || p->token.type != T_MACRO_ID)
    {
      macro_error (stack, p < end ? p : NULL,
                   _("Expected macro variable name following !DO."));
      return 0;
    }
  const struct substring var_name = p->token.string;
  if (is_macro_keyword (var_name)
      || (me->macro && macro_find_parameter_by_name (me->macro, var_name)))
    {
      macro_error (stack, p, _("Cannot use argument name or macro "
                               "keyword as !DO variable."));
      return 0;
    }
  p++;

  struct macro_expansion_stack next_stack = {
    .name = "!DO", .next = stack,
  };
  int miterate = settings_get_miterate ();
  if (p < end && p->token.type == T_MACRO_ID
      && ss_equals_case (p->token.string, ss_cstr ("!IN")))
    {
      p++;
      char *list = macro_evaluate_expression (&p, end - p, nesting_countdown,
                                              me, &next_stack, vars);
      if (!list)
        return 0;

      struct macro_tokens items = { .n = 0 };
      macro_tokens_from_string__ (&items, ss_cstr (list), me->segmenter_mode,
                                  stack);
      free (list);

      const struct macro_token *do_end = find_doend (stack, p, end);
      if (!do_end)
        {
          macro_tokens_uninit (&items);
          return 0;
        }

      const struct macro_tokens inner = {
        .mts = CONST_CAST (struct macro_token *, p),
        .n = do_end - p
      };
      for (size_t i = 0; i < items.n; i++)
        {
          if (i >= miterate)
            {
              macro_error (stack, NULL,
                           _("!DO loop over list exceeded "
                             "maximum number of iterations %d.  "
                             "(Use SET MITERATE to change the limit.)"),
                           miterate);
              break;
            }
          string_map_replace_nocopy (vars, ss_xstrdup (var_name),
                                     ss_xstrdup (items.mts[i].representation));

          bool break_ = false;
          macro_expand (&inner, nesting_countdown,
                        me, vars, &next_stack, &break_, exp);
          if (break_)
            break;
        }
      return do_end - tokens + 1;
    }
  else if (p < end && p->token.type == T_EQUALS)
    {
      p++;
      double first;
      if (!macro_evaluate_number (&p, end - p, nesting_countdown,
                                  me, &next_stack, vars, &first))
        return 0;

      if (p >= end || p->token.type != T_MACRO_ID
          || !ss_equals_case (p->token.string, ss_cstr ("!TO")))
        {
          macro_error (stack, p < end ? p : NULL,
                       _("Expected !TO in numerical !DO loop."));
          return 0;
        }
      p++;

      double last;
      if (!macro_evaluate_number (&p, end - p, nesting_countdown,
                                  me, &next_stack, vars, &last))
        return 0;

      double by = 1.0;
      if (p < end && p->token.type == T_MACRO_ID
          && ss_equals_case (p->token.string, ss_cstr ("!BY")))
        {
          p++;
          if (!macro_evaluate_number (&p, end - p, nesting_countdown,
                                      me, &next_stack, vars, &by))
            return 0;

          if (by == 0.0)
            {
              macro_error (stack, NULL, _("!BY value cannot be zero."));
              return 0;
            }
        }

      const struct macro_token *do_end = find_doend (stack, p, end);
      if (!do_end)
        return 0;
      const struct macro_tokens inner = {
        .mts = CONST_CAST (struct macro_token *, p),
        .n = do_end - p
      };

      if ((by > 0 && first <= last) || (by < 0 && first >= last))
        {
          int i = 0;
          for (double index = first;
               by > 0 ? (index <= last) : (index >= last);
               index += by)
            {
              if (i++ > miterate)
                {
                  macro_error (stack, NULL,
                               _("Numerical !DO loop exceeded "
                                 "maximum number of iterations %d.  "
                                 "(Use SET MITERATE to change the limit.)"),
                               miterate);
                  break;
                }

              char index_s[DBL_BUFSIZE_BOUND];
              c_dtoastr (index_s, sizeof index_s, 0, 0, index);
              string_map_replace_nocopy (vars, ss_xstrdup (var_name),
                                         xstrdup (index_s));

              bool break_ = false;
              macro_expand (&inner, nesting_countdown,
                            me, vars, &next_stack, &break_, exp);
              if (break_)
                break;
            }
        }

      return do_end - tokens + 1;
    }
  else
    {
      macro_error (stack, p < end ? p : NULL,
                   _("Expected `=' or !IN in !DO loop."));
      return 0;
    }
}

static void
macro_expand (const struct macro_tokens *mts, int nesting_countdown,
              const struct macro_expander *me, struct string_map *vars,
              const struct macro_expansion_stack *stack,
              bool *break_, struct macro_tokens *exp)
{
  if (nesting_countdown <= 0)
    {
      macro_error (stack, NULL, _("Maximum nesting level %d exceeded.  "
                                  "(Use SET MNEST to change the limit.)"),
                   settings_get_mnest ());
      for (size_t i = 0; i < mts->n; i++)
        macro_tokens_add (exp, &mts->mts[i]);
      return;
    }

  struct string_map own_vars = STRING_MAP_INITIALIZER (own_vars);
  if (!vars)
    vars = &own_vars;

  for (size_t i = 0; i < mts->n && (!break_ || !*break_); i++)
    {
      const struct macro_token *mt = &mts->mts[i];
      const struct token *token = &mt->token;
      if (token->type == T_MACRO_ID && me->macro)
        {
          const struct macro_param *param = macro_find_parameter_by_name (
            me->macro, token->string);
          if (param)
            {
              const struct macro_tokens *arg = me->args[param - me->macro->params];
              if (*me->expand && param->expand_arg)
                {
                  struct macro_expander subme = {
                    .macros = me->macros,
                    .macro = NULL,
                    .args = NULL,
                    .segmenter_mode = me->segmenter_mode,
                    .expand = me->expand,
                  };
                  macro_expand (arg, nesting_countdown, &subme, NULL,
                                &(struct macro_expansion_stack) {
                                  .name = param->name,
                                  .next = stack,
                                }, break_, exp);
                }
              else
                for (size_t i = 0; i < arg->n; i++)
                  macro_tokens_add (exp, &arg->mts[i]);
              continue;
            }

          if (is_bang_star (mts->mts, mts->n, i))
            {
              for (size_t j = 0; j < me->macro->n_params; j++)
                {
                  const struct macro_param *param = &me->macro->params[j];
                  if (!param->positional)
                    break;

                  const struct macro_tokens *arg = me->args[j];
                  if (*me->expand && param->expand_arg)
                    {
                      struct macro_expander subme = {
                        .macros = me->macros,
                        .macro = NULL,
                        .args = NULL,
                        .segmenter_mode = me->segmenter_mode,
                        .expand = me->expand,
                      };
                      macro_expand (arg, nesting_countdown, &subme, NULL,
                                    &(struct macro_expansion_stack) {
                                      .name = "!*",
                                      .next = stack,
                                    }, break_, exp);
                    }
                  else
                    for (size_t k = 0; k < arg->n; k++)
                      macro_tokens_add (exp, &arg->mts[k]);
                }
              i++;
              continue;
            }

          size_t n = macro_expand_if (&mts->mts[i], mts->n - i,
                                      nesting_countdown, me, stack,
                                      vars, break_, exp);
          if (n > 0)
            {
              i += n - 1;
              continue;
            }
        }

      if (token->type == T_MACRO_ID && vars)
        {
          const char *value = string_map_find__ (vars, token->string.string,
                                                 token->string.length);
          if (value)
            {
              macro_tokens_from_string__ (exp, ss_cstr (value),
                                          me->segmenter_mode, stack);
              continue;
            }
        }

      if (*me->expand)
        {
          struct macro_call *submc;
          int retval = macro_call_create (me->macros, token, &submc);
          for (size_t j = 1; !retval; j++)
            {
              const struct macro_token endcmd
                = { .token = { .type = T_ENDCMD } };
              retval = macro_call_add (
                submc, i + j < mts->n ? &mts->mts[i + j] : &endcmd);
            }
          if (retval > 0)
            {
              i += retval - 1;
              struct macro_expander subme = {
                .macros = submc->macros,
                .macro = submc->macro,
                .args = submc->args,
                .segmenter_mode = me->segmenter_mode,
                .expand = me->expand,
              };
              macro_expand (&submc->macro->body, nesting_countdown - 1,
                            &subme, NULL, &(struct macro_expansion_stack) {
                              .name = submc->macro->name,
                              .file_name = submc->macro->file_name,
                              .first_line = submc->macro->first_line,
                              .last_line = submc->macro->last_line,
                              .next = stack,
                            }, break_, exp);
              macro_call_destroy (submc);
              continue;
            }

          macro_call_destroy (submc);
        }

      if (token->type != T_MACRO_ID)
        {
          macro_tokens_add (exp, mt);
          continue;
        }

      if (ss_equals_case (token->string, ss_cstr ("!break")))
        {
          if (!break_)
            macro_error (stack, mt, _("!BREAK outside !DO."));
          else
            {
              *break_ = true;
              break;
            }
        }

      struct parse_macro_function_ctx ctx = {
        .input = &mts->mts[i],
        .n_input = mts->n - i,
        .nesting_countdown = nesting_countdown,
        .me = me,
        .stack = stack,
        .vars = vars,
      };
      struct string function_output = DS_EMPTY_INITIALIZER;
      size_t function_consumed;
      if (expand_macro_function (&ctx, &function_output, &function_consumed))
        {
          i += function_consumed - 1;

          macro_tokens_from_string__ (exp, function_output.ss,
                                      me->segmenter_mode, stack);
          ds_destroy (&function_output);

          continue;
        }

      size_t n = macro_parse_let (&mts->mts[i], mts->n - i,
                                  nesting_countdown,
                                  me, stack, vars);
      if (n > 0)
        {
          i += n - 1;
          continue;
        }

      n = macro_expand_do (&mts->mts[i], mts->n - i, nesting_countdown, me,
                           stack, vars, exp);
      if (n > 0)
        {
          i += n - 1;
          continue;
        }

      if (ss_equals_case (token->string, ss_cstr ("!onexpand")))
        *me->expand = true;
      else if (ss_equals_case (token->string, ss_cstr ("!offexpand")))
        *me->expand = false;
      else
        macro_tokens_add (exp, mt);
    }
  if (vars == &own_vars)
    string_map_destroy (&own_vars);
}

void
macro_call_expand (struct macro_call *mc, enum segmenter_mode segmenter_mode,
                   struct macro_tokens *exp)
{
  assert (mc->state == MC_FINISHED);

  bool expand = true;
  struct macro_expander me = {
    .macros = mc->macros,
    .macro = mc->macro,
    .args = mc->args,
    .segmenter_mode = segmenter_mode,
    .expand = &expand,
  };

  struct macro_expansion_stack stack = {
    .name = mc->macro->name,
    .file_name = mc->macro->file_name,
    .first_line = mc->macro->first_line,
    .last_line = mc->macro->last_line,
  };
  macro_expand (&mc->macro->body, settings_get_mnest (),
                &me, NULL, &stack, NULL, exp);
}