Improve macro error messages.

[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)

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);
}

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);
}

void
macro_tokens_from_string (struct macro_tokens *mts, const struct substring src,
                          enum segmenter_mode mode)
{
  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'. */
      if (is_scan_type (token->type))
        {
          if (token->type != SCAN_SKIP)
            {
              printf ("error\n");
              /* XXX report error */
            }
        }
      else
        {
          mt.representation.length = state.body.string - mt.representation.string;
          macro_tokens_add (mts, &mt);
        }
      token_uninit (token);
    }
}

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 ();
}

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)
{
  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
struct macro_expansion_stack
  {
    const struct macro_expansion_stack *next;
    const char *name;
    const char *file_name;
    int first_line;
    int last_line;
  };

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];
              lex_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);
}

enum me_state
  {
    /* Error state. */
    ME_ERROR,

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

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

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

    /* Expecting an equal sign for a keyword argument. */
    ME_EQUALS,
  };


struct macro_expander
  {
    const struct macro_set *macros;

    enum me_state state;
    size_t n_tokens;

    const struct macro *macro;
    struct macro_tokens **args;
    const struct macro_param *param;
  };

static int
me_finished (struct macro_expander *me)
{
  for (size_t i = 0; i < me->macro->n_params; i++)
    if (!me->args[i])
      {
        me->args[i] = xmalloc (sizeof *me->args[i]);
        macro_tokens_copy (me->args[i], &me->macro->params[i].def);
      }
  return me->n_tokens;
}

static int
me_next_arg (struct macro_expander *me)
{
  if (!me->param)
    {
      assert (!me->macro->n_params);
      return me_finished (me);
    }
  else if (me->param->positional)
    {
      me->param++;
      if (me->param >= &me->macro->params[me->macro->n_params])
        return me_finished (me);
      else
        {
          me->state = (!me->param->positional ? ME_KEYWORD
                       : me->param->arg_type == ARG_ENCLOSE ? ME_ENCLOSE
                       : ME_ARG);
          return 0;
        }
    }
  else
    {
      for (size_t i = 0; i < me->macro->n_params; i++)
        if (!me->args[i])
          {
            me->state = ME_KEYWORD;
            return 0;
          }
      return me_finished (me);
    }
}

static int
me_error (struct macro_expander *me)
{
  me->state = ME_ERROR;
  return -1;
}

static int
me_add_arg (struct macro_expander *me, const struct macro_token *mt)
{
  const struct macro_param *p = me->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."), me->param->name, me->macro->name);

      return me_error (me);
    }

  me->n_tokens++;

  struct macro_tokens **argp = &me->args[p - me->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 me_next_arg (me);
      return 0;
    }
  else if (p->arg_type == ARG_CMDEND)
    {
      if (token->type == T_ENDCMD || token->type == T_STOP)
        return me_next_arg (me);
      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 me_next_arg (me);
      macro_tokens_add (arg, mt);
      return 0;
    }
}

static int
me_expected (struct macro_expander *me, 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,
       me->param->name, me->macro->name);
  free (expected_s);

  return me_error (me);
}

