#include <assert.h>
#include <ctype.h>
#include <limits.h>  /* for INT_MAX */
#include <stdio.h>   /* printf etc */
#include <stdlib.h>  /* exit */
#include <string.h>  /* memmove */
#include "header.h"

/* recursive usage: */

static void read_program_(struct analyser * a, int terminator);
static struct node * read_C(struct analyser * a);
static struct node * new_string_command(struct analyser * a, int token);

static void print_node_(const struct node * p, int n, const char * s) {
    printf("%*s%s", n * 2, s, name_of_token(p->type));
    if (p->name) {
        putchar(' ');
        report_s(stdout, p->name->s);
    }
    if (p->literalstring) {
        printf(" '");
        report_b(stdout, p->literalstring);
        printf("'");
    } else if (p->type == c_number) {
        printf(" %d", p->number);
    }
    printf("\n");
    if (p->AE) print_node_(p->AE, n+1, "# ");
    if (p->left) print_node_(p->left, n+1, "");
    if (p->aux) print_node_(p->aux, n+1, "@ ");
    if (p->right) print_node_(p->right, n, "");
}

extern void print_program(struct analyser * a) {
    if (a->program) print_node_(a->program, 0, "");
}

static void free_among(struct among * q) {
    FREE(q->v);
    FREE(q->commands);
    FREE(q);
}

static struct node * new_node_at_line(struct analyser * a, int type, int line) {
    NEW(node, p);
    *p = (struct node){0};
    p->mode = a->mode;
    p->line_number = line;
    p->type = type;
    p->next = a->nodes;
    a->nodes = p;
    return p;
}

static struct node * new_node(struct analyser * a, int type) {
    return new_node_at_line(a, type, a->tokeniser->line_number);
}

static const char * name_of_mode(int n) {
    switch (n) {
        case m_backward: return "string backward";
        case m_forward:  return "string forward";
    }
    fprintf(stderr, "Invalid mode %d in name_of_mode()\n", n);
    exit(1);
}

static const char * name_of_type(int code) {
    switch (code) {
        case t_string: return "string";
        case t_boolean: return "boolean";
        case t_integer: return "integer";
        case t_routine: return "routine";
        case t_external: return "external";
        case t_grouping: return "grouping";
    }
    fprintf(stderr, "Invalid type code %d in name_of_type()\n", code);
    exit(1);
}

static void count_error(struct analyser * a) {
    struct tokeniser * t = a->tokeniser;
    if (t->error_count >= 20) { fprintf(stderr, "... etc\n"); exit(1); }
    t->error_count++;
}

static void report_error_location_line(struct analyser * a, int line) {
    struct tokeniser * t = a->tokeniser;
    count_error(a);
    fprintf(stderr, "%s:%d: ", t->file, line);
}

static void report_error_location(struct analyser * a) {
    struct tokeniser * t = a->tokeniser;
    report_error_location_line(a, t->line_number);
}

static void report_error_after(struct analyser * a) {
    struct tokeniser * t = a->tokeniser;
    if (t->previous_token > 0)
        fprintf(stderr, " after %s", name_of_token(t->previous_token));
}

static void omission_error(struct analyser * a, int n) {
    report_error_location(a);
    fprintf(stderr, "%s omitted", name_of_token(n));
    report_error_after(a);
    putc('\n', stderr);
}

static void unexpected_token_error(struct analyser * a,
                                   const char * context) {
    struct tokeniser * t = a->tokeniser;
    if (t->token_reported_as_unexpected) {
        // Avoid duplicate errors if this token was already reported as
        // unexpected and then held.
        return;
    }
    report_error_location(a);
    t->token_reported_as_unexpected = true;
    fprintf(stderr, "unexpected %s", name_of_token(t->token));
    if (t->token == c_number) fprintf(stderr, " %d", t->number);
    if (t->token == c_name) {
        fprintf(stderr, " %.*s", SIZE(t->s), t->s);
    }
    if (context) {
        fprintf(stderr, " in %s", context);
    }
    report_error_after(a);
    putc('\n', stderr);
    // If the token is `)` then always hold it as the actual problem is almost
    // certainly another token missing before it.
    if (t->token == c_ket) hold_token(t);
}

static void substring_without_among_error(struct analyser * a) {
    count_error(a);
    fprintf(stderr, "%s:%d: 'substring' with no matching 'among'\n",
            a->tokeniser->file, a->substring->line_number);
}

static int check_token(struct analyser * a, int code) {
    struct tokeniser * t = a->tokeniser;
    if (t->token != code) {
        omission_error(a, code);
        hold_token(t);
        return false;
    }
    return true;
}

static void hold_token_if_toplevel(struct tokeniser * t) {
    // Hold token if it starts a top-level construct.
    switch (t->token) {
        case c_backwardmode:
        case c_booleans:
        case c_define:
        case c_externals:
        case c_groupings:
        case c_integers:
        case c_routines:
        case c_strings:
            hold_token(t);
    }
}

static int get_token(struct analyser * a, int code) {
    struct tokeniser * t = a->tokeniser;
    read_token(t);
    return check_token(a, code);
}

static struct name * look_for_name(struct analyser * a) {
    const byte * q = a->tokeniser->s;
    for (struct name * p = a->names; p; p = p->next) {
        byte * b = p->s;
        int n = SIZE(b);
        if (n == SIZE(q) && memcmp(q, b, n) == 0) {
            ++p->references;
            return p;
        }
    }
    return NULL;
}

static struct name * find_name(struct analyser * a) {
    struct name * p = look_for_name(a);
    if (p == NULL) {
        report_error_location(a);
        byte * s = a->tokeniser->s;
        fprintf(stderr, "'%.*s' undeclared\n", SIZE(s), s);
    }
    return p;
}

static void check_routine_mode(struct analyser * a, struct name * p, int mode) {
    if (p->mode == m_unknown) {
        p->mode = mode;
    } else if (p->mode != mode) {
        report_error_location(a);
        fprintf(stderr, "%s '%.*s' mis-used in %s mode\n",
                name_of_type(p->type),
                SIZE(p->s), p->s,
                name_of_mode(mode));
    }
}

static int check_name_type(struct analyser * a, struct name * p, int type) {
    if (p->type == type) return true;
    if (type == t_routine && p->type == t_external) return true;
    report_error_location(a);
    fprintf(stderr, "'%.*s' not of type %s\n",
            SIZE(p->s), p->s,
            type == t_routine ? "routine or external" : name_of_type(type));
    return false;
}

static void read_names(struct analyser * a, int type) {
    struct tokeniser * t = a->tokeniser;
    if (!get_token(a, c_bra)) return;
    while (true) {
        int token = read_token(t);
        switch (token) {
            case c_len: {
                /* Context-sensitive token - once declared as a name, it loses
                 * its special meaning, for compatibility with older versions
                 * of snowball.
                 */
                SET_SIZE(t->s, 0);
                t->s = add_literal_to_s(t->s, "len");
                goto handle_as_name;
            }
            case c_lenof: {
                /* Context-sensitive token - once declared as a name, it loses
                 * its special meaning, for compatibility with older versions
                 * of snowball.
                 */
                SET_SIZE(t->s, 0);
                t->s = add_literal_to_s(t->s, "lenof");
                goto handle_as_name;
            }
            case c_name:
handle_as_name:
                if (token != c_name) {
                    disable_token(t, token);
                }
                if (look_for_name(a) != NULL) {
                    report_error_location(a);
                    fprintf(stderr, "'%.*s' re-declared\n", SIZE(t->s), t->s);
                } else {
                    NEW(name, p);
                    *p = (struct name){0};
                    p->mode = m_unknown; /* used for routines, externals */
                    p->s = copy_s(t->s);
                    p->type = type;
                    /* Delay assigning counts until after we've eliminated
                     * variables whose values are never used and checked for
                     * variables which can be localised.
                     */
                    p->count = -1;
                    p->declaration_line_number = t->line_number;
                    // Check if any existing names of the same type differ
                    // only by case - if we find one we set a flag so we know
                    // to mangle this name for languages with case-insensitive
                    // identifiers.  (Note that the first declared name of any
                    // group of colliding names collision doesn't get this flag
                    // set so won't get mangled.)
                    for (struct name * q = a->names; q; q = q->next) {
                        if (q->type != type) continue;
                        byte * b = q->s;
                        int n = SIZE(b);
                        if (n != SIZE(p->s)) continue;
                        for (int i = 0; i < n; ++i) {
                            if (tolower(p->s[i]) != tolower(b[i]))
                                goto next_name;
                        }
                        p->case_collision = true;
                        goto done_case_check;

next_name: ;
                    }
done_case_check:
                    p->next = a->names;
                    a->names = p;
                }
                break;
            default:
                check_token(a, c_ket);
                return;
        }
    }
}

static symbol * new_literalstring(struct analyser * a) {
    NEW(literalstring, p);
    p->b = copy_b(a->tokeniser->b);
    p->next = a->literalstrings;
    a->literalstrings = p;
    return p->b;
}

static int read_AE_test(struct analyser * a) {
    struct tokeniser * t = a->tokeniser;
    switch (read_token(t)) {
        case c_assign:
        case c_plusassign:
        case c_minusassign:
        case c_multiplyassign:
        case c_divideassign:
        case c_eq:
        case c_ne:
        case c_gt:
        case c_ge:
        case c_lt:
        case c_le:
            return t->token;
        case c_slicefrom:
            // In an AE c_slicefrom (`<-`) is not a valid token, so convert
            // it into c_lt (`<`) then c_minus (`-`) so that code such as
            // `$x<-1` works rather than giving a syntax error.
            push_token(t, c_minus);
            return c_lt;
        default:
            unexpected_token_error(a, "integer test expression");
            hold_token(t);
            return c_eq;
    }
}

static int binding(int t) {
    switch (t) {
        case c_plus: case c_minus: return 1;
        case c_multiply: case c_divide: return 2;
        default: return -2;
    }
}

static void mark_used_in(struct analyser * a, struct name * q, struct node * p) {
    (void)a;
    if (!q->used) {
        q->used = p;
    }
}

static void name_to_node(struct analyser * a, struct node * p, int type) {
    struct name * q = find_name(a);
    if (q) {
        check_name_type(a, q, type);
        mark_used_in(a, q, p);
    }
    p->name = q;
}

