[m-rev.] for review: mmc --make --track-flags

Peter Wang novalazy at gmail.com
Thu Apr 9 17:23:24 AEST 2009


Branches: main

Add mmc --make --track-flags:

    --track-flags
	With `--make', keep track of the options used when compiling
	each module.  If an option for a module is added or removed,
	`mmc --make' will then know to recompile the module even if the
	timestamp on the file itself has not changed.  Warning and
	verbosity options are not tracked.

The motivation was to be able to set the execution trace level on selected
modules by editing Mercury.options, without needing to manually touch the
affected files afterwards to force recompilation.  It's probably useful for
anyone that's worried about consistent builds.

The implementation works by recording a hash of the option table which is the
product of the options set for each particular module in .track_flags files,
not a hash of the actual options passed by the user, which might be reordered
or redundant, etc.  Hashes are used as they are much quicker to compare and
take less space (the full options tables are quite big).

compiler/options.m:
	Add the new option.

	Add a predicate to return options that shouldn't be tracked
	(e.g. adding -v shouldn't cause everything to recompile).

compiler/make.m:
	When --track-flags is enabled, write `.tracks_flags' files which need
	to be changed.

compiler/make.dependencies.m:
	When --track-flags is enabled, make compiled code files depend on the
	`.tracks_flags' files.

compiler/make.program_target.m:
	Delete .tracks_flags files on realclean.

compiler/make.module_target.m:
compiler/make.util.m:
	Conform to changes above.

compiler/libs.m:
compiler/md4.m:
	Add an implementation of the MD4 digest function to libs.

doc/user_guide.texi:
NEWS:
	Document the new option.

	Recommend `mmc --make' instead of `mmake' in the user guide.

library/term_io.m:
	Avoid unnecessary memory allocation in should_atom_be_quoted.

diff --git NEWS NEWS
index 4ea8a58..27ccc75 100644
--- NEWS
+++ NEWS
@@ -282,6 +282,9 @@ Changes to the Mercury compiler:

 * We have added support for simultaneous execution of jobs with `mmc --make'.

+* We have added support for `mmc --make' to recompile modules if options have
+  changed.
+
 * We have added support for stack segments, which allows programs to grow
   stacks on demand.

@@ -505,6 +508,11 @@ Changes to the Mercury compiler:
 * Simultaneous execution of jobs with `mmc --make' can be enabled with
   the `--jobs <n>' option.

+* `mmc --make' can record what compiler options were used for each module
+  by enabling the `--track-flags' option.  Then `mmc --make' can know to
+  recompile modules whose options have changed, even if the files haven't
+  been touched.
+
 * The option `--stack-segments', or grade component `.stseg', causes
   programs to execute using stack segments, where segments can be allocated
   at runtime, instead of using fixed sized stacks.  The program won't run out
diff --git compiler/libs.m compiler/libs.m
index 265555d..2a26fff 100644
--- compiler/libs.m
+++ compiler/libs.m
@@ -22,10 +22,11 @@
 :- include_module compiler_util.

 % Generic algorithms and data structures that are not quite useful enough
-% to go in the standard library.
+% or otherwise aren't in the standard library.
 :- include_module atsort.
 :- include_module file_util.
 :- include_module graph_colour.
+:- include_module md4.
 :- include_module pickle.

 % OS interfaces not provided by the standard library.
diff --git compiler/make.dependencies.m compiler/make.dependencies.m
index 430a9ec..a8e5817 100644
--- compiler/make.dependencies.m
+++ compiler/make.dependencies.m
@@ -378,6 +378,7 @@ target_dependencies(_, module_target_short_interface) =
         interface_file_dependencies.
 target_dependencies(_, module_target_unqualified_short_interface) =
         module_target_source `of` self.
+target_dependencies(_, module_target_track_flags) = no_deps.
 target_dependencies(Globals, module_target_c_header(_)) =
         target_dependencies(Globals, module_target_c_code).
 target_dependencies(Globals, module_target_c_code) =
@@ -514,6 +515,7 @@ compiled_code_dependencies(Globals) = Deps :-
     globals.lookup_bool_option(Globals, intermodule_optimization, IntermodOpt),
     globals.lookup_bool_option(Globals, intermodule_analysis,
         IntermodAnalysis),
+    globals.lookup_bool_option(Globals, track_flags, TrackFlags),
     AnyIntermod = bool.or(IntermodOpt, IntermodAnalysis),
     (
         AnyIntermod = yes,
@@ -522,11 +524,11 @@ compiled_code_dependencies(Globals) = Deps :-
             module_target_intermodule_interface `of` intermod_imports,
             map_find_module_deps(imports,
                 map_find_module_deps(parents, intermod_imports)),
-            base_compiled_code_dependencies
+            base_compiled_code_dependencies(TrackFlags)
         ])
     ;
         AnyIntermod = no,
