From unknown Fri Jun 20 07:17:25 2025 Content-Disposition: inline Content-Transfer-Encoding: quoted-printable MIME-Version: 1.0 X-Mailer: MIME-tools 5.509 (Entity 5.509) Content-Type: text/plain; charset=utf-8 From: bug#47408 <47408@debbugs.gnu.org> To: bug#47408 <47408@debbugs.gnu.org> Subject: Status: Emacs etags support for Mercury [v0.2] Reply-To: bug#47408 <47408@debbugs.gnu.org> Date: Fri, 20 Jun 2025 14:17:25 +0000 retitle 47408 Emacs etags support for Mercury [v0.2] reassign 47408 emacs submitter 47408 fabrice nicol severity 47408 normal tag 47408 patch thanks From debbugs-submit-bounces@debbugs.gnu.org Fri Mar 26 04:27:10 2021 Received: (at submit) by debbugs.gnu.org; 26 Mar 2021 08:27:10 +0000 Received: from localhost ([127.0.0.1]:40321 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lPhoC-0004i2-L7 for submit@debbugs.gnu.org; Fri, 26 Mar 2021 04:27:10 -0400 Received: from lists.gnu.org ([209.51.188.17]:51940) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lPgat-0000hV-NO for submit@debbugs.gnu.org; Fri, 26 Mar 2021 03:09:21 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:47074) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lPgat-0000qV-IQ for bug-gnu-emacs@gnu.org; Fri, 26 Mar 2021 03:09:19 -0400 Received: from mail-wr1-x42d.google.com ([2a00:1450:4864:20::42d]:42653) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1lPgap-00034r-Ui for bug-gnu-emacs@gnu.org; Fri, 26 Mar 2021 03:09:19 -0400 Received: by mail-wr1-x42d.google.com with SMTP id x13so4577288wrs.9 for ; Fri, 26 Mar 2021 00:09:15 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=subject:references:to:from:message-id:date:user-agent:mime-version :in-reply-to:content-language; bh=qK74/CctGBCnCxq8MW26S3AJQV/Z+/US3sVJhRJws+I=; b=nsCx4/zn54AyOhBmm7d64xDG3OtQMUsmnlNfLBLiR+w4XL5AwZdA+BKpPNBg9uy2p3 EtLs1d7ntVMvzhtSSi8BvfnPkw35HEcdbh5L6O5zbzN4HGRbgaQSxKMNL/BXpyuCK6MV 3eZEk+QQVdDBmnXHcncRBF0oKnymOkGW/zX/h9rJi0oTiHPR8KjHYmlHCdOLWdqpCuOT Sosu49m3aijVtGS3hpYmGmABBOXVA1ckwVLVprxo8S7iofZ+iHSUsL/0yQ54Gtq0nf+S Anl6CahxYOed73RqR5Nmc3iejWrp5HN5KuqO7ybwoeOtgzajlVP0zwbTnrJW5Q7FDai8 oM7w== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:subject:references:to:from:message-id:date :user-agent:mime-version:in-reply-to:content-language; bh=qK74/CctGBCnCxq8MW26S3AJQV/Z+/US3sVJhRJws+I=; b=OGKGq+qWwDAufSd+L3xJM3DofGxn7wNrZB+OrOwZVZkg/mHY5iyDGr/yr0VMEkSnQw 5rbBZpAnDeiY+sImAtZaZQbbpEv6EZF4F/6rFymz4oCMeJI5EhtfXfAEZRhvRMZzFKTQ uLsWtta+V2mZnqubFPyJiI8FWNb6NMtk+9I+FpihtCSPr+ASXP7P9YFDMMnOaxaNoIwi ++I27AkjS2HHjlaMxaXs/9fZSMaU5ug2XkQLa2Gmnxs0ZOc/dQgx3TsKukVnigEdCO8l vj+QRNDYD5LJwiF1q/SY5ygK2Py8IsJlfDFqpsp5bGXRfq9rpqj5T4yYtZDIPZQ28LKl z3oQ== X-Gm-Message-State: AOAM530hu8x75IsRBBCVpd06eFq39ZbnFred/IiuP7JKGTIEHsTnX7V8 Fz+Haf1edxkLAnr1I8+9Nozg1EfjLLsLOA== X-Google-Smtp-Source: ABdhPJy2DgbjgwnCjJFVe+yP8k+8vOtbho+d7zt/Ov5KBnu+F4k33XtgXBESzhPOT5CFFpOImo8aLw== X-Received: by 2002:adf:f8cd:: with SMTP id f13mr12339415wrq.27.1616742553594; Fri, 26 Mar 2021 00:09:13 -0700 (PDT) Received: from ?IPv6:2a01:cb1d:88b9:5c00:7b73:7901:965e:8523? ([2a01:cb1d:88b9:5c00:7b73:7901:965e:8523]) by smtp.gmail.com with ESMTPSA id m15sm10327619wrp.96.2021.03.26.00.09.12 for (version=TLS1_3 cipher=TLS_AES_128_GCM_SHA256 bits=128/128); Fri, 26 Mar 2021 00:09:13 -0700 (PDT) Subject: Emacs etags support for Mercury [v0.2] References: <25b8baef-11f2-7079-69d8-3207a24658fc@gmail.com> To: bug-gnu-emacs@gnu.org From: fabrice nicol X-Forwarded-Message-Id: <25b8baef-11f2-7079-69d8-3207a24658fc@gmail.com> Message-ID: Date: Fri, 26 Mar 2021 08:09:40 +0100 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Thunderbird/78.8.1 MIME-Version: 1.0 In-Reply-To: <25b8baef-11f2-7079-69d8-3207a24658fc@gmail.com> Content-Type: multipart/mixed; boundary="------------19B5DC828F28B24BA12F4B1F" Content-Language: en-US Received-SPF: pass client-ip=2a00:1450:4864:20::42d; envelope-from=fabrnicol@gmail.com; helo=mail-wr1-x42d.google.com X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_NONE=-0.0001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-Spam-Score: -1.3 (-) X-Debbugs-Envelope-To: submit X-Mailman-Approved-At: Fri, 26 Mar 2021 04:27:06 -0400 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -2.3 (--) This is a multi-part message in MIME format. --------------19B5DC828F28B24BA12F4B1F Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 8bit 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@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: > 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: 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@gnu.org> From: Eli Zaretskii Cc: emacs-devel@gnu.org In-Reply-To: (message from fabrice nicol on Mon, 22 Mar 2021 03:02:03 +0100) Subject: Re: etags support for the Mercury programming language References: > 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. --------------19B5DC828F28B24BA12F4B1F Content-Type: text/x-patch; charset=UTF-8; name="0001-Prepare-commit-for-submission-Mercury-etags-support.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename*0="0001-Prepare-commit-for-submission-Mercury-etags-support.pat"; filename*1="ch" >From 03c7e5cfa23196b2e3a5564be87a8bbd01730f81 Mon Sep 17 00:00:00 2001 From: Fabrice Nicol Date: Fri, 26 Mar 2021 06:15:43 +0100 Subject: [PATCH] Prepare commit for submission [Mercury etags support] --- doc/man/etags.1 | 25 +++- etc/NEWS | 9 ++ lib-src/etags.c | 371 +++++++++++++++++++++++++++++++++++++++++++++-- lisp/speedbar.el | 2 + 4 files changed, 394 insertions(+), 13 deletions(-) diff --git a/doc/man/etags.1 b/doc/man/etags.1 index c5c15fb182..903e38a145 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-25" "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. @@ -270,6 +270,23 @@ prints detailed information about how tags are created for LANG. .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). +.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. + .SH "SEE ALSO" "\|\fBemacs\fP\|" entry in \fBinfo\fP; \fIGNU Emacs Manual\fP, Richard diff --git a/etc/NEWS b/etc/NEWS index 68812c64cc..f3455b341f 100644 --- 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 +--- +** Etags support for the Mercury programming language (https://mercurylang.org). +** New etags command line options '-M/-m' or --with-mercury-definitions/all'. +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 '--with-mercury-all'. If run with '-m' or +'--with-mercury-definitions', only declarations will be tagged. Both options +imply --language=mercury. + +++ ** 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/etags.c b/lib-src/etags.c index b5c18e0e01..9019b619d4 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -359,6 +359,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 *); @@ -502,6 +503,8 @@ #define STDIN 0x1001 /* returned by getopt_long on --parse-stdin */ { "ignore-case-regex", required_argument, NULL, 'c' }, { "parse-stdin", required_argument, NULL, STDIN }, { "version", no_argument, NULL, 'V' }, + { "with-mercury-all", no_argument, NULL, 'M' }, + { "with-mercury-definitions", no_argument, NULL, 'm' }, #if CTAGS /* Ctags options */ { "backward-search", no_argument, NULL, 'B' }, @@ -621,7 +624,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 [] = @@ -683,10 +685,21 @@ #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", /* Use option -l mercury to switch from Objective C to Mercury. */ + 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 --with-mercury-definitions."; +static bool with_mercury_definitions = false; + static const char *Objc_suffixes [] = - { "lm", /* Objective lex file */ - "m", /* Objective C file */ - NULL }; + {"lm", + "m", /* By default, Objective C 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\ @@ -773,7 +786,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 [] = @@ -824,6 +836,7 @@ #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}, + { "mercury", Mercury_help, Mercury_functions, Mercury_suffixes }, { "objc", Objc_help, plain_C_entries, Objc_suffixes }, { "pascal", Pascal_help, Pascal_functions, Pascal_suffixes }, { "perl",Perl_help,Perl_functions,Perl_suffixes,NULL,Perl_interpreters}, @@ -1061,6 +1074,17 @@ print_help (argument *argbuffer) which you like."); } + puts ("-m, --mercury-declarations\n\ + For the Mercury programming language, only tag declarations.\n\ + Declarations start a line with :- \n\ + Implies --language=mercury."); + + puts ("-M, --mercury-all\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."); + puts ("-V, --version\n\ Print the version of the program.\n\ -h, --help\n\ @@ -1111,7 +1135,7 @@ main (int argc, char **argv) /* 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:", ""); @@ -1202,6 +1226,17 @@ main (int argc, char **argv) case 'Q': class_qualify = 1; break; + 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; /* Etags options */ case 'D': constantypedefs = false; break; @@ -1281,6 +1316,22 @@ main (int argc, char **argv) pfatal (tagfile); } + /* /\* Settle the Mercury/Objective C file extension issue. *\/ */ + + /* if (parsing_mercury) */ + /* { */ + /* Objc_suffixes = */ + /* { "lm", /\* Objective lex file *\/ */ + /* NULL }; /\* Remove .m from Obj_c identification. *\/ */ + /* Mercury_suffixes = {"m", NULL}; */ + /* } */ + /* else */ + /* { */ + /* Objc_suffixes = /\* Standard Objective C specification *\/ */ + /* {"lm", "m", NULL}; */ + /* Mercury_suffixes = {NULL}; */ + /* } */ + /* * Loop through files finding functions. */ @@ -2297,7 +2348,7 @@ invalidate_nodes (fdesc *badfdp, node **npp) } } - + static ptrdiff_t total_size_of_entries (node *); static int number_len (intmax_t) ATTRIBUTE_CONST; @@ -3222,7 +3273,7 @@ consider_token (char *str, /* IN: token pointer */ return false; } - + /* * C_entries often keeps pointers to tokens or lines which are older than * the line currently read. By keeping two line buffers, and switching @@ -5890,7 +5941,8 @@ Prolog_functions (FILE *inf) { if (cp[0] == '\0') /* Empty line */ continue; - else if (c_isspace (cp[0])) /* Not a predicate */ + else if (c_isspace (cp[0]) || cp[0] == '%') + /* Not a predicate or comment */ continue; else if (cp[0] == '/' && cp[1] == '*') /* comment. */ prolog_skip_comment (&lb, inf); @@ -6019,6 +6071,307 @@ 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 + * --with-mercury-definitions 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; + +static void +Mercury_functions (FILE *inf) +{ + char *cp, *last = NULL; + ptrdiff_t lastlen = 0, allocated = 0; + + 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: + * :-( + * If with_mercury_definitions == true, we also add: + * ( + * or :- + * 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; + + uint8_t 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/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) -- 2.26.3 --------------19B5DC828F28B24BA12F4B1F-- From debbugs-submit-bounces@debbugs.gnu.org Fri Mar 26 07:35:25 2021 Received: (at control) by debbugs.gnu.org; 26 Mar 2021 11:35:25 +0000 Received: from localhost ([127.0.0.1]:40534 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lPkkP-0005Ia-DS for submit@debbugs.gnu.org; Fri, 26 Mar 2021 07:35:25 -0400 Received: from quimby.gnus.org ([95.216.78.240]:59910) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lPkkO-0005IM-5n for control@debbugs.gnu.org; Fri, 26 Mar 2021 07:35:24 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnus.org; s=20200322; h=Subject:From:To:Message-Id:Date:Sender:Reply-To:Cc: MIME-Version:Content-Type:Content-Transfer-Encoding:Content-ID: Content-Description:Resent-Date:Resent-From:Resent-Sender:Resent-To:Resent-Cc :Resent-Message-ID:In-Reply-To:References:List-Id:List-Help:List-Unsubscribe: List-Subscribe:List-Post:List-Owner:List-Archive; bh=EoKwOiptI9UBXYU5PDELAPRa4dqriaWYh+8ZQr5zLTk=; b=KTCJJiRcO5sv1IcpGG+pWpchm5 ZVNStgVdnJ72FKLWgzQxC/elZJTotledvnEykSc5x56eDIWJEFO2KxRenyxQm/CIaYroyBup8z+So FIa79yeJEATH2jOi65XdJs5jpwer6N5yliWypRI7XTtDsej5UqBSpQbLvZq55QKXE11U=; Received: from cm-84.212.220.105.getinternet.no ([84.212.220.105] helo=xo) by quimby.gnus.org with esmtpsa (TLS1.3:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1lPkkF-0000mu-Je for control@debbugs.gnu.org; Fri, 26 Mar 2021 12:35:17 +0100 Date: Fri, 26 Mar 2021 12:35:14 +0100 Message-Id: <87im5e87wt.fsf@gnus.org> To: control@debbugs.gnu.org From: Lars Ingebrigtsen Subject: control message for bug #47408 X-Spam-Report: Spam detection software, running on the system "quimby.gnus.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see @@CONTACT_ADDRESS@@ for details. Content preview: tags 47408 + patch quit Content analysis details: (-2.9 points, 5.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- -1.0 ALL_TRUSTED Passed through trusted hosts only via SMTP -1.9 BAYES_00 BODY: Bayes spam probability is 0 to 1% [score: 0.0000] X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: control X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) tags 47408 + patch quit From debbugs-submit-bounces@debbugs.gnu.org Sat Mar 27 11:39:49 2021 Received: (at 47408) by debbugs.gnu.org; 27 Mar 2021 15:39:49 +0000 Received: from localhost ([127.0.0.1]:44743 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lQB2S-0005cC-Fo for submit@debbugs.gnu.org; Sat, 27 Mar 2021 11:39:49 -0400 Received: from mail-wm1-f47.google.com ([209.85.128.47]:40705) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lQ6Ww-0002hG-Ma for 47408@debbugs.gnu.org; Sat, 27 Mar 2021 06:51:00 -0400 Received: by mail-wm1-f47.google.com with SMTP id y124-20020a1c32820000b029010c93864955so6130070wmy.5 for <47408@debbugs.gnu.org>; Sat, 27 Mar 2021 03:50:58 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=to:from:subject:message-id:date:user-agent:mime-version :content-language; bh=1qXB6CLllaOx/Ifp4Aco1zGgbQWqYPrr4sSfXEli/GA=; b=fifhjBHTnrSWNlTak8Q9PYqkyqiDtaww9Dguxje7XXcdv38kAcwgZzMxVTAO6+QQhn KNIQeeuqaaZKERfnzXOoTgb89qwm59y8vImZ5CoLTTWMxwu0A6aE6gZBQ77aWWB5Qks1 OcXTWPo1gUGIwERLMjSsTBUfMUyrI4JBkXGcmdmvTzhWTiG7+kHM9jlH/9lDg5Zx+411 jxnY7CSZCiws2Me0KcRn32IJqkqM15oZ8wIUZOWXeevU4OTvru0f8ydrjxJTqfOW5fQQ ZEpXBattbIyE3kENH2qfQrhEHPHZ4TjEhXB9DLbZPeHPeLfis4KOP7L6Hj1F+zAhX6+C wLbA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:to:from:subject:message-id:date:user-agent :mime-version:content-language; bh=1qXB6CLllaOx/Ifp4Aco1zGgbQWqYPrr4sSfXEli/GA=; b=avDN1PkR18mmYF/KQ1kV+TtB7VzSYPmOCcy1V4wmNSGFS5DFgsSl5bPzR2sGy4EXnW F5Vfrgg274GJ5ublWOhdZZDbJImZDVD+WPhO9HElmv7QX8MMk4pzebe6J7T2yFSeoxYI EYq+qX2FuzbqBMGrwdMK3yCV+iELVxvTbpEzPPSpDO2n5nGTQWc71skJPxckypWgY3TZ LrmUGNmkiorCensFGtV68J2/0GHQj9FPoqQv//iVXt+r4WQJsjYXZVn0OBehDcjTGyrc ONaJvbDSWUZrdvrErmN6CvoDooCRZ7D2fZ7jK4KU/P0LCp48wQtKn7vCY1xLpkf577az CZbQ== X-Gm-Message-State: AOAM532ZgerlHcCTijaqoDppr4Bnhi04Qubo0m9GnAPOCE9xdJnKnbb1 oxf1GMOT+nlyVJSxvV/p5BqQ1mzmHRs= X-Google-Smtp-Source: ABdhPJzCifPzjiPqzc0L2+jjjG7KkY0BeP3lGIVuizRXOtzkjd5EihsHJz2vkdqlBgN0qCh+mr8A3Q== X-Received: by 2002:a1c:c1:: with SMTP id 184mr9049991wma.143.1616842252567; Sat, 27 Mar 2021 03:50:52 -0700 (PDT) Received: from ?IPv6:2a01:cb1d:88b9:5c00:7b73:7901:965e:8523? ([2a01:cb1d:88b9:5c00:7b73:7901:965e:8523]) by smtp.gmail.com with ESMTPSA id l1sm17363939wrv.87.2021.03.27.03.50.51 for <47408@debbugs.gnu.org> (version=TLS1_3 cipher=TLS_AES_128_GCM_SHA256 bits=128/128); Sat, 27 Mar 2021 03:50:51 -0700 (PDT) To: 47408@debbugs.gnu.org From: fabrice nicol Subject: Etags support for Mercury [v0.3] Message-ID: <5ba2fec3-3f61-fb7e-35eb-7188fa6064a4@gmail.com> Date: Sat, 27 Mar 2021 11:51:22 +0100 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Thunderbird/78.8.1 MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="------------CAE36B3A8BD255920925A15F" Content-Language: en-US X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 47408 X-Mailman-Approved-At: Sat, 27 Mar 2021 11:39:47 -0400 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) This is a multi-part message in MIME format. --------------CAE36B3A8BD255920925A15F Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 7bit 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 --------------CAE36B3A8BD255920925A15F Content-Type: text/x-patch; charset=UTF-8; name="0001-Fixed-regressions-caused-by-Objc-Mercury-ambiguous-f.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename*0="0001-Fixed-regressions-caused-by-Objc-Mercury-ambiguous-f.pa"; filename*1="tch" >From 50f3f9a0d46d11d0ac096f79f0d5aa1bc17b7920 Mon Sep 17 00:00:00 2001 From: Fabrice Nicol Date: Sat, 27 Mar 2021 10:16:44 +0100 Subject: [PATCH] Fixed regressions caused by Objc/Mercury ambiguous file extension .m. --- doc/man/etags.1 | 25 ++- etc/NEWS | 9 + lib-src/etags.c | 444 ++++++++++++++++++++++++++++++++++++++++++++--- lisp/speedbar.el | 2 + 4 files changed, 455 insertions(+), 25 deletions(-) diff --git a/doc/man/etags.1 b/doc/man/etags.1 index c5c15fb182..903e38a145 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-25" "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. @@ -270,6 +270,23 @@ prints detailed information about how tags are created for LANG. .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). +.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. + .SH "SEE ALSO" "\|\fBemacs\fP\|" entry in \fBinfo\fP; \fIGNU Emacs Manual\fP, Richard diff --git a/etc/NEWS b/etc/NEWS index 68812c64cc..4af4e76371 100644 --- 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 +--- +** 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. + +++ ** 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/etags.c b/lib-src/etags.c index b5c18e0e01..53e04794dd 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -142,7 +142,13 @@ 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 */ +#ifndef MERCURY_HEURISTICS_RATIO +# define MERCURY_HEURISTICS_RATIO 0.02 +#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 +365,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 +385,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); @@ -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 [] = @@ -683,10 +690,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", /* Use option -l mercury to switch from Objective C to Mercury. */ + 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 -M or --declarations."; +static bool with_mercury_definitions = false; +double mercury_heuristics_ratio = MERCURY_HEURISTICS_RATIO; + static const char *Objc_suffixes [] = - { "lm", /* Objective lex file */ - "m", /* Objective C file */ - NULL }; + {"lm", + "m", /* By default, Objective C 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\ @@ -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 [] = @@ -824,7 +842,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 }, @@ -1061,6 +1081,17 @@ print_help (argument *argbuffer) which you like."); } + 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."); + puts ("-V, --version\n\ Print the version of the program.\n\ -h, --help\n\ @@ -1111,7 +1142,7 @@ main (int argc, char **argv) /* 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:", ""); @@ -1202,9 +1233,20 @@ main (int argc, char **argv) case 'Q': class_qualify = 1; break; + 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; /* Etags options */ - case 'D': constantypedefs = false; break; + case 'D': constantypedefs = false; break; case 'i': included_files[nincluded_files++] = optarg; break; /* Ctags options. */ @@ -1298,19 +1340,19 @@ main (int argc, char **argv) analyze_regex (argbuffer[i].what); break; case at_filename: - this_file = argbuffer[i].what; - /* Input file named "-" means read file names from stdin - (one per line) and use them. */ - if (streq (this_file, "-")) - { - if (parsing_stdin) - fatal ("cannot parse standard input " - "AND read file names from it"); - while (readline_internal (&filename_lb, stdin, "-") > 0) - process_file_name (filename_lb.buffer, lang); - } - else - process_file_name (this_file, lang); + this_file = argbuffer[i].what; + /* Input file named "-" means read file names from stdin + (one per line) and use them. */ + if (streq (this_file, "-")) + { + if (parsing_stdin) + fatal ("cannot parse standard input " + "AND read file names from it"); + while (readline_internal (&filename_lb, stdin, "-") > 0) + process_file_name (filename_lb.buffer, lang); + } + else + process_file_name (this_file, lang); break; case at_stdin: this_file = argbuffer[i].what; @@ -1775,6 +1817,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 +6066,361 @@ 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 + * -M/--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; + +/* To robustly disambiguate between Objective C and Mercury, parse file + with the following heuristics hook: + (number of occurrences of non-blank, non-fully-commented lines + comprising ':-' at the start of line)/ number of lines > mercury_heuristics_ratio */ + +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) return; + int c; + uint64_t lines = 1; + uint64_t mercury_decls = 0; + bool blank_line = false; + bool start_of_line = true; + + while ((c = fgetc(fp)) != EOF) + { + switch (c) + { + case '\n': + if (! blank_line) ++lines; + blank_line = true; + start_of_line = true; + break; + case '%': FALLTHROUGH; + case ' ': FALLTHROUGH; + case '\t': + start_of_line = false; + break; + case ':': + if (! start_of_line) break; + start_of_line = false; + c = fgetc(fp); + if (c == '-') ++mercury_decls; + break; + default: + start_of_line = false; + blank_line = false; + } + } + + double ratio = 0; + ratio = ((double) mercury_decls ) / lines; + 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: + * :-( + * If with_mercury_definitions == true, we also add: + * ( + * or :- + * 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; + + uint8_t 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/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) -- 2.26.3 --------------CAE36B3A8BD255920925A15F-- From debbugs-submit-bounces@debbugs.gnu.org Sun Mar 28 09:11:54 2021 Received: (at 47408) by debbugs.gnu.org; 28 Mar 2021 13:11:54 +0000 Received: from localhost ([127.0.0.1]:45534 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lQVCr-00022w-OM for submit@debbugs.gnu.org; Sun, 28 Mar 2021 09:11:54 -0400 Received: from eggs.gnu.org ([209.51.188.92]:57758) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lQVCp-00022k-LI for 47408@debbugs.gnu.org; Sun, 28 Mar 2021 09:11:52 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:52212) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lQVCk-0003GK-F6; Sun, 28 Mar 2021 09:11:46 -0400 Received: from 84.94.185.95.cable.012.net.il ([84.94.185.95]:4147 helo=home-c4e4a596f7) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1lQVCj-0008BR-NP; Sun, 28 Mar 2021 09:11:46 -0400 Date: Sun, 28 Mar 2021 16:11:51 +0300 Message-Id: <834kgvo220.fsf@gnu.org> From: Eli Zaretskii To: fabrice nicol In-Reply-To: <5ba2fec3-3f61-fb7e-35eb-7188fa6064a4@gmail.com> (message from fabrice nicol on Sat, 27 Mar 2021 11:51:22 +0100) Subject: Re: bug#47408: Etags support for Mercury [v0.3] References: <5ba2fec3-3f61-fb7e-35eb-7188fa6064a4@gmail.com> MIME-version: 1.0 Content-type: text/plain; charset=utf-8 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.7 (/) X-Debbugs-Envelope-To: 47408 Cc: 47408@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.7 (-) > From: fabrice nicol > 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 > 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. From debbugs-submit-bounces@debbugs.gnu.org Sun Mar 28 11:48:57 2021 Received: (at 47408) by debbugs.gnu.org; 28 Mar 2021 15:48:57 +0000 Received: from localhost ([127.0.0.1]:46810 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lQXeq-0006GS-SL for submit@debbugs.gnu.org; Sun, 28 Mar 2021 11:48:57 -0400 Received: from mail-wr1-f41.google.com ([209.85.221.41]:43912) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lQXen-0006G9-KB for 47408@debbugs.gnu.org; Sun, 28 Mar 2021 11:48:55 -0400 Received: by mail-wr1-f41.google.com with SMTP id x7so10367625wrw.10 for <47408@debbugs.gnu.org>; Sun, 28 Mar 2021 08:48:53 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:subject:references:to:message-id:date:user-agent:mime-version :in-reply-to:content-language; bh=CbPAWbD3/rI7ibXFy1FyoAVEtEq8KSaCWmsdgB2dtSg=; b=HG1UVTkiqnTfj0DVVIY9YreHRR6pOwXhpRSmOBJql5e/Y4mXEzVlKRPWEfgSwsYe4a VwWEX3KUSlbgUcxxIyDIDbszgZeuh3NDkR9EC6yAnfqAioPc1gFs7ES1+cCQL3+6iiR2 TmIPnMNe+cD3qd2szc66pHq4qkP02Rhim4i+XE2iLX9FRz/p1zHgLojDi/SkqPFvhQ1+ bKNjZayaWsog6TGIU2loxWOyVk/+Wyx5OmlVSTUIHEP7ZpDLZ3HvA6e2WFnxA1yTusRo Sj1nhvOLegN3eBEmGVAPDeN6SMWVMOOCmT8kZgEwvS/uUCpW8XzJ6r7nLQ8yAan7f63P d9wA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:subject:references:to:message-id:date :user-agent:mime-version:in-reply-to:content-language; bh=CbPAWbD3/rI7ibXFy1FyoAVEtEq8KSaCWmsdgB2dtSg=; b=E3t5X3DpwBjaeU7x1GBBeOGCOMbf4cQ0Ltduu3XqTuFFihTEtK+gbeU0wsfaWTdow2 wk9aOA0yxh8NLCynrRrCL0n7nXeBMyDB1EPjcVBjEOeG48+fCGYAWrQU08F6qOrfqlEz pCOUl//9C6xKYmpfu6LXXFx3qcpH47qoSguLIFLPnU7uymc69aT9K/kq95IDDQsMFTcq 4LkJu2du931uFpXkqBXVicJ2SlubTqDWw/r9j4fOscS5W1UUR3+kmjcwwdferFGLBZlW m7AkDKtndnvH1m7po6GbO/CEhBSEDkfbF2utMi/zZcwVnthWsiJAo5v43OASpBMle5Ub RQJg== X-Gm-Message-State: AOAM530oVeJ2ztAhsNBLnKYUQjf9tRdYhuwYb5zQwuk+X2JxDT/3BYJT /Gf4In+s0dQTu8GykVtW1Qv0qh6PHtc= X-Google-Smtp-Source: ABdhPJyG1ONmj/lnCi295chVkdKURaIhn1SnhpAEQihcHqbQqr8pGySykpmHFsnoYyhVpCEng31tGQ== X-Received: by 2002:adf:ec83:: with SMTP id z3mr24118831wrn.59.1616946527547; Sun, 28 Mar 2021 08:48:47 -0700 (PDT) Received: from ?IPv6:2a01:cb1d:88b9:5c00:7b73:7901:965e:8523? ([2a01:cb1d:88b9:5c00:7b73:7901:965e:8523]) by smtp.gmail.com with ESMTPSA id c131sm21537368wma.37.2021.03.28.08.48.47 for <47408@debbugs.gnu.org> (version=TLS1_3 cipher=TLS_AES_128_GCM_SHA256 bits=128/128); Sun, 28 Mar 2021 08:48:47 -0700 (PDT) From: fabrice nicol Subject: Re: bug#47408: Etags support for Mercury [v0.3] References: <5ba2fec3-3f61-fb7e-35eb-7188fa6064a4@gmail.com> <834kgvo220.fsf@gnu.org> To: 47408@debbugs.gnu.org Message-ID: <97f573da-ec63-7362-13c2-ca28a6634480@gmail.com> Date: Sun, 28 Mar 2021 17:49:20 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Thunderbird/78.9.0 MIME-Version: 1.0 In-Reply-To: <834kgvo220.fsf@gnu.org> Content-Type: multipart/alternative; boundary="------------F072051EFF8E1E91D0356A3F" Content-Language: en-US X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 47408 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) This is a multi-part message in MIME format. --------------F072051EFF8E1E91D0356A3F Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 8bit 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. --------------F072051EFF8E1E91D0356A3F Content-Type: text/html; charset=utf-8 Content-Transfer-Encoding: 8bit

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 = &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.
--------------F072051EFF8E1E91D0356A3F-- From debbugs-submit-bounces@debbugs.gnu.org Sun Mar 28 12:22:14 2021 Received: (at 47408) by debbugs.gnu.org; 28 Mar 2021 16:22:14 +0000 Received: from localhost ([127.0.0.1]:46866 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lQYB4-0000mQ-0w for submit@debbugs.gnu.org; Sun, 28 Mar 2021 12:22:14 -0400 Received: from eggs.gnu.org ([209.51.188.92]:38754) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lQYB2-0000ly-6L for 47408@debbugs.gnu.org; Sun, 28 Mar 2021 12:22:12 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:55002) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lQYAx-0005XY-0N; Sun, 28 Mar 2021 12:22:07 -0400 Received: from 84.94.185.95.cable.012.net.il ([84.94.185.95]:4948 helo=home-c4e4a596f7) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1lQYAw-0002nN-EK; Sun, 28 Mar 2021 12:22:06 -0400 Date: Sun, 28 Mar 2021 19:22:15 +0300 Message-Id: <83o8f3meo8.fsf@gnu.org> From: Eli Zaretskii To: fabrice nicol In-Reply-To: <97f573da-ec63-7362-13c2-ca28a6634480@gmail.com> (message from fabrice nicol on Sun, 28 Mar 2021 17:49:20 +0200) Subject: Re: bug#47408: Etags support for Mercury [v0.3] References: <5ba2fec3-3f61-fb7e-35eb-7188fa6064a4@gmail.com> <834kgvo220.fsf@gnu.org> <97f573da-ec63-7362-13c2-ca28a6634480@gmail.com> X-Spam-Score: -0.7 (/) X-Debbugs-Envelope-To: 47408 Cc: 47408@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.7 (-) > From: fabrice nicol > 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. From debbugs-submit-bounces@debbugs.gnu.org Mon Mar 29 07:53:00 2021 Received: (at 47408) by debbugs.gnu.org; 29 Mar 2021 11:53:01 +0000 Received: from localhost ([127.0.0.1]:48013 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lQqS4-0004TU-RL for submit@debbugs.gnu.org; Mon, 29 Mar 2021 07:53:00 -0400 Received: from mail-wm1-f54.google.com ([209.85.128.54]:41484) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lQqS2-0004TH-Uc for 47408@debbugs.gnu.org; Mon, 29 Mar 2021 07:52:59 -0400 Received: by mail-wm1-f54.google.com with SMTP id t5-20020a1c77050000b029010e62cea9deso6535029wmi.0 for <47408@debbugs.gnu.org>; Mon, 29 Mar 2021 04:52:58 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=subject:to:references:from:message-id:date:user-agent:mime-version :in-reply-to:content-language; bh=6Flpc1tYsHhnxK0aC/tshvqw0AasDfPuRTllN0+aN0w=; b=buIWW2fPZ3za5cM+5ei/GkCVCkzqkLsmRQk9U1ky2dciNTKnlnBfn8ckGWJEP3yQ9i dHzOE7a2cY97QZ1YZBLtdMqqQrF7relPthJt/ooLhLRrQQPiHimSpYLRqD5Ll1ZoMo3V 7Mlr+ZgBFpoFdcJj9ef7S3DKNuXjK9+PrR9oqaFqKpla5YX6o/+f2vER8YORqz4Vixwt lN318qcHuDRAtv4c9+Gf+zRLgOpVDtcV0H0CN/5iTH54q0IJRtxypUUFdnpW8yiXCU0l Exv8okA4VTylD1K2k8g1A2pZNSCu5BQK6EnMYqOGaNFn7nOP7paQmVPOaD/A2G51VVfn Z7AA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:subject:to:references:from:message-id:date :user-agent:mime-version:in-reply-to:content-language; bh=6Flpc1tYsHhnxK0aC/tshvqw0AasDfPuRTllN0+aN0w=; b=mw4S0yqTIiTcp1v6UZfVxCQaMWxVSBRsm6keKUlAgDVZWZIUyLJlTcQdW25LX9L/xu SCdHH6XK5KULWJ97oMhCgWve61Y4vc881uCNc2Tjf7s72PYbdaTexWLZ85MLKIKVNk9H QjQWtJzMPBF+Dn8kf75/uoj64x11prnGdv6wpgW/ELfAE+GmAeiWHVzehrT79rJeuhmQ +oOhVb3+j4lS75sFaTkbR5jtCIQsgY9E1/t7VsyJYxM9myh6RX+qZ66UqzdrA8eZUycO T2uHmPwpV5duzFOPj24Um7/04qlgYUggNY8P6XaKUQjabQsIbtiz4URx3n34rd3a4jKg Ojmw== X-Gm-Message-State: AOAM5328ZEKfbX6dRvuvdYD4V8B8+Foly2uGihK6tsBB/abtY58Bf9dP WgS/TSkCYFc66J7qO8iuUaWlZ+9+cj4= X-Google-Smtp-Source: ABdhPJyQQQ/4htsH3nhHCUcRq921ox98n0/hAP+a6quLmIXh/Sk4gBI/mOuP+0ZS+gCnBRA6QOsK3A== X-Received: by 2002:a1c:c282:: with SMTP id s124mr24423137wmf.99.1617018772939; Mon, 29 Mar 2021 04:52:52 -0700 (PDT) Received: from ?IPv6:2a01:cb1d:88b9:5c00:7b73:7901:965e:8523? ([2a01:cb1d:88b9:5c00:7b73:7901:965e:8523]) by smtp.gmail.com with ESMTPSA id o5sm23028448wrx.60.2021.03.29.04.52.51 for <47408@debbugs.gnu.org> (version=TLS1_3 cipher=TLS_AES_128_GCM_SHA256 bits=128/128); Mon, 29 Mar 2021 04:52:51 -0700 (PDT) Subject: bug#47408: Etags support for Mercury [v0.4] To: 47408@debbugs.gnu.org References: <5ba2fec3-3f61-fb7e-35eb-7188fa6064a4@gmail.com> <834kgvo220.fsf@gnu.org> <97f573da-ec63-7362-13c2-ca28a6634480@gmail.com> <83o8f3meo8.fsf@gnu.org> From: fabrice nicol Message-ID: Date: Mon, 29 Mar 2021 13:53:26 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Thunderbird/78.9.0 MIME-Version: 1.0 In-Reply-To: <83o8f3meo8.fsf@gnu.org> Content-Type: multipart/mixed; boundary="------------AD1429F63D3329A3230DD426" Content-Language: en-US X-Debbugs-Envelope-To: 47408 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" This is a multi-part message in MIME format. --------------AD1429F63D3329A3230DD426 Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 8bit 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 >> 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. --------------AD1429F63D3329A3230DD426 Content-Type: text/x-patch; charset=UTF-8; name="0001-Add-etags-support-for-Mercury-v0.4.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="0001-Add-etags-support-for-Mercury-v0.4.patch" >From a0781212917457d3569de941c80364523a422c08 Mon Sep 17 00:00:00 2001 From: Fabrice Nicol 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: + * :-( + * If with_mercury_definitions == true, we also add: + * ( + * or :- + * 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("""") to + // determine it. However constructing the 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 --------------AD1429F63D3329A3230DD426-- From debbugs-submit-bounces@debbugs.gnu.org Sat May 15 04:31:57 2021 Received: (at 47408) by debbugs.gnu.org; 15 May 2021 08:31:57 +0000 Received: from localhost ([127.0.0.1]:47489 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lhpiH-0002oA-4f for submit@debbugs.gnu.org; Sat, 15 May 2021 04:31:57 -0400 Received: from eggs.gnu.org ([209.51.188.92]:55414) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lhpiF-0002nx-7X for 47408@debbugs.gnu.org; Sat, 15 May 2021 04:31:55 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:37966) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lhpiA-0007Si-0C; Sat, 15 May 2021 04:31:50 -0400 Received: from 84.94.185.95.cable.012.net.il ([84.94.185.95]:1995 helo=home-c4e4a596f7) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lhpi8-00078g-8F; Sat, 15 May 2021 04:31:49 -0400 Date: Sat, 15 May 2021 11:31:47 +0300 Message-Id: <838s4gxurw.fsf@gnu.org> From: Eli Zaretskii To: fabrice nicol In-Reply-To: <70503251-f8ea-9006-b7e7-b13b93bb71de@gmail.com> (message from fabrice nicol on Wed, 12 May 2021 18:35:43 +0200) Subject: Re: Fwd: bug#47408: Etags support for Mercury [v0.4] References: <70503251-f8ea-9006-b7e7-b13b93bb71de@gmail.com> MIME-version: 1.0 Content-type: text/plain; charset=utf-8 Content-Transfer-Encoding: 8bit X-Debbugs-Envelope-To: 47408 Cc: 47408@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" > From: fabrice nicol > 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 a écrit : > > From: fabrice nicol > > 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 > Pour : 47408@debbugs.gnu.org > > Attached is the new patch that integrates your indications. > > Please note two points: > > 1. Now that -m/-M have been done with, there is no use specifying any Mercury-specific behavior for > --no-defines. > > Actually the Mercury community consensus is that all declarations should be tagged in any case. > > So --no-defines is just the default behavior of etags run without any option and does not need to be used > explicitly or specifically documented. > > I followed your indications about --declarations. I also added a line to etags.1 about --language=mercury or > --language=objc, should the heuristic test fail to detect the right language. Note, however, that removing > language-specific options comes at a price. The heuristic test has now to be more complex. I had errless > detection results against my test base of 4,000 mercury files and 500 Obj.-C files. This looks satisfactory > but I had to tweak the heuristic test function (test_objc_is_mercury) quite a bit to weed out detection failures. > > I added the ChangeLog, the requested test file (array.m) under test/manual/etags/merc-src and altered the > corresponding Makefile accordingly. > > 2. I removed my added line to speedbar.el, which in the end did not prove very useful. It is located in a > Xemacs compatibility layer that is no longer used by most users. > > Le 28/03/2021 à 18:22, Eli Zaretskii a écrit : > > From: fabrice nicol > 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 > 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: > + * :-( > + * If with_mercury_definitions == true, we also add: > + * ( > + * or :- > + * 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("""") to > + // determine it. However constructing the 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 > > From debbugs-submit-bounces@debbugs.gnu.org Sat May 29 04:01:03 2021 Received: (at 47408) by debbugs.gnu.org; 29 May 2021 08:01:03 +0000 Received: from localhost ([127.0.0.1]:55910 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lmtu3-0006Ei-97 for submit@debbugs.gnu.org; Sat, 29 May 2021 04:01:03 -0400 Received: from eggs.gnu.org ([209.51.188.92]:59578) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lmtu0-0006E6-8o for 47408@debbugs.gnu.org; Sat, 29 May 2021 04:01:02 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:38066) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lmttu-0000CX-WB; Sat, 29 May 2021 04:00:55 -0400 Received: from 84.94.185.95.cable.012.net.il ([84.94.185.95]:3180 helo=home-c4e4a596f7) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lmtts-0006bJ-Fq; Sat, 29 May 2021 04:00:54 -0400 Date: Sat, 29 May 2021 11:01:01 +0300 Message-Id: <838s3y6kaq.fsf@gnu.org> From: Eli Zaretskii To: fabrice nicol In-Reply-To: <53162dfb-0715-3077-78d1-3a8340943f2f@gmail.com> (message from fabrice nicol on Sat, 15 May 2021 12:19:26 +0200) Subject: Re: Fwd: bug#47408: Etags support for Mercury [v0.4] References: <70503251-f8ea-9006-b7e7-b13b93bb71de@gmail.com> <838s4gxurw.fsf@gnu.org> <53162dfb-0715-3077-78d1-3a8340943f2f@gmail.com> X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 47408 Cc: 47408@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) [Please use Reply All to have the bug address on the CC list.] > From: fabrice nicol > 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. From debbugs-submit-bounces@debbugs.gnu.org Sat May 29 06:22:26 2021 Received: (at 47408) by debbugs.gnu.org; 29 May 2021 10:22:26 +0000 Received: from localhost ([127.0.0.1]:56050 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lmw6s-0003QL-0D for submit@debbugs.gnu.org; Sat, 29 May 2021 06:22:26 -0400 Received: from eggs.gnu.org ([209.51.188.92]:49868) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lmw6q-0003Q7-Ja for 47408@debbugs.gnu.org; Sat, 29 May 2021 06:22:24 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:40024) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lmw6k-0007Hq-V8; Sat, 29 May 2021 06:22:19 -0400 Received: from 84.94.185.95.cable.012.net.il ([84.94.185.95]:4559 helo=home-c4e4a596f7) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lmw6k-0006Qz-Hy; Sat, 29 May 2021 06:22:18 -0400 Date: Sat, 29 May 2021 13:22:24 +0300 Message-Id: <83pmx96dr3.fsf@gnu.org> From: Eli Zaretskii To: Fabrice Nicol In-Reply-To: (message from Fabrice Nicol on Sat, 29 May 2021 12:06:57 +0200) Subject: Re: Fwd: bug#47408: Etags support for Mercury [v0.4] References: <70503251-f8ea-9006-b7e7-b13b93bb71de@gmail.com> <838s4gxurw.fsf@gnu.org> <53162dfb-0715-3077-78d1-3a8340943f2f@gmail.com> <838s3y6kaq.fsf@gnu.org> X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 47408 Cc: 47408@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) [Once again, please use Reply All, to keep the bug address on the CC list.] > From: Fabrice Nicol > 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. From debbugs-submit-bounces@debbugs.gnu.org Mon May 31 22:38:23 2021 Received: (at 47408) by debbugs.gnu.org; 1 Jun 2021 02:38:23 +0000 Received: from localhost ([127.0.0.1]:35354 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lnuIR-0001At-OI for submit@debbugs.gnu.org; Mon, 31 May 2021 22:38:23 -0400 Received: from mail-wr1-f42.google.com ([209.85.221.42]:42923) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lnuIQ-0001Ah-84 for 47408@debbugs.gnu.org; Mon, 31 May 2021 22:38:22 -0400 Received: by mail-wr1-f42.google.com with SMTP id c5so1397746wrq.9 for <47408@debbugs.gnu.org>; Mon, 31 May 2021 19:38:22 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:subject:to:cc:references:message-id:date:user-agent :mime-version:in-reply-to:content-language; bh=H/spTJ+rs9GnbZo2t9XzQTLMyTIpAoFtXyRFpgpRe2k=; b=mplJAFusuFgkY0/ZL9VcYfCrDkZ7wTPeQ4IKk/HSzHgCnALNPEVhe5Iz8iL27SU1f6 vfCYfGVbV2+5tQq/ucb/0DyX48Z3ourLCAbGhPDqEF0gpY0USIIcg7ftscAkPN1wEg3L +UTxHE0Eqh9PzmQh0LXw9vada9yP1yfEYMmARZDpARPmPan2518SN/T76mMIGFdGTKsi srwQ7//oM8GXB8yXrMY3fYc5HP1CdNx3O8wWzkZeY/3eg/6R3tHZWe/VN8Xlb3ahrGXp Xh32RiyTzeeJiXQ60vgb1Kv/w28Q6PdpUXa6SOML70/2NU6kXzfhSxO+mIjmOPGmpozG rscQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:subject:to:cc:references:message-id:date :user-agent:mime-version:in-reply-to:content-language; bh=H/spTJ+rs9GnbZo2t9XzQTLMyTIpAoFtXyRFpgpRe2k=; b=f0T3qHIAlxFf9AFdWlLjiv2eV2kvFYNsx+gDmiCyUtZOY18LdR0fgnn5TpY9b4lzMJ m+YPvnMA++5SB3slwHNePlgWO75ejuq4hfDH05JBkJeK70CVCE83KrhqJuvUeJHQnnD5 rplNFnT5Fnimtf8OMm5kx64plbkiUh6vcK/eQ4D5dAnUwF7UE25qs+sIsPXl7L8VGNcv Ne82XOEh0JwOY+qH30ZaebTBZ7K99dKc6VjgWhBIfPq288v1O0TNvH4yR8P7F2YApgIg q6t50DITGtPW2VOF4zE2IG4UnJ24vcsGjm/rypXvv+g3tPC++2gfXTIXJveeBJVNlQ06 jFcw== X-Gm-Message-State: AOAM530P4Oybu65zHeixuvHtBcrHJD15w84SC8GhnSHEy46vflBSPY3q BhmHp4EalMgr8agTHnm7BI/WsP+QCAM= X-Google-Smtp-Source: ABdhPJwcdIoprYiw9Ho3JDu/Elkr8Q9JPoqhWxPGGLoiDtLheWt0OLupAczTztNdIa5wPLJd+TzPVg== X-Received: by 2002:adf:9c93:: with SMTP id d19mr24592692wre.17.1622515095705; Mon, 31 May 2021 19:38:15 -0700 (PDT) Received: from ?IPv6:2a01:cb1d:88b9:5c00:7b73:7901:965e:8523? ([2a01:cb1d:88b9:5c00:7b73:7901:965e:8523]) by smtp.gmail.com with ESMTPSA id 11sm17113030wmo.24.2021.05.31.19.38.14 (version=TLS1_3 cipher=TLS_AES_128_GCM_SHA256 bits=128/128); Mon, 31 May 2021 19:38:15 -0700 (PDT) From: fabrice nicol Subject: bug#47408: Etags support for Mercury [v0.5] To: Eli Zaretskii References: <70503251-f8ea-9006-b7e7-b13b93bb71de@gmail.com> <838s4gxurw.fsf@gnu.org> <53162dfb-0715-3077-78d1-3a8340943f2f@gmail.com> <838s3y6kaq.fsf@gnu.org> Message-ID: Date: Tue, 1 Jun 2021 04:38:56 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Thunderbird/78.10.2 MIME-Version: 1.0 In-Reply-To: <838s3y6kaq.fsf@gnu.org> Content-Type: multipart/mixed; boundary="------------922E82C30E426081894B2236" Content-Language: en-US X-Debbugs-Envelope-To: 47408 Cc: 47408@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" This is a multi-part message in MIME format. --------------922E82C30E426081894B2236 Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 7bit 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 --------------922E82C30E426081894B2236 Content-Type: text/x-patch; charset=UTF-8; name="0001-Add-etags-support-for-Mercury-[v0.5].patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="0001-Add-etags-support-for-Mercury-[v0.5].patch" >From f52a7dee78949190aafe716d01654ee647f3dc61 Mon Sep 17 00:00:00 2001 From: Fabrice Nicol Date: Tue, 1 Jun 2021 04:15:59 +0200 Subject: [PATCH] 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. --- doc/man/etags.1 | 23 +- etc/NEWS | 7 + lib-src/etags.c | 490 +++++- test/manual/etags/Makefile | 3 +- test/manual/etags/merc-src/accumulator.m | 1954 ++++++++++++++++++++++ 5 files changed, 2464 insertions(+), 13 deletions(-) create mode 100644 test/manual/etags/merc-src/accumulator.m diff --git a/doc/man/etags.1 b/doc/man/etags.1 index 354f6ca88b..cbd3c1a646 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, Rust, PHP, PostScript, Python, Prolog, Scheme and -most assembler\-like syntaxes. +Forth, Go, HTML, LaTeX, Emacs Lisp/Common Lisp, Lua, Makefile, Mercury, Pascal, +Perl, Ruby, Rust, 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 always +tagged. In addition, this option 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 6622861aaf..c9c5c97719 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -111,6 +111,13 @@ filters. * 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/etags.c b/lib-src/etags.c index d703183cef..ac1fbb4df5 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 *); @@ -379,6 +387,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); @@ -684,10 +693,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\ @@ -831,7 +852,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 }, @@ -958,6 +981,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."); @@ -1783,6 +1809,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; @@ -6070,6 +6101,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: + * :-( + * If with_mercury_definitions == true, we also add: + * ( + * or :- + * 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 8d56db29b7..b3a82fdba8 100644 --- a/test/manual/etags/Makefile +++ b/test/manual/etags/Makefile @@ -16,6 +16,7 @@ HTMLSRC= #JAVASRC=$(addprefix ./java-src/, ) LUASRC=$(addprefix ./lua-src/,allegro.lua test.lua) MAKESRC=$(addprefix ./make-src/,Makefile) +MERCSRC=$(addprefix ./merc-src/,accumulator.m) OBJCSRC=$(addprefix ./objc-src/,Subprocess.h Subprocess.m PackInsp.h PackInsp.m) OBJCPPSRC=$(addprefix ./objcpp-src/,SimpleCalc.H SimpleCalc.M) PASSRC=$(addprefix ./pas-src/,common.pas) @@ -32,7 +33,7 @@ YSRC= SRCS=${ADASRC} ${ASRC} ${CSRC} ${CPSRC} ${ELSRC} ${ERLSRC} ${FSRC}\ ${FORTHSRC} ${GOSRC} ${HTMLSRC} ${JAVASRC} ${LUASRC} ${MAKESRC}\ ${OBJCSRC} ${OBJCPPSRC} ${PASSRC} ${PHPSRC} ${PERLSRC} ${PSSRC}\ - ${PROLSRC} ${PYTSRC} ${RBSRC} ${RSSRC} ${SCMSRC} ${TEXSRC} ${YSRC} + ${PROLSRC} ${PYTSRC} ${RBSRC} ${RSSRC} ${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/accumulator.m b/test/manual/etags/merc-src/accumulator.m new file mode 100644 index 0000000000..94a6b1d858 --- /dev/null +++ b/test/manual/etags/merc-src/accumulator.m @@ -0,0 +1,1954 @@ +%---------------------------------------------------------------------------% +% vim: ft=mercury ts=4 sw=4 et +%---------------------------------------------------------------------------% +% Copyright (C) 1999-2000,2002-2007, 2009-2012 The University of Melbourne. +% Copyright (C) 2015 The Mercury team. +% This file may only be copied under the terms of the GNU General +% Public License - see the file COPYING in the Mercury distribution. +%---------------------------------------------------------------------------% +% +% Module: accumulator.m. +% Main authors: petdr. +% +% Attempts to transform a single proc to a tail recursive form by +% introducing accumulators. The algorithm can do this if the code after +% the recursive call has either the order independent state update or +% associative property. +% +% /* Order independent State update property */ +% :- promise all [A,B,S0,S] +% ( +% (some[SA] (update(A, S0, SA), update(B, SA, S))) +% <=> +% (some[SB] (update(B, S0, SB), update(A, SB, S))) +% ). +% +% /* Associativity property */ +% :- promise all [A,B,C,ABC] +% ( +% (some[AB] (assoc(A, B, AB), assoc(AB, C, ABC))) +% <=> +% (some[BC] (assoc(B, C, BC), assoc(A, BC, ABC))) +% ). +% +% XXX What about exceptions and non-termination? +% +% The promise declarations above only provide promises about the declarative +% semantics, but in order to apply this optimization, we ought to check that +% it will preserve the operational semantics (modulo whatever changes are +% allowed by the language semantics options). +% +% Currently we check and respect the --fully-strict option, but not the +% --no-reorder-conj option. XXX we should check --no-reorder-conj! +% If --no-reorder-conj was set, it would still be OK to apply this +% transformation, but ONLY in cases where the goals which get reordered +% are guaranteed not to throw any exceptions. +% +% The algorithm implemented is a combination of the algorithms from +% "Making Mercury Programs Tail Recursive" and +% "State Update Transformation", which can be found at +% . +% +% Note that currently "State Update Transformation" paper only resides +% in CVS papers archive in the directory update, but has been submitted +% to PPDP '00. +% +% The transformation recognises predicates in the form +% +% p(In, OutUpdate, OutAssoc) :- +% minimal(In), +% initialize(OutUpdate), +% base(OutAssoc). +% p(In, OutUpdate, OutAssoc) :- +% decompose(In, Current, Rest), +% p(Rest, OutUpdate0, OutAssoc0), +% update(Current, OutUpdate0, OutUpdate), +% assoc(Current, OutAssoc0, OutAssoc). +% +% which can be transformed by the algorithm in "State Update Transformation" to +% +% p(In, OutUpdate, OutAssoc) :- +% initialize(AccUpdate), +% p_acc(In, OutUpdate, OutAssoc, AccUpdate). +% +% p_acc(In, OutUpdate, OutAssoc, AccUpdate) :- +% minimal(In), +% base(OutAssoc), +% OutUpdate = AccUpdate. +% p_acc(In, OutUpdate, OutAssoc, AccUpdate0) :- +% decompose(In, Current, Rest), +% update(Current, AccUpdate0, AccUpdate), +% p_acc(Rest, OutUpdate, OutAssoc0, AccUpdate), +% assoc(Current, OutAssoc0, OutAssoc). +% +% we then apply the algorithm from "Making Mercury Programs Tail Recursive" +% to p_acc to obtain +% +% p_acc(In, OutUpdate, OutAssoc, AccUpdate) :- +% minimal(In), +% base(OutAssoc), +% OutUpdate = AccUpdate. +% p_acc(In, OutUpdate, OutAssoc, AccUpdate0) :- +% decompose(In, Current, Rest), +% update(Current, AccUpdate0, AccUpdate), +% p_acc2(Rest, OutUpdate, OutAssoc, AccUpdate, Current). +% +% p_acc2(In, OutUpdate, OutAssoc, AccUpdate0, AccAssoc0) :- +% minimal(In), +% base(Base), +% assoc(AccAssoc0, Base, OutAssoc), +% OutUpdate = AccUpdate0. +% p_acc2(In, OutUpdate, OutAssoc, AccUpdate0, AccAssoc0) :- +% decompose(In, Current, Rest), +% update(Current, AccUpdate0, AccUpdate), +% assoc(AccAssoc0, Current, AccAssoc), +% p_acc2(Rest, OutUpdate, OutAssoc, AccUpdate, AccAssoc). +% +% p_acc is no longer recursive and is only ever called from p, so we +% inline p_acc into p to obtain the final schema. +% +% p(In, OutUpdate, OutAssoc) :- +% minimal(In), +% base(OutAssoc), +% initialize(AccUpdate), +% OutUpdate = AccUpdate. +% p(In, OutUpdate, OutAssoc) :- +% decompose(In, Current, Rest), +% initialize(AccUpdate0), +% update(Current, AccUpdate0, AccUpdate), +% p_acc2(Rest, OutUpdate, OutAssoc, AccUpdate, Current). +% +% p_acc2(In, OutUpdate, OutAssoc, AccUpdate0, AccAssoc0) :- +% minimal(In), +% base(Base), +% assoc(AccAssoc0, Base, OutAssoc), +% OutUpdate = AccUpdate0. +% p_acc2(In, OutUpdate, OutAssoc, AccUpdate0, AccAssoc0) :- +% decompose(In, Current, Rest), +% update(Current, AccUpdate0, AccUpdate), +% assoc(AccAssoc0, Current, AccAssoc), +% p_acc2(Rest, OutUpdate, OutAssoc, AccUpdate, AccAssoc). +% +% The only real difficulty in this new transformation is identifying the +% initialize/1 and base/1 goals from the original base case. +% +% Note that if the recursive clause contains multiple calls to p, the +% transformation attempts to move each recursive call to the end +% until one succeeds. This makes the order of independent recursive +% calls in the body irrelevant. +% +% XXX Replace calls to can_reorder_goals with calls to the version that +% use the intermodule-analysis framework. +% +%---------------------------------------------------------------------------% + +:- module transform_hlds.accumulator. +:- interface. + +:- import_module hlds. +:- import_module hlds.hlds_module. +:- import_module hlds.hlds_pred. + +:- import_module univ. + + % Attempt to transform a procedure into accumulator recursive form. + % If we succeed, we will add the recursive version of the procedure + % to the module_info. However, we may also encounter errors, which + % we will add to the list of error_specs in the univ accumulator. + % +:- pred accu_transform_proc(pred_proc_id::in, pred_info::in, + proc_info::in, proc_info::out, module_info::in, module_info::out, + univ::in, univ::out) is det. + +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% + +:- implementation. + +:- import_module hlds.assertion. +:- import_module hlds.goal_util. +:- import_module hlds.hlds_error_util. +:- import_module hlds.hlds_goal. +:- import_module hlds.hlds_out. +:- import_module hlds.hlds_out.hlds_out_util. +:- import_module hlds.hlds_promise. +:- import_module hlds.instmap. +:- import_module hlds.pred_table. +:- import_module hlds.quantification. +:- import_module hlds.status. +:- import_module hlds.vartypes. +:- import_module libs. +:- import_module libs.globals. +:- import_module libs.optimization_options. +:- import_module libs.options. +:- import_module mdbcomp. +:- import_module mdbcomp.sym_name. +:- import_module parse_tree. +:- import_module parse_tree.error_util. +:- import_module parse_tree.prog_data. +:- import_module parse_tree.prog_mode. +:- import_module parse_tree.prog_util. +:- import_module parse_tree.set_of_var. +:- import_module transform_hlds.goal_store. + +:- import_module assoc_list. +:- import_module bool. +:- import_module int. +:- import_module io. +:- import_module list. +:- import_module map. +:- import_module maybe. +:- import_module pair. +:- import_module require. +:- import_module set. +:- import_module solutions. +:- import_module string. +:- import_module term. +:- import_module varset. + +%---------------------------------------------------------------------------% + + % The form of the goal around the base and recursive cases. + % +:- type top_level + ---> switch_base_rec + ; switch_rec_base + ; disj_base_rec + ; disj_rec_base + ; ite_base_rec + ; ite_rec_base. + + % An accu_goal_id represents a goal. The first field says which conjunction + % the goal came from (the base case or the recursive case), and the second + % gives the location of the goal in that conjunction. + % +:- type accu_goal_id + ---> accu_goal_id(accu_case, int). + +:- type accu_case + ---> accu_base + ; accu_rec. + + % The goal_store associates a goal with each goal_id. + % +:- type accu_goal_store == goal_store(accu_goal_id). + + % A substitution from the first variable name to the second. + % +:- type accu_subst == map(prog_var, prog_var). + +:- type accu_warning + ---> accu_warn(prog_context, pred_id, prog_var, prog_var). + % Warn that two prog_vars in a call to pred_id at the given context + % were swapped, which may cause an efficiency problem. + +%---------------------------------------------------------------------------% + +accu_transform_proc(proc(PredId, ProcId), PredInfo, !ProcInfo, !ModuleInfo, + !Cookie) :- + module_info_get_globals(!.ModuleInfo, Globals), + globals.get_opt_tuple(Globals, OptTuple), + DoLCMC = OptTuple ^ ot_opt_lcmc_accumulator, + globals.lookup_bool_option(Globals, fully_strict, FullyStrict), + ( if + should_attempt_accu_transform(!ModuleInfo, PredId, ProcId, PredInfo, + !ProcInfo, FullyStrict, DoLCMC, Warnings) + then + globals.lookup_bool_option(Globals, very_verbose, VeryVerbose), + ( + VeryVerbose = yes, + trace [io(!IO)] ( + module_info_get_name(!.ModuleInfo, ModuleName), + get_progress_output_stream(Globals, ModuleName, + ProgressStream, !IO), + PredStr = pred_id_to_string(!.ModuleInfo, PredId), + io.format(ProgressStream, + "%% Accumulators introduced into %s\n", [s(PredStr)], !IO) + ) + ; + VeryVerbose = no + ), + + ( + Warnings = [] + ; + Warnings = [_ | _], + pred_info_get_context(PredInfo, Context), + PredPieces = describe_one_pred_name(!.ModuleInfo, + should_module_qualify, PredId), + InPieces = [words("In") | PredPieces] ++ [suffix(":"), nl], + InMsg = simple_msg(Context, + [option_is_set(warn_accumulator_swaps, yes, + [always(InPieces)])]), + + proc_info_get_varset(!.ProcInfo, VarSet), + generate_warnings(!.ModuleInfo, VarSet, Warnings, WarnMsgs), + ( + Warnings = [_], + EnsurePieces = [words("Please ensure that this"), + words("argument rearrangement does not introduce"), + words("performance problems.")] + ; + Warnings = [_, _ | _], + EnsurePieces = [words("Please ensure that these"), + words("argument rearrangements do not introduce"), + words("performance problems.")] + ), + SuppressPieces = + [words("These warnings can be suppressed by"), + quote("--no-warn-accumulator-swaps"), suffix(".")], + VerbosePieces = [words("If a predicate has been declared"), + words("associative"), + words("via a"), quote("promise"), words("declaration,"), + words("the compiler will rearrange the order of"), + words("the arguments in calls to that predicate,"), + words("if by so doing it makes the containing predicate"), + words("tail recursive. In such situations, the compiler"), + words("will issue this warning. If this reordering"), + words("changes the performance characteristics"), + words("of the call to the predicate, use"), + quote("--no-accumulator-introduction"), + words("to turn the optimization off, or "), + quote("--no-warn-accumulator-swaps"), + words("to turn off the warnings.")], + EnsureSuppressMsg = simple_msg(Context, + [option_is_set(warn_accumulator_swaps, yes, + [always(EnsurePieces), always(SuppressPieces)]), + verbose_only(verbose_once, VerbosePieces)]), + Severity = severity_conditional(warn_accumulator_swaps, yes, + severity_warning, no), + Msgs = [InMsg | WarnMsgs] ++ [EnsureSuppressMsg], + Spec = error_spec($pred, Severity, phase_accumulator_intro, Msgs), + + det_univ_to_type(!.Cookie, Specs0), + Specs = [Spec | Specs0], + type_to_univ(Specs, !:Cookie) + ) + else + true + ). + +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% + +:- pred generate_warnings(module_info::in, prog_varset::in, + list(accu_warning)::in, list(error_msg)::out) is det. + +generate_warnings(_, _, [], []). +generate_warnings(ModuleInfo, VarSet, [Warning | Warnings], [Msg | Msgs]) :- + generate_warning(ModuleInfo, VarSet, Warning, Msg), + generate_warnings(ModuleInfo, VarSet, Warnings, Msgs). + +:- pred generate_warning(module_info::in, prog_varset::in, accu_warning::in, + error_msg::out) is det. + +generate_warning(ModuleInfo, VarSet, Warning, Msg) :- + Warning = accu_warn(Context, PredId, VarA, VarB), + PredPieces = describe_one_pred_name(ModuleInfo, should_module_qualify, + PredId), + + varset.lookup_name(VarSet, VarA, VarAName), + varset.lookup_name(VarSet, VarB, VarBName), + + Pieces = [words("warning: the call to")] ++ PredPieces ++ + [words("has had the location of the variables"), + quote(VarAName), words("and"), quote(VarBName), + words("swapped to allow accumulator introduction."), nl], + Msg = simplest_msg(Context, Pieces). + +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% + + % should_attempt_accu_transform is only true iff the current proc + % has been transformed to call the newly created accumulator proc. + % +:- pred should_attempt_accu_transform(module_info::in, module_info::out, + pred_id::in, proc_id::in, pred_info::in, proc_info::in, proc_info::out, + bool::in, maybe_opt_lcmc_accumulator::in, + list(accu_warning)::out) is semidet. + +should_attempt_accu_transform(!ModuleInfo, PredId, ProcId, PredInfo, + !ProcInfo, FullyStrict, DoLCMC, Warnings) :- + proc_info_get_goal(!.ProcInfo, Goal0), + proc_info_get_headvars(!.ProcInfo, HeadVars), + proc_info_get_initial_instmap(!.ModuleInfo, !.ProcInfo, InitialInstMap), + accu_standardize(Goal0, Goal), + identify_goal_type(PredId, ProcId, Goal, InitialInstMap, + TopLevel, Base, BaseInstMap, Rec, RecInstMap), + + C = initialize_goal_store(Rec, RecInstMap, Base, BaseInstMap), + identify_recursive_calls(PredId, ProcId, C, RecCallIds), + list.length(Rec, M), + + should_attempt_accu_transform_2(!ModuleInfo, PredId, PredInfo, !ProcInfo, + HeadVars, InitialInstMap, TopLevel, FullyStrict, DoLCMC, + RecCallIds, C, M, Rec, Warnings). + + % should_attempt_accu_transform_2 takes a list of locations of the + % recursive calls, and attempts to introduce accumulator into each of the + % recursive calls, stopping at the first one that succeeds. + % This catches the following case, as selecting the first recursive call + % allows the second recursive call to be moved before it, and + % OutA is in the correct spot in list.append. + % + % p(InA, OutA), + % p(InB, OutB), + % list.append(OutB, OutA, Out) + % +:- pred should_attempt_accu_transform_2(module_info::in, module_info::out, + pred_id::in, pred_info::in, proc_info::in, proc_info::out, + list(prog_var)::in, instmap::in, top_level::in, bool::in, + maybe_opt_lcmc_accumulator::in, + list(accu_goal_id)::in, accu_goal_store::in, int::in, list(hlds_goal)::in, + list(accu_warning)::out) is semidet. + +should_attempt_accu_transform_2(!ModuleInfo, PredId, PredInfo, !ProcInfo, + HeadVars, InitialInstMap, TopLevel, FullyStrict, DoLCMC, + [Id | Ids], C, M, Rec, Warnings) :- + proc_info_get_vartypes(!.ProcInfo, VarTypes0), + identify_out_and_out_prime(!.ModuleInfo, VarTypes0, InitialInstMap, + Id, Rec, HeadVars, Out, OutPrime, HeadToCallSubst, CallToHeadSubst), + ( if + accu_stage1(!.ModuleInfo, VarTypes0, FullyStrict, DoLCMC, Id, M, C, + Sets), + accu_stage2(!.ModuleInfo, !.ProcInfo, Id, C, Sets, OutPrime, Out, + VarSet, VarTypes, Accs, BaseCase, BasePairs, Substs, CS, + WarningsPrime), + accu_stage3(Id, Accs, VarSet, VarTypes, C, CS, Substs, + HeadToCallSubst, CallToHeadSubst, BaseCase, BasePairs, Sets, Out, + TopLevel, PredId, PredInfo, !ProcInfo, !ModuleInfo) + then + Warnings = WarningsPrime + else + should_attempt_accu_transform_2(!ModuleInfo, PredId, PredInfo, + !ProcInfo, HeadVars, InitialInstMap, TopLevel, FullyStrict, DoLCMC, + Ids, C, M, Rec, Warnings) + ). + +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% + + % Transform the goal into a standard form that is amenable to + % introducing accumulators. + % + % At the moment all this does is remove any extra disj/conj wrappers + % around the top level goal. + % + % Future work is for this code to rearrange code with multiple base + % and recursive cases into a single base and recursive case. + % +:- pred accu_standardize(hlds_goal::in, hlds_goal::out) is det. + +accu_standardize(Goal0, Goal) :- + ( if + Goal0 = hlds_goal(GoalExpr0, _), + ( + GoalExpr0 = conj(plain_conj, [Goal1]) + ; + GoalExpr0 = disj([Goal1]) + ) + then + accu_standardize(Goal1, Goal) + else + Goal = Goal0 + ). + +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% + + % This predicate takes the original goal and identifies the `shape' + % of the goal around the recursive and base cases. + % + % Note that the base case can contain a recursive call, as the + % transformation doesn't depend on what is in the base case. + % +:- pred identify_goal_type(pred_id::in, proc_id::in, hlds_goal::in, + instmap::in, top_level::out, list(hlds_goal)::out, instmap::out, + list(hlds_goal)::out, instmap::out) is semidet. + +identify_goal_type(PredId, ProcId, Goal, InitialInstMap, Type, + Base, BaseInstMap, Rec, RecInstMap) :- + Goal = hlds_goal(GoalExpr, _GoalInfo), + ( + GoalExpr = switch(_Var, _CanFail, Cases), + ( if + Cases = [case(_IdA, [], GoalA), case(_IdB, [], GoalB)], + goal_to_conj_list(GoalA, GoalAList), + goal_to_conj_list(GoalB, GoalBList) + then + ( if is_recursive_case(GoalAList, proc(PredId, ProcId)) then + Type = switch_rec_base, + Base = GoalBList, + Rec = GoalAList + else if is_recursive_case(GoalBList, proc(PredId, ProcId)) then + Type = switch_base_rec, + Base = GoalAList, + Rec = GoalBList + else + fail + ), + BaseInstMap = InitialInstMap, + RecInstMap = InitialInstMap + else + fail + ) + ; + GoalExpr = disj(Goals), + ( if + Goals = [GoalA, GoalB], + goal_to_conj_list(GoalA, GoalAList), + goal_to_conj_list(GoalB, GoalBList) + then + ( if is_recursive_case(GoalAList, proc(PredId, ProcId)) then + Type = disj_rec_base, + Base = GoalBList, + Rec = GoalAList + else if is_recursive_case(GoalBList, proc(PredId, ProcId)) then + Type = disj_base_rec, + Base = GoalAList, + Rec = GoalBList + else + fail + ), + BaseInstMap = InitialInstMap, + RecInstMap = InitialInstMap + else + fail + ) + ; + GoalExpr = if_then_else(_Vars, Cond, Then, Else), + Cond = hlds_goal(_CondGoalExpr, CondGoalInfo), + CondInstMapDelta = goal_info_get_instmap_delta(CondGoalInfo), + + goal_to_conj_list(Then, GoalAList), + goal_to_conj_list(Else, GoalBList), + ( if is_recursive_case(GoalAList, proc(PredId, ProcId)) then + Type = ite_rec_base, + Base = GoalBList, + Rec = GoalAList, + + BaseInstMap = InitialInstMap, + apply_instmap_delta(CondInstMapDelta, InitialInstMap, RecInstMap) + else if is_recursive_case(GoalBList, proc(PredId, ProcId)) then + Type = ite_base_rec, + Base = GoalAList, + Rec = GoalBList, + + RecInstMap = InitialInstMap, + apply_instmap_delta(CondInstMapDelta, InitialInstMap, BaseInstMap) + else + fail + ) + ). + + % is_recursive_case(Gs, Id) is true iff the list of goals, Gs, + % contains a call to the procedure specified by Id, where the call + % is located in a position that can be used by the transformation + % (i.e. not hidden in a compound goal). + % +:- pred is_recursive_case(list(hlds_goal)::in, pred_proc_id::in) is semidet. + +is_recursive_case(Goals, proc(PredId, ProcId)) :- + list.append(_Initial, [RecursiveCall | _Final], Goals), + RecursiveCall = hlds_goal(plain_call(PredId, ProcId, _, _, _, _), _). + +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% + + % The store info is folded over the list of goals which + % represent the base and recursive case conjunctions. +:- type store_info + ---> store_info( + store_loc :: int, + % The location of the goal in the conjunction. + store_instmap :: instmap, + store_goals :: accu_goal_store + ). + + % Initialise the goal_store, which will hold the C_{a,b} goals. + % +:- func initialize_goal_store(list(hlds_goal), instmap, + list(hlds_goal), instmap) = accu_goal_store. + +initialize_goal_store(Rec, RecInstMap, Base, BaseInstMap) = C :- + goal_store_init(C0), + list.foldl3(accu_store(accu_rec), Rec, + 1, _, RecInstMap, _, C0, C1), + list.foldl3(accu_store(accu_base), Base, + 1, _, BaseInstMap, _, C1, C). + +:- pred accu_store(accu_case::in, hlds_goal::in, + int::in, int::out, instmap::in, instmap::out, + accu_goal_store::in, accu_goal_store::out) is det. + +accu_store(Case, Goal, !N, !InstMap, !GoalStore) :- + Id = accu_goal_id(Case, !.N), + goal_store_det_insert(Id, stored_goal(Goal, !.InstMap), !GoalStore), + + !:N = !.N + 1, + Goal = hlds_goal(_, GoalInfo), + InstMapDelta = goal_info_get_instmap_delta(GoalInfo), + apply_instmap_delta(InstMapDelta, !InstMap). + +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% + + % Determine the k's which are recursive calls. + % Note that this doesn't find recursive calls which are `hidden' + % in compound goals, this is not a problem as currently we can't use + % these to do transformation. + % +:- pred identify_recursive_calls(pred_id::in, proc_id::in, + accu_goal_store::in, list(accu_goal_id)::out) is det. + +identify_recursive_calls(PredId, ProcId, GoalStore, Ids) :- + P = + ( pred(Key::out) is nondet :- + goal_store_member(GoalStore, Key, stored_goal(Goal, _InstMap)), + Key = accu_goal_id(accu_rec, _), + Goal = hlds_goal(plain_call(PredId, ProcId, _, _, _, _), _) + ), + solutions.solutions(P, Ids). + +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% + + % Determine the variables which are members of the sets Out and Out', + % and initialize the substitutions between the two sets. + % + % This is done by identifing those variables whose instantiatedness change + % in the goals after the recursive call and are headvars. + % + % Note that we are only identifying the output variables which will need + % to be accumulated, as there may be other output variables which are + % produced prior to the recursive call. + % +:- pred identify_out_and_out_prime(module_info::in, vartypes::in, instmap::in, + accu_goal_id::in, list(hlds_goal)::in, + list(prog_var)::in, list(prog_var)::out, list(prog_var)::out, + accu_subst::out, accu_subst::out) is det. + +identify_out_and_out_prime(ModuleInfo, VarTypes, InitialInstMap, GoalId, + Rec, HeadVars, Out, OutPrime, HeadToCallSubst, CallToHeadSubst) :- + GoalId = accu_goal_id(_Case, K), + ( if + list.take(K, Rec, InitialGoals), + list.drop(K-1, Rec, FinalGoals), + FinalGoals = [hlds_goal(plain_call(_, _, Args, _, _, _), _) | Rest] + then + goal_list_instmap_delta(InitialGoals, InitInstMapDelta), + apply_instmap_delta( InitInstMapDelta, + InitialInstMap, InstMapBeforeRest), + + goal_list_instmap_delta(Rest, InstMapDelta), + apply_instmap_delta(InstMapDelta, InstMapBeforeRest, InstMapAfterRest), + + instmap_changed_vars(ModuleInfo, VarTypes, + InstMapBeforeRest, InstMapAfterRest, ChangedVars), + + assoc_list.from_corresponding_lists(HeadVars, Args, HeadArg0), + + Member = + ( pred(M::in) is semidet :- + M = HeadVar - _, + set_of_var.member(ChangedVars, HeadVar) + ), + list.filter(Member, HeadArg0, HeadArg), + list.map(fst, HeadArg, Out), + list.map(snd, HeadArg, OutPrime), + + map.from_assoc_list(HeadArg, HeadToCallSubst), + + list.map((pred(X-Y::in, Y-X::out) is det), HeadArg, ArgHead), + map.from_assoc_list(ArgHead, CallToHeadSubst) + else + unexpected($pred, "test failed") + ). + +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% + + % For each goal after the recursive call, we place that goal + % into a set according to what properties that goal has. + % For the definition of what goes into each set, inspect the documentation + % for the functions named before, assoc, and so on. + % +:- type accu_sets + ---> accu_sets( + as_before :: set(accu_goal_id), + as_assoc :: set(accu_goal_id), + as_construct_assoc :: set(accu_goal_id), + as_construct :: set(accu_goal_id), + as_update :: set(accu_goal_id), + as_reject :: set(accu_goal_id) + ). + + % Stage 1 is responsible for identifying which goals are associative, + % which can be moved before the recursive call and so on. + % +:- pred accu_stage1(module_info::in, vartypes::in, bool::in, + maybe_opt_lcmc_accumulator::in, accu_goal_id::in, int::in, + accu_goal_store::in, accu_sets::out) is semidet. + +accu_stage1(ModuleInfo, VarTypes, FullyStrict, DoLCMC, GoalId, M, GoalStore, + Sets) :- + GoalId = accu_goal_id(Case, K), + NextGoalId = accu_goal_id(Case, K + 1), + accu_sets_init(Sets0), + accu_stage1_2(ModuleInfo, VarTypes, FullyStrict, NextGoalId, K, M, + GoalStore, Sets0, Sets1), + Sets1 = accu_sets(Before, Assoc, + ConstructAssoc, Construct, Update, Reject), + Sets = accu_sets(Before `set.union` set_upto(Case, K - 1), Assoc, + ConstructAssoc, Construct, Update, Reject), + + % Continue the transformation only if the set reject is empty and + % the set assoc or update contains something that needs to be moved + % before the recursive call. + set.is_empty(Reject), + ( + not set.is_empty(Assoc) + ; + not set.is_empty(Update) + ), + ( + DoLCMC = do_not_opt_lcmc_accumulator, + % If LCMC is not turned on, then there must be no construction + % unifications after the recursive call. + set.is_empty(Construct), + set.is_empty(ConstructAssoc) + ; + DoLCMC = opt_lcmc_accumulator + ). + + % For each goal after the recursive call decide which set + % the goal belongs to. + % +:- pred accu_stage1_2(module_info::in, vartypes::in, bool::in, + accu_goal_id::in, int::in, int::in, accu_goal_store::in, + accu_sets::in, accu_sets::out) is det. + +accu_stage1_2(ModuleInfo, VarTypes, FullyStrict, GoalId, K, M, GoalStore, + !Sets) :- + GoalId = accu_goal_id(Case, I), + NextGoalId = accu_goal_id(Case, I + 1), + ( if I > M then + true + else + ( if + accu_before(ModuleInfo, VarTypes, FullyStrict, GoalId, K, + GoalStore, !.Sets) + then + !Sets ^ as_before := set.insert(!.Sets ^ as_before, GoalId), + accu_stage1_2(ModuleInfo, VarTypes, FullyStrict, NextGoalId, K, M, + GoalStore, !Sets) + else if + accu_assoc(ModuleInfo, VarTypes, FullyStrict, GoalId, K, + GoalStore, !.Sets) + then + !Sets ^ as_assoc := set.insert(!.Sets ^ as_assoc, GoalId), + accu_stage1_2(ModuleInfo, VarTypes, FullyStrict, NextGoalId, K, M, + GoalStore, !Sets) + else if + accu_construct(ModuleInfo, VarTypes, FullyStrict, GoalId, K, + GoalStore, !.Sets) + then + !Sets ^ as_construct := set.insert(!.Sets ^ as_construct, GoalId), + accu_stage1_2(ModuleInfo, VarTypes, FullyStrict, NextGoalId, K, M, + GoalStore, !Sets) + else if + accu_construct_assoc(ModuleInfo, VarTypes, FullyStrict, GoalId, K, + GoalStore, !.Sets) + then + !Sets ^ as_construct_assoc := + set.insert(!.Sets ^ as_construct_assoc, GoalId), + accu_stage1_2(ModuleInfo, VarTypes, FullyStrict, NextGoalId, K, M, + GoalStore, !Sets) + else if + accu_update(ModuleInfo, VarTypes, FullyStrict, GoalId, K, + GoalStore, !.Sets) + then + !Sets ^ as_update := set.insert(!.Sets ^ as_update, GoalId), + accu_stage1_2(ModuleInfo, VarTypes, FullyStrict, NextGoalId, K, M, + GoalStore, !Sets) + else + !Sets ^ as_reject := set.insert(!.Sets ^ as_reject, GoalId) + ) + ). + +%---------------------------------------------------------------------------% + +:- pred accu_sets_init(accu_sets::out) is det. + +accu_sets_init(Sets) :- + set.init(EmptySet), + Before = EmptySet, + Assoc = EmptySet, + ConstructAssoc = EmptySet, + Construct = EmptySet, + Update = EmptySet, + Reject = EmptySet, + Sets = accu_sets(Before, Assoc, ConstructAssoc, Construct, Update, Reject). + + % set_upto(Case, K) returns the set + % {accu_goal_id(Case, 1) .. accu_goal_id(Case, K)}. + % +:- func set_upto(accu_case, int) = set(accu_goal_id). + +set_upto(Case, K) = Set :- + ( if K =< 0 then + set.init(Set) + else + Set0 = set_upto(Case, K - 1), + set.insert(accu_goal_id(Case, K), Set0, Set) + ). + +%---------------------------------------------------------------------------% + + % A goal is a member of the before set iff the goal only depends on goals + % which are before the recursive call or can be moved before the recursive + % call (member of the before set). + % +:- pred accu_before(module_info::in, vartypes::in, bool::in, + accu_goal_id::in, int::in, accu_goal_store::in, accu_sets::in) is semidet. + +accu_before(ModuleInfo, VarTypes, FullyStrict, GoalId, K, GoalStore, Sets) :- + GoalId = accu_goal_id(Case, _I), + Before = Sets ^ as_before, + goal_store_lookup(GoalStore, GoalId, stored_goal(LaterGoal, LaterInstMap)), + ( + member_lessthan_goalid(GoalStore, GoalId, LessThanGoalId, + stored_goal(EarlierGoal, EarlierInstMap)), + not can_reorder_goals_old(ModuleInfo, VarTypes, FullyStrict, + EarlierInstMap, EarlierGoal, LaterInstMap, LaterGoal) + ) + => + ( + set.member(LessThanGoalId, set_upto(Case, K - 1) `union` Before) + ). + + % A goal is a member of the assoc set iff the goal only depends on goals + % upto and including the recursive call and goals which can be moved + % before the recursive call (member of the before set) AND the goal + % is associative. + % +:- pred accu_assoc(module_info::in, vartypes::in, bool::in, + accu_goal_id::in, int::in, accu_goal_store::in, accu_sets::in) is semidet. + +accu_assoc(ModuleInfo, VarTypes, FullyStrict, GoalId, K, GoalStore, Sets) :- + GoalId = accu_goal_id(Case, _I), + Before = Sets ^ as_before, + goal_store_lookup(GoalStore, GoalId, stored_goal(LaterGoal, LaterInstMap)), + LaterGoal = hlds_goal(plain_call(PredId, _, Args, _, _, _), _), + accu_is_associative(ModuleInfo, PredId, Args, _), + ( + % XXX LessThanGoalId was _N - J, not N - J: it ignored the case. + % See the diff with the previous version. + member_lessthan_goalid(GoalStore, GoalId, LessThanGoalId, + stored_goal(EarlierGoal, EarlierInstMap)), + not can_reorder_goals_old(ModuleInfo, VarTypes, FullyStrict, + EarlierInstMap, EarlierGoal, LaterInstMap, LaterGoal) + ) + => + ( + set.member(LessThanGoalId, set_upto(Case, K) `union` Before) + ). + + % A goal is a member of the construct set iff the goal only depends + % on goals upto and including the recursive call and goals which + % can be moved before the recursive call (member of the before set) + % AND the goal is construction unification. + % +:- pred accu_construct(module_info::in, vartypes::in, bool::in, + accu_goal_id::in, int::in, accu_goal_store::in, accu_sets::in) is semidet. + +accu_construct(ModuleInfo, VarTypes, FullyStrict, GoalId, K, GoalStore, + Sets) :- + GoalId = accu_goal_id(Case, _I), + Before = Sets ^ as_before, + Construct = Sets ^ as_construct, + goal_store_lookup(GoalStore, GoalId, stored_goal(LaterGoal, LaterInstMap)), + LaterGoal = hlds_goal(unify(_, _, _, Unify, _), _GoalInfo), + Unify = construct(_, _, _, _, _, _, _), + ( + % XXX LessThanGoalId was _N - J, not N - J: it ignored the case. + % See the diff with the previous version. + member_lessthan_goalid(GoalStore, GoalId, LessThanGoalId, + stored_goal(EarlierGoal, EarlierInstMap)), + not can_reorder_goals_old(ModuleInfo, VarTypes, FullyStrict, + EarlierInstMap, EarlierGoal, LaterInstMap, LaterGoal) + ) + => + ( + set.member(LessThanGoalId, + set_upto(Case, K) `union` Before `union` Construct) + ). + + % A goal is a member of the construct_assoc set iff the goal depends only + % on goals upto and including the recursive call and goals which can be + % moved before the recursive call (member of the before set) and goals + % which are associative AND the goal is construction unification AND + % there is only one member of the assoc set which the construction + % unification depends on AND the construction unification can be expressed + % as a call to the member of the assoc set which the construction + % unification depends on. + % +:- pred accu_construct_assoc(module_info::in, vartypes::in, bool::in, + accu_goal_id::in, int::in, accu_goal_store::in, accu_sets::in) is semidet. + +accu_construct_assoc(ModuleInfo, VarTypes, FullyStrict, + GoalId, K, GoalStore, Sets) :- + GoalId = accu_goal_id(Case, _I), + Before = Sets ^ as_before, + Assoc = Sets ^ as_assoc, + ConstructAssoc = Sets ^ as_construct_assoc, + goal_store_lookup(GoalStore, GoalId, stored_goal(LaterGoal, LaterInstMap)), + LaterGoal = hlds_goal(unify(_, _, _, Unify, _), _GoalInfo), + Unify = construct(_, ConsId, _, _, _, _, _), + + goal_store_all_ancestors(GoalStore, GoalId, VarTypes, ModuleInfo, + FullyStrict, Ancestors), + + set.is_singleton(Assoc `intersect` Ancestors, AssocId), + goal_store_lookup(GoalStore, AssocId, + stored_goal(AssocGoal, _AssocInstMap)), + AssocGoal = hlds_goal(plain_call(PredId, _, _, _, _, _), _), + + is_associative_construction(ModuleInfo, PredId, ConsId), + ( + % XXX LessThanGoalId was _N - J, not N - J: it ignored the case. + % See the diff with the previous version. + member_lessthan_goalid(GoalStore, GoalId, LessThanGoalId, + stored_goal(EarlierGoal, EarlierInstMap)), + not can_reorder_goals_old(ModuleInfo, VarTypes, FullyStrict, + EarlierInstMap, EarlierGoal, LaterInstMap, LaterGoal) + ) + => + ( + set.member(LessThanGoalId, + set_upto(Case, K) `union` Before `union` Assoc + `union` ConstructAssoc) + ). + + % A goal is a member of the update set iff the goal only depends + % on goals upto and including the recursive call and goals which + % can be moved before the recursive call (member of the before set) + % AND the goal updates some state. + % +:- pred accu_update(module_info::in, vartypes::in, bool::in, + accu_goal_id::in, int::in, accu_goal_store::in, accu_sets::in) is semidet. + +accu_update(ModuleInfo, VarTypes, FullyStrict, GoalId, K, GoalStore, Sets) :- + GoalId = accu_goal_id(Case, _I), + Before = Sets ^ as_before, + goal_store_lookup(GoalStore, GoalId, stored_goal(LaterGoal, LaterInstMap)), + LaterGoal = hlds_goal(plain_call(PredId, _, Args, _, _, _), _), + accu_is_update(ModuleInfo, PredId, Args, _), + ( + % XXX LessThanGoalId was _N - J, not N - J: it ignored the case. + % See the diff with the previous version. + member_lessthan_goalid(GoalStore, GoalId, LessThanGoalId, + stored_goal(EarlierGoal, EarlierInstMap)), + not can_reorder_goals_old(ModuleInfo, VarTypes, FullyStrict, + EarlierInstMap, EarlierGoal, LaterInstMap, LaterGoal) + ) + => + ( + set.member(LessThanGoalId, set_upto(Case, K) `union` Before) + ). + + % member_lessthan_goalid(GS, IdA, IdB, GB) is true iff the goal_id, IdB, + % and its associated goal, GB, is a member of the goal_store, GS, + % and IdB is less than IdA. + % +:- pred member_lessthan_goalid(accu_goal_store::in, + accu_goal_id::in, accu_goal_id::out, stored_goal::out) is nondet. + +member_lessthan_goalid(GoalStore, GoalId, LessThanGoalId, LessThanGoal) :- + goal_store_member(GoalStore, LessThanGoalId, LessThanGoal), + GoalId = accu_goal_id(Case, I), + LessThanGoalId = accu_goal_id(Case, J), + J < I. + +%---------------------------------------------------------------------------% + +:- type accu_assoc + ---> accu_assoc( + set_of_progvar, % the associative input args + prog_var, % the corresponding output arg + bool % is the predicate commutative? + ). + + % If accu_is_associative is true, it returns the two arguments which are + % associative and the variable which depends on those two arguments, + % and an indicator of whether or not the predicate is commutative. + % +:- pred accu_is_associative(module_info::in, pred_id::in, list(prog_var)::in, + accu_assoc::out) is semidet. + +accu_is_associative(ModuleInfo, PredId, Args, Result) :- + module_info_pred_info(ModuleInfo, PredId, PredInfo), + pred_info_get_assertions(PredInfo, Assertions), + AssertionsList = set.to_sorted_list(Assertions), + associativity_assertion(ModuleInfo, AssertionsList, Args, + AssociativeVarsOutputVar), + ( if + commutativity_assertion(ModuleInfo, AssertionsList, Args, + _CommutativeVars) + then + IsCommutative = yes + else + IsCommutative = no + ), + AssociativeVarsOutputVar = + associative_vars_output_var(AssociativeVars, OutputVar), + Result = accu_assoc(AssociativeVars, OutputVar, IsCommutative). + + % Does there exist one (and only one) associativity assertion for the + % current predicate? + % The 'and only one condition' is required because we currently + % do not handle the case of predicates which have individual parts + % which are associative, because then we do not know which variable + % is descended from which. + % +:- pred associativity_assertion(module_info::in, list(assert_id)::in, + list(prog_var)::in, associative_vars_output_var::out) is semidet. + +associativity_assertion(ModuleInfo, [AssertId | AssertIds], Args0, + AssociativeVarsOutputVar) :- + ( if + assertion.is_associativity_assertion(ModuleInfo, AssertId, + Args0, AssociativeVarsOutputVarPrime) + then + AssociativeVarsOutputVar = AssociativeVarsOutputVarPrime, + not associativity_assertion(ModuleInfo, AssertIds, Args0, _) + else + associativity_assertion(ModuleInfo, AssertIds, Args0, + AssociativeVarsOutputVar) + ). + + % Does there exist one (and only one) commutativity assertion for the + % current predicate? + % The 'and only one condition' is required because we currently + % do not handle the case of predicates which have individual + % parts which are commutative, because then we do not know which variable + % is descended from which. + % +:- pred commutativity_assertion(module_info::in,list(assert_id)::in, + list(prog_var)::in, set_of_progvar::out) is semidet. + +commutativity_assertion(ModuleInfo, [AssertId | AssertIds], Args0, + CommutativeVars) :- + ( if + assertion.is_commutativity_assertion(ModuleInfo, AssertId, + Args0, CommutativeVarsPrime) + then + CommutativeVars = CommutativeVarsPrime, + not commutativity_assertion(ModuleInfo, AssertIds, Args0, _) + else + commutativity_assertion(ModuleInfo, AssertIds, Args0, + CommutativeVars) + ). + +%---------------------------------------------------------------------------% + + % Does the current predicate update some state? + % +:- pred accu_is_update(module_info::in, pred_id::in, list(prog_var)::in, + state_update_vars::out) is semidet. + +accu_is_update(ModuleInfo, PredId, Args, ResultStateVars) :- + module_info_pred_info(ModuleInfo, PredId, PredInfo), + pred_info_get_assertions(PredInfo, Assertions), + list.filter_map( + ( pred(AssertId::in, StateVars::out) is semidet :- + assertion.is_update_assertion(ModuleInfo, AssertId, + PredId, Args, StateVars) + ), + set.to_sorted_list(Assertions), Result), + % XXX Maybe we should just match on the first result, + % just in case there are duplicate promises. + Result = [ResultStateVars]. + +%---------------------------------------------------------------------------% + + % Can the construction unification be expressed as a call to the + % specified predicate. + % +:- pred is_associative_construction(module_info::in, pred_id::in, cons_id::in) + is semidet. + +is_associative_construction(ModuleInfo, PredId, ConsId) :- + module_info_pred_info(ModuleInfo, PredId, PredInfo), + pred_info_get_assertions(PredInfo, Assertions), + list.filter( + ( pred(AssertId::in) is semidet :- + assertion.is_construction_equivalence_assertion(ModuleInfo, + AssertId, ConsId, PredId) + ), + set.to_sorted_list(Assertions), Result), + Result = [_ | _]. + +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% + +:- type accu_substs + ---> accu_substs( + acc_var_subst :: accu_subst, + rec_call_subst :: accu_subst, + assoc_call_subst :: accu_subst, + update_subst :: accu_subst + ). + +:- type accu_base + ---> accu_base( + % goals which initialize update + init_update :: set(accu_goal_id), + + % goals which initialize assoc + init_assoc :: set(accu_goal_id), + + % other goals + other :: set(accu_goal_id) + ). + + % Stage 2 is responsible for identifying the substitutions which + % are needed to mimic the unfold/fold process that was used as + % the justification of the algorithm in the paper. + % It is also responsible for ensuring that the reordering of arguments + % doesn't worsen the big-O complexity of the procedure. + % It also divides the base case into goals that initialize the + % variables used by the update goals, and those used by the assoc + % goals and then all the rest. + % +:- pred accu_stage2(module_info::in, proc_info::in, + accu_goal_id::in, accu_goal_store::in, accu_sets::in, + list(prog_var)::in, list(prog_var)::in, prog_varset::out, vartypes::out, + list(prog_var)::out, accu_base::out, list(pair(prog_var))::out, + accu_substs::out, accu_goal_store::out, list(accu_warning)::out) + is semidet. + +accu_stage2(ModuleInfo, ProcInfo0, GoalId, GoalStore, Sets, OutPrime, Out, + !:VarSet, !:VarTypes, Accs, BaseCase, BasePairs, !:Substs, + CS, Warnings) :- + Sets = accu_sets(Before0, Assoc, ConstructAssoc, Construct, Update, _), + GoalId = accu_goal_id(Case, K), + Before = Before0 `union` set_upto(Case, K-1), + + % Note Update set is not placed in the after set, as the after set is used + % to determine the variables that need to be accumulated for the + % associative calls. + After = Assoc `union` ConstructAssoc `union` Construct, + + P = + ( pred(Id::in, Set0::in, Set::out) is det :- + goal_store_lookup(GoalStore, Id, stored_goal(Goal, _InstMap)), + Goal = hlds_goal(_GoalExpr, GoalInfo), + NonLocals = goal_info_get_nonlocals(GoalInfo), + set_of_var.union(NonLocals, Set0, Set) + ), + list.foldl(P, set.to_sorted_list(Before), + set_of_var.init, BeforeNonLocals), + list.foldl(P, set.to_sorted_list(After), + set_of_var.init, AfterNonLocals), + InitAccs = set_of_var.intersect(BeforeNonLocals, AfterNonLocals), + + proc_info_get_varset(ProcInfo0, !:VarSet), + proc_info_get_vartypes(ProcInfo0, !:VarTypes), + + accu_substs_init(set_of_var.to_sorted_list(InitAccs), !VarSet, !VarTypes, + !:Substs), + + set_of_var.list_to_set(OutPrime, OutPrimeSet), + accu_process_assoc_set(ModuleInfo, GoalStore, set.to_sorted_list(Assoc), + OutPrimeSet, !Substs, !VarSet, !VarTypes, CS, Warnings), + + accu_process_update_set(ModuleInfo, GoalStore, set.to_sorted_list(Update), + OutPrimeSet, !Substs, !VarSet, !VarTypes, UpdateOut, UpdateAccOut, + BasePairs), + + Accs = set_of_var.to_sorted_list(InitAccs) ++ UpdateAccOut, + + accu_divide_base_case(ModuleInfo, !.VarTypes, GoalStore, UpdateOut, Out, + UpdateBase, AssocBase, OtherBase), + + BaseCase = accu_base(UpdateBase, AssocBase, OtherBase). + +%---------------------------------------------------------------------------% + +:- pred accu_substs_init(list(prog_var)::in, prog_varset::in, prog_varset::out, + vartypes::in, vartypes::out, accu_substs::out) is det. + +accu_substs_init(InitAccs, !VarSet, !VarTypes, Substs) :- + map.init(Subst), + acc_var_subst_init(InitAccs, !VarSet, !VarTypes, AccVarSubst), + RecCallSubst = Subst, + AssocCallSubst = Subst, + UpdateSubst = Subst, + Substs = accu_substs(AccVarSubst, RecCallSubst, AssocCallSubst, + UpdateSubst). + + % Initialise the acc_var_subst to be from Var to A_Var where Var is a + % member of InitAccs and A_Var is a fresh variable of the same type of Var. + % +:- pred acc_var_subst_init(list(prog_var)::in, + prog_varset::in, prog_varset::out, vartypes::in, vartypes::out, + accu_subst::out) is det. + +acc_var_subst_init([], !VarSet, !VarTypes, map.init). +acc_var_subst_init([Var | Vars], !VarSet, !VarTypes, Subst) :- + create_new_var(Var, "A_", AccVar, !VarSet, !VarTypes), + acc_var_subst_init(Vars, !VarSet, !VarTypes, Subst0), + map.det_insert(Var, AccVar, Subst0, Subst). + + % Create a fresh variable which is the same type as the old variable + % and has the same name except that it begins with the prefix. + % +:- pred create_new_var(prog_var::in, string::in, prog_var::out, + prog_varset::in, prog_varset::out, vartypes::in, vartypes::out) is det. + +create_new_var(OldVar, Prefix, NewVar, !VarSet, !VarTypes) :- + varset.lookup_name(!.VarSet, OldVar, OldName), + string.append(Prefix, OldName, NewName), + varset.new_named_var(NewName, NewVar, !VarSet), + lookup_var_type(!.VarTypes, OldVar, Type), + add_var_type(NewVar, Type, !VarTypes). + +%---------------------------------------------------------------------------% + + % For each member of the assoc set determine the substitutions needed, + % and also check the efficiency of the procedure isn't worsened + % by reordering the arguments to a call. + % +:- pred accu_process_assoc_set(module_info::in, accu_goal_store::in, + list(accu_goal_id)::in, set_of_progvar::in, + accu_substs::in, accu_substs::out, + prog_varset::in, prog_varset::out, vartypes::in, vartypes::out, + accu_goal_store::out, list(accu_warning)::out) is semidet. + +accu_process_assoc_set(_ModuleInfo, _GS, [], _OutPrime, !Substs, + !VarSet, !VarTypes, CS, []) :- + goal_store_init(CS). +accu_process_assoc_set(ModuleInfo, GS, [Id | Ids], OutPrime, !Substs, + !VarSet, !VarTypes, CS, Warnings) :- + !.Substs = accu_substs(AccVarSubst, RecCallSubst0, AssocCallSubst0, + UpdateSubst), + + lookup_call(GS, Id, stored_goal(Goal, InstMap)), + + Goal = hlds_goal(plain_call(PredId, _, Args, _, _, _), GoalInfo), + accu_is_associative(ModuleInfo, PredId, Args, AssocInfo), + AssocInfo = accu_assoc(Vars, AssocOutput, IsCommutative), + OutPrimeVars = set_of_var.intersect(Vars, OutPrime), + set_of_var.is_singleton(OutPrimeVars, DuringAssocVar), + set_of_var.is_singleton(set_of_var.difference(Vars, OutPrimeVars), + BeforeAssocVar), + + map.lookup(AccVarSubst, BeforeAssocVar, AccVar), + create_new_var(BeforeAssocVar, "NewAcc_", NewAcc, !VarSet, !VarTypes), + + map.det_insert(DuringAssocVar, AccVar, AssocCallSubst0, AssocCallSubst1), + map.det_insert(AssocOutput, NewAcc, AssocCallSubst1, AssocCallSubst), + map.det_insert(DuringAssocVar, AssocOutput, RecCallSubst0, RecCallSubst1), + map.det_insert(BeforeAssocVar, NewAcc, RecCallSubst1, RecCallSubst), + + !:Substs = accu_substs(AccVarSubst, RecCallSubst, AssocCallSubst, + UpdateSubst), + + % ONLY swap the order of the variables if the goal is + % associative and not commutative. + ( + IsCommutative = yes, + CSGoal = stored_goal(Goal, InstMap), + CurWarnings = [] + ; + IsCommutative = no, + + % Ensure that the reordering doesn't cause a efficiency problem. + module_info_pred_info(ModuleInfo, PredId, PredInfo), + ModuleName = pred_info_module(PredInfo), + PredName = pred_info_name(PredInfo), + Arity = pred_info_orig_arity(PredInfo), + ( if accu_has_heuristic(ModuleName, PredName, Arity) then + % Only do the transformation if the accumulator variable is + % *not* in a position where it will control the running time + % of the predicate. + accu_heuristic(ModuleName, PredName, Arity, Args, + PossibleDuringAssocVars), + set_of_var.member(PossibleDuringAssocVars, DuringAssocVar), + CurWarnings = [] + else + ProgContext = goal_info_get_context(GoalInfo), + CurWarnings = [accu_warn(ProgContext, PredId, BeforeAssocVar, + DuringAssocVar)] + ), + % Swap the arguments. + [A, B] = set_of_var.to_sorted_list(Vars), + map.from_assoc_list([A - B, B - A], Subst), + rename_some_vars_in_goal(Subst, Goal, SwappedGoal), + CSGoal = stored_goal(SwappedGoal, InstMap) + ), + + accu_process_assoc_set(ModuleInfo, GS, Ids, OutPrime, !Substs, + !VarSet, !VarTypes, CS0, Warnings0), + goal_store_det_insert(Id, CSGoal, CS0, CS), + Warnings = Warnings0 ++ CurWarnings. + +:- pred accu_has_heuristic(module_name::in, string::in, arity::in) is semidet. + +accu_has_heuristic(unqualified("list"), "append", 3). + + % heuristic returns the set of which head variables are important + % in the running time of the predicate. + % +:- pred accu_heuristic(module_name::in, string::in, arity::in, + list(prog_var)::in, set_of_progvar::out) is semidet. + +accu_heuristic(unqualified("list"), "append", 3, [_Typeinfo, A, _B, _C], + Set) :- + set_of_var.make_singleton(A, Set). + +%---------------------------------------------------------------------------% + + % For each member of the update set determine the substitutions needed + % (creating the accumulator variables when needed). + % Also associate with each Output variable which accumulator variable + % to get the result from. + % +:- pred accu_process_update_set(module_info::in, accu_goal_store::in, + list(accu_goal_id)::in, set_of_progvar::in, + accu_substs::in, accu_substs::out, + prog_varset::in, prog_varset::out, vartypes::in, vartypes::out, + list(prog_var)::out, list(prog_var)::out, list(pair(prog_var))::out) + is semidet. + +accu_process_update_set(_ModuleInfo, _GS, [], _OutPrime, !Substs, + !VarSet, !VarTypes, [], [], []). +accu_process_update_set(ModuleInfo, GS, [Id | Ids], OutPrime, !Substs, + !VarSet, !VarTypes, StateOutputVars, Accs, BasePairs) :- + !.Substs = accu_substs(AccVarSubst0, RecCallSubst0, AssocCallSubst, + UpdateSubst0), + lookup_call(GS, Id, stored_goal(Goal, _InstMap)), + + Goal = hlds_goal(plain_call(PredId, _, Args, _, _, _), _GoalInfo), + accu_is_update(ModuleInfo, PredId, Args, StateVars), + StateVars = state_update_vars(StateVarA, StateVarB), + + ( if set_of_var.member(OutPrime, StateVarA) then + StateInputVar = StateVarA, + StateOutputVar = StateVarB + else + StateInputVar = StateVarB, + StateOutputVar = StateVarA + ), + + create_new_var(StateInputVar, "Acc_", Acc0, !VarSet, !VarTypes), + create_new_var(StateOutputVar, "Acc_", Acc, !VarSet, !VarTypes), + + map.det_insert(StateInputVar, Acc0, UpdateSubst0, UpdateSubst1), + map.det_insert(StateOutputVar, Acc, UpdateSubst1, UpdateSubst), + map.det_insert(StateInputVar, StateOutputVar, RecCallSubst0, RecCallSubst), + map.det_insert(Acc, Acc0, AccVarSubst0, AccVarSubst), + !:Substs = accu_substs(AccVarSubst, RecCallSubst, AssocCallSubst, + UpdateSubst), + + accu_process_update_set(ModuleInfo, GS, Ids, OutPrime, !Substs, + !VarSet, !VarTypes, StateOutputVars0, Accs0, BasePairs0), + + % Rather then concatenating to start of the list we concatenate to the end + % of the list. This allows the accumulator introduction to be applied + % as the heuristic will succeed (remember after transforming the two + % input variables will have their order swapped, so they must be in the + % inefficient order to start with) + + StateOutputVars = StateOutputVars0 ++ [StateOutputVar], + Accs = Accs0 ++ [Acc], + BasePairs = BasePairs0 ++ [StateOutputVar - Acc0]. + +%---------------------------------------------------------------------------% + + % divide_base_case(UpdateOut, Out, U, A, O) is true iff given the output + % variables which are instantiated by update goals, UpdateOut, and all + % the variables that need to be accumulated, Out, divide the base case up + % into three sets, those base case goals which initialize the variables + % used by update calls, U, those which initialize variables used by + % assoc calls, A, and the rest of the goals, O. Note that the sets + % are not necessarily disjoint, as the result of a goal may be used + % to initialize a variable in both U and A, so both U and A will contain + % the same goal_id. + % +:- pred accu_divide_base_case(module_info::in, vartypes::in, + accu_goal_store::in, list(prog_var)::in, list(prog_var)::in, + set(accu_goal_id)::out, set(accu_goal_id)::out, set(accu_goal_id)::out) + is det. + +accu_divide_base_case(ModuleInfo, VarTypes, C, UpdateOut, Out, + UpdateBase, AssocBase, OtherBase) :- + list.delete_elems(Out, UpdateOut, AssocOut), + + list.map(accu_related(ModuleInfo, VarTypes, C), UpdateOut, UpdateBaseList), + list.map(accu_related(ModuleInfo, VarTypes, C), AssocOut, AssocBaseList), + UpdateBase = set.power_union(set.list_to_set(UpdateBaseList)), + AssocBase = set.power_union(set.list_to_set(AssocBaseList)), + + Set = base_case_ids_set(C) `difference` (UpdateBase `union` AssocBase), + set.to_sorted_list(Set, List), + + list.map( + ( pred(GoalId::in, Ancestors::out) is det :- + goal_store_all_ancestors(C, GoalId, VarTypes, + ModuleInfo, no, Ancestors) + ), List, OtherBaseList), + + OtherBase = set.list_to_set(List) `union` + (base_case_ids_set(C) `intersect` + set.power_union(set.list_to_set(OtherBaseList))). + + % accu_related(ModuleInfo, VarTypes, GoalStore, Var, Related): + % + % From GoalStore, return all the goal_ids, Related, which are needed + % to initialize Var. + % +:- pred accu_related(module_info::in, vartypes::in, accu_goal_store::in, + prog_var::in, set(accu_goal_id)::out) is det. + +accu_related(ModuleInfo, VarTypes, GoalStore, Var, Related) :- + solutions.solutions( + ( pred(Key::out) is nondet :- + goal_store_member(GoalStore, Key, stored_goal(Goal, InstMap0)), + Key = accu_goal_id(accu_base, _), + Goal = hlds_goal(_GoalExpr, GoalInfo), + InstMapDelta = goal_info_get_instmap_delta(GoalInfo), + apply_instmap_delta(InstMapDelta, InstMap0, InstMap), + instmap_changed_vars(ModuleInfo, VarTypes, + InstMap0, InstMap, ChangedVars), + set_of_var.is_singleton(ChangedVars, Var) + ), Ids), + ( + Ids = [], + unexpected($pred, "no Id") + ; + Ids = [Id], + goal_store_all_ancestors(GoalStore, Id, VarTypes, ModuleInfo, no, + Ancestors), + list.filter((pred(accu_goal_id(accu_base, _)::in) is semidet), + set.to_sorted_list(set.insert(Ancestors, Id)), RelatedList), + Related = set.list_to_set(RelatedList) + ; + Ids = [_, _ | _], + unexpected($pred, "more than one Id") + ). + +%---------------------------------------------------------------------------% + +:- inst stored_goal_plain_call for goal_store.stored_goal/0 + ---> stored_goal(goal_plain_call, ground). + + % Do a goal_store_lookup where the result is known to be a call. + % +:- pred lookup_call(accu_goal_store::in, accu_goal_id::in, + stored_goal::out(stored_goal_plain_call)) is det. + +lookup_call(GoalStore, Id, stored_goal(Call, InstMap)) :- + goal_store_lookup(GoalStore, Id, stored_goal(Goal, InstMap)), + ( if + Goal = hlds_goal(GoalExpr, GoalInfo), + GoalExpr = plain_call(_, _, _, _, _, _) + then + Call = hlds_goal(GoalExpr, GoalInfo) + else + unexpected($pred, "not a call") + ). + +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% + + % accu_stage3 creates the accumulator version of the predicate using + % the substitutions determined in stage2. It also redefines the + % original procedure to call the accumulator version of the procedure. + % +:- pred accu_stage3(accu_goal_id::in, list(prog_var)::in, prog_varset::in, + vartypes::in, accu_goal_store::in, accu_goal_store::in, + accu_substs::in, accu_subst::in, accu_subst::in, + accu_base::in, list(pair(prog_var))::in, accu_sets::in, + list(prog_var)::in, top_level::in, pred_id::in, pred_info::in, + proc_info::in, proc_info::out, module_info::in, module_info::out) is det. + +accu_stage3(RecCallId, Accs, VarSet, VarTypes, C, CS, Substs, + HeadToCallSubst, CallToHeadSubst, BaseCase, BasePairs, Sets, Out, + TopLevel, OrigPredId, OrigPredInfo, !OrigProcInfo, !ModuleInfo) :- + acc_proc_info(Accs, VarSet, VarTypes, Substs, !.OrigProcInfo, + AccTypes, AccProcInfo), + acc_pred_info(AccTypes, Out, AccProcInfo, OrigPredId, OrigPredInfo, + AccProcId, AccPredInfo), + AccName = unqualified(pred_info_name(AccPredInfo)), + + module_info_get_predicate_table(!.ModuleInfo, PredTable0), + predicate_table_insert(AccPredInfo, AccPredId, PredTable0, PredTable), + module_info_set_predicate_table(PredTable, !ModuleInfo), + accu_create_goal(RecCallId, Accs, AccPredId, AccProcId, AccName, Substs, + HeadToCallSubst, CallToHeadSubst, BaseCase, BasePairs, Sets, C, CS, + OrigBaseGoal, OrigRecGoal, AccBaseGoal, AccRecGoal), + + proc_info_get_goal(!.OrigProcInfo, OrigGoal0), + accu_top_level(TopLevel, OrigGoal0, OrigBaseGoal, OrigRecGoal, + AccBaseGoal, AccRecGoal, OrigGoal, AccGoal), + + proc_info_set_goal(OrigGoal, !OrigProcInfo), + proc_info_set_varset(VarSet, !OrigProcInfo), + proc_info_set_vartypes(VarTypes, !OrigProcInfo), + + requantify_proc_general(ordinary_nonlocals_no_lambda, !OrigProcInfo), + update_accumulator_pred(AccPredId, AccProcId, AccGoal, !ModuleInfo). + +%---------------------------------------------------------------------------% + + % Construct a proc_info for the introduced predicate. + % +:- pred acc_proc_info(list(prog_var)::in, prog_varset::in, vartypes::in, + accu_substs::in, proc_info::in, list(mer_type)::out, proc_info::out) + is det. + +acc_proc_info(Accs0, VarSet, VarTypes, Substs, OrigProcInfo, + AccTypes, AccProcInfo) :- + % ProcInfo Stuff that must change. + proc_info_get_headvars(OrigProcInfo, HeadVars0), + proc_info_get_argmodes(OrigProcInfo, HeadModes0), + + proc_info_get_inst_varset(OrigProcInfo, InstVarSet), + proc_info_get_inferred_determinism(OrigProcInfo, Detism), + proc_info_get_goal(OrigProcInfo, Goal), + proc_info_get_context(OrigProcInfo, Context), + proc_info_get_rtti_varmaps(OrigProcInfo, RttiVarMaps), + proc_info_get_is_address_taken(OrigProcInfo, IsAddressTaken), + proc_info_get_has_parallel_conj(OrigProcInfo, HasParallelConj), + proc_info_get_var_name_remap(OrigProcInfo, VarNameRemap), + + Substs = accu_substs(AccVarSubst, _RecCallSubst, _AssocCallSubst, + _UpdateSubst), + list.map(map.lookup(AccVarSubst), Accs0, Accs), + + % We place the extra accumulator variables at the start, because placing + % them at the end breaks the convention that the last variable of a + % function is the output variable. + HeadVars = Accs ++ HeadVars0, + + % XXX we don't want to use the inst of the var as it can be more specific + % than it should be. ie int_const(1) when it should be any integer. + % However this will no longer handle partially instantiated data + % structures. + Inst = ground(shared, none_or_default_func), + inst_lists_to_mode_list([Inst], [Inst], Mode), + list.duplicate(list.length(Accs), list.det_head(Mode), AccModes), + HeadModes = AccModes ++ HeadModes0, + + lookup_var_types(VarTypes, Accs, AccTypes), + + SeqNum = item_no_seq_num, + proc_info_create(Context, SeqNum, VarSet, VarTypes, HeadVars, + InstVarSet, HeadModes, detism_decl_none, Detism, Goal, RttiVarMaps, + IsAddressTaken, HasParallelConj, VarNameRemap, AccProcInfo). + +%---------------------------------------------------------------------------% + + % Construct the pred_info for the introduced predicate. + % +:- pred acc_pred_info(list(mer_type)::in, list(prog_var)::in, proc_info::in, + pred_id::in, pred_info::in, proc_id::out, pred_info::out) is det. + +acc_pred_info(NewTypes, OutVars, NewProcInfo, OrigPredId, OrigPredInfo, + NewProcId, NewPredInfo) :- + % PredInfo stuff that must change. + pred_info_get_arg_types(OrigPredInfo, TypeVarSet, ExistQVars, Types0), + + ModuleName = pred_info_module(OrigPredInfo), + Name = pred_info_name(OrigPredInfo), + PredOrFunc = pred_info_is_pred_or_func(OrigPredInfo), + pred_info_get_context(OrigPredInfo, PredContext), + pred_info_get_markers(OrigPredInfo, Markers), + pred_info_get_class_context(OrigPredInfo, ClassContext), + pred_info_get_origin(OrigPredInfo, OldOrigin), + pred_info_get_var_name_remap(OrigPredInfo, VarNameRemap), + + set.init(Assertions), + + proc_info_get_context(NewProcInfo, Context), + term.context_line(Context, Line), + Counter = 0, + + Types = NewTypes ++ Types0, + + make_pred_name_with_context(ModuleName, "AccFrom", PredOrFunc, Name, + Line, Counter, SymName), + + OutVarNums = list.map(term.var_to_int, OutVars), + Origin = origin_transformed(transform_accumulator(OutVarNums), + OldOrigin, OrigPredId), + GoalType = goal_not_for_promise(np_goal_type_none), + pred_info_create(ModuleName, SymName, PredOrFunc, PredContext, Origin, + pred_status(status_local), Markers, Types, TypeVarSet, + ExistQVars, ClassContext, Assertions, VarNameRemap, GoalType, + NewProcInfo, NewProcId, NewPredInfo). + +%---------------------------------------------------------------------------% + + % create_goal creates the new base and recursive case of the + % original procedure (OrigBaseGoal and OrigRecGoal) and the base + % and recursive cases of accumulator version (AccBaseGoal and + % AccRecGoal). + % +:- pred accu_create_goal(accu_goal_id::in, list(prog_var)::in, + pred_id::in, proc_id::in, sym_name::in, accu_substs::in, + accu_subst::in, accu_subst::in, accu_base::in, + list(pair(prog_var))::in, accu_sets::in, + accu_goal_store::in, accu_goal_store::in, + hlds_goal::out, hlds_goal::out, hlds_goal::out, hlds_goal::out) is det. + +accu_create_goal(RecCallId, Accs, AccPredId, AccProcId, AccName, Substs, + HeadToCallSubst, CallToHeadSubst, BaseIds, BasePairs, + Sets, C, CS, OrigBaseGoal, OrigRecGoal, AccBaseGoal, AccRecGoal) :- + lookup_call(C, RecCallId, stored_goal(OrigCall, _InstMap)), + Call = create_acc_call(OrigCall, Accs, AccPredId, AccProcId, AccName), + create_orig_goal(Call, Substs, HeadToCallSubst, CallToHeadSubst, + BaseIds, Sets, C, OrigBaseGoal, OrigRecGoal), + create_acc_goal(Call, Substs, HeadToCallSubst, BaseIds, BasePairs, + Sets, C, CS, AccBaseGoal, AccRecGoal). + + % create_acc_call takes the original call and generates a call to the + % accumulator version of the call, which can have the substitutions + % applied to it easily. + % +:- func create_acc_call(hlds_goal::in(goal_plain_call), list(prog_var)::in, + pred_id::in, proc_id::in, sym_name::in) = (hlds_goal::out(goal_plain_call)) + is det. + +create_acc_call(OrigCall, Accs, AccPredId, AccProcId, AccName) = Call :- + OrigCall = hlds_goal(OrigCallExpr, GoalInfo), + OrigCallExpr = plain_call(_PredId, _ProcId, Args, Builtin, Context, _Name), + CallExpr = plain_call(AccPredId, AccProcId, Accs ++ Args, Builtin, + Context, AccName), + Call = hlds_goal(CallExpr, GoalInfo). + + % Create the goals which are to replace the original predicate. + % +:- pred create_orig_goal(hlds_goal::in, accu_substs::in, + accu_subst::in, accu_subst::in, accu_base::in, accu_sets::in, + accu_goal_store::in, hlds_goal::out, hlds_goal::out) is det. + +create_orig_goal(Call, Substs, HeadToCallSubst, CallToHeadSubst, + BaseIds, Sets, C, OrigBaseGoal, OrigRecGoal) :- + Substs = accu_substs(_AccVarSubst, _RecCallSubst, _AssocCallSubst, + UpdateSubst), + + BaseIds = accu_base(UpdateBase, _AssocBase, _OtherBase), + Before = Sets ^ as_before, + Update = Sets ^ as_update, + + U = create_new_orig_recursive_goals(UpdateBase, Update, + HeadToCallSubst, UpdateSubst, C), + + rename_some_vars_in_goal(CallToHeadSubst, Call, BaseCall), + Cbefore = accu_goal_list(set.to_sorted_list(Before), C), + Uupdate = accu_goal_list(set.to_sorted_list(UpdateBase) ++ + set.to_sorted_list(Update), U), + Cbase = accu_goal_list(base_case_ids(C), C), + calculate_goal_info(conj(plain_conj, Cbefore ++ Uupdate ++ [BaseCall]), + OrigRecGoal), + calculate_goal_info(conj(plain_conj, Cbase), OrigBaseGoal). + + % Create the goals which are to go in the new accumulator version + % of the predicate. + % +:- pred create_acc_goal(hlds_goal::in, accu_substs::in, accu_subst::in, + accu_base::in, list(pair(prog_var))::in, accu_sets::in, + accu_goal_store::in, accu_goal_store::in, + hlds_goal::out, hlds_goal::out) is det. + +create_acc_goal(Call, Substs, HeadToCallSubst, BaseIds, BasePairs, Sets, + C, CS, AccBaseGoal, AccRecGoal) :- + Substs = accu_substs(AccVarSubst, RecCallSubst, AssocCallSubst, + UpdateSubst), + + BaseIds = accu_base(_UpdateBase, AssocBase, OtherBase), + Sets = accu_sets(Before, Assoc, ConstructAssoc, Construct, Update, + _Reject), + + rename_some_vars_in_goal(RecCallSubst, Call, RecCall), + + Cbefore = accu_goal_list(set.to_sorted_list(Before), C), + + % Create the goals which will be used in the new recursive case. + R = create_new_recursive_goals(Assoc, Construct `union` ConstructAssoc, + Update, AssocCallSubst, AccVarSubst, UpdateSubst, C, CS), + + Rassoc = accu_goal_list(set.to_sorted_list(Assoc), R), + Rupdate = accu_goal_list(set.to_sorted_list(Update), R), + Rconstruct = accu_goal_list(set.to_sorted_list(Construct `union` + ConstructAssoc), R), + + % Create the goals which will be used in the new base case. + B = create_new_base_goals(Assoc `union` Construct `union` + ConstructAssoc, C, AccVarSubst, HeadToCallSubst), + Bafter = set.to_sorted_list(Assoc `union` + Construct `union` ConstructAssoc), + + BaseCase = accu_goal_list(set.to_sorted_list(AssocBase `union` OtherBase) + ++ Bafter, B), + + list.map(acc_unification, BasePairs, UpdateBase), + + calculate_goal_info(conj(plain_conj, Cbefore ++ Rassoc ++ Rupdate + ++ [RecCall] ++ Rconstruct), AccRecGoal), + calculate_goal_info(conj(plain_conj, UpdateBase ++ BaseCase), AccBaseGoal). + + % Create the U set of goals (those that will be used in the original + % recursive case) by renaming all the goals which are used to initialize + % the update state variable using the head_to_call followed by the + % update_subst, and rename all the update goals using the update_subst. + % +:- func create_new_orig_recursive_goals(set(accu_goal_id), set(accu_goal_id), + accu_subst, accu_subst, accu_goal_store) = accu_goal_store. + +create_new_orig_recursive_goals(UpdateBase, Update, HeadToCallSubst, + UpdateSubst, C) + = accu_rename(set.to_sorted_list(Update), UpdateSubst, C, Ubase) :- + Ubase = accu_rename(set.to_sorted_list(UpdateBase), + chain_subst(HeadToCallSubst, UpdateSubst), C, goal_store_init). + + % Create the R set of goals (those that will be used in the new + % recursive case) by renaming all the members of assoc in CS + % using assoc_call_subst and all the members of (construct U + % construct_assoc) in C with acc_var_subst. + % +:- func create_new_recursive_goals(set(accu_goal_id), set(accu_goal_id), + set(accu_goal_id), accu_subst, accu_subst, accu_subst, + accu_goal_store, accu_goal_store) = accu_goal_store. + +create_new_recursive_goals(Assoc, Constructs, Update, + AssocCallSubst, AccVarSubst, UpdateSubst, C, CS) + = accu_rename(set.to_sorted_list(Constructs), AccVarSubst, C, RBase) :- + RBase0 = accu_rename(set.to_sorted_list(Assoc), AssocCallSubst, CS, + goal_store_init), + RBase = accu_rename(set.to_sorted_list(Update), UpdateSubst, C, RBase0). + + % Create the B set of goals (those that will be used in the new base case) + % by renaming all the base case goals of C with head_to_call and all the + % members of (assoc U construct U construct_assoc) of C with acc_var_subst. + % +:- func create_new_base_goals(set(accu_goal_id), accu_goal_store, + accu_subst, accu_subst) = accu_goal_store. + +create_new_base_goals(Ids, C, AccVarSubst, HeadToCallSubst) + = accu_rename(set.to_sorted_list(Ids), AccVarSubst, C, Bbase) :- + Bbase = accu_rename(base_case_ids(C), HeadToCallSubst, C, goal_store_init). + + % acc_unification(O-A, G): + % + % is true if G represents the assignment unification Out = Acc. + % +:- pred acc_unification(pair(prog_var)::in, hlds_goal::out) is det. + +acc_unification(Out - Acc, Goal) :- + UnifyMode = unify_modes_li_lf_ri_rf(free, ground_inst, + ground_inst, ground_inst), + Context = unify_context(umc_explicit, []), + Expr = unify(Out, rhs_var(Acc), UnifyMode, assign(Out,Acc), Context), + set_of_var.list_to_set([Out, Acc], NonLocalVars), + InstMapDelta = instmap_delta_bind_var(Out), + goal_info_init(NonLocalVars, InstMapDelta, detism_det, purity_pure, Info), + Goal = hlds_goal(Expr, Info). + +%---------------------------------------------------------------------------% + + % Given the top level structure of the goal create new version + % with new base and recursive cases plugged in. + % +:- pred accu_top_level(top_level::in, hlds_goal::in, + hlds_goal::in, hlds_goal::in, hlds_goal::in, + hlds_goal::in, hlds_goal::out, hlds_goal::out) is det. + +accu_top_level(TopLevel, Goal, OrigBaseGoal, OrigRecGoal, + NewBaseGoal, NewRecGoal, OrigGoal, NewGoal) :- + ( + TopLevel = switch_base_rec, + ( if + Goal = hlds_goal(switch(Var, CanFail, Cases0), GoalInfo), + Cases0 = [case(IdA, [], _), case(IdB, [], _)] + then + OrigCases = [case(IdA, [], OrigBaseGoal), + case(IdB, [], OrigRecGoal)], + OrigGoal = hlds_goal(switch(Var, CanFail, OrigCases), GoalInfo), + + NewCases = [case(IdA, [], NewBaseGoal), case(IdB, [], NewRecGoal)], + NewGoal = hlds_goal(switch(Var, CanFail, NewCases), GoalInfo) + else + unexpected($pred, "not the correct top level") + ) + ; + TopLevel = switch_rec_base, + ( if + Goal = hlds_goal(switch(Var, CanFail, Cases0), GoalInfo), + Cases0 = [case(IdA, [], _), case(IdB, [], _)] + then + OrigCases = [case(IdA, [], OrigRecGoal), + case(IdB, [], OrigBaseGoal)], + OrigGoal = hlds_goal(switch(Var, CanFail, OrigCases), GoalInfo), + + NewCases = [case(IdA, [], NewRecGoal), case(IdB, [], NewBaseGoal)], + NewGoal = hlds_goal(switch(Var, CanFail, NewCases), GoalInfo) + else + unexpected($pred, "not the correct top level") + ) + ; + TopLevel = disj_base_rec, + ( if + Goal = hlds_goal(disj(Goals), GoalInfo), + Goals = [_, _] + then + OrigGoals = [OrigBaseGoal, OrigRecGoal], + OrigGoal = hlds_goal(disj(OrigGoals), GoalInfo), + + NewGoals = [NewBaseGoal, NewRecGoal], + NewGoal = hlds_goal(disj(NewGoals), GoalInfo) + else + unexpected($pred, "not the correct top level") + ) + ; + TopLevel = disj_rec_base, + ( if + Goal = hlds_goal(disj(Goals), GoalInfo), + Goals = [_, _] + then + OrigGoals = [OrigRecGoal, OrigBaseGoal], + OrigGoal = hlds_goal(disj(OrigGoals), GoalInfo), + + NewGoals = [NewRecGoal, NewBaseGoal], + NewGoal = hlds_goal(disj(NewGoals), GoalInfo) + else + unexpected($pred, "not the correct top level") + ) + ; + TopLevel = ite_base_rec, + ( if Goal = hlds_goal(if_then_else(Vars, Cond, _, _), GoalInfo) then + OrigGoal = hlds_goal(if_then_else(Vars, Cond, + OrigBaseGoal, OrigRecGoal), GoalInfo), + NewGoal = hlds_goal(if_then_else(Vars, Cond, + NewBaseGoal, NewRecGoal), GoalInfo) + else + unexpected($pred, "not the correct top level") + ) + ; + TopLevel = ite_rec_base, + ( if Goal = hlds_goal(if_then_else(Vars, Cond, _, _), GoalInfo) then + OrigGoal = hlds_goal(if_then_else(Vars, Cond, + OrigRecGoal, OrigBaseGoal), GoalInfo), + NewGoal = hlds_goal(if_then_else(Vars, Cond, + NewRecGoal, NewBaseGoal), GoalInfo) + else + unexpected($pred, "not the correct top level") + ) + ). + +%---------------------------------------------------------------------------% + + % Place the accumulator version of the predicate in the HLDS. + % +:- pred update_accumulator_pred(pred_id::in, proc_id::in, + hlds_goal::in, module_info::in, module_info::out) is det. + +update_accumulator_pred(NewPredId, NewProcId, AccGoal, !ModuleInfo) :- + module_info_pred_proc_info(!.ModuleInfo, NewPredId, NewProcId, + PredInfo, ProcInfo0), + proc_info_set_goal(AccGoal, ProcInfo0, ProcInfo1), + requantify_proc_general(ordinary_nonlocals_no_lambda, ProcInfo1, ProcInfo), + module_info_set_pred_proc_info(NewPredId, NewProcId, + PredInfo, ProcInfo, !ModuleInfo). + +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% + + % accu_rename(Ids, Subst, From, Initial): + % + % Return a goal_store, Final, which is the result of looking up each + % member of set of goal_ids, Ids, in the goal_store, From, applying + % the substitution and then storing the goal into the goal_store, Initial. + % +:- func accu_rename(list(accu_goal_id), accu_subst, + accu_goal_store, accu_goal_store) = accu_goal_store. + +accu_rename(Ids, Subst, From, Initial) = Final :- + list.foldl( + ( pred(Id::in, GS0::in, GS::out) is det :- + goal_store_lookup(From, Id, stored_goal(Goal0, InstMap)), + rename_some_vars_in_goal(Subst, Goal0, Goal), + goal_store_det_insert(Id, stored_goal(Goal, InstMap), GS0, GS) + ), Ids, Initial, Final). + + % Return all the goal_ids which belong in the base case. + % +:- func base_case_ids(accu_goal_store) = list(accu_goal_id). + +base_case_ids(GS) = Base :- + solutions.solutions( + ( pred(Key::out) is nondet :- + goal_store_member(GS, Key, _Goal), + Key = accu_goal_id(accu_base, _) + ), Base). + +:- func base_case_ids_set(accu_goal_store) = set(accu_goal_id). + +base_case_ids_set(GS) = set.list_to_set(base_case_ids(GS)). + + % Given a list of goal_ids, return the list of hlds_goals from + % the goal_store. + % +:- func accu_goal_list(list(accu_goal_id), accu_goal_store) = list(hlds_goal). + +accu_goal_list(Ids, GS) = Goals :- + list.map( + ( pred(Key::in, G::out) is det :- + goal_store_lookup(GS, Key, stored_goal(G, _)) + ), Ids, Goals). + +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% + +:- pred calculate_goal_info(hlds_goal_expr::in, hlds_goal::out) is det. + +calculate_goal_info(GoalExpr, hlds_goal(GoalExpr, GoalInfo)) :- + ( if GoalExpr = conj(plain_conj, GoalList) then + goal_list_nonlocals(GoalList, NonLocals), + goal_list_instmap_delta(GoalList, InstMapDelta), + goal_list_determinism(GoalList, Detism), + + goal_info_init(NonLocals, InstMapDelta, Detism, purity_pure, GoalInfo) + else + unexpected($pred, "not a conj") + ). + +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% + +:- func chain_subst(accu_subst, accu_subst) = accu_subst. + +chain_subst(AtoB, BtoC) = AtoC :- + map.keys(AtoB, Keys), + chain_subst_2(Keys, AtoB, BtoC, AtoC). + +:- pred chain_subst_2(list(A)::in, map(A, B)::in, map(B, C)::in, + map(A, C)::out) is det. + +chain_subst_2([], _, _, AtoC) :- + map.init(AtoC). +chain_subst_2([A | As], AtoB, BtoC, AtoC) :- + chain_subst_2(As, AtoB, BtoC, AtoC0), + map.lookup(AtoB, A, B), + ( if map.search(BtoC, B, C) then + map.det_insert(A, C, AtoC0, AtoC) + else + AtoC = AtoC0 + ). + +%---------------------------------------------------------------------------% +:- end_module transform_hlds.accumulator. +%---------------------------------------------------------------------------% -- 2.31.1 --------------922E82C30E426081894B2236-- From debbugs-submit-bounces@debbugs.gnu.org Sun Jun 06 05:48:59 2021 Received: (at 47408-done) by debbugs.gnu.org; 6 Jun 2021 09:48:59 +0000 Received: from localhost ([127.0.0.1]:50684 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lppOt-0008UF-IV for submit@debbugs.gnu.org; Sun, 06 Jun 2021 05:48:59 -0400 Received: from eggs.gnu.org ([209.51.188.92]:45374) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lppOs-0008U2-G8 for 47408-done@debbugs.gnu.org; Sun, 06 Jun 2021 05:48:59 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:46924) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lppOm-0005LR-Vy; Sun, 06 Jun 2021 05:48:52 -0400 Received: from 84.94.185.95.cable.012.net.il ([84.94.185.95]:2552 helo=home-c4e4a596f7) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lppOm-0007nD-J5; Sun, 06 Jun 2021 05:48:52 -0400 Date: Sun, 06 Jun 2021 12:48:48 +0300 Message-Id: <83k0n7iarj.fsf@gnu.org> From: Eli Zaretskii To: fabrice nicol In-Reply-To: (message from fabrice nicol on Tue, 1 Jun 2021 04:38:56 +0200) Subject: Re: bug#47408: Etags support for Mercury [v0.5] References: <70503251-f8ea-9006-b7e7-b13b93bb71de@gmail.com> <838s4gxurw.fsf@gnu.org> <53162dfb-0715-3077-78d1-3a8340943f2f@gmail.com> <838s3y6kaq.fsf@gnu.org> X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 47408-done Cc: 47408-done@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) > From: fabrice nicol > Cc: 47408@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? From debbugs-submit-bounces@debbugs.gnu.org Sun Jun 06 09:33:48 2021 Received: (at 47408-done) by debbugs.gnu.org; 6 Jun 2021 13:33:48 +0000 Received: from localhost ([127.0.0.1]:51032 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lpsuS-00005j-FG for submit@debbugs.gnu.org; Sun, 06 Jun 2021 09:33:48 -0400 Received: from mail-wr1-f45.google.com ([209.85.221.45]:43935) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lpsuN-00005Q-2e for 47408-done@debbugs.gnu.org; Sun, 06 Jun 2021 09:33:46 -0400 Received: by mail-wr1-f45.google.com with SMTP id u7so8857635wrs.10 for <47408-done@debbugs.gnu.org>; Sun, 06 Jun 2021 06:33:43 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=subject:to:cc:references:from:message-id:date:user-agent :mime-version:in-reply-to:content-transfer-encoding:content-language; bh=HQ2lQ1LapKCNiEWdi5u+LLsS3wq4XyCcHtifOjJP7Io=; b=NkJhV2+zXMVDCYnnnKjXq04fxpKz19hqyjykMPWQV7TjT9nJSnMArMvLdKKghqbmZi Pph+XwmRXEQ7pSL2K34IWA/FKun88WQ9R1awSGSJWDMI+4QhYvjqMGWbnaL7FPgO5PTA 2sszJ7u1TrrtV5ZYiIDpX1LqYPnrgTO7Sz2ClGhFqSsXsHmNAsYQrPbX3fTOZHMVlI9j Fs+Y6R8KVzddPLilEBtyHcBBmCmDLkU+zfZWESXcUvNUwh1iQgFdTfQoOgfbinYOX9Wx f2ROhKUxg/vOKh9yH2K81Ik/x49PIwwPm58sVdr9c/CTDXABC1ISPjxx1kWeiwbwUtIR fVRQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:subject:to:cc:references:from:message-id:date :user-agent:mime-version:in-reply-to:content-transfer-encoding :content-language; bh=HQ2lQ1LapKCNiEWdi5u+LLsS3wq4XyCcHtifOjJP7Io=; b=jOntn9jilL/ek/3avogm5fcOl1OkdHRO1qOCW65t5zP7IrkbgyoHnY7u25Hu/d2qk6 zpE3jQStG4Lwa2O9RAGqwY4GXSI8tiKiG2VSpvkWmFQ3OGwDjYzOVI2X0k6LjVOBf8TY k2ezriCXVrQHV7A4mrvx+272YdqhkEBd5DA0kafI76enCd/l53jOy5Emopoedb13qXbQ CYP8O0+orkaGBmW0C3qlMYRAVzhAcNSRrPyv3Xe5GlGLc7vwef9LIbh2QyoQioO7RJFE Nrp4MQswRdcdyb7GhYMtO3a3oU2Z+hTlQdhxj6iKHZpFNR7tyMJdgF1HBNVVFPLR/5Wb H2bg== X-Gm-Message-State: AOAM530hbGA8hlSev4Q9EQ8afN7RplaSG5/F9pQsnMZ0TAGmkDbjR/eQ XpFo2Xiv1HQSuruL7IZrSO7nXSbo240= X-Google-Smtp-Source: ABdhPJyJM4i0V/X+O56x+oXjz5Naf9Y5WtTWBNAP3IOrIgRNcINl5h6aFIy8KkLuEzLYPFL0SgJ5UA== X-Received: by 2002:adf:d23a:: with SMTP id k26mr13035854wrh.68.1622986416876; Sun, 06 Jun 2021 06:33:36 -0700 (PDT) Received: from ?IPv6:2a01:cb1d:88b9:5c00:7b73:7901:965e:8523? ([2a01:cb1d:88b9:5c00:7b73:7901:965e:8523]) by smtp.gmail.com with ESMTPSA id m37sm5297098wms.46.2021.06.06.06.33.36 (version=TLS1_3 cipher=TLS_AES_128_GCM_SHA256 bits=128/128); Sun, 06 Jun 2021 06:33:36 -0700 (PDT) Subject: Re: bug#47408: Etags support for Mercury [v0.5] To: Eli Zaretskii References: <70503251-f8ea-9006-b7e7-b13b93bb71de@gmail.com> <838s4gxurw.fsf@gnu.org> <53162dfb-0715-3077-78d1-3a8340943f2f@gmail.com> <838s3y6kaq.fsf@gnu.org> <83k0n7iarj.fsf@gnu.org> From: fabrice nicol Message-ID: <65f059b1-149d-146d-3b8d-36db60ff1044@gmail.com> Date: Sun, 6 Jun 2021 15:34:30 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Thunderbird/78.10.2 MIME-Version: 1.0 In-Reply-To: <83k0n7iarj.fsf@gnu.org> Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 8bit Content-Language: en-US X-Spam-Score: -0.0 (/) X-Debbugs-Envelope-To: 47408-done Cc: 47408-done@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) 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 >> Cc: 47408@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? From debbugs-submit-bounces@debbugs.gnu.org Sun Jun 06 14:18:55 2021 Received: (at 47408-done) by debbugs.gnu.org; 6 Jun 2021 18:18:55 +0000 Received: from localhost ([127.0.0.1]:53868 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lpxMN-00023d-3e for submit@debbugs.gnu.org; Sun, 06 Jun 2021 14:18:55 -0400 Received: from plesklin7.if2.ehiweb.it ([79.98.45.17]:55928 helo=plesklin7.if1.ehiweb.it) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lpxMJ-00023O-1K for 47408-done@debbugs.gnu.org; Sun, 06 Jun 2021 14:18:54 -0400 Received: from tucano.isti.cnr.it (tucano.isti.cnr.it [146.48.81.102]) by plesklin7.if1.ehiweb.it (Postfix) with ESMTPSA id DB3DA10032A; Sun, 6 Jun 2021 20:18:48 +0200 (CEST) Message-Id: <87o8cin9fb.fsf@tucano.isti.cnr.it> From: =?utf-8?Q?Francesco_Potort=C3=AC?= Date: Sun, 06 Jun 2021 20:18:48 +0200 To: fabrice nicol In-Reply-To: <65f059b1-149d-146d-3b8d-36db60ff1044@gmail.com> (fabrnicol@gmail.com) Subject: Re: bug#47408: Etags support for Mercury [v0.5] References: <70503251-f8ea-9006-b7e7-b13b93bb71de@gmail.com> <838s4gxurw.fsf@gnu.org> <53162dfb-0715-3077-78d1-3a8340943f2f@gmail.com> <838s3y6kaq.fsf@gnu.org> <83k0n7iarj.fsf@gnu.org> <65f059b1-149d-146d-3b8d-36db60ff1044@gmail.com> Organization: The GNU project X-fingerprint: 4B02 6187 5C03 D6B1 2E31 7666 09DF 2DC9 BE21 6115 MIME-version: 1.0 Content-type: text/plain; charset=utf-8 Content-Transfer-Encoding: 8bit X-PPP-Message-ID: <20210606181849.20396.64971@plesklin7.if1.ehiweb.it> X-PPP-Vhost: potorti.it X-Spam-Score: 1.4 (+) X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: 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. Content analysis details: (1.4 points, 10.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- 0.0 SPF_HELO_NONE SPF: HELO does not publish an SPF Record 1.0 SPF_SOFTFAIL SPF: sender does not match SPF record (softfail) -0.0 RCVD_IN_MSPIKE_H4 RBL: Very Good reputation (+4) [79.98.45.17 listed in wl.mailspike.net] -0.0 RCVD_IN_MSPIKE_WL Mailspike good senders 0.4 KHOP_HELO_FCRDNS Relay HELO differs from its IP's reverse DNS X-Debbugs-Envelope-To: 47408-done Cc: 47408-done@debbugs.gnu.org, Eli Zaretskii X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -0.0 (/) 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. From debbugs-submit-bounces@debbugs.gnu.org Sun Jun 06 16:48:40 2021 Received: (at 47408-done) by debbugs.gnu.org; 6 Jun 2021 20:48:40 +0000 Received: from localhost ([127.0.0.1]:54005 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lpzhD-0007qR-VL for submit@debbugs.gnu.org; Sun, 06 Jun 2021 16:48:40 -0400 Received: from mail-wr1-f52.google.com ([209.85.221.52]:33634) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lpzh8-0007qA-H0 for 47408-done@debbugs.gnu.org; Sun, 06 Jun 2021 16:48:34 -0400 Received: by mail-wr1-f52.google.com with SMTP id a20so15167892wrc.0 for <47408-done@debbugs.gnu.org>; Sun, 06 Jun 2021 13:48:30 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=subject:to:cc:references:from:message-id:date:user-agent :mime-version:in-reply-to:content-transfer-encoding:content-language; bh=eK9lHzZ0qPRdCIO2+mDaXq2HABAhq/Lcy0HFC1gHyXs=; b=CXENAJ7csPISMjlyISch9T1R644l/PHOOp8qqb4ee9L8twm8MSNASrS+N7PUKKB75J VyGDWIS8tHwZG576zO7VgV2DEvmB021or+rWzxEahOvg7r0JZ3q42cx2vof6LaZ4OmwA Oo9lol6whsTSfuaQNmkKcImCIcRsxiiXllyXKOhE9Z9OlDzzGD51FkJ0mWh9HoZoUiTL dE9gG7AyHy24Dg0+N6i4jd4BbVuT3kDf/BZQDQxEoLql949rIXgNvXs6WgkesuVJry6f jFAtntIZhbQ8mpDVUazfUswNMI39/5sXfO55ODKQxSEzzOdj0gMyvQ9pbuDF/nNngz8g /3fA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:subject:to:cc:references:from:message-id:date :user-agent:mime-version:in-reply-to:content-transfer-encoding :content-language; bh=eK9lHzZ0qPRdCIO2+mDaXq2HABAhq/Lcy0HFC1gHyXs=; b=qdHeFub5Uh4F75LHi9G7ETpRtE3PgpGTJdbnjszROE4OKbY9ePTWa7661kgKVzxuF5 VwdLk9Wks6IlMzuXC/fIj8iZuJSBaW8Mr68X4fEa2DRLy9rRexQRub/Zw8dV6qYFkeor kLzOiVZrBgKo62wus+Xa11VDfDC50QmdM2ZHe6eiNw23/Tp6SriP76HLwHozWUeqy6uz zWLjDz/I36omWA189TMnmVUuUS1OFMb3nzHGJn1h2VNYZ3yk+n3ed0EeUrCYmGtzPKze nplefS3v81bh9EQOutmtoZNt2paYTtZBX0hWqADgkmEE+RRqTPcF8MtHOvEgqQTkOUIQ YhZw== X-Gm-Message-State: AOAM531FshjYpHUybgzOfzujQsnvQS4ELmmhxF3y0pUEErZO+oAo12ZZ ageTFS78P3EbMhB9y1UcMz8= X-Google-Smtp-Source: ABdhPJxW7s+Dyngooiu9zn/J2ruZziD+AOy1/Z61IUUxclQBNQG8sArWTc84kLtZMS9N9QfpKdtqcw== X-Received: by 2002:a5d:5151:: with SMTP id u17mr13290831wrt.302.1623012504563; Sun, 06 Jun 2021 13:48:24 -0700 (PDT) Received: from ?IPv6:2a01:cb1d:88b9:5c00:7b73:7901:965e:8523? ([2a01:cb1d:88b9:5c00:7b73:7901:965e:8523]) by smtp.gmail.com with ESMTPSA id m21sm9807793wms.42.2021.06.06.13.48.23 (version=TLS1_3 cipher=TLS_AES_128_GCM_SHA256 bits=128/128); Sun, 06 Jun 2021 13:48:24 -0700 (PDT) Subject: Re: bug#47408: Etags support for Mercury [v0.5] To: =?UTF-8?Q?Francesco_Potort=c3=ac?= References: <70503251-f8ea-9006-b7e7-b13b93bb71de@gmail.com> <838s4gxurw.fsf@gnu.org> <53162dfb-0715-3077-78d1-3a8340943f2f@gmail.com> <838s3y6kaq.fsf@gnu.org> <83k0n7iarj.fsf@gnu.org> <65f059b1-149d-146d-3b8d-36db60ff1044@gmail.com> <87o8cin9fb.fsf@tucano.isti.cnr.it> From: fabrice nicol Message-ID: <39f683d3-65d7-a7d9-18b1-cf6dfa7d254a@gmail.com> Date: Sun, 6 Jun 2021 22:49:19 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Thunderbird/78.10.2 MIME-Version: 1.0 In-Reply-To: <87o8cin9fb.fsf@tucano.isti.cnr.it> Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 7bit Content-Language: en-US X-Spam-Score: -0.0 (/) X-Debbugs-Envelope-To: 47408-done Cc: 47408-done@debbugs.gnu.org, Eli Zaretskii X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) > 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. From debbugs-submit-bounces@debbugs.gnu.org Sun Jun 06 17:04:49 2021 Received: (at 47408-done) by debbugs.gnu.org; 6 Jun 2021 21:04:49 +0000 Received: from localhost ([127.0.0.1]:54016 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lpzwv-0008E9-Eu for submit@debbugs.gnu.org; Sun, 06 Jun 2021 17:04:49 -0400 Received: from plesklin7.if2.ehiweb.it ([79.98.45.17]:42121 helo=plesklin7.if1.ehiweb.it) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lpzwu-0008E1-5f for 47408-done@debbugs.gnu.org; Sun, 06 Jun 2021 17:04:48 -0400 Received: from tucano.isti.cnr.it (tucano.isti.cnr.it [146.48.81.102]) by plesklin7.if1.ehiweb.it (Postfix) with ESMTPSA id 25AE510032A; Sun, 6 Jun 2021 23:04:46 +0200 (CEST) Message-Id: <87mts2n1qq.fsf@tucano.isti.cnr.it> From: =?utf-8?Q?Francesco_Potort=C3=AC?= Date: Sun, 06 Jun 2021 23:04:45 +0200 To: fabrice nicol In-Reply-To: <39f683d3-65d7-a7d9-18b1-cf6dfa7d254a@gmail.com> (fabrnicol@gmail.com) Subject: Re: bug#47408: Etags support for Mercury [v0.5] References: <70503251-f8ea-9006-b7e7-b13b93bb71de@gmail.com> <838s4gxurw.fsf@gnu.org> <53162dfb-0715-3077-78d1-3a8340943f2f@gmail.com> <838s3y6kaq.fsf@gnu.org> <83k0n7iarj.fsf@gnu.org> <65f059b1-149d-146d-3b8d-36db60ff1044@gmail.com> <87o8cin9fb.fsf@tucano.isti.cnr.it> <39f683d3-65d7-a7d9-18b1-cf6dfa7d254a@gmail.com> Organization: The GNU project X-fingerprint: 4B02 6187 5C03 D6B1 2E31 7666 09DF 2DC9 BE21 6115 MIME-version: 1.0 Content-type: text/plain; charset=utf-8 Content-Transfer-Encoding: 8bit X-PPP-Message-ID: <20210606210446.13525.56128@plesklin7.if1.ehiweb.it> X-PPP-Vhost: potorti.it X-Spam-Score: 1.4 (+) X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: >> 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 [...] Content analysis details: (1.4 points, 10.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- -0.0 RCVD_IN_MSPIKE_H4 RBL: Very Good reputation (+4) [79.98.45.17 listed in wl.mailspike.net] 0.0 SPF_HELO_NONE SPF: HELO does not publish an SPF Record 1.0 SPF_SOFTFAIL SPF: sender does not match SPF record (softfail) -0.0 RCVD_IN_MSPIKE_WL Mailspike good senders 0.4 KHOP_HELO_FCRDNS Relay HELO differs from its IP's reverse DNS X-Debbugs-Envelope-To: 47408-done Cc: Eli Zaretskii , 47408-done@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -0.0 (/) >> 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. From debbugs-submit-bounces@debbugs.gnu.org Mon Jun 07 20:05:44 2021 Received: (at 47408) by debbugs.gnu.org; 8 Jun 2021 00:05:44 +0000 Received: from localhost ([127.0.0.1]:56893 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lqPFX-0007Pg-Mu for submit@debbugs.gnu.org; Mon, 07 Jun 2021 20:05:44 -0400 Received: from eggs.gnu.org ([209.51.188.92]:34134) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lqPFV-0007P6-WE for 47408@debbugs.gnu.org; Mon, 07 Jun 2021 20:05:42 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:39450) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lqPFQ-00016e-Eu; Mon, 07 Jun 2021 20:05:36 -0400 Received: from 84.94.185.95.cable.012.net.il ([84.94.185.95]:4532 helo=home-c4e4a596f7) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lqE8Z-00051G-UF; Mon, 07 Jun 2021 08:13:48 -0400 Date: Mon, 07 Jun 2021 15:13:45 +0300 Message-Id: <83fsxthnye.fsf@gnu.org> From: Eli Zaretskii To: fabrice nicol In-Reply-To: <39f683d3-65d7-a7d9-18b1-cf6dfa7d254a@gmail.com> (message from fabrice nicol on Sun, 6 Jun 2021 22:49:19 +0200) Subject: Re: bug#47408: Etags support for Mercury [v0.5] References: <70503251-f8ea-9006-b7e7-b13b93bb71de@gmail.com> <838s4gxurw.fsf@gnu.org> <53162dfb-0715-3077-78d1-3a8340943f2f@gmail.com> <838s3y6kaq.fsf@gnu.org> <83k0n7iarj.fsf@gnu.org> <65f059b1-149d-146d-3b8d-36db60ff1044@gmail.com> <87o8cin9fb.fsf@tucano.isti.cnr.it> <39f683d3-65d7-a7d9-18b1-cf6dfa7d254a@gmail.com> X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 47408 Cc: pot@gnu.org, 47408@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) > Cc: 47408-done@debbugs.gnu.org, Eli Zaretskii > From: fabrice nicol > 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? From debbugs-submit-bounces@debbugs.gnu.org Mon Jun 07 20:38:32 2021 Received: (at 47408) by debbugs.gnu.org; 8 Jun 2021 00:38:32 +0000 Received: from localhost ([127.0.0.1]:57031 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lqPlH-0008Mr-SB for submit@debbugs.gnu.org; Mon, 07 Jun 2021 20:38:32 -0400 Received: from mail-ej1-f50.google.com ([209.85.218.50]:33571) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lqPlE-0008Ma-Dq for 47408@debbugs.gnu.org; Mon, 07 Jun 2021 20:38:30 -0400 Received: by mail-ej1-f50.google.com with SMTP id g20so29682258ejt.0 for <47408@debbugs.gnu.org>; Mon, 07 Jun 2021 17:38:28 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=mime-version:references:in-reply-to:from:date:message-id:subject:to :cc; bh=5Yl7MOYc3kMg6bl+Dgsfdw2sm1LSb4KrBpVXvX2M2Pg=; b=s0D9llKwA5ed3+XVsaLi49EUEezgsgKZIfYnaHafxBslKGJANbJSeeLqs/ivi+Kp1E 9CE1SMT4Ul+XolMc8Iyg6mHISWyxzAsvFEtZMbY2TVHoKOOCvCoWc5F363X2slrYVCyF sFOoo1Z42glfFsOfa65e4Nk6KV/4YryqTjQAoW/yPa6TPb6vVujzDIoH3SytTSLQbQrY wEEfJr3sIqEx2ZtTLCvpbpAe3Xw2F5/TYsLNWeeF/3tUGZGPEoJNhoCfp2xVKFjx/aWA T6W6/2NUhm63P+M2WlHxipkBMhBbdgY1VxVEe8zG7oGABH3InEd7lXjRD4FqrKjWgsN7 gUXQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:mime-version:references:in-reply-to:from:date :message-id:subject:to:cc; bh=5Yl7MOYc3kMg6bl+Dgsfdw2sm1LSb4KrBpVXvX2M2Pg=; b=I8Prjx+gb4NjcnojCSeLq0CzPkLF9+foSYeNqox7obbbKUpHhoZ0Nr5mHbGTMojx0K tUv30Bg3A8/iN4OG1MEIjFHTIkHjXve8GXZwd3x/TjL28arpoE6MJb/tjWzFn4mEj1vU JxZg5WukfkNKN/ilS8kGojUPxaQivgI5dpWPw25sB+GXxSAOlA6QEk1s7E6rbt1CjoX1 neG2LbDQYt7L4jffaGm5NxbHX+6TYrATSYWm64KheDiP8KHR4bgP7agIlr01aRz4ynx8 lT6Wa6rDTo0OtHK/jdLlXjOcwlk8tfjn8QhfZHJgQg/KhmcHNR8O17NDpTfbd0IT3yJW AF4g== X-Gm-Message-State: AOAM531KTnIQmyzXVEeLESYPSII6WuexByKgbQZJ6AHHjbXCh0G/HT2E 42hlOSOWH2lHCtnVdDzvgde/5o8oalJLibRtAco= X-Google-Smtp-Source: ABdhPJy6faZ6qtgE2mXFi3PObL8ehvMQLsj/ggTfp4l1/otP33hvG14VBLyTeDgOvqrg5VsLGM785qFJLo7Firthr5c= X-Received: by 2002:a17:906:c791:: with SMTP id cw17mr19756932ejb.329.1623112702320; Mon, 07 Jun 2021 17:38:22 -0700 (PDT) MIME-Version: 1.0 References: <70503251-f8ea-9006-b7e7-b13b93bb71de@gmail.com> <838s4gxurw.fsf@gnu.org> <53162dfb-0715-3077-78d1-3a8340943f2f@gmail.com> <838s3y6kaq.fsf@gnu.org> <83k0n7iarj.fsf@gnu.org> <65f059b1-149d-146d-3b8d-36db60ff1044@gmail.com> <87o8cin9fb.fsf@tucano.isti.cnr.it> <39f683d3-65d7-a7d9-18b1-cf6dfa7d254a@gmail.com> <83fsxthnye.fsf@gnu.org> In-Reply-To: <83fsxthnye.fsf@gnu.org> From: Fabrice Nicol Date: Tue, 8 Jun 2021 02:38:12 +0200 Message-ID: Subject: Re: bug#47408: Etags support for Mercury [v0.5] To: Eli Zaretskii Content-Type: multipart/alternative; boundary="0000000000000d626105c436601b" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 47408 Cc: =?UTF-8?Q?Francesco_Potort=C3=AC?= , 47408@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --0000000000000d626105c436601b Content-Type: text/plain; charset="UTF-8" Content-Transfer-Encoding: quoted-printable 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 =C3=A0 2:05 AM, Eli Zaretskii a =C3=A9cr= it : > > Cc: 47408-done@debbugs.gnu.org, Eli Zaretskii > > From: fabrice nicol > > Date: Sun, 6 Jun 2021 22:49:19 +0200 > > > > > That's difficult to tell for me. However, etags provides ctags suppo= rt > > > 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, mayb= e > > > 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? > --0000000000000d626105c436601b Content-Type: text/html; charset="UTF-8" Content-Transfer-Encoding: quoted-printable
There is something= to be fixed if this is the expected output, as ctags invocation dose not w= ork for Mercury files. I have not looked into the issue yet but the fix sho= uld be quite small.