static struct node * read_AE(struct analyser * a, struct name * assigned_to, int B) {
    struct tokeniser * t = a->tokeniser;
    struct node * p;
    struct node * q;
    switch (read_token(t)) {
        case c_minus: { /* monadic */
            // Note current line number so c_neg node reports the right line.
            int neg_line = a->tokeniser->line_number;
            q = read_AE(a, assigned_to, 100);
            if (q->type == c_neg) {
                /* Optimise away double negation, which avoids generators
                 * having to worry about generating "--" (decrement operator
                 * in many languages).
                 */
                p = q->right;
                /* Don't free q, it's in the linked list a->nodes. */
                break;
            }
            if (q->type == c_number) {
                /* Negated constant. */
                q->number = -q->number;
                p = q;
                break;
            }
            p = new_node_at_line(a, c_neg, neg_line);
            p->right = q;
            break;
        }
        case c_bra:
            p = read_AE(a, assigned_to, 0);
            get_token(a, c_ket);
            break;
        case c_name:
            p = new_node(a, c_name);
            name_to_node(a, p, t_integer);
            if (p->name) {
                // $x = x + 1 shouldn't count as a use of x.
                p->name->value_used = (p->name != assigned_to);
            }
            break;
        case c_maxint:
        case c_minint:
            a->int_limits_used = true;
            /* fall through */
        case c_cursor:
        case c_limit:
        case c_len:
        case c_size:
            p = new_node(a, t->token);
            break;
        case c_number:
            p = new_node(a, c_number);
            p->number = t->number;
            p->fixed_constant = true;
            break;
        case c_lenof:
        case c_sizeof: {
            int token = t->token;
            p = new_string_command(a, token);
            if (!p->literalstring) {
                if (p->name) p->name->value_used = true;
                break;
            }

            /* Replace lenof or sizeof on a literal string with a numeric
             * constant.
             */
            int result = 0;
            if (token == c_lenof && t->encoding == ENC_UTF8) {
                // UTF-8.
                symbol * b = p->literalstring;
                int dummy;
                for (int i = 0; i < SIZE(b); i += get_utf8(b + i, &dummy)) {
                    ++result;
                }
            } else {
                result = SIZE(p->literalstring);
            }
            p->type = c_number;
            p->literalstring = NULL;
            p->number = result;
            p->fixed_constant = (token == c_lenof);
            break;
        }
        default:
            unexpected_token_error(a, "integer expression");
            hold_token(t);
            return NULL;
    }
    while (true) {
        int token = read_token(t);
        int op_line = t->line_number;
        int b = binding(token);
        if (binding(token) <= B) {
            hold_token(t);
            return p;
        }
        struct node * r = read_AE(a, assigned_to, b);
        if (p->type == c_number &&
            r->type == c_number &&
            // Can't evaluate division by zero.
            !(token == c_divide && r->number == 0)) {
            // Evaluate constant sub-expression.
            q = p;
            switch (token) {
                case c_plus:
                    q->number += r->number;
                    break;
                case c_minus:
                    q->number -= r->number;
                    break;
                case c_multiply:
                    q->number *= r->number;
                    break;
                case c_divide:
                    q->number /= r->number;
                    break;
                default:
                    fprintf(stderr, "Unexpected AE operator %s\n",
                            name_of_token(token));
                    exit(1);
            }
            q->fixed_constant = q->fixed_constant && r->fixed_constant;
        } else {
            // Check for specific constant or no-op cases.
            q = NULL;
            switch (token) {
                case c_plus:
                    // 0 + r is r
                    if (p->type == c_number && p->number == 0) {
                        q = r;
                        break;
                    }
                    // p + 0 is p
                    if (r->type == c_number && r->number == 0) {
                        q = p;
                        break;
                    }
                    break;
                case c_minus:
                    // 0 - r is -r
                    if (p->type == c_number && p->number == 0) {
                        q = new_node_at_line(a, c_neg, op_line);
                        q->right = r;
                        break;
                    }
                    // p - 0 is p
                    if (r->type == c_number && r->number == 0) {
                        q = p;
                        break;
                    }
                    break;
                case c_multiply:
                    // 0 * r is 0
                    if (p->type == c_number && p->number == 0) {
                        q = p;
                        break;
                    }
                    // p * 0 is 0
                    if (r->type == c_number && r->number == 0) {
                        q = r;
                        break;
                    }
                    // -1 * r is -r
                    if (p->type == c_number && p->number == -1) {
                        q = new_node_at_line(a, c_neg, p->line_number);
                        q->right = r;
                        break;
                    }
                    // p * -1 is -p
                    if (r->type == c_number && r->number == -1) {
                        q = new_node_at_line(a, c_neg, r->line_number);
                        q->right = p;
                        break;
                    }
                    // 1 * r is r
                    if (p->type == c_number && p->number == 1) {
                        q = r;
                        break;
                    }
                    // p * 1 is p
                    if (r->type == c_number && r->number == 1) {
                        q = p;
                        break;
                    }
                    break;
                case c_divide:
                    // p / 1 is p
                    if (r->type == c_number && r->number == 1) {
                        q = p;
                        break;
                    }
                    // p / -1 is -p
                    if (r->type == c_number && r->number == -1) {
                        q = new_node_at_line(a, c_neg, r->line_number);
                        q->right = p;
                        break;
                    }
                    // p / 0 is an error!
                    if (r->type == c_number && r->number == 0) {
                        report_error_location_line(a, op_line);
                        fprintf(stderr, "Division by zero\n");
                    }
                    break;
            }
            if (!q) {
                q = new_node_at_line(a, token, op_line);
                q->left = p;
                q->right = r;
            }
        }
        p = q;
    }
}

static int
is_just_false(struct node * q)
{
    if (!q) return 1;
    if (q->type == c_false) return 1;
    if (q->type != c_bra) return 0;
    return is_just_false(q->left);
}

static struct node * read_or(struct analyser * a, struct node * n) {
    struct tokeniser * t = a->tokeniser;
    // Note current line number so c_or node reports the right line.
    int or_line = t->line_number;
    struct node * p = is_just_false(n) ? NULL : n;
    struct node * p_end = p;
    do {
        struct node * q = read_C(a);
        // Discard `false` nodes in an `or` chain.
        if (!is_just_false(q)) {
            if (p_end) {
                p_end->right = q;
            } else {
                p = q;
            }
            p_end = q;
        }
    } while (read_token(t) == c_or);
    hold_token(t);
    if (p == NULL) {
        // All sub-nodes are `false` so return the first.
        return n;
    } else if (p->right == NULL) {
        return p;
    }
    n = new_node_at_line(a, c_or, or_line);
    n->left = p;
    return n;
}

static int
is_just_true(struct node * q)
{
    if (!q) return 1;
    if (q->type != c_bra && q->type != c_true) return 0;
    return is_just_true(q->left) && is_just_true(q->right);
}

static struct node * read_and(struct analyser * a, struct node * n) {
    struct tokeniser * t = a->tokeniser;
    // Note current line number so c_and node reports the right line.
    int and_line = t->line_number;
    struct node * p = is_just_true(n) ? NULL : n;
    struct node * p_end = p;
    do {
        struct node * q = read_C(a);
        // Discard nodes equivalent to `true` in an `and` chain.
        if (!is_just_true(q)) {
            if (p_end) {
                p_end->right = q;
            } else {
                p = q;
            }
            p_end = q;
        }
    } while (read_token(t) == c_and);
    hold_token(t);
    if (p == NULL) {
        // Note: is_just_true(n).
        return n;
    } else if (p->right == NULL) {
        return p;
    }
    n = new_node_at_line(a, c_and, and_line);
    n->left = p;
    return n;
}

static struct node * read_C_list(struct analyser * a) {
    struct tokeniser * t = a->tokeniser;
    struct node * p = new_node(a, c_bra);
    struct node * p_end = NULL;
    while (true) {
        int token = read_token(t);
        if (token == c_ket) return p;
        if (token < 0) { omission_error(a, c_ket); return p; }
        hold_token(t);

        struct node * q = read_C(a);
        while (true) {
            token = read_token(t);
            if (token == c_or) {
                q = read_or(a, q);
            } else if (token == c_and) {
                q = read_and(a, q);
            } else {
                hold_token(t);
                break;
            }
        }
        if (p_end == NULL) p->left = q; else p_end->right = q;
        p_end = q;
    }
}

static struct node * new_string_command(struct analyser * a, int token) {
    struct node * p = new_node(a, token);
    int str_token = read_token(a->tokeniser);
    if (str_token == c_literalstring) {
        p->literalstring = new_literalstring(a);
    } else if (str_token == c_name) {
        name_to_node(a, p, t_string);
    } else {
        report_error_location(a);
        fprintf(stderr, "string omitted");
        report_error_after(a);
        putc('\n', stderr);
        hold_token(a->tokeniser);
    }
    return p;
}

static struct node * read_literalstring(struct analyser * a) {
    struct node * p = new_node(a, c_literalstring);
    p->literalstring = new_literalstring(a);
    return p;
}

static void reverse_b(symbol * b) {
    int i = 0; int j = SIZE(b) - 1;
    while (i < j) {
        int ch1 = b[i]; int ch2 = b[j];
        b[i++] = ch2; b[j--] = ch1;
    }
}

static int compare_amongvec(const void *pv, const void *qv) {
    const struct amongvec * p = (const struct amongvec*)pv;
    const struct amongvec * q = (const struct amongvec*)qv;
    symbol * b_p = p->b; int p_size = p->size;
    symbol * b_q = q->b; int q_size = q->size;
    int smaller_size = p_size < q_size ? p_size : q_size;
    for (int i = 0; i < smaller_size; i++)
        if (b_p[i] != b_q[i]) return b_p[i] - b_q[i];
    if (p_size - q_size)
        return p_size - q_size;
    return p->string_index - q->string_index;
}

#define nodes_equivalent(P, Q) \
    ((P) == (Q) || ((P) && (Q) && nodes_equivalent_((P), (Q))))

static int nodes_equivalent_(const struct node *p, const struct node *q) {
    if (p == q) return true;
    if (p == NULL || q == NULL) return false;

    if (p->type != q->type) return false;
    if (p->mode != q->mode) return false;
    if (p->type == c_number) {
        if (p->number != q->number)
            return false;
    }

    if (!nodes_equivalent(p->left, q->left)) return false;
    if (!nodes_equivalent(p->AE, q->AE)) return false;
    if (!nodes_equivalent(p->aux, q->aux)) return false;

    if (p->name != q->name) return false;

    if (p->literalstring != q->literalstring) {
        if (!p->literalstring ||
            !q->literalstring ||
            SIZE(p->literalstring) != SIZE(q->literalstring) ||
            memcmp(p->literalstring, q->literalstring,
                   SIZE(p->literalstring) * sizeof(symbol)) != 0) {
            return false;
        }
    }

    return nodes_equivalent(p->right, q->right);
}

static struct node * make_among(struct analyser * a, struct node * p, struct node * substring) {
    NEW(among, x);
    NEWVEC(amongvec, v, p->number);
    struct node * q = p->left;
    struct node * starter = NULL;
    struct amongvec * w0 = v;
    struct amongvec * w1 = v;
    int result = 1;

    int direction = substring != NULL ? substring->mode : p->mode;
    int backward = direction == m_backward;

    *x = (struct among){0};
    x->node = p;
    x->v = v;
    x->shortest_size = INT_MAX;

    if (q->type == c_bra) {
        fprintf(stderr,
                "%s:%d: warning: among starter is a legacy feature - put "
                "starter code between `substring` and `among` instead\n",
                a->tokeniser->file, q->line_number);
        starter = q;
        p->left = q = q->right;
    }

    int string_index = 0;
    while (q) {
        if (q->type == c_literalstring) {
            symbol * b = q->literalstring;
            w1->b = b;           /* pointer to case string */
            w1->action = NULL;   /* action gets filled in later */
            w1->line_number = q->line_number;
            w1->size = SIZE(b);  /* number of characters in string */
            w1->i = -1;          /* index of longest substring */
            w1->result = -1;     /* number of corresponding case expression */
            w1->string_index = string_index++;
            if (q->left) {
                struct name * function = q->left->name;
                w1->function = function;
                ++function->uses_in_among;
                check_routine_mode(a, function, direction);
                if (function->among_index == 0) {
                    function->among_index = ++x->unique_function_count;
                }
                ++x->function_count;
                w1->function_index = function->among_index;
            } else {
                w1->function = NULL;
                w1->function_index = 0;
                if (w1->size == 0) {
                    // This among contains the empty string without a gating
                    // function so it will always match.
                    x->always_matches = true;
                }
            }
            w1++;
        } else if (q->left == NULL) {
            /* empty command: () */
            w0 = w1;
        } else {
            /* Check for previous action which is the same as this one and use
             * the same action code if we find one.
             */
            int among_result = -1;
            struct node * action = q;
            struct amongvec * w;
            for (w = v; w < w0; ++w) {
                if (w->action && nodes_equivalent(w->action->left, q->left)) {
                    if (w->result <= 0) {
                        printf("Among code %d isn't positive\n", w->result);
                        exit(1);
                    }
                    action = w->action;
                    among_result = w->result;
                    break;
                }
            }
            if (among_result < 0) {
                among_result = result++;
            }

            while (w0 != w1) {
                w0->action = action;
                w0->result = among_result;
                w0++;
            }
        }
        q = q->right;
    }
    if (w1-v != p->number) { fprintf(stderr, "oh! %d %d\n", (int)(w1-v), p->number); exit(1); }
    x->command_count = result - 1;
    {
        NEWVEC(node*, commands, x->command_count);
        x->same_action = -2;
        for (int i = 0; i != x->command_count; ++i)
            commands[i] = NULL;
        for (w0 = v; w0 < w1; w0++) {
            if (w0->result > 0) {
                /* result == -1 when there's no command. */
                if (w0->result > x->command_count) {
                    fprintf(stderr, "More among codes than expected\n");
                    exit(1);
                }
                if (!commands[w0->result - 1]) {
                    commands[w0->result - 1] = w0->action;
                    // Check if all actions are a single command of the same
                    // type with a literalstring argument.
                    if (x->same_action > -1) {
                        if (w0->action->left->right ||
                            !w0->action->left->literalstring ||
                            x->same_action != w0->action->left->type) {
                            x->same_action = -1;
                        }
                    } else if (x->same_action == -2) {
                        if (w0->action->left->right ||
                            !w0->action->left->literalstring) {
                            x->same_action = -1;
                        } else {
                            x->same_action = w0->action->left->type;
                        }
                    }
                }
            } else {
                ++x->nocommand_count;
            }
            if (backward) reverse_b(w0->b);
        }
        x->commands = commands;
    }
    qsort(v, w1 - v, sizeof(struct amongvec), compare_amongvec);

