mittens 0.3.1 → 0.3.2

data/vendor/snowball/compiler/analyser.c

@@ -1,42 +1,18 @@
 #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"
 
-typedef enum {
-    e_token_omitted = 0,
-    e_unexpected_token = 1,
-    e_string_omitted = 2,
-    e_unexpected_token_in_among = 3,
-    /* For codes above here, report "after " t->previous_token after the error. */
-    e_unresolved_substring = 14,
-    e_not_allowed_inside_reverse = 15,
-    e_empty_grouping = 16,
-    e_already_backwards = 17,
-    e_empty_among = 18,
-    e_adjacent_bracketed_in_among = 19,
-    e_substring_preceded_by_substring = 20,
-    /* For codes below here, tokeniser->s is printed before the error. */
-    e_redeclared = 30,
-    e_undeclared = 31,
-    e_declared_as_different_mode = 32,
-    e_not_of_type_x = 33,
-    e_not_of_type_string_or_integer = 34,
-    e_misplaced = 35,
-    e_redefined = 36,
-    e_misused = 37
-} error_code;
-
 /* recursive usage: */
 
 static void read_program_(struct analyser * a, int terminator);
 static struct node * read_C(struct analyser * a);
-static struct node * C_style(struct analyser * a, const char * s, int token);
-
+static struct node * new_string_command(struct analyser * a, int token);
 
