for review: bug fixes

Simon Taylor stayl at cs.mu.OZ.AU
Tue Jun 2 09:26:31 AEST 1998


Hi Fergus,

Sorry for the delay on this. Could you please review these bug fixes.

Simon.


Estimated hours taken: 12

Bug fixes.

tests/term/arit_exp.m still fails with --intermodule-optimization
due to a slightly different (but correct) trans_opt file being produced.

compiler/simplify.m
	Don't produce singleton disjunctions, since the code generator
	barfs on them. Use a `some' instead.
	Test case: tests/general/partition.m compiled with --deforestation.
	Remove a commented-out incorrect optimization of disjunctions.

compiler/unused_args.m
	Deconstructions where the arguments included `any' insts were
	not being handled correctly, due to inst_matches_binding
	failing for any->any.
	Test case: extras/trailed_update/samples/vqueens.m at -O3.
	Don't warn about predicates from `.opt' files having unused
	arguments, because in most cases the warning will be generated
	when compiling the imported module.

compiler/higher_order.m
	Fix a bug that caused compiler/modules.m to be miscompiled at
	-O3 --intermodule-optimization, due to curried arguments for
	multiple known higher-order arguments being passed to a
	specialised version in the wrong order.
	Test case: tests/hard_coded/ho_order2.m

compiler/mercury_compile.m
	Call intermod__update_pred_import_status when compiling to
	C at the same stage of the compilation as the `.opt' file
	was written to ensure that the same information is being used.
	Test case: tests/hard_coded/rational_test.m compiled with
	--intermodule-optimization failed because of a link error.
	Make sure polymorphism has been run before doing unused argument
	checking with --errorcheck-only. Otherwise the argument indices
	read in from `.opt' files are incorrect.

compiler/intermod.m
	Use code_util__compiler_generated to test if a called predicate
	is compiler generated, rather than looking for a call_unify_context
	(function calls have a call_unify_context).
	Add a progress message for updating the import status of predicates
	exported to `.opt' files.
	Fix a bug where the unused_args pragmas read in from the current
	module's `.opt' file were given an import_status of `imported' rather
	than `opt_imported' resulting in an error message from make_hlds.m.

compiler/dead_proc_elim.m
	Ensure that predicates used by instance declarations and
	`:- pragma export's are not eliminated by the dead_pred_elim
	pass before typechecking.
	Test case: most of the typeclass tests compiled with
	--intermodule-optimization.

compiler/hlds_goal.m
	Remove obsolete comments about the modes of a higher-order
	unification being incorrect after polymorphism, since that
	was fixed months ago.

compiler/options.m
	Reenable deforestation.
	Enable --intermodule-optimization and --intermod-unused-args
	at -O5 so they get tested occasionally.

compiler/handle_options.m
	Disable deforestation if --typeinfo-liveness is set, since
	there are bugs in the folding code if extra typeinfos are
	added to a new predicate's arguments by hlds_pred__define_new_pred.
	Disable higher_order.m if --typeinfo-liveness is set, since
	higher_order.m currently does not pass all necessary typeinfos
	to specialised versions or update the typeinfo_varmap of
	specialised versions.
	Test case: tests/valid/agc_ho_pred.m

tests/hard_coded/ho_order2.m
tests/hard_coded/ho_order2.exp
	Test case for higher_order.m.




Index: compiler/dead_proc_elim.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/dead_proc_elim.m,v
retrieving revision 1.39
diff -u -t -u -r1.39 dead_proc_elim.m
--- dead_proc_elim.m	1998/05/25 21:48:47	1.39
+++ dead_proc_elim.m	1998/05/25 23:50:21
@@ -98,6 +98,8 @@
                 Needed0, Needed).
 
         % Add all exported entities to the queue and map.
+        % Note: changes here are likely to require changes to
+        % dead_pred_elim as well.
 
 :- pred dead_proc_elim__initialize(module_info, entity_queue, needed_map).
 :- mode dead_proc_elim__initialize(in, out, out) is det.
@@ -660,12 +662,27 @@
                 ).
 
 dead_pred_elim(ModuleInfo0, ModuleInfo) :-
-        module_info_predids(ModuleInfo0, PredIds),
+
         queue__init(Queue0),
+        map__init(Needed0),
+        module_info_get_pragma_exported_procs(ModuleInfo0, PragmaExports),
+        dead_proc_elim__initialize_pragma_exports(PragmaExports,
+                Queue0, _, Needed0, Needed1),
+        module_info_instances(ModuleInfo0, Instances),
+        dead_proc_elim__initialize_class_methods(Instances,
+                Queue0, _, Needed1, Needed),
+        map__keys(Needed, Entities),
+        queue__init(Queue1),
+        set__init(NeededPreds0),
+        list__foldl2(dead_pred_elim_add_entity, Entities,
+                Queue1, Queue, NeededPreds0, NeededPreds1),
+
         set__init(Preds0),
         set__init(Names0),