    /* the following loop is O(n squared) */
    for (w0 = w1 - 1; w0 >= v; w0--) {
        symbol * b = w0->b;
        int size = w0->size;
        struct amongvec * w;

        if (size) {
            if (size < x->shortest_size) x->shortest_size = size;
            if (size > x->longest_size) x->longest_size = size;
        }

        for (w = w0 - 1; w >= v; w--) {
            if (w->size < size && memcmp(w->b, b, w->size * sizeof(symbol)) == 0) {
                w0->i = (int)(w - v);  /* fill in index of longest substring */
                break;
            }
        }
    }
    if (backward) for (w0 = v; w0 < w1; w0++) reverse_b(w0->b);

    for (w0 = v; w0 < w1 - 1; w0++)
        if (w0->size == (w0 + 1)->size &&
            memcmp(w0->b, (w0 + 1)->b, w0->size * sizeof(symbol)) == 0) {
            count_error(a);
            fprintf(stderr, "%s:%d: among(...) has repeated string '",
                    a->tokeniser->file, (w0 + 1)->line_number);
            report_b(stderr, (w0 + 1)->b);
            fprintf(stderr, "'\n");
            count_error(a);
            fprintf(stderr, "%s:%d: previously seen here\n",
                    a->tokeniser->file, w0->line_number);
        }

    x->literalstring_count = p->number;
    p->among = x;

    if (starter) {
        starter->right = p;
        p = new_node_at_line(a, c_bra, starter->line_number);
        if (substring) {
            p->left = starter;
        } else {
            substring = new_node_at_line(a, c_substring, starter->line_number);
            substring->right = starter;
            p->left = substring;
        }
    }

    // Clear any among_index values we set so we correctly handle a function
    // used in more than one among.
    for (int i = 0; i < x->literalstring_count; i++) {
        if (v[i].function) {
            v[i].function->among_index = 0;
        }
    }

    if (x->literalstring_count == 1) {
        // Eliminate single-case amongs.  Sometimes it's the natural way to
        // express a single rule in Snowball code as it can show commonality
        // with rulesets with multiple rules, but it's silly to actually
        // generate as an among.
        //
        // We handle an `among` which only has the empty string here - this is
        // syntactically valid but is not a useful construct so we warn about
        // it.
        if (substring) {
            substring->among = NULL;
            if (SIZE(v[0].b) == 0) {
                // substring ... among ( '' (C) )
                //
                // becomes:
                //
                // ... (C)
                fprintf(stderr, "%s:%d: warning: `among` with only empty string always matches\n",
                        a->tokeniser->file, p->line_number);
                substring->type = c_true;
            } else {
                substring->type = c_literalstring;
                substring->literalstring = v[0].b;
            }
            if (v[0].action) {
                // substring ... among ( S (C) )
                //
                // becomes:
                //
                // S ... (C)
                p = v[0].action;
            } else {
                // substring ... among ( S )
                //
                // becomes:
                //
                // S ... true
                p = new_node_at_line(a, c_true, v[0].line_number);
            }
        } else {
            if (v[0].action) {
                // among ( S (C) )
                //
                // becomes:
                //
                // (S C)
                p = v[0].action;
                assert(p->type == c_bra);
                if (SIZE(v[0].b) == 0) {
                    fprintf(stderr, "%s:%d: warning: `among` with only empty string always matches\n",
                            a->tokeniser->file, p->line_number);
                } else {
                    // Insert a c_literalstring node at the start of (C)
                    struct node * literalstring = new_node(a, c_literalstring);
                    literalstring->literalstring = v[0].b;
                    literalstring->right = p->left;
                    p->left = literalstring;
                }
            } else {
                // among ( S )
                //
                // becomes:
                //
                // S
                if (SIZE(v[0].b) == 0) {
                    fprintf(stderr, "%s:%d: warning: `among` with only empty string always matches\n",
                            a->tokeniser->file, p->line_number);
                    p->type = c_true;
                } else {
                    p->type = c_literalstring;
                    p->literalstring = v[0].b;
                }
                p->left = NULL;
            }
        }
        if (v[0].function) {
            // If there's an among function, convert the action to:
            //
            // FUNC and C
            struct node * and_node = new_node(a, c_and);
            and_node->left = new_node(a, c_call);
            and_node->left->name = v[0].function;
            and_node->left->right = p;
            p = and_node;
            --v[0].function->uses_in_among;
        }
        free_among(x);
        return p;
    }

    if (a->current_routine) {
        a->current_routine->has_among = true;
        if (x->function_count) {
            a->current_routine->has_among_function = true;
        }
    }

    x->substring = substring;
    if (substring != NULL) substring->among = x;

    if (a->amongs == NULL) a->amongs = x; else a->amongs_end->next = x;
    a->amongs_end = x;

    return p;
}

static struct node * read_among(struct analyser * a) {
    struct tokeniser * t = a->tokeniser;
    struct node * p = new_node(a, c_among);
    struct node * p_end = NULL;
    int previous_token = -1;
    struct node * substring = a->substring;

    a->substring = NULL;
    p->number = 0; /* counts the number of literals */
    if (!get_token(a, c_bra)) return p;
    while (true) {
        struct node * q;
        int token = read_token(t);
        switch (token) {
            case c_literalstring:
                q = read_literalstring(a);
                if (read_token(t) == c_name) {
                    struct node * r = new_node(a, c_name);
                    name_to_node(a, r, t_routine);
                    q->left = r;
                } else {
                    hold_token(t);
                }
                p->number++;
                break;
            case c_bra:
                if (previous_token == c_bra) {
                    report_error_location(a);
                    fprintf(stderr, "two adjacent bracketed expressions in among(...)\n");
                }
                q = read_C_list(a);
                if (is_just_true(q->left)) {
                    /* Convert anything equivalent to () to () so we handle it
                     * the same way.
                     */
                    q->left = NULL;
                }
                break;
            default:
                unexpected_token_error(a, "among(...)");
                previous_token = token;
                continue;
            case c_ket:
                if (p->number == 0) {
                    report_error_location(a);
                    fprintf(stderr, "empty among(...)\n");
                }
                if (t->error_count == 0) p = make_among(a, p, substring);
                return p;
        }
        previous_token = token;
        if (p_end == NULL) p->left = q; else p_end->right = q;
        p_end = q;
    }
}

static struct node * read_substring(struct analyser * a) {
    struct node * p = new_node(a, c_substring);
    if (a->substring != NULL) {
        substring_without_among_error(a);
    }
    a->substring = p;
    return p;
}

static void check_modifyable(struct analyser * a) {
    if (!a->modifyable) {
        struct tokeniser * t = a->tokeniser;
        report_error_location(a);
        fprintf(stderr, "%s not allowed inside reverse(...)\n",
                name_of_token(t->token));
    }
}

static int ae_uses_name(struct node * p, struct name * q) {
    if (!p) {
        // AE is NULL after a syntax error, e.g. `$x = $y`
        return 0;
    }
    switch (p->type) {
        case c_name:
        case c_lenof:
        case c_sizeof:
            if (p->name == q) return 1;
            break;
        case c_neg:
            return ae_uses_name(p->right, q);
        case c_multiply:
        case c_plus:
        case c_minus:
        case c_divide:
            return ae_uses_name(p->left, q) || ae_uses_name(p->right, q);
    }
    return 0;
}

// Put integer tests nodes into a normalised form, so that we can merge
// among actions with equivalent integer tests - e.g. from arabic.sbl:
//
//   [substring] among (
//      // [...]
//      '{a}{n}' '{w}{n}' '{y}{n}' ($(len > 5) delete) // present
//      '{t}{m}{a}' ($(len >= 6) delete)
//   )
static void normalise_comparison(struct node * n) {
    if (!n->left || !n->AE) return;
    if (n->left->type == c_number && n->AE->type != c_number) {
        // Swap operands so a number goes on the RHS.
        switch (n->type) {
            case c_gt: n->type = c_lt; break;
            case c_lt: n->type = c_gt; break;
            case c_ge: n->type = c_le; break;
            case c_le: n->type = c_ge; break;
        }
        struct node * p = n->left;
        n->left = n->AE;
        n->AE = p;
    }
    if (n->AE->type == c_number && abs(n->AE->number) < 32767) {
        if (n->type == c_gt) {
            // Normalise `$(n > 0)` to `$(n >= 1)`.
            n->type = c_ge;
            ++n->AE->number;
        } else if (n->type == c_lt) {
            // Normalise `$(n < 1)` to `$(n <= 0)`
            n->type = c_le;
            --n->AE->number;
        }
    }
}