-static void print_node_(struct node * p, int n, const char * s) {
+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(' ');
@@ -57,24 +33,24 @@ static void print_node_(struct node * p, int n, const char * s) {
 }
 
 extern void print_program(struct analyser * a) {
-    print_node_(a->program, 0, "");
+    if (a->program) print_node_(a->program, 0, "");
 }
 
-static struct node * new_node(struct analyser * a, int type) {
+static struct node * new_node_at_line(struct analyser * a, int type, int line) {
     NEW(node, p);
-    p->next = a->nodes; a->nodes = p;
-    p->left = NULL;
-    p->right = NULL;
-    p->aux = NULL;
-    p->AE = NULL;
-    p->name = NULL;
-    p->literalstring = NULL;
+    *p = (struct node){0};
     p->mode = a->mode;
-    p->line_number = a->tokeniser->line_number;
+    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";
@@ -84,20 +60,7 @@ static const char * name_of_mode(int n) {
     exit(1);
 }
 
-static const char * name_of_type(int n) {
-    switch (n) {
-        case 'b': return "boolean";
-        case 's': return "string";
-        case 'i': return "integer";
-        case 'r': return "routine";
-        case 'R': return "routine or grouping";
-        case 'g': return "grouping";
-    }
-    fprintf(stderr, "Invalid type %d in name_of_type()\n", n);
-    exit(1);
-}
-
-static const char * name_of_name_type(int code) {
+static const char * name_of_type(int code) {
     switch (code) {
         case t_string: return "string";
         case t_boolean: return "boolean";
@@ -106,7 +69,7 @@ static const char * name_of_name_type(int code) {
         case t_external: return "external";
         case t_grouping: return "grouping";
     }
-    fprintf(stderr, "Invalid type code %d in name_of_name_type()\n", code);
+    fprintf(stderr, "Invalid type code %d in name_of_type()\n", code);
     exit(1);
 }
 
@@ -116,108 +79,99 @@ static void count_error(struct analyser * a) {
     t->error_count++;
 }
 
-static void error2(struct analyser * a, error_code n, int x) {
+static void report_error_location_line(struct analyser * a, int line) {
     struct tokeniser * t = a->tokeniser;
-    if (n == e_unexpected_token && t->token_reported_as_unexpected) {
-        // Avoid duplicate errors if this token was already reported as
-        // unexpected and then held.
-        return;
-    }
     count_error(a);
-    fprintf(stderr, "%s:%d: ", t->file, t->line_number);
-    if ((int)n >= (int)e_redeclared) report_s(stderr, t->s);
-    switch (n) {
-        case e_token_omitted:
-            fprintf(stderr, "%s omitted", name_of_token(t->omission)); break;
-        case e_unexpected_token_in_among:
-            fprintf(stderr, "in among(...), ");
-            /* fall through */
-        case e_unexpected_token:
-            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) {
-                t->s[SIZE(t->s)] = 0;
-                fprintf(stderr, " %s", t->s);
-            }
-            break;
-        case e_string_omitted:
-            fprintf(stderr, "string omitted"); break;
-
-        case e_unresolved_substring:
-            fprintf(stderr, "unresolved substring on line %d", x); break;
-        case e_not_allowed_inside_reverse:
-            fprintf(stderr, "%s not allowed inside reverse(...)", name_of_token(t->token)); break;
-        case e_empty_grouping:
-            fprintf(stderr, "empty grouping"); break;
-        case e_already_backwards:
-            fprintf(stderr, "backwards used when already in this mode"); break;
-        case e_empty_among:
-            fprintf(stderr, "empty among(...)"); break;
-        case e_adjacent_bracketed_in_among:
-            fprintf(stderr, "two adjacent bracketed expressions in among(...)"); break;
-        case e_substring_preceded_by_substring:
-            fprintf(stderr, "substring preceded by another substring on line %d", x); break;
-
-        case e_redeclared:
-            fprintf(stderr, " re-declared"); break;
-        case e_undeclared:
-            fprintf(stderr, " undeclared"); break;
-        case e_declared_as_different_mode:
-            fprintf(stderr, " declared as %s mode; used as %s mode",
-                            name_of_mode(a->mode), name_of_mode(x)); break;
-        case e_not_of_type_x:
-            fprintf(stderr, " not of type %s", name_of_type(x)); break;
-        case e_not_of_type_string_or_integer:
-            fprintf(stderr, " not of type string or integer"); break;
-        case e_misplaced:
-            fprintf(stderr, " misplaced"); break;
-        case e_redefined:
-            fprintf(stderr, " redefined"); break;
-        case e_misused:
-            fprintf(stderr, " mis-used as %s mode",
-                            name_of_mode(x)); break;
-    }
-    if ((int)n < (int)e_unresolved_substring && t->previous_token > 0)
-        fprintf(stderr, " after %s", name_of_token(t->previous_token));
-    fprintf(stderr, "\n");
+    fprintf(stderr, "%s:%d: ", t->file, line);
 }
 
-static void error(struct analyser * a, error_code n) { error2(a, n, 0); }
+static void report_error_location(struct analyser * a) {
+    struct tokeniser * t = a->tokeniser;
+    report_error_location_line(a, t->line_number);
+}
 
-static void error4(struct analyser * a, struct name * q) {
-    count_error(a);
-    q->s[SIZE(q->s)] = 0;
-    fprintf(stderr, "%s:%d: %s undefined\n", a->tokeniser->file, q->used->line_number, q->s);
+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) {
-    a->tokeniser->omission = n;
-    error(a, e_token_omitted);
+    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); return false; }
+    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);
-    int x = check_token(a, code);
-    if (!x) hold_token(t);
-    return x;
+    return check_token(a, code);
 }
 
 static struct name * look_for_name(struct analyser * a) {
     const byte * q = a->tokeniser->s;
-    struct name * p;
-    for (p = a->names; p; p = p->next) {
+    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->referenced = true;
+            ++p->references;
             return p;
         }
     }
@@ -226,37 +180,34 @@ static struct name * look_for_name(struct analyser * a) {
 
 static struct name * find_name(struct analyser * a) {
     struct name * p = look_for_name(a);
-    if (p == NULL) error(a, e_undeclared);
+    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) error2(a, e_misused, 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 void check_name_type(struct analyser * a, struct name * p, int type) {
-    switch (type) {
-        case 's':
-            if (p->type == t_string) return;
-            break;
-        case 'i':
-            if (p->type == t_integer) return;
-            break;
-        case 'b':
-            if (p->type == t_boolean) return;
-            break;
-        case 'R':
-            if (p->type == t_grouping) return;
-            /* FALLTHRU */
-        case 'r':
-            if (p->type == t_routine || p->type == t_external) return;
-            break;
-        case 'g':
-            if (p->type == t_grouping) return;
-            break;
-    }
-    error2(a, e_not_of_type_x, type);
+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) {
@@ -270,7 +221,7 @@ static void read_names(struct analyser * a, int type) {
                  * its special meaning, for compatibility with older versions
                  * of snowball.
                  */
-                SIZE(t->s) = 0;
+                SET_SIZE(t->s, 0);
                 t->s = add_literal_to_s(t->s, "len");
                 goto handle_as_name;
             }
@@ -279,39 +230,57 @@ static void read_names(struct analyser * a, int type) {
                  * its special meaning, for compatibility with older versions
                  * of snowball.
                  */
-                SIZE(t->s) = 0;
+                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 (look_for_name(a) != NULL) error(a, e_redeclared); else {
+                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;
-                    p->mode = m_unknown; /* used for routines, externals */
-                    /* We defer assigning counts until after we've eliminated
-                     * variables whose values are never used. */
+                    /* 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->referenced = false;
-                    p->used_in_among = false;
-                    p->used = NULL;
-                    p->value_used = false;
-                    p->initialised = false;
-                    p->used_in_definition = false;
-                    p->local_to = NULL;
-                    p->grouping = NULL;
-                    p->definition = NULL;
                     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;
-                    if (token != c_name) {
-                        disable_token(t, token);
-                    }
                 }
                 break;
             default:
-                if (!check_token(a, c_ket)) hold_token(t);
+                check_token(a, c_ket);
                 return;
         }
     }
@@ -328,7 +297,7 @@ static symbol * new_literalstring(struct analyser * a) {
 static int read_AE_test(struct analyser * a) {
     struct tokeniser * t = a->tokeniser;
     switch (read_token(t)) {
-        case c_assign: return c_mathassign;
+        case c_assign:
         case c_plusassign:
         case c_minusassign:
         case c_multiplyassign:
@@ -338,9 +307,10 @@ static int read_AE_test(struct analyser * a) {
         case c_gt:
         case c_ge:
         case c_lt:
-        case c_le: return t->token;
+        case c_le:
+            return t->token;
         default:
-            error(a, e_unexpected_token);
+            unexpected_token_error(a, "integer test expression");
             hold_token(t);
             return c_eq;
     }
@@ -355,14 +325,9 @@ static int binding(int t) {
 }
 
 static void mark_used_in(struct analyser * a, struct name * q, struct node * p) {
+    (void)a;
     if (!q->used) {
         q->used = p;
-        q->local_to = a->program_end->name;
-    } else if (q->local_to) {
-        if (q->local_to != a->program_end->name) {
-            /* Used in more than one routine/external. */
-            q->local_to = NULL;
-        }
     }
 }
 
@@ -380,7 +345,9 @@ static struct node * read_AE(struct analyser * a, struct name * assigned_to, int
     struct node * p;
     struct node * q;
     switch (read_token(t)) {
-        case c_minus: /* monadic */
+        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
@@ -397,16 +364,17 @@ static struct node * read_AE(struct analyser * a, struct name * assigned_to, int
                 p = q;
                 break;
             }
-            p = new_node(a, c_neg);
+            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, 'i');
+            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);
@@ -430,7 +398,7 @@ static struct node * read_AE(struct analyser * a, struct name * assigned_to, int
         case c_lenof:
         case c_sizeof: {
             int token = t->token;
-            p = C_style(a, "S", token);
+            p = new_string_command(a, token);
             if (!p->literalstring) {
                 if (p->name) p->name->value_used = true;
                 break;
@@ -439,15 +407,12 @@ static struct node * read_AE(struct analyser * a, struct name * assigned_to, int
             /* Replace lenof or sizeof on a literal string with a numeric
              * constant.
              */
-            int result;
+            int result = 0;
             if (token == c_lenof && t->encoding == ENC_UTF8) {
                 // UTF-8.
-                int i = 0;
                 symbol * b = p->literalstring;
-                result = 0;
-                while (i < SIZE(b)) {
-                    int dummy;
-                    i += get_utf8(b + i, &dummy);
+                int dummy;
+                for (int i = 0; i < SIZE(b); i += get_utf8(b + i, &dummy)) {
                     ++result;
                 }
             } else {
@@ -460,46 +425,44 @@ static struct node * read_AE(struct analyser * a, struct name * assigned_to, int
             break;
         }
         default:
-            error(a, e_unexpected_token);
+            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) {
+        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 = new_node(a, c_number);
+            q = p;
             switch (token) {
                 case c_plus:
-                    q->number = p->number + r->number;
+                    q->number += r->number;
                     break;
                 case c_minus:
-                    q->number = p->number - r->number;
+                    q->number -= r->number;
                     break;
                 case c_multiply:
-                    q->number = p->number * r->number;
+                    q->number *= r->number;
                     break;
                 case c_divide:
-                    if (r->number == 0) {
-                        fprintf(stderr, "%s:%d: Division by zero\n",
-                                t->file, t->line_number);
-                        exit(1);
-                    }
-                    q->number = p->number / r->number;
+                    q->number /= r->number;
                     break;
                 default:
                     fprintf(stderr, "Unexpected AE operator %s\n",
                             name_of_token(token));
                     exit(1);
             }
-            q->fixed_constant = p->fixed_constant && r->fixed_constant;
-            q->line_number = p->line_number;
+            q->fixed_constant = q->fixed_constant && r->fixed_constant;
         } else {
             // Check for specific constant or no-op cases.
             q = NULL;
@@ -519,7 +482,7 @@ static struct node * read_AE(struct analyser * a, struct name * assigned_to, int
                 case c_minus:
                     // 0 - r is -r
                     if (p->type == c_number && p->number == 0) {
-                        q = new_node(a, c_neg);
+                        q = new_node_at_line(a, c_neg, op_line);
                         q->right = r;
                         break;
                     }
@@ -538,27 +501,23 @@ static struct node * read_AE(struct analyser * a, struct name * assigned_to, int
                     // p * 0 is 0
                     if (r->type == c_number && r->number == 0) {
                         q = r;
-                        q->line_number = p->line_number;
                         break;
                     }
                     // -1 * r is -r
                     if (p->type == c_number && p->number == -1) {
-                        q = new_node(a, c_neg);
+                        q = new_node_at_line(a, c_neg, p->line_number);
                         q->right = r;
-                        q->line_number = p->line_number;
                         break;
                     }
                     // p * -1 is -p
                     if (r->type == c_number && r->number == -1) {
-                        q = new_node(a, c_neg);
+                        q = new_node_at_line(a, c_neg, r->line_number);
                         q->right = p;
-                        q->line_number = p->line_number;
                         break;
                     }
                     // 1 * r is r
                     if (p->type == c_number && p->number == 1) {
                         q = r;
-                        q->line_number = p->line_number;
                         break;
                     }
                     // p * 1 is p
@@ -575,21 +534,19 @@ static struct node * read_AE(struct analyser * a, struct name * assigned_to, int
                     }
                     // p / -1 is -p
                     if (r->type == c_number && r->number == -1) {
-                        q = new_node(a, c_neg);
+                        q = new_node_at_line(a, c_neg, r->line_number);
                         q->right = p;
-                        q->line_number = p->line_number;
                         break;
                     }
                     // p / 0 is an error!
                     if (r->type == c_number && r->number == 0) {
-                        fprintf(stderr, "%s:%d: Division by zero\n",
-                                t->file, t->line_number);
-                        exit(1);
+                        report_error_location_line(a, op_line);
+                        fprintf(stderr, "Division by zero\n");
                     }
                     break;
             }
             if (!q) {
-                q = new_node(a, token);
+                q = new_node_at_line(a, token, op_line);
                 q->left = p;
                 q->right = r;
             }
@@ -598,17 +555,81 @@ static struct node * read_AE(struct analyser * a, struct name * assigned_to, int
     }
 }
 
-static struct node * read_C_connection(struct analyser * a, struct node * q, int op) {
+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;
-    struct node * p = new_node(a, op);
-    struct node * p_end = q;
-    p->left = q;
+    // 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 {
-        q = read_C(a);
-        p_end->right = q; p_end = q;
-    } while (read_token(t) == op);
+        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);
-    return p;
+    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) {
@@ -620,47 +641,37 @@ static struct node * read_C_list(struct analyser * a) {
         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_and && token != c_or) {
-                    hold_token(t);
-                    break;
-                }
-                q = read_C_connection(a, q, token);
+
+        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;
         }
+        if (p_end == NULL) p->left = q; else p_end->right = q;
+        p_end = q;
     }
 }
 
-static struct node * C_style(struct analyser * a, const char * s, int token) {
-    int i;
+static struct node * new_string_command(struct analyser * a, int token) {
     struct node * p = new_node(a, token);
-    for (i = 0; s[i] != 0; i++) switch (s[i]) {
-        case 'C':
-            p->left = read_C(a); continue;
-        case 'D':
-            p->aux = read_C(a); continue;
-        case 'A':
-            p->AE = read_AE(a, NULL, 0); continue;
-        case 'f':
-            get_token(a, c_for); continue;
-        case 'S':
-            {
-                int str_token = read_token(a->tokeniser);
-                if (str_token == c_name) name_to_node(a, p, 's'); else
-                if (str_token == c_literalstring) p->literalstring = new_literalstring(a);
-                else error(a, e_string_omitted);
-            }
-            continue;
-        case 'b':
-        case 's':
-        case 'i':
-            if (get_token(a, c_name)) name_to_node(a, p, s[i]);
-            continue;
+    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;
 }
@@ -685,76 +696,44 @@ static int compare_amongvec(const void *pv, const void *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;
-    int i;
-    for (i = 0; i < smaller_size; i++)
+    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->line_number - q->line_number;
+    return p->string_index - q->string_index;
 }
 
-#define PTR_NULL_CHECK(P, Q) do {\
-        if ((Q) == NULL) {\
-            if ((P) != NULL) return 1;\
-        } else {\
-            if ((P) == NULL) return -1;\
-        }\
-    } while (0)
-
-static int compare_node(const struct node *p, const struct node *q) {
-    PTR_NULL_CHECK(p, q);
-    if (q == NULL) {
-        /* p must be NULL too. */
-        return 0;
-    }
+#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 p->type > q->type ? 1 : -1;
-    if (p->mode != q->mode) return p->mode > q->mode ? 1 : -1;
+    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 p->number > q->number ? 1 : -1;
-    }
-
-    PTR_NULL_CHECK(p->left, q->left);
-    if (p->left) {
-        int r = compare_node(p->left, q->left);
-        if (r != 0) return r;
+            return false;
     }
 
-    PTR_NULL_CHECK(p->AE, q->AE);
-    if (p->AE) {
-        int r = compare_node(p->AE, q->AE);
-        if (r != 0) return r;
-    }
-
-    PTR_NULL_CHECK(p->aux, q->aux);
-    if (p->aux) {
-        int r = compare_node(p->aux, q->aux);
-        if (r != 0) return r;
-    }
+    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;
 
-    PTR_NULL_CHECK(p->name, q->name);
-    if (p->name) {
-        int r;
-        if (SIZE(p->name->s) != SIZE(q->name->s)) {
-            return SIZE(p->name->s) - SIZE(q->name->s);
-        }
-        r = memcmp(p->name->s, q->name->s, SIZE(p->name->s));
-        if (r != 0) return r;
-    }
+    if (p->name != q->name) return false;
 
-    PTR_NULL_CHECK(p->literalstring, q->literalstring);
-    if (p->literalstring) {
-        int r;
-        if (SIZE(p->literalstring) != SIZE(q->literalstring)) {
-            return SIZE(p->literalstring) - SIZE(q->literalstring);
+    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;
         }
-        r = memcmp(p->literalstring, q->literalstring,
-                   SIZE(p->literalstring) * sizeof(symbol));
-        if (r != 0) return r;
     }
 
-    return compare_node(p->right, q->right);
+    return nodes_equivalent(p->right, q->right);
 }
 
 static struct node * make_among(struct analyser * a, struct node * p, struct node * substring) {
@@ -769,40 +748,44 @@ static struct node * make_among(struct analyser * a, struct node * p, struct nod
     int direction = substring != NULL ? substring->mode : p->mode;
     int backward = direction == m_backward;
 
-    if (a->amongs == NULL) a->amongs = x; else a->amongs_end->next = x;
-    a->amongs_end = x;
-    x->next = NULL;
+    *x = (struct among){0};
     x->node = p;
     x->b = v;
-    x->number = a->among_count++;
-    x->function_count = 0;
-    x->nocommand_count = 0;
-    x->amongvar_needed = false;
-    x->always_matches = false;
     x->shortest_size = INT_MAX;
+    x->in_routine = a->current_routine;
 
     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 below */
+            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->used_in_among = true;
+                ++function->uses_in_among;
                 check_routine_mode(a, function, direction);
-                x->function_count++;
+                if (function->among_index == 0) {
+                    function->among_index = ++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.
@@ -818,13 +801,15 @@ static struct node * make_among(struct analyser * a, struct node * p, struct nod
              * 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 && compare_node(w->action->left, q->left) == 0) {
+                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;
                 }
@@ -834,7 +819,7 @@ static struct node * make_among(struct analyser * a, struct node * p, struct nod
             }
 
             while (w0 != w1) {
-                w0->action = q;
+                w0->action = action;
                 w0->result = among_result;
                 w0++;
             }
@@ -845,6 +830,7 @@ static struct node * make_among(struct analyser * a, struct node * p, struct nod
     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++) {
@@ -854,8 +840,25 @@ static struct node * make_among(struct analyser * a, struct node * p, struct nod
                     fprintf(stderr, "More among codes than expected\n");
                     exit(1);
                 }
-                if (!commands[w0->result - 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;
             }
@@ -871,7 +874,10 @@ static struct node * make_among(struct analyser * a, struct node * p, struct nod
         int size = w0->size;
         struct amongvec * w;
 
-        if (size && size < x->shortest_size) x->shortest_size = size;
+        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) {
@@ -898,39 +904,131 @@ static struct node * make_among(struct analyser * a, struct node * p, struct nod
     x->literalstring_count = p->number;
     p->among = x;
 
-    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 = a->amongvar_needed = true;
-    }
     if (starter) {
         starter->right = p;
+        p = new_node_at_line(a, c_bra, starter->line_number);
         if (substring) {
-            p = starter;
+            p->left = starter;
         } else {
-            substring = new_node(a, c_substring);
+            substring = new_node_at_line(a, c_substring, starter->line_number);
             substring->right = starter;
-            p = substring;
+            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(x->commands);
+        FREE(x);
+        FREE(v);
+        return p;
+    }
+
+    if (x->function_count) {
+        if (a->current_routine) a->current_routine->among_with_function = true;
     }
+
     x->substring = substring;
     if (substring != NULL) substring->among = x;
 
-    if (x->function_count > 0) ++a->among_with_function_count;
+    if (a->amongs == NULL) a->amongs = x; else a->amongs_end->next = x;
+    a->amongs_end = x;
 
     return p;
 }
 
-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_among(struct analyser * a) {
     struct tokeniser * t = a->tokeniser;
     struct node * p = new_node(a, c_among);
@@ -949,14 +1047,18 @@ static struct node * read_among(struct analyser * a) {
                 q = read_literalstring(a);
                 if (read_token(t) == c_name) {
                     struct node * r = new_node(a, c_name);
-                    name_to_node(a, r, 'r');
+                    name_to_node(a, r, t_routine);
                     q->left = r;
                 } else {
                     hold_token(t);
                 }
-                p->number++; break;
+                p->number++;
+                break;
             case c_bra:
-                if (previous_token == c_bra) error(a, e_adjacent_bracketed_in_among);
+                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
@@ -966,11 +1068,14 @@ static struct node * read_among(struct analyser * a) {
                 }
                 break;
             default:
-                error(a, e_unexpected_token_in_among);
+                unexpected_token_error(a, "among(...)");
                 previous_token = token;
                 continue;
             case c_ket:
-                if (p->number == 0) error(a, e_empty_among);
+                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;
         }
@@ -982,13 +1087,20 @@ static struct node * read_among(struct analyser * a) {
 
 static struct node * read_substring(struct analyser * a) {
     struct node * p = new_node(a, c_substring);
-    if (a->substring != NULL) error2(a, e_substring_preceded_by_substring, a->substring->line_number);
+    if (a->substring != NULL) {
+        substring_without_among_error(a);
+    }
     a->substring = p;
     return p;
 }
 
 static void check_modifyable(struct analyser * a) {
-    if (!a->modifyable) error(a, e_not_allowed_inside_reverse);
+    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) {
@@ -1031,35 +1143,89 @@ static struct node * read_C(struct analyser * a) {
             }
             return p;
         }
-        case c_backwards:
-            {
-                int mode = a->mode;
-                if (a->mode == m_backward) error(a, e_already_backwards); else a->mode = m_backward;
-                {   struct node * p = C_style(a, "C", token);
-                    a->mode = mode;
-                    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");
             }
-        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 = C_style(a, "C", token);
-                    a->mode = mode;
-                    a->modifyable = modifyable;
-                    return p;
+            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;
             }
-        case c_not:
+            struct node * p = new_node(a, token);
+            p->left = subcommand;
+            return p;
+        }
         case c_try:
-        case c_fail:
-        case c_test:
         case c_do:
-        case c_repeat:
-            return C_style(a, "C", token);
+        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);
@@ -1097,59 +1263,88 @@ static struct node * read_C(struct analyser * a) {
             p->left = subcommand;
             return p;
         }
-        case c_loop: {
-            struct node * n = C_style(a, "AC", token);
+        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) {
-                    // `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);
+                    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;
                     }
-                    n->AE = NULL;
-                    n->left = NULL;
-                    n->type = c_true;
                 } else if (n->AE->number == 1) {
-                    // `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);
+                    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;
                     }
-                    n = n->left;
                 }
             }
             return n;
         }
-        case c_atleast: {
-            struct node * n = C_style(a, "AC", token);
-            // 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) {
-                    // `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;
-                }
+        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_setmark: {
-            struct node * n = C_style(a, "i", token);
-            if (n->name) n->name->initialised = true;
+        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_tomark:
-        case c_atmark:
-            return C_style(a, "A", token);
         case c_hop: {
-            struct node * n = C_style(a, "A", token);
+            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) {
@@ -1159,7 +1354,7 @@ static struct node * read_C(struct analyser * a) {
                 } else if (n->AE->number == 0) {
                     if (n->AE->fixed_constant) {
                         fprintf(stderr,
-                                "%s:%d: warning: hop 0 is a no-op\n",
+                                "%s:%d: warning: `hop 0` is a no-op\n",
                                 t->file, n->AE->line_number);
                     }
                     n->AE = NULL;
@@ -1176,23 +1371,42 @@ static struct node * read_C(struct analyser * a) {
             }
             return n;
         }
-        case c_delete:
+        case c_delete: {
             check_modifyable(a);
-            /* fall through */
+            // 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_atlimit:
         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 = C_style(a, "s", token);
-            if (n->name) n->name->initialised = true;
+            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, "
@@ -1203,47 +1417,106 @@ static struct node * read_C(struct analyser * a) {
             return n;
         }
         case c_assign:
+            token = c_stringassign;
+            /* FALLTHRU */
         case c_insert:
         case c_attach:
         case c_slicefrom: {
-            struct node *n;
             check_modifyable(a);
-            n = C_style(a, "S", token);
-            if (n->name) n->name->value_used = true;
-            return n;
-        }
-        case c_setlimit:
-            return C_style(a, "CfD", token);
-        case c_set:
-        case c_unset: {
-            struct node * n = C_style(a, "b", token);
-            if (n->name) n->name->initialised = true;
+            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:
-                        count_error(a);
-                        fprintf(stderr, "%s:%d: Expected relational operator (did you mean '=='?)\n",
-                                t->file, t->line_number);
-                        /* Assume it was == to try to avoid an error avalanche. */
+                        // 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;
-                        /* FALLTHRU */
+                        goto handle_rel_op;
                     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 (lhs->type == c_number && rhs->type == c_number) {
+                        if (eval_constant_expr &&
+                            lhs->type == c_number &&
+                            rhs->type == c_number) {
                             // Evaluate constant numeric test expression.
                             int result;
                             switch (token) {
@@ -1280,125 +1553,205 @@ static struct node * read_C(struct analyser * a) {
                         break;
                     }
                     default:
-                        error(a, e_unexpected_token);
+                        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) {
-                struct node * p;
-                struct name * q = find_name(a);
+            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;
-                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;
-                    a->mode = m_forward;
-                    a->modifyable = true;
-                    p = new_node(a, c_dollar);
-                    p->left = read_C(a);
-                    p->name = q;
-                } else {
-                    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.
-                         */
-                        error(a, e_not_of_type_string_or_integer);
-                        q = NULL;
-                    }
-                    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;
-                            if (q) {
-                                q->value_used = true;
-                            }
-                            p->AE = read_AE(a, NULL, 0);
-                            break;
-                        default:
-                            /* +=, 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->type == c_mathassign && q) {
-                                /* $x = x + 1 doesn't initialise x. */
-                                q->initialised = !ae_uses_name(p->AE, q);
-                            }
-                            break;
-                    }
-                }
-                if (q) mark_used_in(a, q, p);
+                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;
             }
 
-            error(a, e_unexpected_token);
-            hold_token(t);
-            return new_node(a, c_dollar);
-        }
-        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:
-                            error(a, e_misplaced); /* integer name misplaced */
-                            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;
+            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);
+                    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;
                 }
-                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)) { omission_error(a, c_name); return p; }
-                name_to_node(a, p, 'g');
+            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;
             }
-        case c_literalstring:
-            return read_literalstring(a);
+            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: error(a, e_unexpected_token); return NULL;
+        default:
+            unexpected_token_error(a, 0);
+            return NULL;
     }
 }
 
@@ -1416,22 +1769,21 @@ static int next_symbol(symbol * p, symbol * W, int utf8) {
 
 static symbol * alter_grouping(symbol * p, symbol * q, int style, int utf8) {
     int j = 0;
-    symbol W;
-    int width;
     if (style == c_plus) {
         while (j < SIZE(q)) {
-            width = next_symbol(q + j, &W, utf8);
+            symbol W;
+            int width = next_symbol(q + j, &W, utf8);
             p = add_symbol_to_b(p, W);
             j += width;
         }
     } else {
         while (j < SIZE(q)) {
-            int i;
-            width = next_symbol(q + j, &W, utf8);
-            for (i = 0; i < SIZE(p); i++) {
+            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));
-                    SIZE(p)--;
+                    ADD_TO_SIZE(p, -1);
                 }
             }
             j += width;
@@ -1440,70 +1792,120 @@ static symbol * alter_grouping(symbol * p, symbol * q, int style, int utf8) {
     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) {
-                error(a, e_redefined);
-                FREE(q->grouping);
+                report_error_location(a);
+                fprintf(stderr, "'%.*s' redefined\n", SIZE(t->s), t->s);
+                q->grouping->name = NULL;
             }
             q->grouping = p;
         }
-        p->next = NULL;
         p->name = q;
         p->line_number = t->line_number;
         p->b = create_b(0);
-        while (true) {
+        do {
             switch (read_token(t)) {
                 case c_name: {
                     struct name * r = find_name(a);
                     if (!r) break;
 
-                    check_name_type(a, r, 'g');
                     if (r == q) {
                         count_error(a);
-                        r->s[SIZE(r->s)] = 0;
-                        fprintf(stderr, "%s:%d: %s defined in terms of itself\n",
-                                t->file, t->line_number, r->s);
+                        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) {
-                        count_error(a);
-                        r->s[SIZE(r->s)] = 0;
-                        fprintf(stderr, "%s:%d: %s undefined\n",
-                                t->file, t->line_number, r->s);
+                        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:
+                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: error(a, e_unexpected_token); return;
-            }
-            switch (read_token(t)) {
-                case c_plus:
-                case c_minus: style = t->token; break;
-                default: goto label0;
+                }
+                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;
             }
-        }
-    label0:
-        {
-            int i;
-            int max = 0;
-            int min = 1<<16;
-            for (i = 0; i < SIZE(p->b); i++) {
-                if (p->b[i] > max) max = p->b[i];
-                if (p->b[i] < min) min = p->b[i];
+            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");
             }
-            p->largest_ch = max;
-            p->smallest_ch = min;
-            if (min == 1<<16) error(a, e_empty_grouping);
         }
         hold_token(t);
     }
@@ -1511,62 +1913,69 @@ static void read_define_grouping(struct analyser * a, struct name * q) {
 
 static void read_define_routine(struct analyser * a, struct name * q) {
     struct node * p = new_node(a, c_define);
-    a->amongvar_needed = false;
+    a->current_routine = q;
     if (q) {
-        check_name_type(a, q, 'R');
-        if (q->definition != NULL) error(a, e_redefined);
-        if (q->mode == m_unknown) q->mode = a->mode; else
-        if (q->mode != a->mode) error2(a, e_declared_as_different_mode, q->mode);
+        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->left;
-    /* We should get a node with a NULL right pointer from read_C() for the
-     * routine's code.  We synthesise a "functionend" node there so
-     * optimisations such as dead code elimination and tail call optimisation
-     * can easily see where the function ends.
-     */
-    assert(p->left->right == NULL);
-    p->left->right = new_node(a, c_functionend);
+    if (q) q->definition = p;
 
     if (a->substring != NULL) {
-        error2(a, e_unresolved_substring, a->substring->line_number);
+        substring_without_among_error(a);
         a->substring = NULL;
     }
-    p->amongvar_needed = a->amongvar_needed;
+    a->current_routine = NULL;
 }
 
 static void read_define(struct analyser * a) {
-    if (get_token(a, c_name)) {
-        struct name * q = find_name(a);
-        int type;
-        if (q) {
-            type = 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 (!get_token(a, c_name)) return;
 
-        if (type == t_grouping) {
-            read_define_grouping(a, q);
-        } else {
-            read_define_routine(a, q);
+    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) {
@@ -1574,7 +1983,6 @@ static void read_backwardmode(struct analyser * a) {
     a->mode = m_backward;
     if (get_token(a, c_bra)) {
         read_program_(a, c_ket);
-        check_token(a, c_ket);
     }
     a->mode = mode;
 }
@@ -1582,7 +1990,8 @@ static void read_backwardmode(struct analyser * a) {
 static void read_program_(struct analyser * a, int terminator) {
     struct tokeniser * t = a->tokeniser;
     while (true) {
-        switch (read_token(t)) {
+        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;
@@ -1591,13 +2000,13 @@ static void read_program_(struct analyser * a, int terminator) {
             case c_groupings:   read_names(a, t_grouping); break;
             case c_define:      read_define(a); break;
             case c_backwardmode:read_backwardmode(a); break;
-            case c_ket:
-                if (terminator == c_ket) return;
-                /* fall through */
             default:
-                error(a, e_unexpected_token); break;
+                if (token == terminator) return;
+                unexpected_token_error(a, 0);
+                break;
             case -1:
-                if (terminator >= 0) omission_error(a, c_ket);
+                if (terminator != -1)
+                    omission_error(a, terminator);
                 return;
         }
     }
@@ -1608,18 +2017,18 @@ static void remove_dead_assignments(struct node * p, struct name * q) {
         switch (p->type) {
             case c_assignto:
             case c_sliceto:
-            case c_mathassign:
+            case c_assign:
             case c_plusassign:
             case c_minusassign:
             case c_multiplyassign:
             case c_divideassign:
-            case c_setmark:
             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
@@ -1636,119 +2045,1001 @@ static void remove_dead_assignments(struct node * p, struct name * q) {
     if (p->right) remove_dead_assignments(p->right, q);
 }
 
-extern void read_program(struct analyser * a) {
+enum {
+    // Not set on at least one code path leading to a use.
+    USE_BEFORE_SET,
+    // Need to keep checking.
+    UNKNOWN,
+    // Set on any code path leading to a use.
+    SET_BEFORE_ANY_USE
+};
+
+/* 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.
+ * func: the c_define of the routine/external this code is in.
+ * v:    the variable to check.
+ */
+static int always_set_before_use_(struct node * p, struct node * func,
+                                  struct name * v) {
+    assert(p);
+    switch (p->type) {
+        case c_call: {
+            if (p->name->definition == func) {
+                /* We've recursed into the function we're considering
+                 * localising this variable into, which means we can't
+                 * localise it because then changes to the variable in
+                 * the nested call won't be reflected after it returns.
+                 */
+                return USE_BEFORE_SET;
+            }
+            // We know v is only referenced in the function we are checking.
+            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], func, v);
+                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;
+            bool all_pass = true;
+            while (q) {
+                int r = always_set_before_use_(q, func, v);
+                if (r == USE_BEFORE_SET) return r;
+                all_pass = all_pass && (r == SET_BEFORE_ANY_USE);
+                q = q->right;
+            }
+            if (all_pass) return SET_BEFORE_ANY_USE;
+            return UNKNOWN;
+        }
+        case c_and:
+        case c_bra: {
+            struct node * q = p->left;
+            while (q) {
+                int r = always_set_before_use_(q, func, v);
+                if (r != UNKNOWN) return r;
+                q = q->right;
+            }
+            return UNKNOWN;
+        }
+        case c_backwards:
+        case c_not:
+        case c_reverse:
+        case c_test:
+            return always_set_before_use_(p->left, func, v);
+        case c_do:
+        case c_fail:
+        case c_gopast:
+        case c_goto:
+        case c_try:
+        case c_repeat: {
+            if (always_set_before_use_(p->left, func, v) == USE_BEFORE_SET)
+                return USE_BEFORE_SET;
+            return UNKNOWN;
+        }
+        case c_atleast:
+        case c_loop:
+            if (always_set_before_use_(p->AE, func, v) == USE_BEFORE_SET)
+                return USE_BEFORE_SET;
+            return always_set_before_use_(p->left, func, v);
+        case c_assign:
+            // Check AE first: `x = x + 1` uses `x` before it sets it.
+            if (always_set_before_use_(p->AE, func, v) == 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, func, v) == 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, func, v);
+            if (r != UNKNOWN) return r;
+            return always_set_before_use_(p->right, func, v);
+        }
+        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, func, v);
+            if (r != UNKNOWN) return r;
+            return always_set_before_use_(p->AE, func, v);
+        }
+        case c_neg:
+            return always_set_before_use_(p->right, func, v);
+        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, func, v);
+            if (r != UNKNOWN) return r;
+            return always_set_before_use_(p->left, func, v);
+        }
+        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, func, v) == 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 node * func,
+                                 struct name * v) {
+    return always_set_before_use_(p, func, v) != 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;
+    }
+}
+
+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->b[i].function)
+                    visit_routine(a, x->b[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;
+}
+
+extern void read_program(struct analyser * a, unsigned localise_mask) {
     read_program_(a, -1);
-    {
-        struct name * q = a->names;
-        while (q) {
-            switch (q->type) {
-                case t_external: case t_routine:
-                    if (q->used && q->definition == NULL) error4(a, q);
-                    break;
-                case t_grouping:
-                    if (q->used && q->grouping == NULL) error4(a, q);
+    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;
+        // Inline some routines.
+        //
+        // Currently we inline routines which are "simple" and only used once.
+        // Probably we should inline "simple" *OR* only used once, but to do
+        // that we probably need to clone the nodes for routines used more
+        // than once, and we need to handle updating things like
+        // amongvar_needed (which hasn't been set at this point).
+        //
+        // Note: the definition of a routine is counted as a reference to its
+        // name, so a routine only called once has 2 references.
+        if (n->type == t_routine &&
+            n->references == 2 &&
+            n->uses_in_among == 0 &&
+            !n->definition->left->right) {
+            bool inline_routine = false;
+            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 "simple" single-command routines.
+                    inline_routine = true;
                     break;
             }
-            q = q->next;
+
+            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
+                struct node * call_site = n->used;
+                call_site->type = c_bra;
+                call_site->name = NULL;
+                call_site->left = n->definition->left;
+                remove_routine(a, n);
+                *n_ptr = n->next;
+                lose_s(n->s);
+                FREE(n);
+                continue;
+            }
         }
+
+        n_ptr = &(n->next);
     }
 
-    if (a->tokeniser->error_count == 0) {
-        struct name * q = a->names;
-        struct name ** ptr = &(a->names);
-        while (q) {
-            if (!q->referenced) {
-                q->s[SIZE(q->s)] = 0;
-                fprintf(stderr, "%s:%d: warning: %s '%s' ",
-                        a->tokeniser->file,
-                        q->declaration_line_number,
-                        name_of_name_type(q->type),
-                        q->s);
-                if (q->type == t_routine ||
-                    q->type == t_external ||
-                    q->type == t_grouping) {
-                    fprintf(stderr, "declared but not defined\n");
+    // Add "functionend" nodes there so optimisations such as dead code
+    // elimination and tail call optimisation can easily see where the function
+    // ends.
+    for (struct name * name = a->names; name; name = name->next) {
+        if (name->type != t_routine && name->type != t_external) continue;
+
+        struct node * p = name->definition;
+        if (!p) {
+            // No definition - we'll report this later.
+            continue;
+        }
+        assert(p->type == c_define);
+        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 {
-                    fprintf(stderr, "defined but not used\n");
+                    line_num = q->grouping->line_number;
                 }
-                q = q->next;
-                *ptr = q;
+                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;
-            } else 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;
-                    }
-                    q->s[SIZE(q->s)] = 0;
-                    fprintf(stderr, "%s:%d: warning: %s '%s' defined but not used\n",
-                            a->tokeniser->file,
-                            line_num,
-                            name_of_name_type(q->type),
-                            q->s);
-                    q = q->next;
-                    *ptr = q;
-                    continue;
-                }
-            } else if (q->type == t_external) {
-                /* Unused is OK. */
-            } else if (!q->initialised) {
-                q->s[SIZE(q->s)] = 0;
-                fprintf(stderr, "%s:%d: warning: %s '%s' is never initialised\n",
+            }
+        }
+
+        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_name_type(q->type),
-                        q->s);
+                        name_of_type(q->type),
+                        SIZE(q->s), q->s);
             } else if (!q->value_used) {
-                q->s[SIZE(q->s)] = 0;
-                fprintf(stderr, "%s:%d: warning: %s '%s' is set but never used\n",
+                fprintf(stderr, "%s:%d: warning: %s '%.*s' is set but never used\n",
                         a->tokeniser->file,
                         q->declaration_line_number,
-                        name_of_name_type(q->type),
-                        q->s);
+                        name_of_type(q->type),
+                        SIZE(q->s), q->s);
                 remove_dead_assignments(a->program, q);
-                q = q->next;
-                *ptr = q;
+                q->used = NULL;
                 continue;
             }
-            ptr = &(q->next);
-            q = q->next;
         }
 
-        {
-            /* Now we've eliminated variables whose values are never used we
-             * can number the variables, which is used by some generators.
-             */
-            int * name_count = a->name_count;
-            struct name * n;
-            for (n = a->names; n; n = n->next) {
-                n->count = name_count[n->type]++;
+        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 not 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->declaration_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;
+                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->b[j].result - i);
+                    if (diff == 0) {
+                        x->b[j].result = merge_with;
+                        if (merge_with == 0) {
+                            assert(x->b[j].action->type == c_bra);
+                            x->b[j].action->left = NULL;
+                        }
+                    } else if (diff > 0) {
+                        --x->b[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;
+                if (x->in_routine)
+                    x->in_routine->amongvar_needed = true;
             }
+
+            a_ptr = &(x->next);
+        }
+    }
+
+    /* Localise variables.
+     *
+     * We localise variables which are only referenced in a single 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).
+     *
+     * 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 != NULL) {
+            if (localise_mask & (1 << name->type)) {
+                struct node * func = name->local_to->definition;
+                if (!always_set_before_use(func->left, func, 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);
+                    report_s(stderr, name->s);
+                    fprintf(stderr, "\n");
+                    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->nodes = NULL;
-    a->names = NULL;
-    a->literalstrings = NULL;
-    a->program = NULL;
-    a->amongs = NULL;
-    a->among_count = 0;
-    a->among_with_function_count = 0;
-    a->groupings = NULL;
     a->mode = m_forward;
     a->modifyable = true;
-    { int i; for (i = 0; i < t_size; i++) a->name_count[i] = 0; }
-    a->substring = NULL;
-    a->int_limits_used = false;
     return a;
 }