Le mar. 8 juin 2021 =C3=A0 2:05 AM, Eli Zaretskii= <eliz@gnu.org> a =C3=A9crit=C2= =A0:
> Cc: 47408-done@de= bbugs.gnu.org, Eli Zaretskii <eliz@gnu.org>
> From: fabrice nicol <fabrnicol@gmail.com>
> Date: Sun, 6 Jun 2021 22:49:19 +0200
>
> > That's difficult to tell for me.=C2=A0 However, etags provide= s ctags support
> > for all languages it knows about.=C2=A0 I may be missing somethin= g, but I
> > think Mercury would be the first exception.=C2=A0 If that's t= he case, maybe
> > it would be worth=C2=A0 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 <= br> > 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?=C2=A0 Do we even need to add any code for that?
--0000000000000d626105c436601b-- From debbugs-submit-bounces@debbugs.gnu.org Tue Jun 08 06:53:27 2021 Received: (at 47408) by debbugs.gnu.org; 8 Jun 2021 10:53:27 +0000 Received: from localhost ([127.0.0.1]:57533 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lqZMN-0000wH-Hr for submit@debbugs.gnu.org; Tue, 08 Jun 2021 06:53:27 -0400 Received: from plesklin7.if2.ehiweb.it ([79.98.45.17]:35679 helo=plesklin7.if1.ehiweb.it) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lqZMM-0000w9-8E for 47408@debbugs.gnu.org; Tue, 08 Jun 2021 06:53:26 -0400 Received: from tucano.isti.cnr.it (tucano.isti.cnr.it [146.48.81.102]) by plesklin7.if1.ehiweb.it (Postfix) with ESMTPSA id 2D216103081; Tue, 8 Jun 2021 12:53:24 +0200 (CEST) Message-Id: <87lf7kmxuk.fsf@tucano.isti.cnr.it> From: =?utf-8?Q?Francesco_Potort=C3=AC?= Date: Tue, 08 Jun 2021 12:53:23 +0200 To: Eli Zaretskii In-Reply-To: <83fsxthnye.fsf@gnu.org> (eliz@gnu.org) Subject: Re: bug#47408: Etags support for Mercury [v0.5] References: <70503251-f8ea-9006-b7e7-b13b93bb71de@gmail.com> <838s4gxurw.fsf@gnu.org> <53162dfb-0715-3077-78d1-3a8340943f2f@gmail.com> <838s3y6kaq.fsf@gnu.org> <83k0n7iarj.fsf@gnu.org> <65f059b1-149d-146d-3b8d-36db60ff1044@gmail.com> <87o8cin9fb.fsf@tucano.isti.cnr.it> <39f683d3-65d7-a7d9-18b1-cf6dfa7d254a@gmail.com> <83fsxthnye.fsf@gnu.org> Organization: The GNU project X-fingerprint: 4B02 6187 5C03 D6B1 2E31 7666 09DF 2DC9 BE21 6115 X-PPP-Message-ID: <20210608105324.31262.16276@plesklin7.if1.ehiweb.it> X-PPP-Vhost: potorti.it X-Spam-Score: 1.4 (+) X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: 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 [...] Content analysis details: (1.4 points, 10.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- 0.0 RCVD_IN_MSPIKE_H4 RBL: Very Good reputation (+4) [79.98.45.17 listed in wl.mailspike.net] 0.0 SPF_HELO_NONE SPF: HELO does not publish an SPF Record 1.0 SPF_SOFTFAIL SPF: sender does not match SPF record (softfail) 0.0 RCVD_IN_MSPIKE_WL Mailspike good senders 0.4 KHOP_HELO_FCRDNS Relay HELO differs from its IP's reverse DNS X-Debbugs-Envelope-To: 47408 Cc: 47408@debbugs.gnu.org, fabrice nicol X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -0.0 (/) 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. From debbugs-submit-bounces@debbugs.gnu.org Tue Jun 08 07:48:02 2021 Received: (at 47408) by debbugs.gnu.org; 8 Jun 2021 11:48:03 +0000 Received: from localhost ([127.0.0.1]:57576 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lqaDC-0004TI-NY for submit@debbugs.gnu.org; Tue, 08 Jun 2021 07:48:02 -0400 Received: from eggs.gnu.org ([209.51.188.92]:55930) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lqaDB-0004Sp-Dj for 47408@debbugs.gnu.org; Tue, 08 Jun 2021 07:48:01 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:58974) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lqaD5-0005ZU-0z; Tue, 08 Jun 2021 07:47:55 -0400 Received: from 84.94.185.95.cable.012.net.il ([84.94.185.95]:4309 helo=home-c4e4a596f7) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lqaD3-0004qG-Ti; Tue, 08 Jun 2021 07:47:54 -0400 Date: Tue, 08 Jun 2021 14:47:37 +0300 Message-Id: <83bl8gfuhy.fsf@gnu.org> From: Eli Zaretskii To: Francesco =?iso-8859-1?Q?Potort=EC?= In-Reply-To: <87lf7kmxuk.fsf@tucano.isti.cnr.it> (message from Francesco =?iso-8859-1?Q?Potort=EC?= on Tue, 08 Jun 2021 12:53:23 +0200) Subject: Re: bug#47408: Etags support for Mercury [v0.5] References: <70503251-f8ea-9006-b7e7-b13b93bb71de@gmail.com> <838s4gxurw.fsf@gnu.org> <53162dfb-0715-3077-78d1-3a8340943f2f@gmail.com> <838s3y6kaq.fsf@gnu.org> <83k0n7iarj.fsf@gnu.org> <65f059b1-149d-146d-3b8d-36db60ff1044@gmail.com> <87o8cin9fb.fsf@tucano.isti.cnr.it> <39f683d3-65d7-a7d9-18b1-cf6dfa7d254a@gmail.com> <83fsxthnye.fsf@gnu.org> <87lf7kmxuk.fsf@tucano.isti.cnr.it> MIME-version: 1.0 Content-type: text/plain; charset=iso-8859-1 Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 47408 Cc: 47408@debbugs.gnu.org, fabrnicol@gmail.com X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) > From: Francesco Potortì > Date: Tue, 08 Jun 2021 12:53:23 +0200 > Cc: 47408@debbugs.gnu.org, > fabrice nicol > > > 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? From debbugs-submit-bounces@debbugs.gnu.org Tue Jun 08 08:47:18 2021 Received: (at 47408) by debbugs.gnu.org; 8 Jun 2021 12:47:18 +0000 Received: from localhost ([127.0.0.1]:57649 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lqb8Y-00062C-7k for submit@debbugs.gnu.org; Tue, 08 Jun 2021 08:47:18 -0400 Received: from plesklin7.if2.ehiweb.it ([79.98.45.17]:48666 helo=plesklin7.if1.ehiweb.it) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lqb8W-000621-9D for 47408@debbugs.gnu.org; Tue, 08 Jun 2021 08:47:16 -0400 Received: from tucano.isti.cnr.it (tucano.isti.cnr.it [146.48.81.102]) by plesklin7.if1.ehiweb.it (Postfix) with ESMTPSA id 2B2CDFF387; Tue, 8 Jun 2021 14:47:14 +0200 (CEST) Message-Id: <87k0n4msku.fsf@tucano.isti.cnr.it> From: =?iso-8859-1?Q?Francesco_Potort=EC?= Date: Tue, 08 Jun 2021 14:47:13 +0200 To: Eli Zaretskii In-Reply-To: <83bl8gfuhy.fsf@gnu.org> (eliz@gnu.org) Subject: Re: bug#47408: Etags support for Mercury [v0.5] References: <70503251-f8ea-9006-b7e7-b13b93bb71de@gmail.com> <838s4gxurw.fsf@gnu.org> <53162dfb-0715-3077-78d1-3a8340943f2f@gmail.com> <838s3y6kaq.fsf@gnu.org> <83k0n7iarj.fsf@gnu.org> <65f059b1-149d-146d-3b8d-36db60ff1044@gmail.com> <87o8cin9fb.fsf@tucano.isti.cnr.it> <39f683d3-65d7-a7d9-18b1-cf6dfa7d254a@gmail.com> <83fsxthnye.fsf@gnu.org> <87lf7kmxuk.fsf@tucano.isti.cnr.it> <83bl8gfuhy.fsf@gnu.org> Organization: The GNU project X-fingerprint: 4B02 6187 5C03 D6B1 2E31 7666 09DF 2DC9 BE21 6115 MIME-version: 1.0 Content-type: text/plain; charset=iso-8859-1 Content-Transfer-Encoding: 8bit X-PPP-Message-ID: <20210608124714.32558.63785@plesklin7.if1.ehiweb.it> X-PPP-Vhost: potorti.it X-Spam-Score: 1.4 (+) X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: >> From: Francesco Potortì >> Date: Tue, 08 Jun 2021 12:53:23 +0200 >> Cc: 47408@debbugs.gnu.org, >> fabrice nicol >> >> > What do we lose if we make Mercury suppor [...] Content analysis details: (1.4 points, 10.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- 0.0 RCVD_IN_MSPIKE_H4 RBL: Very Good reputation (+4) [79.98.45.17 listed in wl.mailspike.net] 0.0 SPF_HELO_NONE SPF: HELO does not publish an SPF Record 1.0 SPF_SOFTFAIL SPF: sender does not match SPF record (softfail) 0.0 RCVD_IN_MSPIKE_WL Mailspike good senders 0.4 KHOP_HELO_FCRDNS Relay HELO differs from its IP's reverse DNS X-Debbugs-Envelope-To: 47408 Cc: fabrnicol@gmail.com, 47408@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -0.0 (/) >> From: Francesco Potortì >> Date: Tue, 08 Jun 2021 12:53:23 +0200 >> Cc: 47408@debbugs.gnu.org, >> fabrice nicol >> >> > 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... From debbugs-submit-bounces@debbugs.gnu.org Thu Jun 10 09:59:28 2021 Received: (at 47408) by debbugs.gnu.org; 10 Jun 2021 13:59:28 +0000 Received: from localhost ([127.0.0.1]:37475 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lrLDT-0007jn-T1 for submit@debbugs.gnu.org; Thu, 10 Jun 2021 09:59:28 -0400 Received: from eggs.gnu.org ([209.51.188.92]:54868) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lrLDR-0007jK-Bs for 47408@debbugs.gnu.org; Thu, 10 Jun 2021 09:59:26 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:51376) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lrLDK-0003yY-Pe; Thu, 10 Jun 2021 09:59:18 -0400 Received: from 84.94.185.95.cable.012.net.il ([84.94.185.95]:2979 helo=home-c4e4a596f7) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lrLDK-00066x-6a; Thu, 10 Jun 2021 09:59:18 -0400 Date: Thu, 10 Jun 2021 16:59:04 +0300 Message-Id: <834ke5ddnb.fsf@gnu.org> From: Eli Zaretskii To: Francesco =?iso-8859-1?Q?Potort=EC?= In-Reply-To: <87k0n4msku.fsf@tucano.isti.cnr.it> (message from Francesco =?iso-8859-1?Q?Potort=EC?= on Tue, 08 Jun 2021 14:47:13 +0200) Subject: Re: bug#47408: Etags support for Mercury [v0.5] References: <70503251-f8ea-9006-b7e7-b13b93bb71de@gmail.com> <838s4gxurw.fsf@gnu.org> <53162dfb-0715-3077-78d1-3a8340943f2f@gmail.com> <838s3y6kaq.fsf@gnu.org> <83k0n7iarj.fsf@gnu.org> <65f059b1-149d-146d-3b8d-36db60ff1044@gmail.com> <87o8cin9fb.fsf@tucano.isti.cnr.it> <39f683d3-65d7-a7d9-18b1-cf6dfa7d254a@gmail.com> <83fsxthnye.fsf@gnu.org> <87lf7kmxuk.fsf@tucano.isti.cnr.it> <83bl8gfuhy.fsf@gnu.org> <87k0n4msku.fsf@tucano.isti.cnr.it> MIME-version: 1.0 Content-type: text/plain; charset=iso-8859-1 Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 47408 Cc: fabrnicol@gmail.com, 47408@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) > From: Francesco Potortì > Date: Tue, 08 Jun 2021 14:47:13 +0200 > Cc: fabrnicol@gmail.com, > 47408@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. From debbugs-submit-bounces@debbugs.gnu.org Thu Jun 10 12:51:57 2021 Received: (at 47408) by debbugs.gnu.org; 10 Jun 2021 16:51:57 +0000 Received: from localhost ([127.0.0.1]:37666 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lrNuP-0005l5-0e for submit@debbugs.gnu.org; Thu, 10 Jun 2021 12:51:57 -0400 Received: from mail-wr1-f45.google.com ([209.85.221.45]:42753) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lrNuL-0005kq-8y for 47408@debbugs.gnu.org; Thu, 10 Jun 2021 12:51:55 -0400 Received: by mail-wr1-f45.google.com with SMTP id c5so3081457wrq.9 for <47408@debbugs.gnu.org>; Thu, 10 Jun 2021 09:51:53 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=subject:to:cc:references:from:message-id:date:user-agent :mime-version:in-reply-to:content-language; bh=+nDjsDlQFBcEVca+p9lKqI/SKDQJuwAenNZUs6WOPwI=; b=k4QSrhP1Pkg5W1WlFxpPsUi2Ycy/mvtrBuoES9lxOZyI+e7AbfRd6XEoutDkRHHGM8 3sm3/b7WjpoNih1uUtrwfTW1PAAxYpjLFpTxTBikjkPYHdQR/0E+p9vJFxBSNaMyUwQY AQmpzjy5CLDgp6Bqkmui1mMDqZaGpZ5IreseF7ddADVWzsB5dzowaEdOumDAsU23w23R 7pg2PztrQ8oHJcZDsZ94JtGbQso5wGxTyY1GkngZToJPS8C/7uE3EZBF6Cq17GlBqYsF 6kwREk7lpQc6+s2CWOLaqoxHhSh0cDLEd0by8XxKxUehRn/VHcaknVP3CfV26w3VDD6W Sleg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:subject:to:cc:references:from:message-id:date :user-agent:mime-version:in-reply-to:content-language; bh=+nDjsDlQFBcEVca+p9lKqI/SKDQJuwAenNZUs6WOPwI=; b=VhvYCZJlTHSVDZNxUJyLn+Dalu48TP6f9/hI/Ki7pQeCvp/MbAvoYTolXVmFp3gFYB n2asXMR+IO6ODAFYnt2vb7uyWIT6avirQL+4OEEbvq7WyPLjzZSLacUMLe8yw0YwAQNI M827zjGKhws2JId4mupOaVm28Iw0bvmWkuZr5Ty7y2Q+yuzZDonj7If38HTcD+aIBGV4 805wRLxhlQyTnydSGwLege2jZeV0T12MgHfVa0ZtDz3ShaIH/s92hPIkpz9QG7J7ag79 jLnbW/2qe13LbIhslO19opB648vtZ3E/GuD1RFerGMnTOKH98WXsTvvazSgye27JeqLa Glbw== X-Gm-Message-State: AOAM533IMFspUzhj14r1GB7BUCAMu/btdslZfG5dG7C7Ndl4kY7ICYGo JW3s2YwdPusVypvdQaxHQyKLNy1d4xw= X-Google-Smtp-Source: ABdhPJwljFCK0ICKsGlutgGxU0eVNhdQtQdwMnXrwJne9MXprAH3bgs5vLhMBnLK3TqMpkBzm4Rd5w== X-Received: by 2002:a05:6000:186c:: with SMTP id d12mr6533226wri.123.1623343907181; Thu, 10 Jun 2021 09:51:47 -0700 (PDT) Received: from ?IPv6:2a01:cb1d:88b9:5c00:7b73:7901:965e:8523? ([2a01:cb1d:88b9:5c00:7b73:7901:965e:8523]) by smtp.gmail.com with ESMTPSA id q19sm1973742wmf.22.2021.06.10.09.51.45 (version=TLS1_3 cipher=TLS_AES_128_GCM_SHA256 bits=128/128); Thu, 10 Jun 2021 09:51:45 -0700 (PDT) Subject: Re: bug#47408: Etags support for Mercury [v0.5] To: Eli Zaretskii , =?UTF-8?Q?Francesco_Potort=c3=ac?= References: <70503251-f8ea-9006-b7e7-b13b93bb71de@gmail.com> <838s4gxurw.fsf@gnu.org> <53162dfb-0715-3077-78d1-3a8340943f2f@gmail.com> <838s3y6kaq.fsf@gnu.org> <83k0n7iarj.fsf@gnu.org> <65f059b1-149d-146d-3b8d-36db60ff1044@gmail.com> <87o8cin9fb.fsf@tucano.isti.cnr.it> <39f683d3-65d7-a7d9-18b1-cf6dfa7d254a@gmail.com> <83fsxthnye.fsf@gnu.org> <87lf7kmxuk.fsf@tucano.isti.cnr.it> <83bl8gfuhy.fsf@gnu.org> <87k0n4msku.fsf@tucano.isti.cnr.it> <834ke5ddnb.fsf@gnu.org> From: fabrice nicol Message-ID: Date: Thu, 10 Jun 2021 18:52:49 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Thunderbird/78.10.2 MIME-Version: 1.0 In-Reply-To: <834ke5ddnb.fsf@gnu.org> Content-Type: multipart/mixed; boundary="------------211BF609FFFB707993F452CF" Content-Language: en-US X-Spam-Score: -0.0 (/) X-Debbugs-Envelope-To: 47408 Cc: 47408@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) This is a multi-part message in MIME format. --------------211BF609FFFB707993F452CF Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 8bit 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@gmail.com, >> 47408@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. --------------211BF609FFFB707993F452CF Content-Type: application/vnd.wolfram.mathematica.package; name="univ.m" Content-Transfer-Encoding: base64 Content-Disposition: attachment; filename="univ.m" JS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0t LS0tLS0tLS0tLS0tLS0tLS0tLS0tLSUKJSB2aW06IGZ0PW1lcmN1cnkgdHM9NCBzdz00IGV0 CiUtLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0t LS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0lCiUgQ29weXJpZ2h0IChDKSAxOTk0LTIwMTAgVGhl IFVuaXZlcnNpdHkgb2YgTWVsYm91cm5lLgolIENvcHlyaWdodCAoQykgMjAxNC0yMDE4IFRo ZSBNZXJjdXJ5IHRlYW0uCiUgVGhpcyBmaWxlIGlzIGRpc3RyaWJ1dGVkIHVuZGVyIHRoZSB0 ZXJtcyBzcGVjaWZpZWQgaW4gQ09QWUlORy5MSUIuCiUtLS0tLS0tLS0tLS0tLS0tLS0tLS0t LS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0l CiUKJSBGaWxlOiB1bml2Lm0uCiUgTWFpbiBhdXRob3I6IGZqaC4KJSBTdGFiaWxpdHk6IG1l ZGl1bS4KJQolIFRoZSB1bml2ZXJzYWwgdHlwZSBgdW5pdicKJQolLS0tLS0tLS0tLS0tLS0t LS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0t LS0tLS0tJQolLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0t LS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tJQoKOi0gbW9kdWxlIHVuaXYuCjotIGlu dGVyZmFjZS4KCjotIGltcG9ydF9tb2R1bGUgdHlwZV9kZXNjLgoKJS0tLS0tLS0tLS0tLS0t LS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0t LS0tLS0tLSUKCiAgICAlIEFuIG9iamVjdCBvZiB0eXBlIGB1bml2JyBjYW4gaG9sZCB0aGUg dHlwZSBhbmQgdmFsdWUgb2YgYW4gb2JqZWN0IG9mIGFueQogICAgJSBvdGhlciB0eXBlLgog ICAgJQo6LSB0eXBlIHVuaXYuCgogICAgJSB0eXBlX3RvX3VuaXYoT2JqZWN0LCBVbml2KS4K ICAgICUKICAgICUgVHJ1ZSBpZmYgdGhlIHR5cGUgc3RvcmVkIGluIGBVbml2JyBpcyB0aGUg c2FtZSBhcyB0aGUgdHlwZSBvZiBgT2JqZWN0JywKICAgICUgYW5kIHRoZSB2YWx1ZSBzdG9y ZWQgaW4gYFVuaXYnIGlzIGVxdWFsIHRvIHRoZSB2YWx1ZSBvZiBgT2JqZWN0Jy4KICAgICUK ICAgICUgT3BlcmF0aW9uYWxseSwKICAgICUKICAgICUgLSB0aGUgZm9yd2FyZCBtb2RlcyAo dGhlIGRpLHVvIG1vZGUgYW5kIHRoZSBpbixvdXQgbW9kZSkKICAgICUgICBjb252ZXJ0IGBP YmplY3QnIHRvIHR5cGUgdW5pdjsKICAgICUKICAgICUgLSB0aGUgcmV2ZXJzZSBtb2RlIChv dXQsaW4pIGNoZWNrcyB3aGV0aGVyIHRoZSB2YWx1ZSBzdG9yZWQgaW4gYFVuaXYnCiAgICAl ICAgaXMgb2YgdHlwZSBULiBJZiB0aGlzIHR5cGUgdGVzdCBzdWNjZWVkcywgaXQgcmV0dXJu cyB0aGF0IHZhbHVlCiAgICAlICAgYXMgYE9iamVjdCcsIGJ1dCBpZiB0aGUgdGVzdCBmYWls cywgaXQgZmFpbHMgYXMgd2VsbC4KICAgICUKOi0gcHJlZCB0eXBlX3RvX3VuaXYoVCwgdW5p dikuCjotIG1vZGUgdHlwZV90b191bml2KGRpLCB1bykgaXMgZGV0Lgo6LSBtb2RlIHR5cGVf dG9fdW5pdihpbiwgb3V0KSBpcyBkZXQuCjotIG1vZGUgdHlwZV90b191bml2KG91dCwgaW4p IGlzIHNlbWlkZXQuCgogICAgJSB1bml2X3RvX3R5cGUoVW5pdiwgT2JqZWN0KSA6LSB0eXBl X3RvX3VuaXYoT2JqZWN0LCBVbml2KS4KICAgICUKOi0gcHJlZCB1bml2X3RvX3R5cGUodW5p diwgVCkuCjotIG1vZGUgdW5pdl90b190eXBlKGluLCBvdXQpIGlzIHNlbWlkZXQuCjotIG1v ZGUgdW5pdl90b190eXBlKG91dCwgaW4pIGlzIGRldC4KOi0gbW9kZSB1bml2X3RvX3R5cGUo dW8sIGRpKSBpcyBkZXQuCgogICAgJSBUaGUgZnVuY3Rpb24gdW5pdi8xIHByb3ZpZGVzIHRo ZSBzYW1lIGZ1bmN0aW9uYWxpdHkgYXMgdHlwZV90b191bml2LzIuCiAgICAlIHVuaXYoT2Jq ZWN0KSA9IFVuaXYgOi0gdHlwZV90b191bml2KE9iamVjdCwgVW5pdikuCiAgICAlCjotIGZ1 bmMgdW5pdihUKSA9IHVuaXYuCjotIG1vZGUgdW5pdihpbikgPSBvdXQgaXMgZGV0Lgo6LSBt b2RlIHVuaXYoZGkpID0gdW8gaXMgZGV0Lgo6LSBtb2RlIHVuaXYob3V0KSA9IGluIGlzIHNl bWlkZXQuCgogICAgJSBkZXRfdW5pdl90b190eXBlKFVuaXYsIE9iamVjdCkuCiAgICAlCiAg ICAlIFRoZSBzYW1lIGFzIHRoZSBmb3J3YXJkcyBtb2RlIG9mIHVuaXZfdG9fdHlwZSwgYnV0 IHRocm93cyBhbiBleGNlcHRpb24KICAgICUgaWYgdW5pdl90b190eXBlIGZhaWxzLgogICAg JQo6LSBwcmVkIGRldF91bml2X3RvX3R5cGUodW5pdjo6aW4sIFQ6Om91dCkgaXMgZGV0LgoK ICAgICUgdW5pdl90eXBlKFVuaXYpLgogICAgJQogICAgJSBSZXR1cm5zIHRoZSB0eXBlX2Rl c2MgZm9yIHRoZSB0eXBlIHN0b3JlZCBpbiBgVW5pdicuCiAgICAlCjotIGZ1bmMgdW5pdl90 eXBlKHVuaXYpID0gdHlwZV9kZXNjLgoKICAgICUgdW5pdl92YWx1ZShVbml2KS4KICAgICUK ICAgICUgUmV0dXJucyB0aGUgdmFsdWUgb2YgdGhlIG9iamVjdCBzdG9yZWQgaW4gVW5pdi4K ICAgICUKOi0gc29tZSBbVF0gZnVuYyB1bml2X3ZhbHVlKHVuaXYpID0gVC4KCiUtLS0tLS0t LS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0t LS0tLS0tLS0tLS0tLS0lCiUtLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0t LS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0lCgo6LSBpbXBsZW1lbnRh dGlvbi4KCjotIGltcG9ydF9tb2R1bGUgcmVxdWlyZS4KOi0gaW1wb3J0X21vZHVsZSBsaXN0 Lgo6LSBpbXBvcnRfbW9kdWxlIHN0cmluZy4KCiUtLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0t LS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0lCgog ICAgJSBXZSBjYWxsIHRoZSBjb25zdHJ1Y3RvciBmb3IgdW5pdnMgYHVuaXZfY29ucycgdG8g YXZvaWQgYW1iaWd1aXR5CiAgICAlIHdpdGggdGhlIHVuaXYvMSBmdW5jdGlvbiB3aGljaCBy ZXR1cm5zIGEgdW5pdi4KICAgICUKOi0gdHlwZSB1bml2CiAgICAtLS0+ICAgIHNvbWUgW1Rd IHVuaXZfY29ucyhUKS4KCjotIHByYWdtYSBwcm9taXNlX2VxdWl2YWxlbnRfY2xhdXNlcyh0 eXBlX3RvX3VuaXYvMikuCgp0eXBlX3RvX3VuaXYoVDo6ZGksIFVuaXY6OnVvKSA6LQogICAg VW5pdjAgPSAnbmV3IHVuaXZfY29ucycoVCksCiAgICB1bnNhZmVfcHJvbWlzZV91bmlxdWUo VW5pdjAsIFVuaXYpLgp0eXBlX3RvX3VuaXYoVDo6aW4sIFVuaXY6Om91dCkgOi0KICAgIFVu aXYgPSAnbmV3IHVuaXZfY29ucycoVCkuCnR5cGVfdG9fdW5pdihUOjpvdXQsIFVuaXY6Omlu KSA6LQogICAgVW5pdiA9IHVuaXZfY29ucyhUMCksCiAgICBwcml2YXRlX2J1aWx0aW4udHlw ZWRfdW5pZnkoVDAsIFQpLgoKdW5pdl90b190eXBlKFVuaXYsIFgpIDotCiAgICB0eXBlX3Rv X3VuaXYoWCwgVW5pdikuCgp1bml2KFgpID0gVW5pdiA6LQogICAgdHlwZV90b191bml2KFgs IFVuaXYpLgoKZGV0X3VuaXZfdG9fdHlwZShVbml2LCBYKSA6LQogICAgKCBpZiB0eXBlX3Rv X3VuaXYoWDAsIFVuaXYpIHRoZW4KICAgICAgICBYID0gWDAKICAgIGVsc2UKICAgICAgICBV bml2VHlwZU5hbWUgPSB0eXBlX25hbWUodW5pdl90eXBlKFVuaXYpKSwKICAgICAgICBPYmpl Y3RUeXBlTmFtZSA9IHR5cGVfbmFtZSh0eXBlX29mKFgpKSwKICAgICAgICBzdHJpbmcuYXBw ZW5kX2xpc3QoWyJkZXRfdW5pdl90b190eXBlOiBjb252ZXJzaW9uIGZhaWxlZFxuIiwKICAg ICAgICAgICAgIlx0VW5pdiBUeXBlOiAiLCBVbml2VHlwZU5hbWUsICJcbiIsCiAgICAgICAg ICAgICJcdE9iamVjdCBUeXBlOiAiLCBPYmplY3RUeXBlTmFtZV0sIEVycm9yU3RyaW5nKSwK ICAgICAgICBlcnJvcihFcnJvclN0cmluZykKICAgICkuCgp1bml2X3R5cGUoVW5pdikgPSB0 eXBlX29mKHVuaXZfdmFsdWUoVW5pdikpLgoKdW5pdl92YWx1ZSh1bml2X2NvbnMoWCkpID0g WC4KCjotIHByZWQgY29uc3RydWN0X3VuaXYoVDo6aW4sIHVuaXY6Om91dCkgaXMgZGV0Lgo6 LSBwcmFnbWEgZm9yZWlnbl9leHBvcnQoIkMiLCBjb25zdHJ1Y3RfdW5pdihpbiwgb3V0KSwg Ik1MX2NvbnN0cnVjdF91bml2IikuCjotIHByYWdtYSBmb3JlaWduX2V4cG9ydCgiQyMiLCBj b25zdHJ1Y3RfdW5pdihpbiwgb3V0KSwgIk1MX2NvbnN0cnVjdF91bml2IikuCjotIHByYWdt YSBmb3JlaWduX2V4cG9ydCgiSmF2YSIsIGNvbnN0cnVjdF91bml2KGluLCBvdXQpLCAiTUxf Y29uc3RydWN0X3VuaXYiKS4KCmNvbnN0cnVjdF91bml2KFgsIFVuaXYpIDotCiAgICBVbml2 ID0gdW5pdihYKS4KCjotIHNvbWUgW1RdIHByZWQgdW5yYXZlbF91bml2KHVuaXY6OmluLCBU OjpvdXQpIGlzIGRldC4KOi0gcHJhZ21hIGZvcmVpZ25fZXhwb3J0KCJDIiwgdW5yYXZlbF91 bml2KGluLCBvdXQpLCAiTUxfdW5yYXZlbF91bml2IikuCjotIHByYWdtYSBmb3JlaWduX2V4 cG9ydCgiQyMiLCB1bnJhdmVsX3VuaXYoaW4sIG91dCksICJNTF91bnJhdmVsX3VuaXYiKS4K Oi0gcHJhZ21hIGZvcmVpZ25fZXhwb3J0KCJKYXZhIiwgdW5yYXZlbF91bml2KGluLCBvdXQp LCAiTUxfdW5yYXZlbF91bml2IikuCgp1bnJhdmVsX3VuaXYoVW5pdiwgWCkgOi0KICAgIHVu aXZfdmFsdWUoVW5pdikgPSBYLgoKJS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0t LS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLSUKOi0gZW5kX21v ZHVsZSB1bml2LgolLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0t LS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tJQo= --------------211BF609FFFB707993F452CF-- From debbugs-submit-bounces@debbugs.gnu.org Thu Jun 10 13:05:41 2021 Received: (at 47408) by debbugs.gnu.org; 10 Jun 2021 17:05:41 +0000 Received: from localhost ([127.0.0.1]:37670 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lrO7h-000666-AP for submit@debbugs.gnu.org; Thu, 10 Jun 2021 13:05:41 -0400 Received: from plesklin7.if2.ehiweb.it ([79.98.45.17]:41881 helo=plesklin7.if1.ehiweb.it) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lrO7g-00065x-3g for 47408@debbugs.gnu.org; Thu, 10 Jun 2021 13:05:40 -0400 Received: from tucano.isti.cnr.it (tucano.isti.cnr.it [146.48.81.102]) by plesklin7.if1.ehiweb.it (Postfix) with ESMTPSA id 8BDEE10730F; Thu, 10 Jun 2021 19:05:37 +0200 (CEST) Message-Id: <87eed9myzi.fsf@tucano.isti.cnr.it> From: =?utf-8?Q?Francesco_Potort=C3=AC?= Date: Thu, 10 Jun 2021 19:05:37 +0200 To: fabrice nicol In-Reply-To: (fabrnicol@gmail.com) Subject: Re: bug#47408: Etags support for Mercury [v0.5] References: <70503251-f8ea-9006-b7e7-b13b93bb71de@gmail.com> <838s4gxurw.fsf@gnu.org> <53162dfb-0715-3077-78d1-3a8340943f2f@gmail.com> <838s3y6kaq.fsf@gnu.org> <83k0n7iarj.fsf@gnu.org> <65f059b1-149d-146d-3b8d-36db60ff1044@gmail.com> <87o8cin9fb.fsf@tucano.isti.cnr.it> <39f683d3-65d7-a7d9-18b1-cf6dfa7d254a@gmail.com> <83fsxthnye.fsf@gnu.org> <87lf7kmxuk.fsf@tucano.isti.cnr.it> <83bl8gfuhy.fsf@gnu.org> <87k0n4msku.fsf@tucano.isti.cnr.it> <834ke5ddnb.fsf@gnu.org> Organization: The GNU project X-fingerprint: 4B02 6187 5C03 D6B1 2E31 7666 09DF 2DC9 BE21 6115 MIME-version: 1.0 Content-type: text/plain; charset=utf-8 Content-Transfer-Encoding: 8bit X-PPP-Message-ID: <20210610170537.6564.78208@plesklin7.if1.ehiweb.it> X-PPP-Vhost: potorti.it X-Spam-Score: 1.4 (+) X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: >:- 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 [ [...] Content analysis details: (1.4 points, 10.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- 0.0 RCVD_IN_MSPIKE_H4 RBL: Very Good reputation (+4) [79.98.45.17 listed in wl.mailspike.net] 0.0 SPF_HELO_NONE SPF: HELO does not publish an SPF Record 1.0 SPF_SOFTFAIL SPF: sender does not match SPF record (softfail) 0.0 RCVD_IN_MSPIKE_WL Mailspike good senders 0.4 KHOP_HELO_FCRDNS Relay HELO differs from its IP's reverse DNS X-Debbugs-Envelope-To: 47408 Cc: 47408@debbugs.gnu.org, Eli Zaretskii X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -0.0 (/) >:- 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 From debbugs-submit-bounces@debbugs.gnu.org Thu Jun 10 13:21:10 2021 Received: (at 47408) by debbugs.gnu.org; 10 Jun 2021 17:21:10 +0000 Received: from localhost ([127.0.0.1]:37676 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lrOMf-0006TB-OD for submit@debbugs.gnu.org; Thu, 10 Jun 2021 13:21:10 -0400 Received: from eggs.gnu.org ([209.51.188.92]:53280) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lrOMc-0006SV-65 for 47408@debbugs.gnu.org; Thu, 10 Jun 2021 13:21:08 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:60380) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lrOMV-0002ZO-Jl; Thu, 10 Jun 2021 13:20:59 -0400 Received: from 84.94.185.95.cable.012.net.il ([84.94.185.95]:4145 helo=home-c4e4a596f7) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lrOMV-00055d-6f; Thu, 10 Jun 2021 13:20:59 -0400 Date: Thu, 10 Jun 2021 20:20:45 +0300 Message-Id: <83h7i5bpqq.fsf@gnu.org> From: Eli Zaretskii To: fabrice nicol In-Reply-To: (message from fabrice nicol on Thu, 10 Jun 2021 18:52:49 +0200) Subject: Re: bug#47408: Etags support for Mercury [v0.5] References: <70503251-f8ea-9006-b7e7-b13b93bb71de@gmail.com> <838s4gxurw.fsf@gnu.org> <53162dfb-0715-3077-78d1-3a8340943f2f@gmail.com> <838s3y6kaq.fsf@gnu.org> <83k0n7iarj.fsf@gnu.org> <65f059b1-149d-146d-3b8d-36db60ff1044@gmail.com> <87o8cin9fb.fsf@tucano.isti.cnr.it> <39f683d3-65d7-a7d9-18b1-cf6dfa7d254a@gmail.com> <83fsxthnye.fsf@gnu.org> <87lf7kmxuk.fsf@tucano.isti.cnr.it> <83bl8gfuhy.fsf@gnu.org> <87k0n4msku.fsf@tucano.isti.cnr.it> <834ke5ddnb.fsf@gnu.org> MIME-version: 1.0 Content-type: text/plain; charset=utf-8 Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 47408 Cc: pot@gnu.org, 47408@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) > Cc: 47408@debbugs.gnu.org > From: fabrice nicol > 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. From debbugs-submit-bounces@debbugs.gnu.org Thu Jun 10 15:15:37 2021 Received: (at 47408) by debbugs.gnu.org; 10 Jun 2021 19:15:37 +0000 Received: from localhost ([127.0.0.1]:37714 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lrQ9Q-0000dI-UM for submit@debbugs.gnu.org; Thu, 10 Jun 2021 15:15:37 -0400 Received: from eggs.gnu.org ([209.51.188.92]:43556) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lrQ9L-0000cz-M6 for 47408@debbugs.gnu.org; Thu, 10 Jun 2021 15:15:35 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:34768) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lrQ9G-0001aw-6c; Thu, 10 Jun 2021 15:15:26 -0400 Received: from 84.94.185.95.cable.012.net.il ([84.94.185.95]:3210 helo=home-c4e4a596f7) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lrQ9E-0005dj-JQ; Thu, 10 Jun 2021 15:15:26 -0400 Date: Thu, 10 Jun 2021 22:15:11 +0300 Message-Id: <838s3hbkg0.fsf@gnu.org> From: Eli Zaretskii To: fabrnicol@gmail.com In-Reply-To: <83h7i5bpqq.fsf@gnu.org> (message from Eli Zaretskii on Thu, 10 Jun 2021 20:20:45 +0300) Subject: Re: bug#47408: Etags support for Mercury [v0.5] References: <70503251-f8ea-9006-b7e7-b13b93bb71de@gmail.com> <838s4gxurw.fsf@gnu.org> <53162dfb-0715-3077-78d1-3a8340943f2f@gmail.com> <838s3y6kaq.fsf@gnu.org> <83k0n7iarj.fsf@gnu.org> <65f059b1-149d-146d-3b8d-36db60ff1044@gmail.com> <87o8cin9fb.fsf@tucano.isti.cnr.it> <39f683d3-65d7-a7d9-18b1-cf6dfa7d254a@gmail.com> <83fsxthnye.fsf@gnu.org> <87lf7kmxuk.fsf@tucano.isti.cnr.it> <83bl8gfuhy.fsf@gnu.org> <87k0n4msku.fsf@tucano.isti.cnr.it> <834ke5ddnb.fsf@gnu.org> <83h7i5bpqq.fsf@gnu.org> X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 47408 Cc: 47408@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) > Date: Thu, 10 Jun 2021 20:20:45 +0300 > From: Eli Zaretskii > Cc: 47408@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. From debbugs-submit-bounces@debbugs.gnu.org Thu Jun 10 16:38:34 2021 Received: (at 47408) by debbugs.gnu.org; 10 Jun 2021 20:38:34 +0000 Received: from localhost ([127.0.0.1]:37774 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lrRRh-0002bM-T5 for submit@debbugs.gnu.org; Thu, 10 Jun 2021 16:38:34 -0400 Received: from mail-wm1-f45.google.com ([209.85.128.45]:44836) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lrRRg-0002b9-0c for 47408@debbugs.gnu.org; Thu, 10 Jun 2021 16:38:33 -0400 Received: by mail-wm1-f45.google.com with SMTP id m41-20020a05600c3b29b02901b9e5d74f02so4120798wms.3 for <47408@debbugs.gnu.org>; Thu, 10 Jun 2021 13:38:31 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=subject:to:cc:references:from:message-id:date:user-agent :mime-version:in-reply-to:content-transfer-encoding:content-language; bh=zQo1DssVIrS3bkM+zExuApj56cpp8pCQQ2whOl7ONfU=; b=NeT8ljzhyWKlA04iFstKj/EXuKeWAYgq1+AuNVcbwF5E6+hikPyjtvJ4MeJs0Fi8gS ARz99Of+S/50OshoSOQMPQwVHzjBxhm6dgGHunQ0ZnTOz3AmTyUJfctkgkIFxl3bpCri 2/2xMwxcGCfGEg/FDdgnesapsjWaYgvdBjnvk/rlxBUjadiwuSnusAUgFAV1m8AtuurE 2iShYd7137Mr6yxnyHJrWV9TXnfLTYQ0XGx1uCb96jyF5+63obfrYQokh+9qqRwZKwsm x8SRFCHKbQ4oyUzoXW2g/N2DLSaNeWYoDfQLw2cqDwwWgLKUd+gLW7plGz8pi1QT9Df9 pH5g== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:subject:to:cc:references:from:message-id:date :user-agent:mime-version:in-reply-to:content-transfer-encoding :content-language; bh=zQo1DssVIrS3bkM+zExuApj56cpp8pCQQ2whOl7ONfU=; b=MN1jXEU/Mm7cSozqrKR/qdjiLeN8GOCarexJuXY4bPfh8nnyCnvR82bNlMQ863ly4t IysEWKWFV1CvJBWFrJ8Xb342vOogPPGNFMK+XtWuIa3SPugjLJAwU/ywbyFvbu4Pr/Lu m2xHUeOOHDE7cqJtyaXv7/vt+ONdG8liHLcx9LwGODtgh2x11UhZK3I+8/HRX9nPMYL4 cBdY9zEk1Icl1m+jKvL5YyoA0l5nvZJG4ZdpKtFtWYjvyuqv4qouK97Mj7jiUrhWZUCu DlJ7mvdjt+ZmZ+H1AVe96rVwJXc8o9hJZl5NHiWrbxUQzDB8gTuX7PmTwdnm+xFFJaYa SutA== X-Gm-Message-State: AOAM532wWY2wFsB+uIAJ06QU8+QeSA27PEkZVpha90dlGAqR+WQeBXCh 4n3qdVPG/dM5RpofvysVy1PBNCXTlFU= X-Google-Smtp-Source: ABdhPJx/kv766yy/gh0EfUe5RV+TmLmIP4Mh88mQROWOeDPJRiVDAQkYb0NvoreMpO8FA3YIGjj4nw== X-Received: by 2002:a05:600c:358b:: with SMTP id p11mr639713wmq.112.1623357505852; Thu, 10 Jun 2021 13:38:25 -0700 (PDT) Received: from ?IPv6:2a01:cb1d:88b9:5c00:7b73:7901:965e:8523? ([2a01:cb1d:88b9:5c00:7b73:7901:965e:8523]) by smtp.gmail.com with ESMTPSA id l20sm3802957wmq.3.2021.06.10.13.38.25 (version=TLS1_3 cipher=TLS_AES_128_GCM_SHA256 bits=128/128); Thu, 10 Jun 2021 13:38:25 -0700 (PDT) Subject: bug#47408: Etags support for Mercury -- fix explicit tags for existentially-quantified procedures To: Eli Zaretskii References: <70503251-f8ea-9006-b7e7-b13b93bb71de@gmail.com> <838s4gxurw.fsf@gnu.org> <53162dfb-0715-3077-78d1-3a8340943f2f@gmail.com> <838s3y6kaq.fsf@gnu.org> <83k0n7iarj.fsf@gnu.org> <65f059b1-149d-146d-3b8d-36db60ff1044@gmail.com> <87o8cin9fb.fsf@tucano.isti.cnr.it> <39f683d3-65d7-a7d9-18b1-cf6dfa7d254a@gmail.com> <83fsxthnye.fsf@gnu.org> <87lf7kmxuk.fsf@tucano.isti.cnr.it> <83bl8gfuhy.fsf@gnu.org> <87k0n4msku.fsf@tucano.isti.cnr.it> <834ke5ddnb.fsf@gnu.org> <83h7i5bpqq.fsf@gnu.org> From: fabrice nicol Message-ID: Date: Thu, 10 Jun 2021 22:39:29 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Thunderbird/78.10.2 MIME-Version: 1.0 In-Reply-To: <83h7i5bpqq.fsf@gnu.org> Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 8bit Content-Language: en-US X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 47408 Cc: pot@gnu.org, 47408@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) 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 From debbugs-submit-bounces@debbugs.gnu.org Fri Jun 11 01:57:14 2021 Received: (at 47408) by debbugs.gnu.org; 11 Jun 2021 05:57:14 +0000 Received: from localhost ([127.0.0.1]:38003 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lraAM-0007bF-7L for submit@debbugs.gnu.org; Fri, 11 Jun 2021 01:57:14 -0400 Received: from eggs.gnu.org ([209.51.188.92]:39712) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lraAJ-0007az-JB for 47408@debbugs.gnu.org; Fri, 11 Jun 2021 01:57:12 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:49928) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lraAD-0007Q6-St; Fri, 11 Jun 2021 01:57:05 -0400 Received: from 84.94.185.95.cable.012.net.il ([84.94.185.95]:2732 helo=home-c4e4a596f7) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lraAD-0003sH-Ae; Fri, 11 Jun 2021 01:57:05 -0400 Date: Fri, 11 Jun 2021 08:56:55 +0300 Message-Id: <831r99aqqg.fsf@gnu.org> From: Eli Zaretskii To: fabrice nicol In-Reply-To: (message from fabrice nicol on Thu, 10 Jun 2021 22:39:29 +0200) Subject: Re: bug#47408: Etags support for Mercury -- fix explicit tags for existentially-quantified procedures References: <70503251-f8ea-9006-b7e7-b13b93bb71de@gmail.com> <838s4gxurw.fsf@gnu.org> <53162dfb-0715-3077-78d1-3a8340943f2f@gmail.com> <838s3y6kaq.fsf@gnu.org> <83k0n7iarj.fsf@gnu.org> <65f059b1-149d-146d-3b8d-36db60ff1044@gmail.com> <87o8cin9fb.fsf@tucano.isti.cnr.it> <39f683d3-65d7-a7d9-18b1-cf6dfa7d254a@gmail.com> <83fsxthnye.fsf@gnu.org> <87lf7kmxuk.fsf@tucano.isti.cnr.it> <83bl8gfuhy.fsf@gnu.org> <87k0n4msku.fsf@tucano.isti.cnr.it> <834ke5ddnb.fsf@gnu.org> <83h7i5bpqq.fsf@gnu.org> X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 47408 Cc: pot@gnu.org, 47408@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) > Cc: pot@gnu.org, 47408@debbugs.gnu.org > From: fabrice nicol > 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). From debbugs-submit-bounces@debbugs.gnu.org Mon Jun 14 11:09:23 2021 Received: (at 47408) by debbugs.gnu.org; 14 Jun 2021 15:09:23 +0000 Received: from localhost ([127.0.0.1]:47440 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lsoDK-0003R9-ND for submit@debbugs.gnu.org; Mon, 14 Jun 2021 11:09:23 -0400 Received: from mail-wr1-f41.google.com ([209.85.221.41]:38737) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lsoDJ-0003Qw-2F for 47408@debbugs.gnu.org; Mon, 14 Jun 2021 11:09:21 -0400 Received: by mail-wr1-f41.google.com with SMTP id c9so14924198wrt.5 for <47408@debbugs.gnu.org>; Mon, 14 Jun 2021 08:09:21 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=subject:to:references:from:message-id:date:user-agent:mime-version :in-reply-to:content-language; bh=tNmMbT9ZcjLSZSPK9Cx/5EEA5GgACTn+GdcQlzTbumA=; b=iSlavpXZI5FuNuex+KRr0P9aEMZJ8+OuWNVbxPWf8xGDhGKYraH6w+ixOcRNnNZnhq 6aB27nAVOAoFRSF/wQN6YCN59nC3dgueYTGuAcrQtaOZfwAhLbIr+s2F9KIIsE9VSc4h zsipAyUguivsOAYgAKu8tZBTQf3vl5u4VKhSRtE0sByeqUlWXxamIA2FkVpXNjrvSdEq D5w3vlQ8rCi/Lvay0QFn3AV/nukM3fuX5W7wLB9AKGEBCn7yAZAFSRxZeKDfZFYDJ04N GHUY8y27OE09krTz93TvFqpfi1mZlcXjnf2djvxm8w9tttvAt0tzLpKfIpnjlNVJiKin QAyw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:subject:to:references:from:message-id:date :user-agent:mime-version:in-reply-to:content-language; bh=tNmMbT9ZcjLSZSPK9Cx/5EEA5GgACTn+GdcQlzTbumA=; b=I2jlsU7TYLlACpaQVhzqWDbsb8cRguqOZdudiAdBiCZhf82X+DDKqJvy7h9gq7069W J9VL7DjOYHIaL60CRfNTHBsPnrJOgiywnjMZL7yRi1Q8nhoXILCG39qAa7lwE5nmc2oZ ix8U5xBfrJ9rpUOIn/DNRg8Do7ZsSqZeIjlHZYKwm21KgQh8G4NoBHkh9zPeH/AyT6vl QPaWa8QLtgIHRseLNjOywQKiMkdPgJVDQM2f5KREaIqxR/Z7PuxM623FrjxCl2fc95gU ku8UcxQWfNK3oS5pAiRGXVSC/AANe3I85nR+7rYp+WVstlqhi/3GPmPb+o8a6OzDZHyf gc4A== X-Gm-Message-State: AOAM531Y5Y7wODqk5tHRfwNZDzn1FajOGsQQciwVTvto26loAIbTUMXN NPxor3KGQR3/EuKqsLtd6ok= X-Google-Smtp-Source: ABdhPJy1ql8FZU2TlkIQ3k1U8kw4D36JQvzwoiym2VEa/2cqAs6fPrl9Uy1IeDNlN4Z3eL+2PRS7Jg== X-Received: by 2002:a05:6000:1847:: with SMTP id c7mr19274798wri.368.1623683354804; Mon, 14 Jun 2021 08:09:14 -0700 (PDT) Received: from ?IPv6:2a01:cb1d:88b9:5c00:7b73:7901:965e:8523? ([2a01:cb1d:88b9:5c00:7b73:7901:965e:8523]) by smtp.gmail.com with ESMTPSA id l9sm13310093wme.21.2021.06.14.08.09.13 (version=TLS1_3 cipher=TLS_AES_128_GCM_SHA256 bits=128/128); Mon, 14 Jun 2021 08:09:13 -0700 (PDT) Subject: [PATCH] Etags support for Mercury -- fix explicit tags for existentially-quantified procedures To: 47408@debbugs.gnu.org, Eli Zaretskii , =?UTF-8?Q?Francesco_Potort=c3=ac?= References: From: fabrice nicol Message-ID: <46bb9128-8bf5-e24c-2172-1cbb4202ee1d@gmail.com> Date: Mon, 14 Jun 2021 17:10:26 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Thunderbird/78.10.2 MIME-Version: 1.0 In-Reply-To: Content-Type: multipart/mixed; boundary="------------D5E446D22BE77C2D422CDB37" Content-Language: en-US X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 47408 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) This is a multi-part message in MIME format. --------------D5E446D22BE77C2D422CDB37 Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 7bit 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 --------------D5E446D22BE77C2D422CDB37 Content-Type: text/x-patch; charset=UTF-8; name="0001-Fix-explicit-tag-issue-with-Mercury-etags-ctags-supp.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename*0="0001-Fix-explicit-tag-issue-with-Mercury-etags-ctags-supp.pa"; filename*1="tch" >From 58e85042f31716a4ae607ae4f93ce75f8065b006 Mon Sep 17 00:00:00 2001 From: Fabrice Nicol Date: Mon, 14 Jun 2021 14:30:54 +0200 Subject: [PATCH] Fix explicit tag issue with Mercury etags/ctags support Redesign of prior fix, which did not handle type quantifiers. Fix omission of single-word declarations like ':- interface.' * lib-src/etags.c (mercury_pr): Pass the newly corrected NAME and NAMELEN arguments to 'make_tag'. --- lib-src/etags.c | 114 +++++++++++++++++++++++++++++++----------------- 1 file changed, 73 insertions(+), 41 deletions(-) diff --git a/lib-src/etags.c b/lib-src/etags.c index 9f20e44caf..b96a44ec7a 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -6081,10 +6081,10 @@ prolog_atom (char *s, size_t pos) pos++; if (s[pos] != '\'') break; - pos++; /* A double quote */ + pos++; /* A double quote */ } else if (s[pos] == '\0') - /* Multiline quoted atoms are ignored. */ + /* Multiline quoted atoms are ignored. */ return 0; else if (s[pos] == '\\') { @@ -6119,6 +6119,13 @@ prolog_atom (char *s, size_t pos) static bool is_mercury_type = false; static bool is_mercury_quantifier = false; static bool is_mercury_declaration = false; +typedef struct +{ + size_t pos; /* Position reached in parsing tag name. */ + size_t namelength; /* Length of tag name */ + size_t totlength; /* Total length of parsed tag: this field is currently + reserved for control and debugging. */ +} mercury_pos_t; /* * Objective-C and Mercury have identical file extension .m. @@ -6374,10 +6381,12 @@ mercury_skip_comment (linebuffer *plb, FILE *inf) "initialise", "finalise", "mutable", "module", "interface", "implementation", "import_module", "use_module", "include_module", "end_module", "some", "all"}; -static size_t +static mercury_pos_t mercury_decl (char *s, size_t pos) { - if (s == NULL) return 0; + mercury_pos_t null_pos = {0, 0, 0}; + + if (s == NULL) return null_pos; size_t origpos; origpos = pos; @@ -6398,7 +6407,8 @@ mercury_decl (char *s, size_t pos) if (is_mercury_quantifier) { if (strcmp (buf, "pred") != 0 && strcmp (buf, "func") != 0) /* Bad syntax. */ - return 0; + return null_pos; + is_mercury_quantifier = false; /* Reset to base value. */ found_decl_tag = true; } @@ -6418,7 +6428,7 @@ mercury_decl (char *s, size_t pos) is_mercury_quantifier = true; } - break; /* Found declaration tag of rank j. */ + break; /* Found declaration tag of rank j. */ } else /* 'solver type' has a blank in the middle, @@ -6461,11 +6471,13 @@ mercury_decl (char *s, size_t pos) if (found_decl_tag) pos = skip_spaces (s + pos) - s; /* Skip len blanks again. */ else - return 0; + return null_pos; } /* From now on it is the same as for Prolog except for module dots. */ + size_t start_of_name = pos; + if (c_islower (s[pos]) || s[pos] == '_' ) { /* The name is unquoted. @@ -6478,7 +6490,8 @@ mercury_decl (char *s, size_t pos) && (c_isalnum (s[pos + 1]) || s[pos + 1] == '_'))) ++pos; - return pos - origpos; + mercury_pos_t position = {pos, pos - start_of_name + 1, pos - origpos}; + return position; } else if (s[pos] == '\'') { @@ -6493,28 +6506,37 @@ mercury_decl (char *s, size_t pos) ++pos; /* A double quote. */ } else if (s[pos] == '\0') /* Multiline quoted atoms are ignored. */ - return 0; + return null_pos; else if (s[pos] == '\\') { if (s[pos+1] == '\0') - return 0; + return null_pos; pos += 2; } else ++pos; } - return pos - origpos; + + mercury_pos_t position = {pos, pos - start_of_name + 1, pos - origpos}; + return position; } 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; + if (s + pos == NULL) return null_pos; ++pos; pos = skip_spaces (s + pos) - s; - return mercury_decl (s, pos) + pos - origpos; + mercury_pos_t position = mercury_decl (s, pos); + position.totlength += pos - origpos; + return position; + } + else if (s[pos] == '.') /* as in ':- interface.' */ + { + mercury_pos_t position = {pos, pos - origpos + 1, pos - origpos}; + return position; } else - return 0; + return null_pos; } static ptrdiff_t @@ -6523,6 +6545,7 @@ mercury_pr (char *s, char *last, ptrdiff_t lastlen) size_t len0 = 0; is_mercury_type = false; is_mercury_quantifier = false; + bool stop_at_rule = false; if (is_mercury_declaration) { @@ -6530,38 +6553,47 @@ mercury_pr (char *s, char *last, ptrdiff_t lastlen) len0 = skip_spaces (s + 2) - s; } - size_t len = mercury_decl (s, len0); - if (len == 0) return 0; - len += len0; + mercury_pos_t position = mercury_decl (s, len0); + size_t pos = position.pos; + int offset = 0; /* may be < 0 */ + if (pos == 0) return 0; + + /* Skip white space for rules in definitions before :- + and possibly multiline type definitions */ - 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) + while (c_isspace (s[pos])) { ++pos; ++offset; } + + if (( ((s[pos] == '.' && (pos += 1)) /* case 1 + This is a statement dot, + not a module dot. */ + || (s[pos] == '(' && (pos += 1)) /* case 2 */ + || ((s[pos] == ':') /* case 3 */ + && s[pos + 1] == '-' && (stop_at_rule = true))) + && (lastlen != pos || memcmp (s, last, pos) != 0) ) /* Types are often declared on several lines so keeping just the first line. */ - || is_mercury_type) + + || is_mercury_type) /* When types are implemented. */ { - char *name = skip_non_spaces (s + len0); - size_t namelen; - if (name >= s + len) - { - name = s; - namelen = len; - } - else - { - name = skip_spaces (name); - namelen = len - (name - s); - } - /* Remove trailing non-name characters. */ - while (namelen > 0 && notinname (name[namelen - 1])) - namelen--; - make_tag (name, namelen, true, s, len, lineno, linecharno); - return len; + 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); + return pos; } return 0; -- 2.31.1 --------------D5E446D22BE77C2D422CDB37-- From debbugs-submit-bounces@debbugs.gnu.org Mon Jun 14 12:04:19 2021 Received: (at 47408) by debbugs.gnu.org; 14 Jun 2021 16:04:20 +0000 Received: from localhost ([127.0.0.1]:47681 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lsp4V-0004yY-OP for submit@debbugs.gnu.org; Mon, 14 Jun 2021 12:04:19 -0400 Received: from eggs.gnu.org ([209.51.188.92]:34280) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lsp4U-0004yF-DK for 47408@debbugs.gnu.org; Mon, 14 Jun 2021 12:04:18 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:49886) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lsp4O-0006RG-BH; Mon, 14 Jun 2021 12:04:12 -0400 Received: from 84.94.185.95.cable.012.net.il ([84.94.185.95]:1074 helo=home-c4e4a596f7) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lsp4K-0006gs-Fb; Mon, 14 Jun 2021 12:04:12 -0400 Date: Mon, 14 Jun 2021 19:04:04 +0300 Message-Id: <83lf7c5t6z.fsf@gnu.org> From: Eli Zaretskii To: fabrice nicol In-Reply-To: <46bb9128-8bf5-e24c-2172-1cbb4202ee1d@gmail.com> (message from fabrice nicol on Mon, 14 Jun 2021 17:10:26 +0200) Subject: Re: [PATCH] Etags support for Mercury -- fix explicit tags for existentially-quantified procedures References: <46bb9128-8bf5-e24c-2172-1cbb4202ee1d@gmail.com> X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 47408 Cc: 47408@debbugs.gnu.org, pot@gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) > From: fabrice nicol > 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? From debbugs-submit-bounces@debbugs.gnu.org Mon Jun 14 13:09:48 2021 Received: (at 47408) by debbugs.gnu.org; 14 Jun 2021 17:09:48 +0000 Received: from localhost ([127.0.0.1]:47743 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lsq5s-0002Zh-BR for submit@debbugs.gnu.org; Mon, 14 Jun 2021 13:09:48 -0400 Received: from mail-wr1-f50.google.com ([209.85.221.50]:46064) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lsq5r-0002ZU-AA for 47408@debbugs.gnu.org; Mon, 14 Jun 2021 13:09:47 -0400 Received: by mail-wr1-f50.google.com with SMTP id z8so15332090wrp.12 for <47408@debbugs.gnu.org>; Mon, 14 Jun 2021 10:09:47 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=subject:to:cc:references:from:message-id:date:user-agent :mime-version:in-reply-to:content-transfer-encoding:content-language; bh=GNjyejysL4DeYUnJ2c61KteY9JlykMcYE9AGBjZq558=; b=F/qxl8bKyhQjt3bnRoS7rme5YUK2Ug1FExpSkoY28LbLcFpJJ14tv4Zrl42NsAqYCQ elB3s6nZUlxjjt4qrKKBB7xbIpRa2f0UBcbPsZhWZlXHdHHHlVxNKGdp04uV25MdoeAK VBs3qA6p+MSi2kMufxeT+SyCdHwP8GIUK3IQDYln101ZZIAfxQXJRMLIVnyefcdXT9Bv o8re1x40sg2qOItm2dHFjzvNdBl3akbKRiQkNqoS9X6lEkXJL0LjyJj/T1G5gsdbfNle MNIFupFSUccUR1WLREan/DEGZvH5zjGn8A9dLX09tF4OdgVfqg4Ba8TGVi7LwkeqgOg4 nb1A== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:subject:to:cc:references:from:message-id:date :user-agent:mime-version:in-reply-to:content-transfer-encoding :content-language; bh=GNjyejysL4DeYUnJ2c61KteY9JlykMcYE9AGBjZq558=; b=YeEJ0uxHtlGBSJWAadAb/86WysjkHj0zFfJr2ednB/diIX+gVrauIJxxAxlfjGMNVz ueATJNZ5hFAsJyWUlJOhsp/e+Tx+BBJid8r6ojE7ShlJhZRiNWLAb38xw2e1V8hUC5uw a/AORHR2WwMP7kM+9rtKAiUyVvw9eJRBrJg1k0MKB1VerJuY79UFbpY/qXpjUj5Q0FYp uZUFGbM/3WJSMZkdrvqYffka8ctE5GyyjrqoeA1vZeI0UANUOxZXuRkXsKvr+Peno76h OAaQlUhlgcQy4v5kbZe857s1/HmeC7x4XcFlBsKC2GRwk94bfZeQ9127YEY8Yulu4266 VC2g== X-Gm-Message-State: AOAM533eh7qLhiYkSMxIRpiYZqmSYtBIjYUcJNiwGT7RcL/BPgXbuXjW SELZbfJcSiWNHVZ0T5WLxeg= X-Google-Smtp-Source: ABdhPJyha1w8/y8cFIE/cBGFZTDwfnlwq4uu1aACav9t6Hq9GNq17Uwl7Dk5fJDEOOchIhOHkfFNWg== X-Received: by 2002:a05:6000:18ca:: with SMTP id w10mr12244282wrq.55.1623690581334; Mon, 14 Jun 2021 10:09:41 -0700 (PDT) Received: from ?IPv6:2a01:cb1d:88b9:5c00:7b73:7901:965e:8523? ([2a01:cb1d:88b9:5c00:7b73:7901:965e:8523]) by smtp.gmail.com with ESMTPSA id f14sm71568wmq.10.2021.06.14.10.09.40 (version=TLS1_3 cipher=TLS_AES_128_GCM_SHA256 bits=128/128); Mon, 14 Jun 2021 10:09:41 -0700 (PDT) Subject: Re: [PATCH] Etags support for Mercury -- fix explicit tags for existentially-quantified procedures To: Eli Zaretskii References: <46bb9128-8bf5-e24c-2172-1cbb4202ee1d@gmail.com> <83lf7c5t6z.fsf@gnu.org> From: fabrice nicol Message-ID: <46a10b9f-91d7-63c4-1513-0af4743e0940@gmail.com> Date: Mon, 14 Jun 2021 19:10:53 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Thunderbird/78.10.2 MIME-Version: 1.0 In-Reply-To: <83lf7c5t6z.fsf@gnu.org> Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 8bit Content-Language: en-US X-Spam-Score: -0.5 (/) X-Debbugs-Envelope-To: 47408 Cc: 47408@debbugs.gnu.org, pot@gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.5 (-) 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? From debbugs-submit-bounces@debbugs.gnu.org Mon Jun 14 13:42:57 2021 Received: (at 47408) by debbugs.gnu.org; 14 Jun 2021 17:42:57 +0000 Received: from localhost ([127.0.0.1]:47758 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lsqbx-0003OA-G0 for submit@debbugs.gnu.org; Mon, 14 Jun 2021 13:42:57 -0400 Received: from eggs.gnu.org ([209.51.188.92]:53160) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lsqbv-0003Nv-AR for 47408@debbugs.gnu.org; Mon, 14 Jun 2021 13:42:55 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:52786) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lsqbp-0002Nl-RM; Mon, 14 Jun 2021 13:42:49 -0400 Received: from 84.94.185.95.cable.012.net.il ([84.94.185.95]:3135 helo=home-c4e4a596f7) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lsqbn-0000uz-DN; Mon, 14 Jun 2021 13:42:49 -0400 Date: Mon, 14 Jun 2021 20:42:37 +0300 Message-Id: <83eed45omq.fsf@gnu.org> From: Eli Zaretskii To: fabrice nicol In-Reply-To: <46a10b9f-91d7-63c4-1513-0af4743e0940@gmail.com> (message from fabrice nicol on Mon, 14 Jun 2021 19:10:53 +0200) Subject: Re: [PATCH] Etags support for Mercury -- fix explicit tags for existentially-quantified procedures References: <46bb9128-8bf5-e24c-2172-1cbb4202ee1d@gmail.com> <83lf7c5t6z.fsf@gnu.org> <46a10b9f-91d7-63c4-1513-0af4743e0940@gmail.com> MIME-version: 1.0 Content-type: text/plain; charset=utf-8 Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 47408 Cc: 47408@debbugs.gnu.org, pot@gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) > Cc: 47408@debbugs.gnu.org, pot@gnu.org > From: fabrice nicol > 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. From debbugs-submit-bounces@debbugs.gnu.org Mon Jun 14 14:51:51 2021 Received: (at 47408) by debbugs.gnu.org; 14 Jun 2021 18:51:51 +0000 Received: from localhost ([127.0.0.1]:47813 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lsrgc-000536-KP for submit@debbugs.gnu.org; Mon, 14 Jun 2021 14:51:51 -0400 Received: from mail-wm1-f51.google.com ([209.85.128.51]:36462) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lsrgb-00052s-6c for 47408@debbugs.gnu.org; Mon, 14 Jun 2021 14:51:49 -0400 Received: by mail-wm1-f51.google.com with SMTP id h11-20020a05600c350bb02901b59c28e8b4so83390wmq.1 for <47408@debbugs.gnu.org>; Mon, 14 Jun 2021 11:51:49 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=subject:to:cc:references:from:message-id:date:user-agent :mime-version:in-reply-to:content-language; bh=eb3XjvjEgkKumiVk2aWQdxk9E8qLcPSDcWn1Sy+Nwcs=; b=m/a9JP+7xP2QOsIc+kYnNgpeN8pf3tJDm+fXgQdtU90o50i6ZziUGgF0tiy9uCkpkw cDXL5qmwHRxz1Tr198X6ZCcAh5M489rP9cFlS8z7Crgb2AFx/oPEuIvTXjgs+WC527vJ KJ+GgTjRMPdkkasw2rsL1w4Chya/Ri/RmHAyzYCOAlEaltZyX6pqozC3LElzNZE6/q7C uKCeL7uNyleAIcOcG8EG42JMESLDo8hgtzNlOkkECcYSC/kSsShF8RYczZQfTjHGj9TF JGrt1hFUg4DqMkR9/SVEADIdT3/I75gL+oYxXSi5aCToM3Cf67ydenRrCb5Ykg/lwBY9 ypkA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:subject:to:cc:references:from:message-id:date :user-agent:mime-version:in-reply-to:content-language; bh=eb3XjvjEgkKumiVk2aWQdxk9E8qLcPSDcWn1Sy+Nwcs=; b=dAd7pwKurioMO49C2RqDQBbZIxFC3aIV3748+0/uPryChTPFa1uP7aGw/WVQX4iu5K nQ0XAuBNmlHyy4E3BM8T9BuDWMsDeo/t/iTsTHO1Q4GH1P6ZrW6NXlPSKxhSv23e7LMe 6/lrlcrLwaW7qsKpqKD4JLf7oZs/JjmoD6xoO/fFBGXn4E9wePvTVXovLzEQbzIicJm3 1fnjzbd065iUzeZL6BukWbBXMTEJPg8OFVM44vaqcr0qtz7qj+wYsOg23zBD+nVGIbhR jAvsgFA2PPHNo2zdGhePvlC5ZZeU76a3xrEAe/SN8ms+biDHyYa8Yr04YO0hBpQ6AGxy K8wQ== X-Gm-Message-State: AOAM531OWFq6aXQd6ojFjzc6Ypo7tza3IJwWzL9ExFKQNRX+9QkXavsp nCHBF2shp8K6gsLiHavpyF5I9PHCaSE= X-Google-Smtp-Source: ABdhPJyw9tlpF7mvt4e5XEIrfQO3q2XnCVfrocwffHp8KdTY9PFjghb63e0fP6Y2ZIchIvo7pWWK3w== X-Received: by 2002:a05:600c:3b23:: with SMTP id m35mr544248wms.185.1623696703148; Mon, 14 Jun 2021 11:51:43 -0700 (PDT) Received: from ?IPv6:2a01:cb1d:88b9:5c00:7b73:7901:965e:8523? ([2a01:cb1d:88b9:5c00:7b73:7901:965e:8523]) by smtp.gmail.com with ESMTPSA id e27sm18079376wra.50.2021.06.14.11.51.41 (version=TLS1_3 cipher=TLS_AES_128_GCM_SHA256 bits=128/128); Mon, 14 Jun 2021 11:51:41 -0700 (PDT) Subject: Re: [PATCH] Etags support for Mercury -- fix explicit tags for existentially-quantified procedures To: Eli Zaretskii References: <46bb9128-8bf5-e24c-2172-1cbb4202ee1d@gmail.com> <83lf7c5t6z.fsf@gnu.org> <46a10b9f-91d7-63c4-1513-0af4743e0940@gmail.com> <83eed45omq.fsf@gnu.org> From: fabrice nicol Message-ID: Date: Mon, 14 Jun 2021 20:52:54 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Thunderbird/78.10.2 MIME-Version: 1.0 In-Reply-To: <83eed45omq.fsf@gnu.org> Content-Type: multipart/mixed; boundary="------------3B01D007E0168713689A0D30" Content-Language: en-US X-Spam-Score: -0.5 (/) X-Debbugs-Envelope-To: 47408 Cc: 47408@debbugs.gnu.org, pot@gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.5 (-) This is a multi-part message in MIME format. --------------3B01D007E0168713689A0D30 Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 8bit 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@debbugs.gnu.org, pot@gnu.org >> From: fabrice nicol >> 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. --------------3B01D007E0168713689A0D30 Content-Type: text/x-patch; charset=UTF-8; name="0001-Fix-explicit-tag-issue-with-Mercury-etags-ctags-supp-v2.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename*0="0001-Fix-explicit-tag-issue-with-Mercury-etags-ctags-supp-v2"; filename*1=".patch" >From 882ba6a0f51a95893cac798c721e3ccd4ad4e0f6 Mon Sep 17 00:00:00 2001 From: Fabrice Nicol Date: Mon, 14 Jun 2021 14:30:54 +0200 Subject: [PATCH] Fix explicit tag issue with Mercury etags/ctags support Redesign of prior fix, which did not handle type quantifiers. Fix omission of single-word declarations like ':- interface.' * lib-src/etags.c (mercury_pr): Pass the newly corrected NAME and NAMELEN arguments to 'make_tag'. --- lib-src/etags.c | 110 ++++++++++++++++++++++++++++++------------------ 1 file changed, 69 insertions(+), 41 deletions(-) diff --git a/lib-src/etags.c b/lib-src/etags.c index 9f20e44caf..370e825111 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -6081,10 +6081,10 @@ prolog_atom (char *s, size_t pos) pos++; if (s[pos] != '\'') break; - pos++; /* A double quote */ + pos++; /* A double quote */ } else if (s[pos] == '\0') - /* Multiline quoted atoms are ignored. */ + /* Multiline quoted atoms are ignored. */ return 0; else if (s[pos] == '\\') { @@ -6119,6 +6119,13 @@ prolog_atom (char *s, size_t pos) static bool is_mercury_type = false; static bool is_mercury_quantifier = false; static bool is_mercury_declaration = false; +typedef struct +{ + size_t pos; /* Position reached in parsing tag name. */ + size_t namelength; /* Length of tag name */ + size_t totlength; /* Total length of parsed tag: this field is currently + reserved for control and debugging. */ +} mercury_pos_t; /* * Objective-C and Mercury have identical file extension .m. @@ -6374,10 +6381,12 @@ mercury_skip_comment (linebuffer *plb, FILE *inf) "initialise", "finalise", "mutable", "module", "interface", "implementation", "import_module", "use_module", "include_module", "end_module", "some", "all"}; -static size_t +static mercury_pos_t mercury_decl (char *s, size_t pos) { - if (s == NULL) return 0; + mercury_pos_t null_pos = {0, 0, 0}; + + if (s == NULL) return null_pos; size_t origpos; origpos = pos; @@ -6398,7 +6407,8 @@ mercury_decl (char *s, size_t pos) if (is_mercury_quantifier) { if (strcmp (buf, "pred") != 0 && strcmp (buf, "func") != 0) /* Bad syntax. */ - return 0; + return null_pos; + is_mercury_quantifier = false; /* Reset to base value. */ found_decl_tag = true; } @@ -6418,7 +6428,7 @@ mercury_decl (char *s, size_t pos) is_mercury_quantifier = true; } - break; /* Found declaration tag of rank j. */ + break; /* Found declaration tag of rank j. */ } else /* 'solver type' has a blank in the middle, @@ -6461,11 +6471,13 @@ mercury_decl (char *s, size_t pos) if (found_decl_tag) pos = skip_spaces (s + pos) - s; /* Skip len blanks again. */ else - return 0; + return null_pos; } /* From now on it is the same as for Prolog except for module dots. */ + size_t start_of_name = pos; + if (c_islower (s[pos]) || s[pos] == '_' ) { /* The name is unquoted. @@ -6478,7 +6490,8 @@ mercury_decl (char *s, size_t pos) && (c_isalnum (s[pos + 1]) || s[pos + 1] == '_'))) ++pos; - return pos - origpos; + mercury_pos_t position = {pos, pos - start_of_name + 1, pos - origpos}; + return position; } else if (s[pos] == '\'') { @@ -6493,28 +6506,37 @@ mercury_decl (char *s, size_t pos) ++pos; /* A double quote. */ } else if (s[pos] == '\0') /* Multiline quoted atoms are ignored. */ - return 0; + return null_pos; else if (s[pos] == '\\') { if (s[pos+1] == '\0') - return 0; + return null_pos; pos += 2; } else ++pos; } - return pos - origpos; + + mercury_pos_t position = {pos, pos - start_of_name + 1, pos - origpos}; + return position; } 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; + if (s + pos == NULL) return null_pos; ++pos; pos = skip_spaces (s + pos) - s; - return mercury_decl (s, pos) + pos - origpos; + mercury_pos_t position = mercury_decl (s, pos); + position.totlength += pos - origpos; + return position; + } + else if (s[pos] == '.') /* as in ':- interface.' */ + { + mercury_pos_t position = {pos, pos - origpos + 1, pos - origpos}; + return position; } else - return 0; + return null_pos; } static ptrdiff_t @@ -6523,6 +6545,7 @@ mercury_pr (char *s, char *last, ptrdiff_t lastlen) size_t len0 = 0; is_mercury_type = false; is_mercury_quantifier = false; + bool stop_at_rule = false; if (is_mercury_declaration) { @@ -6530,38 +6553,43 @@ mercury_pr (char *s, char *last, ptrdiff_t lastlen) len0 = skip_spaces (s + 2) - s; } - size_t len = mercury_decl (s, len0); - if (len == 0) return 0; - len += len0; + mercury_pos_t position = mercury_decl (s, len0); + size_t pos = position.pos; + int offset = 0; /* may be < 0 */ + if (pos == 0) return 0; - 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) + /* Skip white space for rules in definitions before :- + and possibly multiline type definitions */ + + while (c_isspace (s[pos])) { ++pos; ++offset; } + + if (( ((s[pos] == '.' && (pos += 1)) /* case 1 + This is a statement dot, + not a module dot. */ + || (s[pos] == '(' && (pos += 1)) /* case 2 */ + || ((s[pos] == ':') /* case 3 */ + && s[pos + 1] == '-' && (stop_at_rule = true))) + && (lastlen != pos || memcmp (s, last, pos) != 0) ) /* Types are often declared on several lines so keeping just the first line. */ - || is_mercury_type) + + || is_mercury_type) /* When types are implemented. */ { - char *name = skip_non_spaces (s + len0); - size_t namelen; - if (name >= s + len) - { - name = s; - namelen = len; - } - else - { - name = skip_spaces (name); - namelen = len - (name - s); - } - /* Remove trailing non-name characters. */ - while (namelen > 0 && notinname (name[namelen - 1])) - namelen--; - make_tag (name, namelen, true, s, len, lineno, linecharno); - return len; + 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; + + /* 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; } return 0; -- 2.31.1 --------------3B01D007E0168713689A0D30-- From debbugs-submit-bounces@debbugs.gnu.org Thu Jun 17 06:50:29 2021 Received: (at 47408) by debbugs.gnu.org; 17 Jun 2021 10:50:29 +0000 Received: from localhost ([127.0.0.1]:53871 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ltpbQ-00030N-SU for submit@debbugs.gnu.org; Thu, 17 Jun 2021 06:50:29 -0400 Received: from eggs.gnu.org ([209.51.188.92]:44900) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ltpbO-0002zB-Ge for 47408@debbugs.gnu.org; Thu, 17 Jun 2021 06:50:27 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:57958) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ltpbI-0004N6-5D; Thu, 17 Jun 2021 06:50:20 -0400 Received: from 84.94.185.95.cable.012.net.il ([84.94.185.95]:4905 helo=home-c4e4a596f7) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1ltpb4-0005Nl-SS; Thu, 17 Jun 2021 06:50:20 -0400 Date: Thu, 17 Jun 2021 13:50:09 +0300 Message-Id: <83y2b8zrxa.fsf@gnu.org> From: Eli Zaretskii To: fabrice nicol In-Reply-To: (message from fabrice nicol on Mon, 14 Jun 2021 20:52:54 +0200) Subject: Re: [PATCH] Etags support for Mercury -- fix explicit tags for existentially-quantified procedures References: <46bb9128-8bf5-e24c-2172-1cbb4202ee1d@gmail.com> <83lf7c5t6z.fsf@gnu.org> <46a10b9f-91d7-63c4-1513-0af4743e0940@gmail.com> <83eed45omq.fsf@gnu.org> X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 47408 Cc: 47408@debbugs.gnu.org, pot@gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) > Cc: 47408@debbugs.gnu.org, pot@gnu.org > From: fabrice nicol > 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? From debbugs-submit-bounces@debbugs.gnu.org Thu Jun 17 07:19:47 2021 Received: (at 47408) by debbugs.gnu.org; 17 Jun 2021 11:19:47 +0000 Received: from localhost ([127.0.0.1]:53884 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ltq3m-0003it-GV for submit@debbugs.gnu.org; Thu, 17 Jun 2021 07:19:46 -0400 Received: from mail-ej1-f43.google.com ([209.85.218.43]:41953) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ltq3k-0003ie-VH for 47408@debbugs.gnu.org; Thu, 17 Jun 2021 07:19:45 -0400 Received: by mail-ej1-f43.google.com with SMTP id ho18so9230665ejc.8 for <47408@debbugs.gnu.org>; Thu, 17 Jun 2021 04:19:44 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=mime-version:references:in-reply-to:from:date:message-id:subject:to :cc; bh=eHmwasZ8lvljyXMRgWKzzEQXTcxRTfskWLJvgnt33jk=; b=PeVXon1KXzo8QdIh7aOFgJcKlZpqlSjOfgzTduGYCvlStUkOjVyOK/n7uE7OcRbuPQ KDIHgkU7EvK7kWVyGIz274RSsnlVb4H+6JiIHkGqTw8I5I/S4OWdp5rz8a5BNtdcbksJ 8NMtcLc/8FAibGupBFU9XR3iSpSsDi++W+x4TjbPzeMyREl2WYoHUKhEthKslVTpLqPB EqrgE5mGn50D5N8Ygp79x/BlQ+8kgvbpuPlKakrFXGiyHgwdvpoLyu5dUJnUG3WR6dFP CFjito7wpM8pexfKJ4K0HtRAclyJhM7RSYMAz/txEJgCoZ9wFgu7+qKsgaTEa5GLUXlx DPrw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:mime-version:references:in-reply-to:from:date :message-id:subject:to:cc; bh=eHmwasZ8lvljyXMRgWKzzEQXTcxRTfskWLJvgnt33jk=; b=VgtOM8W5dHU21T3glLRBOeipQ8ad0jCeoztd5Q+M+em9tBuqNqJ8/KJ4VHM93hFeVP fTh/AUA/oMx1njSFObLVlAJTbsrCNi/ey1aqkCGm48vEPDtZa7gh4F1sRae+GYA/3uHB uCimExetzFDRvhX+wXftm1ivsExT4Ca69tNP6kDVyLkMwJ9dtCRThvS0caE2+Iic0SzD bgb6kResTAINFGp4PPiYS4IetFC5NQW21AUSPZp/z9TuFGCiOBzQcmPH/WvT2Lmljrte MKHbBqS0JXd7opJ7+HeJIRnqw43AmEg42a/nzLSErOJHF5eT5ukbD1UpuzqlZnimjXl0 xjKw== X-Gm-Message-State: AOAM533r1KDNdCXCpZD7tI2Fy9ssUeBdHkpySSvkPyiQoXCiHvED03l9 ZPxCqda5MEuTLSj+67bY74hdFqy9iByT2ptgZIM= X-Google-Smtp-Source: ABdhPJzZVflfIa+MDHzA7p6yDgoSWl5G1KMSfK4zfeEXepBOwtx0Vz+VAee0TTEQnExDZWwvISp7sBK6wvK0MN2B6b4= X-Received: by 2002:a17:906:430f:: with SMTP id j15mr4576449ejm.445.1623928779097; Thu, 17 Jun 2021 04:19:39 -0700 (PDT) MIME-Version: 1.0 References: <46bb9128-8bf5-e24c-2172-1cbb4202ee1d@gmail.com> <83lf7c5t6z.fsf@gnu.org> <46a10b9f-91d7-63c4-1513-0af4743e0940@gmail.com> <83eed45omq.fsf@gnu.org> <83y2b8zrxa.fsf@gnu.org> In-Reply-To: <83y2b8zrxa.fsf@gnu.org> From: Fabrice Nicol Date: Thu, 17 Jun 2021 13:19:26 +0200 Message-ID: Subject: Re: [PATCH] Etags support for Mercury -- fix explicit tags for existentially-quantified procedures To: Eli Zaretskii Content-Type: multipart/alternative; boundary="00000000000004cc4005c4f4622c" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 47408 Cc: =?UTF-8?Q?Francesco_Potort=C3=AC?= , 47408@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --00000000000004cc4005c4f4622c Content-Type: text/plain; charset="UTF-8" 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 > --00000000000004cc4005c4f4622c Content-Type: text/html; charset="UTF-8" Content-Transfer-Encoding: quoted-printable
Hi Eli,


Thanks.=C2=A0 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
=C2=A0 =C2=A0keywords, and shouldn't be in the TAGS tables.=C2=A0 Examp= les:
=C2=A0 =C2=A0"interface" (e.g., on line 146 of accumulator.m) and=
=C2=A0 =C2=A0"implementation" (e.g., on line 166).=C2=A0 I guess = this is unintended?
=C2=A0 =C2=A0If so, how to fix it?

This is intended. I commented this in the= commit message (one-word declarations).=C2=A0
I con= firm that=C2=A0
':- implementation' and '= ;:-interface' are formally declarations in Mercury as all others= are.=C2=A0
They were not included in the previous v= ersion bercause of an incomplete switch.
It is quite= useful from a practical point of view to add them to the tag base. When in= terfaces are big (they can reach a couple of thousand lines in real-world p= rogramming) 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 bo= okmark 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 de= claration and jumping to the header file and back. Some IDEs use F4 for thi= s. Think of Mercury interfaces as C headers.





2. It always produces "explicitly named" tags, which I think is =C2=A0 =C2=A0unnecessary.=C2=A0 AFAICT, this is related to the following sn= ippet from
=C2=A0 =C2=A0mercury_pr:

> +=C2=A0 =C2=A0 =C2=A0 /* Left-trim type definitions.=C2=A0 */
> +
> +=C2=A0 =C2=A0 =C2=A0 while (pos > namelength + offset
> +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 && c_isspace (s[pos - name= length - offset]))
> +=C2=A0 =C2=A0 =C2=A0--offset;
> +
> +=C2=A0 =C2=A0 =C2=A0 /* There is no need to correct namelength or cal= l notinname.=C2=A0 */
> +=C2=A0 =C2=A0 =C2=A0 s[pos - offset - 1] =3D '\0';
> +
> +=C2=A0 =C2=A0 =C2=A0 make_tag (s + pos - namelength - offset, namelen= gth, true, s, pos, lineno, linecharno);
> +=C2=A0 =C2=A0 =C2=A0 return pos;

=C2=A0 =C2=A0I don't understand why you need to overwrite s[pos - offse= t -1]
=C2=A0 =C2=A0with the null byte: the same effect could be obtained by adjus= ting
=C2=A0 =C2=A0the POS argument passed to make_tag.=C2=A0 Also, you in effect= chop off
=C2=A0 =C2=A0the last character of NAME, but don't adjust NAMELENGTH =C2=A0 =C2=A0accordingly.=C2=A0 These factors together cause make_tag to de= cide that
=C2=A0 =C2=A0an explicitly-named tag is in order, because name[namelength-1= ] is
=C2=A0 =C2=A0a null byte, which is rejected as being "not-a-name"= character.

=C2=A0 =C2=A0To fix this second issue, I propose the change below, which sh= ould
=C2=A0 =C2=A0be 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)<= br> =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0&& c_isspace (s[pos= - namelength - offset]))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 --offset;

