unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: fabrice nicol <fabrnicol@gmail.com>
To: 47408@debbugs.gnu.org
Subject: bug#47408: Etags support for Mercury [v0.4]
Date: Mon, 29 Mar 2021 13:53:26 +0200	[thread overview]
Message-ID: <b59da901-4df7-843f-da03-5aa184d1a992@gmail.com> (raw)
In-Reply-To: <83o8f3meo8.fsf@gnu.org>

[-- Attachment #1: Type: text/plain, Size: 4484 bytes --]

Attached is the new patch that integrates your indications.

Please note two points:

1. Now that -m/-M have been done with, there is no use specifying any 
Mercury-specific behavior for --no-defines.

Actually the Mercury community consensus is that all declarations should 
be tagged in any case.

So --no-defines is just the default behavior of etags run without any 
option and does not need to be used explicitly or specifically documented.

I followed your indications about --declarations. I also added a line to 
etags.1 about --language=mercury or --language=objc, should the 
heuristic test fail to detect the right language. Note, however, that 
removing language-specific options comes at a price. The heuristic test 
has now to be more complex. I had errless detection results against my 
test base of 4,000 mercury files and 500 Obj.-C files. This looks 
satisfactory but I had to tweak the heuristic test function 
(test_objc_is_mercury) quite a bit to weed out detection failures.

I added the ChangeLog, the requested test file (array.m) under 
test/manual/etags/merc-src and altered the corresponding Makefile 
accordingly.

2. I removed by added line to speedbar.el, which in the end did not 
prove very useful. It is located in a Xemacs compatibility layer that is 
no longer used by most users.


Le 28/03/2021 à 18:22, Eli Zaretskii a écrit :
>> From: fabrice nicol <fabrnicol@gmail.com>
>> Date: Sun, 28 Mar 2021 17:49:20 +0200
>>
>> I left this couple of options in (following Francesco Potorti only for long options --declarations/--no-defines),
>> for two reasons:
>>
>> 1. The ambiguity between Objective C and Mercury
>>
>> Both languages having the same file extension .m, it was necessary to add in a heuristic test function, in the
>> absence of explicit language identification input from command line.
>>
>> Yet all heuristics may fail in rare cases. Tests show a fairly low failure rate on the Mercury compiler source
>> code.  Less than 0.5 % of .m files are not identified as Mercury files by the test (this should have been
>> documented somewhere).  File concerned by test failure are some Mercury test files and documentary test
>> files with only (or almost only) comments and blank lines.
>>
>> While this could be improved by tweaking the heuristic test, it would make it more complex, bug-prone and
>> ultimately hard to maintain.
>>
>> So -m/-M are useful to deal with these rare files, as they do not rely on the heuristic test function at all but on
>> their own semantics, which explicitly identifies Mercury.
>>
>> The only alternative I see is to explicitly warn users about adding '-l mercury' to command line when using
>> long options (in etags.1 and possibly other docs).
> I think "-l mercury" is indeed the way to tell etags this is a Mercury
> source.
>
> We never had language-specific options in etags, and I don't see a
> serious enough reason to introduce them now.  I do find it unfortunate
> that Mercury uses the same extension as ObjC, but that's water under
> the bridge.
>
> Of course, if the heuristic test could be improved to make it err
> less, it would also be good.
>
>>   diff --git a/lisp/speedbar.el b/lisp/speedbar.el
>> index 12e57b1108..63f3cd6ca1 100644
>> --- a/lisp/speedbar.el
>> +++ b/lisp/speedbar.el
>> @@ -3534,6 +3534,8 @@ speedbar-fetch-etags-parse-list
>>        speedbar-parse-c-or-c++tag)
>>       ("^\\.emacs$\\|.\\(el\\|l\\|lsp\\)\\'" .
>>        "def[^i]+\\s-+\\(\\(\\w\\|[-_]\\)+\\)\\s-*\C-?")
>> +      ("^\\.m$\\'" .
>> +     "\\(^:-\\)?\\s-*\\(\\(pred\\|func\\|type\\|instance\\|typeclass\\)+\\s+\\([a-z]+[a-zA-Z0-9_]*\\)+\\)\\s-*(?^?")
>>   ;    ("\\.\\([fF]\\|for\\|FOR\\|77\\|90\\)\\'" .
>>   ;      speedbar-parse-fortran77-tag)
>>       ("\\.tex\\'" . speedbar-parse-tex-string)
>>
>>   What about ObjC here? or are these keywords good for ObjC as well?
>>
>> has the following reply: Objective C .m files are not parsed by speedbar.el in current repository code, so the
>> added feature does not break anything.  Issues will only arise if/when Emacs maintainers for Objective C
>> support decide on adding this file format to the speedbar parser.   It would be premature (and out-of-place)
>> for me to settle this on my own.  Should this move happen, the heuristics used in etags.c (function
>> test_objc_is_mercury) could then be ported to elisp code.
> OK, so please add there a comment to say that .m is also Objective C,
> but Speedbar doesn't support it yet.
>
> Thanks.