static struct node * read_C(struct analyser * a) {
    struct tokeniser * t = a->tokeniser;
    int token = read_token(t);
    switch (token) {
        case c_bra: {
            struct node * p = read_C_list(a);
            if (p->type != c_bra) {
                fprintf(stderr, "read_C_list returned unexpected type %s\n",
                        name_of_token(p->type));
                exit(1);
            }
            if (p->left && !p->left->right) {
                // Replace a single entry command list with the command it
                // contains in order to make subsequent optimisations easier.
                p = p->left;
            }
            return p;
        }
        case c_backwards: {
            int mode = a->mode;
            if (a->mode == m_backward) {
                report_error_location(a);
                fprintf(stderr, "'backwards' used when already in this mode\n");
            }
            a->mode = m_backward;
            struct node * p = new_node(a, token);
            p->left = read_C(a);
            a->mode = mode;
            return p;
        }
        case c_reverse: {
            int mode = a->mode;
            int modifyable = a->modifyable;
            a->modifyable = false;
            a->mode = (mode == m_forward) ? m_backward : m_forward;
            struct node * p = new_node(a, token);
            p->left = read_C(a);
            a->mode = mode;
            a->modifyable = modifyable;
            return p;
        }
        case c_not: {
            struct node * subcommand = read_C(a);
            switch (subcommand->type) {
                case c_booltest:
                    /* We synthesise a special command for "not" applied to
                     * testing a boolean variable.
                     */
                    subcommand->type = c_not_booltest;
                    return subcommand;
                case c_next: {
                    // `not next` -> compare `cursor` and `limit`.
                    int mode = a->mode;
                    struct node * n = new_node(a, mode == m_forward ? c_ge : c_le);
                    n->left = subcommand;
                    n->left->type = c_cursor;
                    n->AE = new_node_at_line(a, c_limit, n->left->line_number);
                    return n;
                }
                case c_eq:
                case c_ge:
                case c_gt:
                case c_le:
                case c_lt:
                case c_ne:
                    // Flip the sense of the test.
                    subcommand->type ^= 1;
                    return subcommand;
            }
            struct node * p = new_node(a, token);
            p->left = subcommand;
            return p;
        }
        case c_try:
        case c_do:
        case c_repeat: {
            struct node * p = new_node(a, token);
            p->left = read_C(a);
            return p;
        }
        case c_test: {
            struct node * p = new_node(a, token);
            p->left = read_C(a);
            if (p->left->type == c_next) {
                // `test next` -> compare `cursor` and `limit`.
                int mode = a->mode;
                p->type = (mode == m_forward ? c_lt : c_gt);
                p->left->type = c_cursor;
                p->AE = new_node_at_line(a, c_limit, p->left->line_number);
            }
            return p;
        }
        case c_fail: {
            struct node * p = new_node(a, token);
            p->left = read_C(a);
            if (!p->left || is_just_true(p->left)) {
                p->type = c_false;
                p->left = NULL;
            }
            return p;
        }
        case c_goto:
        case c_gopast: {
            struct node * subcommand = read_C(a);
            if (subcommand->type == c_grouping || subcommand->type == c_non) {
                /* We synthesise special commands for "goto" or "gopast" when
                 * used on a grouping or an inverted grouping - the movement of
                 * c by the matching action is exactly what we want!
                 *
                 * Adding the tokens happens to give unique values (the code
                 * would fail to compile if it didn't!)
                 */
                switch (token + subcommand->type) {
                    case c_goto + c_grouping:
                        subcommand->type = c_goto_grouping;
                        break;
                    case c_gopast + c_grouping:
                        subcommand->type = c_gopast_grouping;
                        break;
                    case c_goto + c_non:
                        subcommand->type = c_goto_non;
                        break;
                    case c_gopast + c_non:
                        subcommand->type = c_gopast_non;
                        break;
                    default:
                        fprintf(stderr, "Unexpected go/grouping combination: %s %s",
                                name_of_token(token),
                                name_of_token(subcommand->type));
                        exit(1);
                }
                return subcommand;
            }

            struct node * p = new_node(a, token);
            p->left = subcommand;
            return p;
        }
        case c_loop:
        case c_atleast: {
            struct node * n = new_node(a, token);
            n->AE = read_AE(a, NULL, 0);
            n->left = read_C(a);

            // n->AE is NULL after a syntax error, e.g. `loop next`.
            if (n->AE && n->AE->type == c_number) {
                if (n->AE->number <= 0) {
                    if (token == c_loop) {
                        // `loop N C`, where N <= 0 is a no-op.
                        if (n->AE->fixed_constant) {
                            fprintf(stderr,
                                    "%s:%d: warning: `loop %d C` is a no-op\n",
                                    t->file, n->AE->line_number, n->AE->number);
                        }
                        n->AE = NULL;
                        n->left = NULL;
                        n->type = c_true;
                    } else {
                        // `atleast N C` where N <= 0 -> `repeat C`.
                        if (n->AE->fixed_constant) {
                            fprintf(stderr,
                                    "%s:%d: warning: atleast %d C is just repeat C\n",
                                    t->file, n->AE->line_number, n->AE->number);
                        }
                        n->AE = NULL;
                        n->type = c_repeat;
                    }
                } else if (n->AE->number == 1) {
                    if (token == c_loop) {
                        // `loop 1 C` -> `C`.
                        if (n->AE->fixed_constant) {
                            fprintf(stderr,
                                    "%s:%d: warning: loop 1 C is just C\n",
                                    t->file, n->AE->line_number);
                        }
                        n = n->left;
                    }
                }
            }
            return n;
        }
        case c_setmark: {
            struct node * n = new_node(a, c_assign);
            n->AE = new_node(a, c_cursor);
            if (get_token(a, c_name)) {
                name_to_node(a, n, t_integer);
                if (n->name) n->name->initialised = true;
            }
            return n;
        }
        case c_atmark: {
            struct node * n = new_node(a, c_eq);
            struct node * AE = read_AE(a, NULL, 0);
            if (AE->type == c_cursor) {
                fprintf(stderr,
                        "%s:%d: warning: `atmark cursor` is always true\n",
                        t->file, n->line_number);
                n->type = c_true;
            } else {
                n->left = new_node_at_line(a, c_cursor, n->line_number);
                n->AE = AE;
            }
            return n;
        }
        case c_tomark: {
            struct node * n = new_node(a, token);
            struct node * AE = read_AE(a, NULL, 0);
            if (AE->type == c_cursor) {
                fprintf(stderr,
                        "%s:%d: warning: `tomark cursor` is a no-op\n",
                        t->file, n->line_number);
                n->type = c_true;
            } else {
                n->AE = AE;
            }
            return n;
        }
        case c_hop: {
            struct node * n = new_node(a, token);
            n->AE = read_AE(a, NULL, 0);
            // n->AE is NULL after a syntax error, e.g. `hop hop`.
            if (n->AE && n->AE->type == c_number) {
                if (n->AE->number == 1) {
                    // Convert `hop 1` to `next`.
                    n->AE = NULL;
                    n->type = c_next;
                } else if (n->AE->number == 0) {
                    if (n->AE->fixed_constant) {
                        fprintf(stderr,
                                "%s:%d: warning: `hop 0` is a no-op\n",
                                t->file, n->AE->line_number);
                    }
                    n->AE = NULL;
                    n->type = c_true;
                } else if (n->AE->number < 0) {
                    fprintf(stderr,
                            "%s:%d: warning: hop %d now signals f (as was "
                            "always documented) rather than moving the cursor "
                            "in the opposite direction\n",
                            t->file, n->AE->line_number, n->AE->number);
                    n->AE = NULL;
                    n->type = c_false;
                }
            }
            return n;
        }
        case c_delete: {
            check_modifyable(a);
            // Canonicalise `delete` to `<-''`.
            struct node * n = new_node(a, c_slicefrom);
            NEW(literalstring, p);
            p->b = create_b(0);
            p->next = a->literalstrings;
            a->literalstrings = p;
            n->literalstring = p->b;
            return n;
        }
        case c_next:
        case c_tolimit:
        case c_leftslice:
        case c_rightslice:
        case c_true:
        case c_false:
            return new_node(a, token);
        case c_atlimit: {
            int mode = a->mode;
            struct node * n = new_node(a, mode == m_forward ? c_ge : c_le);
            n->left = new_node_at_line(a, c_cursor, n->line_number);
            n->AE = new_node_at_line(a, c_limit, n->line_number);
            return n;
        }
        case c_debug:
            a->debug_used = true;
            return new_node(a, token);
        case c_assignto:
        case c_sliceto: {
            check_modifyable(a);
            struct node * n = new_node(a, token);
            if (get_token(a, c_name)) {
                name_to_node(a, n, t_string);
                if (n->name) n->name->initialised = true;
            }
            if (token == c_assignto) {
                fprintf(stderr,
                        "%s:%d: warning: Use of `=>` is not recommended, "
                        "see https://snowballstem.org/compiler/snowman.html "
                        "section 13.3 for details\n",
                        t->file, n->line_number);
            }
            return n;
        }
        case c_assign:
            token = c_stringassign;
            /* FALLTHRU */
        case c_insert:
        case c_attach:
        case c_slicefrom: {
            check_modifyable(a);
            struct node * n = new_string_command(a, token);
            if (n->name) {
                n->name->value_used = true;
            } else if (n->literalstring == NULL || SIZE(n->literalstring) == 0) {
                switch (token) {
                  case c_insert:
                  case c_attach:
                    fprintf(stderr,
                            "%s:%d: warning: `%s ''` is a no-op\n",
                            t->file, n->line_number, name_of_token(token));
                    n->type = c_true;
                    n->literalstring = NULL;
                    break;
                }
            }
            return n;
        }
        case c_setlimit: {
            struct node * n = new_node(a, token);
            n->left = read_C(a);
            get_token(a, c_for);
            n->aux = read_C(a);
            if (n->left->type == c_tomark && n->left->AE->type == c_limit) {
                fprintf(stderr,
                        "%s:%d: warning: `setlimit tomark limit` is a no-op\n",
                        t->file, n->line_number);
                return n->aux;
            }
            return n;
        }
        case c_set:
        case c_unset: {
            struct node * n = new_node(a, token);
            if (get_token(a, c_name)) {
                name_to_node(a, n, t_boolean);
                if (n->name) n->name->initialised = true;
            }
            return n;
        }
        case c_dollar: {
            int dollar_line = t->line_number;
            read_token(t);
            if (t->token == c_bra) {
                /* Handle newer $(AE REL_OP AE) syntax. */
                struct node * n = read_AE(a, NULL, 0);
                read_token(t);
                token = t->token;
                bool eval_constant_expr = false;
                switch (token) {
                    case c_assign:
                        // Assume `==` was meant to try to avoid an error avalanche.
                        token = c_eq;
report_assumed_rel_op_error:
                        report_error_location(a);
                        fprintf(stderr, "Expected relational operator, got '%s' (did you mean '%s'?)\n",
                                name_of_token(t->token), name_of_token(token));
                        goto handle_rel_op;
                    case c_assignto:
                        // Assume `>=` was meant to try to avoid an error avalanche.
                        // (`=>` instead of `>=` is a possible typo.)
                        token = c_ge;
                        goto report_assumed_rel_op_error;
                    case c_divideassign:
                        // Assume `!=` was meant to try to avoid an error avalanche.
                        // (Ada, Erlang, Fortran90, etc use `/=` for not-equal.)
                        token = c_ne;
                        goto report_assumed_rel_op_error;
                    case c_minusassign:
                    case c_multiplyassign:
                    case c_plusassign:
                        // Give a better error if any other assignment operator
                        // is used in this context.
                        report_error_location(a);
                        fprintf(stderr, "Expected relational operator, got '%s'\n",
                                name_of_token(token));
                        // Assume `==` was meant to try to avoid an error avalanche.
                        token = c_eq;
                        goto handle_rel_op;
                    case c_slicefrom:
                        // In an AE c_slicefrom (`<-`) is not a valid token, so
                        // convert it into c_lt (`<`) then c_minus (`-`) so
                        // that code such as `$(x<-1)` works rather than giving
                        // a syntax error.
                        push_token(t, c_minus);
                        token = c_lt;
                        // FALLTHRU
                    case c_eq:
                    case c_ne:
                    case c_gt:
                    case c_ge:
                    case c_lt:
                    case c_le: {
                        // Only evaluate constant expressions if we got a valid
                        // relational operator to avoid spurious unreachable
                        // code warnings after an error.
                        eval_constant_expr = true;
handle_rel_op: ;
                        struct node * lhs = n;
                        struct node * rhs = read_AE(a, NULL, 0);
                        if (eval_constant_expr &&
                            lhs->type == c_number &&
                            rhs->type == c_number) {
                            // Evaluate constant numeric test expression.
                            int result;
                            switch (token) {
                                case c_eq:
                                    result = (lhs->number == rhs->number);
                                    break;
                                case c_ne:
                                    result = (lhs->number != rhs->number);
                                    break;
                                case c_gt:
                                    result = (lhs->number > rhs->number);
                                    break;
                                case c_ge:
                                    result = (lhs->number >= rhs->number);
                                    break;
                                case c_lt:
                                    result = (lhs->number < rhs->number);
                                    break;
                                case c_le:
                                    result = (lhs->number <= rhs->number);
                                    break;
                                default:
                                    fprintf(stderr, "Unexpected numeric test operator %s\n",
                                            name_of_token(t->token));
                                    exit(1);
                            }
                            n = new_node(a, result ? c_true : c_false);
                        } else {
                            n = new_node(a, token);
                            n->left = lhs;
                            n->AE = rhs;
                            normalise_comparison(n);
                        }
                        get_token(a, c_ket);
                        break;
                    }
                    default:
                        unexpected_token_error(a, "integer test expression");
                        hold_token(t);
                        (void)read_AE(a, NULL, 0);
                        get_token(a, c_ket);
                        break;
                }
                return n;
            }

            if (t->token != c_name) {
                unexpected_token_error(a, "integer test expression");
                hold_token(t);
                return new_node_at_line(a, c_dollar, dollar_line);
            }

            struct name * q = find_name(a);
            if (q && q->type == t_string) {
                /* Assume for now that $ on string both initialises and uses
                 * the string variable.  FIXME: Can we do better?
                 */
                q->initialised = true;
                q->value_used = true;
                struct node * p = new_node_at_line(a, c_dollar, dollar_line);
                int mode = a->mode;
                int modifyable = a->modifyable;
                a->mode = m_forward;
                a->modifyable = true;
                p->left = read_C(a);
                a->mode = mode;
                a->modifyable = modifyable;
                p->name = q;
                mark_used_in(a, q, p);
                return p;
            }

            if (q && q->type != t_integer) {
                /* If $ is used on an unknown name or a name which isn't a
                 * string or an integer then we assume the unknown name is an
                 * integer as $ is used more often on integers than strings, so
                 * hopefully this it less likely to cause an error avalanche.
                 *
                 * For an unknown name, we'll already have reported an error.
                 */
                report_error_location(a);
                fprintf(stderr, "'%.*s' not of type integer or string\n",
                        SIZE(q->s), q->s);
                q = NULL;
            }
            struct node * p = new_node(a, read_AE_test(a));
            switch (p->type) {
                case c_eq:
                case c_ne:
                case c_gt:
                case c_ge:
                case c_lt:
                case c_le:
                    p->left = new_node(a, c_name);
                    p->left->name = q;
                    p->AE = read_AE(a, NULL, 0);
                    normalise_comparison(p);
                    if (q) {
                        q->value_used = true;
                        mark_used_in(a, q, p);
                    }
                    return p;
            }

            /* +=, etc don't "initialise" as they only amend an existing value.
             * Similarly, they don't count as using the value.
             */
            p->name = q;
            p->AE = read_AE(a, q, 0);
            if (p->AE && p->AE->type == c_number) {
                switch (p->type) {
                    case c_plusassign:
                    case c_minusassign:
                        if (p->AE->number == 0) {
                            // `$x+=0` and `$x-=0` are no-ops.
                            p->type = c_true;
                            p->name = NULL;
                            p->AE = NULL;
                        } else if (p->AE->number < 0) {
                            // `$x+=-N` -> `$x-=N`, etc as
                            // this may result in slightly
                            // shorter target language code.
                            p->type ^= (c_plusassign ^ c_minusassign);
                            p->AE->number = -p->AE->number;
                        }
                        break;
                    case c_multiplyassign:
                    case c_divideassign:
                        if (p->AE->number == 1) {
                            // `$x*=1` and `$x/=1` are no-ops.
                            p->type = c_true;
                            p->name = NULL;
                            p->AE = NULL;
                        } else if (p->AE->number == 0) {
                            if (p->type == c_divideassign) {
                                report_error_location_line(a, p->line_number);
                                fprintf(stderr, "Division by zero\n");
                                // Set the largest possible value.
                                p->type = c_maxint;
                                p->name = NULL;
                                p->AE = NULL;
                            } else {
                                // `$x*=0` -> `$x=0`
                                p->type = c_assign;
                            }
                        } else if (p->AE->number == -1) {
                            // `$x/=-1` -> `$x=-x`
                            // `$x*=-1` -> `$x=-x`
                            p->type = c_assign;
                            p->AE->number = 0;
                            p->AE->type = c_neg;
                            p->AE->right = new_node_at_line(a, c_name,
                                                            p->AE->line_number);
                            p->AE->right->name = p->name;
                        }
                        break;
                }
            }
            if (p->type == c_assign && q) {
                if (ae_uses_name(p->AE, q)) {
                    if (p->AE->type == c_name) {
                        fprintf(stderr,
                                "%s:%d: warning: `$",
                                t->file, p->line_number);
                        report_s(stderr, p->AE->name->s);
                        fprintf(stderr, " = ");
                        report_s(stderr, p->AE->name->s);
                        fprintf(stderr, "` is a no-op\n");
                        p->AE = NULL;
                        p->type = c_true;
                        q = NULL;
                    }
                } else {
                    // `$x = <AE>` initialises `x` unless AE references `x`.
                    q->initialised = true;
                }
            }
            if (q) mark_used_in(a, q, p);
            return p;
        }
        case c_name: {
            struct name * q = find_name(a);
            struct node * p = new_node(a, c_name);
            if (q) {
                mark_used_in(a, q, p);
                switch (q->type) {
                    case t_boolean:
                        p->type = c_booltest;
                        q->value_used = true;
                        break;
                    case t_integer:
                        report_error_location(a);
                        fprintf(stderr, "integer name '%.*s' misplaced\n",
                                SIZE(t->s), t->s);
                        break;
                    case t_string:
                        q->value_used = true;
                        break;
                    case t_routine:
                    case t_external:
                        p->type = c_call;
                        check_routine_mode(a, q, a->mode);
                        break;
                    case t_grouping:
                        p->type = c_grouping;
                        break;
                }
            }
            p->name = q;
            return p;
        }
        case c_non: {
            struct node * p = new_node(a, token);
            read_token(t);
            if (t->token == c_minus) read_token(t);
            if (!check_token(a, c_name)) {
                return p;
            }
            name_to_node(a, p, t_grouping);
            return p;
        }
        case c_literalstring: {
            struct node * p = read_literalstring(a);
            if (SIZE(p->literalstring) == 0) {
                fprintf(stderr,
                        "%s:%d: warning: empty literal string is a no-op\n",
                        t->file, p->line_number);
                p->type = c_true;
                p->literalstring = NULL;
            }
            return p;
        }
        case c_among: return read_among(a);
        case c_substring: return read_substring(a);
        default:
            unexpected_token_error(a, 0);
            return NULL;
    }
}