-=C2=A0 =C2=A0 =C2=A0 /* There is no need to correct namelength or call not= inname.=C2=A0 */
-=C2=A0 =C2=A0 =C2=A0 s[pos - offset - 1] =3D '\0';
-
-=C2=A0 =C2=A0 =C2=A0 make_tag (s + pos - namelength - offset, namelength, = true, s, pos, lineno, linecharno);
+=C2=A0 =C2=A0 =C2=A0 make_tag (s + pos - namelength - offset, namelength -= 1, true,
+=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0s, pos - offset - 1= , lineno, linecharno);
=C2=A0 =C2=A0 =C2=A0 =C2=A0return pos;
=C2=A0 =C2=A0 =C2=A0}

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?=C2=A0 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
--00000000000004cc4005c4f4622c-- From debbugs-submit-bounces@debbugs.gnu.org Thu Jun 17 07:42:55 2021 Received: (at 47408) by debbugs.gnu.org; 17 Jun 2021 11:42:55 +0000 Received: from localhost ([127.0.0.1]:53889 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ltqQA-0006Rp-OC for submit@debbugs.gnu.org; Thu, 17 Jun 2021 07:42:55 -0400 Received: from eggs.gnu.org ([209.51.188.92]:54116) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ltqQ7-0006Rc-LR for 47408@debbugs.gnu.org; Thu, 17 Jun 2021 07:42:53 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:58862) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ltqQ1-00076L-Gi; Thu, 17 Jun 2021 07:42:45 -0400 Received: from 84.94.185.95.cable.012.net.il ([84.94.185.95]:4213 helo=home-c4e4a596f7) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1ltqQ1-00013Y-4c; Thu, 17 Jun 2021 07:42:45 -0400 Date: Thu, 17 Jun 2021 14:42:47 +0300 Message-Id: <83wnqszphk.fsf@gnu.org> From: Eli Zaretskii To: Fabrice Nicol In-Reply-To: (message from Fabrice Nicol on Thu, 17 Jun 2021 13:19:26 +0200) Subject: Re: [PATCH] Etags support for Mercury -- fix explicit tags for existentially-quantified procedures References: <46bb9128-8bf5-e24c-2172-1cbb4202ee1d@gmail.com> <83lf7c5t6z.fsf@gnu.org> <46a10b9f-91d7-63c4-1513-0af4743e0940@gmail.com> <83eed45omq.fsf@gnu.org> <83y2b8zrxa.fsf@gnu.org> MIME-version: 1.0 Content-type: text/plain; charset=utf-8 Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 47408 Cc: pot@gnu.org, 47408@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) > From: Fabrice Nicol > Date: Thu, 17 Jun 2021 13:19:26 +0200 > Cc: Francesco Potortì , 47408@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? From debbugs-submit-bounces@debbugs.gnu.org Thu Jun 17 14:35:47 2021 Received: (at 47408) by debbugs.gnu.org; 17 Jun 2021 18:35:47 +0000 Received: from localhost ([127.0.0.1]:55148 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ltwrj-0002bu-9z for submit@debbugs.gnu.org; Thu, 17 Jun 2021 14:35:47 -0400 Received: from mail-wm1-f46.google.com ([209.85.128.46]:54135) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ltwrf-0002bZ-NB for 47408@debbugs.gnu.org; Thu, 17 Jun 2021 14:35:46 -0400 Received: by mail-wm1-f46.google.com with SMTP id j18so3884986wms.3 for <47408@debbugs.gnu.org>; Thu, 17 Jun 2021 11:35:43 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=subject:to:cc:references:from:message-id:date:user-agent :mime-version:in-reply-to:content-language; bh=9jIDAKowMcvlI23xTg13VKwB8BkPDwUKyj/qrYm65yg=; b=NRtr3hVZkw1tHpdOsNaN6BDCj4NTdeXTOneerLiImAgnFUztqDiXcGuXHv9pYmwQ/X uYinQMVYm8xSKE9Vd7gOx90l0BT80i/k3AYCWeccab1wsNeIj2BcjXfpJluV4Tr80lK8 V5na4pkZUh7J4Cje8sN2m1jFKd+xnBxEBXnoi4Iq/8Paj9kB+21P7wFMDNjC3MnpWyQV w3/rkrU93Z4Bv+5JZHc778bkEHPD5Su6SnCKBydVBIH3RSzxS2rQ+5Q3pwn1c7f2aDXe B0rObTtDqTivVwKXIGVuJRFGqpiq2uNwvwoC1dgzo+k3bdp9+PbQxZaK71KkXHObq5Jf ilaA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:subject:to:cc:references:from:message-id:date :user-agent:mime-version:in-reply-to:content-language; bh=9jIDAKowMcvlI23xTg13VKwB8BkPDwUKyj/qrYm65yg=; b=k4/QleiADOoVOLTx8YUT/VsJdG93+mDNmfbS+ZawkjHoR9criQmwc2KhDoOTm+kGhU nHOcyx66Xu3vHSLxO2b8F8iImHu3Z9vYRlPQsFnjzyLJzXSAqgzdvhSeuuDhk8kwI149 wgCfLOAK9YIb7BxHeplpXkEIOc6CibswQiOTB0Oke1oqiT8jC/FWIJAH4cfhDf4t+oYJ TTIl106TAv568jr26nXStHaMVm5VlZIkb7e7DzzqfxnyjRIC3FXmrb6Rt6IJBwXUckIP 13QorKfNYX8t7UVzcIwEaaR8vG2sisHsGEFfYkCI7/W5yHAjTCm2LMXa9fitxDhpl95m dplA== X-Gm-Message-State: AOAM533WkhScksNdw7gQltuM05ypb51M+GNQ2gGe5IxR6bSNFntsYXBN 1NBcRFFKIc6s8PVGbVvpNPwKBmbBh9s= X-Google-Smtp-Source: ABdhPJxiiGJBjWM6mbOGALl3JBDEvkRjcDEk61O1TN7liPfrwZ9CNInmUjSV0/RadYtYirUU8glqoQ== X-Received: by 2002:a05:600c:20d:: with SMTP id 13mr6809013wmi.174.1623954937760; Thu, 17 Jun 2021 11:35:37 -0700 (PDT) Received: from ?IPv6:2a01:cb1d:88b9:5c00:7b73:7901:965e:8523? ([2a01:cb1d:88b9:5c00:7b73:7901:965e:8523]) by smtp.gmail.com with ESMTPSA id h46sm7131419wrh.44.2021.06.17.11.35.36 (version=TLS1_3 cipher=TLS_AES_128_GCM_SHA256 bits=128/128); Thu, 17 Jun 2021 11:35:37 -0700 (PDT) Subject: Re: [PATCH] Etags support for Mercury -- fix explicit tags for existentially-quantified procedures To: Eli Zaretskii References: <46bb9128-8bf5-e24c-2172-1cbb4202ee1d@gmail.com> <83lf7c5t6z.fsf@gnu.org> <46a10b9f-91d7-63c4-1513-0af4743e0940@gmail.com> <83eed45omq.fsf@gnu.org> <83y2b8zrxa.fsf@gnu.org> <83wnqszphk.fsf@gnu.org> From: fabrice nicol Message-ID: <768bbdf8-19a9-7401-65a0-9171678c006b@gmail.com> Date: Thu, 17 Jun 2021 20:36:56 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Thunderbird/78.11.0 MIME-Version: 1.0 In-Reply-To: <83wnqszphk.fsf@gnu.org> Content-Type: multipart/mixed; boundary="------------9455C4B7B967BD282768F775" Content-Language: en-US X-Spam-Score: -0.3 (/) X-Debbugs-Envelope-To: 47408 Cc: pot@gnu.org, 47408@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.3 (-) This is a multi-part message in MIME format. --------------9455C4B7B967BD282768F775 Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 7bit 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? --------------9455C4B7B967BD282768F775 Content-Type: text/x-patch; charset=UTF-8; name="0001-Fix-Mercury-support-notably-quantified-procedures.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename*0="0001-Fix-Mercury-support-notably-quantified-procedures.patch" >From b4db1894e71b7aaa0be28b604a814f58bdabeef9 Mon Sep 17 00:00:00 2001 From: Fabrice Nicol Date: Thu, 17 Jun 2021 19:59:52 +0200 Subject: [PATCH] Fix Mercury support, notably quantified procedures. Correct the previous fix (did not correctly handle quantified types). Also fix the following issues: - remove module name (+ dot) from tags, as prefixing module name is often inconsistent in code and may cause tags to be too specific. - now tag 0-arity predicates and functions (':- func foo_14.') - now tag one-word declarations (':- interface.') * lib-src/etags.c (mercury_pr): Pass the correct NAME and NAMELEN arguments to 'make_tag'. --- lib-src/etags.c | 126 +++++++++++++++++++++++++++++++----------------- 1 file changed, 83 insertions(+), 43 deletions(-) diff --git a/lib-src/etags.c b/lib-src/etags.c index 9f20e44caf..bd57ede2f3 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -6081,10 +6081,10 @@ prolog_atom (char *s, size_t pos) pos++; if (s[pos] != '\'') break; - pos++; /* A double quote */ + pos++; /* A double quote */ } else if (s[pos] == '\0') - /* Multiline quoted atoms are ignored. */ + /* Multiline quoted atoms are ignored. */ return 0; else if (s[pos] == '\\') { @@ -6119,6 +6119,13 @@ prolog_atom (char *s, size_t pos) static bool is_mercury_type = false; static bool is_mercury_quantifier = false; static bool is_mercury_declaration = false; +typedef struct +{ + size_t pos; /* Position reached in parsing tag name. */ + size_t namelength; /* Length of tag name */ + size_t totlength; /* Total length of parsed tag: this field is currently + reserved for control and debugging. */ +} mercury_pos_t; /* * Objective-C and Mercury have identical file extension .m. @@ -6374,10 +6381,12 @@ mercury_skip_comment (linebuffer *plb, FILE *inf) "initialise", "finalise", "mutable", "module", "interface", "implementation", "import_module", "use_module", "include_module", "end_module", "some", "all"}; -static size_t +static mercury_pos_t mercury_decl (char *s, size_t pos) { - if (s == NULL) return 0; + mercury_pos_t null_pos = {0, 0, 0}; + + if (s == NULL) return null_pos; size_t origpos; origpos = pos; @@ -6398,7 +6407,8 @@ mercury_decl (char *s, size_t pos) if (is_mercury_quantifier) { if (strcmp (buf, "pred") != 0 && strcmp (buf, "func") != 0) /* Bad syntax. */ - return 0; + return null_pos; + is_mercury_quantifier = false; /* Reset to base value. */ found_decl_tag = true; } @@ -6418,7 +6428,7 @@ mercury_decl (char *s, size_t pos) is_mercury_quantifier = true; } - break; /* Found declaration tag of rank j. */ + break; /* Found declaration tag of rank j. */ } else /* 'solver type' has a blank in the middle, @@ -6461,24 +6471,36 @@ mercury_decl (char *s, size_t pos) if (found_decl_tag) pos = skip_spaces (s + pos) - s; /* Skip len blanks again. */ else - return 0; + return null_pos; } /* From now on it is the same as for Prolog except for module dots. */ + size_t start_of_name = pos; + if (c_islower (s[pos]) || s[pos] == '_' ) { /* The name is unquoted. Do not confuse module dots with end-of-declaration dots. */ + int module_dot_pos = 0; while (c_isalnum (s[pos]) || s[pos] == '_' || (s[pos] == '.' /* A module dot. */ && s + pos + 1 != NULL - && (c_isalnum (s[pos + 1]) || s[pos + 1] == '_'))) + && (c_isalnum (s[pos + 1]) || s[pos + 1] == '_') + && (module_dot_pos = pos))) /* Record module dot position. + Erase module from name. */ ++pos; - return pos - origpos; + if (module_dot_pos) + { + start_of_name = module_dot_pos + 2; + ++pos; + } + + mercury_pos_t position = {pos, pos - start_of_name + 1, pos - origpos}; + return position; } else if (s[pos] == '\'') { @@ -6493,28 +6515,37 @@ mercury_decl (char *s, size_t pos) ++pos; /* A double quote. */ } else if (s[pos] == '\0') /* Multiline quoted atoms are ignored. */ - return 0; + return null_pos; else if (s[pos] == '\\') { if (s[pos+1] == '\0') - return 0; + return null_pos; pos += 2; } else ++pos; } - return pos - origpos; + + mercury_pos_t position = {pos, pos - start_of_name + 1, pos - origpos}; + return position; } 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; + if (s + pos == NULL) return null_pos; ++pos; pos = skip_spaces (s + pos) - s; - return mercury_decl (s, pos) + pos - origpos; + mercury_pos_t position = mercury_decl (s, pos); + position.totlength += pos - origpos; + return position; + } + else if (s[pos] == '.') /* as in ':- interface.' */ + { + mercury_pos_t position = {pos, pos - origpos + 1, pos - origpos}; + return position; } else - return 0; + return null_pos; } static ptrdiff_t @@ -6523,6 +6554,7 @@ mercury_pr (char *s, char *last, ptrdiff_t lastlen) size_t len0 = 0; is_mercury_type = false; is_mercury_quantifier = false; + bool stop_at_rule = false; if (is_mercury_declaration) { @@ -6530,38 +6562,46 @@ mercury_pr (char *s, char *last, ptrdiff_t lastlen) 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) + mercury_pos_t position = mercury_decl (s, len0); + size_t pos = position.pos; + int offset = 0; /* may be < 0 */ + if (pos == 0) return 0; + + /* Skip white space for: + a. rules in definitions before :- + b. 0-arity predicates with inlined modes. + c. possibly multiline type definitions */ + + while (c_isspace (s[pos])) { ++pos; ++offset; } + + if (( ((s[pos] == '.' && (pos += 1)) /* case 1 + This is a statement dot, + not a module dot. */ + || c_isalnum(s[pos]) /* 0-arity procedures */ + || (s[pos] == '(' && (pos += 1)) /* case 2: arity > 0 */ + || ((s[pos] == ':') /* case 3: rules */ + && s[pos + 1] == '-' && (stop_at_rule = true))) + && (lastlen != pos || memcmp (s, last, pos) != 0) ) /* Types are often declared on several lines so keeping just the first line. */ - || is_mercury_type) + + || is_mercury_type) /* When types are implemented. */ { - char *name = skip_non_spaces (s + len0); - size_t namelen; - if (name >= s + len) - { - name = s; - namelen = len; - } - else - { - name = skip_spaces (name); - namelen = len - (name - s); - } - /* Remove trailing non-name characters. */ - while (namelen > 0 && notinname (name[namelen - 1])) - namelen--; - make_tag (name, namelen, true, s, len, lineno, linecharno); - return len; + 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; + + /* There is no need to correct namelength or call notinname. */ + + make_tag (s + pos - namelength - offset, namelength - 1, true, + s, pos - offset - 1, lineno, linecharno); + return pos; } return 0; -- 2.32.0 --------------9455C4B7B967BD282768F775-- From debbugs-submit-bounces@debbugs.gnu.org Fri Jun 18 07:29:43 2021 Received: (at 47408) by debbugs.gnu.org; 18 Jun 2021 11:29:44 +0000 Received: from localhost ([127.0.0.1]:55934 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1luCgx-0007a3-Lm for submit@debbugs.gnu.org; Fri, 18 Jun 2021 07:29:43 -0400 Received: from eggs.gnu.org ([209.51.188.92]:46782) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1luCgw-0007Zq-CL for 47408@debbugs.gnu.org; Fri, 18 Jun 2021 07:29:42 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:36930) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1luCgq-0000M5-9I; Fri, 18 Jun 2021 07:29:36 -0400 Received: from 84.94.185.95.cable.012.net.il ([84.94.185.95]:1274 helo=home-c4e4a596f7) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1luCgp-0003sI-P7; Fri, 18 Jun 2021 07:29:36 -0400 Date: Fri, 18 Jun 2021 14:29:41 +0300 Message-Id: <83zgvnxvfe.fsf@gnu.org> From: Eli Zaretskii To: fabrice nicol In-Reply-To: <768bbdf8-19a9-7401-65a0-9171678c006b@gmail.com> (message from fabrice nicol on Thu, 17 Jun 2021 20:36:56 +0200) Subject: Re: [PATCH] Etags support for Mercury -- fix explicit tags for existentially-quantified procedures References: <46bb9128-8bf5-e24c-2172-1cbb4202ee1d@gmail.com> <83lf7c5t6z.fsf@gnu.org> <46a10b9f-91d7-63c4-1513-0af4743e0940@gmail.com> <83eed45omq.fsf@gnu.org> <83y2b8zrxa.fsf@gnu.org> <83wnqszphk.fsf@gnu.org> <768bbdf8-19a9-7401-65a0-9171678c006b@gmail.com> X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 47408 Cc: pot@gnu.org, 47408@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) > Cc: pot@gnu.org, 47408@debbugs.gnu.org > From: fabrice nicol > 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. From debbugs-submit-bounces@debbugs.gnu.org Fri Jun 18 07:54:58 2021 Received: (at 47408) by debbugs.gnu.org; 18 Jun 2021 11:54:58 +0000 Received: from localhost ([127.0.0.1]:55951 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1luD5O-00020V-61 for submit@debbugs.gnu.org; Fri, 18 Jun 2021 07:54:58 -0400 Received: from plesklin7.if2.ehiweb.it ([79.98.45.17]:59372 helo=plesklin7.if1.ehiweb.it) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1luD5M-00020M-Lj for 47408@debbugs.gnu.org; Fri, 18 Jun 2021 07:54:57 -0400 Received: from tucano.isti.cnr.it (tucano.isti.cnr.it [146.48.81.102]) by plesklin7.if1.ehiweb.it (Postfix) with ESMTPSA id 934F2107469; Fri, 18 Jun 2021 13:54:54 +0200 (CEST) Message-Id: <87czsjmlpt.fsf@tucano.isti.cnr.it> From: =?utf-8?Q?Francesco_Potort=C3=AC?= Date: Fri, 18 Jun 2021 13:54:54 +0200 To: fabrice nicol In-Reply-To: <83zgvnxvfe.fsf@gnu.org> (eliz@gnu.org) Subject: Re: [PATCH] Etags support for Mercury -- fix explicit tags for existentially-quantified procedures References: <46bb9128-8bf5-e24c-2172-1cbb4202ee1d@gmail.com> <83lf7c5t6z.fsf@gnu.org> <46a10b9f-91d7-63c4-1513-0af4743e0940@gmail.com> <83eed45omq.fsf@gnu.org> <83y2b8zrxa.fsf@gnu.org> <83wnqszphk.fsf@gnu.org> <768bbdf8-19a9-7401-65a0-9171678c006b@gmail.com> <83zgvnxvfe.fsf@gnu.org> Organization: The GNU project X-fingerprint: 4B02 6187 5C03 D6B1 2E31 7666 09DF 2DC9 BE21 6115 X-PPP-Message-ID: <20210618115454.25631.11639@plesklin7.if1.ehiweb.it> X-PPP-Vhost: potorti.it X-Spam-Score: 1.4 (+) X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: > 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 [...] Content analysis details: (1.4 points, 10.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- 0.0 RCVD_IN_MSPIKE_H4 RBL: Very Good reputation (+4) [79.98.45.17 listed in wl.mailspike.net] 0.0 SPF_HELO_NONE SPF: HELO does not publish an SPF Record 1.0 SPF_SOFTFAIL SPF: sender does not match SPF record (softfail) 0.0 RCVD_IN_MSPIKE_WL Mailspike good senders 0.4 KHOP_HELO_FCRDNS Relay HELO differs from its IP's reverse DNS X-Debbugs-Envelope-To: 47408 Cc: 47408@debbugs.gnu.org, Eli Zaretskii X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -0.0 (/) > 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 From debbugs-submit-bounces@debbugs.gnu.org Fri Jun 18 08:33:48 2021 Received: (at 47408) by debbugs.gnu.org; 18 Jun 2021 12:33:48 +0000 Received: from localhost ([127.0.0.1]:56016 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1luDgx-00036j-Pm for submit@debbugs.gnu.org; Fri, 18 Jun 2021 08:33:47 -0400 Received: from eggs.gnu.org ([209.51.188.92]:58420) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1luDgw-00036X-8y for 47408@debbugs.gnu.org; Fri, 18 Jun 2021 08:33:46 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:45770) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1luDgr-0002rz-1b; Fri, 18 Jun 2021 08:33:41 -0400 Received: from 84.94.185.95.cable.012.net.il ([84.94.185.95]:1213 helo=home-c4e4a596f7) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1luDgq-0005rS-Mh; Fri, 18 Jun 2021 08:33:41 -0400 Date: Fri, 18 Jun 2021 15:33:48 +0300 Message-Id: <83wnqrxsgj.fsf@gnu.org> From: Eli Zaretskii To: Francesco =?utf-8?Q?Potort=C3=AC?= In-Reply-To: <87czsjmlpt.fsf@tucano.isti.cnr.it> (message from Francesco =?utf-8?Q?Potort=C3=AC?= on Fri, 18 Jun 2021 13:54:54 +0200) Subject: Re: [PATCH] Etags support for Mercury -- fix explicit tags for existentially-quantified procedures References: <46bb9128-8bf5-e24c-2172-1cbb4202ee1d@gmail.com> <83lf7c5t6z.fsf@gnu.org> <46a10b9f-91d7-63c4-1513-0af4743e0940@gmail.com> <83eed45omq.fsf@gnu.org> <83y2b8zrxa.fsf@gnu.org> <83wnqszphk.fsf@gnu.org> <768bbdf8-19a9-7401-65a0-9171678c006b@gmail.com> <83zgvnxvfe.fsf@gnu.org> <87czsjmlpt.fsf@tucano.isti.cnr.it> MIME-version: 1.0 Content-type: text/plain; charset=utf-8 Content-Transfer-Encoding: 8bit X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 47408 Cc: fabrnicol@gmail.com, 47408@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) > From: Francesco Potortì > Date: Fri, 18 Jun 2021 13:54:54 +0200 > Cc: 47408@debbugs.gnu.org, > Eli Zaretskii > > > 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. From debbugs-submit-bounces@debbugs.gnu.org Fri Jun 18 09:52:12 2021 Received: (at 47408) by debbugs.gnu.org; 18 Jun 2021 13:52:12 +0000 Received: from localhost ([127.0.0.1]:56084 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1luEuq-0007Oh-7t for submit@debbugs.gnu.org; Fri, 18 Jun 2021 09:52:12 -0400 Received: from mail-wm1-f47.google.com ([209.85.128.47]:36761) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1luEup-0007OS-60 for 47408@debbugs.gnu.org; Fri, 18 Jun 2021 09:52:11 -0400 Received: by mail-wm1-f47.google.com with SMTP id h11-20020a05600c350bb02901b59c28e8b4so8791388wmq.1 for <47408@debbugs.gnu.org>; Fri, 18 Jun 2021 06:52:11 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=subject:to:cc:references:from:message-id:date:user-agent :mime-version:in-reply-to:content-transfer-encoding:content-language; bh=qTw7tMxPfrsZRe+f6YdJWQEwYa8gHfMCAKj5e/edvK8=; b=E1rYPaYfgkFtod079CMh5xehHS3wXSqe4g7DXOWfS2K61D6o+srWzW7W8wjqi/XOK9 apyVNJ/54iDpYLc7+HgmqbEyIYFbN+Q5ydJ1qNZ3Gpt4tD4OrWHFDMQVQ6/+tHk1d1g1 w+d8VhH7kPB01zqQ+Jnbtl7p6iWDwFRYmjMZqyERgcXmrPPKZq0dPzJsQp1tXj/YK80D vyRfxz34hYFDLCr7nO8q0tbn9zWT2dfiiGTSJIL9jOfQqV3DTGmSECR1GjJzBJb2BW8E auteW6uWfjSIXmC1qyFRuPnI3N+N0PIRoJcRUEwF/MkvUzNnevwU5j3hkuukBB95JEaV YrWQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:subject:to:cc:references:from:message-id:date :user-agent:mime-version:in-reply-to:content-transfer-encoding :content-language; bh=qTw7tMxPfrsZRe+f6YdJWQEwYa8gHfMCAKj5e/edvK8=; b=aIoWLZmfVRiZAPMmcByYCQUbO7sCUB67RjeZLjvMAv2W2ZlFshWOg6NKOUm1ayCsHA A9orWeFOE7L8UK4HsszA+tarwIfWtSvQCLm3WHpR1whKEi6IeOk7ESNsqP/2cqZGN9hx qgjB/IrNijMIDhwPYTrOS4uWbwa5k1eJtphcNf6fX2PQ3hcuqJEnsE9AObha3s0zdpPl BxwKiPj/n8yexF1GM6Wa0DBBlXgl9nLne4Tb1BA9ht8CCg7pPOYgjGgZ3ILiAq3LU61/ XHPxtF2/fXkUAbMTuYfjWUDZCViSKEdImn6Y+2k3dapVtS6EnvQumB4sbrpvy+GxYz9T cPBg== X-Gm-Message-State: AOAM5315CasnR1F+0b7EGU1k5K1nw57Om68mF9rW6D5CigKRhJ3ewaIH 2ofsFAIsBli7yPxvMj7Sk9OLpoW6tTbpag== X-Google-Smtp-Source: ABdhPJxmdaP+4uIVGXQv2DV62LOEXvF+K9sLQqEiYQqlMxgq2Jd2fRWiNZ/6UfxmRhk0evZORRUe7Q== X-Received: by 2002:a7b:cd9a:: with SMTP id y26mr11400842wmj.81.1624024325066; Fri, 18 Jun 2021 06:52:05 -0700 (PDT) Received: from ?IPv6:2a01:cb1d:88b9:5c00:7b73:7901:965e:8523? ([2a01:cb1d:88b9:5c00:7b73:7901:965e:8523]) by smtp.gmail.com with ESMTPSA id o11sm7684022wmq.1.2021.06.18.06.52.04 (version=TLS1_3 cipher=TLS_AES_128_GCM_SHA256 bits=128/128); Fri, 18 Jun 2021 06:52:04 -0700 (PDT) Subject: Re: [PATCH] Etags support for Mercury -- fix explicit tags for existentially-quantified procedures To: Eli Zaretskii , =?UTF-8?Q?Francesco_Potort=c3=ac?= References: <46bb9128-8bf5-e24c-2172-1cbb4202ee1d@gmail.com> <83lf7c5t6z.fsf@gnu.org> <46a10b9f-91d7-63c4-1513-0af4743e0940@gmail.com> <83eed45omq.fsf@gnu.org> <83y2b8zrxa.fsf@gnu.org> <83wnqszphk.fsf@gnu.org> <768bbdf8-19a9-7401-65a0-9171678c006b@gmail.com> <83zgvnxvfe.fsf@gnu.org> <87czsjmlpt.fsf@tucano.isti.cnr.it> <83wnqrxsgj.fsf@gnu.org> From: fabrice nicol Message-ID: <9374caf0-80e3-82bf-7294-1fdcde99c7c1@gmail.com> Date: Fri, 18 Jun 2021 15:53:26 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Thunderbird/78.11.0 MIME-Version: 1.0 In-Reply-To: <83wnqrxsgj.fsf@gnu.org> Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 7bit Content-Language: en-US X-Spam-Score: -0.2 (/) X-Debbugs-Envelope-To: 47408 Cc: 47408@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.2 (-) 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. From unknown Fri Jun 20 07:17:25 2025 Received: (at fakecontrol) by fakecontrolmessage; To: internal_control@debbugs.gnu.org From: Debbugs Internal Request Subject: Internal Control Message-Id: bug archived. Date: Sat, 17 Jul 2021 11:24:04 +0000 User-Agent: Fakemail v42.6.9 # This is a fake control message. # # The action: # bug archived. thanks # This fakemail brought to you by your local debbugs # administrator