-        DeadInfo0 = dead_pred_info(ModuleInfo0, Queue0, 
-                Preds0, Preds0, Names0),
+        DeadInfo0 = dead_pred_info(ModuleInfo0, Queue, 
+                Preds0, NeededPreds1, Names0),
+
+        module_info_predids(ModuleInfo0, PredIds),
         list__foldl(dead_pred_elim_initialize, PredIds, 
                 DeadInfo0, DeadInfo1),
         dead_pred_elim_analyze(DeadInfo1, DeadInfo),
@@ -675,6 +692,14 @@
         set__to_sorted_list(DeadPreds, DeadPredList),
         list__foldl(module_info_remove_predicate, DeadPredList,
                 ModuleInfo1, ModuleInfo).
+
+:- pred dead_pred_elim_add_entity(entity::in, queue(pred_id)::in,
+        queue(pred_id)::out, set(pred_id)::in, set(pred_id)::out) is det.
+
+dead_pred_elim_add_entity(base_gen_info(_, _, _), Q, Q, Preds, Preds).
+dead_pred_elim_add_entity(proc(PredId, _), Q0, Q, Preds0, Preds) :-
+        queue__put(Q0, PredId, Q),
+        set__insert(Preds0, PredId, Preds).
 
 :- pred dead_pred_elim_initialize(pred_id::in, dead_pred_info::in,
                 dead_pred_info::out) is det.
Index: compiler/handle_options.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/handle_options.m,v
retrieving revision 1.52
diff -u -t -u -r1.52 handle_options.m
--- handle_options.m	1998/05/29 08:50:37	1.52
+++ handle_options.m	1998/05/31 22:51:22
@@ -189,8 +189,7 @@
 postprocess_options_2(OptionTable, GC_Method, TagsMethod, ArgsMethod,
                 PrologDialect, TermNorm, TraceLevel) -->
         % work around for NU-Prolog problems