static int next_symbol(const symbol * p, symbol * W, int utf8) {
    if (utf8) {
        int ch;
        int j = get_utf8(p, & ch);
        *W = ch;
        return j;
    } else {
        *W = *p;
        return 1;
    }
}

static symbol * alter_grouping(symbol * p, const symbol * q, int style, int utf8) {
    int j = 0;
    if (style == c_plus) {
        while (j < SIZE(q)) {
            symbol W;
            int width = next_symbol(q + j, &W, utf8);
            p = add_symbol_to_b(p, W);
            j += width;
        }
    } else {
        while (j < SIZE(q)) {
            symbol W;
            int width = next_symbol(q + j, &W, utf8);
            for (int i = 0; i < SIZE(p); i++) {
                if (p[i] == W) {
                    memmove(p + i, p + i + 1, (SIZE(p) - i - 1) * sizeof(symbol));
                    ADD_TO_SIZE(p, -1);
                }
            }
            j += width;
        }
    }
    return p;
}

static int compare_symbol(const void *pv, const void *qv) {
    const symbol * p = (const symbol*)pv;
    const symbol * q = (const symbol*)qv;
    return *p - *q;
}

static int finalise_grouping(struct grouping * p) {
    if (SIZE(p->b) == 0) {
        // Empty grouping - leave things in a non-surprising state.
        p->smallest_ch = p->largest_ch = 0;
        return false;
    }

    qsort(p->b, SIZE(p->b), sizeof(symbol), compare_symbol);
    p->smallest_ch = p->b[0];
    p->largest_ch = p->b[SIZE(p->b) - 1];

    // Eliminate duplicates.
    symbol ch = p->b[0];
    int j = 1;
    for (int i = 1; i < SIZE(p->b); i++) {
        if (p->b[i] != ch) {
            ch = p->b[j++] = p->b[i];
        }
    }
    SET_SIZE(p->b, j);
    return true;
}

static void read_define_grouping(struct analyser * a, struct name * q) {
    struct tokeniser * t = a->tokeniser;
    int style = c_plus;
    bool check_nonempty = true;
    {
        NEW(grouping, p);
        *p = (struct grouping){0};
        if (a->groupings == NULL) a->groupings = p; else a->groupings_end->next = p;
        a->groupings_end = p;
        if (q) {
            if (q->grouping != NULL) {
                report_error_location(a);
                fprintf(stderr, "'%.*s' redefined\n", SIZE(t->s), t->s);
                q->grouping->name = NULL;
            }
            q->grouping = p;
        }
        p->name = q;
        p->line_number = t->line_number;
        p->b = create_b(0);
        do {
            switch (read_token(t)) {
                case c_name: {
                    struct name * r = find_name(a);
                    if (!r) break;

                    if (r == q) {
                        count_error(a);
                        fprintf(stderr, "%s:%d: %.*s defined in terms of itself\n",
                                t->file, t->line_number, SIZE(r->s), r->s);
                        check_nonempty = false;
                    } else if (!r->grouping) {
                        if (check_name_type(a, r, t_grouping)) {
                            count_error(a);
                            fprintf(stderr, "%s:%d: %.*s undefined\n",
                                    t->file, t->line_number, SIZE(r->s), r->s);
                        }
                        check_nonempty = false;
                    } else {
                        p->b = alter_grouping(p->b, r->grouping->b, style, false);
                    }
                    r->used_in_definition = true;
                    break;
                }
                case c_literalstring: {
                    int utf8 = (a->encoding == ENC_UTF8);
                    int i = 0;
                    while (i < SIZE(t->b)) {
                        symbol ch_i;
                        int width_i = next_symbol(t->b + i, &ch_i, utf8);
                        int j = 0;
                        while (j < i) {
                            symbol ch_j;
                            int width_j = next_symbol(t->b + j, &ch_j, utf8);
                            if (ch_i == ch_j) {
                                fprintf(stderr, "%s:%d: warning: Duplicate "
                                                "character in grouping: ",
                                        t->file, t->line_number);
                                if (ch_i >= 32 && ch_i < 127) {
                                    fprintf(stderr, "'%c'\n", ch_i);
                                } else {
                                    fprintf(stderr, "U+%04X\n", ch_i);
                                }
                            }
                            j += width_j;
                        }
                        i += width_i;
                    }
                    p->b = alter_grouping(p->b, t->b, style, (a->encoding == ENC_UTF8));
                    break;
                }
                default:
                    unexpected_token_error(a, "grouping definition");
                    hold_token_if_toplevel(t);
                    // Don't report an error for an empty grouping as well.
                    (void)finalise_grouping(p);
                    return;
            }
            style = read_token(t);
        } while (style == c_plus || style == c_minus);
        if (!finalise_grouping(p)) {
            if (check_nonempty) {
                report_error_location_line(a, p->line_number);
                fprintf(stderr, "empty grouping\n");
            }
        }
        hold_token(t);
    }
}

static void read_define_routine(struct analyser * a, struct name * q) {
    struct node * p = new_node(a, c_define);
    a->current_routine = q;
    if (q) {
        if (q->definition != NULL) {
            report_error_location(a);
            fprintf(stderr, "'%.*s' redefined\n", SIZE(q->s), q->s);
        }
        if (q->mode == m_unknown) {
            q->mode = a->mode;
        } else if (q->mode != a->mode) {
            report_error_location(a);
            fprintf(stderr, "'%.*s' declared as %s mode; used as %s mode",
                    SIZE(q->s), q->s,
                    name_of_mode(a->mode), name_of_mode(q->mode));
        }
    }
    p->name = q;
    if (a->program == NULL) a->program = p; else a->program_end->right = p;
    a->program_end = p;
    get_token(a, c_as);
    p->left = read_C(a);
    if (q) q->definition = p;

    if (a->substring != NULL) {
        substring_without_among_error(a);
        a->substring = NULL;
    }
    a->current_routine = NULL;
}

static void read_define(struct analyser * a) {
    if (!get_token(a, c_name)) return;

    struct name * q = find_name(a);
    int type;
    if (q) {
        type = q->type;
        if (type != t_grouping && type != t_routine && type != t_external) {
            // If integer, boolean, or string name then generate error and
            // parse based on the next token.
            type = (peek_token(a->tokeniser) == c_as) ? t_routine : t_grouping;
            check_name_type(a, q, type);
        }
    } else {
        /* No declaration so sniff next token - if it is a string or name
         * we parse as a grouping, otherwise we parse as a routine.  This
         * avoids an avalanche of further errors if `as` is missing from a
         * routine definition.
         */
        switch (peek_token(a->tokeniser)) {
            case c_literalstring:
            case c_name:
                type = t_grouping;
                break;
            default:
                type = t_routine;
        }
    }

    if (type == t_grouping) {
        read_define_grouping(a, q);
    } else {
        read_define_routine(a, q);
    }
}

static void read_backwardmode(struct analyser * a) {
    int mode = a->mode;
    a->mode = m_backward;
    if (get_token(a, c_bra)) {
        read_program_(a, c_ket);
    }
    a->mode = mode;
}

static void read_program_(struct analyser * a, int terminator) {
    struct tokeniser * t = a->tokeniser;
    while (true) {
        int token = read_token(t);
        switch (token) {
            case c_strings:     read_names(a, t_string); break;
            case c_booleans:    read_names(a, t_boolean); break;
            case c_integers:    read_names(a, t_integer); break;
            case c_routines:    read_names(a, t_routine); break;
            case c_externals:   read_names(a, t_external); break;
            case c_groupings:   read_names(a, t_grouping); break;
            case c_define:      read_define(a); break;
            case c_backwardmode:read_backwardmode(a); break;
            default:
                if (token == terminator) return;
                unexpected_token_error(a, 0);
                break;
            case -1:
                if (terminator != -1)
                    omission_error(a, terminator);
                return;
        }
    }
}