[-- Attachment #2: 0001-Add-etags-support-for-Mercury-v0.4.patch --]
[-- Type: text/x-patch, Size: 142648 bytes --]

From a0781212917457d3569de941c80364523a422c08 Mon Sep 17 00:00:00 2001
From: Fabrice Nicol <fabrnicol@gmail.com>
Date: Mon, 29 Mar 2021 10:55:27 +0200
Subject: [PATCH] Add etags support for Mercury [v0.4]

---
 doc/man/etags.1                    |   23 +-
 etc/NEWS                           |    7 +
 lib-src/ChangeLog                  |   14 +
 lib-src/etags.c                    |  490 +++-
 test/manual/etags/Makefile         |    3 +-
 test/manual/etags/merc-src/array.m | 3416 ++++++++++++++++++++++++++++
 6 files changed, 3940 insertions(+), 13 deletions(-)
 create mode 100644 lib-src/ChangeLog
 create mode 100644 test/manual/etags/merc-src/array.m

diff --git a/doc/man/etags.1 b/doc/man/etags.1
index c5c15fb182..4a908fc0a0 100644
--- a/doc/man/etags.1
+++ b/doc/man/etags.1
@@ -1,5 +1,5 @@
 .\" See section COPYING for copyright and redistribution information.
-.TH ETAGS 1 "2019-06-24" "GNU Tools" "GNU"
+.TH ETAGS 1 "2021-03-30" "GNU Tools" "GNU"
 .de BP
 .sp
 .ti -.2i
@@ -50,9 +50,9 @@ format understood by
 .BR vi ( 1 )\c
 \&.  Both forms of the program understand
 the syntax of C, Objective C, C++, Java, Fortran, Ada, Cobol, Erlang,
-Forth, Go, HTML, LaTeX, Emacs Lisp/Common Lisp, Lua, Makefile, Pascal, Perl,
-Ruby, PHP, PostScript, Python, Prolog, Scheme and
-most assembler\-like syntaxes.
+Forth, Go, HTML, LaTeX, Emacs Lisp/Common Lisp, Lua, Makefile, Mercury, Pascal,
+Perl, Ruby, PHP, PostScript, Python, Prolog, Scheme and most assembler\-like
+syntaxes.
 Both forms read the files specified on the command line, and write a tag
 table (defaults: \fBTAGS\fP for \fBetags\fP, \fBtags\fP for
 \fBctags\fP) in the current working directory.
@@ -91,6 +91,9 @@ Only \fBctags\fP accepts this option.
 In C and derived languages, create tags for function declarations,
 and create tags for extern variables unless \-\-no\-globals is used.
 In Lisp, create tags for (defvar foo) declarations.
+In Mercury, declarations start a line with "\|\fB:-\fP\|" and are tagged
+by default.  This option also tags predicates or functions in first rules
+of clauses, as in Prolog.
 .TP
 .B \-D, \-\-no\-defines
 Do not create tag entries for C preprocessor constant definitions
@@ -125,10 +128,14 @@ final brace of a function or structure definition in C and C++.
 Parse the following files according to the given language.  More than
 one such options may be intermixed with filenames.  Use \fB\-\-help\fP
 to get a list of the available languages and their default filename
-extensions.  The "auto" language can be used to restore automatic
-detection of language based on the file name.  The "none"
-language may be used to disable language parsing altogether; only
-regexp matching is done in this case (see the \fB\-\-regex\fP option).
+extensions.  For example, as Mercury and Objective-C have same
+filename extension \fI.m\fP, a test based on contents tries to detect
+the language.  If this test fails, \fB\-\-language=\fP\fImercury\fP or
+\fB\-\-language=\fP\fIobjc\fP should be used.
+The "auto" language can be used to restore automatic detection of language
+based on the file name.  The "none" language may be used to disable language
+parsing altogether; only regexp matching is done in this case (see the
+\fB\-\-regex\fP option).
 .TP
 .B \-\-members
 Create tag entries for variables that are members of structure-like
diff --git a/etc/NEWS b/etc/NEWS
index 2d66a93474..8afb7c76b4 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -93,6 +93,13 @@ useful on systems such as FreeBSD which ships only with "etc/termcap".
 \f
 * Changes in Emacs 28.1
 
++++
+** Etags support for the Mercury programming language (https://mercurylang.org).
+** Etags command line option --declarations now has Mercury-specific behavior.
+All Mercury declarations are tagged by default.
+For compatibility with Prolog etags support, predicates and functions appearing
+first in clauses will also be tagged if etags is run with '--declarations'.
+
 +++
 ** New command 'font-lock-update', bound to 'C-x x f'.
 This command updates the syntax highlighting in this buffer.
diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog
new file mode 100644
index 0000000000..3ab71a4dab
--- /dev/null
+++ b/lib-src/ChangeLog
@@ -0,0 +1,14 @@
+Add etags support for Mercury (https://mercurylang.org)
+
+Tag declarations starting lines with ':-'.
+By default, all declarations are tagged.  Optionally, first predicate or
+functions in clauses can be tagged as in Prolog support using --declarations
+(Bug#47408).
+* lib-src/etags.c (test_objc_is_mercury, Mercury_functions)
+(mercury_skip_comment,  mercury_decl, mercury_pr):
+Implement Mercury support. As Mercury and Objective-C have same file extension
+.m,  a heuristic test tries to detect the language.
+If this test fails, --language=mercury should be used.
+* doc/man/etags.1: Document the change. Add Mercury-specific behavior for
+--declarations. This option tags first predicates or functions in clauses in
+addition to declarations.
diff --git a/lib-src/etags.c b/lib-src/etags.c
index b5c18e0e01..a5c5224e63 100644
--- a/lib-src/etags.c
+++ b/lib-src/etags.c
@@ -142,7 +142,14 @@ Copyright (C) 1984, 1987-1989, 1993-1995, 1998-2021 Free Software
 # define CTAGS false
 #endif
 
-/* Copy to DEST from SRC (containing LEN bytes), and append a NUL byte.  */
+/* Define MERCURY_HEURISTICS_RATIO as it was necessary to disambiguate
+   Mercury from Objective C, which have same file extensions .m
+   See comments before function test_objc_is_mercury for details.  */
+#ifndef  MERCURY_HEURISTICS_RATIO
+# define MERCURY_HEURISTICS_RATIO 0.5
+#endif
+
+/* COPY to DEST from SRC (containing LEN bytes), and append a NUL byte.  */
 static void
 memcpyz (void *dest, void const *src, ptrdiff_t len)
 {
@@ -359,6 +366,7 @@ #define xrnew(op, n, m) ((op) = xnrealloc (op, n, (m) * sizeof *(op)))
 static void Lisp_functions (FILE *);
 static void Lua_functions (FILE *);
 static void Makefile_targets (FILE *);
+static void Mercury_functions (FILE *);
 static void Pascal_functions (FILE *);
 static void Perl_functions (FILE *);
 static void PHP_functions (FILE *);
@@ -378,6 +386,7 @@ #define xrnew(op, n, m) ((op) = xnrealloc (op, n, (m) * sizeof *(op)))
 static bool nocase_tail (const char *);
 static void get_tag (char *, char **);
 static void get_lispy_tag (char *);
+static void test_objc_is_mercury(char *, language **);
 
 static void analyze_regex (char *);
 static void free_regexps (void);
@@ -683,10 +692,22 @@ #define STDIN 0x1001		/* returned by getopt_long on --parse-stdin */
 "In makefiles, targets are tags; additionally, variables are tags\n\
 unless you specify '--no-globals'.";
 
+/* Mercury and Objective C share the same .m file extensions.  */
+static const char *Mercury_suffixes [] =
+  {"m",
+   NULL};
+static const char Mercury_help [] =
+  "In Mercury code, tags are all declarations beginning a line with ':-'\n\
+and optionally Prolog-like definitions (first rule for a predicate or \
+function).\n\
+To enable this behavior, run etags using --declarations.";
+static bool with_mercury_definitions = false;
+float mercury_heuristics_ratio = MERCURY_HEURISTICS_RATIO;
+
 static const char *Objc_suffixes [] =
-  { "lm",			/* Objective lex file */
-    "m",			/* Objective C file */
-     NULL };
+  { "lm",			/* Objective lex file  */
+    "m",			/* By default, Objective C file will be assumed.  */
+     NULL};
 static const char Objc_help [] =
 "In Objective C code, tags include Objective C definitions for classes,\n\
 class categories, methods and protocols.  Tags for variables and\n\
@@ -824,7 +845,9 @@ #define STDIN 0x1001		/* returned by getopt_long on --parse-stdin */
   { "lisp",      Lisp_help,      Lisp_functions,    Lisp_suffixes      },
   { "lua",       Lua_help,Lua_functions,Lua_suffixes,NULL,Lua_interpreters},
   { "makefile",  Makefile_help,Makefile_targets,NULL,Makefile_filenames},
+  /* objc listed before mercury as it is a better default for .m extensions.  */
   { "objc",      Objc_help,      plain_C_entries,   Objc_suffixes      },
+  { "mercury",   Mercury_help,   Mercury_functions, Mercury_suffixes   },
   { "pascal",    Pascal_help,    Pascal_functions,  Pascal_suffixes    },
   { "perl",Perl_help,Perl_functions,Perl_suffixes,NULL,Perl_interpreters},
   { "php",       PHP_help,       PHP_functions,     PHP_suffixes       },
@@ -950,6 +973,9 @@ print_help (argument *argbuffer)
     puts
       ("\tand create tags for extern variables unless --no-globals is used.");
 
+  puts ("In Mercury, tag both declarations starting a line with ':-' and first\n\
+        predicates or functions in clauses.");
+
   if (CTAGS)
     puts ("-d, --defines\n\
         Create tag entries for C #define constants and enum constants, too.");
@@ -1775,6 +1801,11 @@ find_entries (FILE *inf)
   if (parser == NULL)
     {
       lang = get_language_from_filename (curfdp->infname, true);
+
+      /* Disambiguate file names between Objc and Mercury */
+      if (lang != NULL && strcmp(lang->name, "objc") == 0)
+	test_objc_is_mercury(curfdp->infname, &lang);
+
       if (lang != NULL && lang->function != NULL)
 	{
 	  curfdp->lang = lang;
@@ -6019,6 +6050,457 @@ prolog_atom (char *s, size_t pos)
     return 0;
 }
 
+\f
+/*
+ * Support for Mercury
+ *
+ * Assumes that the declarationa starts at column 0.
+ * Original code by Sunichirou Sugou (1989) for Prolog.
+ * Rewritten by Anders Lindgren (1996) for Prolog.
+ * Adapted by Fabrice Nicol (2021) for Mercury.
+ * Note: Prolog-support behavior is preserved if
+ * --declarations is used, corresponding to
+ * with_mercury_definitions=true.
+ */
+
+static ptrdiff_t mercury_pr (char *, char *, ptrdiff_t);
+static void mercury_skip_comment (linebuffer *, FILE *);
+static bool is_mercury_type = false;
+static bool is_mercury_quantifier = false;
+static bool is_mercury_declaration = false;
+
+/*
+ * Objective-C and Mercury have identical file extension .m
+ * To disambiguate between Objective C and Mercury, parse file
+ * with the following heuristics hook:
+ *   - if line starts with :- choose Mercury unconditionally,
+ *   - if line starts with #, @, choose Objective-C,
+ *   - otherwise compute the following ratio:
+ *
+ *     r = (number of lines with :-
+ *          or % in non-commented parts or . at trimmed EOL)
+ *         / (number of lines - number of lines starting by any amount
+ *                        of whitespace, optionally followed by comment(s))
+ *
+ * Note: strings are neglected in counts.
+ *
+ * If r > mercury_heuristics_ratio, choose Mercury.
+ * Experimental tests show that a possibly optimal default value for
+ * this floor value is around 0.5. This is the default value for
+ * MERCURY_HEURISTICS_RATIO, defined in the first lines of this file.
+ * The closer r to 0.5, the closer the source code to pure Prolog.
+ * Idiomatic Mercury is scored either with r = 1.0 or higher.
+ * Objective-C is scored with r = 0.0. When this fails, the r-score never
+ * rose above 0.1 in Objective-C tests.
+ */
+
+static void
+test_objc_is_mercury (char *this_file, language **lang)
+{
+  if (this_file == NULL) return;
+  FILE* fp = fopen (this_file, "r");
+  if (fp == NULL)
+    pfatal (this_file);
+
+  bool blank_line = false; /* Line starting with any amount of white space
+			      followed by optional comment(s).  */
+  bool commented_line = false;
+  bool found_dot = false;
+  bool only_space_before = true;
+  bool start_of_line = true;
+  int c;
+  intmax_t lines = 1;
+  intmax_t mercury_dots = 0;
+  intmax_t percentage_signs = 0;
+  intmax_t rule_signs = 0;
+  float ratio = 0;
+
+  while ((c = fgetc (fp)) != EOF)
+    {
+      switch (c)
+	{
+	case '\n':
+	  if (! blank_line) ++lines;
+	  blank_line = true;
+	  commented_line = false;
+	  start_of_line = true;
+	  if (found_dot) ++mercury_dots;
+	  found_dot = false;
+	  only_space_before = true;
+	  break;
+	case '.':
+	  found_dot = ! commented_line;
+	  only_space_before = false;
+	  break;
+	case  '%': /* More frequent in Mercury. May be modulo in Obj.-C.  */
+	  if (! commented_line)
+	    {
+	      ++percentage_signs;
+	      /* Cannot tell if it is a comment or modulo yet for sure.
+                 Yet works for heuristic purposes.  */
+	      commented_line = true;
+	    }
+	  found_dot = false;
+	  start_of_line = false;
+	  only_space_before = false;
+	  break;
+	case  '/':
+	  {
+	    int d = fgetc(fp);
+	    found_dot = false;
+	    only_space_before = false;
+	    if (! commented_line)
+	      {
+		if (d == '*')
+		  commented_line = true;
+		else
+		  /* If d == '/', cannot tell if it is an Obj.-C comment:
+		     may be Mercury integ. division.  */
+		    blank_line = false;
+	      }
+	  }
+	  FALLTHROUGH;
+        case  ' ':
+        case '\t':
+	  start_of_line = false;
+	  break;
+        case ':':
+	  c = fgetc(fp);
+	  if (start_of_line)
+	    {
+	      if (c == '-')
+		{
+		  ratio = 1.0; /* Failsafe, not an operator in Obj.-C.  */
+		  goto out;
+		}
+	      start_of_line = false;
+	    }
+	  else
+	    {
+	      /* p :- q. Frequent in Mercury.
+		 Rare or in quoted exprs in Obj.-C.  */
+	      if (c == '-' && ! commented_line)
+		++rule_signs;
+	    }
+	  blank_line = false;
+	  found_dot = false;
+	  only_space_before = false;
+          break;
+	case '@':
+        case '#':
+	  if (start_of_line || only_space_before)
+	    {
+	      ratio = 0.0;
+	      goto out;
+	    }
+	  FALLTHROUGH;
+	default:
+	  start_of_line = false;
+	  blank_line = false;
+	  found_dot = false;
+	  only_space_before = false;
+	}
+    }
+
+  /* Fallback heuristic test. Not failsafe but errless in pratice.  */
+  ratio = ((float) rule_signs + percentage_signs + mercury_dots) / lines;
+
+ out:
+  if (fclose(fp) == EOF)
+    pfatal(this_file);
+
+  if (ratio > mercury_heuristics_ratio)
+    {
+      /* Change the language from Objective C to Mercury.  */
+      static language lang0 = { "mercury", Mercury_help, Mercury_functions,
+	Mercury_suffixes };
+      *lang = &lang0;
+    }
+}
+
+static void
+Mercury_functions (FILE *inf)
+{
+  char *cp, *last = NULL;
+  ptrdiff_t lastlen = 0, allocated = 0;
+  if (declarations) with_mercury_definitions = true;
+
+  LOOP_ON_INPUT_LINES (inf, lb, cp)
+    {
+      if (cp[0] == '\0')   /* Empty line.  */
+	continue;
+      else if (c_isspace (cp[0]) || cp[0] == '%')
+	/*  A Prolog-type comment or anything other than a declaration.  */
+	continue;
+      else if (cp[0] == '/' && cp[1] == '*')  /* Mercury C-type comment.  */
+        mercury_skip_comment (&lb, inf);
+      else
+	{
+	  is_mercury_declaration = (cp[0] == ':' && cp[1] == '-');
+
+          if (is_mercury_declaration
+	      || with_mercury_definitions)
+	    {
+	      ptrdiff_t len = mercury_pr (cp, last, lastlen);
+	      if (0 < len)
+		{
+		  /* Store the declaration to avoid generating duplicate
+		     tags later.  */
+		  if (allocated <= len)
+		    {
+		      xrnew (last, len + 1, 1);
+		      allocated = len + 1;
+		    }
+		  memcpyz (last, cp, len);
+		  lastlen = len;
+		}
+	    }
+	}
+    }
+  free (last);
+}
+
+static void
+mercury_skip_comment (linebuffer *plb, FILE *inf)
+{
+  char *cp;
+
+  do
+    {
+      for (cp = plb->buffer; *cp != '\0'; ++cp)
+	if (cp[0] == '*' && cp[1] == '/')
+	  return;
+      readline (plb, inf);
+    }
+  while (perhaps_more_input (inf));
+}
+
+/*
+ * A declaration is added if it matches:
+ *     <beginning of line>:-<whitespace><Mercury Term><whitespace>(
+ * If with_mercury_definitions == true, we also add:
+ *     <beginning of line><Mercury item><whitespace>(
+ * or  <beginning of line><Mercury item><whitespace>:-
+ * As for Prolog support, different arities and types are not taken into
+ * consideration.
+ * Item is added to the tags database if it doesn't match the
+ * name of the previous declaration.
+ *
+ * Consume a Mercury declaration.
+ * Return the number of bytes consumed, or 0 if there was an error.
+ *
+ * A Mercury declaration must be one of:
+ *  :- type
+ *  :- solver type
+ *  :- pred
+ *  :- func
+ *  :- inst
+ *  :- mode
+ *  :- typeclass
+ *  :- instance
+ *  :- pragma
+ *  :- promise
+ *  :- initialise
+ *  :- finalise
+ *  :- mutable
+ *  :- module
+ *  :- interface
+ *  :- implementation
+ *  :- import_module
+ *  :- use_module
+ *  :- include_module
+ *  :- end_module
+ * followed on the same line by an alphanumeric sequence, starting with a lower
+ * case letter or by a single-quoted arbitrary string.
+ * Single quotes can escape themselves.  Backslash quotes everything.
+ *
+ * Return the size of the name of the declaration or 0 if no header was found.
+ * As quantifiers may precede functions or predicates, we must list them too.
+ */
+
+static const char *Mercury_decl_tags[] = {"type", "solver type", "pred",
+  "func", "inst", "mode", "typeclass", "instance", "pragma", "promise",
+  "initialise", "finalise", "mutable", "module", "interface", "implementation",
+  "import_module", "use_module", "include_module", "end_module", "some", "all"};
+
+static size_t
+mercury_decl (char *s, size_t pos)
+{
+  if (s == NULL) return 0;
+
+  size_t origpos;
+  origpos = pos;
+
+  while (s + pos != NULL && (c_isalnum (s[pos]) || s[pos] == '_')) ++pos;
+
+  unsigned char decl_type_length = pos - origpos;
+  char buf[decl_type_length + 1];
+  memset (buf, 0, decl_type_length + 1);
+
+  /* Mercury declaration tags.  Consume them, then check the declaration item
+     following :- is legitimate, then go on as in the prolog case.  */
+
+  memcpy (buf, &s[origpos], decl_type_length);
+
+  bool found_decl_tag = false;
+
+  if (is_mercury_quantifier)
+    {
+      if (strcmp (buf, "pred") != 0 && strcmp (buf, "func") != 0) /* Bad syntax.  */
+	return 0;
+      is_mercury_quantifier = false; /* Beset to base value.  */
+      found_decl_tag = true;
+    }
+  else
+    {
+      for (int j = 0; j < sizeof (Mercury_decl_tags) / sizeof (char*); ++j)
+	{
+	  if (strcmp (buf, Mercury_decl_tags[j]) == 0)
+	    {
+	      found_decl_tag = true;
+	      if (strcmp (buf, "type") == 0)
+		is_mercury_type = true;
+
+	      if (strcmp (buf, "some") == 0
+		  || strcmp (buf, "all") == 0)
+		{
+		  is_mercury_quantifier = true;
+		}
+
+	      break;  /* Found declaration tag of rank j. */
+	    }
+	  else
+	    /* 'solver type' has a blank in the middle,
+	       so this is the hard case.  */
+	    if (strcmp (buf, "solver") == 0)
+	      {
+		++pos;
+		while (s + pos != NULL && (c_isalnum (s[pos]) || s[pos] == '_'))
+		  ++pos;
+
+		decl_type_length = pos - origpos;
+		char buf2[decl_type_length + 1];
+		memset (buf2, 0, decl_type_length + 1);
+		memcpy (buf2, &s[origpos], decl_type_length);
+
+		if (strcmp (buf2, "solver type") == 0)
+		  {
+		    found_decl_tag = false;
+		    break;  /* Found declaration tag of rank j.  */
+		  }
+	      }
+	}
+    }
+
+  /* If with_mercury_definitions == false
+   * this is a Mercury syntax error, ignoring... */
+
+  if (with_mercury_definitions)
+    {
+      if (found_decl_tag)
+	pos = skip_spaces (s + pos) - s; /* Skip len blanks again.  */
+      else
+	/* Prolog-like behavior
+	 * we have parsed the predicate once, yet inappropriately
+	 * so restarting again the parsing step.  */
+	pos = 0;
+    }
+  else
+    {
+      if (found_decl_tag)
+	pos = skip_spaces (s + pos) - s; /* Skip len blanks again.  */
+      else
+	return 0;
+    }
+
+  /* From now on it is the same as for Prolog except for module dots.  */
+
+  if (c_islower (s[pos]) || s[pos] == '_' )
+    {
+      /* The name is unquoted.
+         Do not confuse module dots with end-of-declaration dots.  */
+
+      while (c_isalnum (s[pos])
+             || s[pos] == '_'
+             || (s[pos] == '.' /* A module dot.  */
+                 && s + pos + 1 != NULL
+                 && (c_isalnum (s[pos + 1]) || s[pos + 1] == '_')))
+	++pos;
+
+      return pos - origpos;
+    }
+  else if (s[pos] == '\'')
+    {
+      ++pos;
+      for (;;)
+	{
+	  if (s[pos] == '\'')
+	    {
+	      ++pos;
+	      if (s[pos] != '\'')
+		break;
+	      ++pos; /* A double quote.  */
+	    }
+	  else if (s[pos] == '\0')  /* Multiline quoted atoms are ignored.  */
+	    return 0;
+	  else if (s[pos] == '\\')
+	    {
+	      if (s[pos+1] == '\0')
+		return 0;
+	      pos += 2;
+	    }
+	  else
+	    ++pos;
+	}
+      return pos - origpos;
+    }
+  else if (is_mercury_quantifier && s[pos] == '[')   /* :- some [T] pred/func.  */
+    {
+      for (++pos; s + pos != NULL && s[pos] != ']'; ++pos) {}
+      if (s + pos == NULL) return 0;
+      ++pos;
+      pos = skip_spaces (s + pos) - s;
+      return mercury_decl (s, pos) + pos - origpos;
+    }
+  else
+    return 0;
+}
+
+static ptrdiff_t
+mercury_pr (char *s, char *last, ptrdiff_t lastlen)
+{
+  size_t len0 = 0;
+  is_mercury_type = false;
+  is_mercury_quantifier = false;
+
+  if (is_mercury_declaration)
+    {
+      /* Skip len0 blanks only for declarations.  */
+      len0 = skip_spaces (s + 2) - s;
+    }
+
+  size_t len = mercury_decl (s , len0);
+  if (len == 0) return 0;
+  len += len0;
+
+  if (( (s[len] == '.'  /* This is a statement dot, not a module dot.  */
+	 || (s[len] == '(' && (len += 1))
+         || (s[len] == ':'  /* Stopping in case of a rule.  */
+	     && s[len + 1] == '-'
+	     && (len += 2)))
+	&& (lastlen != len || memcmp (s, last, len) != 0)
+	)
+      /* Types are often declared on several lines so keeping just
+	 the first line.  */
+      || is_mercury_type)
+    {
+      make_tag (s, 0, true, s, len, lineno, linecharno);
+      return len;
+    }
+
+  return 0;
+}
+
 \f
 /*
  * Support for Erlang
diff --git a/test/manual/etags/Makefile b/test/manual/etags/Makefile
index c1df703905..eae6918256 100644
--- a/test/manual/etags/Makefile
+++ b/test/manual/etags/Makefile
@@ -28,10 +28,11 @@ RBSRC=
 SCMSRC=$(addprefix ./scm-src/,test.scm)
 TEXSRC=$(addprefix ./tex-src/,testenv.tex gzip.texi texinfo.tex nonewline.tex)
 YSRC=$(addprefix ./y-src/,parse.y parse.c atest.y cccp.c cccp.y)
+MERCSRC=$(addprefix ./merc-src/,array.m)
 SRCS=${ADASRC} ${ASRC} ${CSRC} ${CPSRC} ${ELSRC} ${ERLSRC} ${FSRC}\
      ${FORTHSRC} ${GOSRC} ${HTMLSRC} ${JAVASRC} ${LUASRC} ${MAKESRC}\
      ${OBJCSRC} ${OBJCPPSRC} ${PASSRC} ${PHPSRC} ${PERLSRC} ${PSSRC}\
-     ${PROLSRC} ${PYTSRC} ${RBSRC} ${SCMSRC} ${TEXSRC} ${YSRC}
+     ${PROLSRC} ${PYTSRC} ${RBSRC} ${SCMSRC} ${TEXSRC} ${YSRC} ${MERCSRC}
 NONSRCS=./f-src/entry.strange ./erl-src/lists.erl ./cp-src/clheir.hpp.gz
 
 ETAGS_PROG=../../../lib-src/etags
diff --git a/test/manual/etags/merc-src/array.m b/test/manual/etags/merc-src/array.m
new file mode 100644
index 0000000000..0663c41087
--- /dev/null
+++ b/test/manual/etags/merc-src/array.m
@@ -0,0 +1,3416 @@
+%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
+% Copyright (C) 1993-1995, 1997-2012 The University of Melbourne.
+% Copyright (C) 2013-2018 The Mercury team.
+% This file is distributed under the terms specified in COPYING.LIB.
+%---------------------------------------------------------------------------%
+%
+% File: array.m.
+% Main authors: fjh, bromage.
+% Stability: medium-low.
+%
+% This module provides dynamically-sized one-dimensional arrays.
+% Array indices start at zero.
+%
+% WARNING!
+%
+% Arrays are currently not unique objects. until this situation is resolved,
+% it is up to the programmer to ensure that arrays are used in ways that
+% preserve correctness. In the absence of mode reordering, one should therefore
+% assume that evaluation will take place in left-to-right order. For example,
+% the following code will probably not work as expected (f is a function,
+% A an array, I an index, and X an appropriate value):
+%
+%       Y = f(A ^ elem(I) := X, A ^ elem(I))
+%
+% The compiler is likely to compile this as
+%
+%       V0 = A ^ elem(I) := X,
+%       V1 = A ^ elem(I),
+%       Y  = f(V0, V1)
+%
+% and will be unaware that the first line should be ordered *after* the second.
+% The safest thing to do is write things out by hand in the form
+%
+%       A0I = A0 ^ elem(I),
+%       A1  = A0 ^ elem(I) := X,
+%       Y   = f(A1, A0I)
+%
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- module array.
+:- interface.
+
+:- import_module list.
+:- import_module pretty_printer.
+:- import_module random.
+
+:- type array(T).
+
+:- inst array(I) == ground.
+:- inst array == array(ground).
+
+    % XXX the current Mercury compiler doesn't support `ui' modes,
+    % so to work-around that problem, we currently don't use
+    % unique modes in this module.
+
+% :- inst uniq_array(I) == unique.
+% :- inst uniq_array == uniq_array(unique).
+:- inst uniq_array(I) == array(I).          % XXX work-around
+:- inst uniq_array == uniq_array(ground).   % XXX work-around
+
+:- mode array_di == di(uniq_array).
+:- mode array_uo == out(uniq_array).
+:- mode array_ui == in(uniq_array).
+
+% :- inst mostly_uniq_array(I) == mostly_unique).
+% :- inst mostly_uniq_array == mostly_uniq_array(mostly_unique).
+:- inst mostly_uniq_array(I) == array(I).    % XXX work-around
+:- inst mostly_uniq_array == mostly_uniq_array(ground). % XXX work-around
+
+:- mode array_mdi == mdi(mostly_uniq_array).
+:- mode array_muo == out(mostly_uniq_array).
+:- mode array_mui == in(mostly_uniq_array).
+
+    % An `index_out_of_bounds' is the exception thrown
+    % on out-of-bounds array accesses. The string describes
+    % the predicate or function reporting the error.
+:- type index_out_of_bounds
+    --->    index_out_of_bounds(string).
+
+%---------------------------------------------------------------------------%
+
+    % make_empty_array(Array) creates an array of size zero
+    % starting at lower bound 0.
+    %
+:- pred make_empty_array(array(T)::array_uo) is det.
+
+:- func make_empty_array = (array(T)::array_uo) is det.
+
+    % init(Size, Init, Array) creates an array with bounds from 0
+    % to Size-1, with each element initialized to Init.  Throws an
+    % exception if Size < 0.
+    %
+:- pred init(int, T, array(T)).
+:- mode init(in, in, array_uo) is det.
+
+:- func init(int, T) = array(T).
+:- mode init(in, in) = array_uo is det.
+
+    % array/1 is a function that constructs an array from a list.
+    % (It does the same thing as the predicate from_list/2.)
+    % The syntax `array([...])' is used to represent arrays
+    % for io.read, io.write, term_to_type, and type_to_term.
+    %
+:- func array(list(T)) = array(T).
+:- mode array(in) = array_uo is det.
+
+    % generate(Size, Generate) = Array:
+    % Create an array with bounds from 0 to Size - 1 using the function
+    % Generate to set the initial value of each element of the array.
+    % The initial value of the element at index K will be the result of
+    % calling the function Generate(K). Throws an exception if Size < 0.
+    %
+:- func generate(int::in, (func(int) = T)::in) = (array(T)::array_uo)
+    is det.
+
+    % generate_foldl(Size, Generate, Array, !Acc):
+    % As above, but using a predicate with an accumulator threaded through it
+    % to generate the initial value of each element.
+    %
+:- pred generate_foldl(int, pred(int, T, A, A), array(T), A, A).
+:- mode generate_foldl(in, in(pred(in, out, in, out) is det),
+    array_uo, in, out) is det.
+:- mode generate_foldl(in, in(pred(in, out, mdi, muo) is det),
+    array_uo, mdi, muo) is det.
+:- mode generate_foldl(in, in(pred(in, out, di, uo) is det),
+    array_uo, di, uo) is det.
+:- mode generate_foldl(in, in(pred(in, out, in, out) is semidet),
+    array_uo, in, out) is semidet.
+:- mode generate_foldl(in, in(pred(in, out, mdi, muo) is semidet),
+    array_uo, mdi, muo) is semidet.
+:- mode generate_foldl(in, in(pred(in, out, di, uo) is semidet),
+    array_uo, di, uo) is semidet.
+
+%---------------------------------------------------------------------------%
+
+    % min returns the lower bound of the array.
+    % Note: in this implementation, the lower bound is always zero.
+    %
+:- pred min(array(_T), int).
+%:- mode min(array_ui, out) is det.
+:- mode min(in, out) is det.
+
+:- func min(array(_T)) = int.
+%:- mode min(array_ui) = out is det.
+:- mode min(in) = out is det.
+
+    % det_least_index returns the lower bound of the array.
+    % Throws an exception if the array is empty.
+    %
+:- func det_least_index(array(T)) = int.
+%:- mode det_least_index(array_ui) = out is det.
+:- mode det_least_index(in) = out is det.
+
+    % semidet_least_index returns the lower bound of the array,
+    % or fails if the array is empty.
+    %
+:- func semidet_least_index(array(T)) = int.
+%:- mode semidet_least_index(array_ui) = out is semidet.
+:- mode semidet_least_index(in) = out is semidet.
+
+    % max returns the upper bound of the array.
+    % Returns lower bound - 1 for an empty array
+    % (always -1 in this implementation).
+    %
+:- pred max(array(_T), int).
+%:- mode max(array_ui, out) is det.
+:- mode max(in, out) is det.
+
+:- func max(array(_T)) = int.
+%:- mode max(array_ui) = out is det.
+:- mode max(in) = out is det.
+
+    % det_greatest_index returns the upper bound of the array.
+    % Throws an exception if the array is empty.
+    %
+:- func det_greatest_index(array(T)) = int.
+%:- mode det_greatest_index(array_ui) = out is det.
+:- mode det_greatest_index(in) = out is det.
+
+    % semidet_greatest_index returns the upper bound of the array,
+    % or fails if the array is empty.
+    %
+:- func semidet_greatest_index(array(T)) = int.
+%:- mode semidet_greatest_index(array_ui) = out is semidet.
+:- mode semidet_greatest_index(in) = out is semidet.
+
+    % size returns the length of the array,
+    % i.e. upper bound - lower bound + 1.
+    %
+:- pred size(array(_T), int).
+%:- mode size(array_ui, out) is det.
+:- mode size(in, out) is det.
+
+:- func size(array(_T)) = int.
+%:- mode size(array_ui) = out is det.
+:- mode size(in) = out is det.
+
+    % bounds(Array, Min, Max) returns the lower and upper bounds of an array.
+    % The upper bound will be lower bound - 1 for an empty array.
+    % Note: in this implementation, the lower bound is always zero.
+    %
+:- pred bounds(array(_T), int, int).
+%:- mode bounds(array_ui, out, out) is det.
+:- mode bounds(in, out, out) is det.
+
+    % in_bounds checks whether an index is in the bounds of an array.
+    %
+:- pred in_bounds(array(_T), int).
+%:- mode in_bounds(array_ui, in) is semidet.
+:- mode in_bounds(in, in) is semidet.
+
+    % is_empty(Array):
+    % True iff Array is an array of size zero.
+    %
+:- pred is_empty(array(_T)).
+%:- mode is_empty(array_ui) is semidet.
+:- mode is_empty(in) is semidet.
+
+%---------------------------------------------------------------------------%
+
+    % lookup returns the N'th element of an array.
+    % Throws an exception if the index is out of bounds.
+    %
+:- pred lookup(array(T), int, T).
+%:- mode lookup(array_ui, in, out) is det.
+:- mode lookup(in, in, out) is det.
+
+:- func lookup(array(T), int) = T.
+%:- mode lookup(array_ui, in) = out is det.
+:- mode lookup(in, in) = out is det.
+
+    % semidet_lookup returns the N'th element of an array.
+    % It fails if the index is out of bounds.
+    %
+:- pred semidet_lookup(array(T), int, T).
+%:- mode semidet_lookup(array_ui, in, out) is semidet.
+:- mode semidet_lookup(in, in, out) is semidet.
+
+    % unsafe_lookup returns the N'th element of an array.
+    % It is an error if the index is out of bounds.
+    %
+:- pred unsafe_lookup(array(T), int, T).
+%:- mode unsafe_lookup(array_ui, in, out) is det.
+:- mode unsafe_lookup(in, in, out) is det.
+
+    % set sets the N'th element of an array, and returns the
+    % resulting array (good opportunity for destructive update ;-).
+    % Throws an exception if the index is out of bounds.
+    %
+:- pred set(int, T, array(T), array(T)).
+:- mode set(in, in, array_di, array_uo) is det.
+
+:- func set(array(T), int, T) = array(T).
+:- mode set(array_di, in, in) = array_uo is det.
+
+    % semidet_set sets the nth element of an array, and returns
+    % the resulting array. It fails if the index is out of bounds.
+    %
+:- pred semidet_set(int, T, array(T), array(T)).
+:- mode semidet_set(in, in, array_di, array_uo) is semidet.
+
+    % unsafe_set sets the nth element of an array, and returns the
+    % resulting array. It is an error if the index is out of bounds.
+    %
+:- pred unsafe_set(int, T, array(T), array(T)).
+:- mode unsafe_set(in, in, array_di, array_uo) is det.
+
+    % slow_set sets the nth element of an array, and returns the
+    % resulting array. The initial array is not required to be unique,
+    % so the implementation may not be able to use destructive update.
+    % It is an error if the index is out of bounds.
+    %
+:- pred slow_set(int, T, array(T), array(T)).
+%:- mode slow_set(in, in, array_ui, array_uo) is det.
+:- mode slow_set(in, in, in, array_uo) is det.
+
+:- func slow_set(array(T), int, T) = array(T).
+%:- mode slow_set(array_ui, in, in) = array_uo is det.
+:- mode slow_set(in, in, in) = array_uo is det.
+
+    % semidet_slow_set sets the nth element of an array, and returns
+    % the resulting array. The initial array is not required to be unique,
+    % so the implementation may not be able to use destructive update.
+    % It fails if the index is out of bounds.
+    %
+:- pred semidet_slow_set(int, T, array(T), array(T)).
+%:- mode semidet_slow_set(in, in, array_ui, array_uo) is semidet.
+:- mode semidet_slow_set(in, in, in, array_uo) is semidet.
+
+    % Field selection for arrays.
+    % Array ^ elem(Index) = lookup(Array, Index).
+    %
+:- func elem(int, array(T)) = T.
+%:- mode elem(in, array_ui) = out is det.
+:- mode elem(in, in) = out is det.
+
+    % As above, but omit the bounds check.
+    %
+:- func unsafe_elem(int, array(T)) = T.
+%:- mode unsafe_elem(in, array_ui) = out is det.
+:- mode unsafe_elem(in, in) = out is det.
+
+    % Field update for arrays.
+    % (Array ^ elem(Index) := Value) = set(Array, Index, Value).
+    %
+:- func 'elem :='(int, array(T), T) = array(T).
+:- mode 'elem :='(in, array_di, in) = array_uo is det.
+
+    % As above, but omit the bounds check.
+    %
+:- func 'unsafe_elem :='(int, array(T), T) = array(T).
+:- mode 'unsafe_elem :='(in, array_di, in) = array_uo is det.
+
+    % swap(I, J, !Array):
+    % Swap the item in the I'th position with the item in the J'th position.
+    % Throws an exception if either of I or J is out-of-bounds.
+    %
+:- pred swap(int, int, array(T), array(T)).
+:- mode swap(in, in, array_di, array_uo) is det.
+
+    % As above, but omit the bounds checks.
+    %
+:- pred unsafe_swap(int, int, array(T), array(T)).
+:- mode unsafe_swap(in, in, array_di, array_uo) is det.
+
+    % Returns every element of the array, one by one.
+    %
+:- pred member(array(T)::in, T::out) is nondet.
+
+%---------------------------------------------------------------------------%
+
+    % copy(Array0, Array):
+    % Makes a new unique copy of an array.
+    %
+:- pred copy(array(T), array(T)).
+%:- mode copy(array_ui, array_uo) is det.
+:- mode copy(in, array_uo) is det.
+
+:- func copy(array(T)) = array(T).
+%:- mode copy(array_ui) = array_uo is det.
+:- mode copy(in) = array_uo is det.
+
+    % resize(Size, Init, Array0, Array):
+    % The array is expanded or shrunk to make it fit the new size `Size'.
+    % Any new entries are filled with `Init'. Throws an exception if
+    % `Size' < 0.
+    %
+:- pred resize(int, T, array(T), array(T)).
+:- mode resize(in, in, array_di, array_uo) is det.
+
+    % resize(Array0, Size, Init) = Array:
+    % The array is expanded or shrunk to make it fit the new size `Size'.
+    % Any new entries are filled with `Init'. Throws an exception if
+    % `Size' < 0.
+    %
+:- func resize(array(T), int, T) = array(T).
+:- mode resize(array_di, in, in) = array_uo is det.
+
+    % shrink(Size, Array0, Array):
+    % The array is shrunk to make it fit the new size `Size'.
+    % Throws an exception if `Size' is larger than the size of `Array0' or
+    % if `Size' < 0.
+    %
+:- pred shrink(int, array(T), array(T)).
+:- mode shrink(in, array_di, array_uo) is det.
+
+    % shrink(Array0, Size) = Array:
+    % The array is shrunk to make it fit the new size `Size'.
+    % Throws an exception if `Size' is larger than the size of `Array0' or
+    % if `Size' < 0.
+    %
+:- func shrink(array(T), int) = array(T).
+:- mode shrink(array_di, in) = array_uo is det.
+
+    % fill(Item, Array0, Array):
+    % Sets every element of the array to `Elem'.
+    %
+:- pred fill(T::in, array(T)::array_di, array(T)::array_uo) is det.
+
+    % fill_range(Item, Lo, Hi, !Array):
+    % Sets every element of the array with index in the range Lo..Hi
+    % (inclusive) to Item. Throws a software_error/1 exception if Lo > Hi.
+    % Throws an index_out_of_bounds/0 exception if Lo or Hi is out of bounds.
+    %
+:- pred fill_range(T::in, int::in, int::in,
+     array(T)::array_di, array(T)::array_uo) is det.
+
+    % from_list takes a list, and returns an array containing those
+    % elements in the same order that they occurred in the list.
+    %
+:- func from_list(list(T)::in) = (array(T)::array_uo) is det.
+:- pred from_list(list(T)::in, array(T)::array_uo) is det.
+
+    % from_reverse_list takes a list, and returns an array containing
+    % those elements in the reverse order that they occurred in the list.
+    %
+:- func from_reverse_list(list(T)::in) = (array(T)::array_uo) is det.
+
+    % to_list takes an array and returns a list containing the elements
+    % of the array in the same order that they occurred in the array.
+    %
+:- pred to_list(array(T), list(T)).
+%:- mode to_list(array_ui, out) is det.
+:- mode to_list(in, out) is det.
+
+:- func to_list(array(T)) = list(T).
+%:- mode to_list(array_ui) = out is det.
+:- mode to_list(in) = out is det.
+
+    % fetch_items(Array, Lo, Hi, List):
+    % Returns a list containing the items in the array with index in the range
+    % Lo..Hi (both inclusive) in the same order that they occurred in the
+    % array. Returns an empty list if Hi < Lo. Throws an index_out_of_bounds/0
+    % exception if either Lo or Hi is out of bounds, *and* Hi >= Lo.
+    %
+    % If Hi < Lo, we do not generate an exception even if either or both
+    % are out of bounds, for two reasons. First, there is no need; if Hi < Lo,
+    % we can return the empty list without accessing any element of the array.
+    % Second, without this rule, some programming techniques for accessing
+    % consecutive contiguous regions of an array would require explicit
+    % bound checks in the *caller* of fetch_items, which would duplicate
+    % the checks inside fetch_items itself.
+    %
+:- pred fetch_items(array(T), int, int, list(T)).
+:- mode fetch_items(in, in, in, out) is det.
+
+:- func fetch_items(array(T), int, int) = list(T).
+%:- mode fetch_items(array_ui, in, in) = out is det.
+:- mode fetch_items(in, in, in) = out is det.
+
+    % binary_search(A, X, I) does a binary search for the element X
+    % in the array A. If there is an element with that value in the array,
+    % it returns its index I; otherwise, it fails.
+    %
+    % The array A must be sorted into ascending order with respect to the
+    % the builtin Mercury order on terms for binary_search/3, and with respect
+    % to supplied comparison predicate for binary_search/4.
+    %
+    % The array may contain duplicates. If it does, and a search looks for
+    % a duplicated value, the search will return the index of one of the
+    % copies, but it is not specified *which* copy's index it will return.
+    %
+:- pred binary_search(array(T)::array_ui,
+    T::in, int::out) is semidet.
+:- pred binary_search(comparison_func(T)::in, array(T)::array_ui,
+    T::in, int::out) is semidet.
+
+    % approx_binary_search(A, X, I) does a binary search for the element X
+    % in the array A. If there is an element with that value in the array,
+    % it returns its index I. If there is no element with that value in the
+    % array, it returns an index whose slot contains the highest value in the
+    % array that is less than X, as measured by the builtin Mercury order
+    % on terms for approx_binary_search/3, and as measured by the supplied
+    % ordering for approx_binary_search/4. It will fail only if there is
+    % no value smaller than X in the array.
+    %
+    % The array A must be sorted into ascending order with respect to the
+    % the builtin Mercury order on terms for approx_binary_search/3, and
+    % with respect to supplied comparison predicate for approx_binary_search/4.
+    %
+    % The array may contain duplicates. If it does, and if either the
+    % searched-for value or (if that does not exist) the highest value
+    % smaller than the searched-for value is duplicated, the search will return
+    % the index of one of the copies, but it is not specified *which* copy's
+    % index it will return.
+    %
+:- pred approx_binary_search(array(T)::array_ui,
+    T::in, int::out) is semidet.
+:- pred approx_binary_search(comparison_func(T)::in, array(T)::array_ui,
+    T::in, int::out) is semidet.
+
+    % map(Closure, OldArray, NewArray) applies `Closure' to
+    % each of the elements of `OldArray' to create `NewArray'.
+    %
+:- pred map(pred(T1, T2), array(T1), array(T2)).
+%:- mode map(pred(in, out) is det, array_ui, array_uo) is det.
+:- mode map(pred(in, out) is det, in, array_uo) is det.
+
+:- func map(func(T1) = T2, array(T1)) = array(T2).
+%:- mode map(func(in) = out is det, array_ui) = array_uo is det.
+:- mode map(func(in) = out is det, in) = array_uo is det.
+
+:- func array_compare(array(T), array(T)) = comparison_result.
+:- mode array_compare(in, in) = uo is det.
+
+    % sort(Array) returns a version of Array sorted into ascending
+    % order.
+    %
+    % This sort is not stable. That is, elements that compare/3 decides are
+    % equal will appear together in the sorted array, but not necessarily
+    % in the same order in which they occurred in the input array. This is
+    % primarily only an issue with types with user-defined equivalence for
+    % which `equivalent' objects are otherwise distinguishable.
+    %
+:- func sort(array(T)) = array(T).
+:- mode sort(array_di) = array_uo is det.
+
+    % array.sort was previously buggy. This symbol provides a way to ensure
+    % that you are using the fixed version.
+    %
+:- pred array.sort_fix_2014 is det.
+
+    % foldl(Fn, Array, X) is equivalent to
+    %   list.foldl(Fn, to_list(Array), X)
+    % but more efficient.
+    %
+:- func foldl(func(T1, T2) = T2, array(T1), T2) = T2.
+%:- mode foldl(func(in, in) = out is det, array_ui, in) = out is det.
+:- mode foldl(func(in, in) = out is det, in, in) = out is det.
+%:- mode foldl(func(in, di) = uo is det, array_ui, di) = uo is det.
+:- mode foldl(func(in, di) = uo is det, in, di) = uo is det.
+
+    % foldl(Pr, Array, !X) is equivalent to
+    %   list.foldl(Pr, to_list(Array), !X)
+    % but more efficient.
+    %
+:- pred foldl(pred(T1, T2, T2), array(T1), T2, T2).
+:- mode foldl(pred(in, in, out) is det, in, in, out) is det.
+:- mode foldl(pred(in, mdi, muo) is det, in, mdi, muo) is det.
+:- mode foldl(pred(in, di, uo) is det, in, di, uo) is det.
+:- mode foldl(pred(in, in, out) is semidet, in, in, out) is semidet.
+:- mode foldl(pred(in, mdi, muo) is semidet, in, mdi, muo) is semidet.
+:- mode foldl(pred(in, di, uo) is semidet, in, di, uo) is semidet.
+
+    % foldl2(Pr, Array, !X, !Y) is equivalent to
+    %   list.foldl2(Pr, to_list(Array), !X, !Y)
+    % but more efficient.
+    %
+:- pred foldl2(pred(T1, T2, T2, T3, T3), array(T1), T2, T2, T3, T3).
+:- mode foldl2(pred(in, in, out, in, out) is det, in, in, out, in, out)
+    is det.
+:- mode foldl2(pred(in, in, out, mdi, muo) is det, in, in, out, mdi, muo)
+    is det.
+:- mode foldl2(pred(in, in, out, di, uo) is det, in, in, out, di, uo)
+    is det.
+:- mode foldl2(pred(in, in, out, in, out) is semidet, in,
+    in, out, in, out) is semidet.
+:- mode foldl2(pred(in, in, out, mdi, muo) is semidet, in,
+    in, out, mdi, muo) is semidet.
+:- mode foldl2(pred(in, in, out, di, uo) is semidet, in,
+    in, out, di, uo) is semidet.
+
+    % As above, but with three accumulators.
+    %
+:- pred foldl3(pred(T1, T2, T2, T3, T3, T4, T4), array(T1),
+    T2, T2, T3, T3, T4, T4).
+:- mode foldl3(pred(in, in, out, in, out, in, out) is det,
+    in, in, out, in, out, in, out) is det.
+:- mode foldl3(pred(in, in, out, in, out, mdi, muo) is det,
+    in, in, out, in, out, mdi, muo) is det.
+:- mode foldl3(pred(in, in, out, in, out, di, uo) is det,
+    in, in, out, in, out, di, uo) is det.
+:- mode foldl3(pred(in, in, out, in, out, in, out) is semidet,
+    in, in, out, in, out, in, out) is semidet.
+:- mode foldl3(pred(in, in, out, in, out, mdi, muo) is semidet,
+    in, in, out, in, out, mdi, muo) is semidet.
+:- mode foldl3(pred(in, in, out, in, out, di, uo) is semidet,
+    in, in, out, in, out, di, uo) is semidet.
+
+    % As above, but with four accumulators.
+    %
+:- pred foldl4(pred(T1, T2, T2, T3, T3, T4, T4, T5, T5), array(T1),
+    T2, T2, T3, T3, T4, T4, T5, T5).
+:- mode foldl4(pred(in, in, out, in, out, in, out, in, out) is det,
+    in, in, out, in, out, in, out, in, out) is det.
+:- mode foldl4(pred(in, in, out, in, out, in, out, mdi, muo) is det,
+    in, in, out, in, out, in, out, mdi, muo) is det.
+:- mode foldl4(pred(in, in, out, in, out, in, out, di, uo) is det,
+    in, in, out, in, out, in, out, di, uo) is det.
+:- mode foldl4(pred(in, in, out, in, out, in, out, in, out) is semidet,
+    in, in, out, in, out, in, out, in, out) is semidet.
+:- mode foldl4(pred(in, in, out, in, out, in, out, mdi, muo) is semidet,
+    in, in, out, in, out, in, out, mdi, muo) is semidet.
+:- mode foldl4(pred(in, in, out, in, out, in, out, di, uo) is semidet,
+    in, in, out, in, out, in, out, di, uo) is semidet.
+
+    % As above, but with five accumulators.
+    %
+:- pred foldl5(pred(T1, T2, T2, T3, T3, T4, T4, T5, T5, T6, T6),
+    array(T1), T2, T2, T3, T3, T4, T4, T5, T5, T6, T6).
+:- mode foldl5(
+    pred(in, in, out, in, out, in, out, in, out, in, out) is det,
+    in, in, out, in, out, in, out, in, out, in, out) is det.
+:- mode foldl5(
+    pred(in, in, out, in, out, in, out, in, out, mdi, muo) is det,
+    in, in, out, in, out, in, out, in, out, mdi, muo) is det.
+:- mode foldl5(
+    pred(in, in, out, in, out, in, out, in, out, di, uo) is det,
+    in, in, out, in, out, in, out, in, out, di, uo) is det.
+:- mode foldl5(
+    pred(in, in, out, in, out, in, out, in, out, in, out) is semidet,
+    in, in, out, in, out, in, out, in, out, in, out) is semidet.
+:- mode foldl5(
+    pred(in, in, out, in, out, in, out, in, out, mdi, muo) is semidet,
+    in, in, out, in, out, in, out, in, out, mdi, muo) is semidet.
+:- mode foldl5(
+    pred(in, in, out, in, out, in, out, in, out, di, uo) is semidet,
+    in, in, out, in, out, in, out, in, out, di, uo) is semidet.
+
+%---------------------%
+
+    % foldr(Fn, Array, X) is equivalent to
+    %   list.foldr(Fn, to_list(Array), X)
+    % but more efficient.
+    %
+:- func foldr(func(T1, T2) = T2, array(T1), T2) = T2.
+%:- mode foldr(func(in, in) = out is det, array_ui, in) = out is det.
+:- mode foldr(func(in, in) = out is det, in, in) = out is det.
+%:- mode foldr(func(in, di) = uo is det, array_ui, di) = uo is det.
+:- mode foldr(func(in, di) = uo is det, in, di) = uo is det.
+
+    % foldr(P, Array, !Acc) is equivalent to
+    %   list.foldr(P, to_list(Array), !Acc)
+    % but more efficient.
+    %
+:- pred foldr(pred(T1, T2, T2), array(T1), T2, T2).
+:- mode foldr(pred(in, in, out) is det, in, in, out) is det.
+:- mode foldr(pred(in, mdi, muo) is det, in, mdi, muo) is det.
+:- mode foldr(pred(in, di, uo) is det, in, di, uo) is det.
+:- mode foldr(pred(in, in, out) is semidet, in, in, out) is semidet.
+:- mode foldr(pred(in, mdi, muo) is semidet, in, mdi, muo) is semidet.
+:- mode foldr(pred(in, di, uo) is semidet, in, di, uo) is semidet.
+
+    % As above, but with two accumulators.
+    %
+:- pred foldr2(pred(T1, T2, T2, T3, T3), array(T1), T2, T2, T3, T3).
+:- mode foldr2(pred(in, in, out, in, out) is det, in, in, out, in, out)
+    is det.
+:- mode foldr2(pred(in, in, out, mdi, muo) is det, in, in, out, mdi, muo)
+    is det.
+:- mode foldr2(pred(in, in, out, di, uo) is det, in, in, out, di, uo)
+    is det.
+:- mode foldr2(pred(in, in, out, in, out) is semidet, in,
+    in, out, in, out) is semidet.
+:- mode foldr2(pred(in, in, out, mdi, muo) is semidet, in,
+    in, out, mdi, muo) is semidet.
+:- mode foldr2(pred(in, in, out, di, uo) is semidet, in,
+    in, out, di, uo) is semidet.
+
+    % As above, but with three accumulators.
+    %
+:- pred foldr3(pred(T1, T2, T2, T3, T3, T4, T4), array(T1),
+    T2, T2, T3, T3, T4, T4).
+:- mode foldr3(pred(in, in, out, in, out, in, out) is det, in,
+    in, out, in, out, in, out) is det.
+:- mode foldr3(pred(in, in, out, in, out, mdi, muo) is det, in,
+    in, out, in, out, mdi, muo) is det.
+:- mode foldr3(pred(in, in, out, in, out, di, uo) is det, in,
+    in, out, in, out, di, uo) is det.
+:- mode foldr3(pred(in, in, out, in, out, in, out) is semidet, in,
+    in, out, in, out, in, out) is semidet.
+:- mode foldr3(pred(in, in, out, in, out, mdi, muo) is semidet, in,
+    in, out, in, out, mdi, muo) is semidet.
+:- mode foldr3(pred(in, in, out, in, out, di, uo) is semidet, in,
+    in, out, in, out, di, uo) is semidet.
+
+    % As above, but with four accumulators.
+    %
+:- pred foldr4(pred(T1, T2, T2, T3, T3, T4, T4, T5, T5), array(T1),
+    T2, T2, T3, T3, T4, T4, T5, T5).
+:- mode foldr4(pred(in, in, out, in, out, in, out, in, out) is det,
+    in, in, out, in, out, in, out, in, out) is det.
+:- mode foldr4(pred(in, in, out, in, out, in, out, mdi, muo) is det,
+    in, in, out, in, out, in, out, mdi, muo) is det.
+:- mode foldr4(pred(in, in, out, in, out, in, out, di, uo) is det,
+    in, in, out, in, out, in, out, di, uo) is det.
+:- mode foldr4(pred(in, in, out, in, out, in, out, in, out) is semidet,
+    in, in, out, in, out, in, out, in, out) is semidet.
+:- mode foldr4(pred(in, in, out, in, out, in, out, mdi, muo) is semidet,
+    in, in, out, in, out, in, out, mdi, muo) is semidet.
+:- mode foldr4(pred(in, in, out, in, out, in, out, di, uo) is semidet,
+    in, in, out, in, out, in, out, di, uo) is semidet.
+
+    % As above, but with five accumulators.
+    %
+:- pred foldr5(pred(T1, T2, T2, T3, T3, T4, T4, T5, T5, T6, T6),
+    array(T1), T2, T2, T3, T3, T4, T4, T5, T5, T6, T6).
+:- mode foldr5(
+    pred(in, in, out, in, out, in, out, in, out, in, out) is det,
+    in, in, out, in, out, in, out, in, out, in, out) is det.
+:- mode foldr5(
+    pred(in, in, out, in, out, in, out, in, out, mdi, muo) is det,
+    in, in, out, in, out, in, out, in, out, mdi, muo) is det.
+:- mode foldr5(
+    pred(in, in, out, in, out, in, out, in, out, di, uo) is det,
+    in, in, out, in, out, in, out, in, out, di, uo) is det.
+:- mode foldr5(
+    pred(in, in, out, in, out, in, out, in, out, in, out) is semidet,
+    in, in, out, in, out, in, out, in, out, in, out) is semidet.
+:- mode foldr5(
+    pred(in, in, out, in, out, in, out, in, out, mdi, muo) is semidet,
+    in, in, out, in, out, in, out, in, out, mdi, muo) is semidet.
+:- mode foldr5(
+    pred(in, in, out, in, out, in, out, in, out, di, uo) is semidet,
+    in, in, out, in, out, in, out, in, out, di, uo) is semidet.
+
+%---------------------%
+
+    % foldl_corresponding(P, A, B, !Acc):
+    %
+    % Does the same job as foldl, but works on two arrays in parallel.
+    % Throws an exception if the array arguments differ in size.
+    %
+:- pred foldl_corresponding(pred(T1, T2, T3, T3), array(T1), array(T2),
+    T3, T3).
+:- mode foldl_corresponding(in(pred(in, in, in, out) is det), in, in,
+    in, out) is det.
+:- mode foldl_corresponding(in(pred(in, in, mdi, muo) is det), in, in,
+    mdi, muo) is det.
+:- mode foldl_corresponding(in(pred(in, in, di, uo) is det), in, in,
+    di, uo) is det.
+:- mode foldl_corresponding(in(pred(in, in, in, out) is semidet), in, in,
+    in, out) is semidet.
+:- mode foldl_corresponding(in(pred(in, in, mdi, muo) is semidet), in, in,
+    mdi, muo) is semidet.
+:- mode foldl_corresponding(in(pred(in, in, di, uo) is semidet), in, in,
+    di, uo) is semidet.
+
+    % As above, but with two accumulators.
+    %
+:- pred foldl2_corresponding(pred(T1, T2, T3, T3, T4, T4),
+    array(T1), array(T2), T3, T3, T4, T4).
+:- mode foldl2_corresponding(in(pred(in, in, in, out, in, out) is det),
+    in, in, in, out, in, out) is det.
+:- mode foldl2_corresponding(in(pred(in, in, in, out, mdi, muo) is det),
+    in, in, in, out, mdi, muo) is det.
+:- mode foldl2_corresponding(in(pred(in, in, in, out, di, uo) is det),
+    in, in, in, out, di, uo) is det.
+:- mode foldl2_corresponding(in(pred(in, in, in, out, in, out) is semidet),
+    in, in, in, out, in, out) is semidet.
+:- mode foldl2_corresponding(in(pred(in, in, in, out, mdi, muo) is semidet),
+    in, in, in, out, mdi, muo) is semidet.
+:- mode foldl2_corresponding(in(pred(in, in, in, out,  di, uo) is semidet),
+    in, in, in, out, di, uo) is semidet.
+
+%---------------------%
+
+    % map_foldl(P, A, B, !Acc):
+    % Invoke P(Aelt, Belt, !Acc) on each element of the A array,
+    % and construct array B from the resulting values of Belt.
+    %
+:- pred map_foldl(pred(T1, T2, T3, T3), array(T1), array(T2), T3, T3).
+:- mode map_foldl(in(pred(in, out, in, out) is det),
+    in, array_uo, in, out) is det.
+:- mode map_foldl(in(pred(in, out, mdi, muo) is det),
+    in, array_uo, mdi, muo) is det.
+:- mode map_foldl(in(pred(in, out, di, uo) is det),
+    in, array_uo, di, uo) is det.
+:- mode map_foldl(in(pred(in, out, in, out) is semidet),
+    in, array_uo, in, out) is semidet.
+
+%---------------------%
+
+    % map_corresponding_foldl(P, A, B, C, !Acc):
+    %
+    % Given two arrays A and B, invoke P(Aelt, Belt, Celt, !Acc) on
+    % each corresponding pair of elements Aelt and Belt. Build up the array C
+    % from the result Celt values. Return C and the final value of the
+    % accumulator.
+    %
+    % Throws an exception if A and B differ in size.
+    %
+:- pred map_corresponding_foldl(pred(T1, T2, T3, T4, T4),
+    array(T1), array(T2), array(T3), T4, T4).
+:- mode map_corresponding_foldl(
+    in(pred(in, in, out, in, out) is det),
+    in, in, array_uo, in, out) is det.
+:- mode map_corresponding_foldl(
+    in(pred(in, in, out, mdi, muo) is det),
+    in, in, array_uo, mdi, muo) is det.
+:- mode map_corresponding_foldl(
+    in(pred(in, in, out, di, uo) is det),
+    in, in, array_uo, di, uo) is det.
+:- mode map_corresponding_foldl(
+    in(pred(in, in, out, in, out) is semidet),
+    in, in, array_uo, in, out) is semidet.
+:- mode map_corresponding_foldl(
+    in(pred(in, in, out, mdi, muo) is semidet),
+    in, in, array_uo, mdi, muo) is semidet.
+:- mode map_corresponding_foldl(
+    in(pred(in, in, out, di, uo) is semidet),
+    in, in, array_uo, di, uo) is semidet.
+
+%---------------------%
+
+    % all_true(Pred, Array):
+    % True iff Pred is true for every element of Array.
+    %
+:- pred all_true(pred(T), array(T)).
+%:- mode all_true(in(pred(in) is semidet), array_ui) is semidet.
+:- mode all_true(in(pred(in) is semidet), in) is semidet.
+
+    % all_false(Pred, Array):
+    % True iff Pred is false for every element of Array.
+    %
+:- pred all_false(pred(T), array(T)).
+%:- mode all_false(in(pred(in) is semidet), array_ui) is semidet.
+:- mode all_false(in(pred(in) is semidet), in) is semidet.
+
+    % append(A, B) = C:
+    %
+    % Make C a concatenation of the arrays A and B.
+    %
+:- func append(array(T)::in, array(T)::in) = (array(T)::array_uo) is det.
+
+    % random_permutation(A0, A, RS0, RS) permutes the elements in
+    % A0 given random seed RS0 and returns the permuted array in A
+    % and the next random seed in RS.
+    %
+:- pred random_permutation(array(T)::array_di, array(T)::array_uo,
+    random.supply::mdi, random.supply::muo) is det.
+
+    % Convert an array to a pretty_printer.doc for formatting.
+    %
+:- func array_to_doc(array(T)) = pretty_printer.doc.
+:- mode array_to_doc(array_ui) = out is det.
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+% Everything beyond here is not intended as part of the public interface,
+% and will not appear in the Mercury Library Reference Manual.
+
+:- interface.
+
+    % dynamic_cast/2 won't work for arbitrary arrays since array/1 is
+    % not a ground type (that is, dynamic_cast/2 will work when the
+    % target type is e.g. array(int), but not when it is array(T)).
+    %
+:- some [T2] pred dynamic_cast_to_array(T1::in, array(T2)::out) is semidet.
+
+:- implementation.
+
+:- import_module exception.
+:- import_module int.
+:- import_module require.
+:- import_module string.
+:- import_module type_desc.
+
+%
+% Define the array type appropriately for the different targets.
+% Note that the definitions here should match what is output by
+% mlds_to_c.m, mlds_to_csharp.m, or mlds_to_java.m for mlds.mercury_array_type.
+%
+
+    % MR_ArrayPtr is defined in runtime/mercury_types.h.
+:- pragma foreign_type("C", array(T), "MR_ArrayPtr")
+    where equality is array.array_equal,
+    comparison is array.array_compare.
+
+:- pragma foreign_type("C#",  array(T), "System.Array")
+    where equality is array.array_equal,
+    comparison is array.array_compare.
+
+    % We can't use `java.lang.Object []', since we want a generic type
+    % that is capable of holding any kind of array, including e.g. `int []'.
+    % Java doesn't have any equivalent of .NET's System.Array class,
+    % so we just use the universal base `java.lang.Object'.
+:- pragma foreign_type("Java",  array(T), "/* Array */ java.lang.Object")
+    where equality is array.array_equal,
+    comparison is array.array_compare.
+
+    % unify/2 for arrays
+    %
+:- pred array_equal(array(T)::in, array(T)::in) is semidet.
+:- pragma terminates(array_equal/2).
+
+array_equal(Array1, Array2) :-
+    ( if
+        array.size(Array1, Size),
+        array.size(Array2, Size)
+    then
+        equal_elements(0, Size, Array1, Array2)
+    else
+        fail
+    ).
+
+:- pred equal_elements(int, int, array(T), array(T)).
+:- mode equal_elements(in, in, in, in) is semidet.
+
+equal_elements(N, Size, Array1, Array2) :-
+    ( if N = Size then
+        true
+    else
+        array.unsafe_lookup(Array1, N, Elem),
+        array.unsafe_lookup(Array2, N, Elem),
+        N1 = N + 1,
+        equal_elements(N1, Size, Array1, Array2)
+    ).
+
+array_compare(A1, A2) = C :-
+    array_compare(C, A1, A2).
+
+    % compare/3 for arrays
+    %
+:- pred array_compare(comparison_result::uo, array(T)::in, array(T)::in)
+    is det.
+:- pragma terminates(array_compare/3).
+
+array_compare(Result, Array1, Array2) :-
+    array.size(Array1, Size1),
+    array.size(Array2, Size2),
+    compare(SizeResult, Size1, Size2),
+    (
+        SizeResult = (=),
+        compare_elements(0, Size1, Array1, Array2, Result)
+    ;
+        ( SizeResult = (<)
+        ; SizeResult = (>)
+        ),
+        Result = SizeResult
+    ).
+
+:- pred compare_elements(int::in, int::in, array(T)::in, array(T)::in,
+    comparison_result::uo) is det.
+
+compare_elements(N, Size, Array1, Array2, Result) :-
+    ( if N = Size then
+        Result = (=)
+    else
+        array.unsafe_lookup(Array1, N, Elem1),
+        array.unsafe_lookup(Array2, N, Elem2),
+        compare(ElemResult, Elem1, Elem2),
+        (
+            ElemResult = (=),
+            N1 = N + 1,
+            compare_elements(N1, Size, Array1, Array2, Result)
+        ;
+            ( ElemResult = (<)
+            ; ElemResult = (>)
+            ),
+            Result = ElemResult
+        )
+    ).
+
+%---------------------------------------------------------------------------%
+
+:- pred bounds_checks is semidet.
+:- pragma inline(bounds_checks/0).
+
+:- pragma foreign_proc("C",
+    bounds_checks,
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
+        does_not_affect_liveness, no_sharing],
+"
+#ifdef ML_OMIT_ARRAY_BOUNDS_CHECKS
+    SUCCESS_INDICATOR = MR_FALSE;
+#else
+    SUCCESS_INDICATOR = MR_TRUE;
+#endif
+").
+
+:- pragma foreign_proc("C#",
+    bounds_checks,
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+#if ML_OMIT_ARRAY_BOUNDS_CHECKS
+    SUCCESS_INDICATOR = false;
+#else
+    SUCCESS_INDICATOR = true;
+#endif
+").
+
+:- pragma foreign_proc("Java",
+    bounds_checks,
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    // never do bounds checking for Java (throw exceptions instead)
+    SUCCESS_INDICATOR = false;
+").
+
+%---------------------------------------------------------------------------%
+
+:- pragma foreign_decl("C", "
+#include ""mercury_heap.h""             // for MR_maybe_record_allocation()
+#include ""mercury_library_types.h""    // for MR_ArrayPtr
+
+// We do not yet record term sizes for arrays in term size profiling
+// grades. Doing so would require
+//
+// - modifying ML_alloc_array to allocate an extra word for the size;
+// - modifying all the predicates that call ML_alloc_array to compute the
+//   size of the array (the sum of the sizes of the elements and the size of
+//   the array itself);
+// - modifying all the predicates that update array elements to compute the
+//   difference between the sizes of the terms being added to and deleted from
+//   the array, and updating the array size accordingly.
+
+#define ML_alloc_array(newarray, arraysize, alloc_id)                   \
+    do {                                                                \
+        MR_Word newarray_word;                                          \
+        MR_offset_incr_hp_msg(newarray_word, 0, (arraysize),            \
+            alloc_id, ""array.array/1"");                               \
+        (newarray) = (MR_ArrayPtr) newarray_word;                       \
+    } while (0)
+").
+
+:- pragma foreign_decl("C", "
+void ML_init_array(MR_ArrayPtr, MR_Integer size, MR_Word item);
+").
+
+:- pragma foreign_code("C", "
+// The caller is responsible for allocating the memory for the array.
+// This routine does the job of initializing the already-allocated memory.
+void
+ML_init_array(MR_ArrayPtr array, MR_Integer size, MR_Word item)
+{
+    MR_Integer i;
+
+    array->size = size;
+    for (i = 0; i < size; i++) {
+        array->elements[i] = item;
+    }
+}
+").
+
+:- pragma foreign_code("C#", "
+
+public static System.Array
+ML_new_array(int Size, object Item)
+{
+    System.Array arr;
+    if (Size == 0) {
+        return null;
+    }
+    if (
+        Item is int || Item is uint || Item is sbyte || Item is byte ||
+        Item is short || Item is ushort || Item is long || Item is ulong ||
+        Item is double || Item is char || Item is bool
+    ) {
+        arr = System.Array.CreateInstance(Item.GetType(), Size);
+    } else {
+        arr = new object[Size];
+    }
+    for (int i = 0; i < Size; i++) {
+        arr.SetValue(Item, i);
+    }
+    return arr;
+}
+
+public static System.Array
+ML_unsafe_new_array(int Size, object Item, int IndexToSet)
+{
+    System.Array arr;
+
+    if (
+        Item is int || Item is uint || Item is sbyte || Item is byte ||
+        Item is short || Item is ushort || Item is long || Item is ulong ||
+        Item is double || Item is char || Item is bool
+    ) {
+        arr = System.Array.CreateInstance(Item.GetType(), Size);
+    } else {
+        arr = new object[Size];
+    }
+    arr.SetValue(Item, IndexToSet);
+    return arr;
+}
+
+public static System.Array
+ML_array_resize(System.Array arr0, int Size, object Item)
+{
+    if (Size == 0) {
+        return null;
+    }
+    if (arr0 == null) {
+        return ML_new_array(Size, Item);
+    }
+    if (arr0.Length == Size) {
+        return arr0;
+    }
+
+    int OldSize = arr0.Length;
+    System.Array arr;
+    if (Item is int) {
+        int[] tmp = (int[]) arr0;
+        System.Array.Resize(ref tmp, Size);
+        arr = tmp;
+    } else if (Item is uint) {
+        uint[] tmp = (uint[]) arr0;
+        System.Array.Resize(ref tmp, Size);
+        arr = tmp;
+    } else if (Item is sbyte) {
+        sbyte[] tmp = (sbyte[]) arr0;
+        System.Array.Resize(ref tmp, Size);
+        arr = tmp;
+    } else if (Item is byte) {
+        byte[] tmp = (byte[]) arr0;
+        System.Array.Resize(ref tmp, Size);
+        arr = tmp;
+    } else if (Item is short) {
+        short[] tmp = (short[]) arr0;
+        System.Array.Resize(ref tmp, Size);
+        arr = tmp;
+    } else if (Item is ushort) {
+        ushort[] tmp = (ushort[]) arr0;
+        System.Array.Resize(ref tmp, Size);
+        arr = tmp;
+    } else if (Item is long) {
+        long[] tmp = (long[]) arr0;
+        System.Array.Resize(ref tmp, Size);
+        arr = tmp;
+    } else if (Item is ulong) {
+        ulong[] tmp = (ulong[]) arr0;
+        System.Array.Resize(ref tmp, Size);
+        arr = tmp;
+    } else if (Item is double) {
+        double[] tmp = (double[]) arr0;
+        System.Array.Resize(ref tmp, Size);
+        arr = tmp;
+    } else if (Item is char) {
+        char[] tmp = (char[]) arr0;
+        System.Array.Resize(ref tmp, Size);
+        arr = tmp;
+    } else if (Item is bool) {
+        bool[] tmp = (bool[]) arr0;
+        System.Array.Resize(ref tmp, Size);
+        arr = tmp;
+    } else {
+        object[] tmp = (object[]) arr0;
+        System.Array.Resize(ref tmp, Size);
+        arr = tmp;
+    }
+    for (int i = OldSize; i < Size; i++) {
+        arr.SetValue(Item, i);
+    }
+    return arr;
+}
+
+public static System.Array
+ML_shrink_array(System.Array arr, int Size)
+{
+    if (arr == null) {
+        return null;
+    }
+
+    // We need to use Item here to determine the type instead of arr itself
+    // since both 'arr is int[]' and 'arr is uint[]' evaluate to true;
+    // similarly for the other integer types.  (That behaviour is due to an
+    // inconsistency between the covariance of value-typed arrays in C# and
+    // the CLR.)
+    object Item = arr.GetValue(0);
+    if (Item is int) {
+        int[] tmp = (int[]) arr;
+        System.Array.Resize(ref tmp, Size);
+        return tmp;
+    } else if (Item is uint) {
+        uint[] tmp = (uint[]) arr;
+        System.Array.Resize(ref tmp, Size);
+        return tmp;
+    } else if (Item is sbyte) {
+        sbyte[] tmp = (sbyte[]) arr;
+        System.Array.Resize(ref tmp, Size);
+        return tmp;
+    } else if (Item is byte) {
+        byte[] tmp = (byte[]) arr;
+        System.Array.Resize(ref tmp, Size);
+        return tmp;
+    } else if (Item is short) {
+        short[] tmp = (short[]) arr;
+        System.Array.Resize(ref tmp, Size);
+        return tmp;
+    } else if (Item is ushort) {
+        ushort[] tmp = (ushort[]) arr;
+        System.Array.Resize(ref tmp, Size);
+        return tmp;
+    } else if (Item is long) {
+        long[] tmp = (long[]) arr;
+        System.Array.Resize(ref tmp, Size);
+        return tmp;
+    } else if (Item is ulong) {
+        ulong[] tmp = (ulong[]) arr;
+        System.Array.Resize(ref tmp, Size);
+        return tmp;
+    } else if (Item is double) {
+        double[] tmp = (double[]) arr;
+        System.Array.Resize(ref tmp, Size);
+        return tmp;
+    } else if (Item is char) {
+        char[] tmp = (char[]) arr;
+        System.Array.Resize(ref tmp, Size);
+        return tmp;
+    } else if (Item is bool) {
+        bool[] tmp = (bool[]) arr;
+        System.Array.Resize(ref tmp, Size);
+        return tmp;
+    } else {
+        object[] tmp = (object[]) arr;
+        System.Array.Resize(ref tmp, Size);
+        return tmp;
+    }
+}
+").
+
+:- pragma foreign_code("Java", "
+public static Object
+ML_new_array(int Size, Object Item, boolean fill)
+{
+    if (Size == 0) {
+        return null;
+    }
+    if (Item instanceof Integer) {
+        int[] as = new int[Size];
+        if (fill) {
+            java.util.Arrays.fill(as, (Integer) Item);
+        }
+        return as;
+    }
+    if (Item instanceof Double) {
+        double[] as = new double[Size];
+        if (fill) {
+            java.util.Arrays.fill(as, (Double) Item);
+        }
+        return as;
+    }
+    if (Item instanceof Character) {
+        char[] as = new char[Size];
+        if (fill) {
+            java.util.Arrays.fill(as, (Character) Item);
+        }
+        return as;
+    }
+    if (Item instanceof Boolean) {
+        boolean[] as = new boolean[Size];
+        if (fill) {
+            java.util.Arrays.fill(as, (Boolean) Item);
+        }
+        return as;
+    }
+    if (Item instanceof Byte) {
+        byte[] as = new byte[Size];
+        if (fill) {
+            java.util.Arrays.fill(as, (Byte) Item);
+        }
+        return as;
+    }
+    if (Item instanceof Short) {
+        short[] as = new short[Size];
+        if (fill) {
+            java.util.Arrays.fill(as, (Short) Item);
+        }
+        return as;
+    }
+    if (Item instanceof Long) {
+        long[] as =  new long[Size];
+        if (fill) {
+            java.util.Arrays.fill(as, (Long) Item);
+        }
+        return as;
+    }
+    if (Item instanceof Float) {
+        float[] as = new float[Size];
+        if (fill) {
+            java.util.Arrays.fill(as, (Float) Item);
+        }
+        return as;
+    }
+    Object[] as = new Object[Size];
+    if (fill) {
+        java.util.Arrays.fill(as, Item);
+    }
+    return as;
+}
+
+public static Object
+ML_unsafe_new_array(int Size, Object Item, int IndexToSet)
+{
+    if (Item instanceof Integer) {
+        int[] as = new int[Size];
+        as[IndexToSet] = (Integer) Item;
+        return as;
+    }
+    if (Item instanceof Double) {
+        double[] as = new double[Size];
+        as[IndexToSet] = (Double) Item;
+        return as;
+    }
+    if (Item instanceof Character) {
+        char[] as = new char[Size];
+        as[IndexToSet] = (Character) Item;
+        return as;
+    }
+    if (Item instanceof Boolean) {
+        boolean[] as = new boolean[Size];
+        as[IndexToSet] = (Boolean) Item;
+        return as;
+    }
+    if (Item instanceof Byte) {
+        byte[] as = new byte[Size];
+        as[IndexToSet] = (Byte) Item;
+        return as;
+    }
+    if (Item instanceof Short) {
+        short[] as = new short[Size];
+        as[IndexToSet] = (Short) Item;
+        return as;
+    }
+    if (Item instanceof Long) {
+        long[] as = new long[Size];
+        as[IndexToSet] = (Long) Item;
+        return as;
+    }
+    if (Item instanceof Float) {
+        float[] as = new float[Size];
+        as[IndexToSet] = (Float) Item;
+        return as;
+    }
+    Object[] as = new Object[Size];
+    as[IndexToSet] = Item;
+    return as;
+}
+
+public static int
+ML_array_size(Object Array)
+{
+    if (Array == null) {
+        return 0;
+    } else if (Array instanceof int[]) {
+        return ((int[]) Array).length;
+    } else if (Array instanceof double[]) {
+        return ((double[]) Array).length;
+    } else if (Array instanceof char[]) {
+        return ((char[]) Array).length;
+    } else if (Array instanceof boolean[]) {
+        return ((boolean[]) Array).length;
+    } else if (Array instanceof byte[]) {
+        return ((byte[]) Array).length;
+    } else if (Array instanceof short[]) {
+        return ((short[]) Array).length;
+    } else if (Array instanceof long[]) {
+        return ((long[]) Array).length;
+    } else if (Array instanceof float[]) {
+        return ((float[]) Array).length;
+    } else {
+        return ((Object[]) Array).length;
+    }
+}
+
+public static Object
+ML_array_resize(Object Array0, int Size, Object Item)
+{
+    if (Size == 0) {
+        return null;
+    }
+    if (Array0 == null) {
+        return ML_new_array(Size, Item, true);
+    }
+    if (ML_array_size(Array0) == Size) {
+        return Array0;
+    }
+    if (Array0 instanceof int[]) {
+        int[] arr0 = (int[]) Array0;
+        int[] Array = new int[Size];
+
+        System.arraycopy(arr0, 0, Array, 0, Math.min(arr0.length, Size));
+        for (int i = arr0.length; i < Size; i++) {
+            Array[i] = (Integer) Item;
+        }
+        return Array;
+    }
+    if (Array0 instanceof double[]) {
+        double[] arr0 = (double[]) Array0;
+        double[] Array = new double[Size];
+
+        System.arraycopy(arr0, 0, Array, 0, Math.min(arr0.length, Size));
+        for (int i = arr0.length; i < Size; i++) {
+            Array[i] = (Double) Item;
+        }
+        return Array;
+    }
+    if (Array0 instanceof char[]) {
+        char[] arr0 = (char[]) Array0;
+        char[] Array = new char[Size];
+
+        System.arraycopy(arr0, 0, Array, 0, Math.min(arr0.length, Size));
+        for (int i = arr0.length; i < Size; i++) {
+            Array[i] = (Character) Item;
+        }
+        return Array;
+    }
+    if (Array0 instanceof boolean[]) {
+        boolean[] arr0 = (boolean[]) Array0;
+        boolean[] Array = new boolean[Size];
+
+        System.arraycopy(arr0, 0, Array, 0, Math.min(arr0.length, Size));
+        for (int i = arr0.length; i < Size; i++) {
+            Array[i] = (Boolean) Item;
+        }
+        return Array;
+    }
+    if (Array0 instanceof byte[]) {
+        byte[] arr0 = (byte[]) Array0;
+        byte[] Array = new byte[Size];
+
+        System.arraycopy(arr0, 0, Array, 0, Math.min(arr0.length, Size));
+        for (int i = arr0.length; i < Size; i++) {
+            Array[i] = (Byte) Item;
+        }
+        return Array;
+    }
+    if (Array0 instanceof short[]) {
+        short[] arr0 = (short[]) Array0;
+        short[] Array = new short[Size];
+
+        System.arraycopy(arr0, 0, Array, 0, Math.min(arr0.length, Size));
+        for (int i = arr0.length; i < Size; i++) {
+            Array[i] = (Short) Item;
+        }
+        return Array;
+    }
+    if (Array0 instanceof long[]) {
+        long[] arr0 = (long[]) Array0;
+        long[] Array = new long[Size];
+
+        System.arraycopy(arr0, 0, Array, 0, Math.min(arr0.length, Size));
+        for (int i = arr0.length; i < Size; i++) {
+            Array[i] = (Long) Item;
+        }
+        return Array;
+    }
+    if (Array0 instanceof float[]) {
+        float[] arr0 = (float[]) Array0;
+        float[] Array = new float[Size];
+
+        System.arraycopy(arr0, 0, Array, 0, Math.min(arr0.length, Size));
+        for (int i = arr0.length; i < Size; i++) {
+            Array[i] = (Float) Item;
+        }
+        return Array;
+    } else {
+        Object[] arr0 = (Object[]) Array0;
+        Object[] Array = new Object[Size];
+
+        System.arraycopy(arr0, 0, Array, 0, Math.min(arr0.length, Size));
+        for (int i = arr0.length; i < Size; i++) {
+            Array[i] = Item;
+        }
+        return Array;
+    }
+}
+
+public static Object
+ML_array_fill(Object array, int fromIndex, int toIndex, Object Item)
+{
+    if (array == null) {
+        return null;
+    }
+
+    if (array instanceof int[]) {
+        java.util.Arrays.fill(((int []) array), fromIndex, toIndex,
+            (Integer) Item);
+    } else if (array instanceof double[]) {
+        java.util.Arrays.fill(((double []) array), fromIndex, toIndex,
+            (Double) Item);
+    } else if (array instanceof byte[]) {
+        java.util.Arrays.fill(((byte []) array), fromIndex, toIndex,
+            (Byte) Item);
+    } else if (array instanceof short[]) {
+        java.util.Arrays.fill(((short []) array), fromIndex, toIndex,
+            (Short) Item);
+    } else if (array instanceof long[]) {
+        java.util.Arrays.fill(((long []) array), fromIndex, toIndex,
+            (Long) Item);
+    } else if (array instanceof char[]) {
+        java.util.Arrays.fill(((char []) array), fromIndex, toIndex,
+            (Character) Item);
+    } else if (array instanceof boolean[]) {
+        java.util.Arrays.fill(((boolean []) array), fromIndex, toIndex,
+            (Boolean) Item);
+    } else if (array instanceof float[]) {
+        java.util.Arrays.fill(((float []) array), fromIndex, toIndex,
+            (Float) Item);
+    } else {
+        java.util.Arrays.fill(((Object []) array), fromIndex, toIndex, Item);
+    }
+    return array;
+}
+").
+
+init(N, X) = A :-
+    array.init(N, X, A).
+
+init(Size, Item, Array) :-
+    ( if Size < 0 then
+        unexpected($pred, "negative size")
+    else
+        array.init_2(Size, Item, Array)
+    ).
+
+:- pred init_2(int::in, T::in, array(T)::array_uo) is det.
+
+:- pragma foreign_proc("C",
+    init_2(Size::in, Item::in, Array::array_uo),
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
+        does_not_affect_liveness,
+        sharing(yes(int, T, array(T)), [
+            cel(Item, []) - cel(Array, [T])
+        ])
+    ],
+"
+    ML_alloc_array(Array, Size + 1, MR_ALLOC_ID);
+    ML_init_array(Array, Size, Item);
+").
+:- pragma foreign_proc("C#",
+    init_2(Size::in, Item::in, Array::array_uo),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    Array = array.ML_new_array(Size, Item);
+").
+:- pragma foreign_proc("Java",
+    init_2(Size::in, Item::in, Array::array_uo),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    Array = array.ML_new_array(Size, Item, true);
+").
+
+make_empty_array = A :-
+    array.make_empty_array(A).
+
+:- pragma foreign_proc("C",
+    make_empty_array(Array::array_uo),
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
+        does_not_affect_liveness, no_sharing],
+"
+    ML_alloc_array(Array, 1, MR_ALLOC_ID);
+    ML_init_array(Array, 0, 0);
+").
+:- pragma foreign_proc("C#",
+    make_empty_array(Array::array_uo),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    // XXX A better solution than using the null pointer to represent
+    // the empty array would be to create an array of size 0. However,
+    // we need to determine the element type of the array before we can
+    // do that. This could be done by examining the RTTI of the array
+    // type and then using System.Type.GetType(""<mercury type>"") to
+    // determine it. However constructing the <mercury type> string is
+    // a non-trivial amount of work.
+    Array = null;
+").
+:- pragma foreign_proc("Java",
+    make_empty_array(Array::array_uo),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    // XXX as per C#
+    Array = null;
+").
+
+%---------------------------------------------------------------------------%
+
+generate(Size, GenFunc) = Array :-
+    compare(Result, Size, 0),
+    (
+        Result = (<),
+        unexpected($pred, "negative size")
+    ;
+        Result = (=),
+        make_empty_array(Array)
+    ;
+        Result = (>),
+        FirstElem = GenFunc(0),
+        Array0 = unsafe_init(Size, FirstElem, 0),
+        Array = generate_2(1, Size, GenFunc, Array0)
+    ).
+
+:- func unsafe_init(int::in, T::in, int::in) = (array(T)::array_uo) is det.
+:- pragma foreign_proc("C",
+    unsafe_init(Size::in, FirstElem::in, IndexToSet::in) = (Array::array_uo),
+    [promise_pure, will_not_call_mercury, thread_safe, will_not_modify_trail,
+        does_not_affect_liveness],
+"
+    ML_alloc_array(Array, Size + 1, MR_ALLOC_ID);
+
+    // In debugging grades, we fill the array with the first element,
+    // in case the return value of a call to this predicate is examined
+    // in the debugger.
+    #if defined(MR_EXEC_TRACE)
+        ML_init_array(Array, Size, FirstElem);
+    #else
+        Array->size = Size;
+        Array->elements[IndexToSet] = FirstElem;
+    #endif
+
+").
+:- pragma foreign_proc("C#",
+    unsafe_init(Size::in, FirstElem::in, IndexToSet::in) = (Array::array_uo),
+    [promise_pure, will_not_call_mercury, thread_safe],
+"
+    Array = array.ML_unsafe_new_array(Size, FirstElem, IndexToSet);
+").
+:- pragma foreign_proc("Java",
+    unsafe_init(Size::in, FirstElem::in, IndexToSet::in) = (Array::array_uo),
+    [promise_pure, will_not_call_mercury, thread_safe],
+"
+    Array = array.ML_unsafe_new_array(Size, FirstElem, IndexToSet);
+").
+
+:- func generate_2(int::in, int::in, (func(int) = T)::in, array(T)::array_di)
+    = (array(T)::array_uo) is det.
+
+generate_2(Index, Size, GenFunc, !.Array) = !:Array :-
+    ( if Index < Size then
+        Elem = GenFunc(Index),
+        array.unsafe_set(Index, Elem, !Array),
+        !:Array = generate_2(Index + 1, Size, GenFunc, !.Array)
+    else
+        true
+    ).
+
+generate_foldl(Size, GenPred, Array, !Acc) :-
+    compare(Result, Size, 0),
+    (
+        Result = (<),
+        unexpected($pred, "negative size")
+    ;
+        Result = (=),
+        make_empty_array(Array)
+    ;
+        Result = (>),
+        GenPred(0, FirstElem, !Acc),
+        Array0 = unsafe_init(Size, FirstElem, 0),
+        generate_foldl_2(1, Size, GenPred, Array0, Array, !Acc)
+    ).
+
+:- pred generate_foldl_2(int, int, pred(int, T, A, A),
+    array(T), array(T), A, A).
+:- mode generate_foldl_2(in, in, in(pred(in, out, in, out) is det),
+    array_di, array_uo, in, out) is det.
+:- mode generate_foldl_2(in, in, in(pred(in, out, mdi, muo) is det),
+    array_di, array_uo, mdi, muo) is det.
+:- mode generate_foldl_2(in, in, in(pred(in, out, di, uo) is det),
+    array_di, array_uo, di, uo) is det.
+:- mode generate_foldl_2(in, in, in(pred(in, out, in, out) is semidet),
+    array_di, array_uo, in, out) is semidet.
+:- mode generate_foldl_2(in, in, in(pred(in, out, mdi, muo) is semidet),
+    array_di, array_uo, mdi, muo) is semidet.
+:- mode generate_foldl_2(in, in, in(pred(in, out, di, uo) is semidet),
+    array_di, array_uo, di, uo) is semidet.
+
+generate_foldl_2(Index, Size, GenPred, !Array, !Acc) :-
+    ( if Index < Size then
+        GenPred(Index, Elem, !Acc),
+        array.unsafe_set(Index, Elem, !Array),
+        generate_foldl_2(Index + 1, Size, GenPred, !Array, !Acc)
+    else
+        true
+    ).
+
+%---------------------------------------------------------------------------%
+
+min(A) = N :-
+    array.min(A, N).
+
+:- pragma foreign_proc("C",
+    min(Array::in, Min::out),
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
+        does_not_affect_liveness, no_sharing],
+"
+    // Array not used.
+    Min = 0;
+").
+
+:- pragma foreign_proc("C#",
+    min(_Array::in, Min::out),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    // Array not used.
+    Min = 0;
+").
+
+
+:- pragma foreign_proc("Java",
+    min(_Array::in, Min::out),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    // Array not used.
+    Min = 0;
+").
+
+max(A) = N :-
+    array.max(A, N).
+
+:- pragma foreign_proc("C",
+    max(Array::in, Max::out),
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
+        does_not_affect_liveness, no_sharing],
+"
+    Max = Array->size - 1;
+").
+:- pragma foreign_proc("C#",
+    max(Array::in, Max::out),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    if (Array != null) {
+        Max = Array.Length - 1;
+    } else {
+        Max = -1;
+    }
+").
+
+:- pragma foreign_proc("Java",
+    max(Array::in, Max::out),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    if (Array != null) {
+        Max = array.ML_array_size(Array) - 1;
+    } else {
+        Max = -1;
+    }
+").
+
+bounds(Array, Min, Max) :-
+    array.min(Array, Min),
+    array.max(Array, Max).
+
+%---------------------------------------------------------------------------%
+
+size(A) = N :-
+    array.size(A, N).
+
+:- pragma foreign_proc("C",
+    size(Array::in, Max::out),
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
+        does_not_affect_liveness, no_sharing],
+"
+    Max = Array->size;
+").
+
+:- pragma foreign_proc("C#",
+    size(Array::in, Max::out),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    if (Array != null) {
+        Max = Array.Length;
+    } else {
+        Max = 0;
+    }
+").
+
+:- pragma foreign_proc("Java",
+    size(Array::in, Max::out),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    Max = jmercury.array.ML_array_size(Array);
+").
+
+%---------------------------------------------------------------------------%
+
+in_bounds(Array, Index) :-
+    array.bounds(Array, Min, Max),
+    Min =< Index, Index =< Max.
+
+is_empty(Array) :-
+    array.size(Array, 0).
+
+semidet_set(Index, Item, !Array) :-
+    ( if array.in_bounds(!.Array, Index) then
+        array.unsafe_set(Index, Item, !Array)
+    else
+        fail
+    ).
+
+semidet_slow_set(Index, Item, !Array) :-
+    ( if array.in_bounds(!.Array, Index) then
+        array.slow_set(Index, Item, !Array)
+    else
+        fail
+    ).
+
+slow_set(!.Array, N, X) = !:Array :-
+    array.slow_set(N, X, !Array).
+
+slow_set(Index, Item, !Array) :-
+    array.copy(!Array),
+    array.set(Index, Item, !Array).
+
+%---------------------------------------------------------------------------%
+
+elem(Index, Array) = array.lookup(Array, Index).
+
+unsafe_elem(Index, Array) = Elem :-
+    array.unsafe_lookup(Array, Index, Elem).
+
+lookup(Array, N) = X :-
+    array.lookup(Array, N, X).
+
+lookup(Array, Index, Item) :-
+    ( if
+        bounds_checks,
+        not array.in_bounds(Array, Index)
+    then
+        out_of_bounds_error(Array, Index, "array.lookup")
+    else
+        array.unsafe_lookup(Array, Index, Item)
+    ).
+
+semidet_lookup(Array, Index, Item) :-
+    ( if array.in_bounds(Array, Index) then
+        array.unsafe_lookup(Array, Index, Item)
+    else
+        fail
+    ).
+
+:- pragma foreign_proc("C",
+    unsafe_lookup(Array::in, Index::in, Item::out),
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
+        does_not_affect_liveness,
+        sharing(yes(array(T), int, T), [
+            cel(Array, [T]) - cel(Item, [])
+        ])
+    ],
+"
+    Item = Array->elements[Index];
+").
+
+:- pragma foreign_proc("C#",
+    unsafe_lookup(Array::in, Index::in, Item::out),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"{
+    Item = Array.GetValue(Index);
+}").
+
+:- pragma foreign_proc("Java",
+    unsafe_lookup(Array::in, Index::in, Item::out),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    if (Array instanceof int[]) {
+        Item = ((int[]) Array)[Index];
+    } else if (Array instanceof double[]) {
+        Item = ((double[]) Array)[Index];
+    } else if (Array instanceof char[]) {
+        Item = ((char[]) Array)[Index];
+    } else if (Array instanceof boolean[]) {
+        Item = ((boolean[]) Array)[Index];
+    } else if (Array instanceof byte[]) {
+        Item = ((byte[]) Array)[Index];
+    } else if (Array instanceof short[]) {
+        Item = ((short[]) Array)[Index];
+    } else if (Array instanceof long[]) {
+        Item = ((long[]) Array)[Index];
+    } else if (Array instanceof float[]) {
+        Item = ((float[]) Array)[Index];
+    } else {
+        Item = ((Object[]) Array)[Index];
+    }
+").
+
+%---------------------------------------------------------------------------%
+
+'elem :='(Index, Array, Value) = array.set(Array, Index, Value).
+
+set(A1, N, X) = A2 :-
+    array.set(N, X, A1, A2).
+
+set(Index, Item, !Array) :-
+    ( if
+        bounds_checks,
+        not array.in_bounds(!.Array, Index)
+    then
+        out_of_bounds_error(!.Array, Index, "array.set")
+    else
+        array.unsafe_set(Index, Item, !Array)
+    ).
+
+'unsafe_elem :='(Index, !.Array, Value) = !:Array :-
+    array.unsafe_set(Index, Value, !Array).
+
+:- pragma foreign_proc("C",
+    unsafe_set(Index::in, Item::in, Array0::array_di, Array::array_uo),
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
+        does_not_affect_liveness,
+        sharing(yes(int, T, array(T), array(T)), [
+            cel(Array0, []) - cel(Array, []),
+            cel(Item, [])   - cel(Array, [T])
+        ])
+    ],
+"
+    Array0->elements[Index] = Item; // destructive update!
+    Array = Array0;
+").
+
+:- pragma foreign_proc("C#",
+    unsafe_set(Index::in, Item::in, Array0::array_di, Array::array_uo),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"{
+    Array0.SetValue(Item, Index);   // destructive update!
+    Array = Array0;
+}").
+
+:- pragma foreign_proc("Java",
+    unsafe_set(Index::in, Item::in, Array0::array_di, Array::array_uo),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    if (Array0 instanceof int[]) {
+        ((int[]) Array0)[Index] = (Integer) Item;
+    } else if (Array0 instanceof double[]) {
+        ((double[]) Array0)[Index] = (Double) Item;
+    } else if (Array0 instanceof char[]) {
+        ((char[]) Array0)[Index] = (Character) Item;
+    } else if (Array0 instanceof boolean[]) {
+        ((boolean[]) Array0)[Index] = (Boolean) Item;
+    } else if (Array0 instanceof byte[]) {
+        ((byte[]) Array0)[Index] = (Byte) Item;
+    } else if (Array0 instanceof short[]) {
+        ((short[]) Array0)[Index] = (Short) Item;
+    } else if (Array0 instanceof long[]) {
+        ((long[]) Array0)[Index] = (Long) Item;
+    } else if (Array0 instanceof float[]) {
+        ((float[]) Array0)[Index] = (Float) Item;
+    } else {
+        ((Object[]) Array0)[Index] = Item;
+    }
+    Array = Array0;         // destructive update!
+").
+
+%---------------------------------------------------------------------------%
+
+% lower bounds other than zero are not supported
+%     % array.resize takes an array and new lower and upper bounds.
+%     % the array is expanded or shrunk at each end to make it fit
+%     % the new bounds.
+% :- pred array.resize(array(T), int, int, array(T)).
+% :- mode array.resize(in, in, in, out) is det.
+
+:- pragma foreign_decl("C", "
+extern void
+ML_resize_array(MR_ArrayPtr new_array, MR_ArrayPtr old_array,
+    MR_Integer array_size, MR_Word item);
+").
+
+:- pragma foreign_code("C", "
+// The caller is responsible for allocating the storage for the new array.
+// This routine does the job of copying the old array elements to the
+// new array, initializing any additional elements in the new array,
+// and deallocating the old array.
+void
+ML_resize_array(MR_ArrayPtr array, MR_ArrayPtr old_array,
+    MR_Integer array_size, MR_Word item)
+{
+    MR_Integer i;
+    MR_Integer elements_to_copy;
+
+    elements_to_copy = old_array->size;
+    if (elements_to_copy > array_size) {
+        elements_to_copy = array_size;
+    }
+
+    array->size = array_size;
+    for (i = 0; i < elements_to_copy; i++) {
+        array->elements[i] = old_array->elements[i];
+    }
+    for (; i < array_size; i++) {
+        array->elements[i] = item;
+    }
+
+    // Since the mode on the old array is `array_di', it is safe to
+    // deallocate the storage for it.
+#ifdef MR_CONSERVATIVE_GC
+    MR_GC_free_attrib(old_array);
+#endif
+}
+").
+
+resize(!.Array, N, X) = !:Array :-
+    array.resize(N, X, !Array).
+
+resize(N, X, !Array) :-
+    ( if N  < 0 then
+        unexpected($pred, "cannot resize to a negative size")
+    else
+        do_resize(N, X, !Array)
+    ).
+
+:- pred do_resize(int, T, array(T), array(T)).
+:- mode do_resize(in, in, array_di, array_uo) is det.
+
+:- pragma foreign_proc("C",
+    do_resize(Size::in, Item::in, Array0::array_di, Array::array_uo),
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
+        does_not_affect_liveness,
+        sharing(yes(int, T, array(T), array(T)), [
+            cel(Array0, []) - cel(Array, []),
+            cel(Item, [])   - cel(Array, [T])
+        ])
+    ],
+"
+    if ((Array0)->size == Size) {
+        Array = Array0;
+    } else {
+        ML_alloc_array(Array, Size + 1, MR_ALLOC_ID);
+        ML_resize_array(Array, Array0, Size, Item);
+    }
+").
+
+:- pragma foreign_proc("C#",
+    do_resize(Size::in, Item::in, Array0::array_di, Array::array_uo),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    Array = array.ML_array_resize(Array0, Size, Item);
+").
+
+:- pragma foreign_proc("Java",
+    do_resize(Size::in, Item::in, Array0::array_di, Array::array_uo),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    Array = jmercury.array.ML_array_resize(Array0, Size, Item);
+").
+
+%---------------------------------------------------------------------------%
+
+:- pragma foreign_decl("C", "
+extern void
+ML_shrink_array(MR_ArrayPtr array, MR_ArrayPtr old_array,
+    MR_Integer array_size);
+").
+
+:- pragma foreign_code("C", "
+// The caller is responsible for allocating the storage for the new array.
+// This routine does the job of copying the old array elements to the
+// new array and deallocating the old array.
+void
+ML_shrink_array(MR_ArrayPtr array, MR_ArrayPtr old_array,
+    MR_Integer array_size)
+{
+    MR_Integer i;
+
+    array->size = array_size;
+    for (i = 0; i < array_size; i++) {
+        array->elements[i] = old_array->elements[i];
+    }
+
+    // Since the mode on the old array is `array_di', it is safe to
+    // deallocate the storage for it.
+#ifdef MR_CONSERVATIVE_GC
+    MR_GC_free_attrib(old_array);
+#endif
+}
+").
+
+shrink(!.Array, N) = !:Array :-
+    array.shrink(N, !Array).
+
+shrink(Size, !Array) :-
+    OldSize = array.size(!.Array),
+    ( if Size < 0 then
+        unexpected($pred, "cannot shrink to a negative size")
+    else if Size > OldSize then
+        unexpected($pred, "cannot shrink to a larger size")
+    else if Size = OldSize then
+        true
+    else
+        array.shrink_2(Size, !Array)
+    ).
+
+:- pred shrink_2(int::in, array(T)::array_di, array(T)::array_uo) is det.
+
+:- pragma foreign_proc("C",
+    shrink_2(Size::in, Array0::array_di, Array::array_uo),
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
+        does_not_affect_liveness,
+        sharing(yes(int, array(T), array(T)), [
+            cel(Array0, []) - cel(Array, [])
+        ])
+    ],
+"
+    ML_alloc_array(Array, Size + 1, MR_ALLOC_ID);
+    ML_shrink_array(Array, Array0, Size);
+").
+
+:- pragma foreign_proc("C#",
+    shrink_2(Size::in, Array0::array_di, Array::array_uo),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    Array = array.ML_shrink_array(Array0, Size);
+").
+
+:- pragma foreign_proc("Java",
+    shrink_2(Size::in, Array0::array_di, Array::array_uo),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    if (Array0 == null) {
+        Array = null;
+    } else if (Array0 instanceof int[]) {
+        Array = new int[Size];
+    } else if (Array0 instanceof double[]) {
+        Array = new double[Size];
+    } else if (Array0 instanceof byte[]) {
+        Array = new byte[Size];
+    } else if (Array0 instanceof short[]) {
+        Array = new short[Size];
+    } else if (Array0 instanceof long[]) {
+        Array = new long[Size];
+    } else if (Array0 instanceof char[]) {
+        Array = new char[Size];
+    } else if (Array0 instanceof float[]) {
+        Array = new float[Size];
+    } else if (Array0 instanceof boolean[]) {
+        Array = new boolean[Size];
+    } else {
+        Array = new Object[Size];
+    }
+
+    if (Array != null) {
+        System.arraycopy(Array0, 0, Array, 0, Size);
+    }
+").
+
+%---------------------------------------------------------------------------%
+
+fill(Item, !Array) :-
+    array.bounds(!.Array, Min, Max),
+    do_fill_range(Item, Min, Max, !Array).
+
+fill_range(Item, Lo, Hi, !Array) :-
+    ( if Lo > Hi then
+        unexpected($pred, "empty range")
+    else if not in_bounds(!.Array, Lo) then
+        arg_out_of_bounds_error(!.Array, "second", "fill_range", Lo)
+    else if not in_bounds(!.Array, Hi) then
+        arg_out_of_bounds_error(!.Array, "third", "fill_range", Hi)
+    else
+        do_fill_range(Item, Lo, Hi, !Array)
+    ).
+
+%---------------------------------------------------------------------------%
+
+:- pred do_fill_range(T::in, int::in, int::in,
+     array(T)::array_di, array(T)::array_uo) is det.
+
+:- pragma foreign_proc("Java",
+    do_fill_range(Item::in, Lo::in, Hi::in,
+        Array0::array_di, Array::array_uo),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    Array = jmercury.array.ML_array_fill(Array0, Lo, Hi + 1, Item);
+").
+
+do_fill_range(Item, Lo, Hi, !Array) :-
+    ( if Lo =< Hi then
+        array.unsafe_set(Lo, Item, !Array),
+        do_fill_range(Item, Lo + 1, Hi, !Array)
+    else
+        true
+    ).
+
+%---------------------------------------------------------------------------%
+
+:- pragma foreign_decl("C", "
+extern void
+ML_copy_array(MR_ArrayPtr array, MR_ConstArrayPtr old_array);
+").
+
+:- pragma foreign_code("C", "
+// The caller is responsible for allocating the storage for the new array.
+// This routine does the job of copying the array elements.
+void
+ML_copy_array(MR_ArrayPtr array, MR_ConstArrayPtr old_array)
+{
+    // Any changes to this function will probably also require changes to
+    // - array.append below, and
+    // - MR_deep_copy() in runtime/mercury_deep_copy.[ch].
+
+    MR_Integer i;
+    MR_Integer array_size;
+
+    array_size = old_array->size;
+    array->size = array_size;
+    for (i = 0; i < array_size; i++) {
+        array->elements[i] = old_array->elements[i];
+    }
+}
+").
+
+copy(A1) = A2 :-
+    array.copy(A1, A2).
+
+:- pragma foreign_proc("C",
+    copy(Array0::in, Array::array_uo),
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
+        does_not_affect_liveness,
+        sharing(yes(array(T), array(T)), [
+            cel(Array0, [T]) - cel(Array, [T])
+        ])
+    ],
+"
+    ML_alloc_array(Array, Array0->size + 1, MR_ALLOC_ID);
+    ML_copy_array(Array, (MR_ConstArrayPtr) Array0);
+").
+
+:- pragma foreign_proc("C#",
+    copy(Array0::in, Array::array_uo),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    Array = (System.Array) Array0.Clone();
+").
+
+:- pragma foreign_proc("Java",
+    copy(Array0::in, Array::array_uo),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    int Size;
+
+    if (Array0 == null) {
+        Array = null;
+        Size = 0;
+    } else if (Array0 instanceof int[]) {
+        Size = ((int[]) Array0).length;
+        Array = new int[Size];
+    } else if (Array0 instanceof double[]) {
+        Size = ((double[]) Array0).length;
+        Array = new double[Size];
+    } else if (Array0 instanceof byte[]) {
+        Size = ((byte[]) Array0).length;
+        Array = new byte[Size];
+    } else if (Array0 instanceof short[]) {
+        Size = ((short[]) Array0).length;
+        Array = new short[Size];
+    } else if (Array0 instanceof long[]) {
+        Size = ((long[]) Array0).length;
+        Array = new long[Size];
+    } else if (Array0 instanceof char[]) {
+        Size = ((char[]) Array0).length;
+        Array = new char[Size];
+    } else if (Array0 instanceof float[]) {
+        Size = ((float[]) Array0).length;
+        Array = new float[Size];
+    } else if (Array0 instanceof boolean[]) {
+        Size = ((boolean[]) Array0).length;
+        Array = new boolean[Size];
+    } else {
+        Size = ((Object[]) Array0).length;
+        Array = new Object[Size];
+    }
+
+    if (Array != null) {
+        System.arraycopy(Array0, 0, Array, 0, Size);
+    }
+").
+
+%---------------------------------------------------------------------------%
+
+array(List) = Array :-
+    array.from_list(List, Array).
+
+from_list(List) = Array :-
+    array.from_list(List, Array).
+
+from_list([], Array) :-
+    array.make_empty_array(Array).
+from_list(List, Array) :-
+    List = [Head | Tail],
+    list.length(List, Len),
+    Array0 = array.unsafe_init(Len, Head, 0),
+    array.unsafe_insert_items(Tail, 1, Array0, Array).
+
+%---------------------------------------------------------------------------%
+
+:- pred unsafe_insert_items(list(T)::in, int::in,
+    array(T)::array_di, array(T)::array_uo) is det.
+
+unsafe_insert_items([], _N, !Array).
+unsafe_insert_items([Head | Tail], N, !Array) :-
+    unsafe_set(N, Head, !Array),
+    unsafe_insert_items(Tail, N + 1, !Array).
+
+%---------------------------------------------------------------------------%
+
+from_reverse_list([]) = Array :-
+    array.make_empty_array(Array).
+from_reverse_list(RevList) = Array :-
+    RevList = [Head | Tail],
+    list.length(RevList, Len),
+    Array0 = array.unsafe_init(Len, Head, Len - 1),
+    unsafe_insert_items_reverse(Tail, Len - 2, Array0, Array).
+
+:- pred unsafe_insert_items_reverse(list(T)::in, int::in,
+    array(T)::array_di, array(T)::array_uo) is det.
+
+unsafe_insert_items_reverse([], _, !Array).
+unsafe_insert_items_reverse([Head | Tail], N, !Array) :-
+    unsafe_set(N, Head, !Array),
+    unsafe_insert_items_reverse(Tail, N - 1, !Array).
+
+%---------------------------------------------------------------------------%
+
+to_list(Array) = List :-
+    to_list(Array, List).
+
+to_list(Array, List) :-
+    ( if is_empty(Array) then
+        List = []
+    else
+        bounds(Array, Low, High),
+        fetch_items(Array, Low, High, List)
+    ).
+
+%---------------------------------------------------------------------------%
+
+fetch_items(Array, Low, High) = List :-
+    fetch_items(Array, Low, High, List).
+
+fetch_items(Array, Low, High, List) :-
+    ( if High < Low then
+        % If High is less than Low, then there cannot be any array indexes
+        % within the range Low -> High (inclusive). This can happen when
+        % calling to_list/2 on the empty array, or when iterative over
+        % consecutive contiguous regions of an array. (For an example of
+        % the latter, see ip_get_goals_{before,after} and their callers
+        % in the deep_profiler directory.)
+        List = []
+    else if not in_bounds(Array, Low) then
+        arg_out_of_bounds_error(Array, "second", "fetch_items", Low)
+    else if not in_bounds(Array, High) then
+        arg_out_of_bounds_error(Array, "third", "fetch_items", High)
+    else
+        List = do_foldr_func(func(X, Xs) = [X | Xs], Array, [], Low, High)
+    ).
+
+%---------------------------------------------------------------------------%
+
+map(F, A1) = A2 :-
+    P = (pred(X::in, Y::out) is det :- Y = F(X)),
+    array.map(P, A1, A2).
+
+map(Closure, OldArray, NewArray) :-
+    ( if array.semidet_lookup(OldArray, 0, Elem0) then
+        array.size(OldArray, Size),
+        Closure(Elem0, Elem),
+        NewArray0 = unsafe_init(Size, Elem, 0),
+        array.map_2(1, Size, Closure, OldArray, NewArray0, NewArray)
+    else
+        array.make_empty_array(NewArray)
+    ).
+
+:- pred map_2(int::in, int::in, pred(T1, T2)::in(pred(in, out) is det),
+    array(T1)::in, array(T2)::array_di, array(T2)::array_uo) is det.
+
+map_2(N, Size, Closure, OldArray, !NewArray) :-
+    ( if N >= Size then
+        true
+    else
+        array.unsafe_lookup(OldArray, N, OldElem),
+        Closure(OldElem, NewElem),
+        array.unsafe_set(N, NewElem, !NewArray),
+        map_2(N + 1, Size, Closure, OldArray, !NewArray)
+    ).
+
+%---------------------------------------------------------------------------%
+
+swap(I, J, !Array) :-
+    ( if not in_bounds(!.Array, I) then
+        arg_out_of_bounds_error(!.Array, "first", "array.swap", I)
+    else if not in_bounds(!.Array, J) then
+        arg_out_of_bounds_error(!.Array, "second", "array.swap", J)
+    else
+        unsafe_swap(I, J, !Array)
+    ).
+
+unsafe_swap(I, J, !Array) :-
+    array.unsafe_lookup(!.Array, I, IVal),
+    array.unsafe_lookup(!.Array, J, JVal),
+    array.unsafe_set(I, JVal, !Array),
+    array.unsafe_set(J, IVal, !Array).
+
+%---------------------------------------------------------------------------%
+
+member(A, X) :-
+    nondet_int_in_range(array.min(A), array.max(A), N),
+    array.unsafe_lookup(A, N, X).
+
+%---------------------------------------------------------------------------%
+
+    % array.sort/1 has type specialised versions for arrays of ints and strings
+    % on the expectation that these constitute the common case and are hence
+    % worth providing a fast-path.
+    %
+    % Experiments indicate that type specialisation improves the speed of
+    % array.sort/1 by about 30-40%.
+    %
+:- pragma type_spec(array.sort/1, T = int).
+:- pragma type_spec(array.sort/1, T = string).
+
+sort(A) = samsort_subarray(A, array.min(A), array.max(A)).
+
+:- pragma no_inline(array.sort_fix_2014/0).
+
+sort_fix_2014.
+
+%---------------------------------------------------------------------------%
+
+binary_search(A, SearchX, I) :-
+    array.binary_search(ordering, A, SearchX, I).
+
+binary_search(Cmp, A, SearchX, I) :-
+    Lo = 0,
+    Hi = array.size(A) - 1,
+    binary_search_loop(Cmp, A, SearchX, Lo, Hi, I).
+
+:- pred binary_search_loop(comparison_func(T)::in, array(T)::array_ui,
+    T::in, int::in, int::in, int::out) is semidet.
+
+binary_search_loop(Cmp, A, SearchX, Lo, Hi, I) :-
+    % loop invariant: if SearchX is anywhere in A[0] .. A[array.size(A)-1],
+    % then it is in A[Lo] .. A[Hi].
+    Lo =< Hi,
+    % We calculate Mid this way to avoid overflow.
+    % The right shift by one bit is a fast implementation of division by 2.
+    Mid = Lo + ((Hi - Lo) `unchecked_right_shift` 1),
+    array.unsafe_lookup(A, Mid, MidX),
+    O = Cmp(MidX, SearchX),
+    (
+        O = (>),
+        binary_search_loop(Cmp, A, SearchX, Lo, Mid - 1, I)
+    ;
+        O = (=),
+        I = Mid
+    ;
+        O = (<),
+        binary_search_loop(Cmp, A, SearchX, Mid + 1, Hi, I)
+    ).
+
+%---------------------------------------------------------------------------%
+
+approx_binary_search(A, SearchX, I) :-
+    approx_binary_search(ordering, A, SearchX, I).
+
+approx_binary_search(Cmp, A, SearchX, I) :-
+    Lo = 0,
+    Hi = array.size(A) - 1,
+    approx_binary_search_loop(Cmp, A, SearchX, Lo, Hi, I).
+
+:- pred approx_binary_search_loop(comparison_func(T)::in, array(T)::array_ui,
+    T::in, int::in, int::in, int::out) is semidet.
+
+approx_binary_search_loop(Cmp, A, SearchX, Lo, Hi, I) :-
+    % loop invariant: if SearchX is anywhere in A[0] .. A[array.size(A)-1],
+    % then it is in A[Lo] .. A[Hi].
+    Lo =< Hi,
+    % We calculate Mid this way to avoid overflow.
+    % The right shift by one bit is a fast implementation of division by 2.
+    Mid = Lo + ((Hi - Lo) `unchecked_right_shift` 1),
+    array.unsafe_lookup(A, Mid, MidX),
+    O = Cmp(MidX, SearchX),
+    (
+        O = (>),
+        approx_binary_search_loop(Cmp, A, SearchX, Lo, Mid - 1, I)
+    ;
+        O = (=),
+        I = Mid
+    ;
+        O = (<),
+        ( if
+            ( if Mid < Hi then
+                % We get here only if Mid + 1 cannot exceed Hi,
+                % so the array access is safe.
+                array.unsafe_lookup(A, Mid + 1, MidP1X),
+                (<) = Cmp(SearchX, MidP1X)
+            else
+                Mid = Hi
+            )
+        then
+            I = Mid
+        else
+            approx_binary_search_loop(Cmp, A, SearchX, Mid + 1, Hi, I)
+        )
+    ).
+
+%---------------------------------------------------------------------------%
+
+append(A, B) = C :-
+    SizeA = array.size(A),
+    SizeB = array.size(B),
+    SizeC = SizeA + SizeB,
+    ( if
+        ( if SizeA > 0 then
+            array.lookup(A, 0, InitElem)
+        else if SizeB > 0 then
+            array.lookup(B, 0, InitElem)
+        else
+            fail
+        )
+    then
+        C0 = array.init(SizeC, InitElem),
+        copy_subarray(A, 0, SizeA - 1, 0, C0, C1),
+        copy_subarray(B, 0, SizeB - 1, SizeA, C1, C)
+    else
+        C = array.make_empty_array
+    ).
+
+:- pragma foreign_proc("C",
+    append(ArrayA::in, ArrayB::in) = (ArrayC::array_uo),
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
+        does_not_affect_liveness,
+        sharing(yes(array(T), array(T), array(T)), [
+            cel(ArrayA, [T]) - cel(ArrayC, [T]),
+            cel(ArrayB, [T]) - cel(ArrayC, [T])
+        ])
+    ],
+"
+    MR_Integer sizeC;
+    MR_Integer i;
+    MR_Integer offset;
+
+    sizeC = ArrayA->size + ArrayB->size;
+    ML_alloc_array(ArrayC, sizeC + 1, MR_ALLOC_ID);
+
+    ArrayC->size = sizeC;
+    for (i = 0; i < ArrayA->size; i++) {
+        ArrayC->elements[i] = ArrayA->elements[i];
+    }
+
+    offset = ArrayA->size;
+    for (i = 0; i < ArrayB->size; i++) {
+        ArrayC->elements[offset + i] = ArrayB->elements[i];
+    }
+").
+
+%---------------------------------------------------------------------------%
+
+random_permutation(A0, A, RS0, RS) :-
+    Lo = array.min(A0),
+    Hi = array.max(A0),
+    Sz = array.size(A0),
+    permutation_2(Lo, Lo, Hi, Sz, A0, A, RS0, RS).
+
+:- pred permutation_2(int::in, int::in, int::in, int::in,
+    array(T)::array_di, array(T)::array_uo,
+    random.supply::mdi, random.supply::muo) is det.
+
+permutation_2(I, Lo, Hi, Sz, !A, !RS) :-
+    ( if I > Hi then
+        true
+    else
+        random.random(R, !RS),
+        J  = Lo + (R `rem` Sz),
+        swap_elems(I, J, !A),
+        permutation_2(I + 1, Lo, Hi, Sz, !A, !RS)
+    ).
+
+:- pred swap_elems(int::in, int::in, array(T)::array_di, array(T)::array_uo)
+    is det.
+
+swap_elems(I, J, !A) :-
+    array.lookup(!.A, I, XI),
+    array.lookup(!.A, J, XJ),
+    array.unsafe_set(I, XJ, !A),
+    array.unsafe_set(J, XI, !A).
+
+%---------------------------------------------------------------------------%
+
+foldl(Fn, A, X) =
+    do_foldl_func(Fn, A, X, array.min(A), array.max(A)).
+
+:- func do_foldl_func(func(T1, T2) = T2, array(T1), T2, int, int) = T2.
+%:- mode do_foldl_func(func(in, in) = out is det, array_ui, in, in, in)
+%   = out is det.
+:- mode do_foldl_func(func(in, in) = out is det, in, in, in, in) = out is det.
+%:- mode do_foldl_func(func(in, di) = uo is det, array_ui, di, in, in)
+%   = uo is det.
+:- mode do_foldl_func(func(in, di) = uo is det, in, di, in, in) = uo is det.
+
+do_foldl_func(Fn, A, X, I, Max) =
+    ( if Max < I then
+        X
+    else
+        do_foldl_func(Fn, A, Fn(A ^ unsafe_elem(I), X), I + 1, Max)
+    ).
+
+%---------------------------------------------------------------------------%
+
+foldl(P, A, !Acc) :-
+    do_foldl_pred(P, A, array.min(A), array.max(A), !Acc).
+
+:- pred do_foldl_pred(pred(T1, T2, T2), array(T1), int, int, T2, T2).
+:- mode do_foldl_pred(pred(in, in, out) is det, in, in, in, in, out) is det.
+:- mode do_foldl_pred(pred(in, mdi, muo) is det, in, in, in, mdi, muo) is det.
+:- mode do_foldl_pred(pred(in, di, uo) is det, in, in, in, di, uo) is det.
+:- mode do_foldl_pred(pred(in, in, out) is semidet, in, in, in, in, out)
+    is semidet.
+:- mode do_foldl_pred(pred(in, mdi, muo) is semidet, in, in, in, mdi, muo)
+    is semidet.
+:- mode do_foldl_pred(pred(in, di, uo) is semidet, in, in, in, di, uo)
+    is semidet.
+
+do_foldl_pred(P, A, I, Max, !Acc) :-
+    ( if Max < I then
+        true
+    else
+        P(A ^ unsafe_elem(I), !Acc),
+        do_foldl_pred(P, A, I + 1, Max, !Acc)
+    ).
+
+%---------------------------------------------------------------------------%
+
+foldl2(P, A, !Acc1, !Acc2) :-
+    do_foldl2(P, array.min(A), array.max(A), A, !Acc1, !Acc2).
+
+:- pred do_foldl2(pred(T1, T2, T2, T3, T3), int, int, array(T1), T2, T2,
+    T3, T3).
+:- mode do_foldl2(pred(in, in, out, in, out) is det, in, in, in, in, out,
+    in, out) is det.
+:- mode do_foldl2(pred(in, in, out, mdi, muo) is det, in, in, in, in, out,
+    mdi, muo) is det.
+:- mode do_foldl2(pred(in, in, out, di, uo) is det, in, in, in, in, out,
+    di, uo) is det.
+:- mode do_foldl2(pred(in, in, out, in, out) is semidet, in, in, in, in, out,
+    in, out) is semidet.
+:- mode do_foldl2(pred(in, in, out, mdi, muo) is semidet, in, in, in, in, out,
+    mdi, muo) is semidet.
+:- mode do_foldl2(pred(in, in, out, di, uo) is semidet, in, in, in, in, out,
+    di, uo) is semidet.
+
+do_foldl2(P, I, Max, A, !Acc1, !Acc2) :-
+    ( if Max < I then
+        true
+    else
+        P(A ^ unsafe_elem(I), !Acc1, !Acc2),
+        do_foldl2(P, I + 1, Max, A, !Acc1, !Acc2)
+    ).
+
+%---------------------------------------------------------------------------%
+
+foldl3(P, A, !Acc1, !Acc2, !Acc3) :-
+    do_foldl3(P, array.min(A), array.max(A), A, !Acc1, !Acc2, !Acc3).
+
+:- pred do_foldl3(pred(T1, T2, T2, T3, T3, T4, T4), int, int, array(T1),
+    T2, T2, T3, T3, T4, T4).
+:- mode do_foldl3(pred(in, in, out, in, out, in, out) is det, in, in, in,
+    in, out, in, out, in, out) is det.
+:- mode do_foldl3(pred(in, in, out, in, out, mdi, muo) is det, in, in, in,
+    in, out, in, out, mdi, muo) is det.
+:- mode do_foldl3(pred(in, in, out, in, out, di, uo) is det, in, in, in,
+    in, out, in, out, di, uo) is det.
+:- mode do_foldl3(pred(in, in, out, in, out, in, out) is semidet, in, in, in,
+    in, out, in, out, in, out) is semidet.
+:- mode do_foldl3(pred(in, in, out, in, out, mdi, muo) is semidet, in, in, in,
+    in, out, in, out, mdi, muo) is semidet.
+:- mode do_foldl3(pred(in, in, out, in, out, di, uo) is semidet, in, in, in,
+    in, out, in, out, di, uo) is semidet.
+
+do_foldl3(P, I, Max, A, !Acc1, !Acc2, !Acc3) :-
+    ( if Max < I then
+        true
+    else
+        P(A ^ unsafe_elem(I), !Acc1, !Acc2, !Acc3),
+        do_foldl3(P, I + 1, Max, A, !Acc1, !Acc2, !Acc3)
+    ).
+
+%---------------------------------------------------------------------------%
+
+foldl4(P, A, !Acc1, !Acc2, !Acc3, !Acc4) :-
+    do_foldl4(P, array.min(A), array.max(A), A, !Acc1, !Acc2, !Acc3, !Acc4).
+
+:- pred do_foldl4(pred(T1, T2, T2, T3, T3, T4, T4, T5, T5), int, int,
+    array(T1), T2, T2, T3, T3, T4, T4, T5, T5).
+:- mode do_foldl4(pred(in, in, out, in, out, in, out, in, out) is det, in, in,
+    in, in, out, in, out, in, out, in, out) is det.
+:- mode do_foldl4(pred(in, in, out, in, out, in, out, mdi, muo) is det, in, in,
+    in, in, out, in, out, in, out, mdi, muo) is det.
+:- mode do_foldl4(pred(in, in, out, in, out, in, out, di, uo) is det, in, in,
+    in, in, out, in, out, in, out, di, uo) is det.
+:- mode do_foldl4(pred(in, in, out, in, out, in, out, in, out) is semidet,
+    in, in, in, in, out, in, out, in, out, in, out) is semidet.
+:- mode do_foldl4(pred(in, in, out, in, out, in, out, mdi, muo) is semidet,
+    in, in, in, in, out, in, out, in, out, mdi, muo) is semidet.
+:- mode do_foldl4(pred(in, in, out, in, out, in, out, di, uo) is semidet,
+    in, in, in, in, out, in, out, in, out, di, uo) is semidet.
+
+do_foldl4(P, I, Max, A, !Acc1, !Acc2, !Acc3, !Acc4) :-
+    ( if Max < I then
+        true
+    else
+        P(A ^ unsafe_elem(I), !Acc1, !Acc2, !Acc3, !Acc4),
+        do_foldl4(P, I + 1, Max, A, !Acc1, !Acc2, !Acc3, !Acc4)
+    ).
+
+%---------------------------------------------------------------------------%
+
+foldl5(P, A, !Acc1, !Acc2, !Acc3, !Acc4, !Acc5) :-
+    do_foldl5(P, array.min(A), array.max(A), A, !Acc1, !Acc2, !Acc3, !Acc4,
+        !Acc5).
+
+:- pred do_foldl5(pred(T1, T2, T2, T3, T3, T4, T4, T5, T5, T6, T6),
+    int, int, array(T1), T2, T2, T3, T3, T4, T4, T5, T5, T6, T6).
+:- mode do_foldl5(
+    pred(in, in, out, in, out, in, out, in, out, in, out) is det,
+    in, in, in, in, out, in, out, in, out, in, out, in, out) is det.
+:- mode do_foldl5(
+    pred(in, in, out, in, out, in, out, in, out, mdi, muo) is det,
+    in, in, in, in, out, in, out, in, out, in, out, mdi, muo) is det.
+:- mode do_foldl5(
+    pred(in, in, out, in, out, in, out, in, out, di, uo) is det,
+    in, in, in, in, out, in, out, in, out, in, out, di, uo) is det.
+:- mode do_foldl5(
+    pred(in, in, out, in, out, in, out, in, out, in, out) is semidet,
+    in, in, in, in, out, in, out, in, out, in, out, in, out) is semidet.
+:- mode do_foldl5(
+    pred(in, in, out, in, out, in, out, in, out, mdi, muo) is semidet,
+    in, in, in, in, out, in, out, in, out, in, out, mdi, muo) is semidet.
+:- mode do_foldl5(
+    pred(in, in, out, in, out, in, out, in, out, di, uo) is semidet,
+    in, in, in, in, out, in, out, in, out, in, out, di, uo) is semidet.
+
+do_foldl5(P, I, Max, A, !Acc1, !Acc2, !Acc3, !Acc4, !Acc5) :-
+    ( if Max < I then
+        true
+    else
+        P(A ^ unsafe_elem(I), !Acc1, !Acc2, !Acc3, !Acc4, !Acc5),
+        do_foldl5(P, I + 1, Max, A, !Acc1, !Acc2, !Acc3, !Acc4, !Acc5)
+    ).
+
+%---------------------------------------------------------------------------%
+
+foldr(Fn, A, X) =
+    do_foldr_func(Fn, A, X, array.min(A), array.max(A)).
+
+:- func do_foldr_func(func(T1, T2) = T2, array(T1), T2, int, int) = T2.
+%:- mode do_foldr_func(func(in, in) = out is det, array_ui, in, in, in)
+%   = out is det.
+:- mode do_foldr_func(func(in, in) = out is det, in, in, in, in) = out is det.
+%:- mode do_foldr_func(func(in, di) = uo is det, array_ui, di, in, in)
+%   = uo is det.
+:- mode do_foldr_func(func(in, di) = uo is det, in, di, in, in) = uo is det.
+
+do_foldr_func(Fn, A, X, Min, I) =
+    ( if I < Min then
+        X
+    else
+        do_foldr_func(Fn, A, Fn(A ^ unsafe_elem(I), X), Min, I - 1)
+    ).
+
+%---------------------------------------------------------------------------%
+
+foldr(P, A, !Acc) :-
+    do_foldr_pred(P, array.min(A), array.max(A), A, !Acc).
+
+:- pred do_foldr_pred(pred(T1, T2, T2), int, int, array(T1), T2, T2).
+:- mode do_foldr_pred(pred(in, in, out) is det, in, in, in, in, out) is det.
+:- mode do_foldr_pred(pred(in, mdi, muo) is det, in, in, in, mdi, muo) is det.
+:- mode do_foldr_pred(pred(in, di, uo) is det, in, in, in, di, uo) is det.
+:- mode do_foldr_pred(pred(in, in, out) is semidet, in, in, in, in, out)
+    is semidet.
+:- mode do_foldr_pred(pred(in, mdi, muo) is semidet, in, in, in, mdi, muo)
+    is semidet.
+:- mode do_foldr_pred(pred(in, di, uo) is semidet, in, in, in, di, uo)
+    is semidet.
+
+do_foldr_pred(P, Min, I, A, !Acc) :-
+    ( if I < Min then
+        true
+    else
+        P(A ^ unsafe_elem(I), !Acc),
+        do_foldr_pred(P, Min, I - 1, A, !Acc)
+    ).
+
+%---------------------------------------------------------------------------%
+
+foldr2(P, A, !Acc1, !Acc2) :-
+    do_foldr2(P, array.min(A), array.max(A), A, !Acc1, !Acc2).
+
+:- pred do_foldr2(pred(T1, T2, T2, T3, T3), int, int, array(T1), T2, T2,
+    T3, T3).
+:- mode do_foldr2(pred(in, in, out, in, out) is det, in, in, in, in, out,
+    in, out) is det.
+:- mode do_foldr2(pred(in, in, out, mdi, muo) is det, in, in, in, in, out,
+    mdi, muo) is det.
+:- mode do_foldr2(pred(in, in, out, di, uo) is det, in, in, in, in, out,
+    di, uo) is det.
+:- mode do_foldr2(pred(in, in, out, in, out) is semidet, in, in, in, in, out,
+    in, out) is semidet.
+:- mode do_foldr2(pred(in, in, out, mdi, muo) is semidet, in, in, in, in, out,
+    mdi, muo) is semidet.
+:- mode do_foldr2(pred(in, in, out, di, uo) is semidet, in, in, in, in, out,
+    di, uo) is semidet.
+
+do_foldr2(P, Min, I, A, !Acc1, !Acc2) :-
+    ( if I < Min then
+        true
+    else
+        P(A ^ unsafe_elem(I), !Acc1, !Acc2),
+        do_foldr2(P, Min, I - 1, A, !Acc1, !Acc2)
+    ).
+
+%---------------------------------------------------------------------------%
+
+foldr3(P, A, !Acc1, !Acc2, !Acc3) :-
+    do_foldr3(P, array.min(A), array.max(A), A, !Acc1, !Acc2, !Acc3).
+
+:- pred do_foldr3(pred(T1, T2, T2, T3, T3, T4, T4), int, int, array(T1),
+    T2, T2, T3, T3, T4, T4).
+:- mode do_foldr3(pred(in, in, out, in, out, in, out) is det, in, in, in,
+    in, out, in, out, in, out) is det.
+:- mode do_foldr3(pred(in, in, out, in, out, mdi, muo) is det, in, in, in,
+    in, out, in, out, mdi, muo) is det.
+:- mode do_foldr3(pred(in, in, out, in, out, di, uo) is det, in, in, in,
+    in, out, in, out, di, uo) is det.
+:- mode do_foldr3(pred(in, in, out, in, out, in, out) is semidet, in, in, in,
+    in, out, in, out, in, out) is semidet.
+:- mode do_foldr3(pred(in, in, out, in, out, mdi, muo) is semidet, in, in, in,
+    in, out, in, out, mdi, muo) is semidet.
+:- mode do_foldr3(pred(in, in, out, in, out, di, uo) is semidet, in, in, in,
+    in, out, in, out, di, uo) is semidet.
+
+do_foldr3(P, Min, I, A, !Acc1, !Acc2, !Acc3) :-
+    ( if I < Min then
+        true
+    else
+        P(A ^ unsafe_elem(I), !Acc1, !Acc2, !Acc3),
+        do_foldr3(P, Min, I - 1, A, !Acc1, !Acc2, !Acc3)
+    ).
+
+%---------------------------------------------------------------------------%
+
+foldr4(P, A, !Acc1, !Acc2, !Acc3, !Acc4) :-
+    do_foldr4(P, array.min(A), array.max(A), A, !Acc1, !Acc2, !Acc3, !Acc4).
+
+:- pred do_foldr4(pred(T1, T2, T2, T3, T3, T4, T4, T5, T5), int, int,
+    array(T1), T2, T2, T3, T3, T4, T4, T5, T5).
+:- mode do_foldr4(pred(in, in, out, in, out, in, out, in, out) is det, in, in,
+    in, in, out, in, out, in, out, in, out) is det.
+:- mode do_foldr4(pred(in, in, out, in, out, in, out, mdi, muo) is det, in, in,
+    in, in, out, in, out, in, out, mdi, muo) is det.
+:- mode do_foldr4(pred(in, in, out, in, out, in, out, di, uo) is det, in, in,
+    in, in, out, in, out, in, out, di, uo) is det.
+:- mode do_foldr4(pred(in, in, out, in, out, in, out, in, out) is semidet,
+    in, in, in, in, out, in, out, in, out, in, out) is semidet.
+:- mode do_foldr4(pred(in, in, out, in, out, in, out, mdi, muo) is semidet,
+    in, in, in, in, out, in, out, in, out, mdi, muo) is semidet.
+:- mode do_foldr4(pred(in, in, out, in, out, in, out, di, uo) is semidet,
+    in, in, in, in, out, in, out, in, out, di, uo) is semidet.
+
+do_foldr4(P, Min, I, A, !Acc1, !Acc2, !Acc3, !Acc4) :-
+    ( if I < Min then
+        true
+    else
+        P(A ^ unsafe_elem(I), !Acc1, !Acc2, !Acc3, !Acc4),
+        do_foldr4(P, Min, I - 1, A, !Acc1, !Acc2, !Acc3, !Acc4)
+    ).
+
+%---------------------------------------------------------------------------%
+
+foldr5(P, A, !Acc1, !Acc2, !Acc3, !Acc4, !Acc5) :-
+    do_foldr5(P, array.min(A), array.max(A), A, !Acc1, !Acc2, !Acc3, !Acc4,
+        !Acc5).
+
+:- pred do_foldr5(pred(T1, T2, T2, T3, T3, T4, T4, T5, T5, T6, T6),
+    int, int, array(T1), T2, T2, T3, T3, T4, T4, T5, T5, T6, T6).
+:- mode do_foldr5(
+    pred(in, in, out, in, out, in, out, in, out, in, out) is det,
+    in, in, in, in, out, in, out, in, out, in, out, in, out) is det.
+:- mode do_foldr5(
+    pred(in, in, out, in, out, in, out, in, out, mdi, muo) is det,
+    in, in, in, in, out, in, out, in, out, in, out, mdi, muo) is det.
+:- mode do_foldr5(
+    pred(in, in, out, in, out, in, out, in, out, di, uo) is det,
+    in, in, in, in, out, in, out, in, out, in, out, di, uo) is det.
+:- mode do_foldr5(
+    pred(in, in, out, in, out, in, out, in, out, in, out) is semidet,
+    in, in, in, in, out, in, out, in, out, in, out, in, out) is semidet.
+:- mode do_foldr5(
+    pred(in, in, out, in, out, in, out, in, out, mdi, muo) is semidet,
+    in, in, in, in, out, in, out, in, out, in, out, mdi, muo) is semidet.
+:- mode do_foldr5(
+    pred(in, in, out, in, out, in, out, in, out, di, uo) is semidet,
+    in, in, in, in, out, in, out, in, out, in, out, di, uo) is semidet.
+
+do_foldr5(P, Min, I, A, !Acc1, !Acc2, !Acc3, !Acc4, !Acc5) :-
+    ( if I < Min then
+        true
+    else
+        P(A ^ unsafe_elem(I), !Acc1, !Acc2, !Acc3, !Acc4, !Acc5),
+        do_foldr5(P, Min, I - 1, A, !Acc1, !Acc2, !Acc3, !Acc4, !Acc5)
+    ).
+
+%---------------------------------------------------------------------------%
+
+foldl_corresponding(P, A, B, !Acc) :-
+    MaxA = array.max(A),
+    MaxB = array.max(B),
+    ( if MaxA = MaxB then
+        do_foldl_corresponding(P, 0, MaxA, A, B, !Acc)
+    else
+        unexpected($pred, "mismatched array sizes")
+    ).
+
+:- pred do_foldl_corresponding(pred(T1, T2, T3, T3), int, int,
+    array(T1), array(T2), T3, T3).
+:- mode do_foldl_corresponding(in(pred(in, in, in, out) is det), in, in,
+    in, in, in, out) is det.
+:- mode do_foldl_corresponding(in(pred(in, in, mdi, muo) is det), in, in,
+    in, in, mdi, muo) is det.
+:- mode do_foldl_corresponding(in(pred(in, in, di, uo) is det), in, in,
+    in, in, di, uo) is det.
+:- mode do_foldl_corresponding(in(pred(in, in, in, out) is semidet), in, in,
+    in, in, in, out) is semidet.
+:- mode do_foldl_corresponding(in(pred(in, in, mdi, muo) is semidet), in, in,
+    in, in, mdi, muo) is semidet.
+:- mode do_foldl_corresponding(in(pred(in, in, di, uo) is semidet), in, in,
+    in, in, di, uo) is semidet.
+
+do_foldl_corresponding(P, I, Max, A, B, !Acc) :-
+    ( if Max < I then
+        true
+    else
+        P(A ^ unsafe_elem(I), B ^ unsafe_elem(I), !Acc),
+        do_foldl_corresponding(P, I + 1, Max, A, B, !Acc)
+    ).
+
+foldl2_corresponding(P, A, B, !Acc1, !Acc2) :-
+    MaxA = array.max(A),
+    MaxB = array.max(B),
+    ( if MaxA = MaxB then
+        do_foldl2_corresponding(P, 0, MaxA, A, B, !Acc1, !Acc2)
+    else
+        unexpected($pred, "mismatched array sizes")
+    ).
+
+:- pred do_foldl2_corresponding(pred(T1, T2, T3, T3, T4, T4), int, int,
+    array(T1), array(T2), T3, T3, T4, T4).
+:- mode do_foldl2_corresponding(in(pred(in, in, in, out, in, out) is det),
+    in, in, in, in, in, out, in, out) is det.
+:- mode do_foldl2_corresponding(in(pred(in, in, in, out, mdi, muo) is det),
+    in, in, in, in, in, out, mdi, muo) is det.
+:- mode do_foldl2_corresponding(in(pred(in, in, in, out, di, uo) is det),
+    in, in, in, in, in, out, di, uo) is det.
+:- mode do_foldl2_corresponding(in(pred(in, in, in, out, in, out) is semidet),
+    in, in, in, in, in, out, in, out) is semidet.
+:- mode do_foldl2_corresponding(in(pred(in, in, in, out, mdi, muo) is semidet),
+    in, in, in, in, in, out, mdi, muo) is semidet.
+:- mode do_foldl2_corresponding(in(pred(in, in, in, out, di, uo) is semidet),
+    in, in, in, in, in, out, di, uo) is semidet.
+
+do_foldl2_corresponding(P, I, Max, A, B, !Acc1, !Acc2) :-
+    ( if Max < I then
+        true
+    else
+        P(A ^ unsafe_elem(I), B ^ unsafe_elem(I), !Acc1, !Acc2),
+        do_foldl2_corresponding(P, I + 1, Max, A, B, !Acc1, !Acc2)
+    ).
+
+%---------------------------------------------------------------------------%
+
+map_foldl(P, A, B, !Acc) :-
+    N = array.size(A),
+    ( if N =< 0 then
+        B = array.make_empty_array
+    else
+        array.unsafe_lookup(A, 0, X),
+        P(X, Y, !Acc),
+        B1 = unsafe_init(N, Y, 0),
+        map_foldl_2(P, 1, A, B1, B, !Acc)
+    ).
+
+:- pred map_foldl_2(pred(T1, T2, T3, T3),
+    int, array(T1), array(T2), array(T2), T3, T3).
+:- mode map_foldl_2(in(pred(in, out, in, out) is det),
+    in, in, array_di, array_uo, in, out) is det.
+:- mode map_foldl_2(in(pred(in, out, mdi, muo) is det),
+    in, in, array_di, array_uo, mdi, muo) is det.
+:- mode map_foldl_2(in(pred(in, out, di, uo) is det),
+    in, in, array_di, array_uo, di, uo) is det.
+:- mode map_foldl_2(in(pred(in, out, in, out) is semidet),
+    in, in, array_di, array_uo, in, out) is semidet.
+
+map_foldl_2(P, I, A, !B, !Acc) :-
+    ( if I < array.size(A) then
+        array.unsafe_lookup(A, I, X),
+        P(X, Y, !Acc),
+        array.unsafe_set(I, Y, !B),
+        map_foldl_2(P, I + 1, A, !B, !Acc)
+    else
+        true
+    ).
+
+%---------------------------------------------------------------------------%
+
+map_corresponding_foldl(P, A, B, C, !Acc) :-
+    SizeA = array.size(A),
+    SizeB = array.size(B),
+    ( if SizeA \= SizeB then
+        unexpected($pred, "mismatched array sizes")
+    else if SizeA =< 0 then
+        C = array.make_empty_array
+    else
+        array.unsafe_lookup(A, 0, X),
+        array.unsafe_lookup(B, 0, Y),
+        P(X, Y, Z, !Acc),
+        C1 = unsafe_init(SizeA, Z, 0),
+        map_corresponding_foldl_2(P, 1, SizeA, A, B, C1, C, !Acc)
+    ).
+
+:- pred map_corresponding_foldl_2(pred(T1, T2, T3, T4, T4),
+    int, int, array(T1), array(T2), array(T3), array(T3), T4, T4).
+:- mode map_corresponding_foldl_2(
+    in(pred(in, in, out, in, out) is det),
+    in, in, in, in, array_di, array_uo, in, out) is det.
+:- mode map_corresponding_foldl_2(
+    in(pred(in, in, out, mdi, muo) is det),
+    in, in, in, in, array_di, array_uo, mdi, muo) is det.
+:- mode map_corresponding_foldl_2(
+    in(pred(in, in, out, di, uo) is det),
+    in, in, in, in, array_di, array_uo, di, uo) is det.
+:- mode map_corresponding_foldl_2(
+    in(pred(in, in, out, in, out) is semidet),
+    in, in, in, in, array_di, array_uo, in, out) is semidet.
+:- mode map_corresponding_foldl_2(
+    in(pred(in, in, out, mdi, muo) is semidet),
+    in, in, in, in, array_di, array_uo, mdi, muo) is semidet.
+:- mode map_corresponding_foldl_2(
+    in(pred(in, in, out, di, uo) is semidet),
+    in, in, in, in, array_di, array_uo, di, uo) is semidet.
+
+map_corresponding_foldl_2(P, I, N, A, B, !C, !Acc) :-
+    ( if I < N then
+        array.unsafe_lookup(A, I, X),
+        array.unsafe_lookup(B, I, Y),
+        P(X, Y, Z, !Acc),
+        array.unsafe_set(I, Z, !C),
+        map_corresponding_foldl_2(P, I + 1, N, A, B, !C, !Acc)
+    else
+        true
+    ).
+
+%---------------------------------------------------------------------------%
+
+all_true(Pred, Array) :-
+    do_all_true(Pred, array.min(Array), array.max(Array), Array).
+
+:- pred do_all_true(pred(T), int, int, array(T)).
+%:- mode do_all_true(in(pred(in) is semidet), in, in, array_ui) is semidet.
+:- mode do_all_true(in(pred(in) is semidet), in, in, in) is semidet.
+
+do_all_true(Pred, I, UB, Array) :-
+    ( if I =< UB then
+        array.unsafe_lookup(Array, I, Elem),
+        Pred(Elem),
+        do_all_true(Pred, I + 1, UB, Array)
+    else
+        true
+    ).
+
+all_false(Pred, Array) :-
+    do_all_false(Pred, array.min(Array), array.max(Array), Array).
+
+:- pred do_all_false(pred(T), int, int, array(T)).
+%:- mode do_all_false(in(pred(in) is semidet), in, in, array_ui) is semidet.
+:- mode do_all_false(in(pred(in) is semidet), in, in, in) is semidet.
+
+do_all_false(Pred, I, UB, Array) :-
+    ( if I =< UB then
+        array.unsafe_lookup(Array, I, Elem),
+        not Pred(Elem),
+        do_all_false(Pred, I + 1, UB, Array)
+    else
+        true
+    ).
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+    % SAMsort (smooth applicative merge) invented by R.A. O'Keefe.
+    %
+    % SAMsort is a mergesort variant that works by identifying contiguous
+    % monotonic sequences and merging them, thereby taking advantage of
+    % any existing order in the input sequence.
+    %
+:- func samsort_subarray(array(T)::array_di, int::in, int::in) =
+    (array(T)::array_uo) is det.
+
+:- pragma type_spec(samsort_subarray/3, T = int).
+:- pragma type_spec(samsort_subarray/3, T = string).
+
+samsort_subarray(A0, Lo, Hi) = A :-
+    samsort_up(0, array.copy(A0), A, A0, _, Lo, Hi, Lo).
+
+    % samsort_up(N, A0, A, B0, B, Lo, Hi, I):
+    %
+    % Precondition:
+    %   We are N levels from the bottom (leaf nodes) of the tree.
+    %   A0 is sorted from Lo .. I - 1.
+    %   A0 and B0 are identical from I .. Hi.
+    % Postcondition:
+    %   A is sorted from Lo .. Hi.
+    %
+:- pred samsort_up(int::in, array(T)::array_di, array(T)::array_uo,
+    array(T)::array_di, array(T)::array_uo, int::in, int::in, int::in) is det.
+
+:- pragma type_spec(samsort_up/8, T = int).
+:- pragma type_spec(samsort_up/8, T = string).
+
+samsort_up(N, A0, A, B0, B, Lo, Hi, I) :-
+    trace [compile_time(flag("array_sort"))] (
+        verify_sorted(A0, Lo, I - 1),
+        verify_identical(A0, B0, I, Hi)
+    ),
+    ( if I > Hi then
+        A = A0,
+        B = B0
+        % A is sorted from Lo .. Hi.
+    else if N > 0 then
+        % B0 and A0 are identical from I .. Hi.
+        samsort_down(N - 1, B0, B1, A0, A1, I, Hi, J),
+        % A1 is sorted from I .. J - 1.
+        % B1 and A1 are identical from J .. Hi.
+
+        merge_subarrays(A1, Lo, I - 1, I, J - 1, Lo, B1, B2),
+        A2 = A1,
+
+        % B2 is sorted from Lo .. J - 1.
+        % B2 and A2 are identical from J .. Hi.
+        samsort_up(N + 1, B2, B3, A2, A3, Lo, Hi, J),
+        % B3 is sorted from Lo .. Hi.
+
+        A = B3,
+        B = A3
+        % A is sorted from Lo .. Hi.
+    else
+        % N = 0, I = Lo
+        copy_run_ascending(A0, B0, B1, Lo, Hi, J),
+
+        % B1 is sorted from Lo .. J - 1.
+        % B1 and A0 are identical from J .. Hi.
+        samsort_up(N + 1, B1, B2, A0, A2, Lo, Hi, J),
+        % B2 is sorted from Lo .. Hi.
+
+        A = B2,
+        B = A2
+        % A is sorted from Lo .. Hi.
+    ),
+    trace [compile_time(flag("array_sort"))] (
+        verify_sorted(A, Lo, Hi)
+    ).
+
+    % samsort_down(N, A0, A, B0, B, Lo, Hi, I):
+    %
+    % Precondition:
+    %   We are N levels from the bottom (leaf nodes) of the tree.
+    %   A0 and B0 are identical from Lo .. Hi.
+    % Postcondition:
+    %   B is sorted from Lo .. I - 1.
+    %   A and B are identical from I .. Hi.
+    %
+:- pred samsort_down(int::in, array(T)::array_di, array(T)::array_uo,
+    array(T)::array_di, array(T)::array_uo, int::in, int::in, int::out) is det.
+
+:- pragma type_spec(samsort_down/8, T = int).
+:- pragma type_spec(samsort_down/8, T = string).
+
+samsort_down(N, A0, A, B0, B, Lo, Hi, I) :-
+    trace [compile_time(flag("array_sort"))] (
+        verify_identical(A0, B0, Lo, Hi)
+    ),
+    ( if Lo > Hi then
+        A = A0,
+        B = B0,
+        I = Lo
+        % B is sorted from Lo .. I - 1.
+    else if N > 0 then
+        samsort_down(N - 1, B0, B1, A0, A1, Lo, Hi, J),
+        samsort_down(N - 1, B1, B2, A1, A2, J,  Hi, I),
+        % A2 is sorted from Lo .. J - 1.
+        % A2 is sorted from J  .. I - 1.
+        A = A2,
+        merge_subarrays(A2, Lo, J - 1, J, I - 1, Lo, B2, B)
+        % B is sorted from Lo .. I - 1.
+    else
+        A = A0,
+        copy_run_ascending(A0, B0, B, Lo, Hi, I)
+        % B is sorted from Lo .. I - 1.
+    ),
+    trace [compile_time(flag("array_sort"))] (
+        verify_sorted(B, Lo, I - 1),
+        verify_identical(A, B, I, Hi)
+    ).
+
+:- pred verify_sorted(array(T)::array_ui, int::in, int::in) is det.
+
+verify_sorted(A, Lo, Hi) :-
+    ( if Lo >= Hi then
+        true
+    else if compare((<), A ^ elem(Lo + 1), A ^ elem(Lo)) then
+        unexpected($pred, "array range not sorted")
+    else
+        verify_sorted(A, Lo + 1, Hi)
+    ).
+
+:- pred verify_identical(array(T)::array_ui, array(T)::array_ui,
+    int::in, int::in) is det.
+
+verify_identical(A, B, Lo, Hi) :-
+    ( if Lo > Hi then
+        true
+    else if A ^ elem(Lo) = B ^ elem(Lo) then
+        verify_identical(A, B, Lo + 1, Hi)
+    else
+        unexpected($pred, "array ranges not identical")
+    ).
+
+%---------------------------------------------------------------------------%
+
+:- pred copy_run_ascending(array(T)::array_ui,
+    array(T)::array_di, array(T)::array_uo, int::in, int::in, int::out) is det.
+
+:- pragma type_spec(copy_run_ascending/6, T = int).
+:- pragma type_spec(copy_run_ascending/6, T = string).
+
+copy_run_ascending(A, !B, Lo, Hi, I) :-
+    ( if
+        Lo < Hi,
+        compare((>), A ^ elem(Lo), A ^ elem(Lo + 1))
+    then
+        I = search_until((<), A, Lo, Hi),
+        copy_subarray_reverse(A, Lo, I - 1, I - 1, !B)
+    else
+        I = search_until((>), A, Lo, Hi),
+        copy_subarray(A, Lo, I - 1, Lo, !B)
+    ).
+
+%---------------------------------------------------------------------------%
+
+:- func search_until(comparison_result::in, array(T)::array_ui,
+    int::in, int::in) = (int::out) is det.
+
+:- pragma type_spec(search_until/4, T = int).
+:- pragma type_spec(search_until/4, T = string).
+
+search_until(R, A, Lo, Hi) =
+    ( if
+        Lo < Hi,
+        not compare(R, A ^ elem(Lo), A ^ elem(Lo + 1))
+    then
+        search_until(R, A, Lo + 1, Hi)
+    else
+        Lo + 1
+    ).
+
+%---------------------------------------------------------------------------%
+
+    % Assigns the subarray A[Lo..Hi] to B[InitI..Final], where InitI
+    % is the initial value of I, and FinalI = InitI + (Ho - Lo + 1).
+    % In this version, I is ascending, so B[InitI] gets A[Lo]
+    %
+:- pred copy_subarray(array(T)::array_ui, int::in, int::in, int::in,
+    array(T)::array_di, array(T)::array_uo) is det.
+
+:- pragma type_spec(copy_subarray/6, T = int).
+:- pragma type_spec(copy_subarray/6, T = string).
+
+copy_subarray(A, Lo, Hi, I, !B) :-
+    ( if Lo =< Hi then
+        array.lookup(A, Lo, X),
+        % XXX Would it be safe to replace this with array.unsafe_set?
+        array.set(I, X, !B),
+        copy_subarray(A, Lo + 1, Hi, I + 1, !B)
+    else
+        true
+    ).
+
+    % Assigns the subarray A[Lo..Hi] to B[InitI..Final], where InitI
+    % is the initial value of I, and FinalI = InitI - (Ho - Lo + 1).
+    % In this version, I is descending, so B[InitI] gets A[Hi].
+    %
+:- pred copy_subarray_reverse(array(T)::array_ui, int::in, int::in, int::in,
+    array(T)::array_di, array(T)::array_uo) is det.
+
+:- pragma type_spec(copy_subarray_reverse/6, T = int).
+:- pragma type_spec(copy_subarray_reverse/6, T = string).
+
+copy_subarray_reverse(A, Lo, Hi, I, !B) :-
+    ( if Lo =< Hi then
+        array.lookup(A, Lo, X),
+        % XXX Would it be safe to replace this with array.unsafe_set?
+        array.set(I, X, !B),
+        copy_subarray_reverse(A, Lo + 1, Hi, I - 1, !B)
+    else
+        true
+    ).
+
+%---------------------------------------------------------------------------%
+
+    % merges the two sorted consecutive subarrays Lo1 .. Hi1 and Lo2 .. Hi2
+    % from A into the subarray starting at I in B.
+    %
+:- pred merge_subarrays(array(T)::array_ui,
+    int::in, int::in, int::in, int::in, int::in,
+    array(T)::array_di, array(T)::array_uo) is det.
+
+:- pragma type_spec(merge_subarrays/8, T = int).
+:- pragma type_spec(merge_subarrays/8, T = string).
+
+merge_subarrays(A, Lo1, Hi1, Lo2, Hi2, I, !B) :-
+    ( if Lo1 > Hi1 then
+        copy_subarray(A, Lo2, Hi2, I, !B)
+    else if Lo2 > Hi2 then
+        copy_subarray(A, Lo1, Hi1, I, !B)
+    else
+        array.lookup(A, Lo1, X1),
+        array.lookup(A, Lo2, X2),
+        compare(R, X1, X2),
+        (
+            R = (<),
+            array.set(I, X1, !B),
+            merge_subarrays(A, Lo1 + 1, Hi1, Lo2, Hi2, I + 1, !B)
+        ;
+            R = (=),
+            array.set(I, X1, !B),
+            merge_subarrays(A, Lo1 + 1, Hi1, Lo2, Hi2, I + 1, !B)
+        ;
+            R = (>),
+            array.set(I, X2, !B),
+            merge_subarrays(A, Lo1, Hi1, Lo2 + 1, Hi2, I + 1, !B)
+        )
+    ).
+
+%---------------------------------------------------------------------------%
+
+    % Throw an exception indicating an array bounds error.
+    %
+:- pred out_of_bounds_error(array(T), int, string).
+%:- mode out_of_bounds_error(array_ui, in, in) is erroneous.
+:- mode out_of_bounds_error(in, in, in) is erroneous.
+
+out_of_bounds_error(Array, Index, PredName) :-
+    % Note: we deliberately do not include the array element type name in the
+    % error message here, for performance reasons: using the type name could
+    % prevent the compiler from optimizing away the construction of the
+    % type_info in the caller, because it would prevent unused argument
+    % elimination. Performance is important here, because array.set and
+    % array.lookup are likely to be used in the inner loops of
+    % performance-critical applications.
+    array.bounds(Array, Min, Max),
+    string.format("%s: index %d not in range [%d, %d]",
+        [s(PredName), i(Index), i(Min), i(Max)], Msg),
+    throw(array.index_out_of_bounds(Msg)).
+
+    % Like the above, but for use in cases where the are multiple arguments
+    % that correspond to array indices.
+    %
+:- pred arg_out_of_bounds_error(array(T), string, string, int).
+:- mode arg_out_of_bounds_error(in, in, in, in) is erroneous.
+
+arg_out_of_bounds_error(Array, ArgPosn, PredName, Index) :-
+    array.bounds(Array, Min, Max),
+    string.format("%s argument of %s: index %d not in range [%d, %d]",
+        [s(ArgPosn), s(PredName), i(Index), i(Min), i(Max)], Msg),
+    throw(array.index_out_of_bounds(Msg)).
+
+%---------------------------------------------------------------------------%
+
+det_least_index(A) = Index :-
+    ( if array.is_empty(A) then
+        unexpected($pred, "empty array")
+    else
+        Index = array.min(A)
+    ).
+
+semidet_least_index(A) = Index :-
+    ( if array.is_empty(A) then
+        fail
+    else
+        Index = array.min(A)
+    ).
+
+%---------------------------------------------------------------------------%
+
+det_greatest_index(A) = Index :-
+    ( if array.is_empty(A) then
+        unexpected($pred, "empty array")
+    else
+        Index = array.max(A)
+    ).
+
+semidet_greatest_index(A) = Index :-
+    ( if array.is_empty(A) then
+        fail
+    else
+        Index = array.max(A)
+    ).
+
+%---------------------------------------------------------------------------%
+
+array_to_doc(A) =
+    indent([str("array(["), array_to_doc_2(0, A), str("])")]).
+
+:- func array_to_doc_2(int, array(T)) = doc.
+
+array_to_doc_2(I, A) =
+    ( if I > array.max(A) then
+        str("")
+    else
+        docs([
+            format_arg(format(A ^ elem(I))),
+            ( if I = array.max(A) then str("") else group([str(", "), nl]) ),
+            format_susp((func) = array_to_doc_2(I + 1, A))
+        ])
+    ).
+
+%---------------------------------------------------------------------------%
+
+dynamic_cast_to_array(X, A) :-
+    % If X is an array then it has a type with one type argument.
+    [ArgTypeDesc] = type_args(type_of(X)),
+
+    % Convert ArgTypeDesc to a type variable ArgType.
+    (_ `with_type` ArgType) `has_type` ArgTypeDesc,
+
+    % Constrain the type of A to be array(ArgType) and do the cast.
+    dynamic_cast(X, A `with_type` array(ArgType)).
+
+%---------------------------------------------------------------------------%
+:- end_module array.
+%---------------------------------------------------------------------------%
-- 
2.26.3


  reply	other threads:[~2021-03-29 11:53 UTC|newest]

Thread overview: 27+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
     [not found] <25b8baef-11f2-7079-69d8-3207a24658fc@gmail.com>
2021-03-26  7:09 ` bug#47408: Emacs etags support for Mercury [v0.2] fabrice nicol
2021-03-27 10:51   ` bug#47408: Etags support for Mercury [v0.3] fabrice nicol
2021-03-28 13:11     ` Eli Zaretskii
2021-03-28 15:49       ` fabrice nicol
2021-03-28 16:22         ` Eli Zaretskii
2021-03-29 11:53           ` fabrice nicol [this message]
     [not found]             ` <70503251-f8ea-9006-b7e7-b13b93bb71de@gmail.com>
2021-05-15  8:31               ` bug#47408: Fwd: bug#47408: Etags support for Mercury [v0.4] Eli Zaretskii
     [not found]                 ` <53162dfb-0715-3077-78d1-3a8340943f2f@gmail.com>
2021-05-29  8:01                   ` Eli Zaretskii
     [not found]                     ` <CANTSrJtDMu=4SWUcBRt51X8n42mOfB6_sFi8mNoZ0YgYdtE-DA@mail.gmail.com>
2021-05-29 10:22                       ` Eli Zaretskii
2021-06-01  2:38                     ` bug#47408: Etags support for Mercury [v0.5] fabrice nicol
2021-06-06  9:48                       ` Eli Zaretskii
2021-06-06 13:34                         ` fabrice nicol
2021-06-06 18:18                           ` Francesco Potortì
2021-06-06 20:49                             ` fabrice nicol
2021-06-06 21:04                               ` Francesco Potortì
2021-06-07 12:13                               ` Eli Zaretskii
2021-06-08  0:38                                 ` Fabrice Nicol
2021-06-08 10:53                                 ` Francesco Potortì
2021-06-08 11:47                                   ` Eli Zaretskii
2021-06-08 12:47                                     ` Francesco Potortì
2021-06-10 13:59                                       ` Eli Zaretskii
2021-06-10 16:52                                         ` fabrice nicol
2021-06-10 17:05                                           ` Francesco Potortì
2021-06-10 17:20                                           ` Eli Zaretskii
2021-06-10 19:15                                             ` Eli Zaretskii
2021-06-10 20:39                                             ` bug#47408: Etags support for Mercury -- fix explicit tags for existentially-quantified procedures fabrice nicol
2021-06-11  5:56                                               ` Eli Zaretskii

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=b59da901-4df7-843f-da03-5aa184d1a992@gmail.com \
    --to=fabrnicol@gmail.com \
    --cc=47408@debbugs.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).