Package: emacs;
Reported by: fabrice nicol <fabrnicol <at> gmail.com>
Date: Fri, 26 Mar 2021 08:28:02 UTC
Severity: normal
Tags: patch
Done: Eli Zaretskii <eliz <at> gnu.org>
Bug is archived. No further changes may be made.
To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 47408 in the body.
You can then email your comments to 47408 AT debbugs.gnu.org in the normal way.
Toggle the display of automated, internal messages from the tracker.
View this report as an mbox folder, status mbox, maintainer mbox
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Fri, 26 Mar 2021 08:28:02 GMT) Full text and rfc822 format available.fabrice nicol <fabrnicol <at> gmail.com>:bug-gnu-emacs <at> gnu.org.
(Fri, 26 Mar 2021 08:28:02 GMT) Full text and rfc822 format available.Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: fabrice nicol <fabrnicol <at> gmail.com> To: bug-gnu-emacs <at> gnu.org Subject: Emacs etags support for Mercury [v0.2] Date: Fri, 26 Mar 2021 08:09:40 +0100
[Message part 1 (text/plain, inline)]
Hi, As a follow-up to my previous threads on the Emacs devel list (see below), I am now submitting a revised patch that takes into account suggestions from two devel-list members (and adds in support for declarations with variable quantifiers over predicates and functions). I also consulted members from the Mercury devel list (reviews-request <at> lists.mercurylang.org). Although they did not go into the 'etags' code, as they mostly use Vim, the overall design does seem to meet approval there. The patch proposes adding two options to 'etags', namely -M/--declarations and -m/--no-defines. As explained in my prior threads, this is justified by the fact that Mercury is derived from Prolog. It is not unusual to have to port Prolog code into Mercury. Yet Emacs 'etags' Prolog support is quite different, as Prolog has no types or declarations, so predicates appearing first in clauses are tagged as a workaround in Prolog 'etags' support. Unlike Prolog, Mercury has declarations, which should be tagged in priority (this is the community consensus). But preserving some sort of backward compatibility with Prolog may be quite useful for porting purposes, notably. There is no clean way to achieve this without adding at least one extra option to 'etags' (with an argument), or two options without argument, which I personally find clearer. Regarding tests, the following link to source code from the Mercury compiler has (almost) all the possible use cases: https://raw.githubusercontent.com/Mercury-Language/mercury/master/library/array.m Thanks in advance for considering this submission. Fabrice Nicol Message-Id: <E1lOzjX-00GjV8-Hj <at> tucano.isti.cnr.it> > You will note an unconventional move. I was daring enough to add two > options to 'etags' (-m and -M) to implement some kind of backward > compatibility with Prolog etags support (based on tagging definitions, > -M) while allowing a simpler, more idiomatic approach that focuses on > tagging Mercury declarations only (-m). Backward compatibility is > legitimate and quite useful, but having it on board all the time may > be cumbersome for some use cases. Hence the 'behavioral' options I added. I fear this is too intrusive, but easy to amend. Instead of -M, you should use --declarations Instead of -m, you should use --no-defines In both cases, the description of the options should be augmented with their Mercury use. ------------------------- In-Reply-To: <b9e2c35c-ba8f-5114-031f-36f580ae994e <at> gmail.com> Content-Type: multipart/mixed; boundary="------------7AF01A37602B0D491A3765DF" Content-Language: en-US This is a multi-part message in MIME format. --------------7AF01A37602B0D491A3765DF Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 8bit As a follow-up to my message of March 22, I would appreciate to get some feedback on the attached patch implementing Mercury support for 'etags' before considering a formal submission. You will note an unconventional move. I was daring enough to add two options to 'etags' (-m and -M) to implement some kind of backward compatibility with Prolog etags support (based on tagging definitions, -M) while allowing a simpler, more idiomatic approach that focuses on tagging Mercury declarations only (-m). Backward compatibility is legitimate and quite useful, but having it on board all the time may be cumbersome for some use cases. Hence the 'behavioral' options I added. Fabrice Nicol ------------------------ Date: Mon, 22 Mar 2021 19:23:33 +0200 Message-Id: <83y2ef9k6i.fsf <at> gnu.org> From: Eli Zaretskii <eliz <at> gnu.org> Cc: emacs-devel <at> gnu.org In-Reply-To: <b9e2c35c-ba8f-5114-031f-36f580ae994e <at> gmail.com> (message from fabrice nicol on Mon, 22 Mar 2021 03:02:03 +0100) Subject: Re: etags support for the Mercury programming language References: <b9e2c35c-ba8f-5114-031f-36f580ae994e <at> gmail.com> > Date: Mon, 22 Mar 2021 03:02:03 +0100 > > I have been developing Emacs etags support for the Mercury > logic/functional programming language (https://mercurylang.org/), > based on the current code for Prolog support. > > Before proposing a patch for review, I would like to know if > (considering the limited audience) such a proposal stands a chance of > being accepted. All the changes are located in lib-src/etags.c (plus > two lines in lisp/speedbar.el). Yes, I think support for additional languages in etags is always welcome. But please also be sure to update the etags.1 man page with the relevant information, and announce the addition in NEWS. If the changes are substantial, we will need you to assign the copyright for these changes to the FSF. Would you like to start the legal paperwork rolling now? If so, I will send you the form to fill. Thanks.
[0001-Prepare-commit-for-submission-Mercury-etags-support.patch (text/x-patch, attachment)]
Lars Ingebrigtsen <larsi <at> gnus.org>
to control <at> debbugs.gnu.org.
(Fri, 26 Mar 2021 11:36:02 GMT) Full text and rfc822 format available.bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Sat, 27 Mar 2021 15:40:02 GMT) Full text and rfc822 format available.Message #10 received at 47408 <at> debbugs.gnu.org (full text, mbox):
From: fabrice nicol <fabrnicol <at> gmail.com> To: 47408 <at> debbugs.gnu.org Subject: Etags support for Mercury [v0.3] Date: Sat, 27 Mar 2021 11:51:22 +0100
[Message part 1 (text/plain, inline)]
Hi, I'm sending a new patch for this Mercury feature request. The attached patch fixes a previously unnoticed regression that affects Objective C parsing (Mercury and Objective C have same file extensions .m). I had to resort to an added heuristics (implemented in `test_objc_is_mercury') to disambiguate Mercury from Objective C source files with extension .m. The patch is cumulative and replaces the former one. Best, Fabrice Nicol
[0001-Fixed-regressions-caused-by-Objc-Mercury-ambiguous-f.patch (text/x-patch, attachment)]
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Sun, 28 Mar 2021 13:12:01 GMT) Full text and rfc822 format available.Message #13 received at 47408 <at> debbugs.gnu.org (full text, mbox):
From: Eli Zaretskii <eliz <at> gnu.org> To: fabrice nicol <fabrnicol <at> gmail.com> Cc: 47408 <at> debbugs.gnu.org Subject: Re: bug#47408: Etags support for Mercury [v0.3] Date: Sun, 28 Mar 2021 16:11:51 +0300
> From: fabrice nicol <fabrnicol <at> gmail.com>
> Date: Sat, 27 Mar 2021 11:51:22 +0100
>
> I'm sending a new patch for this Mercury feature request.
Thanks, I have some comments below.
> >From 50f3f9a0d46d11d0ac096f79f0d5aa1bc17b7920 Mon Sep 17 00:00:00 2001
> From: Fabrice Nicol <fabrnicol <at> gmail.com>
> Date: Sat, 27 Mar 2021 10:16:44 +0100
> Subject: [PATCH] Fixed regressions caused by Objc/Mercury ambiguous file
> extension .m.
Please accompany the changeset with a ChangeLog-style commit log
message, you can see the style we are using via "git log" and also
find some instructions in CONTRIBUTE.
> .B \-V, \-\-version
> Print the current version of the program (same as the version of the
> emacs \fBetags\fP is shipped with).
> +.TP
> +.B \-, \-\-version
> +Print the current version of the program (same as the version of the
> +emacs \fBetags\fP is shipped with).
Copy/paste mistake? or why are you duplicating the --version
description?
> +.TP
> +.B \-M, \-\-no\-defines
> +For the Mercury programming language, tag both declarations and
> +definitions. Declarations start a line with \fI:\-\fP optionally followed by a
> +quantifier over a variable (\fIsome [T]\fP or \fIall [T]\fP), then by
> +a builtin operator like \fIpred\fP or \fIfunc\fP.
> +Definitions are first rules of clauses, as in Prolog.
> +Implies \-\-language=mercury.
> +.TP
> +.B \-m, \-\-declarations
> +For the Mercury programming language, tag declarations as with \fB\-M\fP, but do not
> +tag definitions. Implies \-\-language=mercury.
This is not what Francesco Potortì suggested to do. He suggested that
you use the existing options --no-defines and --declarations, but give
them Mercury-specific meanings when processing Mercury source files.
IOW, let's not introduce the new -m and -M shorthands for these options,
and let's describe the Mercury-specific meaning of the existing
options where they are currently described in etags.1. OK?
> --- a/etc/NEWS
> +++ b/etc/NEWS
> @@ -93,6 +93,15 @@ useful on systems such as FreeBSD which ships only with "etc/termcap".
>
> * Changes in Emacs 28.1
>
> +---
^^^
This should be "+++", since you submitted the changes for the
documentation as part of the changeset.
> +** Etags support for the Mercury programming language (https://mercurylang.org).
> +** New etags command line options '-M/-m' or --declarations/--no-defines'.
> +Tags all Mercury declarations. For compatibility with Prolog etags support,
> +predicates and functions appearing first in clauses will be tagged if etags is
> +run with the option '-M' or '--declarations'. If run with '-m' or
> +'--no-defines', declarations will be tagged but definitions will not.
> +Both options imply --language=mercury.
This should be amended for the changes in the options I described
above.
> +/* Define MERCURY_HEURISTICS_RATIO as it was necessary to disambiguate
> + Mercury from Objective C, which have same file extensions .m */
This comment should explain how the value is used to disambiguate, so
that people could decide what alternative value to use.
> +static void test_objc_is_mercury(char *, language **);
^^
Our style is to leave one space between the function's name and the
opening parenthesis. Please follow that here and elsewhere in your
patch.
> @@ -621,7 +629,6 @@ #define STDIN 0x1001 /* returned by getopt_long on --parse-stdin */
> "In Java code, all the tags constructs of C and C++ code are\n\
> tagged. (Use --help --lang=c --lang=c++ --lang=java for full help.)";
>
> -
> static const char *Cobol_suffixes [] =
> { "COB", "cob", NULL };
> static char Cobol_help [] =
Why remove this empty line?
> static const char *Objc_suffixes [] =
> - { "lm", /* Objective lex file */
> - "m", /* Objective C file */
> - NULL };
> + {"lm",
> + "m", /* By default, Objective C will be assumed. */
> + NULL};
This loses the explanation that a .lm file is an ObjC lex file.
> @@ -773,7 +792,6 @@ #define STDIN 0x1001 /* returned by getopt_long on --parse-stdin */
> 'TEXTAGS' to a colon-separated list like, for example,\n\
> TEXTAGS=\"mycommand:myothercommand\".";
>
> -
> static const char *Texinfo_suffixes [] =
> { "texi", "texinfo", "txi", NULL };
> static const char Texinfo_help [] =
Again, an empty line removed -- why?
> + puts ("-m, --declarations\n\
> + For the Mercury programming language, only tag declarations.\n\
> + Declarations start a line with :- \n\
> + Implies --language=mercury.");
> +
> + puts ("-M, --no-defines\n\
> + For the Mercury programming language, include both declarations and\n\
> + definitions. Declarations start a line with :- while definitions\n\
> + are first rules for a given item, as for Prolog.\n\
> + Implies --language=mercury.");
> +
This should be merged with the existing description of the long
options.
> /* When the optstring begins with a '-' getopt_long does not rearrange the
> non-options arguments to be at the end, but leaves them alone. */
> - optstring = concat ("-ac:Cf:Il:o:Qr:RSVhH",
> + optstring = concat ("-ac:Cf:Il:Mmo:Qr:RSVhHW",
> (CTAGS) ? "BxdtTuvw" : "Di:",
> "");
As mentioned, let's not introduce -m and -M.
> + case 'M':
> + with_mercury_definitions = true; FALLTHROUGH;
> + case 'm':
> + {
> + language lang =
> + { "mercury", Mercury_help, Mercury_functions, Mercury_suffixes };
> +
> + argbuffer[current_arg].lang = ⟨
> + argbuffer[current_arg].arg_type = at_language;
> + }
> + break;
Shouldn't be needed anymore.
> /* Etags options */
> - case 'D': constantypedefs = false; break;
> + case 'D': constantypedefs = false; break;
This whitespace change is for the worse: our conventions are to use
mixed spaces-with-tabs style for indentation in C source files, not
just spaces.
> +static void test_objc_is_mercury(char *this_file, language **lang)
Our style is to write function definitions like this:
static void
test_objc_is_mercury (char *this_file, language **lang)
IOW, break the line between the return type and the function's name.
> + FILE* fp = fopen(this_file, "r");
> + if (fp == NULL) return;
No error/warning if the file couldn't be open?
In any case, this leaks a FILE object: you open a file, but never
close it.
> + uint64_t lines = 1;
> + uint64_t mercury_decls = 0;
We don't use such types elsewhere in etags.c; why do you need them
here? can you use intmax_t instead, as we do elsewhere?
> + case '%': FALLTHROUGH;
> + case ' ': FALLTHROUGH;
> + case '\t':
> + start_of_line = false;
FALLTHROUGH isn't needed here, as there's no code under the first 2
'case' lines.
> + /* Change the language from Objective C to Mercury */
Our style for comments is to end each comment with a period and 2
spaces, like this:
/* Change the language from Objective C to Mercury. */
Please follow this style, here and elsewhere in the changeset.
> + uint8_t decl_type_length = pos - origpos;
Please use 'unsigned char' instead of uint8_t.
> + 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
> + )
Please avoid parentheses alone on their lines.
> 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?
Last, but not least: if you can, please provide a test file for the
etags test suite, see test/manual/etags/.
Thanks again for working on this.
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Sun, 28 Mar 2021 15:49:01 GMT) Full text and rfc822 format available.Message #16 received at 47408 <at> debbugs.gnu.org (full text, mbox):
From: fabrice nicol <fabrnicol <at> gmail.com> To: 47408 <at> debbugs.gnu.org Subject: Re: bug#47408: Etags support for Mercury [v0.3] Date: Sun, 28 Mar 2021 17:49:20 +0200
[Message part 1 (text/plain, inline)]
Thanks for this review.
Changes will be implemented soon as indicated.
(1) There is just one point that I would like to discuss before changing
things around: the proposed -m/-M short option issue.
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).
Whether this is less intrusive (or more) than -m/-M is not crystal-clear
to me. Both solutions look on a par wrt this criterion, but -m/-M may
be more user-friendly.
If two short options are one too many, I propose redesigning the short
option pair as just one -m option with a binary argument (like: '-m
defines / -m all', or -m 0 / -m 1).
2. The social side of things
As indicated previously, I also consulted the Mercury review list, and
the feedback was positive on -m/-M (see below):
> Accommodating different people's different preferences is a good idea
> if it can be done at acceptable cost.
>
>> Instead of -M, you should use --declarations
>>
>> Instead of -m, you should use --no-defines
> There is no need for "instead"; you can support both forms of both options.
>
So I opted for a compromise: renaming long options, following F.
Potorti, and keeping -m/-M, following Z. Somogyi.
(2) Your following question:
> 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.
>> +.TP
>> +.B \-M, \-\-no\-defines
>> +For the Mercury programming language, tag both declarations and
>> +definitions. Declarations start a line with \fI:\-\fP optionally followed by a
>> +quantifier over a variable (\fIsome [T]\fP or \fIall [T]\fP), then by
>> +a builtin operator like \fIpred\fP or \fIfunc\fP.
>> +Definitions are first rules of clauses, as in Prolog.
>> +Implies \-\-language=mercury.
>> +.TP
>> +.B \-m, \-\-declarations
>> +For the Mercury programming language, tag declarations as with \fB\-M\fP, but do not
>> +tag definitions. Implies \-\-language=mercury.
> This is not what Francesco Potortì suggested to do. He suggested that
> you use the existing options --no-defines and --declarations, but give
> them Mercury-specific meanings when processing Mercury source files.
> IOW, let's not introduce the new -m and -M shorthands for these options,
> and let's describe the Mercury-specific meaning of the existing
> options where they are currently described in etags.1. OK?
> +** Etags support for the Mercury programming language (https://mercurylang.org).
> +** New etags command line options '-M/-m' or --declarations/--no-defines'.
> +Tags all Mercury declarations. For compatibility with Prolog etags support,
> +predicates and functions appearing first in clauses will be tagged if etags is
> +run with the option '-M' or '--declarations'. If run with '-m' or
> +'--no-defines', declarations will be tagged but definitions will not.
> +Both options imply --language=mercury.
> This should be amended for the changes in the options I described
> above.
> As mentioned, let's not introduce -m and -M.
>
>> + case 'M':
>> + with_mercury_definitions = true; FALLTHROUGH;
>> + case 'm':
>> + {
>> + language lang =
>> + { "mercury", Mercury_help, Mercury_functions, Mercury_suffixes };
>> +
>> + argbuffer[current_arg].lang = ⟨
>> + argbuffer[current_arg].arg_type = at_language;
>> + }
>> + break;
> Shouldn't be needed anymore.
>
>> 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?
>
> Last, but not least: if you can, please provide a test file for the
> etags test suite, see test/manual/etags/.
>
> Thanks again for working on this.
[Message part 2 (text/html, inline)]
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Sun, 28 Mar 2021 16:23:02 GMT) Full text and rfc822 format available.Message #19 received at 47408 <at> debbugs.gnu.org (full text, mbox):
From: Eli Zaretskii <eliz <at> gnu.org> To: fabrice nicol <fabrnicol <at> gmail.com> Cc: 47408 <at> debbugs.gnu.org Subject: Re: bug#47408: Etags support for Mercury [v0.3] Date: Sun, 28 Mar 2021 19:22:15 +0300
> From: fabrice nicol <fabrnicol <at> 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.
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Mon, 29 Mar 2021 11:53:01 GMT) Full text and rfc822 format available.Message #22 received at 47408 <at> debbugs.gnu.org (full text, mbox):
From: fabrice nicol <fabrnicol <at> gmail.com> To: 47408 <at> debbugs.gnu.org Subject: bug#47408: Etags support for Mercury [v0.4] Date: Mon, 29 Mar 2021 13:53:26 +0200
[Message part 1 (text/plain, inline)]
Attached is the new patch that integrates your indications.
Please note two points:
1. Now that -m/-M have been done with, there is no use specifying any
Mercury-specific behavior for --no-defines.
Actually the Mercury community consensus is that all declarations should
be tagged in any case.
So --no-defines is just the default behavior of etags run without any
option and does not need to be used explicitly or specifically documented.
I followed your indications about --declarations. I also added a line to
etags.1 about --language=mercury or --language=objc, should the
heuristic test fail to detect the right language. Note, however, that
removing language-specific options comes at a price. The heuristic test
has now to be more complex. I had errless detection results against my
test base of 4,000 mercury files and 500 Obj.-C files. This looks
satisfactory but I had to tweak the heuristic test function
(test_objc_is_mercury) quite a bit to weed out detection failures.
I added the ChangeLog, the requested test file (array.m) under
test/manual/etags/merc-src and altered the corresponding Makefile
accordingly.
2. I removed by added line to speedbar.el, which in the end did not
prove very useful. It is located in a Xemacs compatibility layer that is
no longer used by most users.
Le 28/03/2021 à 18:22, Eli Zaretskii a écrit :
>> From: fabrice nicol <fabrnicol <at> 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.
[0001-Add-etags-support-for-Mercury-v0.4.patch (text/x-patch, attachment)]
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Sat, 15 May 2021 08:32:02 GMT) Full text and rfc822 format available.Message #25 received at 47408 <at> debbugs.gnu.org (full text, mbox):
From: Eli Zaretskii <eliz <at> gnu.org> To: fabrice nicol <fabrnicol <at> gmail.com> Cc: 47408 <at> debbugs.gnu.org Subject: Re: Fwd: bug#47408: Etags support for Mercury [v0.4] Date: Sat, 15 May 2021 11:31:47 +0300
> From: fabrice nicol <fabrnicol <at> 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 <at> gnu.org> a écrit :
> > From: fabrice nicol <fabrnicol <at> 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 <at> gmail.com>
> Pour : 47408 <at> 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 <at> 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 <at> 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".
>
> * 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;
> }
>
> +
> +/*
> + * 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;
> +}
> +
>
> /*
> * 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
>
>
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Sat, 29 May 2021 08:02:01 GMT) Full text and rfc822 format available.Message #28 received at 47408 <at> debbugs.gnu.org (full text, mbox):
From: Eli Zaretskii <eliz <at> gnu.org> To: fabrice nicol <fabrnicol <at> gmail.com> Cc: 47408 <at> debbugs.gnu.org Subject: Re: Fwd: bug#47408: Etags support for Mercury [v0.4] Date: Sat, 29 May 2021 11:01:01 +0300
[Please use Reply All to have the bug address on the CC list.]
> From: fabrice nicol <fabrnicol <at> gmail.com>
> Date: Sat, 15 May 2021 12:19:26 +0200
>
> The confusion stems from an earlier discussion with a third party (I
> forgot his name), who proposed to reuse '--no-defines' **and**
> '--declarations' to replace Mercury-specific short options that I had
> introduced. You followed this advice and so did I except for one detail
> that I will outline below.
>
> To make things clearer, I will rephrase the way I implemented this:
>
> 1. There are **no longer** Mercury-specific short options -m/-M.
>
> 2. As advised by this third party and your review comments,
> '--declarations' is implemented in a Mercury-specific way (hence the -
> correct - NEWS item about it, as well as a couple of sentences in the
> man page, this is just what your review advised).
>
> Using '--declarations', etags will tag not only Mercury language
> declarations (strictly speaking) but also 'legacy declarations', i.e.
> the old Prolog way (in actual terms, these are definitions in Mercury,
> but there is unfortunately no '--definitions' etags options, so we must
> do with what we have in store).
OK. But the documentation patches you submitted seem to be somewhat
confusing: will Mercury declarations be tagged by default, or only
when --declarations is used? This option isn't the default in etags,
so either the declarations are tagged by default (i.e. without using
this option) or only when --declarations is specified on the command
line. You seem to say both, which I don't understand.
And I have several minor comments to the patch:
> +In Mercury, declarations start a line with "\|\fB:-\fP\|" and are tagged
> +by default.
Here, this is the confusing part about tagging Mercury declarations.
> ++++
> +** 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'.
And this as well. It leaves me wondering what is the difference
between the results when using --declarations and not using it.
> --- /dev/null
> +++ b/lib-src/ChangeLog
We don't maintain ChangeLog files anymore in the repository, so what
you wanted to say there should be instead in the commit log message
(which you didn't include). See CONTRIBUTE for more details about
formatting commit log messages.
> + /* Disambiguate file names between Objc and Mercury */
> + if (lang != NULL && strcmp(lang->name, "objc") == 0)
> + test_objc_is_mercury(curfdp->infname, &lang);
Our C style conventions are to leave one space between the function's
name and the left parenthesis following it, as below:
if (lang != NULL && strcmp (lang->name, "objc") == 0)
test_objc_is_mercury (curfdp->infname, &lang);
Please make sure you use this style everywhere.
> 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.
Adding test file(s) for Mercury is great, but we cannot have there
files under arbitrary license/copyright. If COPYING.LIB mentioned
above specifies GPL or a compatible license, then it's okay for us to
distribute this file, but we need a copy of that COPYING.LIB file as
well. If the license is not compatible with GPL, we cannot distribute
this file; in that case, please find some other test file, or provide
your own.
Thanks.
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Sat, 29 May 2021 10:23:01 GMT) Full text and rfc822 format available.Message #31 received at 47408 <at> debbugs.gnu.org (full text, mbox):
From: Eli Zaretskii <eliz <at> gnu.org> To: Fabrice Nicol <fabrnicol <at> gmail.com> Cc: 47408 <at> debbugs.gnu.org Subject: Re: Fwd: bug#47408: Etags support for Mercury [v0.4] Date: Sat, 29 May 2021 13:22:24 +0300
[Once again, please use Reply All, to keep the bug address on the CC list.] > From: Fabrice Nicol <fabrnicol <at> gmail.com> > Date: Sat, 29 May 2021 12:06:57 +0200 > > Hi Eli, > All your comments are fine by me and I will make the requested adjustments within a week. Thanks. > FYI, Mercury is entirely GPL, so there should be no licensing issue. It is just the authors' status that changed > (from a university team to a private team), but this does not impact the licensing terms. I will document this. I'm not talking about the license of Mercury, I'm talking about the license of the file you added to the etags test suite. We must have clear understanding and documentation about its legal status. P.S. Please be sure to CC the bug address on your future messages in this matter.
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Tue, 01 Jun 2021 02:39:01 GMT) Full text and rfc822 format available.Message #34 received at 47408 <at> debbugs.gnu.org (full text, mbox):
From: fabrice nicol <fabrnicol <at> gmail.com> To: Eli Zaretskii <eliz <at> gnu.org> Cc: 47408 <at> debbugs.gnu.org Subject: bug#47408: Etags support for Mercury [v0.5] Date: Tue, 1 Jun 2021 04:38:56 +0200
[Message part 1 (text/plain, inline)]
Hi Eli, >> Using '--declarations', etags will tag not only Mercury language >> declarations (strictly speaking) but also 'legacy declarations', i.e. >> the old Prolog way (in actual terms, these are definitions in Mercury, >> but there is unfortunately no '--definitions' etags options, so we must >> do with what we have in store). > OK. But the documentation patches you submitted seem to be somewhat > confusing: will Mercury declarations be tagged by default, or only > when --declarations is used? Mercury-specific declarations will be tagged by default. What is confusing is not the implementation but the fact that, after it was decided **not** to use language-specific options (like the initially proposed -m/-M), we were left with no choice as to which existing option could be used to implement the optional "Prolog legacy/porting" behavior. --declarations was the option that the first third-party reviewer proposed, and both of us followed suit. It is to be understood as "**all** declarations", meaning Mercury-specific declarations **and** Prolog-support-style declarations (i.e. first rule predicates in clauses). I've tried to make the documentation patch a bit clearer. > This option isn't the default in etags, > so either the declarations are tagged by default (i.e. without using > this option) Yes. Mercury-specific declarations are tagged by default, this is what I explained in my latest two emails. > or only when --declarations is specified on the command > line. No. --declarations adds Prolog-style 'declarations' in addition to Mercury-specific declarations, so that porting Prolog to Mercury is facilitated. It is always necessary to tag Mercury-specific (non-Prolog-style) declarations, in all circumstances. It is only useful to tag Prolog-style declarations (actually definitions) in some circumstances. > You seem to say both, which I don't understand. Mercury-specific declarations are tagged by default **and** with --declarations. This is what the Mercury community wants, I consulted them on the user list. Prolog-style 'declarations' (which are actually definitions, as there are **no** declarations in Prolog) are additionaly tagged when --declarations is used. > And I have several minor comments to the patch: > >> +In Mercury, declarations start a line with "\|\fB:-\fP\|" and are tagged >> +by default. >> >> Here, this is the confusing part about tagging Mercury declarations. This will not be confusing to people who have practiced Mercury even a little bit. A Mercury-specific declaration is by definition preceded by ':-'. I changed this to '... and are always tagged'. Which may be clearer. >> ++++ >> +** 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'. >> >> And this as well. It leaves me wondering what is the difference >> between the results when using --declarations and not using it. By default, when --declarations is not used, all Mercury-specific declarations (i.e. beginning a line with ':-' ) are tagged, **and only them**. When --declarations is used, all Mercury-specific declarations **plus** all Prolog-support-style 'declarations' are tagged. I see no confusing phrasing in the proposed sentences. I changed 'also' into 'in addition', which is (perhaps) clearer. >> --- /dev/null >> +++ b/lib-src/ChangeLog > We don't maintain ChangeLog files anymore in the repository, so what > you wanted to say there should be instead in the commit log message > (which you didn't include). See CONTRIBUTE for more details about > formatting commit log messages. Ah, I thought commit log messages were yours to make as I am not granted committing rights. >> + /* Disambiguate file names between Objc and Mercury */ >> + if (lang != NULL && strcmp(lang->name, "objc") == 0) >> + test_objc_is_mercury(curfdp->infname, &lang); > Our C style conventions are to leave one space between the function's > name and the left parenthesis following it, as below: > > if (lang != NULL && strcmp (lang->name, "objc") == 0) > test_objc_is_mercury (curfdp->infname, &lang); > > Please make sure you use this style everywhere. Done. >> 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. > Adding test file(s) for Mercury is great, but we cannot have there > files under arbitrary license/copyright. If COPYING.LIB mentioned > above specifies GPL or a compatible license, then it's okay for us to > distribute this file, but we need a copy of that COPYING.LIB file as > well. If the license is not compatible with GPL, we cannot distribute > this file; in that case, please find some other test file, or provide > your own. > > Thanks. OK. Upon closer inspection, the COPYING.LIB license that applies to library files is a kind of dual license with an optional way out of GPL v2 into LGPL-like licensing terms. Admittedly this is a bit complex and uncertain. However these complex licensing terms only apply to library files. Compiler files, on the contrary, are casher GPLv2. So I removed my example file (array.m from the library) and replaced it with a compiler file (accumulator.m). This now leaves no uncertainty whatsoever. The COPYING file referred to in the accumulator.m header is GPL v2. I hope this works, Fabrice
[0001-Add-etags-support-for-Mercury-[v0.5].patch (text/x-patch, attachment)]
Eli Zaretskii <eliz <at> gnu.org>:fabrice nicol <fabrnicol <at> gmail.com>:Message #39 received at 47408-done <at> debbugs.gnu.org (full text, mbox):
From: Eli Zaretskii <eliz <at> gnu.org> To: fabrice nicol <fabrnicol <at> gmail.com> Cc: 47408-done <at> debbugs.gnu.org Subject: Re: bug#47408: Etags support for Mercury [v0.5] Date: Sun, 06 Jun 2021 12:48:48 +0300
> From: fabrice nicol <fabrnicol <at> gmail.com> > Cc: 47408 <at> debbugs.gnu.org > Date: Tue, 1 Jun 2021 04:38:56 +0200 > > Mercury-specific declarations will be tagged by default. Thanks, I installed the changes. I see that there's no Mercury support for ctags (the 'ctags' output of the test suite remained without change) -- is that intentional?
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Sun, 06 Jun 2021 13:34:01 GMT) Full text and rfc822 format available.Message #42 received at 47408-done <at> debbugs.gnu.org (full text, mbox):
From: fabrice nicol <fabrnicol <at> gmail.com> To: Eli Zaretskii <eliz <at> gnu.org> Cc: 47408-done <at> debbugs.gnu.org Subject: Re: bug#47408: Etags support for Mercury [v0.5] Date: Sun, 6 Jun 2021 15:34:30 +0200
Yes, unless I am mistaken, ctags has no practical use outside of the C-family language domain. Le 06/06/2021 à 11:48, Eli Zaretskii a écrit : >> From: fabrice nicol <fabrnicol <at> gmail.com> >> Cc: 47408 <at> debbugs.gnu.org >> Date: Tue, 1 Jun 2021 04:38:56 +0200 >> >> Mercury-specific declarations will be tagged by default. > Thanks, I installed the changes. > > I see that there's no Mercury support for ctags (the 'ctags' output of > the test suite remained without change) -- is that intentional?
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Sun, 06 Jun 2021 18:19:02 GMT) Full text and rfc822 format available.Message #45 received at 47408-done <at> debbugs.gnu.org (full text, mbox):
From: Francesco Potortì <pot <at> gnu.org> To: fabrice nicol <fabrnicol <at> gmail.com> Cc: 47408-done <at> debbugs.gnu.org, Eli Zaretskii <eliz <at> gnu.org> Subject: Re: bug#47408: Etags support for Mercury [v0.5] Date: Sun, 06 Jun 2021 20:18:48 +0200
Eli Zaretskii: >> I see that there's no Mercury support for ctags (the 'ctags' output of >> the test suite remained without change) -- is that intentional? Fabrice Nicol: >Yes, unless I am mistaken, ctags has no practical use outside of the >C-family language domain. That's difficult to tell for me. However, etags provides ctags support for all languages it knows about. I may be missing something, but I think Mercury would be the first exception. If that's the case, maybe it would be worth adding a comment telling so.
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Sun, 06 Jun 2021 20:49:02 GMT) Full text and rfc822 format available.Message #48 received at 47408-done <at> debbugs.gnu.org (full text, mbox):
From: fabrice nicol <fabrnicol <at> gmail.com> To: Francesco Potortì <pot <at> gnu.org> Cc: 47408-done <at> debbugs.gnu.org, Eli Zaretskii <eliz <at> gnu.org> Subject: Re: bug#47408: Etags support for Mercury [v0.5] Date: Sun, 6 Jun 2021 22:49:19 +0200
> Yes, unless I am mistaken, ctags has no practical use outside of the >> C-family language domain. > That's difficult to tell for me. However, etags provides ctags support > for all languages it knows about. I may be missing something, but I > think Mercury would be the first exception. If that's the case, maybe > it would be worth adding a comment telling so. ctags only differs from etags by the fact that its output is Vim-compatible. But it so happens that Mercury has superior in-built support for Vim tagging (the core team use Vim). So ctags would not actually be used by users with Vim-compatibility requirements, they would just use Mercury tagging on Vim.
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Sun, 06 Jun 2021 21:05:01 GMT) Full text and rfc822 format available.Message #51 received at 47408-done <at> debbugs.gnu.org (full text, mbox):
From: Francesco Potortì <pot <at> gnu.org> To: fabrice nicol <fabrnicol <at> gmail.com> Cc: Eli Zaretskii <eliz <at> gnu.org>, 47408-done <at> debbugs.gnu.org Subject: Re: bug#47408: Etags support for Mercury [v0.5] Date: Sun, 06 Jun 2021 23:04:45 +0200
>> Yes, unless I am mistaken, ctags has no practical use outside of the >>> C-family language domain. >> That's difficult to tell for me. However, etags provides ctags support >> for all languages it knows about. I may be missing something, but I >> think Mercury would be the first exception. If that's the case, maybe >> it would be worth adding a comment telling so. > >ctags only differs from etags by the fact that its output is >Vim-compatible. But it so happens that Mercury has superior in-built >support for Vim tagging (the core team use Vim). So ctags would not >actually be used by users with Vim-compatibility requirements, they >would just use Mercury tagging on Vim. Maybe adding this info in a comment inside etags' code would be useful for future maintainers.
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Tue, 08 Jun 2021 00:06:02 GMT) Full text and rfc822 format available.Message #54 received at 47408 <at> debbugs.gnu.org (full text, mbox):
From: Eli Zaretskii <eliz <at> gnu.org> To: fabrice nicol <fabrnicol <at> gmail.com> Cc: pot <at> gnu.org, 47408 <at> debbugs.gnu.org Subject: Re: bug#47408: Etags support for Mercury [v0.5] Date: Mon, 07 Jun 2021 15:13:45 +0300
> Cc: 47408-done <at> debbugs.gnu.org, Eli Zaretskii <eliz <at> gnu.org> > From: fabrice nicol <fabrnicol <at> gmail.com> > Date: Sun, 6 Jun 2021 22:49:19 +0200 > > > That's difficult to tell for me. However, etags provides ctags support > > for all languages it knows about. I may be missing something, but I > > think Mercury would be the first exception. If that's the case, maybe > > it would be worth adding a comment telling so. > > ctags only differs from etags by the fact that its output is > Vim-compatible. But it so happens that Mercury has superior in-built > support for Vim tagging (the core team use Vim). So ctags would not > actually be used by users with Vim-compatibility requirements, they > would just use Mercury tagging on Vim. What do we lose if we make Mercury support active in ctags mode? Do we even need to add any code for that?
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Tue, 08 Jun 2021 00:39:02 GMT) Full text and rfc822 format available.Message #57 received at 47408 <at> debbugs.gnu.org (full text, mbox):
From: Fabrice Nicol <fabrnicol <at> gmail.com> To: Eli Zaretskii <eliz <at> gnu.org> Cc: Francesco Potortì <pot <at> gnu.org>, 47408 <at> debbugs.gnu.org Subject: Re: bug#47408: Etags support for Mercury [v0.5] Date: Tue, 8 Jun 2021 02:38:12 +0200
[Message part 1 (text/plain, inline)]
There is something to be fixed if this is the expected output, as ctags invocation dose not work for Mercury files. I have not looked into the issue yet but the fix should be quite small. Le mar. 8 juin 2021 à 2:05 AM, Eli Zaretskii <eliz <at> gnu.org> a écrit : > > Cc: 47408-done <at> debbugs.gnu.org, Eli Zaretskii <eliz <at> gnu.org> > > From: fabrice nicol <fabrnicol <at> gmail.com> > > Date: Sun, 6 Jun 2021 22:49:19 +0200 > > > > > That's difficult to tell for me. However, etags provides ctags support > > > for all languages it knows about. I may be missing something, but I > > > think Mercury would be the first exception. If that's the case, maybe > > > it would be worth adding a comment telling so. > > > > ctags only differs from etags by the fact that its output is > > Vim-compatible. But it so happens that Mercury has superior in-built > > support for Vim tagging (the core team use Vim). So ctags would not > > actually be used by users with Vim-compatibility requirements, they > > would just use Mercury tagging on Vim. > > What do we lose if we make Mercury support active in ctags mode? Do > we even need to add any code for that? >
[Message part 2 (text/html, inline)]
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Tue, 08 Jun 2021 10:54:02 GMT) Full text and rfc822 format available.Message #60 received at 47408 <at> debbugs.gnu.org (full text, mbox):
From: Francesco Potortì <pot <at> gnu.org> To: Eli Zaretskii <eliz <at> gnu.org> Cc: 47408 <at> debbugs.gnu.org, fabrice nicol <fabrnicol <at> gmail.com> Subject: Re: bug#47408: Etags support for Mercury [v0.5] Date: Tue, 08 Jun 2021 12:53:23 +0200
Eli Zaretskii: >>>> I see that there's no Mercury support for ctags (the 'ctags' output of >>>> the test suite remained without change) -- is that intentional? Fabrice Nicol: >> ctags only differs from etags by the fact that its output is >> Vim-compatible. But it so happens that Mercury has superior in-built >> support for Vim tagging (the core team use Vim). So ctags would not >> actually be used by users with Vim-compatibility requirements, they >> would just use Mercury tagging on Vim. Eli Zaretski: > What do we lose if we make Mercury support active in ctags mode? Do > we even need to add any code for that? I just looked at the code. Unless I am grossly mistaken, nothing is needed to get ctags output. You just call the program as ctags and that's it. So there is no reason to prevent ctags help from mentioning Mercurial.
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Tue, 08 Jun 2021 11:49:01 GMT) Full text and rfc822 format available.Message #63 received at 47408 <at> debbugs.gnu.org (full text, mbox):
From: Eli Zaretskii <eliz <at> gnu.org> To: Francesco Potortì <pot <at> gnu.org> Cc: 47408 <at> debbugs.gnu.org, fabrnicol <at> gmail.com Subject: Re: bug#47408: Etags support for Mercury [v0.5] Date: Tue, 08 Jun 2021 14:47:37 +0300
> From: Francesco Potortì <pot <at> gnu.org> > Date: Tue, 08 Jun 2021 12:53:23 +0200 > Cc: 47408 <at> debbugs.gnu.org, > fabrice nicol <fabrnicol <at> gmail.com> > > > What do we lose if we make Mercury support active in ctags mode? Do > > we even need to add any code for that? > > I just looked at the code. Unless I am grossly mistaken, nothing is > needed to get ctags output. You just call the program as ctags and > that's it. So there is no reason to prevent ctags help from mentioning > Mercurial. Then how come, when I run the etags test suite (test/manual/etags/), I get no change in the produced CTAGS file wrt CTAGS.good? That .good file is from before we added the Mercury source to the suite. What am I missing?
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Tue, 08 Jun 2021 12:48:02 GMT) Full text and rfc822 format available.Message #66 received at 47408 <at> debbugs.gnu.org (full text, mbox):
From: Francesco Potortì <pot <at> gnu.org> To: Eli Zaretskii <eliz <at> gnu.org> Cc: fabrnicol <at> gmail.com, 47408 <at> debbugs.gnu.org Subject: Re: bug#47408: Etags support for Mercury [v0.5] Date: Tue, 08 Jun 2021 14:47:13 +0200
>> From: Francesco Potortì <pot <at> gnu.org> >> Date: Tue, 08 Jun 2021 12:53:23 +0200 >> Cc: 47408 <at> debbugs.gnu.org, >> fabrice nicol <fabrnicol <at> gmail.com> >> >> > What do we lose if we make Mercury support active in ctags mode? Do >> > we even need to add any code for that? >> >> I just looked at the code. Unless I am grossly mistaken, nothing is >> needed to get ctags output. You just call the program as ctags and >> that's it. So there is no reason to prevent ctags help from mentioning >> Mercurial. > >Then how come, when I run the etags test suite (test/manual/etags/), I >get no change in the produced CTAGS file wrt CTAGS.good? That .good >file is from before we added the Mercury source to the suite. What am >I missing? Sorry, don't know :( Looked again, but then I'd need to debug it to know...
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Thu, 10 Jun 2021 14:00:02 GMT) Full text and rfc822 format available.Message #69 received at 47408 <at> debbugs.gnu.org (full text, mbox):
From: Eli Zaretskii <eliz <at> gnu.org> To: Francesco Potortì <pot <at> gnu.org> Cc: fabrnicol <at> gmail.com, 47408 <at> debbugs.gnu.org Subject: Re: bug#47408: Etags support for Mercury [v0.5] Date: Thu, 10 Jun 2021 16:59:04 +0300
> From: Francesco Potortì <pot <at> gnu.org> > Date: Tue, 08 Jun 2021 14:47:13 +0200 > Cc: fabrnicol <at> gmail.com, > 47408 <at> debbugs.gnu.org > > >> I just looked at the code. Unless I am grossly mistaken, nothing is > >> needed to get ctags output. You just call the program as ctags and > >> that's it. So there is no reason to prevent ctags help from mentioning > >> Mercurial. > > > >Then how come, when I run the etags test suite (test/manual/etags/), I > >get no change in the produced CTAGS file wrt CTAGS.good? That .good > >file is from before we added the Mercury source to the suite. What am > >I missing? > > Sorry, don't know :( Looked again, but then I'd need to debug it to know... I found the reason: make_tag was called incorrectly from mercury_pr. This should be fixed now.
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Thu, 10 Jun 2021 16:52:02 GMT) Full text and rfc822 format available.Message #72 received at 47408 <at> debbugs.gnu.org (full text, mbox):
From: fabrice nicol <fabrnicol <at> gmail.com> To: Eli Zaretskii <eliz <at> gnu.org>, Francesco Potortì <pot <at> gnu.org> Cc: 47408 <at> debbugs.gnu.org Subject: Re: bug#47408: Etags support for Mercury [v0.5] Date: Thu, 10 Jun 2021 18:52:49 +0200
[Message part 1 (text/plain, inline)]
Eli,
your latest fix for Mercury 'etags' support has introduced a regression
for existentially quantified predicates.
These predicates have the following (somewhat simplified) syntax (in
extended regexp form, \s for white space):
:-[:blank:]+some[:blank:]*\[[:blank:]*T(,[:blank:]*[:upper:]{1})*[:blank:]*\][:blank:]+pred[:blank:]+([:lower:]+([:alnum:]|[:punct:])*)+[:blank:]*\([^()]+\)([:blank:]|[:lower:])*\.
Example:
:- some [T] pred unravel_univ(univ::in, T::out) is det.
Your fix incorrectly outputs such quantified predicates. For example on
tagging univ.m (attached), your commit version yields:
:- some [T] pred unravel_univ(^?[T] pred unravel_univ^A141,4333
whilst my original code yields the correct tag:
:- some [T] pred unravel_univ(^?141,4333
In other words, 'pred unravel_univ' is wrongly repeated in your latest
commit.
The issue seems to be located at the patch line below:
+ char *name = skip_non_spaces (s + len0);
Pending a more accurate 'fix for the fix', it would probably be wiser to
revert to original code, as it - at least - gives a correct output for
'etags' invocation.
Existentially quantified predicates are not uncommon in Mercury.
Fabrice
>> Date: Tue, 08 Jun 2021 14:47:13 +0200
>> Cc: fabrnicol <at> gmail.com,
>> 47408 <at> debbugs.gnu.org
>>
>>>> I just looked at the code. Unless I am grossly mistaken, nothing is
>>>> needed to get ctags output. You just call the program as ctags and
>>>> that's it. So there is no reason to prevent ctags help from mentioning
>>>> Mercurial.
>>> Then how come, when I run the etags test suite (test/manual/etags/), I
>>> get no change in the produced CTAGS file wrt CTAGS.good? That .good
>>> file is from before we added the Mercury source to the suite. What am
>>> I missing?
>> Sorry, don't know :( Looked again, but then I'd need to debug it to know...
> I found the reason: make_tag was called incorrectly from mercury_pr.
>
> This should be fixed now.
[univ.m (application/vnd.wolfram.mathematica.package, attachment)]
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Thu, 10 Jun 2021 17:06:02 GMT) Full text and rfc822 format available.Message #75 received at 47408 <at> debbugs.gnu.org (full text, mbox):
From: Francesco Potortì <pot <at> gnu.org> To: fabrice nicol <fabrnicol <at> gmail.com> Cc: 47408 <at> debbugs.gnu.org, Eli Zaretskii <eliz <at> gnu.org> Subject: Re: bug#47408: Etags support for Mercury [v0.5] Date: Thu, 10 Jun 2021 19:05:37 +0200
>:- some [T] pred unravel_univ(univ::in, T::out) is det. > >Your fix incorrectly outputs such quantified predicates. For example on >tagging univ.m (attached), your commit version yields: > >:- some [T] pred unravel_univ(^?[T] pred unravel_univ^A141,4333 > >whilst my original code yields the correct tag: > >:- some [T] pred unravel_univ(^?141,4333 The first tag is a named tag, as described in etc/ETAGS.EBNF. Why do you say it is incorrect? Does etags.el behave badly with that tag? While the automatically generated explicit tag name should do no harm, if you generate a moreappropriate tag name that should improve functionality. In this case, I suspect that the tag name should be in fact "unravel_univ" rather than "pred unravel_univ". In short: 1) the first tag is anamed tag, and should behave essentially like the second, probably providing more resilience against code changes, so it shuld be the preferred way to generate a tag 2) this can be further improved with knowledge of the tagged langage: rather than relying on etags to autometically generate a name, the code should ideally provide the correct name
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Thu, 10 Jun 2021 17:22:01 GMT) Full text and rfc822 format available.Message #78 received at 47408 <at> debbugs.gnu.org (full text, mbox):
From: Eli Zaretskii <eliz <at> gnu.org> To: fabrice nicol <fabrnicol <at> gmail.com> Cc: pot <at> gnu.org, 47408 <at> debbugs.gnu.org Subject: Re: bug#47408: Etags support for Mercury [v0.5] Date: Thu, 10 Jun 2021 20:20:45 +0300
> Cc: 47408 <at> debbugs.gnu.org
> From: fabrice nicol <fabrnicol <at> gmail.com>
> Date: Thu, 10 Jun 2021 18:52:49 +0200
>
> your latest fix for Mercury 'etags' support has introduced a regression
> for existentially quantified predicates.
Is it a "regression" in the sense that "M-." no longer finds the
definitions?
> These predicates have the following (somewhat simplified) syntax (in
> extended regexp form, \s for white space):
>
> :-[:blank:]+some[:blank:]*\[[:blank:]*T(,[:blank:]*[:upper:]{1})*[:blank:]*\][:blank:]+pred[:blank:]+([:lower:]+([:alnum:]|[:punct:])*)+[:blank:]*\([^()]+\)([:blank:]|[:lower:])*\.
>
> Example:
>
> :- some [T] pred unravel_univ(univ::in, T::out) is det.
>
> Your fix incorrectly outputs such quantified predicates. For example on
> tagging univ.m (attached), your commit version yields:
>
>
> :- some [T] pred unravel_univ(^?[T] pred unravel_univ^A141,4333
>
>
> whilst my original code yields the correct tag:
>
>
> :- some [T] pred unravel_univ(^?141,4333
Why do you think the current result is incorrect, while the previous
result was correct?
> In other words, 'pred unravel_univ' is wrongly repeated in your latest
> commit.
It isn't "wrongly repeated". TAGS files support 2 different ways of
specifying a tag: implicitly named or explicitly named. The "repeated
name" form is the latter; it should be used whenever the NAME argument
passed to make_tag includes characters that etags.el doesn't expect to
find in an identifier; see the function notinname and the comments
before make_tag.
It should have been the job of mercury_pr to find the identifier
itself within the line whose pointer it accepts as S, and pass only
that to make_tag as NAME/NAMELEN arguments. I made a step in that
direction, but it turns out I didn't go far enough. Feel free to
propose improvements to the code I installed so as to identify the
name of the identifier and nothing else, as other callers of make_tag
do.
> The issue seems to be located at the patch line below:
>
>
> + char *name = skip_non_spaces (s + len0);
The only problem with the above line is that it assumes there's only
one non-space "word" before the identifier proper, whereas the example
you show makes it clear there could be more than one. Which means the
code might need to repeatedly skip these non-identifier words until we
exhaust them all. I will look into fixing that (but I really prefer
that you do it in my stead, as I don't know enough about the Mercury's
syntax).
But other than that, the changes I installed are IMO a step in the
right direction: your original code incorrectly passed to make_tag the
same arguments as both NAME and LINESTART, and passed zero as NAMELEN,
which was the immediate reason why ctags didn't output anything for
Mercury sources. Please compare the way you called make_tag with how
the rest of the code calls that function.
> Pending a more accurate 'fix for the fix', it would probably be wiser to
> revert to original code, as it - at least - gives a correct output for
> 'etags' invocation.
The original code was incorrect, so it doesn't sound right to me to
revert to it. I will work on fixing the cases you described (unless
you beat me to it).
Thanks for turning my attention to this issue.
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Thu, 10 Jun 2021 19:16:02 GMT) Full text and rfc822 format available.Message #81 received at 47408 <at> debbugs.gnu.org (full text, mbox):
From: Eli Zaretskii <eliz <at> gnu.org> To: fabrnicol <at> gmail.com Cc: 47408 <at> debbugs.gnu.org Subject: Re: bug#47408: Etags support for Mercury [v0.5] Date: Thu, 10 Jun 2021 22:15:11 +0300
> Date: Thu, 10 Jun 2021 20:20:45 +0300 > From: Eli Zaretskii <eliz <at> gnu.org> > Cc: 47408 <at> debbugs.gnu.org > > It should have been the job of mercury_pr to find the identifier > itself within the line whose pointer it accepts as S, and pass only > that to make_tag as NAME/NAMELEN arguments. I made a step in that > direction, but it turns out I didn't go far enough. Feel free to > propose improvements to the code I installed so as to identify the > name of the identifier and nothing else, as other callers of make_tag > do. > > > The issue seems to be located at the patch line below: > > > > > > + char *name = skip_non_spaces (s + len0); > > The only problem with the above line is that it assumes there's only > one non-space "word" before the identifier proper, whereas the example > you show makes it clear there could be more than one. Which means the > code might need to repeatedly skip these non-identifier words until we > exhaust them all. I will look into fixing that (but I really prefer > that you do it in my stead, as I don't know enough about the Mercury's > syntax). I think one way of solving this would be for mercury_decl to return more information to the caller than it currently does. That function already performs the necessary analysis of the line, and knows where the real identifier is located within that line. But it doesn't return that information to the caller. If it could return the pointer to the beginning of the identifier and the length of the identifier, it would allow mercury_pr to call make_tag correctly without doing again what mercury_decl already did. If you agree with this analysis, I'd be grateful if you could submit a patch along these lines. TIA.
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Thu, 10 Jun 2021 20:39:01 GMT) Full text and rfc822 format available.Message #84 received at 47408 <at> debbugs.gnu.org (full text, mbox):
From: fabrice nicol <fabrnicol <at> gmail.com> To: Eli Zaretskii <eliz <at> gnu.org> Cc: pot <at> gnu.org, 47408 <at> debbugs.gnu.org Subject: bug#47408: Etags support for Mercury -- fix explicit tags for existentially-quantified procedures Date: Thu, 10 Jun 2021 22:39:29 +0200
Hi Eli,
>> your latest fix for Mercury 'etags' support has introduced a regression
>> for existentially quantified predicates.
> Is it a "regression" in the sense that "M-." no longer finds the
> definitions?
Exactly. M-. no longer finds the definition for
existentially-quantified predicates (or functions), so this is a
regression strictly speaking.
Prior code did not abide by pfnote input constraints, but it "just
worked" in all cases, at least for 'etags' invocation.
>> These predicates have the following (somewhat simplified) syntax (in
>> extended regexp form, \s for white space):
>>
>> :-[:blank:]+some[:blank:]*\[[:blank:]*T(,[:blank:]*[:upper:]{1})*[:blank:]*\][:blank:]+pred[:blank:]+([:lower:]+([:alnum:]|[:punct:])*)+[:blank:]*\([^()]+\)([:blank:]|[:lower:])*\.
>>
>> Example:
>>
>> :- some [T] pred unravel_univ(univ::in, T::out) is det.
>>
>> Your fix incorrectly outputs such quantified predicates. For example on
>> tagging univ.m (attached), your commit version yields:
>>
>>
>> :- some [T] pred unravel_univ(^?[T] pred unravel_univ^A141,4333
>>
>>
>> whilst my original code yields the correct tag:
>>
>>
>> :- some [T] pred unravel_univ(^?141,4333
> Why do you think the current result is incorrect, while the previous
> result was correct?
The previous code issued TAGS file that were correctly parsed by 'etags'
and so M-. / M-, "just worked" in all cases.
The new code introduces such chunks as "[T] pred " at the beginning of
explicit tags, which looks wrong and is likely to be the reason why
these explicit tags are not parsed, hence useless.
>
> The original code was incorrect, so it doesn't sound right to me to
> revert to it. I will work on fixing the cases you described (unless
> you beat me to it).
>
> Thanks for turning my attention to this issue.
I will not be able to spare enough free time to implement explicit tag
parsing for existential predicates before a couple of weeks, so in the
meantime, it would be safer to revert to original code and just
flag/blame it as 'to-be-fixed for ctags by FN.'
As I explained in prior mail, this is anyway a use case in which 'ctags'
is not useful at all, whilst 'etags' is.
Fabrice
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Fri, 11 Jun 2021 05:58:01 GMT) Full text and rfc822 format available.Message #87 received at 47408 <at> debbugs.gnu.org (full text, mbox):
From: Eli Zaretskii <eliz <at> gnu.org> To: fabrice nicol <fabrnicol <at> gmail.com> Cc: pot <at> gnu.org, 47408 <at> debbugs.gnu.org Subject: Re: bug#47408: Etags support for Mercury -- fix explicit tags for existentially-quantified procedures Date: Fri, 11 Jun 2021 08:56:55 +0300
> Cc: pot <at> gnu.org, 47408 <at> debbugs.gnu.org > From: fabrice nicol <fabrnicol <at> gmail.com> > Date: Thu, 10 Jun 2021 22:39:29 +0200 > > Prior code did not abide by pfnote input constraints, but it "just > worked" in all cases, at least for 'etags' invocation. I'm afraid that was by sheer luck. The call to make_tag was incorrect. > I will not be able to spare enough free time to implement explicit tag > parsing for existential predicates before a couple of weeks, so in the > meantime, it would be safer to revert to original code and just > flag/blame it as 'to-be-fixed for ctags by FN.' Will you work on this after that time, or should I not rely on it and do it myself? Two weeks is not too long a time to wait for a solution. > As I explained in prior mail, this is anyway a use case in which 'ctags' > is not useful at all, whilst 'etags' is. As Francesco and myself explained, that would make Mercury the only such language, which I think is undesirable (and unnecessary).
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Mon, 14 Jun 2021 15:10:01 GMT) Full text and rfc822 format available.Message #90 received at 47408 <at> debbugs.gnu.org (full text, mbox):
From: fabrice nicol <fabrnicol <at> gmail.com> To: 47408 <at> debbugs.gnu.org, Eli Zaretskii <eliz <at> gnu.org>, Francesco Potortì <pot <at> gnu.org> Subject: [PATCH] Etags support for Mercury -- fix explicit tags for existentially-quantified procedures Date: Mon, 14 Jun 2021 17:10:26 +0200
[Message part 1 (text/plain, inline)]
Hi, I'm sending the announced patch, which enables existentially-quantified procedures for both etags and ctags in Mercury etags/ctags support. Taking advantage of this to revise my prior contribution, I fixed an incidental issue (single-word declarations, which are very rare, were not tagged). I hope this works, Fabrice
[0001-Fix-explicit-tag-issue-with-Mercury-etags-ctags-supp.patch (text/x-patch, attachment)]
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Mon, 14 Jun 2021 16:05:02 GMT) Full text and rfc822 format available.Message #93 received at 47408 <at> debbugs.gnu.org (full text, mbox):
From: Eli Zaretskii <eliz <at> gnu.org> To: fabrice nicol <fabrnicol <at> gmail.com> Cc: 47408 <at> debbugs.gnu.org, pot <at> gnu.org Subject: Re: [PATCH] Etags support for Mercury -- fix explicit tags for existentially-quantified procedures Date: Mon, 14 Jun 2021 19:04:04 +0300
> From: fabrice nicol <fabrnicol <at> gmail.com> > Date: Mon, 14 Jun 2021 17:10:26 +0200 > > I'm sending the announced patch, which enables existentially-quantified > procedures for both etags and ctags in Mercury etags/ctags support. > > Taking advantage of this to revise my prior contribution, I fixed an > incidental issue (single-word declarations, which are very rare, were > not tagged). Thanks. I didn't yet try to apply and run the patch, but one aspect of the patch caused me to raise mu brow: > + char *name = xnew (pos + 1, char); > + size_t namelength = position.namelength; > + if (stop_at_rule && offset) --offset; > + > + /* Left-trim type definitions. */ > + > + while (pos > namelength + offset > + && c_isspace (s[pos - namelength - offset])) > + --offset; > + > + memcpy (name, s + pos - namelength - offset, namelength); > + > + /* There is no need to correct namelength or call notinname. */ > + name[namelength - 1] = '\0'; > + > + make_tag (name, namelength, true, s, pos, lineno, linecharno); > + free (name); Why do you copy the identifier's name into a newly-allocated buffer, instead of just passing 's + pos - namelength - offset' and 'namelength' as the first 2 arguments of make_tag? Isn't this xnew+memcpy+free dance here redundant? Or what did I miss?
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Mon, 14 Jun 2021 17:10:02 GMT) Full text and rfc822 format available.Message #96 received at 47408 <at> debbugs.gnu.org (full text, mbox):
From: fabrice nicol <fabrnicol <at> gmail.com> To: Eli Zaretskii <eliz <at> gnu.org> Cc: 47408 <at> debbugs.gnu.org, pot <at> gnu.org Subject: Re: [PATCH] Etags support for Mercury -- fix explicit tags for existentially-quantified procedures Date: Mon, 14 Jun 2021 19:10:53 +0200
Yes, I'm afraid that you missed something there this time around. If you take a look at other languages that implement explicit tags (like Fortran) you will see that there are buffers coming in to avoid having 'name' and 'linestart' (1st and 4th arguments to 'make_tag') share a same string pointer (here 's'). This is explained in the header comment to 'make_tag': " 2. LINESTART contains name as either a rightmost, or rightmost but * one character, substring;" which is a bit of a convoluted constraint: better protect oneself and bufferize from the ground up. In most cases (though perhaps with occasional exceptions), if I followed your suggestion, 'name' would be a substring with aon offset of at least +2 bytes from start of string s. When I applied you suggestion and tested, the TAGS base was as expected accordingly: wrong. Fabrice >> Thanks. I didn't yet try to apply and run the patch, but one aspect >> of the patch caused me to raise mu brow: >> >> + char *name = xnew (pos + 1, char); >> + size_t namelength = position.namelength; >> + if (stop_at_rule && offset) --offset; >> + >> + /* Left-trim type definitions. */ >> + >> + while (pos > namelength + offset >> + && c_isspace (s[pos - namelength - offset])) >> + --offset; >> + >> + memcpy (name, s + pos - namelength - offset, namelength); >> + >> + /* There is no need to correct namelength or call notinname. */ >> + name[namelength - 1] = '\0'; >> + >> + make_tag (name, namelength, true, s, pos, lineno, linecharno); >> + free (name); > Why do you copy the identifier's name into a newly-allocated buffer, > instead of just passing 's + pos - namelength - offset' and > 'namelength' as the first 2 arguments of make_tag? Isn't this > xnew+memcpy+free dance here redundant? Or what did I miss?
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Mon, 14 Jun 2021 17:43:01 GMT) Full text and rfc822 format available.Message #99 received at 47408 <at> debbugs.gnu.org (full text, mbox):
From: Eli Zaretskii <eliz <at> gnu.org> To: fabrice nicol <fabrnicol <at> gmail.com> Cc: 47408 <at> debbugs.gnu.org, pot <at> gnu.org Subject: Re: [PATCH] Etags support for Mercury -- fix explicit tags for existentially-quantified procedures Date: Mon, 14 Jun 2021 20:42:37 +0300
> Cc: 47408 <at> debbugs.gnu.org, pot <at> gnu.org > From: fabrice nicol <fabrnicol <at> gmail.com> > Date: Mon, 14 Jun 2021 19:10:53 +0200 > > If you take a look at other languages that implement explicit tags (like > Fortran) you will see that there are buffers coming in to avoid having > 'name' and 'linestart' (1st and 4th arguments to 'make_tag') share a > same string pointer (here 's'). > > This is explained in the header comment to 'make_tag': > > " 2. LINESTART contains name as either a rightmost, or rightmost but > * one character, substring;" This is just a condition for generating "implicitly named" tags. There's nothing wrong with having explicitly named tags, if there are good reasons for that. > When I applied you suggestion and tested, the TAGS base was as expected > accordingly: wrong. "Wrong" in what sense? Can you show an example of such a wrong tag? And how does Mercury differ from Prolog in this sense? prolog_pr doesn't allocate new strings before calling make_tag. Thanks.
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Mon, 14 Jun 2021 18:52:02 GMT) Full text and rfc822 format available.Message #102 received at 47408 <at> debbugs.gnu.org (full text, mbox):
From: fabrice nicol <fabrnicol <at> gmail.com> To: Eli Zaretskii <eliz <at> gnu.org> Cc: 47408 <at> debbugs.gnu.org, pot <at> gnu.org Subject: Re: [PATCH] Etags support for Mercury -- fix explicit tags for existentially-quantified procedures Date: Mon, 14 Jun 2021 20:52:54 +0200
[Message part 1 (text/plain, inline)]
Agreed. (But you may have more systematically explicit tags because of this condition 2.) The attached patch was tested, builds and runs OK. Replaces the former one, is you stick to the option of modifying 's' by reference rather than creating a copy. Note: Prolog has a much simpler naming pattern, so differences are normal. No need for explicit tagging in Prolog, see the call to 'make_tag' in Prolog support. Fabrice Le 14/06/2021 à 19:42, Eli Zaretskii a écrit : >> Cc: 47408 <at> debbugs.gnu.org, pot <at> gnu.org >> From: fabrice nicol <fabrnicol <at> gmail.com> >> Date: Mon, 14 Jun 2021 19:10:53 +0200 >> >> If you take a look at other languages that implement explicit tags (like >> Fortran) you will see that there are buffers coming in to avoid having >> 'name' and 'linestart' (1st and 4th arguments to 'make_tag') share a >> same string pointer (here 's'). >> >> This is explained in the header comment to 'make_tag': >> >> " 2. LINESTART contains name as either a rightmost, or rightmost but >> * one character, substring;" > This is just a condition for generating "implicitly named" tags. > There's nothing wrong with having explicitly named tags, if there are > good reasons for that. > >> When I applied you suggestion and tested, the TAGS base was as expected >> accordingly: wrong. > "Wrong" in what sense? Can you show an example of such a wrong tag? > And how does Mercury differ from Prolog in this sense? prolog_pr > doesn't allocate new strings before calling make_tag. > > Thanks.
[0001-Fix-explicit-tag-issue-with-Mercury-etags-ctags-supp-v2.patch (text/x-patch, attachment)]
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Thu, 17 Jun 2021 10:51:01 GMT) Full text and rfc822 format available.Message #105 received at 47408 <at> debbugs.gnu.org (full text, mbox):
From: Eli Zaretskii <eliz <at> gnu.org> To: fabrice nicol <fabrnicol <at> gmail.com> Cc: 47408 <at> debbugs.gnu.org, pot <at> gnu.org Subject: Re: [PATCH] Etags support for Mercury -- fix explicit tags for existentially-quantified procedures Date: Thu, 17 Jun 2021 13:50:09 +0300
> Cc: 47408 <at> debbugs.gnu.org, pot <at> gnu.org
> From: fabrice nicol <fabrnicol <at> gmail.com>
> Date: Mon, 14 Jun 2021 20:52:54 +0200
>
> Agreed. (But you may have more systematically explicit tags because of
> this condition 2.)
>
> The attached patch was tested, builds and runs OK. Replaces the former
> one, is you stick to the option of modifying 's' by reference rather
> than creating a copy.
Thanks. I confirm that this works, but I have 2 follow-up issues with
this patch:
1. It adds tags for some identifiers that AFAUI are actually
keywords, and shouldn't be in the TAGS tables. Examples:
"interface" (e.g., on line 146 of accumulator.m) and
"implementation" (e.g., on line 166). I guess this is unintended?
If so, how to fix it?
2. It always produces "explicitly named" tags, which I think is
unnecessary. AFAICT, this is related to the following snippet from
mercury_pr:
> + /* Left-trim type definitions. */
> +
> + while (pos > namelength + offset
> + && c_isspace (s[pos - namelength - offset]))
> + --offset;
> +
> + /* There is no need to correct namelength or call notinname. */
> + s[pos - offset - 1] = '\0';
> +
> + make_tag (s + pos - namelength - offset, namelength, true, s, pos, lineno, linecharno);
> + return pos;
I don't understand why you need to overwrite s[pos - offset -1]
with the null byte: the same effect could be obtained by adjusting
the POS argument passed to make_tag. Also, you in effect chop off
the last character of NAME, but don't adjust NAMELENGTH
accordingly. These factors together cause make_tag to decide that
an explicitly-named tag is in order, because name[namelength-1] is
a null byte, which is rejected as being "not-a-name" character.
To fix this second issue, I propose the change below, which should
be applied on top of your patches:
diff --git a/lib-src/etags.c b/lib-src/etags.c
index 370e825..2b0288e 100644
--- a/lib-src/etags.c
+++ b/lib-src/etags.c
@@ -6585,10 +6585,8 @@ mercury_pr (char *s, char *last, ptrdiff_t lastlen)
&& c_isspace (s[pos - namelength - offset]))
--offset;
- /* There is no need to correct namelength or call notinname. */
- s[pos - offset - 1] = '\0';
-
- make_tag (s + pos - namelength - offset, namelength, true, s, pos, lineno, linecharno);
+ make_tag (s + pos - namelength - offset, namelength - 1, true,
+ s, pos - offset - 1, lineno, linecharno);
return pos;
}
I've verified that etags after this change still produces the correct
TAGS file, including for the file univ.m you sent up-thread.
Do you agree with the changes I propose? If not, could you please
explain what I miss here?
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Thu, 17 Jun 2021 11:20:01 GMT) Full text and rfc822 format available.Message #108 received at 47408 <at> debbugs.gnu.org (full text, mbox):
From: Fabrice Nicol <fabrnicol <at> gmail.com> To: Eli Zaretskii <eliz <at> gnu.org> Cc: Francesco Potortì <pot <at> gnu.org>, 47408 <at> debbugs.gnu.org Subject: Re: [PATCH] Etags support for Mercury -- fix explicit tags for existentially-quantified procedures Date: Thu, 17 Jun 2021 13:19:26 +0200
[Message part 1 (text/plain, inline)]
Hi Eli, Thanks. I confirm that this works, but I have 2 follow-up issues with > this patch: > > 1. It adds tags for some identifiers that AFAUI are actually > keywords, and shouldn't be in the TAGS tables. Examples: > "interface" (e.g., on line 146 of accumulator.m) and > "implementation" (e.g., on line 166). I guess this is unintended? > If so, how to fix it? > This is intended. I commented this in the commit message (one-word declarations). I confirm that ':- implementation' and ':-interface' are *formally* declarations in Mercury as all others are. They were not included in the previous version bercause of an incomplete switch. It is quite useful from a practical point of view to add them to the tag base. When interfaces are big (they can reach a couple of thousand lines in real-world programming) it is sometimes useful to have a bookmark to jump to the start of the implementation section and back. I used to create an ad-hoc emacs bookmark for this. Tagging removes the need for this. Simply strike M-. at a blank line an select the interface/implementation tag. In the C family this is the same as striking M-. on an header include declaration and jumping to the header file and back. Some IDEs use F4 for this. Think of Mercury interfaces as C headers. > > > 2. It always produces "explicitly named" tags, which I think is > unnecessary. AFAICT, this is related to the following snippet from > mercury_pr: > > > + /* Left-trim type definitions. */ > > + > > + while (pos > namelength + offset > > + && c_isspace (s[pos - namelength - offset])) > > + --offset; > > + > > + /* There is no need to correct namelength or call notinname. */ > > + s[pos - offset - 1] = '\0'; > > + > > + make_tag (s + pos - namelength - offset, namelength, true, s, > pos, lineno, linecharno); > > + return pos; > > I don't understand why you need to overwrite s[pos - offset -1] > with the null byte: the same effect could be obtained by adjusting > the POS argument passed to make_tag. Also, you in effect chop off > the last character of NAME, but don't adjust NAMELENGTH > accordingly. These factors together cause make_tag to decide that > an explicitly-named tag is in order, because name[namelength-1] is > a null byte, which is rejected as being "not-a-name" character. > > To fix this second issue, I propose the change below, which should > be applied on top of your patches: > > diff --git a/lib-src/etags.c b/lib-src/etags.c > index 370e825..2b0288e 100644 > --- a/lib-src/etags.c > +++ b/lib-src/etags.c > @@ -6585,10 +6585,8 @@ mercury_pr (char *s, char *last, ptrdiff_t lastlen) > && c_isspace (s[pos - namelength - offset])) > --offset; > > - /* There is no need to correct namelength or call notinname. */ > - s[pos - offset - 1] = '\0'; > - > - make_tag (s + pos - namelength - offset, namelength, true, s, pos, > lineno, linecharno); > + make_tag (s + pos - namelength - offset, namelength - 1, true, > + s, pos - offset - 1, lineno, linecharno); > return pos; > } > > I've verified that etags after this change still produces the correct > TAGS file, including for the file univ.m you sent up-thread. > > Do you agree with the changes I propose? If not, could you please > explain what I miss here? > OK, this is another way of achieving an equivalent result. Please leave me until tomorrow to perform more tests so that I can formally confirm that this is fine. Best Fabrice >
[Message part 2 (text/html, inline)]
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Thu, 17 Jun 2021 11:43:01 GMT) Full text and rfc822 format available.Message #111 received at 47408 <at> debbugs.gnu.org (full text, mbox):
From: Eli Zaretskii <eliz <at> gnu.org> To: Fabrice Nicol <fabrnicol <at> gmail.com> Cc: pot <at> gnu.org, 47408 <at> debbugs.gnu.org Subject: Re: [PATCH] Etags support for Mercury -- fix explicit tags for existentially-quantified procedures Date: Thu, 17 Jun 2021 14:42:47 +0300
> From: Fabrice Nicol <fabrnicol <at> gmail.com> > Date: Thu, 17 Jun 2021 13:19:26 +0200 > Cc: Francesco Potortì <pot <at> gnu.org>, 47408 <at> debbugs.gnu.org > > 1. It adds tags for some identifiers that AFAUI are actually > keywords, and shouldn't be in the TAGS tables. Examples: > "interface" (e.g., on line 146 of accumulator.m) and > "implementation" (e.g., on line 166). I guess this is unintended? > If so, how to fix it? > > This is intended. I commented this in the commit message (one-word declarations). Understood, thanks. > To fix this second issue, I propose the change below, which should > be applied on top of your patches: > > diff --git a/lib-src/etags.c b/lib-src/etags.c > index 370e825..2b0288e 100644 > --- a/lib-src/etags.c > +++ b/lib-src/etags.c > @@ -6585,10 +6585,8 @@ mercury_pr (char *s, char *last, ptrdiff_t lastlen) > && c_isspace (s[pos - namelength - offset])) > --offset; > > - /* There is no need to correct namelength or call notinname. */ > - s[pos - offset - 1] = '\0'; > - > - make_tag (s + pos - namelength - offset, namelength, true, s, pos, lineno, linecharno); > + make_tag (s + pos - namelength - offset, namelength - 1, true, > + s, pos - offset - 1, lineno, linecharno); > return pos; > } > > I've verified that etags after this change still produces the correct > TAGS file, including for the file univ.m you sent up-thread. > > Do you agree with the changes I propose? If not, could you please > explain what I miss here? > > OK, this is another way of achieving an equivalent result. Please leave me until tomorrow to perform more > tests so that I can formally confirm that this is fine. Thanks. I also plan on adding a few lines from univ.m to accumulator.m, because those few lines use a feature accumulator.m doesn't. Is this OK with you?
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Thu, 17 Jun 2021 18:36:02 GMT) Full text and rfc822 format available.Message #114 received at 47408 <at> debbugs.gnu.org (full text, mbox):
From: fabrice nicol <fabrnicol <at> gmail.com> To: Eli Zaretskii <eliz <at> gnu.org> Cc: pot <at> gnu.org, 47408 <at> debbugs.gnu.org Subject: Re: [PATCH] Etags support for Mercury -- fix explicit tags for existentially-quantified procedures Date: Thu, 17 Jun 2021 20:36:56 +0200
[Message part 1 (text/plain, inline)]
Hi, Eli, I could finalize my tests against the entire Mercury library code. All is OK. I applied your patch on top of mine. Also, I added two new corner-case fixes, which are mentioned in the commit message: 1. The first new fix is for 0-arity predicates and functions. Yes, Mercury has them. (They play the role of global immutable constants in other languages). They happened not to be caught by the previous code, now they are. 2. I also removed module names from within tag names. The point is that module name prefixing is optional in most cases, so if you leave the module prefix within the tag, you will fail to get to the declaration when striking M-. on a (non-prefixed) predicate name. It is better to remove the name altogether. This will automatically trigger an explicit tag. Fabrice >> This is intended. I commented this in the commit message (one-word declarations). > Understood, thanks. > >> To fix this second issue, I propose the change below, which should >> be applied on top of your patches: >> >> diff --git a/lib-src/etags.c b/lib-src/etags.c >> index 370e825..2b0288e 100644 >> --- a/lib-src/etags.c >> +++ b/lib-src/etags.c >> @@ -6585,10 +6585,8 @@ mercury_pr (char *s, char *last, ptrdiff_t lastlen) >> && c_isspace (s[pos - namelength - offset])) >> --offset; >> >> - /* There is no need to correct namelength or call notinname. */ >> - s[pos - offset - 1] = '\0'; >> - >> - make_tag (s + pos - namelength - offset, namelength, true, s, pos, lineno, linecharno); >> + make_tag (s + pos - namelength - offset, namelength - 1, true, >> + s, pos - offset - 1, lineno, linecharno); >> return pos; >> } >> >> I've verified that etags after this change still produces the correct >> TAGS file, including for the file univ.m you sent up-thread. >> >> Do you agree with the changes I propose? If not, could you please >> explain what I miss here? >> >> OK, this is another way of achieving an equivalent result. Please leave me until tomorrow to perform more >> tests so that I can formally confirm that this is fine. > Thanks. > > I also plan on adding a few lines from univ.m to accumulator.m, > because those few lines use a feature accumulator.m doesn't. Is this > OK with you?
[0001-Fix-Mercury-support-notably-quantified-procedures.patch (text/x-patch, attachment)]
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Fri, 18 Jun 2021 11:30:01 GMT) Full text and rfc822 format available.Message #117 received at 47408 <at> debbugs.gnu.org (full text, mbox):
From: Eli Zaretskii <eliz <at> gnu.org> To: fabrice nicol <fabrnicol <at> gmail.com> Cc: pot <at> gnu.org, 47408 <at> debbugs.gnu.org Subject: Re: [PATCH] Etags support for Mercury -- fix explicit tags for existentially-quantified procedures Date: Fri, 18 Jun 2021 14:29:41 +0300
> Cc: pot <at> gnu.org, 47408 <at> debbugs.gnu.org > From: fabrice nicol <fabrnicol <at> gmail.com> > Date: Thu, 17 Jun 2021 20:36:56 +0200 > > I could finalize my tests against the entire Mercury library code. > > All is OK. I applied your patch on top of mine. > > Also, I added two new corner-case fixes, which are mentioned in the > commit message: > > 1. The first new fix is for 0-arity predicates and functions. Yes, > Mercury has them. (They play the role of global immutable constants in > other languages). > > They happened not to be caught by the previous code, now they are. > > 2. I also removed module names from within tag names. The point is that > module name prefixing is optional in most cases, so if you leave the > module prefix within the tag, you will fail to get to the declaration > when striking M-. on a (non-prefixed) predicate name. It is better to > remove the name altogether. This will automatically trigger an explicit tag. Thanks, installed.
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Fri, 18 Jun 2021 11:55:02 GMT) Full text and rfc822 format available.Message #120 received at 47408 <at> debbugs.gnu.org (full text, mbox):
From: Francesco Potortì <pot <at> gnu.org> To: fabrice nicol <fabrnicol <at> gmail.com> Cc: 47408 <at> debbugs.gnu.org, Eli Zaretskii <eliz <at> gnu.org> Subject: Re: [PATCH] Etags support for Mercury -- fix explicit tags for existentially-quantified procedures Date: Fri, 18 Jun 2021 13:54:54 +0200
> 2. I also removed module names from within tag names. The point is that
> module name prefixing is optional in most cases
I don't know about Mercurial, but this sounds similar to C++ classes:
the fully-qualified class name is not always necessary. When possible,
etags creates a fully-qualified name for the tag, like this:
I used ^? and ^A for the non-printable separation characters
ipc3dLinkControlSetup setup;^?CMultiChannelCSC19_3D::setup^A5,190
If that makes sense, maybe you could choose to do something similar for
Mercurial
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Fri, 18 Jun 2021 12:34:01 GMT) Full text and rfc822 format available.Message #123 received at 47408 <at> debbugs.gnu.org (full text, mbox):
From: Eli Zaretskii <eliz <at> gnu.org> To: Francesco Potortì <pot <at> gnu.org> Cc: fabrnicol <at> gmail.com, 47408 <at> debbugs.gnu.org Subject: Re: [PATCH] Etags support for Mercury -- fix explicit tags for existentially-quantified procedures Date: Fri, 18 Jun 2021 15:33:48 +0300
> From: Francesco Potortì <pot <at> gnu.org> > Date: Fri, 18 Jun 2021 13:54:54 +0200 > Cc: 47408 <at> debbugs.gnu.org, > Eli Zaretskii <eliz <at> gnu.org> > > > 2. I also removed module names from within tag names. The point is that > > module name prefixing is optional in most cases > > I don't know about Mercurial, but this sounds similar to C++ classes: > the fully-qualified class name is not always necessary. When possible, > etags creates a fully-qualified name for the tag, like this: Under the --class-qualify switch, yes. Maybe we should support that for Mercury as well.
bug-gnu-emacs <at> gnu.org:bug#47408; Package emacs.
(Fri, 18 Jun 2021 13:53:01 GMT) Full text and rfc822 format available.Message #126 received at 47408 <at> debbugs.gnu.org (full text, mbox):
From: fabrice nicol <fabrnicol <at> gmail.com> To: Eli Zaretskii <eliz <at> gnu.org>, Francesco Potortì <pot <at> gnu.org> Cc: 47408 <at> debbugs.gnu.org Subject: Re: [PATCH] Etags support for Mercury -- fix explicit tags for existentially-quantified procedures Date: Fri, 18 Jun 2021 15:53:26 +0200
Well, I suggest adding this to a todo-list, leaving things as they stand in the meantime. There are other features that might be added to this list too, possibly higher: - tag type non 0-arity type constructors (as in inbuilt Vim support); - tag embedded foreign code (at least for C): there is a lot of embedded C in real-world Mercury code; I'll keep this for the summer vacation. F. >>> 2. I also removed module names from within tag names. The point is that >>> module name prefixing is optional in most cases >> I don't know about Mercurial, but this sounds similar to C++ classes: >> the fully-qualified class name is not always necessary. When possible, >> etags creates a fully-qualified name for the tag, like this: > Under the --class-qualify switch, yes. Maybe we should support that > for Mercury as well.
Debbugs Internal Request <help-debbugs <at> gnu.org>
to internal_control <at> debbugs.gnu.org.
(Sat, 17 Jul 2021 11:24:04 GMT) Full text and rfc822 format available.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.