static void remove_dead_assignments(struct node * p, struct name * q) {
    if (p->name == q) {
        switch (p->type) {
            case c_assignto:
            case c_sliceto:
            case c_assign:
            case c_plusassign:
            case c_minusassign:
            case c_multiplyassign:
            case c_divideassign:
            case c_set:
            case c_unset:
            case c_dollar:
                /* c_true is a no-op. */
                p->type = c_true;
                p->AE = NULL;
                p->name = NULL;
                break;
            default:
                /* There are no read accesses to this variable, so any
                 * references must be assignments.
                 */
                fprintf(stderr, "Unhandled type of dead assignment via %s\n",
                        name_of_token(p->type));
                exit(1);
        }
    }
    if (p->AE) remove_dead_assignments(p->AE, q);
    if (p->left) remove_dead_assignments(p->left, q);
    if (p->aux) remove_dead_assignments(p->aux, q);
    if (p->right) remove_dead_assignments(p->right, q);
}

// Numeric values are picked so we can take the minimum to merge when joining
// control flows.
enum {
    // Not set on at least one code path leading to a use.
    USE_BEFORE_SET = 0,
    // Need to keep checking.
    UNKNOWN = 1,
    // Set on any code path leading to a use.
    SET_BEFORE_ANY_USE = 2
};

static inline int merge_r(int r1, int r2) {
    return r1 < r2 ? r1 : r2;
}

/* Find out if every codepath in the command with node p to a use of variable v
 * sets v first.
 *
 * The checks err towards being too conservative and may report that v can't be
 * safely localised when it can, but they allow localising all variables which
 * can be trivially made local in existing stemmers.
 *
 * p:       the node of the command to check.
 * v:       the variable to check.
 * catcher: pointer to USE_BEFORE_SET/UNKNOWN/SET_BEFORE_ANY_USE value to
 *          update on signal `f`.
 */
static int always_set_before_use_(struct node * p,
                                  struct name * v,
                                  int * catcher) {
    assert(p);
    switch (p->type) {
        case c_call: {
            // We know v is only referenced in the function we are checking
            // (and we don't try to localise variables into recursive
            // functions, so we know this call can't re-enter the current
            // function).
            return UNKNOWN;
        }
        case c_among: {
            bool all_pass = true;
            struct among * x = p->among;
            for (int i = 1; i <= x->command_count; i++) {
                int r = always_set_before_use_(x->commands[i - 1], v, catcher);
                if (r == USE_BEFORE_SET) return r;
                all_pass = all_pass && (r == SET_BEFORE_ANY_USE);
            }
            if (all_pass) return SET_BEFORE_ANY_USE;
            return UNKNOWN;
        }
        case c_or: {
            struct node * q = p->left;
            assert(q);
            bool all_pass = true;
            while (q->right) {
                // `or` handles signal `f` from subcommands except the last.
                int r_f = UNKNOWN;
                int r = always_set_before_use_(q, v, &r_f);
                if (r == USE_BEFORE_SET) return r;
                if (r_f == USE_BEFORE_SET) return r;
                all_pass = all_pass &&
                    (r == SET_BEFORE_ANY_USE) &&
                    (r_f == SET_BEFORE_ANY_USE);
                q = q->right;
            }
            // Signal `f` from the last subcommand propagates.
            int r = always_set_before_use_(q, v, catcher);
            if (r == USE_BEFORE_SET) return r;
            all_pass = all_pass && (r == SET_BEFORE_ANY_USE);
            if (all_pass) return SET_BEFORE_ANY_USE;
            return UNKNOWN;
        }
        case c_and:
        case c_bra: {
            struct node * q = p->left;
            // If we execute this command, we'll definitely execute
            // sub-commands up to and including the first which could
            // fail.
            while (q) {
                int r = always_set_before_use_(q, v, catcher);
                if (r != UNKNOWN) {
                    *catcher = r;
                    return r;
                }
                bool last = (q->possible_signals <= 0);
                q = q->right;
                if (last) break;
            }
            // Any remaining subcommands may not get executed, so we don't
            // update *catcher for them.
            while (q) {
                int r = always_set_before_use_(q, v, catcher);
                if (r != UNKNOWN) return r;
                q = q->right;
            }
            return UNKNOWN;
        }
        case c_backwards:
        case c_reverse:
        case c_test:
            return always_set_before_use_(p->left, v, catcher);
        case c_fail:
            return always_set_before_use_(p->left, v, catcher);
            // FIXME: Could be?
            // *catcher = merge_r(r, *catcher);
            // return UNKNOWN;
        case c_repeat:
        case c_do:
        case c_not:
        case c_try: {
            int r_f = UNKNOWN;
            int r = always_set_before_use_(p->left, v, &r_f);
            return merge_r(r, r_f);
        }
        case c_gopast:
        case c_goto:
            // If the cursor is atlimit already the subcommand won't be
            // executed, so a SET_BEFORE_ANY_USE from it doesn't guarantee
            // that the variable will get set.
            if (always_set_before_use_(p->left, v, catcher) == USE_BEFORE_SET)
                return USE_BEFORE_SET;
            return UNKNOWN;
        case c_atleast:
        case c_loop:
            if (always_set_before_use_(p->AE, v, catcher) == USE_BEFORE_SET)
                return USE_BEFORE_SET;
            // If AE has value <= 0 the subcommand won't be executed, so a
            // SET_BEFORE_ANY_USE from it doesn't guarantee that the variable
            // will get set.
            if (always_set_before_use_(p->left, v, catcher) == USE_BEFORE_SET)
                return USE_BEFORE_SET;
            return UNKNOWN;
        case c_assign:
            // Check AE first: `x = x + 1` uses `x` before it sets it.
            if (always_set_before_use_(p->AE, v, catcher) == USE_BEFORE_SET)
                return USE_BEFORE_SET;
            if (p->name == v)
                return SET_BEFORE_ANY_USE;
            return UNKNOWN;
        case c_assignto:
        case c_set:
        case c_sliceto:
        case c_unset:
            if (p->name == v)
                return SET_BEFORE_ANY_USE;
            return UNKNOWN;
        case c_grouping:
        case c_leftslice:
        case c_literalstring:
        case c_next:
        case c_non:
        case c_number:
        case c_rightslice:
        case c_debug:
        case c_substring:
        case c_tolimit:
        case c_false:
        case c_true:
        case c_goto_grouping:
        case c_gopast_grouping:
        case c_goto_non:
        case c_gopast_non:
            return UNKNOWN;
        case c_hop:
        case c_tomark:
            if (always_set_before_use_(p->AE, v, catcher) == USE_BEFORE_SET)
                return USE_BEFORE_SET;
            return UNKNOWN;
        case c_stringassign:
        case c_attach:
        case c_booltest:
        case c_insert:
        case c_name:
        case c_not_booltest:
        case c_slicefrom:
            if (p->name == v) {
                return USE_BEFORE_SET;
            }
            return UNKNOWN;
        case c_functionend:
            return SET_BEFORE_ANY_USE;
        case c_divide:
        case c_minus:
        case c_multiply:
        case c_plus: {
            int r = always_set_before_use_(p->left, v, catcher);
            if (r != UNKNOWN) return r;
            return always_set_before_use_(p->right, v, catcher);
        }
        case c_eq:
        case c_ne:
        case c_gt:
        case c_ge:
        case c_lt:
        case c_le: {
            int r = always_set_before_use_(p->left, v, catcher);
            if (r != UNKNOWN) return r;
            return always_set_before_use_(p->AE, v, catcher);
        }
        case c_neg:
            return always_set_before_use_(p->right, v, catcher);
        case c_lenof:
        case c_sizeof:
            if (p->name == v) {
                return USE_BEFORE_SET;
            }
            return UNKNOWN;
        case c_cursor:
        case c_len:
        case c_limit:
        case c_maxint:
        case c_minint:
        case c_size:
            return UNKNOWN;
        case c_setlimit: {
            int r = always_set_before_use_(p->aux, v, catcher);
            if (r != UNKNOWN) return r;
            r = always_set_before_use_(p->left, v, catcher);
            if (p->aux->possible_signals <= 0) {
                // aux can fail so left may not be executed.
                if (r == USE_BEFORE_SET) return r;
                return UNKNOWN;
            }
            return r;
        }
        case c_divideassign:
        case c_minusassign:
        case c_multiplyassign:
        case c_plusassign:
            if (p->name == v) {
                return USE_BEFORE_SET;
            }
            if (always_set_before_use_(p->AE, v, catcher) == USE_BEFORE_SET) {
                return USE_BEFORE_SET;
            }
            return UNKNOWN;
        case c_dollar:
            if (p->name != v) {
                return UNKNOWN;
            }
#if 0
            // This check is valid, but currently it's better to not treat
            // initialising uses of string-$ as definitely setting the string
            // variable because for some target languages that means we need to
            // initialise to an empty string at the start of the function and
            // we would incur overhead from doing so.
            if (p->left->type == c_stringassign) {
                // Special-case `$x = S` because it's easy to handle.
                return SET_BEFORE_ANY_USE;
            }
#endif
            // Otherwise, for now we assume that `$x C` might use `x` before
            // setting it.  If string-$ sees wider use we can do better here.
            return USE_BEFORE_SET;
        case c_backwardmode:
        case c_define: // We always start from c_define's ->left.
        case c_booleans:
        case c_externals:
        case c_groupings:
        case c_integers:
        case c_routines:
        case c_strings:
            // Allowing these would allow checking the whole program.
            assert(0);
            return UNKNOWN;
        case c_comment1:
        case c_comment2:
        case c_decimal:
        case c_get:
        case c_hex:
        case c_stringdef:
        case c_stringescapes:
            // These are only use in the tokeniser.
            assert(0);
            break;
        case c_atlimit:
        case c_atmark:
        case c_setmark:
            // These are only use in the tokeniser and analyser.
            assert(0);
            break;
        case c_as:
        case c_for:
        case c_ket:
            // These shouldn't occur in this context.
            assert(0);
            break;
    }
    /* Pessimistic assumption for cases we don't handle yet. */
    printf("Assuming the worst about '%s' (%d)\n", name_of_token(p->type), p->type);
    return USE_BEFORE_SET;
}

static int always_set_before_use(struct node * p, struct name * v) {
    int r_f = UNKNOWN;
    int r = always_set_before_use_(p, v, &r_f);
    return merge_r(r, r_f) != USE_BEFORE_SET;
}

static void remove_routine(struct analyser * a, struct name * q) {
    struct node ** ptr = &(a->program);
    while (*ptr) {
        if ((*ptr)->name == q) {
            *ptr = (*ptr)->right;
        } else {
            ptr = &((*ptr)->right);
        }
    }
}