static int
me_enclose (struct macro_expander *me, const struct macro_token *mt)
{
  const struct token *token = &mt->token;
  me->n_tokens++;

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

  return me_expected (me, mt, &me->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
me_keyword (struct macro_expander *me, const struct macro_token *mt)
{
  const struct token *token = &mt->token;
  if (token->type != T_ID)
    return me_finished (me);

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

      me->n_tokens++;
      me->state = ME_EQUALS;
      return 0;
    }

  return me_finished (me);
}

static int
me_equals (struct macro_expander *me, const struct macro_token *mt)
{
  const struct token *token = &mt->token;
  me->n_tokens++;

  if (token->type == T_EQUALS)
    {
      me->state = ME_ARG;
      return 0;
    }

  return me_expected (me, mt, &(struct token) { .type = T_EQUALS });
}

int
macro_expander_create (const struct macro_set *macros,
                       const struct token *token,
                       struct macro_expander **mep)
{
  *mep = NULL;
  if (macro_set_is_empty (macros))
    return -1;
  if (token->type != T_ID && token->type != T_MACRO_ID)
    return -1;

  const struct macro *macro = macro_set_find (macros, token->string.string);
  if (!macro)
    return -1;

  struct macro_expander *me = xmalloc (sizeof *me);
  *me = (struct macro_expander) {
    .macros = macros,
    .n_tokens = 1,
    .macro = macro,
  };
  *mep = me;

  if (!macro->n_params)
    return 1;
  else
    {
      me->state = (!macro->params[0].positional ? ME_KEYWORD
                   : macro->params[0].arg_type == ARG_ENCLOSE ? ME_ENCLOSE
                   : ME_ARG);
      me->args = xcalloc (macro->n_params, sizeof *me->args);
      me->param = macro->params;
      return 0;
    }
}

void
macro_expander_destroy (struct macro_expander *me)
{
  if (!me)
    return;

  for (size_t i = 0; i < me->macro->n_params; i++)
    if (me->args[i])
      {
        macro_tokens_uninit (me->args[i]);
        free (me->args[i]);
      }
  free (me->args);
  free (me);
}

/* Adds TOKEN to the collection of tokens in ME 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.

   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_expander_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_expander_get_expansion() to obtain the expansion. */
int
macro_expander_add (struct macro_expander *me, const struct macro_token *mt)
{
  switch (me->state)
    {
    case ME_ERROR:
      return -1;

    case ME_ARG:
      return me_add_arg (me, mt);

    case ME_ENCLOSE:
      return me_enclose (me, mt);

    case ME_KEYWORD:
      return me_keyword (me, mt);

    case ME_EQUALS:
      return me_equals (me, mt);

    default:
      NOT_REACHED ();
    }
}

/* 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_set *macros;
    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_set *,
              const struct macro_expander *, struct string_map *vars,
              const struct macro_expansion_stack *stack,
              bool *expand, 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)
    {
      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,
        .macros = ctx->macros,
        .me = ctx->me,
        .stack = ctx->stack,
        .vars = ctx->vars,
        .expand = ctx->expand,
      };
      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, struct string *content)
{
  struct string_lexer slex;
  string_lexer_init (&slex, s, strlen (s), SEG_MODE_INTERACTIVE /* XXX */,
                     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, struct string *tmp)
{
  ds_init_empty (tmp);
  return unquote_string (s, 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], 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], &tmp);

      struct macro_tokens mts = { .n = 0 };
      macro_tokens_from_string (&mts, ss_cstr (s), SEG_MODE_INTERACTIVE /* XXX */);
      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], 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[1]);
          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], &tmp);

      struct macro_tokens mts = { .n = 0 };
      macro_tokens_from_string (&mts, ss_cstr (s), SEG_MODE_INTERACTIVE /* XXX */);
      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], 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], &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]),
                                SEG_MODE_INTERACTIVE /* XXX */);
      struct macro_tokens exp = { .n = 0 };
      macro_expand (&mts, ctx->nesting_countdown - 1, ctx->macros, ctx->me,
                    ctx->vars,
                    &(struct macro_expansion_stack) {
                      .name = "!EVAL",
                      .next = ctx->stack,
                    }, ctx->expand, 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_set *macros;
    const struct macro_expander *me;
    const struct macro_expansion_stack *stack;
    struct string_map *vars;
    bool *expand;
  };

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;
    }

  struct parse_macro_function_ctx fctx = {
    .input = p,
    .n_input = end - p,
    .nesting_countdown = ctx->nesting_countdown,
    .macros = ctx->macros,
    .me = ctx->me,
    .stack = ctx->stack,
    .vars = ctx->vars,
    .expand = ctx->expand,
  };
  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), &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/*XXX*/ (unquote_string_in_place (lhs, &lhs_tmp),
                           unquote_string_in_place (rhs, &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
            :/*op == 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_set *macros,
                           const struct macro_expander *me,
                           const struct macro_expansion_stack *stack,
                           struct string_map *vars, bool *expand)
{
  const struct expr_context ctx = {
    .nesting_countdown = nesting_countdown,
    .macros = macros,
    .me = me,
    .stack = stack,
    .vars = vars,
    .expand = expand,
  };
  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_set *macros,
                       const struct macro_expander *me,
                       const struct macro_expansion_stack *stack,
                       struct string_map *vars,
                       bool *expand, double *number)
{
  char *s = macro_evaluate_expression (tokens, n_tokens, nesting_countdown,
                                       macros, me, stack, vars, expand);
  if (!s)
    return false;

  struct macro_tokens mts = { .n = 0 };
  macro_tokens_from_string (&mts, ss_cstr (s), SEG_MODE_INTERACTIVE /* XXX */);
  if (mts.n != 1 || !token_is_number (&mts.mts[0].token))
    {
      macro_tokens_print (&mts, stdout);
      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_set *macros,
                 const struct macro_expander *me,
                 const struct macro_expansion_stack *stack,
                 struct string_map *vars,
                 bool *expand, 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, macros, me,
                                            stack, vars, expand);
  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, macros, me, vars,
                    &(struct macro_expansion_stack) {
                      .name = "!IF",
                      .next = stack,
                    },
                    expand, 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_set *macros,
                 const struct macro_expander *me,
                 const struct macro_expansion_stack *stack,
                 struct string_map *vars, bool *expand)
{
  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)
      || 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, macros, me, stack,
                                           vars, expand);
  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_set *macros,
                 const struct macro_expander *me,
                 const struct macro_expansion_stack *stack,
                 struct string_map *vars,
                 bool *expand, 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)
      || 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, macros, me,
                                              &next_stack, vars, expand);
      if (!list)
        return 0;

      struct macro_tokens items = { .n = 0 };
      macro_tokens_from_string (&items, ss_cstr (list),
                                SEG_MODE_INTERACTIVE /* XXX */);
      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, macros,
                        me, vars, &next_stack, expand, &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, macros, me,
                                  &next_stack, vars, expand, &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, macros, me,
                                  &next_stack, vars, expand, &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, macros, me,
                                      &next_stack, vars, expand, &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, macros,
                            me, vars, &next_stack, expand, &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_set *macros,
              const struct macro_expander *me, struct string_map *vars,
              const struct macro_expansion_stack *stack,
              bool *expand, bool *break_, struct macro_tokens *exp)
{
  if (nesting_countdown <= 0)
    {
      macro_error (stack, NULL, _("Maximum nesting level %d exceeded."),
                   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)
        {
          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 (*expand && param->expand_arg)
                macro_expand (arg, nesting_countdown, macros, NULL, NULL,
                              &(struct macro_expansion_stack) {
                                .name = param->name,
                                .next = stack,
                              }, expand, 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 (*expand && param->expand_arg)
                    macro_expand (arg, nesting_countdown, macros, NULL, NULL,
                                  &(struct macro_expansion_stack) {
                                    .name = "!*",
                                    .next = stack,
                                  }, expand, 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, macros, me, stack,
                                      vars, expand, 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),
                                        SEG_MODE_INTERACTIVE /* XXX */);
              continue;
            }
        }

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

          macro_expander_destroy (subme);
        }

      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,
        .macros = macros,
        .me = me,
        .stack = stack,
        .vars = vars,
        .expand = expand,
      };
      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,
                                    SEG_MODE_INTERACTIVE /* XXX */);
          ds_destroy (&function_output);

          continue;
        }

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

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

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

void
macro_expander_get_expansion (struct macro_expander *me, struct macro_tokens *exp)
{
  bool expand = true;
  struct macro_expansion_stack stack = {
    .name = me->macro->name,
    .file_name = me->macro->file_name,
    .first_line = me->macro->first_line,
    .last_line = me->macro->last_line,
  };
  macro_expand (&me->macro->body, settings_get_mnest (),
                me->macros, me, NULL, &stack, &expand, NULL, exp);
}