-        ( { map__search(OptionTable, heap_space, int(HeapSpace)) }
-        ->
+        ( { map__search(OptionTable, heap_space, int(HeapSpace)) } ->
                 io__preallocate_heap_space(HeapSpace)
         ;
                 []
@@ -337,6 +336,16 @@
         % `procid' and `agc' stack layouts need `basic' stack layouts
         option_implies(procid_stack_layout, basic_stack_layout, bool(yes)),
         option_implies(agc_stack_layout, basic_stack_layout, bool(yes)),
+
+        % XXX higher_order.m does not update the typeinfo_varmap
+        % for specialised versions.
+        % This causes the compiler to abort in unused_args.m when compiling
+        % tests/valid/agc_ho_pred.m with `-O3 --intermodule-optimization'.
+        option_implies(typeinfo_liveness, optimize_higher_order, bool(no)),
+
+        % XXX deforestation does not perform folding on polymorphic
+        % predicates correctly with --typeinfo-liveness.
+        option_implies(typeinfo_liveness, deforestation, bool(no)),
 
         % --dump-hlds and --statistics require compilation by phases
         globals__io_lookup_accumulating_option(dump_hlds, DumpStages),
Index: compiler/higher_order.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/higher_order.m,v
retrieving revision 1.42
diff -u -t -u -r1.42 higher_order.m
--- higher_order.m	1998/03/03 17:34:25	1.42
+++ higher_order.m	1998/05/06 03:52:19
@@ -585,7 +585,8 @@
         ;       
                 pred_info_arg_types(PredInfo, _, ArgTypes),
                 find_higher_order_args(Module, Args0, ArgTypes, PredVars, 1,
-                                [], HigherOrderArgs, Args0, Args1),
+                                [], HigherOrderArgs0, Args0, Args1),
+                list__reverse(HigherOrderArgs0, HigherOrderArgs),
                 (
                         HigherOrderArgs = [] 
                 ->
@@ -636,7 +637,7 @@
         % a known value. Also update the argument list to now include
         % curried arguments that need to be explicitly passed.
         % The order of the argument list must match that generated
-        % by construct_higher_order terms.
+        % by construct_higher_order_terms.
 :- pred find_higher_order_args(module_info::in, list(var)::in, list(type)::in,
                 pred_vars::in, int::in, list(higher_order_arg)::in,
                 list(higher_order_arg)::out,
@@ -657,16 +658,19 @@
                 type_is_higher_order(ArgType, _, _),
                 map__search(PredVars, Arg, yes(PredId, ProcId, CurriedArgs))
         ->
+                % Find any known higher-order arguments
+                % in the list of curried arguments.
                 module_info_pred_info(ModuleInfo, PredId, PredInfo),
                 pred_info_arg_types(PredInfo, _, CurriedArgTypes),
                 find_higher_order_args(ModuleInfo, CurriedArgs,
-                        CurriedArgTypes, PredVars, 1, [], HOCurriedArgs,
+                        CurriedArgTypes, PredVars, 1, [], HOCurriedArgs0,
                         CurriedArgs, NewExtraArgs0),
+                list__reverse(HOCurriedArgs0, HOCurriedArgs),
                 list__length(CurriedArgs, NumArgs),
                 remove_listof_higher_order_args(NewExtraArgs0, 1, HOCurriedArgs,
                                                                 NewExtraArgs),
                 HOArgs1 = [higher_order_arg(PredId, ProcId, ArgNo,
-                                         NumArgs, HOCurriedArgs) | HOArgs0],
+                                NumArgs, HOCurriedArgs) | HOArgs0],
                 list__append(NewArgs0, NewExtraArgs, NewArgs1)
         ;
                 HOArgs1 = HOArgs0,
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_goal.m,v
retrieving revision 1.51
diff -u -t -u -r1.51 hlds_goal.m
--- hlds_goal.m	1998/04/27 04:01:04	1.51
+++ hlds_goal.m	1998/05/26 00:09:51
@@ -94,10 +94,6 @@
                         unify_rhs,      % whatever is on the right hand side
                                         % of the unification
                         unify_mode,     % the mode of the unification
-                                        % (this field might not make a lot
-                                        % of sense for higher-order
-                                        % unifications, because polymorphism.m
-                                        % does not update it properly)
                         unification,    % this field says what category of
                                         % unification it is, and contains
                                         % information specific to each category
@@ -263,10 +259,6 @@
                                         % expression, this is the list of
                                         % modes of the non-local variables
                                         % of the lambda expression.
-                                        % (this field might not make a lot
-                                        % of sense for higher-order
-                                        % unifications, because polymorphism.m
-                                        % does not update it properly)
                 )
 
                 % A deconstruction unification is a unification with a functor
Index: compiler/intermod.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/intermod.m,v
retrieving revision 1.53
diff -u -t -u -r1.53 intermod.m
--- intermod.m	1998/05/29 08:50:39	1.53
+++ intermod.m	1998/05/31 22:51:23
@@ -51,8 +51,9 @@
 
         % Make sure that local preds which have been exported in the .opt
         % file get an exported(_) label.
-:- pred intermod__adjust_pred_import_status(module_info, module_info).
-:- mode intermod__adjust_pred_import_status(in, out) is det.
+:- pred intermod__adjust_pred_import_status(module_info, module_info,
+                io__state, io__state).
+:- mode intermod__adjust_pred_import_status(in, out, di, uo) is det.
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
@@ -412,16 +413,7 @@
         %
         % Ensure that the called predicate will be exported.
         %
-        (
-                % We don't need to export complicated unification
-                % pred declarations, since they will be recreated when 
-                % mode analysis is run on the importing module.
-                { MaybeUnifyContext = no }
-        ->
-                intermod_info_add_proc(PredId, DoWrite)
-        ;
-                { DoWrite = yes }
-        ).
+        intermod_info_add_proc(PredId, DoWrite).
 
 intermod__traverse_goal(higher_order_call(A,B,C,D,E,F) - Info,
                         higher_order_call(A,B,C,D,E,F) - Info, yes) --> [].
@@ -496,10 +488,18 @@
         { pred_info_import_status(PredInfo, Status) },
         { pred_info_procids(PredInfo, ProcIds) },
         { pred_info_get_markers(PredInfo, Markers) },
-        ( { check_marker(Markers, infer_modes) } ->
+        (
+                { check_marker(Markers, infer_modes) }
+        ->
                 % Don't write this pred if it calls preds without mode decls.
                 { DoWrite = no }
-        ; 
+        ;
+                % Don't output declarations for compiler generated procedures,
+                % since they will be recreated in the calling module.
+                { code_util__compiler_generated(PredInfo) }
+        ->
+                { DoWrite = yes }
+        ;
                 {
                 pred_info_procedures(PredInfo, Procs),
                 list__member(ProcId, ProcIds),
@@ -1200,7 +1200,12 @@
         % Make sure the labels of local preds needed by predicates in 
         % the .opt file are exported, and inhibit dead proc elimination
         % on those preds.
-intermod__adjust_pred_import_status(Module0, Module) :-
+intermod__adjust_pred_import_status(Module0, Module, IO0, IO) :-
+        globals__io_lookup_bool_option(very_verbose, VVerbose, IO0, IO1),
+        maybe_write_string(VVerbose, 
+                "Adjusting import status of predicates in the `.opt' file...",
+                IO1, IO2),
+
         init_intermod_info(Module0, Info0),
         module_info_predids(Module0, PredIds),
         module_info_globals(Module0, Globals),
@@ -1210,7 +1215,8 @@
         intermod__gather_preds(PredIds, yes, Threshold,
                 Deforestation, Info0, Info1),
         intermod__gather_abstract_exported_types(Info1, Info),
-        do_adjust_pred_import_status(Info, Module0, Module).
+        do_adjust_pred_import_status(Info, Module0, Module),
+        maybe_write_string(VVerbose, "done\n", IO2, IO).
 
 :- pred do_adjust_pred_import_status(intermod_info::in,
                 module_info::in, module_info::out) is det.
@@ -1300,24 +1306,6 @@
         { module_imports_set_items(Module0, Items1, Module1) },
 
                 %
-                % Figure out which .int files are needed by the .opt files
-                %
-        { get_dependencies(OptItems, NewImportDeps0, NewUseDeps0) },
-        { list__append(NewImportDeps0, NewUseDeps0, NewDeps0) },
-        { set__list_to_set(NewDeps0, NewDepsSet0) },
-        { set__delete_list(NewDepsSet0, [ModuleName | OptFiles], NewDepsSet) },
-        { set__to_sorted_list(NewDepsSet, NewDeps) },
-
-                %
-                % Read in the .int, and .int2 files needed by the .opt files.
-                % (XXX do we also need to read in .int0 files here?)
-                %
-        process_module_long_interfaces(NewDeps, ".int", [], NewIndirectDeps,
-                                Module1, Module2),
-        process_module_indirect_imports(NewIndirectDeps, ".int2",
-                                Module2, Module3),
-
-                %
                 % Get the :- pragma unused_args(...) declarations created
                 % when writing the .opt file for the current module. These
                 % are needed because we can probably remove more arguments
@@ -1334,13 +1322,31 @@
                                 )) },
                 { list__filter(IsPragmaUnusedArgs, LocalItems, PragmaItems) },
 
