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