// Return 0 for always f.
// Return 1 for always t.
// Return -1 for don't know (or can raise t or f).
static int check_possible_signals(struct analyser * a, struct node * p) {
    switch (p->type) {
        case c_fail:
        case c_false:
            /* Always gives signal f. */
            return 0;
        case c_stringassign:
        case c_attach:
        case c_debug:
        case c_do:
        case c_insert:
        case c_leftslice:
        case c_rightslice:
        case c_set:
        case c_slicefrom:
        case c_sliceto:
        case c_tolimit:
        case c_tomark:
        case c_true:
        case c_try:
        case c_unset:
        case c_assign:
        case c_plusassign:
        case c_minusassign:
        case c_multiplyassign:
        case c_divideassign:
        case c_functionend:
            /* Always gives signal t. */
            return 1;
        case c_repeat: {
            int possible_signals = p->left->possible_signals;
            if (possible_signals == 1) {
                fprintf(stderr, "%s:%d: warning: infinite loop: body of 'repeat' always signals 't'\n",
                        a->tokeniser->file, p->line_number);
                // Any code after this is unreachable.
                // FIXME: This only prunes the rest of this command list - we
                // want to prune anything that's only reachable from here.
                p->right = NULL;
            } else if (possible_signals == 0) {
                fprintf(stderr, "%s:%d: warning: body of 'repeat' always signals 'f'\n",
                        a->tokeniser->file, p->line_number);
                p->type = c_do;
            }
            /* Always gives signal t. */
            return 1;
        }
        case c_not: {
            // `not` signals the opposite to the command it is applied to.
            int res = p->left->possible_signals;
            if (res < 0) {
                // `not` applied to command which can signal `t` or `f`.
                return res;
            }
            if (res == 0) {
                fprintf(stderr, "%s:%d: warning: 'not' applied to command which always signals f\n",
                        a->tokeniser->file, p->line_number);
                // Handling the failure will restore the cursor, so equivalent to `do`.
                p->type = c_do;
                return 1;
            }
            fprintf(stderr, "%s:%d: warning: 'not' applied to command which always signals t\n",
                    a->tokeniser->file, p->line_number);
            // This `not` is equivalent to `fail`.
            p->type = c_fail;
            return 0;
        }
        case c_setlimit: {
            /* If either always signals f, setlimit does too. */
            int res = p->left->possible_signals;
            int res2 = p->aux->possible_signals;
            if (res == 0 || res2 == 0) {
                return 0;
            }
            // If both always signal t, setlimit does too.  Otherwise we know at
            // least one is unknown and that means setlimit's signal is unknown.
            // We can achieve that with a simple bitwise or.
            return res | res2;
        }
        case c_and:
        case c_bra: {
            struct node * q = p->left;
            int r = 1;
            while (q) {
                int res = q->possible_signals;
                if (res == 0) {
                    // If any command always signals f, then the list always
                    // signals f.
                    if (q->right) {
                        if (q->right->type != c_functionend) {
                            fprintf(stderr, "%s:%d: warning: command always signals f here so rest of %s is unreachable\n",
                                    a->tokeniser->file, q->line_number,
                                    (p->type == c_and ? "'and'" : "command list"));
                        }
                        q->right = NULL;
                    }
                    return res;
                }
                if (res < 0) r = res;
                q = q->right;
            }
            return r;
        }
        case c_backwards:
        case c_dollar:
        case c_loop:
        case c_reverse:
        case c_test:
            /* Give same signal as p->left. */
            return p->left->possible_signals;
        case c_atleast: {
            int possible_signals = p->left->possible_signals;
            if (possible_signals == 1) {
                fprintf(stderr, "%s:%d: warning: infinite loop: body of 'atleast' always signals 't'\n",
                        a->tokeniser->file, p->line_number);
                // Any code after this is unreachable.
                // FIXME: This only prunes the rest of this command list - we
                // want to prune anything that's only reachable from here.
                p->right = NULL;
            } else if (possible_signals == 0) {
                fprintf(stderr, "%s:%d: warning: body of 'atleast' always signals 'f'\n",
                        a->tokeniser->file, p->line_number);
                p->type = c_bra;
                p->AE = NULL;
            }
            /* Give same signal as p->left. */
            return possible_signals;
        }
        case c_call:
            // If the call recurses back into the current routine then this
            // will still be -1.
            return p->name->definition->possible_signals;
        case c_gopast:
        case c_goto:
        case c_goto_grouping:
        case c_gopast_grouping:
        case c_goto_non:
        case c_gopast_non:
            /* FIXME: unless we can prove that c is either definitely atlimit
             * or definitely not atlimit... */
            return -1;
        case c_booltest:
        case c_not_booltest:
        case c_hop:
        case c_literalstring:
        case c_next:
        case c_eq:
        case c_ne:
        case c_gt:
        case c_ge:
        case c_lt:
        case c_le:
        case c_grouping:
        case c_non:
        case c_name:
            /* FIXME: unless we can prove... */
            return -1;
        case c_substring: {
            struct among * x = p->among;
            if (x->always_matches) {
                return 1;
            }
            return -1;
        }
        case c_among: {
            struct among * x = p->among;
            int r = 1;

            if (x->substring == NULL) {
                if (!x->always_matches) {
                    r = -1;
                }
            }

            if (x->command_count > 0) {
                bool trues = (x->nocommand_count > 0);
                bool falses = false;
                for (int i = 1; i <= x->command_count; i++) {
                    int res = x->commands[i - 1]->possible_signals;
                    if (res == 0) {
                        falses = true;
                    } else if (res > 0) {
                        trues = true;
                    } else {
                        falses = trues = true;
                    }
                    if (falses && trues) break;
                }
                if (!trues) {
                    // All commands in among always fail.
                    return 0;
                }
                if (falses) {
                    // Commands in among can succeed or fail.
                    return -1;
                }
            }
            return r;
        }
        case c_or: {
            int r = 0;
            for (struct node * q = p->left; q; q = q->right) {
                // Just check this node - q->right is a separate clause of
                // the OR.
                int res = q->possible_signals;
                if (res > 0) {
                    // If any clause of the OR always signals t, then the OR
                    // always signals t.
                    if (q->right) {
                        if (q->right->type != c_functionend) {
                            fprintf(stderr, "%s:%d: warning: command always signals t here so rest of 'or' is unreachable\n",
                                    a->tokeniser->file,
                                    q->line_number);
                        }
                        q->right = NULL;
                    }
                    return 1;
                }
                if (res < 0) {
                    r = res;
                }
            }
            return r;
        }
        default:
            return -1;
    }
}

// Can control flow from node `p` reach routine `func`?
static bool recursion_check(struct node * p, struct name * func) {
    while (p) {
        switch (p->type) {
            case c_call:
                if (p->name == func) return true;
                if (p->name->definition && !p->name->visited) {
                    p->name->visited = true;
                    if (recursion_check(p->name->definition->left, func)) return true;
                }
                break;
            case c_among: {
                struct among * x = p->among;
                if (x->unique_function_count == 0) break;
                for (int i = 0; i < x->literalstring_count; ++i) {
                    if (x->v[i].function == func) return true;
                }
                break;
            }
        }
        if (p->left && recursion_check(p->left, func)) return true;
        if (p->aux && recursion_check(p->aux, func)) return true;
        p = p->right;
    }
    return false;
}

static void visit_routine(struct analyser * a, struct name * n);

static void visit_node(struct analyser * a, struct node * p, struct name * func) {
    while (p) {
        if (p->name) {
            if (p->name->count != -2) {
                // First use of this name that visit_node() has seen.
                p->name->used = p;
                p->name->local_to = func;
                if (p->type == c_call) {
                    visit_routine(a, p->name);
                } else {
                    // Mark as reachable.
                    p->name->count = -2;
                }
            } else if (p->name->local_to != func) {
                // Used in more than one routine/external.
                p->name->local_to = NULL;
            }
        } else if (p->type == c_among) {
            struct among * x = p->among;
            x->used = true;
            for (int i = 0; i < x->literalstring_count; ++i) {
                if (x->v[i].function)
                    visit_routine(a, x->v[i].function);
            }
            for (int i = 0; i < x->command_count; ++i) {
                visit_node(a, x->commands[i], func);
            }
        }
        if (p->left) {
            visit_node(a, p->left, func);
        }
        if (p->aux) {
            visit_node(a, p->aux, func);
        }
        if (p->AE) {
            visit_node(a, p->AE, func);
        }

        p->possible_signals = check_possible_signals(a, p);

        if ((p->type == c_and || p->type == c_or) && !p->left->right) {
            // Pruning of unreachable code can leave single-entry c_and and
            // c_or nodes.  These can lead to unused variables in the generated
            // code and may also hinder further optimisations.
            //
            // We want to replace these with their subnode.  It's fiddly to do
            // an actual replacement as we'd need to update the location we got
            // the current value of `p` from, so instead we swap the contents
            // of the two nodes.  Note that we must not swap the existing ->next
            // pointers as that could break the chain of all allocated nodes we
            // have from analyser->nodes.
            struct node * p_left = p->left;
            struct node * p_right = p->right;
            struct node * p_next = p->next;
            struct node tmp = *p;
            tmp.next = p_left->next;
            *p = *p_left;
            p->right = p_right;
            p->next = p_next;
            *p_left = tmp;
            if (p->type == c_among) {
                // Update struct among's node pointer.
                for (struct among * q = a->amongs; q; q = q->next) {
                    if (q->node == p_left) {
                        q->node = p;
                        break;
                    }
                }
            }
        }

        p = p->right;
    }
}

static void visit_routine(struct analyser * a, struct name * n) {
    if (n->count == -2) {
        // Already visited.  We set n->count before walking the definition so
        // this also prevents the walk from reentering a routine via recursive
        // calls.
        return;
    }
    n->count = -2;

    struct node * p = n->definition;

    // Recursive functions are valid in the Snowball language, but aren't
    // actually used in typical snowball programs so we take a simple
    // approach and handle them by setting pessimistic assumptions here which
    // will be used if a function calls itself (directly or indirectly).
    p->possible_signals = -1; // Assume it could signal t or f.

    visit_node(a, p->left, n);

    // Update with calculated value.
    p->possible_signals = p->left->possible_signals;
}

static struct node * clone_node(struct analyser * a, struct node * n) {
    if (n == NULL) return n;

    NEW(node, p);
    p->among = n->among;
    p->type = n->type;
    p->mode = n->mode;
    p->fixed_constant = n->fixed_constant;
    p->possible_signals = n->possible_signals;
    p->name = n->name;
    p->literalstring = n->literalstring;
    p->number = n->number;
    p->line_number = n->line_number;

    p->left = clone_node(a, n->left);
    p->aux = clone_node(a, n->aux);
    p->right = clone_node(a, n->right);
    p->AE = clone_node(a, n->AE);

    p->next = a->nodes;
    a->nodes = p;
    return p;
}

// Inline any calls to routine `n` in the code starting at `p`.
//
// Returns true if any calls were inlined.  If there are no remaining calls to
// `n` anywhere in the program then n->definition will be set to NULL.
static bool inline_calls(struct analyser * a,
                         struct node * p,
                         struct name * n) {
    bool r = false;
    while (p) {
        if (p->name == n && p->type == c_call) {
            p->type = c_bra;
            p->name = NULL;
            --n->references;
            if (n->references < 2) {
                // No more uses of n, so there is no need to clone the code.
                // We can also stop looking for uses of n to inline.
                p->left = n->definition->left;
                n->definition = NULL;
                return true;
            }
            p->left = clone_node(a, n->definition->left);
            p = p->right;
            r = true;
            continue;
        }
        if (inline_calls(a, p->left, n)) {
            if (!n->definition) return true;
            r = true;
        }
        if (inline_calls(a, p->aux, n)) {
            if (!n->definition) return true;
            r = true;
        }
        p = p->right;
    }
    return r;
}