-        Deps0 = base_compiled_code_dependencies
+        Deps0 = base_compiled_code_dependencies(TrackFlags)
     ),
     (
         IntermodAnalysis = yes,
@@ -540,14 +542,22 @@ compiled_code_dependencies(Globals) = Deps :-
         Deps = Deps0
     ).

-:- func base_compiled_code_dependencies =
+:- func base_compiled_code_dependencies(bool::in) =
     (find_module_deps(dependency_file_index)::out(find_module_deps)) is det.

-base_compiled_code_dependencies =
-    combine_deps_list([
+base_compiled_code_dependencies(TrackFlags) = Deps :-
+    (
+        TrackFlags = yes,
+        Deps0 = module_target_track_flags `of` self
+    ;
+        TrackFlags = no,
+        Deps0 = no_deps
+    ),
+    Deps = combine_deps_list([
         module_target_source `of` self,
         fact_table_files `files_of` self,
-        map_find_module_deps(imports, self)
+        map_find_module_deps(imports, self),
+        Deps0
     ]).

 :- func imports =
@@ -1425,8 +1435,14 @@ dependency_status(dep_file(FileName, _) @ Dep,
Status, !Info, !IO) :-
     ).
 dependency_status(dep_target(Target) @ Dep, Status, !Info, !IO) :-
     Target = target_file(ModuleName, FileType),
-    ( FileType = module_target_source ->
+    (
+        ( FileType = module_target_source
+        ; FileType = module_target_track_flags
+        )
+    ->
         % Source files are always up-to-date.
+        % .track_flags should already have been made, if required,
+        % so are also up-to-date.
         ModuleTarget = module_target(module_target_source),
         maybe_warn_up_to_date_target(ModuleName - ModuleTarget, !Info, !IO),
         Status = deps_status_up_to_date
diff --git compiler/make.m compiler/make.m
index f017019..73fa2f7 100644
--- compiler/make.m
+++ compiler/make.m
@@ -63,7 +63,10 @@
 :- import_module backend_libs.compile_target_code.
 :- import_module hlds.
 :- import_module libs.
+:- import_module libs.compiler_util.
 :- import_module libs.globals.
+:- import_module libs.handle_options.
+:- import_module libs.md4.
 :- import_module libs.options.
 :- import_module libs.timestamp.
 :- import_module make.dependencies.
@@ -76,9 +79,11 @@
 :- import_module top_level.                 % XXX unwanted dependency
 :- import_module top_level.mercury_compile. % XXX unwanted dependency

+:- import_module assoc_list.
 :- import_module bool.
 :- import_module dir.
 :- import_module int.
+:- import_module getopt_io.
 :- import_module map.
 :- import_module maybe.
 :- import_module pair.
@@ -211,6 +216,7 @@
     ;       module_target_unqualified_short_interface
     ;       module_target_intermodule_interface
     ;       module_target_analysis_registry
+    ;       module_target_track_flags
     ;       module_target_c_header(c_header_type)
     ;       module_target_c_code
     ;       module_target_il_code
@@ -381,18 +387,32 @@ make_process_args(Variables, OptionArgs, Targets0, !IO) :-

 make_target(Target, Success, !Info, !IO) :-
     Target = ModuleName - TargetType,
+    globals.io_lookup_bool_option(track_flags, TrackFlags, !IO),
     (
-        TargetType = module_target(ModuleTargetType),
-        TargetFile = target_file(ModuleName, ModuleTargetType),
-        make_module_target(dep_target(TargetFile), Success,
-            !Info, !IO)
+        TrackFlags = no,
+        TrackFlagsSuccess = yes
     ;
-        TargetType = linked_target(ProgramTargetType),
-        LinkedTargetFile = linked_target_file(ModuleName, ProgramTargetType),
-        make_linked_target(LinkedTargetFile, Success, !Info, !IO)
+        TrackFlags = yes,
+        make_track_flags_files(ModuleName, TrackFlagsSuccess, !Info, !IO)
+    ),
+    (
+        TrackFlagsSuccess = yes,
+        (
+            TargetType = module_target(ModuleTargetType),
+            TargetFile = target_file(ModuleName, ModuleTargetType),
+            make_module_target(dep_target(TargetFile), Success, !Info, !IO)
+        ;
+            TargetType = linked_target(ProgramTargetType),
+            LinkedTargetFile = linked_target_file(ModuleName,
+                ProgramTargetType),
+            make_linked_target(LinkedTargetFile, Success, !Info, !IO)
+        ;
+            TargetType = misc_target(MiscTargetType),
+            make_misc_target(ModuleName - MiscTargetType, Success, !Info, !IO)
+        )
     ;
-        TargetType = misc_target(MiscTargetType),
-        make_misc_target(ModuleName - MiscTargetType, Success, !Info, !IO)
+        TrackFlagsSuccess = no,
+        Success = no
     ).

 %-----------------------------------------------------------------------------%
@@ -515,5 +535,164 @@ search_backwards_for_dot(String, Index, DotIndex) :-
     ).

 %-----------------------------------------------------------------------------%
+
+:- type last_hash
+    --->    last_hash(
+                lh_options  :: list(string),
+                lh_hash     :: string
+            ).
+
+    % Generate the .track_flags files for local modules reachable from the
+    % target module.  The files contain hashes of the options which are set for
+    % that particular module (deliberately ignoring some options), and are only
+    % updated if they have changed since the last --make run.  We use hashes as
+    % the full option tables are quite large.
+    %
+:- pred make_track_flags_files(module_name::in, bool::out,
+    make_info::in, make_info::out, io::di, io::uo) is det.
+
+make_track_flags_files(ModuleName, Success, !Info, !IO) :-
+    find_reachable_local_modules(ModuleName, Success0, Modules, !Info, !IO),
+    (
+        Success0 = yes,
+        KeepGoing = no,
+        DummyLashHash = last_hash([], ""),
+        foldl3_maybe_stop_at_error(KeepGoing, make_track_flags_files_2,
+            set.to_sorted_list(Modules), Success, DummyLashHash, _LastHash,
+            !Info, !IO)
+    ;
+        Success0 = no,
+        Success = no
+    ).
+
+:- pred make_track_flags_files_2(module_name::in, bool::out,
+    last_hash::in, last_hash::out, make_info::in, make_info::out,
+    io::di, io::uo) is det.
+
+make_track_flags_files_2(ModuleName, Success, !LastHash, !Info, !IO) :-
+    lookup_mmc_module_options(!.Info ^ options_variables, ModuleName,
+        OptionsResult, !IO),
+    (
+        OptionsResult = yes(ModuleOptionArgs),
+        OptionArgs = !.Info ^ option_args,
+        AllOptionArgs = list.condense([ModuleOptionArgs, OptionArgs]),
+
+        % The set of options from one module to the next is usually identical,
+        % so we can easily avoid running handle_options and stringifying and
+        % hashing the option table, all of which can contribute to an annoying
+        % delay when mmc --make starts.
+        ( !.LastHash = last_hash(AllOptionArgs, HashPrime) ->
+            Hash = HashPrime
+        ;
+            option_table_hash(AllOptionArgs, Hash, !IO),
+            !:LastHash = last_hash(AllOptionArgs, Hash)
+        ),
+
+        module_name_to_file_name(ModuleName, ".track_flags", do_create_dirs,
+            HashFileName, !IO),
+        compare_hash_file(HashFileName, Hash, Same, !IO),
+        ( Same = yes ->
+            Success = yes
+        ;
+            write_hash_file(HashFileName, Hash, Success, !IO)
+        )
+    ;
+        OptionsResult = no,
+        Success = no
+    ).
+
+:- pred option_table_hash(list(string)::in, string::out,
+    io::di, io::uo) is det.
+
+option_table_hash(AllOptionArgs, Hash, !IO) :-
+    globals.io_get_globals(Globals, !IO),
+    handle_options(AllOptionArgs, OptionsErrors, _, _, _, !IO),
+    (
+        OptionsErrors = []
+    ;
+        OptionsErrors = [_ | _],
+        unexpected($file, $pred ++ ": " ++
+            "handle_options returned with errors")
+    ),
+    globals.io_get_globals(UpdatedGlobals, !IO),
+    globals.get_options(UpdatedGlobals, OptionTable),
+    map.to_sorted_assoc_list(OptionTable, OptionList),
+    inconsequential_options(InconsequentialOptions),
+    list.filter(is_consequential_option(InconsequentialOptions),
+        OptionList, ConsequentialOptionList),
+    Hash = md4sum(string(ConsequentialOptionList)),
+    globals.io_set_globals(Globals, !IO).
+
+:- pred is_consequential_option(set(option)::in,
+    pair(option, option_data)::in) is semidet.
+
+is_consequential_option(InconsequentialOptions, Option - _) :-
+    not set.contains(InconsequentialOptions, Option).
+
+:- pred compare_hash_file(string::in, string::in, bool::out,
+    io::di, io::uo) is det.
+
+compare_hash_file(FileName, Hash, Same, !IO) :-
+    io.open_input(FileName, OpenResult, !IO),
+    (
+        OpenResult = ok(Stream),
+        io.read_line_as_string(Stream, ReadResult, !IO),
+        (
+            ReadResult = ok(Line),
+            ( Line = Hash ->
+                Same = yes
+            ;
+                Same = no
+            )
+        ;
+            ReadResult = eof,
+            Same = no
+        ;
+            ReadResult = error(_),
+            Same = no
+        ),
+        io.close_input(Stream, !IO)
+    ;
+        OpenResult = error(_),
+        % Probably missing file.
+        Same = no
+    ),
+    globals.io_lookup_bool_option(verbose, Verbose, !IO),
+    (
+        Verbose = yes,
+        io.write_string("% ", !IO),
+        io.write_string(FileName, !IO),
+        (
+            Same = yes,
+            io.write_string(" does not need updating.\n", !IO)
+        ;
+            Same = no,
+            io.write_string(" will be UPDATED.\n", !IO)
+        )
+    ;
+        Verbose = no
+    ).
+
+:- pred write_hash_file(string::in, string::in, bool::out, io::di, io::uo)
+    is det.
+
+write_hash_file(FileName, Hash, Success, !IO) :-
+    io.open_output(FileName, OpenResult, !IO),
+    (
+        OpenResult = ok(Stream),
+        io.write_string(Stream, Hash, !IO),
+        io.close_output(Stream, !IO),
+        Success = yes
+    ;
+        OpenResult = error(Error),
+        io.write_string("Error creating `", !IO),
+        io.write_string(FileName, !IO),
+        io.write_string("': ", !IO),
+        io.write_string(io.error_message(Error), !IO),
+        io.nl(!IO),
+        Success = no
+    ).
+
+%-----------------------------------------------------------------------------%
 :- end_module make.
 %-----------------------------------------------------------------------------%
diff --git compiler/make.module_target.m compiler/make.module_target.m
index c1c4270..f8d05f7 100644
--- compiler/make.module_target.m
+++ compiler/make.module_target.m
@@ -784,6 +784,8 @@ delete_timestamp(TouchedFile, !Timestamps) :-

 compilation_task(_, module_target_source) = _ :-
     unexpected(this_file, "compilation_task").
+compilation_task(_, module_target_track_flags) = _ :-
+    unexpected(this_file, "compilation_task").
 compilation_task(_, module_target_errors) =
     process_module(task_errorcheck) - ["--errorcheck-only"].
 compilation_task(_, module_target_unqualified_short_interface) =
@@ -1112,6 +1114,7 @@ target_type_to_pic(TargetType) = Result :-
         ; TargetType = module_target_unqualified_short_interface
         ; TargetType = module_target_intermodule_interface
         ; TargetType = module_target_analysis_registry
+        ; TargetType = module_target_track_flags
         ; TargetType = module_target_c_header(_)
         ; TargetType = module_target_c_code
         ; TargetType = module_target_il_code
diff --git compiler/make.program_target.m compiler/make.program_target.m
index 8fac5cd..57d70b6 100644
--- compiler/make.program_target.m
+++ compiler/make.program_target.m
@@ -1844,7 +1844,8 @@ make_module_realclean(ModuleName, !Info, !IO) :-
             module_target_intermodule_interface,
             module_target_analysis_registry,
             module_target_c_header(header_mh),
-            module_target_erlang_header
+            module_target_erlang_header,
+            module_target_track_flags
         ],
         !Info, !IO),
     make_remove_file(very_verbose, ModuleName, make_module_dep_file_extension,
diff --git compiler/make.util.m compiler/make.util.m
index 2f38aa6..b79f935 100644
--- compiler/make.util.m
+++ compiler/make.util.m
@@ -1218,6 +1218,7 @@ target_extension(_,
module_target_short_interface) = yes(".int2").
 target_extension(_, module_target_unqualified_short_interface) = yes(".int3").
 target_extension(_, module_target_intermodule_interface) = yes(".opt").
 target_extension(_, module_target_analysis_registry) = yes(".analysis").
+target_extension(_, module_target_track_flags) = yes(".track_flags").
 target_extension(_, module_target_c_header(header_mih)) = yes(".mih").
 target_extension(_, module_target_c_header(header_mh)) = yes(".mh").
 target_extension(_, module_target_c_code) = yes(".c").
@@ -1341,6 +1342,7 @@
module_target_to_file_name_maybe_search(ModuleName, TargetType, MkDir,
Search,
             ; TargetType = module_target_source
             ; TargetType = module_target_unqualified_short_interface
             ; TargetType = module_target_xml_doc
+            ; TargetType = module_target_track_flags
             ),
             unexpected(this_file, "module_target_to_file_name_2")
         )