-                { module_imports_get_items(Module3, Items3) },
-                { list__append(Items3, PragmaItems, Items) },
-                { module_imports_set_items(Module3, Items, Module) }
+                { module_imports_get_items(Module1, Items2) },
+                { list__append(Items2, PragmaItems, Items) },
+                { module_imports_set_items(Module1, Items, Module2) }
         ;
-                { Module = Module3 },
+                { Module2 = Module1 },
                 { UAError = no }
         ),
+
+                %
+                % Figure out which .int files are needed by the .opt files
+                %
+        { get_dependencies(OptItems, NewImportDeps0, NewUseDeps0) },
+        { list__append(NewImportDeps0, NewUseDeps0, NewDeps0) },
+        { set__list_to_set(NewDeps0, NewDepsSet0) },
+        { set__delete_list(NewDepsSet0, [ModuleName | OptFiles], NewDepsSet) },
+        { set__to_sorted_list(NewDepsSet, NewDeps) },
+
+                %
+                % Read in the .int, and .int2 files needed by the .opt files.
+                % (XXX do we also need to read in .int0 files here?)
+                %
+        process_module_long_interfaces(NewDeps, ".int", [], NewIndirectDeps,
+                                Module2, Module3),
+        process_module_indirect_imports(NewIndirectDeps, ".int2",
+                                Module3, Module),
 
                 %
                 % Figure out whether anything went wrong
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_compile.m,v
retrieving revision 1.93
diff -u -t -u -r1.93 mercury_compile.m
--- mercury_compile.m	1998/05/29 08:50:41	1.93
+++ mercury_compile.m	1998/06/01 04:15:18
@@ -321,8 +321,16 @@
             ; { ErrorCheckOnly = yes } ->
                 % we may still want to run `unused_args' so that we get
                 % the appropriate warnings
-                globals__io_set_option(optimize_unused_args, bool(no)),
-                mercury_compile__maybe_unused_args(HLDS21, Verbose, Stats, _)
+                globals__io_lookup_bool_option(warn_unused_args, UnusedArgs),
+                ( { UnusedArgs = yes } ->
+                        mercury_compile__maybe_polymorphism(HLDS21,
+                                Verbose, Stats, HLDS22), 
+                        globals__io_set_option(optimize_unused_args, bool(no)),
+                        mercury_compile__maybe_unused_args(HLDS22,
+                                Verbose, Stats, _)
+                ;
+                        []
+                )
             ; { MakeOptInt = yes } ->
                 % only run up to typechecking when making the .opt file
                 []
@@ -407,17 +415,7 @@
         ( { FoundError = yes ; IntermodError = yes } ->
                 { module_info_incr_errors(HLDS0, HLDS1) }
         ;       
-                globals__io_lookup_bool_option(intermodule_optimization,
-                        Intermod),
-                globals__io_lookup_bool_option(make_optimization_interface,
-                        MakeOptInt),
-                ( { Intermod = yes, MakeOptInt = no } ->
-                        % Eliminate unnecessary clauses from `.opt' files,
-                        % to speed up compilation.
-                        { dead_pred_elim(HLDS0, HLDS1) }
-                ;
-                        { HLDS1 = HLDS0 }
-                )
+                { HLDS1 = HLDS0 }
         ).
 
 :- pred mercury_compile__module_qualify_items(item_list, item_list,
@@ -574,12 +572,25 @@
                 "% Checking typeclass instances...\n"),
             check_typeclass__check_instance_decls(HLDS1, HLDS2,
                 FoundTypeclassError),