extern void read_program(struct analyser * a, unsigned localise_mask) {
    read_program_(a, -1);
    for (struct name * q = a->names; q; q = q->next) {
        // Declaring but not defining is only an error if used.  We'll issue
        // a warning later on if there are no errors.
        if (!q->used) continue;

        bool error = false;
        switch (q->type) {
            case t_external: case t_routine:
                error = (q->definition == NULL);
                break;
            case t_grouping:
                error = (q->grouping == NULL);
                break;
        }
        if (error) {
            count_error(a);
            fprintf(stderr, "%s:%d: %s '%.*s' declared but not defined\n",
                    a->tokeniser->file, q->used->line_number,
                    name_of_type(q->type),
                    SIZE(q->s), q->s);
        }
    }

    // Skip name warning checks if there are errors.
    if (a->tokeniser->error_count)
        return;

    for (struct name ** n_ptr = &(a->names); *n_ptr; ) {
        struct name * n = *n_ptr;
        if (n->type == t_routine &&
            n->references >= 2 &&
            !n->definition->left->right) {
            bool inline_routine = false;
            if (n->references == 2) {
                // Inline any routine only called once (where that call is not
                // as an among function).
                //
                // Note: the definition of a routine is counted as a reference
                // to its name, so a routine only called once has 2 references.
                inline_routine = (n->uses_in_among == 0);
            } else {
                // Inline any calls to routines which is simple enough that the
                // generated code to call the routine is likely to be a similar
                // size to the inlined code that replaces it.
                //
                // Currently we inline any non-compound command (including
                // non-compound commands we synthesise, such as `goto` applied
                // to a grouping).
                switch (n->definition->left->type) {
                    case c_eq:
                    case c_ge:
                    case c_gt:
                    case c_le:
                    case c_lt:
                    case c_ne:
                    case c_booltest:
                    case c_not_booltest:
                    case c_grouping:
                    case c_non:
                    case c_goto_grouping:
                    case c_gopast_grouping:
                    case c_goto_non:
                    case c_gopast_non:
                    case c_literalstring:
                    case c_name:
                    case c_true:
                    case c_false:
                    case c_fail:
                    case c_set:
                    case c_unset:
                    case c_assign:
                    case c_plusassign:
                    case c_minusassign:
                    case c_multiplyassign:
                    case c_divideassign:
                    case c_tomark:
                    case c_tolimit:
                    case c_hop:
                    case c_next:
                    case c_insert:
                    case c_attach:
                    case c_leftslice:
                    case c_rightslice:
                    case c_sliceto:
                    case c_stringassign:
                    case c_slicefrom:
                        inline_routine = true;
                        break;
                }
            }

            if (inline_routine) {
#if 0
                fprintf(stderr, "%s:%d: info: Inlining %.*s\n",
                        a->tokeniser->file,
                        n->used->line_number,
                        SIZE(n->s), n->s);
#endif
                bool remove = false;
                for (struct name * r = a->names; r; r = r->next) {
                    // Only routines and externals.
                    if (!r->definition) continue;
                    // Don't try to inline a routine into itself!
                    if (r == n) continue;
                    if (inline_calls(a, r->definition->left, n)) {
                        // If n contains an among, r now does.  Similarly
                        // for an among with functions.
                        r->has_among |= n->has_among;
                        r->has_among_function |= n->has_among_function;
                        if (n->definition == NULL) {
                            // All calls to routine `n` have now been inlined
                            // so remove it and move on to the next candidate
                            // for inlining.
                            remove = true;
                            break;
                        }
                    }
                }
                if (remove) {
                    remove_routine(a, n);
                    *n_ptr = n->next;
                    lose_s(n->s);
                    FREE(n);
                    continue;
                }
            }
        }

        n_ptr = &(n->next);
    }

    for (struct name * name = a->names; name; name = name->next) {
        struct node * p = name->definition;
        if (!p) {
            // Either this name is not a routine/external, or it is missing
            // a definition (which gets reported later).
            continue;
        }

        // Recursion is rare in real-world Snowball programs, and there are
        // some optimisations that we don't attempt if this flag is set.
        for (struct name * n = a->names; n; n = n->next) {
            n->visited = false;
        }
        name->recursive = recursion_check(p->left, name);
#if 0
        if (name->recursive) {
            fprintf(stderr,
                    "%s:%d: info: `%.*s` is recursive\n",
                    a->tokeniser->file, name->definition->line_number,
                    SIZE(name->s), name->s);
        }
#endif

        // Add "functionend" nodes so that optimisations such as dead code
        // elimination and tail call optimisation can easily see where the
        // function ends.
        assert(p->type == c_define);
        assert(p->left);
        assert(p->left->right == NULL);
        if (p->left->type == c_bra) {
            /* Put the "functionend" node at the end of the command list. */
            struct node * e = p->left->left;
            if (e) {
                while (e->right) e = e->right;
                e->right = new_node(a, c_functionend);
            } else {
                p->left = new_node(a, c_functionend);
            }
        } else {
            /* Put the "functionend" node after the single command. */
            p->left->right = new_node(a, c_functionend);
        }
    }

    // Trace possible control flow starting from externals to discover any
    // unreachable code.  This also fills in possible_signals for each
    // reachable node.
    for (struct name * n = a->names; n; n = n->next) {
        if (n->type == t_external) {
            if (!n->used) {
                // Externals can be called from outside of Snowball, so if they
                // aren't already marked as used we set the `used` field to
                // point to the definition so we can just check this field
                // later.
                n->used = n->definition;
            }
            visit_routine(a, n);
        }
    }

    for (struct name * q = a->names; q; q = q->next) {
        if (q->references == 0) {
            fprintf(stderr, "%s:%d: warning: %s '%.*s' ",
                    a->tokeniser->file,
                    q->declaration_line_number,
                    name_of_type(q->type),
                    SIZE(q->s), q->s);
            if (q->type == t_routine ||
                q->type == t_external ||
                q->type == t_grouping) {
                fprintf(stderr, "declared but not defined\n");
            } else {
                fprintf(stderr, "declared but not used\n");
            }
            q->used = NULL;
            continue;
        }

        if (q->type == t_routine || q->type == t_grouping) {
            /* It's OK to define a grouping but only use it to define other
             * groupings.
             */
            if (!q->used && !q->used_in_definition) {
                int line_num;
                if (q->type == t_routine) {
                    line_num = q->definition->line_number;
                } else {
                    line_num = q->grouping->line_number;
                }
                fprintf(stderr, "%s:%d: warning: %s '%.*s' defined but not used\n",
                        a->tokeniser->file,
                        line_num,
                        name_of_type(q->type),
                        SIZE(q->s), q->s);
                continue;
            }
        }

        if (q->type < t_routine) {
            if (!q->initialised) {
                fprintf(stderr, "%s:%d: warning: %s '%.*s' is never initialised\n",
                        a->tokeniser->file,
                        q->declaration_line_number,
                        name_of_type(q->type),
                        SIZE(q->s), q->s);
            } else if (!q->value_used) {
                fprintf(stderr, "%s:%d: warning: %s '%.*s' is set but never used\n",
                        a->tokeniser->file,
                        q->declaration_line_number,
                        name_of_type(q->type),
                        SIZE(q->s), q->s);
                remove_dead_assignments(a->program, q);
                q->used = NULL;
                continue;
            }
        }

        if (q->count == -1) {
            // Used but use is not reachable by calling any externals so
            // suppress all code generation for this name.
            //
            // We only issue a warning about unreachability for routines here
            // to avoid excess diagnostics, since other types must be used in a
            // routine which is reachable (or will have been warned about as
            // unused by the check above).
            if (q->type == t_routine) {
                fprintf(stderr, "%s:%d: warning: %s '%.*s' not reachable from any externals\n",
                        a->tokeniser->file,
                        q->definition->line_number,
                        name_of_type(q->type),
                        SIZE(q->s), q->s);
                remove_routine(a, q);
            }
            q->used = NULL;
        }
    }

    /* We've now identified variables whose values are never used and
     * names which are unreachable, and cleared "used" for them, so go
     * through and unlink the unused ones.
     */
    struct name * n = a->names;
    struct name ** n_ptr = &(a->names);
    while (n) {
        if (!n->used) {
            if (n->grouping) {
                // Clear the name field then loop through and remove from
                // the groupings list just below.
                n->grouping->name = NULL;
            } else if (n->definition) {
                remove_routine(a, n);
            }
            struct name * n_next = n->next;
            lose_s(n->s);
            FREE(n);
            n = n_next;
            *n_ptr = n;
            continue;
        }
        n_ptr = &(n->next);
        n = n->next;
    }

    // Remove groupings which aren't used.
    struct grouping * g = a->groupings;
    struct grouping ** g_ptr = &(a->groupings);
    while (g) {
        if (!g->name) {
            struct grouping * g_next = g->next;
            lose_b(g->b);
            FREE(g);
            g = g_next;
            *g_ptr = g;
            continue;
        }
        g_ptr = &(g->next);
        g = g->next;
    }

    // Remove amongs which are in unreachable routines from the list
    // and number the others.
    {
        int among_count = 0;
        struct among ** a_ptr = &(a->amongs);
        while (*a_ptr) {
            struct among * x = *a_ptr;
            if (!x->used) {
                *a_ptr = x->next;
                free_among(x);
                continue;
            }

            x->number = among_count++;
            if (x->function_count > 0) ++a->among_with_function_count;

            for (int i = 1; i <= x->command_count; i++) {
                int merge_with = 0;
                struct node * command = x->commands[i - 1];
                assert(command->type == c_bra);
                if (!command->left || is_just_true(command->left)) {
                    // Optimisation has turned this action into a no-op.
                    command->left = NULL;
                    merge_with = -1;
                } else {
                    for (int k = 1; k < i; ++k) {
                        if (nodes_equivalent(command->left, x->commands[k - 1]->left)) {
                            // Optimisation has made this action equivalent
                            // to an earlier one.
                            merge_with = k;
                            break;
                        }
                    }
                }
                if (!merge_with) continue;

                // Update references to this command index to be `merge_with`
                // and subtract one from references to command indexes after
                // this one.
                for (int j = 0; j < x->literalstring_count; ++j) {
                    int diff = (x->v[j].result - i);
                    if (diff == 0) {
                        x->v[j].result = merge_with;
                        if (merge_with == 0) {
                            assert(x->v[j].action->type == c_bra);
                            x->v[j].action->left = NULL;
                        }
                    } else if (diff > 0) {
                        --x->v[j].result;
                    }
                }
                memmove(x->commands + (i - 1), x->commands + i,
                        sizeof(x->commands[0]) * (x->command_count - i));
                --x->command_count;
                ++x->nocommand_count;
                --i;
            }

            if (x->command_count > 1 ||
                (x->command_count == 1 && x->nocommand_count > 0)) {
                /* We need to set among_var rather than just checking if
                 * find_among*() returns zero or not.
                 */
                x->amongvar_needed = true;
            }

            a_ptr = &(x->next);
        }
    }

    /* Localise variables.
     *
     * We localise variables which are only referenced in a single non-recursive
     * function (routine or external) and which are always set before being
     * read within that function (since a function could rely on a variable's
     * previous value surviving).
     *
     * This optimisation is done after inlining, since inlining can often move
     * all references to a variable into the same function.
     *
     * We could potentially localise variables referenced in multiple functions
     * provided that they are always set before use in every function they are
     * referenced in, and that these functions don't call one another, but that
     * situation doesn't occur in any of the stemmers we currently ship.
     */
    memset(a->name_count, 0, sizeof(a->name_count));
    for (struct name * name = a->names; name; name = name->next) {
        if (name->local_to) {
            if (localise_mask & (1 << name->type)) {
                struct node * func = name->local_to->definition;
                if (name->local_to->recursive) {
                    fprintf(stderr,
                            "%s:%d: info: Could not localise %s `%.*s` into recursive routine `%.*s`\n",
                            a->tokeniser->file, func->line_number,
                            name_of_type(name->type),
                            SIZE(name->s), name->s,
                            SIZE(func->name->s), func->name->s);
                    name->local_to = NULL;
                } else if (!always_set_before_use(func->left, name)) {
                    fprintf(stderr,
                            "%s:%d: info: Could not localise %s `%.*s` to routine `%.*s`\n",
                            a->tokeniser->file, func->line_number,
                            name_of_type(name->type),
                            SIZE(name->s), name->s,
                            SIZE(func->name->s), func->name->s);
                    name->local_to = NULL;
                }
            } else {
                name->local_to = NULL;
            }
        }
        if (name->local_to == NULL) {
            name->count = a->name_count[name->type]++;
        }
    }
    a->variable_count = a->name_count[t_string] +
                        a->name_count[t_boolean] +
                        a->name_count[t_integer];

    // Now number the locals (which e.g. Ada and Pascal use to avoid clashes
    // from case-insensitive variable names).  We use a copy of the counters
    // to do this so that a->name_count[] reflects the number of non-localised
    // variables of each type.
    int name_count[t_size];
    memcpy(name_count, a->name_count, sizeof(name_count));
    for (struct name * name = a->names; name; name = name->next) {
        if (name->count < 0) {
            name->count = name_count[name->type]++;
        }
    }
}

extern struct analyser * create_analyser(struct tokeniser * t) {
    NEW(analyser, a);
    *a = (struct analyser){0};
    a->tokeniser = t;
    a->mode = m_forward;
    a->modifyable = true;
    return a;
}

extern void close_analyser(struct analyser * a) {
    {
        struct node * q = a->nodes;
        while (q) {
            struct node * q_next = q->next;
            FREE(q);
            q = q_next;
        }
    }
    {
        struct name * q = a->names;
        while (q) {
            struct name * q_next = q->next;
            lose_s(q->s);
            FREE(q);
            q = q_next;
        }
    }
    {
        struct literalstring * q = a->literalstrings;
        while (q) {
            struct literalstring * q_next = q->next;
            lose_b(q->b); FREE(q);
            q = q_next;
        }
    }
    {
        struct among * q = a->amongs;
        while (q) {
            struct among * q_next = q->next;
            free_among(q);
            q = q_next;
        }
    }
    {
        struct grouping * q = a->groupings;
        while (q) {
            struct grouping * q_next = q->next;
            lose_b(q->b); FREE(q);
            q = q_next;
        }
    }
    FREE(a);
}