@@ -1405,6 +1407,7 @@
search_for_file_type(module_target_intermodule_interface) =
         yes(intermod_directories).
 search_for_file_type(module_target_analysis_registry) =
         yes(intermod_directories).
+search_for_file_type(module_target_track_flags) = no.
 search_for_file_type(module_target_c_header(_)) = yes(c_include_directory).
 search_for_file_type(module_target_c_code) = no.
 search_for_file_type(module_target_il_code) = no.
@@ -1441,6 +1444,7 @@ is_target_grade_or_arch_dependent(Target) = IsDependent :-
     ;
         ( Target = module_target_intermodule_interface
         ; Target = module_target_analysis_registry
+        ; Target = module_target_track_flags
         ; Target = module_target_c_header(header_mih)
         ; Target = module_target_c_code
         ; Target = module_target_il_code
@@ -1704,6 +1708,9 @@ module_target_type_to_nonce(Type) = X :-
     ;
         Type = module_target_xml_doc,
         X = 23
+    ;
+        Type = module_target_track_flags,
+        X = 24
     ).

 :- func pic_to_nonce(pic) = int.
diff --git compiler/md4.m compiler/md4.m
new file mode 100644
index 0000000..4df81ff
--- /dev/null
+++ compiler/md4.m
@@ -0,0 +1,270 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2009 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% File: md4.
+% Main author: wangp.
+%
+% This module contains an implementation of the MD4 message digest algorithm.
+% The C code is adapted from:
+%
+%   a implementation of MD4 designed for use in the SMB authentication protocol
+%   Copyright (C) Andrew Tridgell 1997-1998.
+%
+%   This program is free software; you can redistribute it and/or modify
+%   it under the terms of the GNU General Public License as published by
+%   the Free Software Foundation; either version 2 of the License, or
+%   (at your option) any later version.
+%
+%   This program is distributed in the hope that it will be useful,
+%   but WITHOUT ANY WARRANTY; without even the implied warranty of
+%   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+%   GNU General Public License for more details.
+%
+%   You should have received a copy of the GNU General Public License
+%   along with this program; if not, write to the Free Software
+%   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+%
+%-----------------------------------------------------------------------------%
+
+:- module libs.md4.
+:- interface.
+
+:- import_module string.
+
+:- func md4sum(string) = string.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module libs.compiler_util.
+
+%-----------------------------------------------------------------------------%
+
+:- pragma foreign_decl("C", "local", "
+
+struct mdfour {
+    MR_uint_least32_t A, B, C, D;
+    MR_uint_least32_t totalN;
+    unsigned char tail[64];
+    unsigned tail_len;
+};
+
+static void mdfour_begin(struct mdfour *md);
+static void mdfour_update(struct mdfour *md, const unsigned char *in, int n);
+static void mdfour_tail(struct mdfour *m, const unsigned char *in, int n);
+static void mdfour_result(const struct mdfour *md, unsigned char out[12]);
+
+").
+
+:- pragma foreign_code("C", "
+
+#define MASK32          (0xffffffff)
+
+#define F(X,Y,Z)        ((((X)&(Y)) | ((~(X))&(Z))))
+#define G(X,Y,Z)        ((((X)&(Y)) | ((X)&(Z)) | ((Y)&(Z))))
+#define H(X,Y,Z)        (((X)^(Y)^(Z)))
+#define lshift(x,s)     (((((x)<<(s))&MASK32) | (((x)>>(32-(s)))&MASK32)))
+
+#define ROUND1(a,b,c,d,k,s) \
+    a = lshift((a + F(b,c,d) + M[k]) & MASK32, s)
+#define ROUND2(a,b,c,d,k,s) \
+    a = lshift((a + G(b,c,d) + M[k] + 0x5A827999) & MASK32, s)
+#define ROUND3(a,b,c,d,k,s) \
+    a = lshift((a + H(b,c,d) + M[k] + 0x6ED9EBA1) & MASK32, s)
+
+/* this applies md4 to 64 byte chunks */
+static void mdfour64(struct mdfour *m, MR_uint_least32_t *M)
+{
+    MR_uint_least32_t AA, BB, CC, DD;
+    MR_uint_least32_t A,B,C,D;
+
+    A = m->A; B = m->B; C = m->C; D = m->D;
+    AA = A; BB = B; CC = C; DD = D;
+
+    ROUND1(A,B,C,D,  0,  3);  ROUND1(D,A,B,C,  1,  7);
+    ROUND1(C,D,A,B,  2, 11);  ROUND1(B,C,D,A,  3, 19);
+    ROUND1(A,B,C,D,  4,  3);  ROUND1(D,A,B,C,  5,  7);
+    ROUND1(C,D,A,B,  6, 11);  ROUND1(B,C,D,A,  7, 19);
+    ROUND1(A,B,C,D,  8,  3);  ROUND1(D,A,B,C,  9,  7);
+    ROUND1(C,D,A,B, 10, 11);  ROUND1(B,C,D,A, 11, 19);
+    ROUND1(A,B,C,D, 12,  3);  ROUND1(D,A,B,C, 13,  7);
+    ROUND1(C,D,A,B, 14, 11);  ROUND1(B,C,D,A, 15, 19);	
+
+
+    ROUND2(A,B,C,D,  0,  3);  ROUND2(D,A,B,C,  4,  5);
+    ROUND2(C,D,A,B,  8,  9);  ROUND2(B,C,D,A, 12, 13);
+    ROUND2(A,B,C,D,  1,  3);  ROUND2(D,A,B,C,  5,  5);
+    ROUND2(C,D,A,B,  9,  9);  ROUND2(B,C,D,A, 13, 13);
+    ROUND2(A,B,C,D,  2,  3);  ROUND2(D,A,B,C,  6,  5);
+    ROUND2(C,D,A,B, 10,  9);  ROUND2(B,C,D,A, 14, 13);
+    ROUND2(A,B,C,D,  3,  3);  ROUND2(D,A,B,C,  7,  5);
+    ROUND2(C,D,A,B, 11,  9);  ROUND2(B,C,D,A, 15, 13);
+
+    ROUND3(A,B,C,D,  0,  3);  ROUND3(D,A,B,C,  8,  9);
+    ROUND3(C,D,A,B,  4, 11);  ROUND3(B,C,D,A, 12, 15);
+    ROUND3(A,B,C,D,  2,  3);  ROUND3(D,A,B,C, 10,  9);
+    ROUND3(C,D,A,B,  6, 11);  ROUND3(B,C,D,A, 14, 15);
+    ROUND3(A,B,C,D,  1,  3);  ROUND3(D,A,B,C,  9,  9);
+    ROUND3(C,D,A,B,  5, 11);  ROUND3(B,C,D,A, 13, 15);
+    ROUND3(A,B,C,D,  3,  3);  ROUND3(D,A,B,C, 11,  9);
+    ROUND3(C,D,A,B,  7, 11);  ROUND3(B,C,D,A, 15, 15);
+
+    A += AA; B += BB;
+    C += CC; D += DD;
+
+    A &= MASK32; B &= MASK32;
+    C &= MASK32; D &= MASK32;
+
+    m->A = A; m->B = B; m->C = C; m->D = D;
+}
+
+static void copy64(MR_uint_least32_t *M, const unsigned char *in)
+{
+    int i;
+
+    for (i=0; i<16; i++) {
+        M[i] = (in[i*4+3]<<24) | (in[i*4+2]<<16) |
+               (in[i*4+1]<<8) | (in[i*4+0]<<0);
+    }
+}
+
+static void copy4(unsigned char *out, MR_uint_least32_t x)
+{
+    out[0] = x & 0xFF;
+    out[1] = (x>>8) & 0xFF;
+    out[2] = (x>>16) & 0xFF;
+    out[3] = (x>>24) & 0xFF;
+}
+
+static void mdfour_begin(struct mdfour *md)
+{
+    md->A = 0x67452301;
+    md->B = 0xefcdab89;
+    md->C = 0x98badcfe;
+    md->D = 0x10325476;
+    md->totalN = 0;
+    md->tail_len = 0;
+}
+
+static void mdfour_update(struct mdfour *md, const unsigned char *in, int n)
+{
+    MR_uint_least32_t M[16];
+
+    if (in == NULL) {
+        mdfour_tail(md, md->tail, md->tail_len);
+        return;
+    }
+
+    if (md->tail_len) {
+        int len = 64 - md->tail_len;
+        if (len > n) {
+            len = n;
+        }
+        memcpy(md->tail+md->tail_len, in, len);
+        md->tail_len += len;
+        n -= len;
+        in += len;
+        if (md->tail_len == 64) {
+            copy64(M, md->tail);
+            mdfour64(md, M);
+            md->totalN += 64;
+            md->tail_len = 0;
+        }
+    }
+
+    while (n >= 64) {
+        copy64(M, in);
+        mdfour64(md, M);
+        in += 64;
+        n -= 64;
+        md->totalN += 64;
+    }
+
+    if (n) {
+        memcpy(md->tail, in, n);
+        md->tail_len = n;
+    }
+}
+
+static void mdfour_tail(struct mdfour *m, const unsigned char *in, int n)
+{
+    unsigned char buf[128];
+    MR_uint_least32_t M[16];
+    MR_uint_least32_t b;
+
+    m->totalN += n;
+
+    b = m->totalN * 8;
+
+    memset(buf, 0, 128);
+    if (n) {
+        memcpy(buf, in, n);
+    }
+    buf[n] = 0x80;
+
+    if (n <= 55) {
+        copy4(buf+56, b);
+        copy64(M, buf);
+        mdfour64(m, M);
+    } else {
+        copy4(buf+120, b);
+        copy64(M, buf);
+        mdfour64(m, M);
+        copy64(M, buf+64);
+        mdfour64(m, M);
+    }
+}
+
+static void mdfour_result(const struct mdfour *m, unsigned char *out)
+{
+    copy4(out, m->A);
+    copy4(out+4, m->B);
+    copy4(out+8, m->C);
+    copy4(out+12, m->D);
+}
+
+").
+
+:- pragma foreign_proc("C",
+    md4sum(In::in) = (Digest::out),
+    [will_not_call_mercury, promise_pure, thread_safe, may_not_duplicate],
+"
+    const char hex[16] = ""0123456789abcdef"";
+    struct mdfour md;
+    unsigned char sum[16];
+    char hexbuf[sizeof(sum) * 2 + 1];
+    char *p;
+    int i;
+
+    mdfour_begin(&md);
+    mdfour_update(&md, (const unsigned char *)In, strlen(In));
+    mdfour_update(&md, NULL, 0);
+    mdfour_result(&md, sum);
+
+    /* Convert to hexadecimal string representation. */
+    p = hexbuf;
+    for (i = 0; i < sizeof(sum); i++) {
+        *p++ = hex[(sum[i] & 0xf0) >> 4];
+        *p++ = hex[(sum[i] & 0x0f)];
+    }
+    *p = '\\0';
+
+    MR_make_aligned_string_copy(Digest, hexbuf);
+").
+
+%-----------------------------------------------------------------------------%
+
+    % Exercise for the reader.
+    %
+md4sum(_) = _ :-
+    sorry($file, $pred).
+
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=8 sts=4 sw=4 et
diff --git compiler/options.m compiler/options.m
index a13ff28..d7ea5c5 100644
--- compiler/options.m
+++ compiler/options.m
@@ -24,6 +24,7 @@
 :- import_module char.
 :- import_module getopt_io.
 :- import_module io.
+:- import_module set.

 %-----------------------------------------------------------------------------%

@@ -47,6 +48,12 @@
 :- pred special_handler(option::in, special_data::in, option_table::in,
     maybe_option_table::out) is semidet.

+    % Return the set of options which are inconsequential as far as the
+    % `--track-flags' option is concerned.  That is, adding or removing such
+    % an option to a module should not force the module to be recompiled.
+    %
+:- pred inconsequential_options(set(option)::out) is det.
+
 :- pred options_help(io::di, io::uo) is det.

 :- type option_table == option_table(option).
@@ -879,6 +886,7 @@
     ;       keep_going
     ;       rebuild
     ;       jobs
+    ;       track_flags
     ;       invoked_by_mmc_make
     ;       extra_init_command
     ;       pre_link_command
@@ -944,6 +952,7 @@
 :- import_module libs.compiler_util.
 :- import_module libs.handle_options.

+:- import_module assoc_list.
 :- import_module bool.
 :- import_module dir.
 :- import_module int.
@@ -1714,6 +1723,7 @@ option_defaults_2(build_system_option, [
     keep_going                          -   bool(no),
     rebuild                             -   bool(no),
     jobs                                -   int(1),
+    track_flags                         -   bool(no),
     invoked_by_mmc_make                 -   bool(no),
     pre_link_command                    -   maybe_string(no),
     extra_init_command                  -   maybe_string(no),
@@ -2603,6 +2613,8 @@ long_option("make",                 make).
 long_option("keep-going",           keep_going).
 long_option("rebuild",              rebuild).
 long_option("jobs",                 jobs).
+long_option("track-flags",          track_flags).
+long_option("track-options",        track_flags).
 long_option("invoked-by-mmc-make",  invoked_by_mmc_make).
 long_option("pre-link-command",     pre_link_command).
 long_option("extra-init-command",   extra_init_command).
@@ -3171,6 +3183,18 @@ quote_char_unix('$').

 %-----------------------------------------------------------------------------%

+inconsequential_options(InconsequentialOptions) :-
+    option_defaults_2(warning_option, WarningOptions),
+    option_defaults_2(verbosity_option, VerbosityOptions),
+    option_defaults_2(internal_use_option, InternalUseOptions),
+    assoc_list.keys(WarningOptions, WarningKeys),
+    assoc_list.keys(VerbosityOptions, VerbosityKeys),
+    assoc_list.keys(InternalUseOptions, InternalUseKeys),
+    Keys = WarningKeys ++ VerbosityKeys ++ InternalUseKeys,
+    InconsequentialOptions = set.from_list(Keys).
+
+%-----------------------------------------------------------------------------%
+
 options_help -->
     io.write_string("\t-?, -h, --help\n"),
     io.write_string("\t\tPrint this usage message.\n"),
@@ -5283,6 +5307,14 @@ options_help_build_system -->
         "-j <n>, --jobs <n>",
         "\tWith `--make', attempt to perform up to <n> jobs",
         "\tconcurrently for some tasks.",
+
+        "--track-flags",
+        "\tWith `--make', keep track of the options used when compiling",
+        "\teach module.  If an option for a module is added or removed,",
+        "\t`mmc --make' will then know to recompile the module even if the",
+        "\ttimestamp on the file itself has not changed.  Warning and",
+        "\tverbosity options are not tracked.",
+
         "--pre-link-command <command>",
         "\tSpecify a command to run before linking with `mmc --make'.",
         "\tThis can be used to compile C source files which rely on",
diff --git doc/user_guide.texi doc/user_guide.texi
index 0f52446..5f7d543 100644
--- doc/user_guide.texi
+++ doc/user_guide.texi
@@ -131,14 +131,14 @@ how to build and debug Mercury programs.

 This document describes the compilation environment of Mercury.
 It describes how to use @samp{mmc}, the Mercury compiler;
-how to use @samp{mmake}, the ``Mercury make'' program,
-a tool built on top of ordinary or GNU make
+a build tool integrated into the compiler called @samp{mmc --make};
+an older tool, @samp{mmake}, built on top of ordinary or GNU make
 to simplify the handling of Mercury programs;
 how to use @samp{mdb}, the Mercury debugger;
 and how to use @samp{mprof}, the Mercury profiler.

-We strongly recommend that programmers use @samp{mmake} rather
-than invoking @samp{mmc} directly, because @samp{mmake} is generally
+We strongly recommend that programmers use @samp{mmc --make} rather
+than invoking @samp{mmc} directly, because @samp{mmc --make} is generally
 easier to use and avoids unnecessary recompilation.

 @c ----------------------------------------------------------------------------
@@ -8801,25 +8801,6 @@ Same as @samp{--make}, but always rebuild the
target files
 even if they are up to date.

 @sp 1
- at item --pre-link-command @var{command}
- at findex --pre-link-command
-Specify a command to run before linking with @samp{mmc --make}.
-This can be used to compile C source files which rely on
-header files generated by the Mercury compiler.
-The command will be passed the names of all of the source files in
-the program or library, with the source file containing the main
-module given first.
-
- at sp 1
- at item --extra-init-command @var{command}
- at findex --extra-init-command
-Specify a command to produce extra entries in the @file{.init}
-file for a library.
-The command will be passed the names of all of the source files in
-the program or library, with the source file containing the main
-module given first.
-
- at sp 1
 @item -k
 @itemx --keep-going
 @findex -k
@@ -8841,6 +8822,34 @@ the @samp{-P} option in the
@samp{MERCURY_OPTIONS} environment variable
 (see @ref{Environment}).

 @sp 1
+ at item --track-flags
+ at findex -track-flags
+With @samp{--make}, keep track of the options used when compiling
+each module.  If an option for a module is added or removed,
+ at samp{mmc --make} will then know to recompile the module even if the
+timestamp on the file itself has not changed.  Warning and
+verbosity options are not tracked.
+
+ at sp 1
+ at item --pre-link-command @var{command}
+ at findex --pre-link-command
+Specify a command to run before linking with @samp{mmc --make}.
+This can be used to compile C source files which rely on
+header files generated by the Mercury compiler.
+The command will be passed the names of all of the source files in
+the program or library, with the source file containing the main
+module given first.
+
+ at sp 1
+ at item --extra-init-command @var{command}
+ at findex --extra-init-command
+Specify a command to produce extra entries in the @file{.init}
+file for a library.
+The command will be passed the names of all of the source files in
+the program or library, with the source file containing the main
+module given first.
+
+ at sp 1
 @item --install-prefix @var{dir}
 @findex --install-prefix
 Specify the directory under which to install Mercury libraries.
diff --git library/term_io.m library/term_io.m
index 4ee50dd..13a4208 100644
--- library/term_io.m
+++ library/term_io.m
@@ -621,9 +621,9 @@ should_atom_be_quoted(S, NextToGraphicToken) =
ShouldQuote :-
         % I didn't make these rules up: see ISO Prolog 6.3.1.3 and 6.4.2. -fjh
         (
             % Letter digit token (6.4.2)
-            string.first_char(S, FirstChar, Rest),
+            string.index(S, 0, FirstChar),
             char.is_lower(FirstChar),
-            string.is_all_alnum_or_underscore(Rest)
+            string.is_all_alnum_or_underscore(S)
         ;
             % Semicolon token (6.4.2)
             S = ";"
@@ -632,17 +632,12 @@ should_atom_be_quoted(S, NextToGraphicToken) =
ShouldQuote :-
             S = "!"
         ;
             % Graphic token (6.4.2)
-            string.to_char_list(S, Chars),
-            (
-                list.member(Char, Chars)
-            =>
-                lexer.graphic_token_char(Char)
-            ),
-            Chars = [_ | _],
+            string.all_match(lexer.graphic_token_char, S),
+            string.length(S) > 0,

             % We need to quote tokens starting with '#', because Mercury uses
             % '#' to start source line number indicators.
-            Chars \= ['#' | _],
+            not string.index(S, 0, '#'),

             % If the token could be the last token in a term, and the term
             % could be followed with ".\n", then we need to quote the token,
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------



More information about the reviews mailing list