-            mercury_compile__maybe_dump_hlds(HLDS2, "2", "typeclass"), !,
+            mercury_compile__maybe_dump_hlds(HLDS2, "02", "typeclass"), !,
+
+            globals__io_lookup_bool_option(intermodule_optimization, Intermod),
+            globals__io_lookup_bool_option(make_optimization_interface,
+                MakeOptInt),
+            ( { Intermod = yes, MakeOptInt = no } ->
+                % Eliminate unnecessary clauses from `.opt' files,
+                % to speed up compilation. This must be done after
+                % typeclass instances have been checked, since that
+                % fills in which pred_ids are needed by instance decls.
+                { dead_pred_elim(HLDS2, HLDS2a) }
+            ;
+                { HLDS2a = HLDS2 }
+            ),
 
             %
             % Next typecheck the clauses.
             %
-            typecheck(HLDS2, HLDS3, FoundUndefModeError, FoundTypeError), !,
+            typecheck(HLDS2a, HLDS3, FoundUndefModeError, FoundTypeError), !,
             ( { FoundTypeError = yes } ->
                 maybe_write_string(Verbose,
                         "% Program contains type error(s).\n"),
@@ -599,30 +610,30 @@
                 { bool__or(FoundTypeError, FoundTypeclassError, FoundError) }
             ;
                 % only write out the `.opt' file if there are no type errors
-                globals__io_lookup_bool_option(make_optimization_interface,
-                        MakeOptInt),
-                ( { FoundTypeError = no } ->
+                % or undefined modes
+                ( { FoundTypeError = no, FoundUndefModeError = no } ->
                         mercury_compile__maybe_write_optfile(MakeOptInt,
                                 HLDS3, HLDS4), !
                 ;
                         { HLDS4 = HLDS3 }
                 ),
-                % if our job was to write out the `.opt' file, then we're done
-                ( { MakeOptInt = yes } ->
-                        { HLDS = HLDS4 },
-                        { bool__or(FoundTypeError, FoundTypeclassError,
-                                FoundError) }
-                ;
-                        %
-                        % We can't continue after an undefined inst/mode
-                        % error, since mode analysis would get internal errors
-                        %
-                        ( { FoundUndefModeError = yes } ->
-                            { FoundError = yes },
-                            { HLDS = HLDS4 },
-                            maybe_write_string(Verbose,
+                %
+                % We can't continue after an undefined inst/mode
+                % error, since mode analysis would get internal errors
+                %
+                ( { FoundUndefModeError = yes } ->
+                    { FoundError = yes },
+                    { HLDS = HLDS4 },
+                    maybe_write_string(Verbose,
                 "% Program contains undefined inst or undefined mode error(s).\n"),
                             io__set_exit_status(1)
+                ;
+                        % if our job was to write out the `.opt' file,
+                        % then we're done
+                        ( { MakeOptInt = yes } ->
+                                { HLDS = HLDS4 },
+                                { bool__or(FoundTypeError, FoundTypeclassError,
+                                        FoundError) }
                         ;
                             %
                             % Now go ahead and do the rest of mode checking and
@@ -643,6 +654,7 @@
                 module_info::out, io__state::di, io__state::uo) is det.
 
 mercury_compile__maybe_write_optfile(MakeOptInt, HLDS0, HLDS) -->
+        globals__io_lookup_bool_option(intermodule_optimization, Intermod),
         globals__io_lookup_bool_option(intermod_unused_args, IntermodArgs),
         globals__io_lookup_bool_option(verbose, Verbose),
         globals__io_lookup_bool_option(statistics, Stats),
@@ -685,6 +697,8 @@
                 module_name_to_file_name(ModuleName, ".opt", yes, OptName),
                 update_interface(OptName),
                 touch_interface_datestamp(ModuleName, ".optdate")
+        ; { Intermod = yes } ->
+                intermod__adjust_pred_import_status(HLDS0, HLDS)
         ;
                 { HLDS = HLDS0 }
         ).
@@ -740,7 +754,7 @@
 
         ( { UnsafeToContinue = yes } ->
                 { FoundError = yes },
-                { HLDS13 = HLDS5 }
+                { HLDS12 = HLDS5 }
         ;
                 mercury_compile__detect_switches(HLDS5, Verbose, Stats, HLDS6),
                 !,
@@ -783,24 +797,13 @@
                         % FoundModeError etc. aren't always correct.
                         { ExitStatus = 0 }
                 ->
-                        { FoundError = no },
-                        globals__io_lookup_bool_option(intermodule_optimization,
-                                                                Intermod),
-                        globals__io_lookup_bool_option(
-                                make_optimization_interface, MakeOptInt),
-                        { Intermod = yes, MakeOptInt = no ->
-                                intermod__adjust_pred_import_status(HLDS12,
-                                        HLDS13), !
-                        ;
-                                HLDS13 = HLDS12
-                        }
+                        { FoundError = no }
                 ;
-                        { FoundError = yes },
-                        { HLDS13 = HLDS12 }
+                        { FoundError = yes }
                 )
         ),
 
-        { HLDS20 = HLDS13 },
+        { HLDS20 = HLDS12 },
         mercury_compile__maybe_dump_hlds(HLDS20, "20", "front_end").
 
 :- pred mercury_compile__frontend_pass_2_by_preds(module_info, module_info,
Index: compiler/options.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/options.m,v
retrieving revision 1.230
diff -u -t -u -r1.230 options.m
--- options.m	1998/05/20 11:11:35	1.230
+++ options.m	1998/05/26 00:18:08
@@ -1111,7 +1111,7 @@
         optimize_saved_vars     -       bool(yes),
         optimize_unused_args    -       bool(yes),      
         optimize_higher_order   -       bool(yes),
-        deforestation           -       bool(no),       % buggy
+        deforestation           -       bool(yes),
         constant_propagation    -       bool(yes),
         optimize_repeat         -       int(4)
 ]).
