mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-25 22:34:26 +00:00
Code Issues Projects Releases Wiki Activity
Files
de8f79cac3272dbabddd2e072b94de54612276bc
mercury/compiler/dupelim.m
Julien Fischer bad6ce0733 Update and fix more copyright notices. 
compiler/*.m:
    As above.
2024-12-14 23:55:01 +11:00

1019 lines
35 KiB
Mathematica
Raw Blame History

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1995-2007, 2009-2012 The University of Melbourne.
% Copyright (C) 2013-2015, 2018-2019, 2024 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
% File: dupelim.m.
% Author: zs.
%
% This module eliminate some duplicate code sequences.
%
% Our algorithm has the following stages.
%
% 1. Divide the code of the procedure into basic blocks.
%
% 2. For each block, compute a standard form, which is its most general
% generalization.
%
% 3. Find out which sets of blocks have the same standard form.
%
% 4. For each set of blocks with the same standard form, find out
% which blocks are not fallen into and can thus be eliminated,
% and choose which blocks will be eliminated.
%
% 5. For each set of blocks with the same standard form, compute
% their most specific common generalization (which must exist),
% and substitute this code for the code of the copy of the block
% that step 4 has decided to keep.
%
% 6. Convert the (possibly reduced) list of basic blocks back to a
% list of instructions and substitute all references to the labels
% starting eliminated blocks to refer to their noneliminated version.
%
% Generalizing an rval, lval or instruction involves replacing field references
% with known tags with field references with unknown tags. Generalizing a block
% involves generalizing its constituent instructions, removing comments, and
% possibly adding a goto at the end to represent falling through to the next
% label. In all other ways the original and the generalized version will be
% identical.
%
%-----------------------------------------------------------------------------%
:- module ll_backend.dupelim.
:- interface.
:- import_module ll_backend.llds.
:- import_module mdbcomp.
:- import_module mdbcomp.prim_data.
:- import_module counter.
:- import_module list.
%-----------------------------------------------------------------------------%
:- pred dupelim_main(proc_label::in, counter::in, counter::out,
list(instruction)::in, list(instruction)::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module ll_backend.basic_block.
:- import_module ll_backend.opt_util.
:- import_module bool.
:- import_module int.
:- import_module map.
:- import_module maybe.
:- import_module require.
:- import_module set.
%-----------------------------------------------------------------------------%
% A std_map maps a list of standardized instructions to the list
% of labels whose basic blocks have that standardized form.
%
:- type std_map == map(list(instr), list(label)).
% cluster(Exemplar, OtherLabels) means that references to labels
% in OtherLabels can be replaced with references to Exemplar
% once its block has been replaced with the most specific
% generalization of the blocks started by Exemplar and OtherLabels.
% OtherLabels must be nonempty.
%
:- type cluster
---> cluster(label, list(label)).
dupelim_main(ProcLabel, !C, Instrs0, Instrs) :-
create_basic_blocks(Instrs0, Comments, ProcLabel, !C, _NewLabels,
LabelSeq0, BlockMap0),
map.init(StdMap0),
set.init(Fixed0),
dupelim_build_maps(LabelSeq0, BlockMap0, StdMap0, StdMap, Fixed0, Fixed),
map.values(StdMap, StdList),
find_clusters(StdList, Fixed, [], Clusters),
(
Clusters = [],
% We don't want to introduce any incidental changes
% if we cannot eliminate any blocks.
Instrs = Instrs0
;
Clusters = [_ | _],
map.init(ReplMap0),
process_clusters(Clusters, LabelSeq0, LabelSeq, BlockMap0, BlockMap,
ReplMap0, ReplMap),
flatten_basic_blocks(LabelSeq, BlockMap, Instrs1, _),
opt_util.replace_labels_instruction_list(Instrs1, Instrs2,
ReplMap, yes, no),
Instrs = Comments ++ Instrs2
).
%-----------------------------------------------------------------------------%
% dupelim_build_maps builds up a map mapping standardized instruction
% sequences to the label(s) that start basic blocks with that standardized
% form, and a set showing which labels are fallen into.
%
:- pred dupelim_build_maps(list(label)::in, block_map::in,
std_map::in, std_map::out, set(label)::in, set(label)::out) is det.
dupelim_build_maps([], _, !StdMap, !Fixed).
dupelim_build_maps([Label | Labels], BlockMap, !StdMap, !Fixed) :-
map.lookup(BlockMap, Label, BlockInfo),
BlockInfo = block_info(_, _, Instrs, NumInstrs, _, _, MaybeFallThrough),
( if NumInstrs < std_block_size_limit then
standardize_instr_block(Instrs, MaybeFallThrough, StdInstrs),
map.search_insert(StdInstrs, [Label], MaybeOldCluster, !StdMap),
(
MaybeOldCluster = no
;
MaybeOldCluster = yes(OldCluster),
map.det_update(StdInstrs, [Label | OldCluster], !StdMap)
)
else
true
),
(
MaybeFallThrough = yes(FallIntoLabel),
set.insert(FallIntoLabel, !Fixed)
;
MaybeFallThrough = no
),
list.foldl(add_pragma_pref_labels, Instrs, !Fixed),
dupelim_build_maps(Labels, BlockMap, !StdMap, !Fixed).
% Don't try to standardize blocks that have more instructions than this.
% They are extremely unlikely to be duplicate blocks, so the work would
% be almost certainly wasted.
%
:- func std_block_size_limit = int.
std_block_size_limit = 10.
:- pred add_pragma_pref_labels(instruction::in,
set(label)::in, set(label)::out) is det.
add_pragma_pref_labels(Instr, !FoldFixed) :-
Instr = llds_instr(Uinstr, _),
( if
Uinstr = foreign_proc_code(_, _, _, MaybeFixedLabel,
MaybeLayoutLabel, MaybeOnlyLayoutLabel, _, MaybeDefLabel, _, _)
then
(
MaybeFixedLabel = yes(FixedLabel),
set.insert(FixedLabel, !FoldFixed)
;
MaybeFixedLabel = no
),
(
MaybeLayoutLabel = yes(LayoutLabel),
set.insert(LayoutLabel, !FoldFixed)
;
MaybeLayoutLabel = no
),
(
MaybeOnlyLayoutLabel = yes(OnlyLayoutLabel),
set.insert(OnlyLayoutLabel, !FoldFixed)
;
MaybeOnlyLayoutLabel = no
),
(
MaybeDefLabel = yes(DefLabel),
set.insert(DefLabel, !FoldFixed)
;
MaybeDefLabel = no
)
else
true
).
% For each set of labels that start basic blocks with identical standard
% forms, find_clusters finds out whether we can eliminate some of those
% blocks; if yes, it decides which blocks can be eliminated and which
% other block should stand in their place.
%
% If two or more blocks have the same standardized form, it may be possible
% to eliminate all but one of the blocks. However, blocks that can be
% fallen into cannot be eliminated. (Actually, they could, but only by
% inserting a goto, and full jumpopt would then undo the elimination of
% the block.) Similarly, blocks whose starting label is referred to by C
% code cannot be eliminated. (Actually, they could, but only by doing
% surgery on C code strings, which is not a good idea.)
%
:- pred find_clusters(list(list(label))::in, set(label)::in,
list(cluster)::in, list(cluster)::out) is det.
find_clusters([], _, !Clusters).
find_clusters([Labels | LabelsList], Fixed, !Clusters) :-
( if
Labels = [_, _ | _],
% The rest of the condition is relatively expensive, so don't do it
% if there aren't at least two labels whose blocks have the same
% standardized form.
IsFallenInto = (pred(Label::in) is semidet :-
set.member(Label, Fixed)
),
list.filter(IsFallenInto, Labels, FixedLabels, NonFixedLabels),
NonFixedLabels = [FirstNonFixed | OtherNonFixed]
then
(
FixedLabels = [ChosenLabel | _],
Cluster = cluster(ChosenLabel, NonFixedLabels)
;
FixedLabels = [],
Cluster = cluster(FirstNonFixed, OtherNonFixed)
),
!:Clusters = [Cluster | !.Clusters]
else
true
),
find_clusters(LabelsList, Fixed, !Clusters).
%-----------------------------------------------------------------------------%
% For each cluster, a set of blocks in which all but one are to be
% eliminated favor of the remaining one, find their most specific common
% generalization (which must exist), and substitute this code for the code
% of the copy of the block that is to be kept. Remove the eliminated labels
% from the label sequence and map them to their replacements.
%
:- pred process_clusters(list(cluster)::in, list(label)::in, list(label)::out,
block_map::in, block_map::out,
map(label, label)::in, map(label, label)::out) is det.
process_clusters([], !LabelSeq, !BlockMap, !ReplMap).
process_clusters([Cluster | Clusters], !LabelSeq, !BlockMap, !ReplMap) :-
Cluster = cluster(Exemplar, ElimLabels),
map.lookup(!.BlockMap, Exemplar, ExemplarInfo0),
ExemplarInfo0 = block_info(ExLabel, ExLabelInstr, ExInstrs0,
ExNumInstrs, ExFallInto, ExSideLabels, ExMaybeFallThrough),
expect(unify(Exemplar, ExLabel), $pred, "exemplar label mismatch"),
process_elim_labels(ElimLabels, ExInstrs0, !LabelSeq, !.BlockMap,
Exemplar, !ReplMap, UnifiedInstrs,
ExMaybeFallThrough, UnifiedMaybeFallThrough),
ExemplarInfo = block_info(ExLabel, ExLabelInstr, UnifiedInstrs,
ExNumInstrs, ExFallInto, ExSideLabels, UnifiedMaybeFallThrough),
map.det_update(Exemplar, ExemplarInfo, !BlockMap),
process_clusters(Clusters, !LabelSeq, !BlockMap, !ReplMap).
% Given the current form of a basic block (instructions and fallthrough),
% compute its most specific generalization with the basic blocks headed
% by the given labels, whose basic blocks are to be eliminated.
%
% On the same traversal of the list of to-be-eliminated labels, remove each
% such label from the sequence of labels whose basic blocks will make up
% the final code of the procedure, and add the mapping of the eliminated
% label to the replacement (exemplar) label to the set of substitutions
% that will need to be done.
%
:- pred process_elim_labels(list(label)::in, list(instruction)::in,
list(label)::in, list(label)::out, block_map::in,
label::in, map(label, label)::in, map(label, label)::out,
list(instruction)::out, maybe(label)::in, maybe(label)::out) is det.
process_elim_labels([], Instrs, !LabelSeq, _, _, !ReplMap, Instrs,
!MaybeFallThrough).
process_elim_labels([ElimLabel | ElimLabels], Instrs0, !LabelSeq, BlockMap,
Exemplar, !ReplMap, Instrs, !MaybeFallThrough) :-
map.lookup(BlockMap, ElimLabel, ElimLabelInfo),
ElimLabelInfo = block_info(ElimLabel2, _, ElimInstrs, _NumElimInstrs,
_, _, ElimMaybeFallThrough),
expect(unify(ElimLabel, ElimLabel2), $pred, "elim label mismatch"),
( if
most_specific_block(Instrs0, !.MaybeFallThrough, ElimInstrs,
ElimMaybeFallThrough, Instrs1, !:MaybeFallThrough)
then
list.delete_all(!.LabelSeq, ElimLabel, !:LabelSeq),
map.det_insert(ElimLabel, Exemplar, !ReplMap),
process_elim_labels(ElimLabels, Instrs1, !LabelSeq, BlockMap,
Exemplar, !ReplMap, Instrs, !MaybeFallThrough)
else
unexpected($pred, "blocks with same standard form don't antiunify")
).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
% The code of this section is concerned with computing the standard
% form (most general generalization) of a sequence of instructions.
%
% If a block can fall through, we add a goto to the following label
% at the end. This way, it will match with other blocks that have
% identical (standardized) content except for an explicit goto to our
% fallthrough label.
%
:- pred standardize_instr_block(list(instruction)::in, maybe(label)::in,
list(instr)::out) is det.
standardize_instr_block(Instrs0, MaybeFallThrough, Uinstrs) :-
standardize_instrs(Instrs0, Uinstrs1),
(
MaybeFallThrough = yes(Label),
Goto = goto(code_label(Label)),
Uinstrs = Uinstrs1 ++ [Goto]
;
MaybeFallThrough = no,
Uinstrs = Uinstrs1
).
% Compute the standard form of a sequence of instructions.
%
:- pred standardize_instrs(list(instruction)::in, list(instr)::out) is det.
standardize_instrs([], []).
standardize_instrs([llds_instr(Instr, _) | Instrs], StdInstrs) :-
standardize_instrs(Instrs, StdInstrs1),
standardize_instr(Instr, StdInstr),
( if StdInstr = comment(_) then
StdInstrs = StdInstrs1
else
StdInstrs = [StdInstr | StdInstrs1]
).
% Compute the standard form of an instruction.
%
:- pred standardize_instr(instr::in, instr::out) is det.
standardize_instr(Instr0, Instr) :-
(
Instr0 = assign(Lval0, Rval0),
standardize_lval(Lval0, Lval),
standardize_rval(Rval0, Rval),
Instr = assign(Lval, Rval)
;
Instr0 = keep_assign(Lval0, Rval0),
standardize_lval(Lval0, Lval),
standardize_rval(Rval0, Rval),
Instr = keep_assign(Lval, Rval)
;
Instr0 = if_val(Rval0, CodeAddr),
standardize_rval(Rval0, Rval),
Instr = if_val(Rval, CodeAddr)
;
Instr0 = save_maxfr(Lval0),
standardize_lval(Lval0, Lval),
Instr = save_maxfr(Lval)
;
Instr0 = restore_maxfr(Lval0),
standardize_lval(Lval0, Lval),
Instr = restore_maxfr(Lval)
;
Instr0 = incr_hp(Lval0, MaybeTag, MaybeOffset, Rval0, Msg,
MayUseAtomic, MaybeRegionRval0, MaybeReuse0),
standardize_lval(Lval0, Lval),
standardize_rval(Rval0, Rval),
(
MaybeRegionRval0 = yes(RegionRval0),
standardize_rval(RegionRval0, RegionRval),
MaybeRegionRval = yes(RegionRval)
;
MaybeRegionRval0 = no,
MaybeRegionRval = MaybeRegionRval0
),
(
MaybeReuse0 = llds_reuse(ReuseRval0, MaybeFlagLval0),
standardize_rval(ReuseRval0, ReuseRval),
(
MaybeFlagLval0 = yes(FlagLval0),
standardize_lval(FlagLval0, FlagLval),
MaybeFlagLval = yes(FlagLval)
;
MaybeFlagLval0 = no,
MaybeFlagLval = no
),
MaybeReuse = llds_reuse(ReuseRval, MaybeFlagLval)
;
MaybeReuse0 = no_llds_reuse,
MaybeReuse = no_llds_reuse
),
Instr = incr_hp(Lval, MaybeTag, MaybeOffset, Rval, Msg,
MayUseAtomic, MaybeRegionRval, MaybeReuse)
;
Instr0 = mark_hp(Lval0),
standardize_lval(Lval0, Lval),
Instr = mark_hp(Lval)
;
Instr0 = restore_hp(Rval0),
standardize_rval(Rval0, Rval),
Instr = restore_hp(Rval)
;
Instr0 = region_fill_frame(FillOp, EmbeddedStackFrame, IdRval0,
NumLval0, AddrLval0),
standardize_rval(IdRval0, IdRval),
standardize_lval(NumLval0, NumLval),
standardize_lval(AddrLval0, AddrLval),
Instr = region_fill_frame(FillOp, EmbeddedStackFrame, IdRval,
NumLval, AddrLval)
;
Instr0 = region_set_fixed_slot(SetOp, EmbeddedStackFrame, ValueRval0),
standardize_rval(ValueRval0, ValueRval),
Instr = region_set_fixed_slot(SetOp, EmbeddedStackFrame, ValueRval)
;
Instr0 = free_heap(Rval0),
standardize_rval(Rval0, Rval),
Instr = free_heap(Rval)
;
Instr0 = store_ticket(Lval0),
standardize_lval(Lval0, Lval),
Instr = store_ticket(Lval)
;
Instr0 = reset_ticket(Rval0, Reason),
standardize_rval(Rval0, Rval),
Instr = reset_ticket(Rval, Reason)
;
Instr0 = mark_ticket_stack(Lval0),
standardize_lval(Lval0, Lval),
Instr = mark_ticket_stack(Lval)
;
Instr0 = prune_tickets_to(Rval0),
standardize_rval(Rval0, Rval),
Instr = prune_tickets_to(Rval)
;
Instr0 = init_sync_term(Lval0, N, ConjId),
standardize_lval(Lval0, Lval),
Instr = init_sync_term(Lval, N, ConjId)
;
Instr0 = join_and_continue(Lval0, Label),
standardize_lval(Lval0, Lval),
Instr = join_and_continue(Lval, Label)
;
Instr0 = lc_create_loop_control(NumSlots, Lval0),
standardize_lval(Lval0, Lval),
Instr = lc_create_loop_control(NumSlots, Lval)
;
Instr0 = lc_wait_free_slot(Rval0, Lval0, Label),
standardize_rval(Rval0, Rval),
standardize_lval(Lval0, Lval),
Instr = lc_wait_free_slot(Rval, Lval, Label)
;
Instr0 = lc_spawn_off(LCRval0, LCSRval0, Label),
standardize_rval(LCRval0, LCRval),
standardize_rval(LCSRval0, LCSRval),
Instr = lc_spawn_off(LCRval, LCSRval, Label)
;
Instr0 = lc_join_and_terminate(LCRval0, LCSRval0),
standardize_rval(LCRval0, LCRval),
standardize_rval(LCSRval0, LCSRval),
Instr = lc_join_and_terminate(LCRval, LCSRval)
;
( Instr0 = comment(_)
; Instr0 = livevals(_)
; Instr0 = block(_, _, _)
; Instr0 = llcall(_, _, _, _, _, _)
; Instr0 = mkframe(_, _)
; Instr0 = label(_)
; Instr0 = goto(_)
; Instr0 = computed_goto(_, _, _)
; Instr0 = arbitrary_c_code(_, _, _)
; Instr0 = push_region_frame(_, _)
; Instr0 = use_and_maybe_pop_region_frame(_, _)
; Instr0 = discard_ticket
; Instr0 = prune_ticket
; Instr0 = incr_sp(_, _, _)
; Instr0 = decr_sp(_)
; Instr0 = decr_sp_and_return(_)
; Instr0 = fork_new_child(_, _)
; Instr0 = foreign_proc_code(_, _, _, _, _, _, _, _, _, _)
),
Instr = Instr0
).
% Compute the standard form of an lval.
%
:- pred standardize_lval(lval::in, lval::out) is det.
standardize_lval(Lval0, Lval) :-
(
( Lval0 = reg(_, _)
; Lval0 = succip
; Lval0 = maxfr
; Lval0 = curfr
; Lval0 = hp
; Lval0 = sp
; Lval0 = parent_sp
; Lval0 = temp(_, _)
; Lval0 = stackvar(_)
; Lval0 = parent_stackvar(_)
; Lval0 = framevar(_)
; Lval0 = double_stackvar(_, _)
; Lval0 = succip_slot(_)
; Lval0 = redoip_slot(_)
; Lval0 = succfr_slot(_)
; Lval0 = redofr_slot(_)
; Lval0 = prevfr_slot(_)
; Lval0 = mem_ref(_)
; Lval0 = global_var_ref(_)
),
Lval = Lval0
;
Lval0 = field(_, Addr, FieldNum),
Lval = field(no, Addr, FieldNum)
;
Lval0 = lvar(_),
unexpected($pred, "lvar")
).
% Compute the standard form of an rval.
%
:- pred standardize_rval(rval::in, rval::out) is det.
standardize_rval(Rval0, Rval) :-
(
Rval0 = lval(Lval0),
standardize_lval(Lval0, Lval),
Rval = lval(Lval)
;
( Rval0 = mkword(_, _)
; Rval0 = mkword_hole(_)
; Rval0 = const(_)
; Rval0 = mem_addr(_)
),
Rval = Rval0
;
Rval0 = cast(Type, Rval0L),
standardize_rval(Rval0L, RvalL),
Rval = cast(Type, RvalL)
;
Rval0 = unop(Unop, Rval0L),
standardize_rval(Rval0L, RvalL),
Rval = unop(Unop, RvalL)
;
Rval0 = binop(Binop, Rval0L, Rval0R),
standardize_rval(Rval0L, RvalL),
standardize_rval(Rval0R, RvalR),
Rval = binop(Binop, RvalL, RvalR)
;
Rval0 = var(_),
unexpected($pred, "var")
).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
% This predicate computes the most specific code sequence that
% generalizes both input sequences.
%
% If a block can fall through, we add a goto to the following label
% at the end. This way, it will match with other blocks that have
% identical (standardized) content except for an explicit goto to our
% fallthrough label.
%
:- pred standardize_block(list(instruction)::in, maybe(label)::in,
list(instruction)::out) is det.
standardize_block(Instrs, MaybeFallThrough, StdInstrs) :-
(
MaybeFallThrough = yes(Label),
( if
list.last(Instrs, LastInstr),
LastInstr = llds_instr(goto(code_label(Label)), _)
then
StdInstrs = Instrs
else
Goto = llds_instr(goto(code_label(Label)), ""),
StdInstrs = Instrs ++ [Goto]
)
;
MaybeFallThrough = no,
StdInstrs = Instrs
).
:- pred most_specific_block(list(instruction)::in, maybe(label)::in,
list(instruction)::in, maybe(label)::in,
list(instruction)::out, maybe(label)::out) is semidet.
most_specific_block(Instrs1, MaybeFallThrough1,
Instrs2, MaybeFallThrough2, Instrs, MaybeFallThrough) :-
standardize_block(Instrs1, MaybeFallThrough1, StdInstrs1),
standardize_block(Instrs2, MaybeFallThrough2, StdInstrs2),
most_specific_instrs(StdInstrs1, StdInstrs2, Instrs),
% A basic block cannot be empty after standardization, since
% standardization adds a goto to basic blocks that previously
% had no executable instructions. While most_specific_instrs
% can delete comments from its input instruction sequences,
% it cannot delete executable instructions.
list.det_last(Instrs, LastInstr),
( if LastInstr = llds_instr(goto(code_label(Label)), _) then
MaybeFallThrough = yes(Label)
else
MaybeFallThrough = no
).
:- pred most_specific_instrs(list(instruction)::in, list(instruction)::in,
list(instruction)::out) is semidet.
most_specific_instrs(InstrsA, InstrsB, Instrs) :-
( if
InstrsA = [InstrA | TailA],
InstrsB = [InstrB | TailB]
then
InstrA = llds_instr(UinstrA, CommentA),
InstrB = llds_instr(UinstrB, CommentB),
( if
most_specific_instr(UinstrA, UinstrB, yes(Uinstr))
then
( if CommentA = CommentB then
Comment = CommentA
else
Comment = "unified intruction"
),
Instr = llds_instr(Uinstr, Comment),
most_specific_instrs(TailA, TailB, Tail),
Instrs = [Instr | Tail]
else if
UinstrA = comment(_)
then
most_specific_instrs(TailA, InstrsB, Instrs)
else if
UinstrB = comment(_)
then
most_specific_instrs(InstrsA, TailB, Instrs)
else
fail
)
else if
InstrsA = [],
InstrsB = []
then
Instrs = []
else if
InstrsA = [InstrA | TailA],
InstrA = llds_instr(comment(_), _)
then
most_specific_instrs(TailA, InstrsB, Instrs)
else if
InstrsB = [InstrB | TailB],
InstrB = llds_instr(comment(_), _)
then
most_specific_instrs(InstrsA, TailB, Instrs)
else
fail
).
% This predicate computes the most specific instruction that
% generalizes both input instructions.
%
:- pred most_specific_instr(instr::in, instr::in, maybe(instr)::out) is det.
most_specific_instr(InstrA, InstrB, MaybeInstr) :-
(
InstrA = assign(LvalA, RvalA),
( if
InstrB = assign(LvalB, RvalB),
most_specific_lval(LvalA, LvalB, Lval),
most_specific_rval(RvalA, RvalB, Rval)
then
MaybeInstr = yes(assign(Lval, Rval))
else
MaybeInstr = no
)
;
InstrA = keep_assign(LvalA, RvalA),
( if
InstrB = keep_assign(LvalB, RvalB),
most_specific_lval(LvalA, LvalB, Lval),
most_specific_rval(RvalA, RvalB, Rval)
then
MaybeInstr = yes(keep_assign(Lval, Rval))
else
MaybeInstr = no
)
;
InstrA = if_val(RvalA, CodeAddrA),
( if
InstrB = if_val(RvalB, CodeAddrB),
most_specific_rval(RvalA, RvalB, Rval),
CodeAddrA = CodeAddrB
then
MaybeInstr = yes(if_val(Rval, CodeAddrA))
else
MaybeInstr = no
)
;
InstrA = incr_hp(LvalA, MaybeTag, MaybeOffset, RvalA, Msg,
MayUseAtomic, MaybeRegionRvalA, MaybeReuseA),
( if
InstrB = incr_hp(LvalB, MaybeTag, MaybeOffset, RvalB, Msg,
MayUseAtomic, MaybeRegionRvalB, MaybeReuseB),
most_specific_lval(LvalA, LvalB, Lval),
most_specific_rval(RvalA, RvalB, Rval),
(
MaybeRegionRvalA = yes(RegionRvalA),
MaybeRegionRvalB = yes(RegionRvalB),
most_specific_rval(RegionRvalA, RegionRvalB, RegionRval),
MaybeRegionRval = yes(RegionRval)
;
MaybeRegionRvalA = no,
MaybeRegionRvalB = no,
MaybeRegionRval = no
),
(
MaybeReuseA = llds_reuse(ReuseRvalA, MaybeFlagLvalA),
MaybeReuseB = llds_reuse(ReuseRvalB, MaybeFlagLvalB),
most_specific_rval(ReuseRvalA, ReuseRvalB, ReuseRval),
(
MaybeFlagLvalA = yes(FlagLvalA),
MaybeFlagLvalB = yes(FlagLvalB),
most_specific_lval(FlagLvalA, FlagLvalB, FlagLval),
MaybeFlagLval = yes(FlagLval)
;
MaybeFlagLvalA = no,
MaybeFlagLvalB = no,
MaybeFlagLval = no
),
MaybeReuse = llds_reuse(ReuseRval, MaybeFlagLval)
;
MaybeReuseA = no_llds_reuse,
MaybeReuseB = no_llds_reuse,
MaybeReuse = no_llds_reuse
)
then
MaybeInstr = yes(incr_hp(Lval, MaybeTag, MaybeOffset, Rval,
Msg, MayUseAtomic, MaybeRegionRval, MaybeReuse))
else
MaybeInstr = no
)
;
InstrA = mark_hp(LvalA),
( if
InstrB = mark_hp(LvalB),
most_specific_lval(LvalA, LvalB, Lval)
then
MaybeInstr = yes(mark_hp(Lval))
else
MaybeInstr = no
)
;
InstrA = restore_hp(RvalA),
( if
InstrB = restore_hp(RvalB),
most_specific_rval(RvalA, RvalB, Rval)
then
MaybeInstr = yes(restore_hp(Rval))
else
MaybeInstr = no
)
;
InstrA = free_heap(RvalA),
( if
InstrB = free_heap(RvalB),
most_specific_rval(RvalA, RvalB, Rval)
then
MaybeInstr = yes(free_heap(Rval))
else
MaybeInstr = no
)
;
InstrA = push_region_frame(StackId, EmbeddedStackFrame),
( if
InstrB = push_region_frame(StackId, EmbeddedStackFrame)
then
MaybeInstr = yes(push_region_frame(StackId, EmbeddedStackFrame))
else
MaybeInstr = no
)
;
InstrA = region_fill_frame(FillOp, EmbeddedStackFrame,
IdRvalA, NumLvalA, AddrLvalA),
( if
InstrB = region_fill_frame(FillOp, EmbeddedStackFrame,
IdRvalB, NumLvalB, AddrLvalB),
most_specific_rval(IdRvalA, IdRvalB, IdRval),
most_specific_lval(NumLvalA, NumLvalB, NumLval),
most_specific_lval(AddrLvalA, AddrLvalB, AddrLval)
then
MaybeInstr = yes(region_fill_frame(FillOp, EmbeddedStackFrame,
IdRval, NumLval, AddrLval))
else
MaybeInstr = no
)
;
InstrA = region_set_fixed_slot(SetOp, EmbeddedStackFrame,
ValueRvalA),
( if
InstrB = region_set_fixed_slot(SetOp, EmbeddedStackFrame,
ValueRvalB),
most_specific_rval(ValueRvalA, ValueRvalB, ValueRval)
then
MaybeInstr = yes(region_set_fixed_slot(SetOp, EmbeddedStackFrame,
ValueRval))
else
MaybeInstr = no
)
;
InstrA = use_and_maybe_pop_region_frame(UseOp, EmbeddedStackFrame),
( if
InstrB = use_and_maybe_pop_region_frame(UseOp, EmbeddedStackFrame)
then
MaybeInstr = yes(use_and_maybe_pop_region_frame(UseOp,
EmbeddedStackFrame))
else
MaybeInstr = no
)
;
InstrA = store_ticket(LvalA),
( if
InstrB = store_ticket(LvalB),
most_specific_lval(LvalA, LvalB, Lval)
then
MaybeInstr = yes(store_ticket(Lval))
else
MaybeInstr = no
)
;
InstrA = reset_ticket(RvalA, Reason),
( if
InstrB = reset_ticket(RvalB, Reason),
most_specific_rval(RvalA, RvalB, Rval)
then
MaybeInstr = yes(reset_ticket(Rval, Reason))
else
MaybeInstr = no
)
;
InstrA = mark_ticket_stack(LvalA),
( if
InstrB = mark_ticket_stack(LvalB),
most_specific_lval(LvalA, LvalB, Lval)
then
MaybeInstr = yes(mark_ticket_stack(Lval))
else
MaybeInstr = no
)
;
InstrA = prune_tickets_to(RvalA),
( if
InstrB = prune_tickets_to(RvalB),
most_specific_rval(RvalA, RvalB, Rval)
then
MaybeInstr = yes(prune_tickets_to(Rval))
else
MaybeInstr = no
)
;
InstrA = lc_create_loop_control(NumSlots, LvalA),
( if
InstrB = lc_create_loop_control(NumSlots, LvalB),
most_specific_lval(LvalA, LvalB, Lval)
then
MaybeInstr = yes(lc_create_loop_control(NumSlots, Lval))
else
MaybeInstr = no
)
;
InstrA = lc_wait_free_slot(RvalA, LvalA, Label),
( if
InstrB = lc_wait_free_slot(RvalB, LvalB, Label),
most_specific_rval(RvalA, RvalB, Rval),
most_specific_lval(LvalA, LvalB, Lval)
then
MaybeInstr = yes(lc_wait_free_slot(Rval, Lval, Label))
else
MaybeInstr = no
)
;
InstrA = lc_spawn_off(LCRvalA, LCSRvalA, Label),
( if
InstrB = lc_spawn_off(LCRvalB, LCSRvalB, Label),
most_specific_rval(LCRvalA, LCRvalB, LCRval),
most_specific_rval(LCSRvalA, LCSRvalB, LCSRval)
then
MaybeInstr = yes(lc_spawn_off(LCRval, LCSRval, Label))
else
MaybeInstr = no
)
;
InstrA = lc_join_and_terminate(LCRvalA, LCSRvalA),
( if
InstrB = lc_join_and_terminate(LCRvalB, LCSRvalB),
most_specific_rval(LCRvalA, LCRvalB, LCRval),
most_specific_rval(LCSRvalA, LCSRvalB, LCSRval)
then
MaybeInstr = yes(lc_join_and_terminate(LCRval, LCSRval))
else
MaybeInstr = no
)
;
( InstrA = livevals(_)
; InstrA = block(_, _, _)
; InstrA = llcall(_, _, _, _, _, _)
; InstrA = mkframe(_, _)
; InstrA = label(_)
; InstrA = goto(_)
; InstrA = computed_goto(_, _, _)
; InstrA = arbitrary_c_code(_, _, _)
; InstrA = save_maxfr(_)
; InstrA = restore_maxfr(_)
; InstrA = discard_ticket
; InstrA = prune_ticket
; InstrA = incr_sp(_, _, _)
; InstrA = decr_sp(_)
; InstrA = decr_sp_and_return(_)
; InstrA = foreign_proc_code(_, _, _, _, _, _, _, _, _, _)
; InstrA = fork_new_child(_, _)
; InstrA = init_sync_term(_, _, _)
; InstrA = join_and_continue(_, _)
),
( if InstrA = InstrB then
MaybeInstr = yes(InstrA)
else
MaybeInstr = no
)
;
InstrA = comment(_),
MaybeInstr = no
).
% This predicate computes the most specific lval that
% generalizes both input lvals.
%
:- pred most_specific_lval(lval::in, lval::in, lval::out) is semidet.
most_specific_lval(LvalA, LvalB, Lval) :-
(
( LvalA = reg(_, _)
; LvalA = succip
; LvalA = maxfr
; LvalA = curfr
; LvalA = hp
; LvalA = sp
; LvalA = parent_sp
; LvalA = temp(_, _)
; LvalA = stackvar(_)
; LvalA = parent_stackvar(_)
; LvalA = framevar(_)
; LvalA = double_stackvar(_, _)
; LvalA = succip_slot(_)
; LvalA = redoip_slot(_)
; LvalA = redofr_slot(_)
; LvalA = succfr_slot(_)
; LvalA = prevfr_slot(_)
; LvalA = mem_ref(_)
; LvalA = global_var_ref(_)
),
LvalA = LvalB,
Lval = LvalA
;
LvalA = field(MaybeTagA, Addr, FieldNum),
LvalB = field(MaybeTagB, Addr, FieldNum),
( if MaybeTagA = MaybeTagB then
MaybeTag = MaybeTagA
else
MaybeTag = no
),
Lval = field(MaybeTag, Addr, FieldNum)
;
LvalA = lvar(_),
unexpected($pred, "lvar")
).
% This predicate computes the most specific rval that
% generalizes both input rvals.
%
:- pred most_specific_rval(rval::in, rval::in, rval::out) is semidet.
most_specific_rval(RvalA, RvalB, Rval) :-
require_complete_switch [RvalA]
(
RvalA = lval(LvalA),
RvalB = lval(LvalB),
most_specific_lval(LvalA, LvalB, Lval),
Rval = lval(Lval)
;
RvalA = var(_),
unexpected($pred, "var")
;
( RvalA = mkword(_, _)
; RvalA = mkword_hole(_)
; RvalA = const(_)
; RvalA = mem_addr(_)
),
RvalB = RvalA,
Rval = RvalA
;
RvalA = cast(Type, RvalAL),
RvalB = cast(Type, RvalBL),
most_specific_rval(RvalAL, RvalBL, RvalL),
Rval = cast(Type, RvalL)
;
RvalA = unop(Unop, RvalAL),
RvalB = unop(Unop, RvalBL),
most_specific_rval(RvalAL, RvalBL, RvalL),
Rval = unop(Unop, RvalL)
;
RvalA = binop(Binnop, RvalAL, RvalAR),
RvalB = binop(Binnop, RvalBL, RvalBR),
most_specific_rval(RvalAL, RvalBL, RvalL),
most_specific_rval(RvalAR, RvalBR, RvalR),
Rval = binop(Binnop, RvalL, RvalR)
).
%-----------------------------------------------------------------------------%
:- end_module ll_backend.dupelim.
%-----------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink