unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: Eli Zaretskii <eliz@gnu.org>
To: fabrice nicol <fabrnicol@gmail.com>
Cc: 47408@debbugs.gnu.org
Subject: bug#47408: Fwd: bug#47408: Etags support for Mercury [v0.4]
Date: Sat, 15 May 2021 11:31:47 +0300	[thread overview]
Message-ID: <838s4gxurw.fsf@gnu.org> (raw)
In-Reply-To: <70503251-f8ea-9006-b7e7-b13b93bb71de@gmail.com> (message from fabrice nicol on Wed, 12 May 2021 18:35:43 +0200)

> From: fabrice nicol <fabrnicol@gmail.com>
> Date: Wed, 12 May 2021 18:35:43 +0200
> 
> Yes, I did post a patch with all your review comments complied with, or so I think, on March 29. 
> There is just one review comment of yours that I did not follow: upon closer examination, it is unnecessary
> and may be misleading to specify "Mercury-specific behavior for --no-defines". See below comments in my
> March 29 email. 
> Note that in this default case, etags support for Prolog works the same way, so there is no good reason to
> make a special case for Mercury.

I'm confused.  First, you originally said that this option had to do
something special for Mercury.  Moreover, the patch you sent now still
says:

  +** 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'.

So there still is some Mercury-specific behavior here.  What am I
missing?




> 
> Patch is file 0001-Add... .patch, joined again.
> 
> I hope this works.
> Best,
> Fabrice
> 
> Le mer. 12 mai 2021 à 5:47 PM, Eli Zaretskii <eliz@gnu.org> a écrit :
> > From: fabrice nicol <fabrnicol@gmail.com>
> > Date: Wed, 12 May 2021 17:16:56 +0200
> > 
> > All papers have been signed and approved by copyright clerks.
> > 
> > Do I have anything to do now, like issue a pull request in the git repository? Or just sit back and wait for the
> > procedure to unroll?
> 
> An updated patch with all the review comments taken care of would be
> nice.  I don't think we had such a patch before the paperwork started,
> did we?
> 
> -------- Message transféré -------- 
> 
>  Sujet :   bug#47408: Etags support for Mercury [v0.4]  
>  Date :   Mon, 29 Mar 2021 13:53:26 +0200  
>  De :   fabrice nicol <fabrnicol@gmail.com>  
>  Pour :   47408@debbugs.gnu.org  
> 
> 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 my 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.
> 
> [2:text/x-patch Hide Save:0001-Add-etags-support-for-Mercury-v0.4.patch (139kB)]
> 
> >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
> 
> 





  parent reply	other threads:[~2021-05-15  8:31 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           ` bug#47408: Etags support for Mercury [v0.4] fabrice nicol
     [not found]             ` <70503251-f8ea-9006-b7e7-b13b93bb71de@gmail.com>
2021-05-15  8:31               ` Eli Zaretskii [this message]
     [not found]                 ` <53162dfb-0715-3077-78d1-3a8340943f2f@gmail.com>
2021-05-29  8:01                   ` bug#47408: Fwd: " 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=838s4gxurw.fsf@gnu.org \
    --to=eliz@gnu.org \
    --cc=47408@debbugs.gnu.org \
    --cc=fabrnicol@gmail.com \
    /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).