@@ -1138,7 +1138,9 @@
         pred_value_number       -       bool(yes),
         optimize_repeat         -       int(5),
         optimize_vnrepeat       -       int(2),
-        inline_compound_threshold -     int(100)
+        inline_compound_threshold -     int(100),
+        intermodule_optimization -      bool(yes),
+        intermod_unused_args    -       bool(yes)
 ]).
 
 % Optimization level 6: apply optimizations which may have any
Index: compiler/simplify.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/simplify.m,v
retrieving revision 1.58
diff -u -t -u -r1.58 simplify.m
--- simplify.m	1998/05/15 07:07:35	1.58
+++ simplify.m	1998/05/16 02:39:59
@@ -348,20 +348,24 @@
 
 simplify__goal_2(disj(Disjuncts0, SM), GoalInfo0,
                 Goal, GoalInfo, Info0, Info) :-
-        ( Disjuncts0 = [] ->
+        simplify_info_get_instmap(Info0, InstMap0),
+        simplify__disj(Disjuncts0, [], Disjuncts, [], InstMaps,
+                        Info0, Info0, Info1),
+        ( Disjuncts = [] ->
                 Goal = disj([], SM),
                 GoalInfo = GoalInfo0,
-                Info = Info0
-        ; Disjuncts0 = [SingleGoal0] ->
+                Info = Info1
+        ; Disjuncts = [SingleGoal] ->
                 % a singleton disjunction is equivalent to the goal itself
-                simplify__goal(SingleGoal0, Goal1 - GoalInfo1, Info0, Info),
+                SingleGoal = Goal1 - GoalInfo1,
+                Info = Info1,
                 (
                         % If the determinisms are not the same, we really
                         % need to rerun determinism analysis on the
                         % procedure. I think this is a similar situation
                         % to inlining of erroneous goals. The safe thing
-                        % to do is to disable the optimisation if the
-                        % inner and outer determinisms are not the same.
+                        % to do is to wrap a `some' around the inner goal if
+                        % the inner and outer determinisms are not the same.
                         % It probably won't happen that often.
                         goal_info_get_determinism(GoalInfo0, Det),
                         goal_info_get_determinism(GoalInfo1, Det)
@@ -369,53 +373,17 @@
                         Goal = Goal1,
                         GoalInfo = GoalInfo1
                 ;
-                        Goal = disj([Goal1 - GoalInfo1], SM),
+                        Goal = some([], Goal1 - GoalInfo1),
                         GoalInfo = GoalInfo0
                 )
         ;
-                simplify_info_get_instmap(Info0, InstMap0),
-                simplify__disj(Disjuncts0, [], Disjuncts, [], InstMaps,
-                        Info0, Info0, Info1),
-                (
-        /****
-        XXX This optimization is not correct, see comment below
-            at the definition of fixup_disj
-                        goal_info_get_determinism(GoalInfo, Detism),
-                        determinism_components(Detism, _CanFail, MaxSoln),
-                        MaxSoln \= at_most_many
-                ->
-                        goal_info_get_instmap_delta(GoalInfo, DeltaInstMap),
-                        goal_info_get_nonlocals(GoalInfo, NonLocalVars),
-                        (
-                                det_no_output_vars(NonLocalVars, InstMap0,
-                                        DeltaInstMap, DetInfo)
-                        ->
-                                OutputVars = no
-                        ;
-                                OutputVars = yes
-                        ),
-                        simplify__fixup_disj(Disjuncts, Detism, OutputVars,
-                                GoalInfo, SM, InstMap0, DetInfo, Goal,
-                                MsgsA, Msgs)
-                ;
-        ****/
-                        Goal = disj(Disjuncts, SM),
-                        ( Disjuncts = [] ->
-                                GoalInfo = GoalInfo0,
-                                Info = Info1
-                        ;
-                                simplify_info_get_module_info(Info1, 
-                                        ModuleInfo1),
-                                goal_info_get_nonlocals(GoalInfo0, NonLocals),
-                                merge_instmap_deltas(InstMap0, NonLocals, 
-                                        InstMaps, NewDelta, 
-                                        ModuleInfo1, ModuleInfo2),
-                                simplify_info_set_module_info(Info1, 
-                                        ModuleInfo2, Info),
-                                goal_info_set_instmap_delta(GoalInfo0, 
-                                        NewDelta, GoalInfo)
-                        )
-                )
+                Goal = disj(Disjuncts, SM),
+                simplify_info_get_module_info(Info1, ModuleInfo1),
+                goal_info_get_nonlocals(GoalInfo0, NonLocals),
+                merge_instmap_deltas(InstMap0, NonLocals, InstMaps,
+                        NewDelta, ModuleInfo1, ModuleInfo2),
+                simplify_info_set_module_info(Info1, ModuleInfo2, Info),
+                goal_info_set_instmap_delta(GoalInfo0, NewDelta, GoalInfo)
         ).
 
 simplify__goal_2(switch(Var, SwitchCanFail0, Cases0, SM),
Index: compiler/unused_args.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/unused_args.m,v
retrieving revision 1.48
diff -u -t -u -r1.48 unused_args.m
--- unused_args.m	1998/03/18 08:07:49	1.48
+++ unused_args.m	1998/06/01 04:22:32
@@ -464,42 +464,39 @@
         set_var_used(UseInf1, Var2, UseInf).
                 
 traverse_goal(_, unify(_, _, _, assign(Var1, Var2), _), UseInf0, UseInf) :-
-        (
-                map__contains(UseInf0, Var1)
-        ->
-                add_aliases(UseInf0, Var2, [Var1], UseInf)
-        ;
+        ( local_var_is_used(UseInf0, Var1) ->
                 % if Var1 used to instantiate an output argument, Var2 used
                 set_var_used(UseInf0, Var2, UseInf)
+        ;
+                add_aliases(UseInf0, Var2, [Var1], UseInf)
         ).
 
 traverse_goal(ModuleInfo,
                 unify(Var1, _, _, deconstruct(_, _, Args, Modes, CanFail), _),
                 UseInf0, UseInf) :-
+        partition_deconstruct_args(ModuleInfo, Args,
+                Modes, InputVars, OutputVars),
+                % The deconstructed variable is used if any of the
+                % variables, that the deconstruction binds are used.
+        add_aliases(UseInf0, Var1, OutputVars, UseInf1),
+                % Treat a deconstruction that further instantiates its
+                % left arg as a partial construction.
+        add_construction_aliases(UseInf1, Var1, InputVars, UseInf2),
         (
                 CanFail = can_fail      
         ->
                 % a deconstruction that can_fail uses its left arg
-                set_var_used(UseInf0, Var1, UseInf)
+                set_var_used(UseInf2, Var1, UseInf)
         ;
-                get_instantiating_variables(ModuleInfo, Args, Modes, InputVars),
-                list__delete_elems(Args, InputVars, OutputVars),
-                        % The deconstructed variable is used if any of the
-                        % variables, that the deconstruction binds are used.
-                add_aliases(UseInf0, Var1, OutputVars, UseInf1),
-                        % Treat a deconstruction that further instantiates its
-                        % left arg as a partial construction.
-                add_construction_aliases(UseInf1, Var1, InputVars, UseInf)      
+                UseInf = UseInf2        
         ).
 
 traverse_goal(_, unify(Var1, _, _, construct(_, _, Args, _), _),
                                         UseInf0, UseInf) :-
-        (
-                map__contains(UseInf0, Var1)
-        ->
-                add_construction_aliases(UseInf0, Var1, Args, UseInf)
-        ;
+        ( local_var_is_used(UseInf0, Var1) ->
                 set_list_vars_used(UseInf0, Args, UseInf)
+        ;
+                add_construction_aliases(UseInf0, Var1, Args, UseInf)
         ).
         
         % These should be transformed into calls by polymorphism.m.
@@ -550,27 +547,41 @@
                 UseInf = UseInf0
         ).
                         
-        % Returns variables which further instantiate a deconstructed variable.
-:- pred get_instantiating_variables(module_info::in, list(var)::in,
-                                list(uni_mode)::in, list(var)::out) is det.
+        % Partition the arguments to a deconstruction into inputs
+        % and outputs.
+:- pred partition_deconstruct_args(module_info::in, list(var)::in,
+                list(uni_mode)::in, list(var)::out, list(var)::out) is det.
 
-get_instantiating_variables(ModuleInfo, ArgVars, ArgModes, InstVars) :-
+partition_deconstruct_args(ModuleInfo, ArgVars, ArgModes,
+                InputVars, OutputVars) :-
         (
                 ArgVars = [Var | Vars], ArgModes = [Mode | Modes]
         ->
-                Mode = ((Inst1 - _) -> (Inst2 - _)),
-                (
-                        inst_matches_binding(Inst1, Inst2, ModuleInfo)
-                ->
-                        InstVars = InstVars1
+                partition_deconstruct_args(ModuleInfo,
+                        Vars, Modes, InputVars1, OutputVars1),
+                Mode = ((InitialInst1 - InitialInst2) ->
+                        (FinalInst1 - FinalInst2)),
+
+                % If the inst of the argument of the LHS is changed,
+                % the argument is input.
+                ( inst_matches_binding(InitialInst1, FinalInst1, ModuleInfo) ->
+                        InputVars = InputVars1
                 ;
-                        InstVars = [Var | InstVars1]
+                        InputVars = [Var | InputVars1]
                 ),
-                get_instantiating_variables(ModuleInfo, Vars, Modes, InstVars1)
+
+                % If the inst of the argument of the RHS is changed,
+                % the argument is output.
+                ( inst_matches_binding(InitialInst2, FinalInst2, ModuleInfo) ->
+                        OutputVars = OutputVars1
+                ;
+                        OutputVars = [Var | OutputVars1]
+                )
         ;
-                ( ArgVars = [], ArgModes = [] )
+                ArgVars = [], ArgModes = []
         ->
-                InstVars = []
+                InputVars = [],
+                OutputVars = []
         ;
                 error("get_instantiating_variables - invalid call")
         ).
@@ -1431,6 +1442,7 @@
                         {
                         pred_info_name(PredInfo, Name),
                         \+ pred_info_is_imported(PredInfo),
+                        \+ pred_info_import_status(PredInfo, opt_imported),
                                 % Don't warn about builtins
                                 % that have unused arguments.
                         \+ code_util__predinfo_is_builtin(PredInfo),
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/staff/zs/imp/tests/hard_coded/Mmakefile,v
retrieving revision 1.31
diff -u -t -u -r1.31 Mmakefile
--- Mmakefile	1998/05/30 15:23:10	1.31
+++ Mmakefile	1998/05/31 22:52:11
@@ -41,6 +41,7 @@
         higher_order_type_manip \
         ho_func_reg \
         ho_order \
+        ho_order2 \
         ho_solns \
         ho_univ_to_type \
         impossible_unify \
@@ -88,6 +89,7 @@
 MCFLAGS-boyer           =       --infer-all
 MCFLAGS-func_test       =       --infer-all
 MCFLAGS-ho_order        =       --optimize-higher-order
+MCFLAGS-ho_order2       =       --optimize-higher-order
 MCFLAGS-no_fully_strict =       --no-fully-strict
 MCFLAGS-rnd             =       -O6
 


tests/hard_coded/ho_order2.m
%-----------------------------------------------------------------------------%


%-----------------------------------------------------------------------------%
% Regression test for a bug in higher_order.m
% Symptom: seg fault or incorrect behaviour at runtime
% Cause: Incorrect ordering of curried arguments to multiple known
% higher-order input arguments in the specialised version.
%-----------------------------------------------------------------------------%
:- module ho_order2.

:- interface.

:- import_module io.

:- pred main(io__state, io__state).
:- mode main(di, uo) is det.

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

:- implementation.
:- import_module int, list, map, require, std_util, string.

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

		% information used during the elimination phase.

main(State0, State) :-
	map__from_assoc_list([0 - 1], Needed),
	map__from_assoc_list([0 - 1, 1 - 2, 2 - 4], ProcTable0),
	ProcIds = [1, 2],
	Keep = no,
	fldl2(ho_order2__eliminate_proc(Keep, Needed),
		ho_order2__eliminate_proc_2(Needed, Keep),
		ProcIds, ProcTable0, _ProcTable, State0, State).

		% eliminate a procedure, if unused

:- pred ho_order2__eliminate_proc(maybe(int), map(int, int),
	int, map(int, int), map(int, int), io__state, io__state).
:- mode ho_order2__eliminate_proc(in, in, in, in, out, di, uo) is det.

ho_order2__eliminate_proc(Keep, Needed, ProcId, 
		ProcTable0, ProcTable) -->
	(
		( { map__search(Needed, ProcId, _) }
		; { Keep = yes(_) }
		)
	->
		{ ProcTable = ProcTable0 }
	;
		io__format("Deleting %i\n", [i(ProcId)]),
		{ map__delete(ProcTable0, ProcId, ProcTable) }
	).

:- pred ho_order2__eliminate_proc_2(map(int, int), maybe(int),
	int, map(int, int), map(int, int), io__state, io__state).
:- mode ho_order2__eliminate_proc_2(in, in, in, in, out, di, uo) is det.

ho_order2__eliminate_proc_2(Needed, Keep, ProcId, 
		ProcTable0, ProcTable) -->
	(
		( { map__search(Needed, ProcId, _) }
		; { Keep = yes(_) }
		)
	->
		{ ProcTable = ProcTable0 }
	;
		io__format("Deleting %i\n", [i(ProcId)]),
		{ map__delete(ProcTable0, ProcId, ProcTable) }
	).
:- pred fldl2(pred(X, Y, Y, Z, Z), pred(X, Y, Y, Z, Z), list(X), Y, Y, Z, Z).
:- mode fldl2(pred(in, in, out, di, uo) is det,
		pred(in, in, out, di, uo) is det,
		in, in, out, di, uo) is det.

fldl2(_, _, [], FirstAcc, FirstAcc, SecAcc, SecAcc).
fldl2(P1, P2, [H|T], FirstAcc0, FirstAcc, SecAcc0, SecAcc) :-
	call(P1, H, FirstAcc0, FirstAcc1, SecAcc0, SecAcc1),
	call(P2, H, FirstAcc0, FirstAcc2, SecAcc1, SecAcc2),
	( FirstAcc1 = FirstAcc2 ->
		fldl2(P1, P2, T, FirstAcc1, FirstAcc, SecAcc2, SecAcc)
	;
		error("fldl2: results don't agree")
	).

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


tests/hard_coded/ho_order2.exp
%-----------------------------------------------------------------------------%
Deleting 1
Deleting 1
Deleting 2
Deleting 2



More information about the developers mailing list