for review: add last call modulo constructors optimisation
David Matthew Overton
dmo at students.cs.mu.OZ.AU
Mon Jun 22 16:06:57 AEST 1998
Hi Andrew,
Could you please review this change, since you are familiar with the
alias branch. Anyone else who wants to look and/or make any comments,
feel free.
David
--
David Overton
MEngSc Student Email: dmo at cs.mu.oz.au
Department of Computer Science Web: http://www.cs.mu.oz.au/~dmo
The University of Melbourne Phone: +61 3 9344 9159
Estimated hours taken: 500
- Add support for pass-by-reference in the code generator.
- Add partial support for aliasing between free variables in the mode
system.
- Use the above changes to implement the last call modulo constructors
optimisation (LCO).
Current known problems: LCO does not currently work in conjunction
with value-numbering, termination analysis or follow-code. The
follow-code problem is with merging alias insts at the end of branch
structures -- Andrew Bromage is working on this.
Tag: alias
compiler/inst.m:
Add an argument to `free' insts to say whether or not they are
aliased.
compiler/code_exprn.m:
Add support for references to `free(alias)' variables in the
exprn_info and add some new predicates to deal with them.
compiler/hlds_pred.m:
Add new functors `ref_out' and `ref_in' to the `arg_mode'
type. These are for `free(unique) -> free(alias)' and
`free(alias) -> bound(...)' modes, respectively.
compiler/lco.m:
Last call modulo constructors optimisation (LCO).
When a procedure ends with a call followed only by
construction unifications, move the constructions to before
the call. Modify the call and the called procedure to use
pass-by-reference for arguments which are now `free(alias)'.
This re-ordering provides more opportunities for tailcall
optimisation and reduces the number of live variables at the
call, thus hopefully reducing the number of stack slots
needed.
Current limitations:
- The caller and callee must both be in the same module.
- Only one reference is allowed per `free(alias)' variable.
This will be fixed by adding a free(alias_many) inst and
appropriate changes to the code generator.
- If any of the constructions are for `no_tag' types then the
re-ordering is not done. Support for some of the
constructions being for `no_tag' types will be added soon.
(Of course, if _all_ the constructions are for `no_tag'
types, there is no point doing the re-ordering.)
compiler/arg_info.m:
compiler/call_gen.m:
compiler/code_info.m:
compiler/follow_vars.m:
compiler/hlds_out.m:
compiler/store_alloc.m:
Distinguish between pass-by-value and pass-by-reference
arguments/variables.
compiler/common.m:
compiler/higher_order.m:
compiler/hlds_out.m:
compiler/instmap.m:
compiler/make_hlds.m:
compiler/mercury_to_mercury.m:
compiler/module_qual.m:
compiler/polymorphism.m :
compiler/prog_io_util.m:
compiler/prog_util.m:
compiler/table_gen.m:
Add an argument to `free' insts to say whether or not they are
aliased.
compiler/export.m:
Add `ref_in' and `ref_out' arg_modes to switches in
`get_input_args' and `copy_output_args'. But don't produce
any code for them yet. (XXXs have been added in appropriate
places).
compiler/exprn_aux.m:
Move declarations for `exprn_aux__lval_contains_lval' and
`exprn_aux__substitute_lval_in_lval' into the interface so
they can be used by `code_exprn.m'.
compiler/hlds_goal.m:
Distinguish between values and references in `follow_vars' and
`store_map' types.
Add a new argument to the `goal_info' containing the set of
live reference vars. This is needed during code generation to
update the `exprn_info' correctly in unreachable branches.
compiler/inst_match.m:
Add new predicates to test for `free(alias)' insts.
Modify `inst_matches_*' predicates to allow for `free(alias)'
insts.
compiler/inst_util.m:
Allow abstract unification of free insts with partially
instantiated bound insts.
compiler/live_vars.m:
Add an extra argument to the call to `initial_liveness'.
compiler/liveness.m:
Add support for `ref_in' and `ref_out' arg_modes.
Compute the set of live reference vars in the `goal_info'.
compiler/llds.m:
Add the type `val_or_ref' to indicate whether an argument is a
value or reference.
compiler/llds_out.m:
Output a pointer de-reference for `mem_ref' lvals.
compiler/mercury_compile.m:
Call LCO before dead procedure elimination because LCO may
cause some procedures to become dead.
Allow the `module_info' to be threaded through LCO.
compiler/mode_util.m:
Add support for `free(alias)' insts and `ref_in' and `ref_out'
arg_modes to `mode_to_arg_mode/4'.
compiler/modecheck_unify.m:
Add support for `free(alias)' insts.
Disallow scheduling of constructions of partially instantiated
data structures until we come up with a better algorithm for
when this should be done and when it shouldn't. At the
moment, partially instantiated data structures are only
created by LCO, which is called after mode checking.
compiler/par_conj_gen.m:
Convert `stack_slots' to `store_map' (which are now different
types) before calling `code_info__generate_branch_end'.
compiler/pd_util.m:
Pass `io__state' to `simplify__process_goal'.
Add support for the extra argument to `free' insts.
compiler/simplify.m:
Call `modecheck_queued_procs' after `recompute_instmap_delta'
because new unification procs may have been created.
Don't allow removal of ``excess'' assignments if either of the
variables has inst `free(alias)' before the assignment.
compiler/unify_gen.m:
Generate code for construction of partially instantiated data
structures.
Place result of constructions in the correct place if the LHS
variable has mode `ref_in'.
Generate code for assignments between `free(alias)' and
`free(unique)' variables.
compiler/stratify.m:
Fix a spelling mistake (s/_IMelta/_IMDelta/).
compiler/det_util.m:
Rename a variable (s/IKT/InstTable).
Index: compiler/arg_info.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/arg_info.m,v
retrieving revision 1.23.4.7
diff -u -r1.23.4.7 arg_info.m
--- 1.23.4.7 1998/06/05 08:42:29
+++ arg_info.m 1998/06/22 01:23:56
@@ -48,7 +48,7 @@
% Given a list of the head variables and their argument information,
% return a list giving the input variables and their initial locations.
:- pred arg_info__build_input_arg_list(assoc_list(var, arg_info),
- assoc_list(var, rval)).
+ assoc_list(var, val_or_ref)).
:- mode arg_info__build_input_arg_list(in, out) is det.
%-----------------------------------------------------------------------------%
@@ -207,6 +207,20 @@
ArgReg = OutReg0,
InReg1 = InReg0,
OutReg1 is OutReg0 + 1
+ ;
+ % Treat aliased args as input because we need to pass in
+ % a pointer to the memory location.
+ ArgMode = ref_in,
+ ArgReg = InReg0,
+ InReg1 is InReg0 + 1,
+ OutReg1 = OutReg0
+ ;
+ % Treat ref_out the same as output because we will need to
+ % return a reference.
+ ArgMode = ref_out,
+ ArgReg = OutReg0,
+ InReg1 = InReg0,
+ OutReg1 is OutReg0 + 1
),
ArgInfo = arg_info(ArgReg, ArgMode),
make_arg_infos_compact_list(Modes, Types, InReg1, OutReg1,
@@ -239,11 +253,12 @@
arg_info__build_input_arg_list([], []).
arg_info__build_input_arg_list([V - Arg | Rest0], VarArgs) :-
Arg = arg_info(Loc, Mode),
- (
- Mode = top_in
- ->
+ ( Mode = top_in ->
+ code_util__arg_loc_to_register(Loc, Reg),
+ VarArgs = [V - value(lval(Reg)) | VarArgs0]
+ ; Mode = ref_in ->
code_util__arg_loc_to_register(Loc, Reg),
- VarArgs = [V - lval(Reg) | VarArgs0]
+ VarArgs = [V - reference(Reg) | VarArgs0]
;
VarArgs = VarArgs0
),
Index: compiler/call_gen.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/call_gen.m,v
retrieving revision 1.113.4.8
diff -u -r1.113.4.8 call_gen.m
--- 1.113.4.8 1998/06/05 08:42:48
+++ call_gen.m 1998/06/22 01:02:35
@@ -478,7 +478,11 @@
call_gen__save_variables_2([], empty) --> [].
call_gen__save_variables_2([Var | Vars], Code) -->
- code_info__save_variable_on_stack(Var, CodeA),
+ ( code_info__var_is_free_alias(Var) ->
+ code_info__save_reference_on_stack(Var, CodeA)
+ ;
+ code_info__save_variable_on_stack(Var, CodeA)
+ ),
call_gen__save_variables_2(Vars, CodeB),
{ Code = tree(CodeA, CodeB) }.
@@ -504,6 +508,11 @@
{ code_util__arg_loc_to_register(ArgLoc, Register) },
code_info__set_var_location(Var, Register)
;
+ { Mode = ref_out }
+ ->
+ { code_util__arg_loc_to_register(ArgLoc, Register) },
+ code_info__set_var_reference_location(Var, Register)
+ ;
{ true }
),
call_gen__rebuild_registers_2(Args).
@@ -582,7 +591,7 @@
call_gen__partition_args([], [], []).
call_gen__partition_args([V - arg_info(_Loc,Mode) | Rest], Ins, Outs) :-
(
- Mode = top_in
+ ( Mode = top_in ; Mode = ref_in )
->
call_gen__partition_args(Rest, Ins0, Outs),
Ins = [V | Ins0]
@@ -684,7 +693,7 @@
call_gen__select_out_args([V - arg_info(_Loc, Mode) | Rest], Out) :-
call_gen__select_out_args(Rest, Out0),
(
- Mode = top_out
+ ( Mode = top_out ; Mode = ref_out )
->
set__insert(Out0, V, Out)
;
@@ -699,7 +708,7 @@
call_gen__input_args([], []).
call_gen__input_args([arg_info(Loc, Mode) | Args], Vs) :-
(
- Mode = top_in
+ ( Mode = top_in ; Mode = ref_in )
->
Vs = [Loc |Vs0]
;
@@ -712,7 +721,7 @@
call_gen__input_arg_locs([], []).
call_gen__input_arg_locs([Var - arg_info(Loc, Mode) | Args], Vs) :-
(
- Mode = top_in
+ ( Mode = top_in ; Mode = ref_in )
->
Vs = [Var - Loc | Vs0]
;
@@ -723,7 +732,7 @@
call_gen__output_arg_locs([], []).
call_gen__output_arg_locs([Var - arg_info(Loc, Mode) | Args], Vs) :-
(
- Mode = top_out
+ ( Mode = top_out ; Mode = ref_out )
->
Vs = [Var - Loc | Vs0]
;
Index: compiler/code_exprn.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/code_exprn.m,v
retrieving revision 1.51.4.5
diff -u -r1.51.4.5 code_exprn.m
--- 1.51.4.5 1998/06/05 08:43:04
+++ code_exprn.m 1998/06/22 01:28:00
@@ -55,7 +55,7 @@
% the table of options; this is used to decide what expressions
% are considered constants.
-:- pred code_exprn__init_state(assoc_list(var, rval), varset, stack_slots,
+:- pred code_exprn__init_state(assoc_list(var, val_or_ref), varset, stack_slots,
follow_vars, option_table, exprn_info).
:- mode code_exprn__init_state(in, in, in, in, in, out) is det.
@@ -68,7 +68,8 @@
% of variables and lvalues. The new state places the given
% variables at their corresponding locations.
-:- pred code_exprn__reinit_state(assoc_list(var, rval), exprn_info, exprn_info).
+:- pred code_exprn__reinit_state(assoc_list(var, val_or_ref), exprn_info,
+ exprn_info).
:- mode code_exprn__reinit_state(in, in, out) is det.
% code_exprn__clobber_regs(CriticalVars, ExprnInfo0, ExprnInfo)
@@ -91,6 +92,14 @@
:- pred code_exprn__maybe_set_var_location(var, lval, exprn_info, exprn_info).
:- mode code_exprn__maybe_set_var_location(in, in, in, out) is det.
+% code_exprn__set_var_reference_location(Var, Lval, ExprnInfo0, ExprnInfo)
+% Modifies ExprnInfo0 to record that Lval holds an address
+% where the value of Var will be placed.
+
+:- pred code_exprn__set_var_reference_location(var, lval,
+ exprn_info, exprn_info).
+:- mode code_exprn__set_var_reference_location(in, in, in, out) is det.
+
:- pred code_exprn__lval_in_use(lval, exprn_info, exprn_info).
:- mode code_exprn__lval_in_use(in, in, out) is semidet.
@@ -123,10 +132,27 @@
% ExprnInfo which places the value of each variable
% mentioned in the store map into the corresponding location.
-:- pred code_exprn__place_vars(assoc_list(var, lval), code_tree,
+:- pred code_exprn__place_vars(assoc_list(var, store_info), code_tree,
exprn_info, exprn_info).
:- mode code_exprn__place_vars(in, out, in, out) is det.
+% code_exprn__place_var_in_references(Var, Code, ExprnInfo0, ExprnInfo)
+% If the Var has a set of reference locations associated with
+% it, place it in these locations and remove them from the
+% locations set.
+:- pred code_exprn__place_var_in_references(var, code_tree,
+ exprn_info, exprn_info).
+:- mode code_exprn__place_var_in_references(in, out, in, out) is det.
+
+
+% code_exprn__place_var_reference(Var, Lval, Code, ExprnInfo0, ExprnInfo)
+% Produces code to place the reference to Var's location
+% in Lval, if it isn't already there.
+
+:- pred code_exprn__place_var_reference(var, lval, code_tree, exprn_info,
+ exprn_info).
+:- mode code_exprn__place_var_reference(in, in, out, in, out) is det.
+
% code_exprn__produce_var(Var, Rval, Code, ExprnInfo0, ExprnInfo)
% Produces a code fragment Code to evaluate Var and
% provide it as Rval (which may be a const, etc, or an lval).
@@ -152,6 +178,10 @@
exprn_info, exprn_info).
:- mode code_exprn__produce_var_in_reg_or_stack(in, out, out, in, out) is det.
+:- pred code_exprn__produce_ref_in_reg_or_stack(var, lval, code_tree,
+ exprn_info, exprn_info).
+:- mode code_exprn__produce_ref_in_reg_or_stack(in, out, out, in, out) is det.
+
% code_exprn__materialize_vars_in_rval(Rval0, Rval, Code, ExprnInfo0,
% ExprnInfo)
% Produces code to materialize any vars that occur in `Rval0'
@@ -239,6 +269,10 @@
:- pred code_exprn__set_follow_vars(follow_vars, exprn_info, exprn_info).
:- mode code_exprn__set_follow_vars(in, in, out) is det.
+:- pred code_exprn__value_to_rval(val_or_ref::in, rval::out) is semidet.
+
+:- pred code_exprn__reference_to_lval(val_or_ref::in, lval::out) is semidet.
+
% code_exprn__max_reg_in_use(MaxReg)
% Returns the number of the highest numbered rN register in use.
@@ -254,9 +288,27 @@
:- import_module bool, bag, require, int, term, string, std_util.
:- type var_stat ---> evaled(set(rval))
- ; cached(rval).
+ ; cached(rval)
+ ; none
+ .
+
+
+% var_info stores information about the current status of a variable
+% and the set of locations where the variable value should be put when
+% the cache is flushed.
+:- type var_info --->
+ var_info(
+ var_refs,
+ var_stat
+ % Current status of variable value.
+ ).
+
+% Locations where the value needs to be placed, Each lval in a
+% set(lval) should point to the same place. The bool is yes if the
+% value is already in this location, otherwise it is no.
+:- type var_refs == set(pair(bool, set(lval))).
-:- type var_map == map(var, var_stat).
+:- type var_map == map(var, var_info).
:- type exprn_info --->
exprn_info(
@@ -291,28 +343,52 @@
ExprnInfo = exprn_info(Varset, Vars, Regs, Acqu,
StackSlots, FollowVars, ExprnOpts).
-:- pred code_exprn__init_state_2(assoc_list(var, rval), var_map, var_map,
+:- pred code_exprn__init_state_2(assoc_list(var, val_or_ref), var_map, var_map,
bag(lval), bag(lval)).
:- mode code_exprn__init_state_2(in, in, out, in, out) is det.
code_exprn__init_state_2([], Vars, Vars, Regs, Regs).
-code_exprn__init_state_2([V - L | Rest], Vars0, Vars, Regs0, Regs) :-
- (
- map__search(Vars0, V, evaled(Vals0))
- ->
- set__insert(Vals0, L, Vals),
- map__det_update(Vars0, V, evaled(Vals), Vars1)
- ;
- set__singleton_set(Vals, L),
- map__det_insert(Vars0, V, evaled(Vals), Vars1)
- ),
- (
- L = lval(Loc),
- Loc = reg(_, _)
- ->
- bag__insert(Regs0, Loc, Regs1)
- ;
- Regs1 = Regs0
+code_exprn__init_state_2([V - VVal | Rest], Vars0, Vars, Regs0, Regs) :-
+ ( VVal = value(Rval),
+ ( map__search(Vars0, V, var_info(Locs0, Stat)) ->
+ ( Stat = evaled(Vals0) ->
+ set__insert(Vals0, Rval, Vals),
+ VarInfo = var_info(Locs0, evaled(Vals)),
+ map__det_update(Vars0, V, VarInfo, Vars1)
+ ;
+ set__singleton_set(Vals, Rval),
+ VarInfo = var_info(Locs0, evaled(Vals)),
+ map__det_update(Vars0, V, VarInfo, Vars1)
+ )
+ ;
+ set__singleton_set(Vals, Rval),
+ set__init(Locs),
+ VarInfo = var_info(Locs, evaled(Vals)),
+ map__det_insert(Vars0, V, VarInfo, Vars1)
+ ),
+ (
+ Rval = lval(Loc),
+ Loc = reg(_, _)
+ ->
+ bag__insert(Regs0, Loc, Regs1)
+ ;
+ Regs1 = Regs0
+ )
+ ; VVal = reference(Lval),
+ set__singleton_set(Lvals, Lval),
+ ( map__search(Vars0, V, var_info(Locs0, Stat)) ->
+ set__insert(Locs0, no - Lvals, Locs),
+ map__det_update(Vars0, V, var_info(Locs, Stat), Vars1)
+ ;
+ set__singleton_set(Locs, no - Lvals),
+ map__det_insert(Vars0, V, var_info(Locs, none),
+ Vars1)
+ ),
+ ( Lval = reg(_, _) ->
+ bag__insert(Regs0, Lval, Regs1)
+ ;
+ Regs1 = Regs0
+ )
),
code_exprn__init_state_2(Rest, Vars1, Vars, Regs1, Regs).
@@ -324,19 +400,24 @@
map__init(Locations0),
code_exprn__repackage_locations(VarList, Locations0, Locations).
-:- pred code_exprn__repackage_locations(assoc_list(var, var_stat),
+:- pred code_exprn__repackage_locations(assoc_list(var, var_info),
map(var, set(rval)), map(var, set(rval))).
:- mode code_exprn__repackage_locations(in, in, out) is det.
code_exprn__repackage_locations([], Loc, Loc).
-code_exprn__repackage_locations([V - Locs | Rest], Loc0, Loc) :-
+code_exprn__repackage_locations([V - var_info(_, Locs) | Rest], Loc0, Loc) :-
(
- Locs = cached(Rval),
- set__singleton_set(Rvals, Rval)
+ (
+ Locs = cached(Rval),
+ set__singleton_set(Rvals, Rval)
+ ;
+ Locs = evaled(Rvals)
+ )
+ ->
+ map__set(Loc0, V, Rvals, Loc1)
;
- Locs = evaled(Rvals)
+ Loc1 = Loc0
),
- map__set(Loc0, V, Rvals, Loc1),
code_exprn__repackage_locations(Rest, Loc1, Loc).
%------------------------------------------------------------------------------%
@@ -353,12 +434,14 @@
{ set__init(Acqu) },
code_exprn__set_acquired(Acqu).
-:- pred code_exprn__clobber_regs_2(assoc_list(var, var_stat), list(var),
+:- pred code_exprn__clobber_regs_2(assoc_list(var, var_info), list(var),
var_map, var_map, var_map).
:- mode code_exprn__clobber_regs_2(in, in, in, in, out) is det.
code_exprn__clobber_regs_2([], _Critical, _OldVars, Vars, Vars).
-code_exprn__clobber_regs_2([V - Stat | Rest], Critical, OldVars, Vars0, Vars) :-
+code_exprn__clobber_regs_2([V - VarInfo | Rest], Critical, OldVars, Vars0,
+ Vars) :-
+ VarInfo = var_info(Refs0, Stat),
(
Stat = cached(Exprn),
(
@@ -369,10 +452,10 @@
->
error("code_exprn__clobber_regs: attempt to clobber critical register")
;
- Vars1 = Vars0
+ SetStat = no
)
;
- map__set(Vars0, V, Stat, Vars1)
+ SetStat = yes(Stat)
)
;
Stat = evaled(Rvals0),
@@ -385,11 +468,31 @@
->
error("code_exprn__clobber_regs: attempt to clobber critical register")
;
- Vars1 = Vars0
+ SetStat = no
)
;
- map__set(Vars0, V, evaled(Rvals), Vars1)
+ SetStat = yes(evaled(Rvals))
)
+ ;
+ Stat = none,
+ SetStat = no
+ ),
+ code_exprn__filter_out_reg_depending_refs(Refs0, OldVars, Refs),
+ (
+ set__member(_ - Ref, Refs),
+ set__empty(Ref),
+ list__member(V, Critical)
+ ->
+ error("code_exprn__clobber_regs: attempt to clobber critical register")
+ ;
+ true
+ ),
+ ( SetStat = yes(NewStat) ->
+ map__set(Vars0, V, var_info(Refs, NewStat), Vars1)
+ ; set__empty(Refs) ->
+ Vars1 = Vars0
+ ;
+ map__set(Vars0, V, var_info(Refs, none), Vars1)
),
code_exprn__clobber_regs_2(Rest, Critical, OldVars, Vars1, Vars).
@@ -401,7 +504,7 @@
code_exprn__rval_depends_on_reg(lval(Lval), Vars) :-
code_exprn__lval_depends_on_reg(Lval, Vars).
code_exprn__rval_depends_on_reg(var(Var), Vars) :-
- map__lookup(Vars, Var, Stat),
+ map__lookup(Vars, Var, var_info(_, Stat)),
(
Stat = cached(Rval),
code_exprn__rval_depends_on_reg(Rval, Vars)
@@ -430,7 +533,7 @@
code_exprn__lval_depends_on_reg(reg(_, _), _Vars).
code_exprn__lval_depends_on_reg(lvar(Var), Vars) :-
- map__lookup(Vars, Var, Stat),
+ map__lookup(Vars, Var, var_info(_, Stat)),
(
Stat = cached(Rval),
code_exprn__rval_depends_on_reg(Rval, Vars)
@@ -483,6 +586,23 @@
Rvals = [Rval0 | Rvals1]
).
+:- pred code_exprn__filter_out_reg_depending_refs(var_refs, var_map, var_refs).
+:- mode code_exprn__filter_out_reg_depending_refs(in, in, out) is det.
+
+code_exprn__filter_out_reg_depending_refs(Refs0, Vars, Refs) :-
+ set__to_sorted_list(Refs0, RefList0),
+ list__map(lambda([Ref0::in, Ref::out] is det,
+ (
+ Ref0 = Placed - Lvals0,
+ set__to_sorted_list(Lvals0, LvalList0),
+ list__filter(lambda([Lval::in] is semidet,
+ \+ code_exprn__lval_depends_on_reg(Lval, Vars)),
+ LvalList0, LvalList),
+ set__list_to_set(LvalList, Lvals),
+ Ref = Placed - Lvals
+ )), RefList0, RefList),
+ set__list_to_set(RefList, Refs).
+
%------------------------------------------------------------------------------%
code_exprn__set_var_location(Var, Lval) -->
@@ -498,13 +618,33 @@
code_exprn__maybe_set_var_location(Var, Lval) -->
code_exprn__get_vars(Vars0),
- { set__singleton_set(Locs, lval(Lval)) },
- { map__set(Vars0, Var, evaled(Locs), Vars) },
+ { set__singleton_set(Rvals, lval(Lval)) },
+ { map__search(Vars0, Var, var_info(Locs0, _)) ->
+ Locs = Locs0
+ ;
+ set__init(Locs)
+ },
+ { map__set(Vars0, Var, var_info(Locs, evaled(Rvals)), Vars) },
code_exprn__set_vars(Vars),
code_exprn__add_lval_reg_dependencies(Lval).
%------------------------------------------------------------------------------%
+code_exprn__set_var_reference_location(Var, Lval) -->
+ code_exprn__get_vars(Vars0),
+ { set__singleton_set(Lvals, Lval) },
+ { map__search(Vars0, Var, var_info(Refs0, Stat0)) ->
+ Stat = Stat0,
+ set__insert(Refs0, no - Lvals, Refs)
+ ;
+ Stat = none,
+ set__singleton_set(Refs, no - Lvals)
+ },
+ { map__set(Vars0, Var, var_info(Refs, Stat), Vars) },
+ code_exprn__set_vars(Vars).
+
+%------------------------------------------------------------------------------%
+
code_exprn__lval_in_use(Lval) -->
code_exprn__get_vars(Vars),
code_exprn__get_regs(Regs),
@@ -515,12 +655,12 @@
{ code_exprn__lval_in_use_by_vars(Lval, VarStatList) }
).
-:- pred code_exprn__lval_in_use_by_vars(lval, assoc_list(var, var_stat)).
+:- pred code_exprn__lval_in_use_by_vars(lval, assoc_list(var, var_info)).
:- mode code_exprn__lval_in_use_by_vars(in, in) is semidet.
-code_exprn__lval_in_use_by_vars(Lval, VarStatList) :-
- list__member(VarStat, VarStatList),
- VarStat = _Var - Stat,
+code_exprn__lval_in_use_by_vars(Lval, VarInfoList) :-
+ list__member(VarInfo, VarInfoList),
+ VarInfo = _Var - var_info(Refs, Stat),
(
Stat = cached(Rval),
exprn_aux__rval_contains_lval(Rval, Lval)
@@ -528,6 +668,10 @@
Stat = evaled(Rvals),
set__member(Rval, Rvals),
exprn_aux__rval_contains_lval(Rval, Lval)
+ ;
+ set__member(_Placed - Lvals, Refs),
+ set__member(Lval0, Lvals),
+ exprn_aux__lval_contains_lval(Lval0, Lval)
).
%------------------------------------------------------------------------------%
@@ -537,15 +681,16 @@
code_exprn__clear_lval_of_synonyms(Lval) -->
code_exprn__get_vars(Vars),
- { map__to_assoc_list(Vars, VarStatList) },
- code_exprn__clear_lval_of_synonyms_1(VarStatList, Lval).
+ { map__to_assoc_list(Vars, VarInfoList) },
+ code_exprn__clear_lval_of_synonyms_1(VarInfoList, Lval).
-:- pred code_exprn__clear_lval_of_synonyms_1(assoc_list(var, var_stat), lval,
+:- pred code_exprn__clear_lval_of_synonyms_1(assoc_list(var, var_info), lval,
exprn_info, exprn_info).
:- mode code_exprn__clear_lval_of_synonyms_1(in, in, in, out) is det.
code_exprn__clear_lval_of_synonyms_1([], _) --> [].
-code_exprn__clear_lval_of_synonyms_1([Var - Stat | VarStatList], Lval) -->
+code_exprn__clear_lval_of_synonyms_1([Var - VarInfo0 | VarInfoList], Lval) -->
+ { VarInfo0 = var_info(Locs, Stat) },
(
{ Stat = cached(_) }
;
@@ -558,11 +703,14 @@
;
code_exprn__get_vars(Vars0),
{ set__sorted_list_to_set(RvalsList, Rvals) },
- { map__set(Vars0, Var, evaled(Rvals), Vars) },
+ { map__set(Vars0, Var, var_info(Locs, evaled(Rvals)),
+ Vars) },
code_exprn__set_vars(Vars)
)
+ ;
+ { Stat = none }
),
- code_exprn__clear_lval_of_synonyms_1(VarStatList, Lval).
+ code_exprn__clear_lval_of_synonyms_1(VarInfoList, Lval).
:- pred code_exprn__find_rvals_without_lval(list(rval), lval, list(rval)).
:- mode code_exprn__find_rvals_without_lval(in, in, out) is det.
@@ -726,29 +874,36 @@
code_exprn__var_becomes_dead(Var) -->
code_exprn__get_vars(Vars0),
- (
- { map__search(Vars0, Var, Stat) }
- ->
+ ( { map__search(Vars0, Var, var_info(_, Stat)) } ->
(
- { Stat = cached(Rval0) },
- code_exprn__rem_rval_reg_dependencies(Rval0)
- ;
- { Stat = evaled(Rvals0) },
- { set__to_sorted_list(Rvals0, RvalList0) },
- code_exprn__rem_rval_list_reg_dependencies(RvalList0),
- code_exprn__get_options(ExprnOpts),
(
- { code_exprn__member_expr_is_constant(RvalList0,
- Vars0, ExprnOpts, Rval7) }
- ->
- { Rval0 = Rval7 }
+ { Stat = cached(Rval0) },
+ code_exprn__rem_rval_reg_dependencies(Rval0)
;
- { code_exprn__select_rval(RvalList0, Rval0) }
+ { Stat = evaled(Rvals0) },
+ { set__to_sorted_list(Rvals0, RvalList0) },
+ code_exprn__rem_rval_list_reg_dependencies(
+ RvalList0),
+ code_exprn__get_options(ExprnOpts),
+ (
+ { code_exprn__member_expr_is_constant(
+ RvalList0, Vars0, ExprnOpts,
+ Rval7) }
+ ->
+ { Rval0 = Rval7 }
+ ;
+ { code_exprn__select_rval(RvalList0,
+ Rval0) }
+ )
)
- ),
- { map__delete(Vars0, Var, Vars1) },
- code_exprn__set_vars(Vars1),
- code_exprn__update_dependent_vars(Var, Rval0)
+ ->
+ { map__delete(Vars0, Var, Vars1) },
+ code_exprn__set_vars(Vars1),
+ code_exprn__update_dependent_vars(Var, Rval0)
+ ;
+ % Stat = none
+ []
+ )
;
% XXX When we make the code generator tighter,
% we can reinstate this sanity check. In particular,
@@ -774,13 +929,13 @@
{ map__from_assoc_list(VarList, Vars) },
code_exprn__set_vars(Vars).
-:- pred code_exprn__update_dependent_vars_2(assoc_list(var, var_stat),
- var, rval, assoc_list(var, var_stat), exprn_info, exprn_info).
+:- pred code_exprn__update_dependent_vars_2(assoc_list(var, var_info),
+ var, rval, assoc_list(var, var_info), exprn_info, exprn_info).
:- mode code_exprn__update_dependent_vars_2(in, in, in, out, in, out) is det.
code_exprn__update_dependent_vars_2([], _Var, _Rval, []) --> [].
-code_exprn__update_dependent_vars_2([V - Stat0 | Rest0], Var, Rval,
- [V - Stat | Rest]) -->
+code_exprn__update_dependent_vars_2([V - var_info(Locs, Stat0) | Rest0], Var,
+ Rval, [V - var_info(Locs, Stat) | Rest]) -->
(
{ Stat0 = cached(Exprn0) },
{ exprn_aux__rval_contains_rval(Exprn0, var(Var)) }
@@ -806,7 +961,7 @@
{ set__sorted_list_to_set(RvalList, Rvals) },
{ Stat = evaled(Rvals) }
;
- % Stat0 = cached(Exprn), \+ contains
+ % Stat0 = (cached(Exprn), \+ contains) ; none
{ Stat = Stat0 }
),
code_exprn__update_dependent_vars_2(Rest0, Var, Rval, Rest).
@@ -890,6 +1045,20 @@
code_exprn__select_stackvar(Rs, Rval)
).
+:- pred code_exprn__select_lval(set(lval), lval).
+:- mode code_exprn__select_lval(in, out) is det.
+
+code_exprn__select_lval(Lvals, Lval) :-
+ set__to_sorted_list(Lvals, LvalList),
+ Lambda = lambda([L::in, R::out] is det, ( R = lval(L) )),
+ list__map(Lambda, LvalList, RvalList),
+ code_exprn__select_rval(RvalList, Rval0),
+ ( Rval0 = lval(Lval0) ->
+ Lval = Lval0
+ ;
+ error("code_exprn__select_lval: something went wrong")
+ ).
+
%------------------------------------------------------------------------------%
:- pred code_exprn__expr_is_constant(rval, var_map, exprn_opts, rval).
@@ -918,7 +1087,7 @@
code_exprn__args_are_constant(Args0, Vars, ExprnOpts, Args).
code_exprn__expr_is_constant(var(Var), Vars, ExprnOpts, Rval) :-
- map__search(Vars, Var, Stat),
+ map__search(Vars, Var, var_info(_, Stat)),
(
Stat = cached(Rval0),
code_exprn__expr_is_constant(Rval0, Vars, ExprnOpts, Rval)
@@ -960,22 +1129,37 @@
code_exprn__cache_exprn(Var, Rval) -->
code_exprn__get_vars(Vars0),
+ { map__search(Vars0, Var, var_info(Locs0, Stat0)) ->
+ Locs = Locs0,
+ Stat = Stat0
+ ;
+ set__init(Locs),
+ Stat = none
+ },
(
- { map__search(Vars0, Var, _) }
+ { Stat \= none }
->
code_exprn__get_var_name(Var, Name),
- { string__append("code_exprn__cache_exprn: existing definition of variable ", Name, Msg) },
+ { term__var_to_int(Var, Num) },
+ { string__int_to_string(Num, NumStr) },
+ { string__append_list([
+ "code_exprn__cache_exprn:",
+ "existing definition of variable ",
+ Name, " (", NumStr, ")"
+ ], Msg) },
{ error(Msg) }
;
code_exprn__add_rval_reg_dependencies(Rval),
- (
- { exprn_aux__vars_in_rval(Rval, []) }
+ {
+ exprn_aux__vars_in_rval(Rval, [])
->
- { set__singleton_set(Rvals, Rval) },
- { map__det_insert(Vars0, Var, evaled(Rvals), Vars) }
+ set__singleton_set(Rvals, Rval),
+ map__set(Vars0, Var,
+ var_info(Locs, evaled(Rvals)), Vars)
;
- { map__det_insert(Vars0, Var, cached(Rval), Vars) }
- ),
+ map__set(Vars0, Var,
+ var_info(Locs, cached(Rval)), Vars)
+ },
code_exprn__set_vars(Vars)
).
@@ -982,8 +1166,14 @@
%------------------------------------------------------------------------------%
code_exprn__place_vars([], empty) --> [].
-code_exprn__place_vars([Var - Lval | StoreMap], Code) -->
- code_exprn__place_var(Var, Lval, FirstCode),
+code_exprn__place_vars([Var - store_info(ValOrRef, Lval) | StoreMap], Code) -->
+ (
+ { ValOrRef = val },
+ code_exprn__place_var(Var, Lval, FirstCode)
+ ;
+ { ValOrRef = ref },
+ code_exprn__place_var_reference(Var, Lval, FirstCode)
+ ),
code_exprn__place_vars(StoreMap, RestCode),
{ Code = tree(FirstCode, RestCode) }.
@@ -995,6 +1185,14 @@
;
{ Stat = evaled(Rvals) },
code_exprn__place_evaled(Rvals, Var, Lval, Code)
+ ;
+ { Stat = none },
+ code_exprn__get_var_name(Var, Name),
+ { term__var_to_int(Var, Num) },
+ { string__int_to_string(Num, NumStr) },
+ { string__append_list(["code_exprn__place_var: variable ",
+ Name, " (", NumStr, ") has no value"], Msg) },
+ { error(Msg) }
).
:- pred code_exprn__place_cached(rval, var, lval, code_tree,
@@ -1008,19 +1206,20 @@
->
{ error("code_exprn__place_var: cached exprn with no vars!") }
;
- % if the variable already has its value stored in the
- % right place, we don't need to generate any code
+ % If the variable already has its value stored in the
+ % right place, we don't need to generate any code.
{ Rval0 = var(Var1) },
- { map__search(Vars0, Var1, Stat0) },
+ { map__search(Vars0, Var1, var_info(_, Stat0)) },
{ Stat0 = evaled(VarRvals) },
{ set__member(lval(Lval), VarRvals) }
->
- % but we do need to reserve the registers
+ % But we do need to reserve the registers
% needed to access Lval
code_exprn__add_lval_reg_dependencies(Lval),
- { map__det_update(Vars0, Var, Stat0, Vars) },
+ { map__lookup(Vars0, Var, var_info(Locs, _)) },
+ { map__det_update(Vars0, Var, var_info(Locs, Stat0), Vars) },
code_exprn__set_vars(Vars),
- { Code = empty }
+ code_exprn__place_var_in_references(Var, Code)
;
% If the value of the variable is a constant or
% is built up by operations involving only constants,
@@ -1029,12 +1228,59 @@
{ code_exprn__expr_is_constant(Rval0, Vars0, ExprnOpts, Rval) }
->
code_exprn__place_exprn(yes(Lval), yes(Var), Rval, yes, yes,
- _, Code)
+ _, Code0),
+ code_exprn__place_var_in_references(Var, Code1),
+ { Code = tree(Code0, Code1) }
;
code_exprn__place_exprn(yes(Lval), yes(Var), Rval0, no, no,
- _, Code)
+ _, Code0),
+ code_exprn__place_var_in_references(Var, Code1),
+ { Code = tree(Code0, Code1) }
+ ).
+
+% Remove from the set of references any references that are in Lvals0.
+
+:- pred code_exprn__remove_lval_references(var_refs, set(lval), var_refs).
+:- mode code_exprn__remove_lval_references(in, in, out) is det.
+
+code_exprn__remove_lval_references(Refs0, Lvals0, Refs) :-
+ set__to_sorted_list(Refs0, RefsList0),
+ Filter = lambda([X::in] is semidet,
+ (
+ X = _ - Lvals1,
+ set__member(L, Lvals0),
+ set__member(L, Lvals1)
+ )),
+ list__filter(Filter, RefsList0, RefsList),
+ set__sorted_list_to_set(RefsList, Refs).
+
+code_exprn__place_var_in_references(Var, Code) -->
+ code_exprn__get_vars(Vars0),
+ { map__lookup(Vars0, Var, var_info(Refs0, Stat)) },
+
+ % Remove an lval from the set and recursively call place_var.
+ ( { get_next_ref_to_place(Refs0, Lvals, Refs1) } ->
+ { code_exprn__remove_lval_references(Refs1, Lvals, Refs2) },
+ { set__insert(Refs2, yes - Lvals, Refs) },
+ { map__det_update(Vars0, Var, var_info(Refs, Stat), Vars) },
+ code_exprn__set_vars(Vars),
+ { code_exprn__select_lval(Lvals, Lval) },
+ code_exprn__place_var(Var, mem_ref(lval(Lval)), Code)
+ ;
+ { Code = empty }
).
+:- pred get_next_ref_to_place(var_refs, set(lval), var_refs).
+:- mode get_next_ref_to_place(in, out, out) is semidet.
+
+get_next_ref_to_place(Refs0, Lvals, Refs) :-
+ set__to_sorted_list(Refs0, RefList0),
+ list__takewhile(lambda([X::in] is semidet, X = yes - _),
+ RefList0, RefList1, [no - Lvals | RefList2]),
+ list__append(RefList1, RefList2, RefList),
+ set__sorted_list_to_set(RefList, Refs).
+
+
:- pred code_exprn__place_evaled(set(rval), var, lval, code_tree,
exprn_info, exprn_info).
:- mode code_exprn__place_evaled(in, in, in, out, in, out) is det.
@@ -1045,8 +1291,9 @@
{ set__member(lval(Lval), Rvals0) }
->
code_exprn__get_vars(Vars1),
+ { map__lookup(Vars1, Var, var_info(Refs, _)) },
{ Stat = evaled(Rvals0) },
- { map__set(Vars1, Var, Stat, Vars) },
+ { map__set(Vars1, Var, var_info(Refs, Stat), Vars) },
code_exprn__set_vars(Vars),
{ Code = empty }
;
@@ -1092,7 +1339,7 @@
% If the variable already has its value stored in an
% acceptable place, we don't need to generate any code.
{ Rval0 = var(Var1) },
- { map__search(Vars0, Var1, Stat0) },
+ { map__search(Vars0, Var1, var_info(_, Stat0)) },
{ Stat0 = evaled(VarRvals) },
{ set__to_sorted_list(VarRvals, RvalList) },
{
@@ -1222,6 +1469,39 @@
%------------------------------------------------------------------------------%
+code_exprn__place_var_reference(Var, Lval, Code) -->
+ code_exprn__get_vars(Vars0),
+ (
+ { map__search(Vars0, Var, var_info(Refs0, Stat)) },
+
+ % XXX for now we only allow one reference per variable.
+ { set__singleton_set(Refs0, Placed - Lvals0) }
+ ->
+ ( { set__member(Lval, Lvals0) } ->
+ { Code = empty }
+ ;
+ { code_exprn__select_lval(Lvals0, SelectedLval) },
+ code_exprn__place_exprn(yes(Lval), no,
+ lval(SelectedLval), no, no, _Lval, Code),
+ code_exprn__get_vars(Vars1),
+ { set__insert(Lvals0, Lval, Lvals) },
+ { set__delete(Refs0, Placed - Lvals0, Refs1) },
+ { set__insert(Refs1, Placed - Lvals, Refs) },
+ { map__set(Vars1, Var, var_info(Refs, Stat), Vars) },
+ code_exprn__set_vars(Vars)
+ )
+ ;
+ code_exprn__get_var_name(Var, Name),
+ { term__var_to_int(Var, Num) },
+ { string__int_to_string(Num, NumStr) },
+ { string__append_list([
+ "code_exprn__place_var_reference: variable ",
+ Name, " (", NumStr, ") has 0 or >1 references"], Msg) },
+ { error(Msg) }
+ ).
+
+%------------------------------------------------------------------------------%
+
:- pred code_exprn__find_real_creates(list(maybe(rval)), list(rval),
exprn_info, exprn_info).
:- mode code_exprn__find_real_creates(in, out, in, out) is det.
@@ -1422,6 +1702,33 @@
{ Rval = lval(Lval) }
).
+code_exprn__produce_ref_in_reg_or_stack(Var, Lval, Code) -->
+ code_exprn__get_vars(Vars0),
+ (
+ { map__search(Vars0, Var, var_info(RefLocs0, Stat)) },
+ { set__singleton_set(RefLocs0, Placed - Lvals0) }
+ ->
+ (
+ { set__to_sorted_list(Lvals0, LvalList) },
+ { code_exprn__select_reg_or_stack_lval(LvalList, Lval0)}
+ ->
+ { Code = empty },
+ { Lval = Lval0 },
+ { Vars = Vars0 }
+ ;
+ code_exprn__select_preferred_lval(Var, Lval),
+ code_exprn__place_var_reference(Var, Lval, Code),
+ { set__insert(Lvals0, Lval, Lvals) },
+ { set__singleton_set(RefLocs, Placed - Lvals) },
+ { map__det_update(Vars0, Var, var_info(RefLocs, Stat),
+ Vars) }
+ )
+ ;
+ { error("code_exprn__produce_ref_in_reg_or_stack: internal error") }
+ ),
+ code_exprn__set_vars(Vars).
+
+
%------------------------------------------------------------------------------%
:- pred code_exprn__select_reg_rval(list(rval), rval).
@@ -1447,6 +1754,18 @@
code_exprn__select_reg_or_stack_rval(Rvals0, Rval)
).
+:- pred code_exprn__select_reg_or_stack_lval(list(lval), lval).
+:- mode code_exprn__select_reg_or_stack_lval(in, out) is semidet.
+
+code_exprn__select_reg_or_stack_lval([Lval0 | Lvals0], Lval) :-
+ (
+ ( Lval0 = reg(_, _) ; Lval0 = stackvar(_) ; Lval0 = framevar(_) )
+ ->
+ Lval = Lval0
+ ;
+ code_exprn__select_reg_or_stack_lval(Lvals0, Lval)
+ ).
+
%------------------------------------------------------------------------------%
:- pred code_exprn__select_preferred_lval(var, lval, exprn_info, exprn_info).
@@ -1455,7 +1774,7 @@
code_exprn__select_preferred_lval(Var, Lval) -->
code_exprn__get_follow_vars(FollowVars),
(
- { map__search(FollowVars, Var, PrefLval) }
+ { map__search(FollowVars, Var, store_info(_, PrefLval)) }
->
(
\+ { unreal_lval(PrefLval) },
@@ -1475,7 +1794,7 @@
code_exprn__select_preferred_reg(Var, Lval) -->
code_exprn__get_follow_vars(FollowVars),
(
- { map__search(FollowVars, Var, PrefLval) },
+ { map__search(FollowVars, Var, store_info(_, PrefLval)) },
{ PrefLval = reg(_, _) }
->
(
@@ -1578,13 +1897,13 @@
{ Code = empty }
).
-:- pred code_exprn__relocate_lval(assoc_list(var, var_stat), lval, lval,
- assoc_list(var, var_stat), exprn_info, exprn_info).
+:- pred code_exprn__relocate_lval(assoc_list(var, var_info), lval, lval,
+ assoc_list(var, var_info), exprn_info, exprn_info).
:- mode code_exprn__relocate_lval(in, in, in, out, in, out) is det.
code_exprn__relocate_lval([], _OldVal, _NewVal, []) --> [].
-code_exprn__relocate_lval([V - Stat0 | Rest0], OldVal, NewVal,
- [V - Stat | Rest]) -->
+code_exprn__relocate_lval([V - var_info(Refs0, Stat0) | Rest0], OldVal, NewVal,
+ [V - var_info(Refs, Stat) | Rest]) -->
(
{ Stat0 = cached(Exprn0) },
(
@@ -1605,7 +1924,11 @@
NewVal, RvalsList),
{ set__sorted_list_to_set(RvalsList, Rvals) },
{ Stat = evaled(Rvals) }
+ ;
+ { Stat0 = none },
+ { Stat = none }
),
+ code_exprn__relocate_lval_in_refs(OldVal, NewVal, Refs0, Refs),
code_exprn__relocate_lval(Rest0, OldVal, NewVal, Rest).
:- pred code_exprn__relocate_lval_2(list(rval), lval, lval, list(rval),
@@ -1625,6 +1948,28 @@
),
code_exprn__relocate_lval_2(Rs0, OldVal, NewVal, Rs).
+:- pred code_exprn__relocate_lval_in_refs(lval, lval, var_refs, var_refs,
+ exprn_info, exprn_info).
+:- mode code_exprn__relocate_lval_in_refs(in, in, in, out, in, out) is det.
+
+code_exprn__relocate_lval_in_refs(Old, New, Refs0, Refs) -->
+ { set__to_sorted_list(Refs0, RefsList0) },
+ list__map_foldl(lambda([R0::in, R::out, Exprn0::in, Exprn::out] is det,
+ (
+ R0 = Placed - Lvals0,
+ set__to_sorted_list(Lvals0, LvalsList0),
+ list__map_foldl(lambda([L0::in, L::out, E0::in, E::out] is det,
+ (
+ exprn_aux__substitute_lval_in_lval(Old, New, L0, L),
+ code_exprn__rem_lval_reg_dependencies(L0, E0, E1),
+ code_exprn__add_lval_reg_dependencies(L, E1, E)
+ )), LvalsList0, LvalsList, Exprn0, Exprn),
+ set__list_to_set(LvalsList, Lvals),
+ R = Placed - Lvals
+ )), RefsList0, RefsList),
+ { set__list_to_set(RefsList, Refs) }.
+
+
%------------------------------------------------------------------------------%
:- pred code_exprn__get_var_status(var, var_stat, exprn_info, exprn_info).
@@ -1633,7 +1978,7 @@
code_exprn__get_var_status(Var, Stat) -->
code_exprn__get_vars(Vars0),
(
- { map__search(Vars0, Var, Stat0) }
+ { map__search(Vars0, Var, var_info(_, Stat0)) }
->
{ Stat = Stat0 }
;
@@ -1654,7 +1999,12 @@
code_exprn__get_vars(Vars0),
{ set__list_to_set(RvalList, Rvals) },
{ Stat = evaled(Rvals) },
- { map__set(Vars0, Var, Stat, Vars) },
+ { map__search(Vars0, Var, var_info(Refs0, _)) ->
+ Refs = Refs0
+ ;
+ set__init(Refs)
+ },
+ { map__set(Vars0, Var, var_info(Refs, Stat), Vars) },
code_exprn__set_vars(Vars).
:- pred code_exprn__maybe_add_evaled(maybe(var), rval, exprn_info, exprn_info).
@@ -1663,7 +2013,7 @@
code_exprn__maybe_add_evaled(no, _) --> [].
code_exprn__maybe_add_evaled(yes(Var), NewRval) -->
code_exprn__get_vars(Vars0),
- { map__lookup(Vars0, Var, Stat0) },
+ { map__lookup(Vars0, Var, var_info(Locs0, Stat0)) },
{
Stat0 = evaled(Rvals0),
set__insert(Rvals0, NewRval, Rvals)
@@ -1670,11 +2020,24 @@
;
Stat0 = cached(_),
set__singleton_set(Rvals, NewRval)
+ ;
+ Stat0 = none,
+ error("code_exprn__maybe_add_evaled: var not cached or evaled")
},
{ Stat = evaled(Rvals) },
- { map__set(Vars0, Var, Stat, Vars) },
+ { map__set(Vars0, Var, var_info(Locs0, Stat), Vars) },
code_exprn__set_vars(Vars).
+:- pred code_exprn__remove_rval_from_lvals(rval, set(lval), set(lval)).
+:- mode code_exprn__remove_rval_from_lvals(in, in, out) is det.
+
+code_exprn__remove_rval_from_lvals(Rval, Lvals0, Lvals) :-
+ ( Rval = lval(Lval) ->
+ set__delete(Lvals0, Lval, Lvals)
+ ;
+ Lvals = Lvals0
+ ).
+
%------------------------------------------------------------------------------%
% Warning: if you get a reg, you must mark it as in use yourself.
@@ -1787,11 +2150,11 @@
set__to_sorted_list(Acquired, ARegs),
code_exprn__max_reg_in_use_lvals(ARegs, Max2, Max).
-:- pred code_exprn__max_reg_in_use_vars(list(var_stat), int, int).
+:- pred code_exprn__max_reg_in_use_vars(list(var_info), int, int).
:- mode code_exprn__max_reg_in_use_vars(in, in, out) is det.
code_exprn__max_reg_in_use_vars([], Max, Max).
-code_exprn__max_reg_in_use_vars([Stat | Stats], Max0, Max) :-
+code_exprn__max_reg_in_use_vars([var_info(Refs, Stat) | Infos], Max0, Max) :-
(
Stat = evaled(RvalSet),
set__to_sorted_list(RvalSet, Rvals),
@@ -1799,8 +2162,12 @@
;
Stat = cached(Rval),
code_exprn__max_reg_in_use_rvals([Rval], Max0, Max1)
+ ;
+ Stat = none,
+ Max1 = Max0
),
- code_exprn__max_reg_in_use_vars(Stats, Max1, Max).
+ code_exprn__max_reg_in_use_refs(Refs, Max1, Max2),
+ code_exprn__max_reg_in_use_vars(Infos, Max2, Max).
:- pred code_exprn__max_reg_in_use_rvals(list(rval), int, int).
:- mode code_exprn__max_reg_in_use_rvals(in, in, out) is det.
@@ -1822,6 +2189,18 @@
code_exprn__lval_is_r_reg(reg(r, N), N).
+:- pred code_exprn__max_reg_in_use_refs(var_refs, int, int).
+:- mode code_exprn__max_reg_in_use_refs(in, in, out) is det.
+
+code_exprn__max_reg_in_use_refs(Refs, Max0, Max) :-
+ set__to_sorted_list(Refs, RefsList),
+ list__foldl(lambda([Ref::in, N0::in, N::out] is det,
+ (
+ Ref = _Placed - Lvals,
+ set__to_sorted_list(Lvals, LvalsList),
+ code_exprn__max_reg_in_use_lvals(LvalsList, N0, N)
+ )), RefsList, Max0, Max).
+
%------------------------------------------------------------------------------%
:- pred code_exprn__get_varset(varset, exprn_info, exprn_info).
@@ -1894,3 +2273,6 @@
%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%
+code_exprn__value_to_rval(value(Rval), Rval).
+
+code_exprn__reference_to_lval(reference(Lval), Lval).
Index: compiler/code_info.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/code_info.m,v
retrieving revision 1.211.2.10
diff -u -r1.211.2.10 code_info.m
--- 1.211.2.10 1998/06/17 04:12:07
+++ code_info.m 1998/06/22 01:02:40
@@ -804,7 +804,8 @@
code_info__make_vars_forward_dead(PostDeaths),
{ goal_info_get_post_births(GoalInfo, PostBirths) },
code_info__add_forward_live_vars(PostBirths),
- code_info__make_vars_forward_live(PostBirths),
+ { goal_info_get_refs(GoalInfo, Refs) },
+ code_info__make_vars_forward_live(PostBirths, Refs),
{ goal_info_get_instmap_delta(GoalInfo, InstMapDelta) },
code_info__apply_instmap_delta(InstMapDelta).
@@ -1138,6 +1139,8 @@
:- implementation.
+:- import_module inst_match.
+
:- type fail_stack == stack(failure_cont).
:- type failure_cont
@@ -1161,7 +1164,7 @@
:- type is_known ---> known ; unknown.
-:- type resume_map == map(var, set(rval)).
+:- type resume_map == map(var, set(val_or_ref)).
:- type resume_maps
---> orig_only(resume_map, code_addr)
@@ -1306,7 +1309,11 @@
code_info__get_stack_slots(StackSlots),
{ map__select(StackSlots, ResumeVars, StackMap0) },
{ map__to_assoc_list(StackMap0, StackList0) },
- { code_info__tweak_stacklist(StackList0, StackList) },
+ code_info__get_instmap(InstMap),
+ code_info__get_inst_table(InstTable),
+ code_info__get_module_info(ModuleInfo),
+ { code_info__stacklist_to_valrefs(StackList0, InstMap,
+ InstTable, ModuleInfo, StackList) },
{ map__from_assoc_list(StackList, StackMap) },
{ ResumeMaps = stack_only(StackMap, StackAddr) }
;
@@ -1315,7 +1322,11 @@
code_info__get_stack_slots(StackSlots),
{ map__select(StackSlots, ResumeVars, StackMap0) },
{ map__to_assoc_list(StackMap0, StackList0) },
- { code_info__tweak_stacklist(StackList0, StackList) },
+ code_info__get_instmap(InstMap),
+ code_info__get_inst_table(InstTable),
+ code_info__get_module_info(ModuleInfo),
+ { code_info__stacklist_to_valrefs(StackList0, InstMap,
+ InstTable, ModuleInfo, StackList) },
{ map__from_assoc_list(StackList, StackMap) },
{ ResumeMaps = orig_and_stack(OrigMap, OrigAddr,
StackMap, StackAddr) }
@@ -1325,7 +1336,11 @@
code_info__get_stack_slots(StackSlots),
{ map__select(StackSlots, ResumeVars, StackMap0) },
{ map__to_assoc_list(StackMap0, StackList0) },
- { code_info__tweak_stacklist(StackList0, StackList) },
+ code_info__get_instmap(InstMap),
+ code_info__get_inst_table(InstTable),
+ code_info__get_module_info(ModuleInfo),
+ { code_info__stacklist_to_valrefs(StackList0, InstMap,
+ InstTable, ModuleInfo, StackList) },
{ map__from_assoc_list(StackList, StackMap) },
{ ResumeMaps = stack_and_orig(StackMap, StackAddr,
OrigMap, OrigAddr) }
@@ -1333,7 +1348,7 @@
code_info__push_failure_cont(failure_cont(FailContInfo, ResumeMaps)),
{ ModContCode = tree(OrigCode, TempFrameCode) }.
-:- pred code_info__produce_resume_vars(list(var), map(var, set(rval)),
+:- pred code_info__produce_resume_vars(list(var), map(var, set(val_or_ref)),
code_tree, code_info, code_info).
:- mode code_info__produce_resume_vars(in, out, out, in, out) is det.
@@ -1341,19 +1356,34 @@
{ map__init(Map) }.
code_info__produce_resume_vars([V | Vs], Map, Code) -->
code_info__produce_resume_vars(Vs, Map0, Code0),
- code_info__produce_variable_in_reg_or_stack(V, Code1, Rval),
- { set__singleton_set(Rvals, Rval) },
- { map__set(Map0, V, Rvals, Map) },
+ ( code_info__var_is_free_alias(V) ->
+ code_info__produce_reference_in_reg_or_stack(V, Code1, Lval),
+ { set__singleton_set(ValRefs, reference(Lval)) }
+ ;
+ code_info__produce_variable_in_reg_or_stack(V, Code1, Rval),
+ { set__singleton_set(ValRefs, value(Rval)) }
+ ),
+ { map__set(Map0, V, ValRefs, Map) },
{ Code = tree(Code0, Code1) }.
-:- pred code_info__tweak_stacklist(assoc_list(var, lval),
- assoc_list(var, set(rval))).
-:- mode code_info__tweak_stacklist(in, out) is det.
-
-code_info__tweak_stacklist([], []).
-code_info__tweak_stacklist([V - L | Rest0], [V - Rs | Rest]) :-
- set__singleton_set(Rs, lval(L)),
- code_info__tweak_stacklist(Rest0, Rest).
+% Use the instmap to work out which stack slots are values and which are
+% references.
+:- pred code_info__stacklist_to_valrefs(assoc_list(var, lval), instmap,
+ inst_table, module_info, assoc_list(var, set(val_or_ref))).
+:- mode code_info__stacklist_to_valrefs(in, in, in, in, out) is det.
+
+code_info__stacklist_to_valrefs([], _, _, _, []).
+code_info__stacklist_to_valrefs([V - L | Rest0], InstMap, InstTable,
+ ModuleInfo, [V - Rs | Rest]) :-
+ instmap__lookup_var(InstMap, V, Inst),
+ ( inst_is_free_alias(Inst, InstTable, ModuleInfo) ->
+ VVal = reference(L)
+ ;
+ VVal = value(lval(L))
+ ),
+ set__singleton_set(Rs, VVal),
+ code_info__stacklist_to_valrefs(Rest0, InstMap, InstTable,
+ ModuleInfo, Rest).
%---------------------------------------------------------------------------%
@@ -1582,8 +1612,8 @@
error("code_info__generate_resume_setup: non-label!")
).
-:- pred code_info__place_resume_vars(assoc_list(var, set(rval)), code_tree,
- code_info, code_info).
+:- pred code_info__place_resume_vars(assoc_list(var, set(val_or_ref)),
+ code_tree, code_info, code_info).
:- mode code_info__place_resume_vars(in, out, in, out) is det.
code_info__place_resume_vars([], empty) --> [].
@@ -1593,14 +1623,16 @@
{ Code = tree(FirstCode, RestCode) },
code_info__place_resume_vars(Rest, RestCode).
-:- pred code_info__place_resume_var(var, list(rval), code_tree,
+:- pred code_info__place_resume_var(var, list(val_or_ref), code_tree,
code_info, code_info).
:- mode code_info__place_resume_var(in, in, out, in, out) is det.
code_info__place_resume_var(_Var, [], empty) --> [].
code_info__place_resume_var(Var, [Target | Targets], Code) -->
- ( { Target = lval(TargetLval) } ->
+ ( { Target = value(lval(TargetLval)) } ->
code_info__place_var(Var, TargetLval, FirstCode)
+ ; { Target = reference(RefLval) } ->
+ code_info__place_var_reference(Var, RefLval, FirstCode)
;
{ error("code_info__place_resume_var: not lval") }
),
@@ -1611,7 +1643,8 @@
% Remember that the variables in the map are available in their
% associated rvals; forget about all other variables.
-:- pred code_info__set_var_locations(map(var, set(rval)), code_info, code_info).
+:- pred code_info__set_var_locations(map(var, set(val_or_ref)), code_info,
+ code_info).
:- mode code_info__set_var_locations(in, in, out) is det.
code_info__set_var_locations(Map) -->
@@ -1621,19 +1654,19 @@
{ code_exprn__reinit_state(List, Exprn0, Exprn) },
code_info__set_exprn_info(Exprn).
-:- pred code_info__flatten_varlval_list(assoc_list(var, set(rval)),
- assoc_list(var, rval)).
+:- pred code_info__flatten_varlval_list(assoc_list(var, set(val_or_ref)),
+ assoc_list(var, val_or_ref)).
:- mode code_info__flatten_varlval_list(in, out) is det.
code_info__flatten_varlval_list([], []).
-code_info__flatten_varlval_list([V - Rvals | Rest0], All) :-
+code_info__flatten_varlval_list([V - Vvals | Rest0], All) :-
code_info__flatten_varlval_list(Rest0, Rest),
- set__to_sorted_list(Rvals, RvalList),
- code_info__flatten_varlval_list_2(RvalList, V, Rest1),
+ set__to_sorted_list(Vvals, VvalList),
+ code_info__flatten_varlval_list_2(VvalList, V, Rest1),
list__append(Rest1, Rest, All).
-:- pred code_info__flatten_varlval_list_2(list(rval), var,
- assoc_list(var, rval)).
+:- pred code_info__flatten_varlval_list_2(list(val_or_ref), var,
+ assoc_list(var, val_or_ref)).
:- mode code_info__flatten_varlval_list_2(in, in, out) is det.
code_info__flatten_varlval_list_2([], _V, []).
@@ -1772,10 +1805,23 @@
)
}.
-:- pred code_info__match_resume_loc(resume_map, resume_map).
+:- pred code_info__match_resume_loc(resume_map, map(var, set(rval))).
:- mode code_info__match_resume_loc(in, in) is semidet.
-code_info__match_resume_loc(Map, Locations0) :-
+code_info__match_resume_loc(Map0, Locations0) :-
+ % Convert resume_map to map(var, set(rval)), removing all reference()'s.
+ map__to_assoc_list(Map0, AL0),
+ Filter = lambda([V::in, R::out] is semidet, (
+ V = Variable - VVals,
+ set__to_sorted_list(VVals, Vs),
+ list__filter_map(code_exprn__value_to_rval, Vs, Rs),
+ Rs \= [],
+ set__sorted_list_to_set(Rs, RvalsSet),
+ R = Variable - RvalsSet
+ )),
+ list__filter_map(Filter, AL0, AL),
+ map__from_assoc_list(AL, Map),
+
map__keys(Map, KeyList),
set__list_to_set(KeyList, Keys),
map__select(Locations0, Keys, Locations),
@@ -2198,8 +2244,9 @@
% Make these variables appear magically live.
% We don't care where they are put.
-:- pred code_info__make_vars_forward_live(set(var), code_info, code_info).
-:- mode code_info__make_vars_forward_live(in, in, out) is det.
+:- pred code_info__make_vars_forward_live(set(var), set(var),
+ code_info, code_info).
+:- mode code_info__make_vars_forward_live(in, in, in, out) is det.
code_info__get_known_variables(VarList) -->
code_info__get_forward_live_vars(ForwardLiveVars),
@@ -2221,29 +2268,34 @@
{ set__difference(Liveness0, Deaths, Liveness) },
code_info__set_forward_live_vars(Liveness).
-code_info__make_vars_forward_live(Vars) -->
+code_info__make_vars_forward_live(Vars, RefVars) -->
code_info__get_stack_slots(StackSlots),
code_info__get_exprn_info(Exprn0),
{ set__to_sorted_list(Vars, VarList) },
- { code_info__make_vars_forward_live_2(VarList, StackSlots, 1,
+ { code_info__make_vars_forward_live_2(VarList, RefVars, StackSlots, 1,
Exprn0, Exprn) },
code_info__set_exprn_info(Exprn).
-:- pred code_info__make_vars_forward_live_2(list(var), stack_slots, int,
- exprn_info, exprn_info).
-:- mode code_info__make_vars_forward_live_2(in, in, in, in, out) is det.
-
-code_info__make_vars_forward_live_2([], _, _, Exprn, Exprn).
-code_info__make_vars_forward_live_2([V | Vs], StackSlots, N0, Exprn0, Exprn) :-
- ( map__search(StackSlots, V, Lval0) ->
+:- pred code_info__make_vars_forward_live_2(list(var), set(var), stack_slots,
+ int, exprn_info, exprn_info).
+:- mode code_info__make_vars_forward_live_2(in, in, in, in, in, out) is det.
+
+code_info__make_vars_forward_live_2([], _, _, _, Exprn, Exprn).
+code_info__make_vars_forward_live_2([V | Vs], RefVars, StackSlots, N0) -->
+ =(Exprn0),
+ { map__search(StackSlots, V, Lval0) ->
Lval = Lval0,
N1 = N0
;
code_info__find_unused_reg(N0, Exprn0, N1),
Lval = reg(r, N1)
+ },
+ ( { set__member(V, RefVars)} ->
+ code_exprn__set_var_reference_location(V, Lval)
+ ;
+ code_exprn__maybe_set_var_location(V, Lval)
),
- code_exprn__maybe_set_var_location(V, Lval, Exprn0, Exprn1),
- code_info__make_vars_forward_live_2(Vs, StackSlots, N1, Exprn1, Exprn).
+ code_info__make_vars_forward_live_2(Vs, RefVars, StackSlots, N1).
:- pred code_info__find_unused_reg(int, exprn_info, int).
:- mode code_info__find_unused_reg(in, in, out) is det.
@@ -2492,6 +2544,9 @@
:- pred code_info__set_var_location(var, lval, code_info, code_info).
:- mode code_info__set_var_location(in, in, in, out) is det.
+:- pred code_info__set_var_reference_location(var, lval, code_info, code_info).
+:- mode code_info__set_var_reference_location(in, in, in, out) is det.
+
:- pred code_info__cache_expression(var, rval, code_info, code_info).
:- mode code_info__cache_expression(in, in, in, out) is det.
@@ -2498,9 +2553,18 @@
:- pred code_info__place_var(var, lval, code_tree, code_info, code_info).
:- mode code_info__place_var(in, in, out, in, out) is det.
+:- pred code_info__place_var_reference(var, lval, code_tree,
+ code_info, code_info).
+:- mode code_info__place_var_reference(in, in, out, in, out) is det.
+
:- pred code_info__produce_variable(var, code_tree, rval, code_info, code_info).
:- mode code_info__produce_variable(in, out, out, in, out) is det.
+:- pred code_info__produce_variable_in_references(var, code_tree,
+ code_info, code_info).
+:- mode code_info__produce_variable_in_references(in, out,
+ in, out) is det.
+
:- pred code_info__produce_variable_in_reg(var, code_tree, rval,
code_info, code_info).
:- mode code_info__produce_variable_in_reg(in, out, out, in, out) is det.
@@ -2567,17 +2631,33 @@
code_info, code_info).
:- mode code_info__save_variables_on_stack(in, out, in, out) is det.
+:- pred code_info__save_reference_on_stack(var, code_tree,
+ code_info, code_info).
+:- mode code_info__save_reference_on_stack(in, out, in, out) is det.
+
+:- pred code_info__var_is_free_alias(var, code_info, code_info).
+:- mode code_info__var_is_free_alias(in, in, out) is semidet.
+
:- pred code_info__max_reg_in_use(int, code_info, code_info).
:- mode code_info__max_reg_in_use(out, in, out) is det.
+:- pred code_info__stack_slots_to_store_map(stack_slots, store_map,
+ code_info, code_info).
+:- mode code_info__stack_slots_to_store_map(in, out, in, out) is det.
+
%---------------------------------------------------------------------------%
:- implementation.
-:- pred code_info__place_vars(assoc_list(var, set(rval)), code_tree,
+:- pred code_info__place_vars(assoc_list(var, set(val_or_ref)), code_tree,
code_info, code_info).
:- mode code_info__place_vars(in, out, in, out) is det.
+:- pred code_info__produce_reference_in_reg_or_stack(var, code_tree, lval,
+ code_info, code_info).
+:- mode code_info__produce_reference_in_reg_or_stack(in, out, out, in, out)
+ is det.
+
code_info__variable_locations(Locations) -->
code_info__get_exprn_info(Exprn),
{ code_exprn__get_varlocs(Exprn, Locations) }.
@@ -2587,6 +2667,11 @@
{ code_exprn__set_var_location(Var, Lval, Exprn0, Exprn) },
code_info__set_exprn_info(Exprn).
+code_info__set_var_reference_location(Var, Lval) -->
+ code_info__get_exprn_info(Exprn0),
+ { code_exprn__set_var_reference_location(Var, Lval, Exprn0, Exprn) },
+ code_info__set_exprn_info(Exprn).
+
code_info__cache_expression(Var, Rval) -->
code_info__get_exprn_info(Exprn0),
{ code_exprn__cache_exprn(Var, Rval, Exprn0, Exprn) },
@@ -2600,7 +2685,8 @@
code_info__place_vars([], empty) --> [].
code_info__place_vars([V - Rs | RestList], Code) -->
(
- { set__to_sorted_list(Rs, RList) },
+ { set__to_sorted_list(Rs, VList) },
+ { list__filter_map(code_exprn__value_to_rval, VList, RList) },
{ code_info__lval_in_rval_list(L, RList) }
->
code_info__place_var(V, L, ThisCode)
@@ -2610,6 +2696,11 @@
code_info__place_vars(RestList, RestCode),
{ Code = tree(ThisCode, RestCode) }.
+code_info__place_var_reference(Var, Lval, Code) -->
+ code_info__get_exprn_info(Exprn0),
+ { code_exprn__place_var_reference(Var, Lval, Code, Exprn0, Exprn) },
+ code_info__set_exprn_info(Exprn).
+
:- pred code_info__lval_in_rval_list(lval, list(rval)).
:- mode code_info__lval_in_rval_list(out, in) is semidet.
@@ -2625,6 +2716,11 @@
{ code_exprn__produce_var(Var, Rval, Code, Exprn0, Exprn) },
code_info__set_exprn_info(Exprn).
+code_info__produce_variable_in_references(Var, Code) -->
+ code_info__get_exprn_info(Exprn0),
+ { code_exprn__place_var_in_references(Var, Code, Exprn0, Exprn) },
+ code_info__set_exprn_info(Exprn).
+
code_info__produce_variable_in_reg(Var, Code, Rval) -->
code_info__get_exprn_info(Exprn0),
{ code_exprn__produce_var_in_reg(Var, Rval, Code, Exprn0, Exprn) },
@@ -2636,6 +2732,12 @@
Exprn0, Exprn) },
code_info__set_exprn_info(Exprn).
+code_info__produce_reference_in_reg_or_stack(Var, Code, Lval) -->
+ code_info__get_exprn_info(Exprn0),
+ { code_exprn__produce_ref_in_reg_or_stack(Var, Lval, Code,
+ Exprn0, Exprn) },
+ code_info__set_exprn_info(Exprn).
+
code_info__materialize_vars_in_rval(Rval0, Rval, Code) -->
code_info__get_exprn_info(Exprn0),
{ code_exprn__materialize_vars_in_rval(Rval0, Rval, Code,
@@ -2656,7 +2758,7 @@
code_info__get_exprn_info(Exprn0),
code_info__get_follow_vars(Follow),
(
- { map__search(Follow, Var, PrefLval) },
+ { map__search(Follow, Var, store_info(_, PrefLval)) },
{ PrefLval = reg(PrefRegType, PrefRegNum) }
->
{ code_exprn__acquire_reg_prefer_given(PrefRegType, PrefRegNum,
@@ -2697,17 +2799,16 @@
code_info__remake_with_store_map(StoreMap) -->
{ map__to_assoc_list(StoreMap, VarLvals) },
- { code_info__fixup_lvallist(VarLvals, VarRvals) },
+ { list__map(code_info__fixup_lval, VarLvals, VarRvals) },
code_info__get_exprn_info(Exprn0),
{ code_exprn__reinit_state(VarRvals, Exprn0, Exprn) },
code_info__set_exprn_info(Exprn).
-:- pred code_info__fixup_lvallist(assoc_list(var, lval), assoc_list(var, rval)).
-:- mode code_info__fixup_lvallist(in, out) is det.
+:- pred code_info__fixup_lval(pair(var, store_info), pair(var, val_or_ref)).
+:- mode code_info__fixup_lval(in, out) is det.
-code_info__fixup_lvallist([], []).
-code_info__fixup_lvallist([V - L | Ls], [V - lval(L) | Rs]) :-
- code_info__fixup_lvallist(Ls, Rs).
+code_info__fixup_lval(V - store_info(val, L), V - value(lval(L))).
+code_info__fixup_lval(V - store_info(ref, L), V - reference(L)).
%---------------------------------------------------------------------------%
@@ -2715,16 +2816,23 @@
code_info__setup_call([V - arg_info(Loc, Mode) | Rest], Direction, Code) -->
(
{
- Mode = top_in,
+ ( Mode = top_in ; Mode = ref_in ),
Direction = caller
;
- Mode = top_out,
+ ( Mode = top_out ; Mode = ref_out ),
Direction = callee
}
->
{ code_util__arg_loc_to_register(Loc, Reg) },
code_info__get_exprn_info(Exprn0),
- { code_exprn__place_var(V, Reg, Code0, Exprn0, Exprn1) },
+ ( { Mode = ref_in ; Mode = ref_out } ->
+ % (ref_in and caller) or (ref_out and callee)
+ { code_exprn__place_var_reference(V, Reg, Code0, Exprn0,
+ Exprn1) }
+ ;
+ % (top_in and caller) or (top_out and callee)
+ { code_exprn__place_var(V, Reg, Code0, Exprn0, Exprn1) }
+ ),
% We need to test that either the variable
% is live OR it occurs in the remaining arguments
% because of a bug in polymorphism.m which
@@ -2790,6 +2898,19 @@
code_info__save_variables_on_stack(Vars, RestCode),
{ Code = tree(FirstCode, RestCode) }.
+code_info__save_reference_on_stack(Var, Code) -->
+ code_info__get_variable_slot(Var, Slot),
+ code_info__get_exprn_info(Exprn0),
+ { code_exprn__place_var_reference(Var, Slot, Code, Exprn0, Exprn) },
+ code_info__set_exprn_info(Exprn).
+
+code_info__var_is_free_alias(Var) -->
+ code_info__get_instmap(InstMap),
+ code_info__get_inst_table(InstTable),
+ code_info__get_module_info(ModuleInfo),
+ { instmap__lookup_var(InstMap, Var, Inst) },
+ { inst_is_free_alias(Inst, InstTable, ModuleInfo) }.
+
code_info__max_reg_in_use(Max) -->
code_info__get_exprn_info(Exprn),
{ code_exprn__max_reg_in_use(Exprn, Max) }.
@@ -3150,4 +3271,14 @@
).
%---------------------------------------------------------------------------%
+
+code_info__stack_slots_to_store_map(StackSlots, StoreMap, CodeInfo, CodeInfo) :-
+ map__map_values(lambda([Var::in, Lval::in, StoreInfo::out] is det,
+ ( code_info__var_is_free_alias(Var, CodeInfo, _) ->
+ StoreInfo = store_info(ref, Lval)
+ ;
+ StoreInfo = store_info(val, Lval)
+ )), StackSlots, StoreMap).
+
+%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
Index: compiler/common.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/common.m,v
retrieving revision 1.44.4.7
diff -u -r1.44.4.7 common.m
--- 1.44.4.7 1998/06/05 08:43:26
+++ common.m 1998/06/22 01:02:43
@@ -373,9 +373,10 @@
simplify_info_get_module_info(Info0, ModuleInfo),
module_info_pred_proc_info(ModuleInfo, PredId,
ProcId, _, ProcInfo),
- proc_info_argmodes(ProcInfo, argument_modes(ArgInstTable, ArgModes)),
- common__partition_call_args(ModuleInfo, ArgInstTable, ArgModes, Args,
- InputArgs, OutputArgs)
+ proc_info_argmodes(ProcInfo,
+ argument_modes(ArgInstTable, ArgModes)),
+ common__partition_call_args(ModuleInfo, ArgInstTable, ArgModes,
+ Args, InputArgs, OutputArgs)
->
common__optimise_call_2(seen_call(PredId, ProcId), InputArgs,
OutputArgs, Goal0, GoalInfo, Goal, Info0, Info)
@@ -575,7 +576,7 @@
simplify_info_get_instmap(Info0, InstMap),
instmap__lookup_var(InstMap, FromVar, FromVarInst0),
- ( FromVarInst0 = free ->
+ ( FromVarInst0 = free(unique) ->
% This may mean that the variable was local
% to the first unification or call. In that
% case we need to recompute the instmap_deltas
Index: compiler/det_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/det_util.m,v
retrieving revision 1.12.4.6
diff -u -r1.12.4.6 det_util.m
--- 1.12.4.6 1998/03/26 00:34:05
+++ det_util.m 1998/06/22 01:02:51
@@ -172,11 +172,11 @@
bool % --fully-strict
).
-det_info_init(ModuleInfo, PredId, ProcId, IKT, Globals, DetInfo) :-
+det_info_init(ModuleInfo, PredId, ProcId, InstTable, Globals, DetInfo) :-
globals__lookup_bool_option(Globals, reorder_conj, ReorderConj),
globals__lookup_bool_option(Globals, reorder_disj, ReorderDisj),
globals__lookup_bool_option(Globals, fully_strict, FullyStrict),
- DetInfo = det_info(ModuleInfo, PredId, ProcId, IKT,
+ DetInfo = det_info(ModuleInfo, PredId, ProcId, InstTable,
ReorderConj, ReorderDisj, FullyStrict).
det_info_get_module_info(det_info(ModuleInfo, _, _, _, _, _, _), ModuleInfo).
Index: compiler/export.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/export.m,v
retrieving revision 1.13.4.5
diff -u -r1.13.4.5 export.m
--- 1.13.4.5 1998/06/05 08:43:58
+++ export.m 1998/06/22 01:02:52
@@ -376,6 +376,14 @@
;
Mode = top_unused,
InputArg = ""
+ ;
+ Mode = ref_in,
+ InputArg = ""
+ % XXX will need to change to support exporting pass-by-reference
+ % procedures.
+ ;
+ Mode = ref_out,
+ InputArg = ""
),
get_input_args(ATs, Num, TheRest),
string__append(InputArg, TheRest, Result).
@@ -404,6 +412,14 @@
;
Mode = top_unused,
OutputArg = ""
+ ;
+ Mode = ref_in,
+ OutputArg = ""
+ ;
+ Mode = ref_out,
+ OutputArg = ""
+ % XXX will need to change to support exporting pass-by-reference
+ % procedures.
),
copy_output_args(ATs, Num, TheRest),
string__append(OutputArg, TheRest, Result).
Index: compiler/exprn_aux.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/exprn_aux.m,v
retrieving revision 1.22.4.2
diff -u -r1.22.4.2 exprn_aux.m
--- 1.22.4.2 1998/03/03 00:24:44
+++ exprn_aux.m 1998/06/22 01:02:52
@@ -37,6 +37,9 @@
:- pred exprn_aux__rval_contains_lval(rval, lval).
:- mode exprn_aux__rval_contains_lval(in, in) is semidet.
+:- pred exprn_aux__lval_contains_lval(lval, lval).
+:- mode exprn_aux__lval_contains_lval(in, in) is semidet.
+
:- pred exprn_aux__rval_contains_rval(rval, rval).
:- mode exprn_aux__rval_contains_rval(in, in) is semidet.
:- mode exprn_aux__rval_contains_rval(in, out) is multidet.
@@ -57,6 +60,9 @@
:- pred exprn_aux__substitute_rvals_in_rval(assoc_list(rval, rval), rval, rval).
:- mode exprn_aux__substitute_rvals_in_rval(in, in, out) is det.
+:- pred exprn_aux__substitute_lval_in_lval(lval, lval, lval, lval).
+:- mode exprn_aux__substitute_lval_in_lval(in, in, in, out) is det.
+
:- pred exprn_aux__vars_in_lval(lval, list(var)).
:- mode exprn_aux__vars_in_lval(in, out) is det.
@@ -203,9 +209,6 @@
exprn_aux__rval_contains_lval(Rval1, Lval)
).
-:- pred exprn_aux__lval_contains_lval(lval, lval).
-:- mode exprn_aux__lval_contains_lval(in, in) is semidet.
-
exprn_aux__lval_contains_lval(Lval0, Lval) :-
(
Lval0 = Lval
@@ -414,9 +417,6 @@
MemRef = heap_ref(Rval, Tag, N)
).
-:- pred exprn_aux__substitute_lval_in_lval(lval, lval, lval, lval).
-:- mode exprn_aux__substitute_lval_in_lval(in, in, in, out) is det.
-
exprn_aux__substitute_lval_in_lval(OldLval, NewLval, Lval0, Lval) :-
(
Lval0 = OldLval
Index: compiler/follow_vars.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/follow_vars.m,v
retrieving revision 1.43.2.9
diff -u -r1.43.2.9 follow_vars.m
--- 1.43.2.9 1998/06/17 04:12:32
+++ follow_vars.m 1998/06/22 01:02:54
@@ -73,10 +73,10 @@
find_final_follow_vars_2([arg_info(Loc, Mode) | Args], [Var | Vars],
Follow0, Follow) :-
code_util__arg_loc_to_register(Loc, Reg),
- (
- Mode = top_out
- ->
- map__det_insert(Follow0, Var, Reg, Follow1)
+ ( Mode = top_out ->
+ map__det_insert(Follow0, Var, store_info(val, Reg), Follow1)
+ ; Mode = ref_out ->
+ map__det_insert(Follow0, Var, store_info(ref, Reg), Follow1)
;
Follow0 = Follow1
),
@@ -281,10 +281,10 @@
find_follow_vars_from_arginfo_2([arg_info(Loc, Mode) | Args], [Var | Vars],
Follow0, Follow) :-
code_util__arg_loc_to_register(Loc, Reg),
- (
- Mode = top_in
- ->
- map__set(Follow0, Var, Reg, Follow1)
+ ( Mode = top_in ->
+ map__set(Follow0, Var, store_info(val, Reg), Follow1)
+ ; Mode = ref_in ->
+ map__set(Follow0, Var, store_info(ref, Reg), Follow1)
;
Follow0 = Follow1
),
Index: compiler/higher_order.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/higher_order.m,v
retrieving revision 1.33.2.11
diff -u -r1.33.2.11 higher_order.m
--- 1.33.2.11 1998/06/17 04:12:42
+++ higher_order.m 1998/06/22 01:02:55
@@ -1216,7 +1216,7 @@
PredInstInfo = pred_inst_info(PredOrFunc,
argument_modes(CalledArgIT, UnCurriedArgModes), Detism),
Inst = ground(shared, yes(PredInstInfo)),
- Unimode = (free -> Inst) - (Inst -> Inst),
+ Unimode = (free(unique) -> Inst) - (Inst -> Inst),
Goal = unify(LVar, Rhs, Unimode, Unify, Context),
set__list_to_set([LVar | NewHeadVars0], NonLocals),
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_goal.m,v
retrieving revision 1.40.2.7
diff -u -r1.40.2.7 hlds_goal.m
--- 1.40.2.7 1998/06/17 04:12:44
+++ hlds_goal.m 1998/06/22 01:02:55
@@ -223,13 +223,13 @@
% The only legal lvals in the range are
% stackvars and framevars.
-:- type follow_vars == map(var, lval).
+:- type follow_vars == map(var, store_info).
% Advisory information about where variables
% ought to be put next. The legal range
% includes the nonexistent register r(-1),
% which indicates any available register.
-:- type store_map == map(var, lval).
+:- type store_map == map(var, store_info).
% Authoritative information about where
% variables must be put at the ends of
% branches of branched control structures.
@@ -239,6 +239,13 @@
% Apart from this, the legal range is
% the set of legal lvals.
+:- type store_info
+ ---> store_info(store_type, lval).
+
+:- type store_type
+ ---> val % Lval contains value of variable.
+ ; ref. % Lval contains pointer to variable location.
+
% Initially all unifications are represented as
% unify(var, unify_rhs, _, _, _), but mode analysis replaces
% these with various special cases (construct/deconstruct/assign/
@@ -438,9 +445,12 @@
set(var), % the post-birth set
set(var), % the pre-death set
set(var), % the post-death set
- % (all four are computed by liveness.m)
% NB for atomic goals, the post-deadness
% should be applied _before_ the goal
+ set(var), % the ref-vars set -- i.e. vars that are
+ % live but have not value yet, only a reference
+ % to where the value should be placed.
+ % (all five are computed by liveness.m)
determinism, % the overall determinism of the goal
% (computed during determinism analysis)
@@ -572,6 +582,12 @@
:- pred goal_info_set_post_deaths(hlds_goal_info, set(var), hlds_goal_info).
:- mode goal_info_set_post_deaths(in, in, out) is det.
+:- pred goal_info_get_refs(hlds_goal_info, set(var)).
+:- mode goal_info_get_refs(in, out) is det.
+
+:- pred goal_info_set_refs(hlds_goal_info, set(var), hlds_goal_info).
+:- mode goal_info_set_refs(in, in, out) is det.
+
:- pred goal_info_get_code_model(hlds_goal_info, code_model).
:- mode goal_info_get_code_model(in, out) is det.
@@ -746,12 +762,13 @@
set__init(PostBirths),
set__init(PreDeaths),
set__init(PostDeaths),
+ set__init(Refs),
instmap_delta_init_unreachable(InstMapDelta),
set__init(NonLocals),
term__context_init(Context),
set__init(Features),
GoalInfo = goal_info(PreBirths, PostBirths, PreDeaths, PostDeaths,
- Detism, InstMapDelta, Context, NonLocals, no, Features,
+ Refs, Detism, InstMapDelta, Context, NonLocals, no, Features,
no_resume_point, []).
goal_info_init(NonLocals, InstMapDelta, Detism, GoalInfo) :-
@@ -761,40 +778,44 @@
goal_info_set_determinism(GoalInfo2, Detism, GoalInfo).
goal_info_get_pre_births(GoalInfo, PreBirths) :-
- GoalInfo = goal_info(PreBirths, _, _, _, _, _, _, _, _, _, _, _).
+ GoalInfo = goal_info(PreBirths, _, _, _, _, _, _, _, _, _, _, _, _).
goal_info_get_post_births(GoalInfo, PostBirths) :-
- GoalInfo = goal_info(_, PostBirths, _, _, _, _, _, _, _, _, _, _).
+ GoalInfo = goal_info(_, PostBirths, _, _, _, _, _, _, _, _, _, _, _).
goal_info_get_pre_deaths(GoalInfo, PreDeaths) :-
- GoalInfo = goal_info(_, _, PreDeaths, _, _, _, _, _, _, _, _, _).
+ GoalInfo = goal_info(_, _, PreDeaths, _, _, _, _, _, _, _, _, _, _).
goal_info_get_post_deaths(GoalInfo, PostDeaths) :-
- GoalInfo = goal_info(_, _, _, PostDeaths, _, _, _, _, _, _, _, _).
+ GoalInfo = goal_info(_, _, _, PostDeaths, _, _, _, _, _, _, _, _, _).
+
+goal_info_get_refs(GoalInfo, Refs) :-
+ GoalInfo = goal_info(_, _, _, _, Refs, _, _, _, _, _, _, _, _).
goal_info_get_determinism(GoalInfo, Determinism) :-
- GoalInfo = goal_info(_, _, _, _, Determinism, _, _, _, _, _, _, _).
+ GoalInfo = goal_info(_, _, _, _, _, Determinism, _, _, _, _, _, _, _).
goal_info_get_instmap_delta(GoalInfo, InstMapDelta) :-
- GoalInfo = goal_info(_, _, _, _, _, InstMapDelta, _, _, _, _, _, _).
+ GoalInfo = goal_info(_, _, _, _, _, _, InstMapDelta, _, _, _, _, _, _).
goal_info_get_context(GoalInfo, Context) :-
- GoalInfo = goal_info(_, _, _, _, _, _, Context, _, _, _, _, _).
+ GoalInfo = goal_info(_, _, _, _, _, _, _, Context, _, _, _, _, _).
goal_info_get_nonlocals(GoalInfo, NonLocals) :-
- GoalInfo = goal_info(_, _, _, _, _, _, _, NonLocals, _, _, _, _).
+ GoalInfo = goal_info(_, _, _, _, _, _, _, _, NonLocals, _, _, _, _).
goal_info_get_follow_vars(GoalInfo, MaybeFollowVars) :-
- GoalInfo = goal_info(_, _, _, _, _, _, _, _, MaybeFollowVars, _, _, _).
+ GoalInfo = goal_info(_, _, _, _, _, _, _, _, _, MaybeFollowVars,
+ _, _, _).
goal_info_get_features(GoalInfo, Features) :-
- GoalInfo = goal_info(_, _, _, _, _, _, _, _, _, Features, _, _).
+ GoalInfo = goal_info(_, _, _, _, _, _, _, _, _, _, Features, _, _).
goal_info_get_resume_point(GoalInfo, ResumePoint) :-
- GoalInfo = goal_info(_, _, _, _, _, _, _, _, _, _, ResumePoint, _).
+ GoalInfo = goal_info(_, _, _, _, _, _, _, _, _, _, _, ResumePoint, _).
goal_info_get_goal_path(GoalInfo, GoalPath) :-
- GoalInfo = goal_info(_, _, _, _, _, _, _, _, _, _, _, GoalPath).
+ GoalInfo = goal_info(_, _, _, _, _, _, _, _, _, _, _, _, GoalPath).
% :- type hlds_goal_info
% ---> goal_info(
@@ -802,63 +823,68 @@
% B set(var), % the post-birth set
% C set(var), % the pre-death set
% D set(var), % the post-death set
-% E determinism, % the overall determinism of the goal
-% F instmap_delta, % the change in insts over this goal
-% G term__context,
-% H set(var), % the non-local vars in the goal
-% I maybe(follow_vars),
-% J set(goal_feature),
-% K resume_point,
-% L goal_path
+% E set(var), % the references set
+% F determinism, % the overall determinism of the goal
+% G instmap_delta, % the change in insts over this goal
+% H term__context,
+% I set(var), % the non-local vars in the goal
+% J maybe(follow_vars),
+% K set(goal_feature),
+% L resume_point,
+% M goal_path
% ).
goal_info_set_pre_births(GoalInfo0, PreBirths, GoalInfo) :-
- GoalInfo0 = goal_info(_, B, C, D, E, F, G, H, I, J, K, L),
- GoalInfo = goal_info(PreBirths, B, C, D, E, F, G, H, I, J, K, L).
+ GoalInfo0 = goal_info(_, B, C, D, E, F, G, H, I, J, K, L, M),
+ GoalInfo = goal_info(PreBirths, B, C, D, E, F, G, H, I, J, K, L, M).
goal_info_set_post_births(GoalInfo0, PostBirths, GoalInfo) :-
- GoalInfo0 = goal_info(A, _, C, D, E, F, G, H, I, J, K, L),
- GoalInfo = goal_info(A, PostBirths, C, D, E, F, G, H, I, J, K, L).
+ GoalInfo0 = goal_info(A, _, C, D, E, F, G, H, I, J, K, L, M),
+ GoalInfo = goal_info(A, PostBirths, C, D, E, F, G, H, I, J, K, L, M).
goal_info_set_pre_deaths(GoalInfo0, PreDeaths, GoalInfo) :-
- GoalInfo0 = goal_info(A, B, _, D, E, F, G, H, I, J, K, L),
- GoalInfo = goal_info(A, B, PreDeaths, D, E, F, G, H, I, J, K, L).
+ GoalInfo0 = goal_info(A, B, _, D, E, F, G, H, I, J, K, L, M),
+ GoalInfo = goal_info(A, B, PreDeaths, D, E, F, G, H, I, J, K, L, M).
goal_info_set_post_deaths(GoalInfo0, PostDeaths, GoalInfo) :-
- GoalInfo0 = goal_info(A, B, C, _, E, F, G, H, I, J, K, L),
- GoalInfo = goal_info(A, B, C, PostDeaths, E, F, G, H, I, J, K, L).
+ GoalInfo0 = goal_info(A, B, C, _, E, F, G, H, I, J, K, L, M),
+ GoalInfo = goal_info(A, B, C, PostDeaths, E, F, G, H, I, J, K, L, M).
+
+goal_info_set_refs(GoalInfo0, Refs, GoalInfo) :-
+ GoalInfo0 = goal_info(A, B, C, D, _, F, G, H, I, J, K, L, M),
+ GoalInfo = goal_info(A, B, C, D, Refs, F, G, H, I, J, K, L, M).
goal_info_set_determinism(GoalInfo0, Determinism, GoalInfo) :-
- GoalInfo0 = goal_info(A, B, C, D, _, F, G, H, I, J, K, L),
- GoalInfo = goal_info(A, B, C, D, Determinism, F, G, H, I, J, K, L).
+ GoalInfo0 = goal_info(A, B, C, D, E, _, G, H, I, J, K, L, M),
+ GoalInfo = goal_info(A, B, C, D, E, Determinism, G, H, I, J, K, L, M).
goal_info_set_instmap_delta(GoalInfo0, InstMapDelta, GoalInfo) :-
- GoalInfo0 = goal_info(A, B, C, D, E, _, G, H, I, J, K, L),
- GoalInfo = goal_info(A, B, C, D, E, InstMapDelta, G, H, I, J, K, L).
+ GoalInfo0 = goal_info(A, B, C, D, E, F, _, H, I, J, K, L, M),
+ GoalInfo = goal_info(A, B, C, D, E, F, InstMapDelta, H, I, J, K, L, M).
goal_info_set_context(GoalInfo0, Context, GoalInfo) :-
- GoalInfo0 = goal_info(A, B, C, D, E, F, _, H, I, J, K, L),
- GoalInfo = goal_info(A, B, C, D, E, F, Context, H, I, J, K, L).
+ GoalInfo0 = goal_info(A, B, C, D, E, F, G, _, I, J, K, L, M),
+ GoalInfo = goal_info(A, B, C, D, E, F, G, Context, I, J, K, L, M).
goal_info_set_nonlocals(GoalInfo0, NonLocals, GoalInfo) :-
- GoalInfo0 = goal_info(A, B, C, D, E, F, G, _, I, J, K, L),
- GoalInfo = goal_info(A, B, C, D, E, F, G, NonLocals, I, J, K, L).
+ GoalInfo0 = goal_info(A, B, C, D, E, F, G, H, _, J, K, L, M),
+ GoalInfo = goal_info(A, B, C, D, E, F, G, H, NonLocals, J, K, L, M).
goal_info_set_follow_vars(GoalInfo0, FollowVars, GoalInfo) :-
- GoalInfo0 = goal_info(A, B, C, D, E, F, G, H, _, J, K, L),
- GoalInfo = goal_info(A, B, C, D, E, F, G, H, FollowVars, J, K, L).
+ GoalInfo0 = goal_info(A, B, C, D, E, F, G, H, I, _, K, L, M),
+ GoalInfo = goal_info(A, B, C, D, E, F, G, H, I, FollowVars, K, L, M).
goal_info_set_features(GoalInfo0, Features, GoalInfo) :-
- GoalInfo0 = goal_info(A, B, C, D, E, F, G, H, I, _, K, L),
- GoalInfo = goal_info(A, B, C, D, E, F, G, H, I, Features, K, L).
+ GoalInfo0 = goal_info(A, B, C, D, E, F, G, H, I, J, _, L, M),
+ GoalInfo = goal_info(A, B, C, D, E, F, G, H, I, J, Features, L, M).
goal_info_set_resume_point(GoalInfo0, ResumePoint, GoalInfo) :-
- GoalInfo0 = goal_info(A, B, C, D, E, F, G, H, I, J, _, L),
- GoalInfo = goal_info(A, B, C, D, E, F, G, H, I, J, ResumePoint, L).
+ GoalInfo0 = goal_info(A, B, C, D, E, F, G, H, I, J, K, _, M),
+ GoalInfo = goal_info(A, B, C, D, E, F, G, H, I, J, K, ResumePoint, M).
goal_info_set_goal_path(GoalInfo0, GoalPath, GoalInfo) :-
- GoalInfo0 = goal_info(A, B, C, D, E, F, G, H, I, J, K, _),
- GoalInfo = goal_info(A, B, C, D, E, F, G, H, I, J, K, GoalPath).
+ GoalInfo0 = goal_info(A, B, C, D, E, F, G, H, I, J, K, L, _),
+ GoalInfo = goal_info(A, B, C, D, E, F, G, H, I, J, K, L, GoalPath).
goal_info_get_code_model(GoalInfo, CodeModel) :-
goal_info_get_determinism(GoalInfo, Determinism),
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_out.m,v
retrieving revision 1.172.2.9
diff -u -r1.172.2.9 hlds_out.m
--- 1.172.2.9 1998/06/17 04:12:47
+++ hlds_out.m 1998/06/22 01:02:56
@@ -1190,7 +1190,8 @@
% mode analysis yet
{ Unification = complicated_unify(Mode, CanFail) },
{ CanFail = can_fail },
- { Mode = (free - free -> free - free) }
+ { Mode = (free(unique) - free(unique) ->
+ free(unique) - free(unique)) }
->
hlds_out__write_indent(Indent),
io__write_string("% Not yet classified\n")
@@ -1836,20 +1837,27 @@
hlds_out__write_stack_slots(Indent, StackSlots, VarSet, AppendVarnums) -->
{ map__to_assoc_list(StackSlots, VarSlotList) },
- hlds_out__write_var_to_lvals(VarSlotList, VarSet, AppendVarnums,
+ { list__map(lambda([X::in, Y::out] is det,
+ ( X = V - L, Y = V - store_info(val, L) )),
+ VarSlotList, StoreInfoList) },
+ hlds_out__write_var_to_lvals(StoreInfoList, VarSet, AppendVarnums,
Indent).
-:- pred hlds_out__write_var_to_lvals(assoc_list(var, lval), varset, bool, int,
- io__state, io__state).
+:- pred hlds_out__write_var_to_lvals(assoc_list(var, store_info), varset,
+ bool, int, io__state, io__state).
:- mode hlds_out__write_var_to_lvals(in, in, in, in, di, uo) is det.
-hlds_out__write_var_to_lvals([], _, _, _) --> [].
-hlds_out__write_var_to_lvals([Var - Loc | VarLocs], VarSet, AppendVarnums,
- Indent) -->
+ hlds_out__write_var_to_lvals([], _, _, _) --> [].
+hlds_out__write_var_to_lvals([Var - store_info(ValOrRef, Loc) | VarLocs],
+ VarSet, AppendVarnums, Indent) -->
hlds_out__write_indent(Indent),
io__write_string("%\t"),
mercury_output_var(Var, VarSet, AppendVarnums),
io__write_string("\t-> "),
+ ( { ValOrRef = ref },
+ io__write_string("*")
+ ; { ValOrRef = val }
+ ),
{ llds_out__lval_to_string(Loc, LocStrPrime) ->
LocStr = LocStrPrime
;
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_pred.m,v
retrieving revision 1.35.4.9
diff -u -r1.35.4.9 hlds_pred.m
--- 1.35.4.9 1998/06/05 08:44:42
+++ hlds_pred.m 1998/06/22 01:02:56
@@ -137,7 +137,9 @@
:- type arg_mode ---> top_in
; top_out
- ; top_unused.
+ ; top_unused
+ ; ref_out
+ ; ref_in.
:- type arg_loc == int.
Index: compiler/inst.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/inst.m,v
retrieving revision 1.2.4.6
diff -u -r1.2.4.6 inst.m
--- 1.2.4.6 1998/03/17 00:01:42
+++ inst.m 1998/06/22 01:02:56
@@ -21,8 +21,8 @@
:- type (inst)
---> any(uniqueness)
; alias(inst_key)
- ; free
- ; free(type)
+ ; free(aliasing)
+ ; free(aliasing, type)
; bound(uniqueness, list(bound_inst))
% The list(bound_inst) must be sorted
; ground(uniqueness, maybe(pred_inst_info))
@@ -41,6 +41,11 @@
% defined (yet).
; abstract_inst(sym_name, list(inst)).
+:- type aliasing
+ ---> unique % No aliases.
+ ; alias. % An alias exists.
+ % ; alias_many. % Many aliases - XXX to be added later.
+
:- type uniqueness
---> shared % there might be other references
; unique % there is only one reference
@@ -406,8 +411,9 @@
).
optimise_inst_keys_in_inst(_OldFwd, _UsedOnce, _Sub,
any(Uniq), any(Uniq), IKs, IKs).
-optimise_inst_keys_in_inst(_OldFwd, _UsedOnce, _Sub, free, free, IKs, IKs).
-optimise_inst_keys_in_inst(_OldFwd, _UsedOnce, _Sub, free(T), free(T),
+optimise_inst_keys_in_inst(_OldFwd, _UsedOnce, _Sub, free(A), free(A),
+ IKs, IKs).
+optimise_inst_keys_in_inst(_OldFwd, _UsedOnce, _Sub, free(A, T), free(A, T),
IKs, IKs).
optimise_inst_keys_in_inst(OldFwd, UsedOnce, Sub,
bound(Uniq, Insts0), bound(Uniq, Insts), IKs0, IKs) :-
@@ -578,8 +584,8 @@
inst_keys_in_inst(any(_Uniq), Keys, Keys).
inst_keys_in_inst(alias(Key), Keys, [Key | Keys]).
-inst_keys_in_inst(free, Keys, Keys).
-inst_keys_in_inst(free(_Type), Keys, Keys).
+inst_keys_in_inst(free(_), Keys, Keys).
+inst_keys_in_inst(free(_, _Type), Keys, Keys).
inst_keys_in_inst(bound(_Uniq, BoundInsts), Keys0, Keys) :-
inst_keys_in_bound_insts(BoundInsts, Keys0, Keys).
inst_keys_in_inst(ground(_Uniq, _MaybePredInstInfo), Keys, Keys).
@@ -613,8 +619,8 @@
inst_expand_fully(IKT, alias(Key), Inst) :-
inst_key_table_lookup(IKT, Key, Inst0),
inst_expand_fully(IKT, Inst0, Inst).
-inst_expand_fully(_IKT, free, free).
-inst_expand_fully(_IKT, free(Type), free(Type)).
+inst_expand_fully(_IKT, free(A), free(A)).
+inst_expand_fully(_IKT, free(A, Type), free(A, Type)).
inst_expand_fully(IKT, bound(Uniq, BoundInsts0), bound(Uniq, BoundInsts)) :-
bound_insts_expand_fully(IKT, BoundInsts0, BoundInsts).
inst_expand_fully(_IKT, ground(Uniq, PredInstInfo), ground(Uniq, PredInstInfo)).
@@ -645,8 +651,8 @@
;
Key = Key0
).
-inst_apply_sub(_Sub, free, free).
-inst_apply_sub(_Sub, free(Type), free(Type)).
+inst_apply_sub(_Sub, free(Aliasing), free(Aliasing)).
+inst_apply_sub(_Sub, free(Aliasing, Type), free(Aliasing, Type)).
inst_apply_sub(Sub, bound(Uniq, BoundInsts0), bound(Uniq, BoundInsts)) :-
list__map(bound_inst_apply_sub(Sub), BoundInsts0, BoundInsts).
inst_apply_sub(_Sub, ground(Uniq, MaybePredInstInfo),
Index: compiler/inst_match.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/inst_match.m,v
retrieving revision 1.34.2.10
diff -u -r1.34.2.10 inst_match.m
--- 1.34.2.10 1998/03/26 00:36:09
+++ inst_match.m 1998/06/22 01:02:56
@@ -158,6 +158,11 @@
:- pred inst_is_ground_or_any(inst, inst_table, module_info).
:- mode inst_is_ground_or_any(in, in, in) is semidet.
+ % succeed if the inst is fully ground and higher order
+ % (i.e. contains a pred_inst_info.
+:- pred inst_is_higher_order_ground(inst, inst_table, module_info).
+:- mode inst_is_higher_order_ground(in, in, in) is semidet.
+
% succeed if the inst is `mostly_unique' or `unique'
:- pred inst_is_mostly_unique(inst, inst_table, module_info).
:- mode inst_is_mostly_unique(in, in, in) is semidet.
@@ -220,6 +225,12 @@
:- pred inst_is_free(inst, inst_table, module_info).
:- mode inst_is_free(in, in, in) is semidet.
+:- pred inst_is_free_alias(inst, inst_table, module_info).
+:- mode inst_is_free_alias(in, in, in) is semidet.
+
+:- pred inst_contains_free_alias(inst, inst_table, module_info).
+:- mode inst_contains_free_alias(in, in, in) is semidet.
+
:- pred inst_list_is_free(list(inst), inst_table, module_info).
:- mode inst_list_is_free(in, in, in) is semidet.
@@ -310,14 +321,15 @@
inst_matches_initial_3(any(UniqA), any(UniqB), _, _, _) :-
unique_matches_initial(UniqA, UniqB).
-inst_matches_initial_3(any(_), free, _, _, _).
-inst_matches_initial_3(free, any(_), _, _, _).
-inst_matches_initial_3(free, free, _, _, _).
+inst_matches_initial_3(any(_), free(unique), _, _, _).
+inst_matches_initial_3(free(unique), any(_), _, _, _).
+inst_matches_initial_3(free(alias), free(alias), _, _, _). % AAA
+inst_matches_initial_3(free(unique), free(unique), _, _, _). % AAA
inst_matches_initial_3(bound(UniqA, ListA), any(UniqB), InstTable, ModuleInfo,
_) :-
unique_matches_initial(UniqA, UniqB),
bound_inst_list_matches_uniq(ListA, UniqB, InstTable, ModuleInfo).
-inst_matches_initial_3(bound(_Uniq, _List), free, _, _, _).
+inst_matches_initial_3(bound(_Uniq, _List), free(_), _, _, _).
inst_matches_initial_3(bound(UniqA, ListA), bound(UniqB, ListB),
InstTable, ModuleInfo, Expansions) :-
unique_matches_initial(UniqA, UniqB),
@@ -340,7 +352,7 @@
bound_inst_list_is_mostly_unique(List, InstTable, ModuleInfo).
inst_matches_initial_3(ground(UniqA, _PredInst), any(UniqB), _, _, _) :-
unique_matches_initial(UniqA, UniqB).
-inst_matches_initial_3(ground(_Uniq, _PredInst), free, _, _, _).
+inst_matches_initial_3(ground(_Uniq, _PredInst), free(_), _, _, _).
inst_matches_initial_3(ground(UniqA, _), bound(UniqB, List), InstTable,
ModuleInfo, _) :-
unique_matches_initial(UniqA, UniqB),
@@ -359,7 +371,7 @@
% Abstract insts aren't really supported.
error("inst_matches_initial(ground, abstract_inst) == ??").
inst_matches_initial_3(abstract_inst(_,_), any(shared), _, _, _).
-inst_matches_initial_3(abstract_inst(_,_), free, _, _, _).
+inst_matches_initial_3(abstract_inst(_,_), free(_), _, _, _).
inst_matches_initial_3(abstract_inst(Name, ArgsA), abstract_inst(Name, ArgsB),
InstTable, ModuleInfo, Expansions) :-
inst_list_matches_initial(ArgsA, ArgsB, InstTable, ModuleInfo,
@@ -400,6 +412,14 @@
% aliasing in their argument_modes.
pred_inst_argmodes_matches(ModesA, ModesB, InstTable, ModuleInfo, Expansions).
+pred_inst_matches_2(pred_inst_info(PredOrFunc, ArgModesA, Det),
+ pred_inst_info(PredOrFunc, ArgModesB, Det),
+ InstTable, ModuleInfo, Expansions) :-
+ ArgModesA = argument_modes(_, ModesA),
+ ArgModesB = argument_modes(_, ModesB),
+ pred_inst_argmodes_matches(ModesA, ModesB, InstTable, ModuleInfo,
+ Expansions).
+
% pred_inst_matches_argmodes(ModesA, ModesB, ModuleInfo, Expansions):
% succeeds if the initial insts of ModesB specify at least as
% much information as, and the same binding as, the initial
@@ -562,13 +582,13 @@
inst_matches_final_3(any(UniqA), any(UniqB), _, _, _) :-
unique_matches_final(UniqA, UniqB).
-inst_matches_final_3(free, any(Uniq), _, _, _) :-
+inst_matches_final_3(free(unique), any(Uniq), _, _, _) :-
% We do not yet allow `free' to match `any',
% unless the `any' is `clobbered_any' or `mostly_clobbered_any'.
% Among other things, changing this would break compare_inst
% in modecheck_call.m.
( Uniq = clobbered ; Uniq = mostly_clobbered ).
-inst_matches_final_3(free, free, _, _, _).
+inst_matches_final_3(free(Aliasing), free(Aliasing), _, _, _).
inst_matches_final_3(bound(UniqA, ListA), any(UniqB), InstTable, ModuleInfo,
_) :-
unique_matches_final(UniqA, UniqB),
@@ -687,7 +707,7 @@
:- mode inst_matches_binding_3(in, in, in, in, in) is semidet.
% Note that `any' is *not* considered to match `any'.
-inst_matches_binding_3(free, free, _, _, _).
+inst_matches_binding_3(free(Aliasing), free(Aliasing), _, _, _).
inst_matches_binding_3(bound(_UniqA, ListA), bound(_UniqB, ListB), InstTable,
ModuleInfo, Expansions) :-
bound_inst_list_matches_binding(ListA, ListB, InstTable, ModuleInfo,
@@ -793,8 +813,8 @@
% or is a user-defined inst which is defined as `free'.
% Abstract insts must not be free.
-inst_is_free(free, _, _).
-inst_is_free(free(_Type), _, _).
+inst_is_free(free(_), _, _).
+inst_is_free(free(_, _), _, _).
inst_is_free(inst_var(_), _, _) :-
error("internal error: uninstantiated inst parameter").
inst_is_free(defined_inst(InstName), InstTable, ModuleInfo) :-
@@ -805,6 +825,51 @@
inst_key_table_lookup(IKT, Key, Inst),
inst_is_free(Inst, InstTable, ModuleInfo).
+ % inst_is_free_alias succeeds iff the inst passed is `free(alias)'
+ % or a user-defined inst which is defined as `free(alias)' or
+ % `alias(IK)' where `IK' points to a `free(alias)' inst in the IKT.
+
+inst_is_free_alias(free(alias), _, _).
+inst_is_free_alias(free(alias, _), _, _).
+inst_is_free_alias(inst_var(_), _, _) :-
+ error("internal error: uninstantiated inst parameter").
+inst_is_free_alias(defined_inst(InstName), InstTable, ModuleInfo) :-
+ inst_lookup(InstTable, ModuleInfo, InstName, Inst),
+ inst_is_free_alias(Inst, InstTable, ModuleInfo).
+inst_is_free_alias(alias(Key), InstTable, ModuleInfo) :-
+ inst_table_get_inst_key_table(InstTable, IKT),
+ inst_key_table_lookup(IKT, Key, Inst),
+ inst_is_free_alias(Inst, InstTable, ModuleInfo).
+
+ % inst_contains_free_alias succeeds iff the inst passed is free(alias)
+ % or is bound to a functor with an argument containing a free(alias).
+inst_contains_free_alias(Inst, InstTable, ModuleInfo) :-
+ set__init(Seen0),
+ inst_contains_free_alias_2(Inst, InstTable, ModuleInfo, Seen0).
+
+:- pred inst_contains_free_alias_2(inst, inst_table, module_info,
+ set(inst_name)).
+:- mode inst_contains_free_alias_2(in, in, in, in) is semidet.
+
+inst_contains_free_alias_2(free(alias), _, _, _).
+inst_contains_free_alias_2(free(alias, _), _, _, _).
+inst_contains_free_alias_2(inst_var(_), _, _, _) :-
+ error("internal error: uninstantiated inst parameter").
+inst_contains_free_alias_2(defined_inst(InstName), InstTable, ModuleInfo,
+ Seen0) :-
+ \+ set__member(InstName, Seen0),
+ inst_lookup(InstTable, ModuleInfo, InstName, Inst),
+ set__insert(Seen0, InstName, Seen1),
+ inst_contains_free_alias_2(Inst, InstTable, ModuleInfo, Seen1).
+inst_contains_free_alias_2(alias(Key), InstTable, ModuleInfo, Seen) :-
+ inst_table_get_inst_key_table(InstTable, IKT),
+ inst_key_table_lookup(IKT, Key, Inst),
+ inst_contains_free_alias_2(Inst, InstTable, ModuleInfo, Seen).
+inst_contains_free_alias_2(bound(_, BoundInsts), InstTable, ModuleInfo, Seen) :-
+ list__member(functor(_, ArgInsts), BoundInsts),
+ list__member(Inst, ArgInsts),
+ inst_contains_free_alias_2(Inst, InstTable, ModuleInfo, Seen).
+
% inst_is_bound succeeds iff the inst passed is not `free'
% or is a user-defined inst which is not defined as `free'.
% Abstract insts must be bound.
@@ -914,6 +979,21 @@
inst_key_table_lookup(IKT, Key, Inst),
inst_is_ground_or_any_2(Inst, InstTable, ModuleInfo, Expansions).
+ % inst_is_higher_order_ground succeeds iff the inst passed is `ground'
+ % or equivalent and has a pred_inst_info.
+
+inst_is_higher_order_ground(ground(_, yes(_PredInstInfo)), _, _).
+inst_is_higher_order_ground(inst_var(_), _, _) :-
+ error("internal error: uninstantiated inst parameter").
+inst_is_higher_order_ground(Inst, InstTable, ModuleInfo) :-
+ Inst = defined_inst(InstName),
+ inst_lookup(InstTable, ModuleInfo, InstName, Inst2),
+ inst_is_higher_order_ground(Inst2, InstTable, ModuleInfo).
+inst_is_higher_order_ground(alias(Key), InstTable, ModuleInfo) :-
+ inst_table_get_inst_key_table(InstTable, IKT),
+ inst_key_table_lookup(IKT, Key, Inst),
+ inst_is_higher_order_ground(Inst, InstTable, ModuleInfo).
+
% inst_is_unique succeeds iff the inst passed is unique
% or free. Abstract insts are not considered unique.
@@ -933,7 +1013,7 @@
bound_inst_list_has_property(inst_is_unique_2, List, InstTable,
ModuleInfo, Expansions).
inst_is_unique_2(any(unique), _, _, _).
-inst_is_unique_2(free, _, _, _).
+inst_is_unique_2(free(unique), _, _, _).
inst_is_unique_2(ground(unique, _), _, _, _).
inst_is_unique_2(inst_var(_), _, _, _) :-
error("internal error: uninstantiated inst parameter").
@@ -972,7 +1052,7 @@
ModuleInfo, Expansions).
inst_is_mostly_unique_2(any(unique), _, _, _).
inst_is_mostly_unique_2(any(mostly_unique), _, _, _).
-inst_is_mostly_unique_2(free, _, _, _).
+inst_is_mostly_unique_2(free(unique), _, _, _).
inst_is_mostly_unique_2(ground(unique, _), _, _, _).
inst_is_mostly_unique_2(ground(mostly_unique, _), _, _, _).
inst_is_mostly_unique_2(inst_var(_), _, _, _) :-
@@ -1013,7 +1093,7 @@
Expansions) :-
bound_inst_list_has_property(inst_is_not_partly_unique_2, List,
InstTable, ModuleInfo, Expansions).
-inst_is_not_partly_unique_2(free, _, _, _).
+inst_is_not_partly_unique_2(free(_), _, _, _).
inst_is_not_partly_unique_2(any(shared), _, _, _).
inst_is_not_partly_unique_2(ground(shared, _), _, _, _).
inst_is_not_partly_unique_2(inst_var(_), _, _, _) :-
@@ -1060,7 +1140,7 @@
InstTable, ModuleInfo, Expansions).
inst_is_not_fully_unique_2(any(shared), _, _, _).
inst_is_not_fully_unique_2(any(mostly_unique), _, _, _).
-inst_is_not_fully_unique_2(free, _, _, _).
+inst_is_not_fully_unique_2(free(_), _, _, _).
inst_is_not_fully_unique_2(ground(shared, _), _, _, _).
inst_is_not_fully_unique_2(ground(mostly_unique, _), _, _, _).
inst_is_not_fully_unique_2(inst_var(_), _, _, _) :-
@@ -1321,6 +1401,16 @@
Expansions, InstVar) :-
inst_list_contains_inst_var(ArgInsts, InstTable, ModuleInfo, Expansions,
InstVar).
+inst_contains_inst_var_2(ground(_Uniq, PredInstInfo), InstTable,
+ ModuleInfo, Expansions, InstVar) :-
+ PredInstInfo = yes(pred_inst_info(_PredOrFunc, ArgModes, _Det)),
+ ArgModes = argument_modes(_, Modes),
+ mode_list_contains_inst_var_2(Modes, InstTable, ModuleInfo, Expansions,
+ InstVar).
+inst_contains_inst_var_2(abstract_inst(_Name, ArgInsts), InstTable, ModuleInfo,
+ Expansions, InstVar) :-
+ inst_list_contains_inst_var(ArgInsts, InstTable, ModuleInfo, Expansions,
+ InstVar).
:- pred bound_inst_list_contains_inst_var(list(bound_inst), inst_table,
module_info, set(inst_name), inst_var).
Index: compiler/inst_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/inst_util.m,v
retrieving revision 1.3.2.12
diff -u -r1.3.2.12 inst_util.m
--- 1.3.2.12 1998/03/26 00:36:23
+++ inst_util.m 1998/06/22 01:02:56
@@ -273,7 +273,7 @@
(
% free = alias(K) where alias(K) is ground
- InstA2 = free,
+ InstA2 = free(_),
inst_is_ground(InstB2, InstTable0, ModuleInfo0)
->
UI = UI0,
@@ -281,7 +281,7 @@
;
% alias(K) = free where alias(K) is ground
- InstB2 = free,
+ InstB2 = free(_),
inst_is_ground(InstA2, InstTable0, ModuleInfo0)
->
UI = UI0,
@@ -388,13 +388,13 @@
abstractly_unify_inst_3(live, Real, any(Uniq), Inst0, UI0, Inst, Det, UI) :-
make_any_inst(Inst0, live, Uniq, Real, UI0, Inst, Det, UI).
-abstractly_unify_inst_3(live, Real, free, any(UniqY), UI,
+abstractly_unify_inst_3(live, Real, free(_), any(UniqY), UI,
any(Uniq), det, UI) :-
unify_uniq(live, Real, det, unique, UniqY, Uniq).
% abstractly_unify_inst_3(live, _, free, free, _, _, _, _, _) :- fail.
-abstractly_unify_inst_3(live, Real, free, bound(UniqY, List0), UI0,
+abstractly_unify_inst_3(live, Real, free(_), bound(UniqY, List0), UI0,
bound(Uniq, List), det, UI) :-
unify_uniq(live, Real, det, unique, UniqY, Uniq),
@@ -411,7 +411,7 @@
List = List0, UI = UI0
).
-abstractly_unify_inst_3(live, Real, free, ground(UniqY, PredInst), UI,
+abstractly_unify_inst_3(live, Real, free(_), ground(UniqY, PredInst), UI,
ground(Uniq, PredInst), det, UI) :-
unify_uniq(live, Real, det, unique, UniqY, Uniq).
@@ -425,7 +425,7 @@
List, Det1, UI),
det_par_conjunction_detism(Det1, semidet, Det).
-abstractly_unify_inst_3(live, Real, bound(UniqY, List0), free, UI0,
+abstractly_unify_inst_3(live, Real, bound(UniqY, List0), free(_), UI0,
bound(Uniq, List), det, UI) :-
unify_uniq(live, Real, det, unique, UniqY, Uniq),
% since both are live, we must disallow free-free unifications
@@ -461,7 +461,7 @@
Real = fake_unify,
unify_uniq(live, Real, det, UniqX, UniqY, Uniq).
-abstractly_unify_inst_3(live, Real, ground(Uniq0, yes(PredInst)), free, UI,
+abstractly_unify_inst_3(live, Real, ground(Uniq0, yes(PredInst)), free(_), UI,
ground(Uniq, yes(PredInst)), det, UI) :-
unify_uniq(live, Real, det, unique, Uniq0, Uniq).
@@ -528,7 +528,7 @@
make_any_inst(Inst0, dead, Uniq, Real, UI0, Inst, Det, UI).
% YYY This looks right, but it wasn't on the main branch. Hmmm
-abstractly_unify_inst_3(dead, _Real, free, Inst, UI, Inst, det, UI).
+abstractly_unify_inst_3(dead, _Real, free(_), Inst, UI, Inst, det, UI).
abstractly_unify_inst_3(dead, Real, bound(UniqX, List0), any(UniqY), UI0,
bound(Uniq, List), Det, UI) :-
@@ -538,7 +538,7 @@
List, Det1, UI),
det_par_conjunction_detism(Det1, semidet, Det).
-abstractly_unify_inst_3(dead, Real, bound(UniqX, List), free, UI,
+abstractly_unify_inst_3(dead, Real, bound(UniqX, List), free(_), UI,
bound(Uniq, List), det, UI) :-
unify_uniq(dead, Real, det, UniqX, unique, Uniq).
@@ -576,7 +576,7 @@
allow_unify_bound_any(Real),
unify_uniq(dead, Real, semidet, UniqX, UniqY, Uniq).
-abstractly_unify_inst_3(dead, _Real, ground(Uniq, yes(PredInst)), free, UI,
+abstractly_unify_inst_3(dead, _Real, ground(Uniq, yes(PredInst)), free(_), UI,
ground(Uniq, yes(PredInst)), det, UI).
abstractly_unify_inst_3(dead, Real, ground(UniqA, yes(_)),
@@ -696,11 +696,14 @@
abstractly_unify_inst_functor_2(live, _, not_reached, _, _, _, UI,
not_reached, erroneous, UI).
-abstractly_unify_inst_functor_2(live, _Real, free, ConsId, Args, ArgLives, UI,
- bound(unique, [functor(ConsId, Args)]), det, UI) :-
- unify_inst_info_get_module_info(UI, M),
- unify_inst_info_get_inst_table(UI, InstTable),
- inst_list_is_ground_or_any_or_dead(Args, ArgLives, InstTable, M).
+abstractly_unify_inst_functor_2(live, _Real, free(_), ConsId, Args0, ArgLives,
+ UI0, bound(unique, [functor(ConsId, Args)]), det, UI) :-
+ unify_inst_info_get_module_info(UI0, M),
+ unify_inst_info_get_inst_table(UI0, InstTable0),
+ assoc_list__from_corresponding_lists(Args0, ArgLives, ArgsAndLives),
+ list__map_foldl(abstractly_unify_bound_inst_arg_with_free(M),
+ ArgsAndLives, Args, InstTable0, InstTable),
+ unify_inst_info_set_inst_table(UI0, InstTable, UI).
abstractly_unify_inst_functor_2(live, Real, bound(Uniq, ListX), ConsId, Args,
ArgLives, UI0, bound(Uniq, List), Det, UI) :-
@@ -732,8 +735,8 @@
abstractly_unify_inst_functor_2(dead, _, not_reached, _, _, _, UI,
not_reached, erroneous, UI).
-abstractly_unify_inst_functor_2(dead, _Real, free, ConsId, Args, _ArgLives, UI,
- bound(unique, [functor(ConsId, Args)]), det, UI).
+abstractly_unify_inst_functor_2(dead, _Real, free(_), ConsId, Args, _ArgLives,
+ UI, bound(unique, [functor(ConsId, Args)]), det, UI).
abstractly_unify_inst_functor_2(dead, Real, bound(Uniq, ListX), ConsId, Args,
_ArgLives, UI0, bound(Uniq, List), Det, UI) :-
@@ -863,6 +866,40 @@
det_par_conjunction_detism(Det1, Det2, Det).
%-----------------------------------------------------------------------------%
+
+:- pred abstractly_unify_bound_inst_arg_with_free(module_info,
+ pair(inst, is_live), inst, inst_table, inst_table).
+:- mode abstractly_unify_bound_inst_arg_with_free(in, in, out, in, out) is det.
+
+abstractly_unify_bound_inst_arg_with_free(_ModuleInfo, Inst - dead, Inst,
+ InstTable, InstTable).
+
+abstractly_unify_bound_inst_arg_with_free(ModuleInfo, Inst0 - live, Inst,
+ InstTable0, InstTable) :-
+ inst_expand_defined_inst(InstTable0, ModuleInfo, Inst0, Inst1),
+ ( inst_is_ground_or_any(Inst1, InstTable0, ModuleInfo) ->
+ Inst = Inst1,
+ InstTable = InstTable0
+ ; inst_is_free(Inst1, InstTable0, ModuleInfo) ->
+ (
+ Inst0 = alias(_),
+ inst_is_free_alias(Inst0, InstTable0, ModuleInfo)
+ ->
+ Inst = Inst1,
+ InstTable = InstTable0
+ ;
+ inst_table_get_inst_key_table(InstTable0, IKT0),
+ inst_key_table_add(IKT0, free(alias), IK, IKT),
+ inst_table_set_inst_key_table(InstTable0, IKT,
+ InstTable),
+ Inst = alias(IK)
+ )
+ ;
+ Inst = Inst0,
+ InstTable = InstTable0
+ ).
+
+%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- pred unify_uniq(is_live, unify_is_real, determinism, uniqueness, uniqueness,
@@ -1002,9 +1039,9 @@
make_ground_inst(any(Uniq0), IsLive, Uniq1, Real, UI, ground(Uniq, no),
semidet, UI) :-
unify_uniq(IsLive, Real, semidet, Uniq0, Uniq1, Uniq).
-make_ground_inst(free, IsLive, Uniq0, Real, UI, ground(Uniq, no), det, UI) :-
+make_ground_inst(free(_), IsLive, Uniq0, Real, UI, ground(Uniq, no), det, UI) :-
unify_uniq(IsLive, Real, det, unique, Uniq0, Uniq).
-make_ground_inst(free(T), IsLive, Uniq0, Real, UI,
+make_ground_inst(free(_, T), IsLive, Uniq0, Real, UI,
defined_inst(typed_ground(Uniq, T)), det, UI) :-
unify_uniq(IsLive, Real, det, unique, Uniq0, Uniq).
make_ground_inst(bound(Uniq0, BoundInsts0), IsLive, Uniq1, Real, UI0,
@@ -1134,15 +1171,16 @@
semidet, UI) :-
allow_unify_bound_any(Real),
unify_uniq(IsLive, Real, semidet, Uniq0, Uniq1, Uniq).
-make_any_inst(free, IsLive, Uniq0, Real, UI, any(Uniq), det, UI) :-
+make_any_inst(free(unique), IsLive, Uniq0, Real, UI, any(Uniq), det, UI) :-
unify_uniq(IsLive, Real, det, unique, Uniq0, Uniq).
-make_any_inst(free(T), IsLive, Uniq, Real, UI,
+make_any_inst(free(unique, T), IsLive, Uniq, Real, UI,
defined_inst(Any), det, UI) :-
% The following is a round-about way of doing this
% unify_uniq(IsLive, Real, det, unique, Uniq0, Uniq),
% Any = typed_any(Uniq, T).
% without the need for a `typed_any' inst.
- Any = typed_inst(T, unify_inst(IsLive, free, any(Uniq), Real)).
+ Any = typed_inst(T, unify_inst(IsLive, free(unique), any(Uniq),
+ Real)).
make_any_inst(bound(Uniq0, BoundInsts0), IsLive, Uniq1, Real, UI0,
bound(Uniq, BoundInsts), Det, UI) :-
allow_unify_bound_any(Real),
@@ -1313,10 +1351,10 @@
).
make_shared_inst(any(Uniq0), UI, any(Uniq), UI) :-
make_shared(Uniq0, Uniq).
-make_shared_inst(free, UI, free, UI) :-
+make_shared_inst(free(_), UI, free(_), UI) :-
% the caller should ensure that this never happens
error("make_shared_inst: cannot make shared version of `free'").
-make_shared_inst(free(T), UI, free(T), UI) :-
+make_shared_inst(free(_, T), UI, free(_, T), UI) :-
% the caller should ensure that this never happens
error("make_shared_inst: cannot make shared version of `free(T)'").
make_shared_inst(bound(Uniq0, BoundInsts0), UI0, bound(Uniq, BoundInsts), UI) :-
@@ -1416,8 +1454,8 @@
make_mostly_uniq_inst_2(not_reached, UI, not_reached, UI).
make_mostly_uniq_inst_2(any(Uniq0), UI, any(Uniq), UI) :-
make_mostly_uniq(Uniq0, Uniq).
-make_mostly_uniq_inst_2(free, UI, free, UI).
-make_mostly_uniq_inst_2(free(T), UI, free(T), UI).
+make_mostly_uniq_inst_2(free(A), UI, free(A), UI).
+make_mostly_uniq_inst_2(free(A, T), UI, free(A, T), UI).
make_mostly_uniq_inst_2(bound(Uniq0, BoundInsts0), UI0,
bound(Uniq, BoundInsts), UI) :-
% XXX could improve efficiency by avoiding recursion here
@@ -1656,7 +1694,7 @@
inst_merge_3(any(UniqA), any(UniqB), InstTable, M, any(Uniq), InstTable, M) :-
merge_uniq(UniqA, UniqB, Uniq).
-inst_merge_3(any(Uniq), free, InstTable, M, any(Uniq), InstTable, M) :-
+inst_merge_3(any(Uniq), free(_), InstTable, M, any(Uniq), InstTable, M) :-
% we do not yet allow merge of any with free, except for clobbered anys
( Uniq = clobbered ; Uniq = mostly_clobbered ).
inst_merge_3(any(UniqA), bound(UniqB, ListB), InstTable, M, any(Uniq),
@@ -1676,7 +1714,7 @@
merge_uniq(UniqA, shared, Uniq),
% we do not yet allow merge of any with free, except for clobbered anys
( Uniq = clobbered ; Uniq = mostly_clobbered ).
-inst_merge_3(free, any(Uniq), InstTable, M, any(Uniq), InstTable, M) :-
+inst_merge_3(free(_), any(Uniq), InstTable, M, any(Uniq), InstTable, M) :-
% we do not yet allow merge of any with free, except for clobbered anys
( Uniq = clobbered ; Uniq = mostly_clobbered ).
inst_merge_3(bound(UniqA, ListA), any(UniqB), InstTable, M, any(Uniq),
@@ -1696,7 +1734,8 @@
merge_uniq(shared, UniqB, Uniq),
% we do not yet allow merge of any with free, except for clobbered anys
( Uniq = clobbered ; Uniq = mostly_clobbered ).
-inst_merge_3(free, free, InstTable, M, free, InstTable, M).
+inst_merge_3(free(Aliasing), free(Aliasing), InstTable, M, free(Aliasing),
+ InstTable, M).
inst_merge_3(bound(UniqA, ListA), bound(UniqB, ListB), InstTable0, ModuleInfo0,
bound(Uniq, List), InstTable, ModuleInfo) :-
merge_uniq(UniqA, UniqB, Uniq),
@@ -1798,8 +1837,8 @@
inst_table_get_inst_key_table(InstTable, IKT),
inst_key_table_lookup(IKT, InstKey, Inst),
merge_inst_uniq(Inst, UniqB, InstTable, ModuleInfo, Expansions, Uniq).
-merge_inst_uniq(free, Uniq, _, _, _, Uniq).
merge_inst_uniq(free(_), Uniq, _, _, _, Uniq).
+merge_inst_uniq(free(_, _), Uniq, _, _, _, Uniq).
merge_inst_uniq(bound(UniqA, ListA), UniqB, InstTable, ModuleInfo, Expansions,
Uniq) :-
merge_uniq(UniqA, UniqB, Uniq0),
Index: compiler/instmap.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/instmap.m,v
retrieving revision 1.15.2.13
diff -u -r1.15.2.13 instmap.m
--- 1.15.2.13 1998/06/17 04:12:51
+++ instmap.m 1998/06/22 01:02:56
@@ -414,7 +414,7 @@
( map__search(InstMap, Var, VarInst) ->
Inst = VarInst
;
- Inst = free
+ Inst = free(unique)
).
instmap_delta_search_var(unreachable, _, not_reached).
@@ -663,8 +663,8 @@
),
instmap__get_relevant_inst_keys_in_inst(Inst, Recursive, ModuleInfo,
InstTable, S1, S, D1, D).
-instmap__get_relevant_inst_keys_in_inst(free, _, _, _, S, S, D, D).
instmap__get_relevant_inst_keys_in_inst(free(_), _, _, _, S, S, D, D).
+instmap__get_relevant_inst_keys_in_inst(free(_, _), _, _, _, S, S, D, D).
instmap__get_relevant_inst_keys_in_inst(bound(_, BoundInsts), Rec, ModuleInfo,
InstTable, S0, S, D0, D) :-
list__foldl2(lambda([BoundInst :: in, AS0 :: in, AS :: out,
@@ -931,7 +931,7 @@
Sub2 = Sub0
)
;
- VarInst = free,
+ VarInst = free(unique),
Inst2 = Inst0,
Error1 = Error0,
ModuleInfo2 = ModuleInfo0,
Index: compiler/lco.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/lco.m,v
retrieving revision 1.7.2.3
diff -u -r1.7.2.3 lco.m
--- 1.7.2.3 1998/06/17 04:12:58
+++ lco.m 1998/06/22 04:32:22
@@ -4,7 +4,7 @@
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
-% Main author: zs
+% Main authors: zs, dmo
% This module looks for opportunities to apply the "last call modulo
% constructor application" optimization.
@@ -18,9 +18,9 @@
:- import_module hlds_module, hlds_pred.
:- import_module io.
-:- pred lco_modulo_constructors(pred_id, proc_id, module_info,
- proc_info, proc_info, io__state, io__state).
-:- mode lco_modulo_constructors(in, in, in, in, out, di, uo) is det.
+:- pred lco_modulo_constructors(pred_id, proc_id, proc_info, proc_info,
+ module_info, module_info, io__state, io__state).
+:- mode lco_modulo_constructors(in, in, in, out, in, out, di, uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -27,110 +27,154 @@
:- implementation.
-:- import_module hlds_goal, passes_aux, hlds_out.
-:- import_module list, require, std_util.
+:- import_module hlds_goal, passes_aux, hlds_out, (inst), instmap, inst_match.
+:- import_module mode_util, hlds_data, prog_data, type_util, globals, options.
+:- import_module list, std_util, map, assoc_list, term, varset, require.
+:- import_module bool, set, int.
%-----------------------------------------------------------------------------%
-lco_modulo_constructors(PredId, ProcId, ModuleInfo, ProcInfo0, ProcInfo) -->
+lco_modulo_constructors(PredId, ProcId, ProcInfo0, ProcInfo, ModuleInfo0,
+ ModuleInfo) -->
+ write_proc_progress_message("% Trying to introduce LCO in ",
+ PredId, ProcId, ModuleInfo0),
{ proc_info_goal(ProcInfo0, Goal0) },
- { lco_in_goal(Goal0, ModuleInfo, Goal) },
- ( { Goal = Goal0 } ->
- { ProcInfo = ProcInfo0 }
+ { lco_in_goal(Goal0, Goal, ModuleInfo0, ModuleInfo1,
+ ProcInfo0, ProcInfo1, Changed) },
+ ( { Changed = yes } ->
+ { proc_info_set_goal(ProcInfo1, Goal, ProcInfo) },
+ { ModuleInfo = ModuleInfo1 },
+ write_proc_progress_message("% Can introduce LCO in ",
+ PredId, ProcId, ModuleInfo)
;
- { ProcInfo = ProcInfo0 }, % for now
- % { proc_info_set_goal(ProcInfo0, Goal, ProcInfo) },
- io__write_string("% Can introduce LCO in "),
- hlds_out__write_pred_proc_id(ModuleInfo, PredId, ProcId),
- io__write_string("\n")
+ { ProcInfo = ProcInfo0 },
+ { ModuleInfo = ModuleInfo0 }
).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-:- pred lco_in_goal(hlds_goal, module_info, hlds_goal).
-:- mode lco_in_goal(in, in, out) is det.
+% Do the LCO optimisation and recompute the instmap deltas.
+:- pred lco_in_goal(hlds_goal, hlds_goal, module_info, module_info,
+ proc_info, proc_info, bool).
+:- mode lco_in_goal(in, out, in, out, in, out, out) is det.
+
+lco_in_goal(Goal0, Goal, Module0, Module, ProcInfo0, ProcInfo, Changed):-
+ lco_in_sub_goal(Goal0, Goal1, Module0, Module1, ProcInfo0, ProcInfo1,
+ Changed),
+ (
+ Changed = yes,
+ proc_info_inst_table(ProcInfo1, InstTable0),
+ proc_info_get_initial_instmap(ProcInfo1, Module1, InstMap),
+ proc_info_vartypes(ProcInfo1, VarTypes),
+ proc_info_headvars(ProcInfo1, ArgVars),
+ proc_info_arglives(ProcInfo1, Module1, ArgLives),
+ recompute_instmap_delta(ArgVars, ArgLives, VarTypes,
+ Goal1, Goal, InstMap, InstTable0, InstTable,
+ _GoalChanged, Module1, Module),
+ proc_info_set_inst_table(ProcInfo1, InstTable, ProcInfo)
+ ;
+ Changed = no,
+ Goal = Goal0,
+ Module = Module0,
+ ProcInfo = ProcInfo0
+ ).
-lco_in_goal(Goal0 - GoalInfo, ModuleInfo, Goal - GoalInfo) :-
- lco_in_goal_2(Goal0, ModuleInfo, Goal).
+% Do the LCO optimisation without recomputing instmap deltas.
+:- pred lco_in_sub_goal(hlds_goal, hlds_goal, module_info, module_info,
+ proc_info, proc_info, bool).
+:- mode lco_in_sub_goal(in, out, in, out, in, out, out) is det.
+lco_in_sub_goal(Goal0 - GoalInfo, Goal - GoalInfo, Module0, Module,
+ Proc0, Proc, Changed) :-
+ lco_in_goal_2(Goal0, Goal, Module0, Module, Proc0, Proc, Changed).
+
%-----------------------------------------------------------------------------%
-:- pred lco_in_goal_2(hlds_goal_expr, module_info, hlds_goal_expr).
-:- mode lco_in_goal_2(in, in, out) is det.
+:- pred lco_in_goal_2(hlds_goal_expr, hlds_goal_expr, module_info,
+ module_info, proc_info, proc_info, bool).
+:- mode lco_in_goal_2(in, out, in, out, in, out, out) is det.
-lco_in_goal_2(conj(Goals0), ModuleInfo, conj(Goals)) :-
+lco_in_goal_2(conj(Goals0), conj(Goals), Module0, Module, Proc0, Proc, Changed)
+ :-
list__reverse(Goals0, RevGoals0),
- lco_in_conj(RevGoals0, [], ModuleInfo, Goals).
+ lco_in_conj(RevGoals0, [], Goals, Module0, Module, Proc0, Proc,
+ Changed).
% XXX Some execution algorithm issues here.
-lco_in_goal_2(par_conj(_Goals0, SM), _ModuleInfo, par_conj(_Goals, SM)) :-
- error("sorry: lco of parallel conjunction not implemented").
+lco_in_goal_2(par_conj(Goals, SM), par_conj(Goals, SM), Module, Module,
+ Proc, Proc, no).
-lco_in_goal_2(disj(Goals0, SM), ModuleInfo, disj(Goals, SM)) :-
- lco_in_disj(Goals0, ModuleInfo, Goals).
+lco_in_goal_2(disj(Goals0, SM), disj(Goals, SM), Module0, Module, Proc0, Proc,
+ Changed) :-
+ lco_in_disj(Goals0, Goals, Module0, Module, Proc0, Proc, Changed).
-lco_in_goal_2(switch(Var, Det, Cases0, SM), ModuleInfo,
- switch(Var, Det, Cases, SM)) :-
- lco_in_cases(Cases0, ModuleInfo, Cases).
+lco_in_goal_2(switch(Var, Det, Cases0, SM), switch(Var, Det, Cases, SM),
+ Module0, Module, Proc0, Proc, Changed) :-
+ lco_in_cases(Cases0, Cases, Module0, Module, Proc0, Proc, Changed).
-lco_in_goal_2(if_then_else(Vars, Cond, Then0, Else0, SM), ModuleInfo,
- if_then_else(Vars, Cond, Then, Else, SM)) :-
- lco_in_goal(Then0, ModuleInfo, Then),
- lco_in_goal(Else0, ModuleInfo, Else).
+lco_in_goal_2(if_then_else(Vars, Cond, Then0, Else0, SM),
+ if_then_else(Vars, Cond, Then, Else, SM), Module0, Module,
+ Proc0, Proc, Changed) :-
+ lco_in_sub_goal(Then0, Then, Module0, Module1, Proc0, Proc1, Changed0),
+ lco_in_sub_goal(Else0, Else, Module1, Module, Proc1, Proc, Changed1),
+ bool__or(Changed0, Changed1, Changed).
-lco_in_goal_2(some(Vars, Goal0), ModuleInfo, some(Vars, Goal)) :-
- lco_in_goal(Goal0, ModuleInfo, Goal).
+lco_in_goal_2(some(Vars, Goal0), some(Vars, Goal), Module0, Module,
+ Proc0, Proc, Changed) :-
+ lco_in_sub_goal(Goal0, Goal, Module0, Module, Proc0, Proc, Changed).
-lco_in_goal_2(not(Goal), _ModuleInfo, not(Goal)).
+lco_in_goal_2(not(Goal), not(Goal), Module, Module, Proc, Proc, no).
-lco_in_goal_2(higher_order_call(A,B,C,D,E,F), _ModuleInfo,
- higher_order_call(A,B,C,D,E,F)).
+lco_in_goal_2(higher_order_call(A,B,C,D,E,F), higher_order_call(A,B,C,D,E,F),
+ Module, Module, Proc, Proc, no).
-lco_in_goal_2(class_method_call(A,B,C,D,E,F), _ModuleInfo,
- class_method_call(A,B,C,D,E,F)).
+lco_in_goal_2(class_method_call(A,B,C,D,E,F), class_method_call(A,B,C,D,E,F),
+ Module, Module, Proc, Proc, no).
-lco_in_goal_2(call(A,B,C,D,E,F), _ModuleInfo, call(A,B,C,D,E,F)).
+lco_in_goal_2(call(A,B,C,D,E,F), call(A,B,C,D,E,F), Module, Module,
+ Proc, Proc, no).
-lco_in_goal_2(unify(A,B,C,D,E), _ModuleInfo, unify(A,B,C,D,E)).
+lco_in_goal_2(unify(A,B,C,D,E), unify(A,B,C,D,E), Module, Module, Proc, Proc,
+ no).
-lco_in_goal_2(pragma_c_code(A,B,C,D,E,F,G), _,
- pragma_c_code(A,B,C,D,E,F,G)).
+lco_in_goal_2(pragma_c_code(A,B,C,D,E,F,G), pragma_c_code(A,B,C,D,E,F,G),
+ Module, Module, Proc, Proc, no).
%-----------------------------------------------------------------------------%
-:- pred lco_in_disj(list(hlds_goal), module_info, list(hlds_goal)).
-:- mode lco_in_disj(in, in, out) is det.
+:- pred lco_in_disj(list(hlds_goal), list(hlds_goal), module_info,
+ module_info, proc_info, proc_info, bool).
+:- mode lco_in_disj(in, out, in, out, in, out, out) is det.
-lco_in_disj([], __ModuleInfo, []).
-lco_in_disj([Goal0 | Goals0], ModuleInfo, [Goal | Goals]) :-
- lco_in_goal(Goal0, ModuleInfo, Goal),
- lco_in_disj(Goals0, ModuleInfo, Goals).
+lco_in_disj([], [], Module, Module, Proc, Proc, no).
+lco_in_disj([Goal0 | Goals0], [Goal | Goals], Module0, Module, Proc0, Proc,
+ Changed) :-
+ lco_in_sub_goal(Goal0, Goal, Module0, Module1, Proc0, Proc1, Changed0),
+ lco_in_disj(Goals0, Goals, Module1, Module, Proc1, Proc, Changed1),
+ bool__or(Changed0, Changed1, Changed).
%-----------------------------------------------------------------------------%
-:- pred lco_in_cases(list(case), module_info, list(case)).
-:- mode lco_in_cases(in, in, out) is det.
+:- pred lco_in_cases(list(case), list(case), module_info, module_info,
+ proc_info, proc_info, bool).
+:- mode lco_in_cases(in, out, in, out, in, out, out) is det.
-lco_in_cases([], __ModuleInfo, []).
-lco_in_cases([case(Cons, IMDelta, Goal0) | Cases0], ModuleInfo,
- [case(Cons, IMDelta, Goal) | Cases]) :-
- lco_in_goal(Goal0, ModuleInfo, Goal),
- lco_in_cases(Cases0, ModuleInfo, Cases).
+lco_in_cases([], [], Module, Module, Proc, Proc, no).
+lco_in_cases([case(Cons, IMD, Goal0) | Cases0], [case(Cons, IMD, Goal) | Cases],
+ Module0, Module, Proc0, Proc, Changed) :-
+ lco_in_sub_goal(Goal0, Goal, Module0, Module1, Proc0, Proc1, Changed0),
+ lco_in_cases(Cases0, Cases, Module1, Module, Proc1, Proc, Changed1),
+ bool__or(Changed0, Changed1, Changed).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-% lco_in_conj(RevGoals, Unifies, ModuleInfo, Goals)
+% lco_in_conj(RevGoals, Unifies, Goals, Module0, Module, Proc0, Proc, Changed)
%
% Given a conjunction whose structure is: "goals*,call,construct*",
% move the construction unifications before the call.
%
-% For now the transformation results are usable by humans only.
-% XXX Later we will have to modify the instantiation states
-% recorded for the variables involved in the constructions.
-% The ModuleInfo will be probably be needed by this code.
-%
% We traverse the conjunction backwards (the caller has reversed the list).
% RevGoals is the list of remaining goals in the reversed conjunction list.
% RevUnifies is the list of assignments and constructions delayed by any
@@ -138,23 +182,80 @@
%
% invariant: append(reverse(RevGoals), Unifies) = original conjunction
-:- pred lco_in_conj(list(hlds_goal), list(hlds_goal), module_info,
- list(hlds_goal)).
-:- mode lco_in_conj(in, in, in, out) is det.
-
-lco_in_conj([], Unifies, __ModuleInfo, Unifies).
-lco_in_conj([Goal0 | Goals0], Unifies0, ModuleInfo, Goals) :-
+:- pred lco_in_conj(list(hlds_goal), list(hlds_goal), list(hlds_goal),
+ module_info, module_info, proc_info, proc_info, bool).
+:- mode lco_in_conj(in, in, out, in, out, in, out, out) is det.
+
+lco_in_conj([], Unifies, Unifies, Module, Module, Proc, Proc, no).
+lco_in_conj([Goal0 | Goals0], Unifies0, Goals, Module0, Module, Proc0, Proc,
+ Changed) :-
Goal0 = GoalExpr0 - _,
(
- GoalExpr0 = unify(_, _, _, Unif, _),
- Unif = construct(_, _, _, _)
+ GoalExpr0 = unify(_, _, LHSMode - RHSMode, Unif, _),
+ Unif = construct(_, _, _, _),
+
+ % XXX For now, don't allow LCO on constructions of
+ % higher-order terms. This is because we currently
+ % can't express non-ground higher-order terms.
+ proc_info_inst_table(Proc0, InstTable),
+ mode_get_insts(Module0, LHSMode, _, LFinalInst),
+ \+ inst_is_higher_order_ground(LFinalInst, InstTable, Module0),
+ mode_get_insts(Module0, RHSMode, _, RFinalInst),
+ \+ inst_is_higher_order_ground(RFinalInst, InstTable, Module0)
->
Unifies1 = [Goal0 | Unifies0],
- lco_in_conj(Goals0, Unifies1, ModuleInfo, Goals)
+ lco_in_conj(Goals0, Unifies1, Goals, Module0, Module, Proc0,
+ Proc, Changed)
;
- GoalExpr0 = call(_, _, _, _, _, _)
+ GoalExpr0 = call(CalledPredId, ProcId, Vars, _, _, _),
+
+ % Make sure there were actually some constructions of tagged
+ % types after the call. Otherwise there's no point in doing the
+ % optimisation.
+ list__filter(goal_is_no_tag_construction(Module0, Proc0),
+ Unifies0, NoTagUnifies, Unifies1),
+ Unifies1 \= [],
+
+ % AAA for now, don't allow any constructions of no_tag types.
+ NoTagUnifies = [],
+
+ % XXX - For now, only allow calls to preds within this module.
+ % This is because a new proc will need to be created for the
+ % pred that is called.
+ module_info_pred_info(Module0, CalledPredId, PredInfo),
+ \+ pred_info_is_imported(PredInfo),
+
+ % XXX - Also, we currently only allow one reference per
+ % variable, so make sure there is no more than one reference
+ % to each output variable in the call.
+ pred_info_procedures(PredInfo, ProcTable),
+ map__lookup(ProcTable, ProcId, CalledProcInfo),
+ check_only_one_ref_per_var(Unifies1, Vars, Module0,
+ CalledProcInfo, Proc0),
+
+ % The conservative GC version of solutions does not deep
+ % copy the solutions, so we need to disallow LCO if both the
+ % calling proc and called proc are multi-solution.
+ \+ (
+ module_info_globals(Module0, Globals),
+ globals__get_gc_method(Globals, conservative),
+ proc_info_interface_determinism(Proc0, CallingDet),
+ proc_info_interface_determinism(CalledProcInfo,
+ CalledDet),
+ determinism_components(CallingDet, _, at_most_many),
+ determinism_components(CalledDet, _, at_most_many)
+ )
->
- list__append(Unifies0, [Goal0], LaterGoals),
+ set__init(ChangedVarsSet0),
+ modify_instantiations(Unifies1, Unifies, Goal0, Goal1,
+ NoTagUnifies, Module0, ChangedVarsSet0, ChangedVarsSet,
+ Proc0, Proc),
+ Changed = yes,
+
+ maybe_create_new_proc(ChangedVarsSet, Module0, Module,
+ Goal1, Goal),
+
+ list__append(Unifies, [Goal | NoTagUnifies], LaterGoals),
list__reverse(Goals0, FrontGoals),
list__append(FrontGoals, LaterGoals, Goals)
;
@@ -161,8 +262,745 @@
% The conjunction does not follow the pattern "unify*, goal"
% so we cannot optimize it; reconstruct the original goal list
list__reverse([Goal0 | Goals0], FrontGoals),
- list__append(FrontGoals, Unifies0, Goals)
+ list__append(FrontGoals, Unifies0, Goals1),
+
+ % We may, however, be able to optimise the last conjuct, so
+ % give that a go.
+ list__reverse(Goals1, RevGoals0),
+ ( RevGoals0 = [Last0 | RevGoals1] ->
+ lco_in_sub_goal(Last0, Last, Module0, Module,
+ Proc0, Proc, Changed),
+ list__reverse([Last | RevGoals1], Goals)
+ ;
+ Goals = Goals1,
+ Module = Module0,
+ Proc = Proc0,
+ Changed = no
+ )
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred goal_is_no_tag_construction(module_info, proc_info, hlds_goal).
+:- mode goal_is_no_tag_construction(in, in, in) is semidet.
+
+goal_is_no_tag_construction(Module, Proc, Goal) :-
+ Goal = unify(_, _, _, Unif, _) - _,
+ Unif = construct(Var, _, _, _),
+ proc_info_vartypes(Proc, VarTypes),
+ map__search(VarTypes, Var, Type),
+ type_constructors(Type, Module, Constructors),
+ type_is_no_tag_type(Constructors, _FunctorName, _ArgType).
+
+%-----------------------------------------------------------------------------%
+
+:- pred check_only_one_ref_per_var(list(hlds_goal), list(var),
+ module_info, proc_info, proc_info).
+:- mode check_only_one_ref_per_var(in, in, in, in, in) is semidet.
+
+check_only_one_ref_per_var(Unifies, CallVars, Module, CalledProcInfo,
+ CallingProcInfo) :-
+ Lambda = lambda([Goal::in, Vars::out, N0::in, N::out] is det,
+ (
+ Goal = unify(_, _, _, Unif, _) - _,
+ Unif = construct(_, _, Vars0, _)
+ ->
+ Vars = N0 - Vars0,
+ N is N0 + 1
+ ;
+ error("lco:check_only_one_ref_per_var incorrect goal")
+ )),
+ list__map_foldl(Lambda, Unifies, UnifVars, 0, _),
+
+ proc_info_argmodes(CalledProcInfo,
+ argument_modes(CalledInstTable, CalledModes)),
+ assoc_list__from_corresponding_lists(CallVars, CalledModes,
+ CalledVarModes),
+
+ proc_info_headvars(CallingProcInfo, CallingHeadVars),
+ proc_info_argmodes(CallingProcInfo,
+ argument_modes(CallingInstTable, CallingHeadModes)),
+ assoc_list__from_corresponding_lists(CallingHeadVars, CallingHeadModes,
+ CallingHeadVarModes),
+
+ proc_info_vartypes(CallingProcInfo, Types),
+
+ check_only_one_ref_per_var_2(CalledVarModes, UnifVars, CalledInstTable,
+ Module, Types, CallingHeadVarModes, CallingInstTable).
+
+:- pred check_only_one_ref_per_var_2(assoc_list(var, mode),
+ list(pair(int, list(var))), inst_table, module_info, map(var, type),
+ assoc_list(var, mode), inst_table).
+:- mode check_only_one_ref_per_var_2(in, in, in, in, in, in, in) is semidet.
+
+check_only_one_ref_per_var_2([], _, _, _, _, _, _).
+check_only_one_ref_per_var_2([Var - Mode | VarModes], UnifVars, InstTable,
+ Module, Types, CallingHeadVarModes, CallingInstTable) :-
+ (
+ map__search(Types, Var, Type),
+ mode_to_arg_mode(InstTable, Module, Mode, Type, top_out)
+ ->
+ % Ensure that there is at most one construction
+ % that has this variable on its RHS.
+ \+ (
+ list__member(N1 - Vars1, UnifVars),
+ list__member(N2 - Vars2, UnifVars),
+ N1 < N2,
+ list__member(Var, Vars1),
+ list__member(Var, Vars2)
+ ),
+
+ % Ensure that, if this variable occurs on the RHS
+ % of a construction, then it is not also an output
+ % from the calling procedure.
+ \+ (
+ list__member(_ - Vars, UnifVars),
+ list__member(Var, Vars),
+ list__member(Var - HMode, CallingHeadVarModes),
+ mode_to_arg_mode(CallingInstTable, Module,
+ HMode, Type, ArgMode),
+ ( ArgMode = top_out
+ ; ArgMode = ref_in
+ )
+ )
+ ;
+ true
+ ),
+ check_only_one_ref_per_var_2(VarModes, UnifVars, InstTable, Module,
+ Types, CallingHeadVarModes, CallingInstTable).
+
+%-----------------------------------------------------------------------------%
+
+% We need a proc that is the same as the called proc, but with aliasing on
+% some of the output variables. See if the required proc already exists
+% and if it doesn't, create it.
+
+:- pred maybe_create_new_proc(set(var), module_info, module_info,
+ hlds_goal, hlds_goal).
+:- mode maybe_create_new_proc(in, in, out, in, out) is det.
+
+maybe_create_new_proc(ChangedVars, Module0, Module, Goal0, Goal) :-
+ (
+ Goal0 = call(PredId, ProcId0, Vars, A,B,C) - GoalInfo
+ ->
+ module_info_pred_info(Module0, PredId, PredInfo0),
+ pred_info_procedures(PredInfo0, ProcTable0),
+ map__lookup(ProcTable0, ProcId0, ProcInfo0),
+ proc_info_argmodes(ProcInfo0, ArgModes0),
+ ArgModes0 = argument_modes(ArgInstTable, Modes0),
+ proc_info_inst_table(ProcInfo0, InstTable0),
+ assoc_list__from_corresponding_lists(Vars, Modes0, VarModes0),
+ list__map(change_arg_mode(ChangedVars, Module0, InstTable0),
+ VarModes0, Modes),
+ ArgModes = argument_modes(ArgInstTable, Modes),
+
+ % See if a procedure with these modes already exists
+ ( find_matching_proc(ProcTable0, ArgModes, Module0, ProcId1) ->
+ Goal = call(PredId, ProcId1, Vars, A,B,C) - GoalInfo,
+ Module = Module0
+ ;
+ create_new_proc(ProcTable0, ProcId0, ArgModes, InstTable0,
+ ProcTable1, ProcId),
+ Goal = call(PredId, ProcId, Vars, A,B,C) - GoalInfo,
+ pred_info_set_procedures(PredInfo0, ProcTable1, PredInfo1),
+ module_info_set_pred_info(Module0, PredId, PredInfo1, Module1),
+
+ % Run lco on the new proc.
+ map__lookup(ProcTable1, ProcId, ProcInfo1),
+ proc_info_goal(ProcInfo1, ProcGoal0),
+ lco_in_goal(ProcGoal0, ProcGoal1, Module1, Module2, ProcInfo1,
+ ProcInfo2, _),
+
+ % Fix modes of unifications and calls in the new proc
+ % that bind aliased output arguments.
+ proc_info_headvars(ProcInfo2, HeadVars),
+ proc_info_vartypes(ProcInfo2, Types0),
+ proc_info_inst_table(ProcInfo2, ProcInstTable0),
+ assoc_list__from_corresponding_lists(HeadVars, Modes, VarModes),
+ Filter = lambda([VarMode::in, Var::out] is semidet,
+ (
+ VarMode = Var - Mode,
+ map__lookup(Types0, Var, Type),
+ mode_to_arg_mode(ProcInstTable0, Module2, Mode, Type,
+ ref_in)
+ )),
+ list__filter_map(Filter, VarModes, AliasedVars),
+
+ proc_info_varset(ProcInfo2, VarSet0),
+ proc_info_get_initial_instmap(ProcInfo2, Module2, InstMap),
+
+ FMI0 = fix_modes_info(VarSet0, Types0, ProcInstTable0, InstMap),
+ set__list_to_set(AliasedVars, AliasedVarSet),
+ list__foldl2(
+ lambda([V::in, G0::in, G::out, F0::in, F::out] is det,(
+ fix_modes_of_binding_goal(Module2, AliasedVarSet, V,
+ G0, G, F0, F1),
+ fix_modes_info_set_instmap(F1, InstMap, F)
+ )), AliasedVars, ProcGoal1, ProcGoal, FMI0, FMI),
+
+ proc_info_set_goal(ProcInfo2, ProcGoal, ProcInfo3),
+ FMI = fix_modes_info(VarSet, Types, ProcInstTable, _),
+ proc_info_set_varset(ProcInfo3, VarSet, ProcInfo4),
+ proc_info_set_vartypes(ProcInfo4, Types, ProcInfo5),
+ proc_info_set_inst_table(ProcInfo5, ProcInstTable, ProcInfo),
+ map__set(ProcTable1, ProcId, ProcInfo, ProcTable),
+ pred_info_set_procedures(PredInfo1, ProcTable, PredInfo),
+ module_info_set_pred_info(Module2, PredId, PredInfo, Module)
+ )
+ ;
+ error("lco:maybe_create_new_proc: internal error")
+ ).
+
+:- pred get_unused_proc_id(proc_id, proc_table, proc_id).
+:- mode get_unused_proc_id(in, in, out) is det.
+
+get_unused_proc_id(ProcId0, ProcTable, ProcId) :-
+ ( map__contains(ProcTable, ProcId0) ->
+ hlds_pred__next_proc_id(ProcId0, ProcId1),
+ get_unused_proc_id(ProcId1, ProcTable, ProcId)
+ ;
+ ProcId = ProcId0
+ ).
+
+
+% If Var is in the set of variables that need their modes changed and mode
+% is (free(unique) -> I), then change mode to (free(alias) -> I).
+:- pred change_arg_mode(set(var), module_info, inst_table, pair(var, mode),
+ mode).
+:- mode change_arg_mode(in, in, in, in, out) is det.
+
+change_arg_mode(VarSet, Module, InstTable, Var - Mode0, Mode) :-
+ (
+ set__member(Var, VarSet),
+ mode_is_output(InstTable, Module, Mode0)
+ ->
+ mode_get_insts(Module, Mode0, _, FinalInst),
+ Mode = (free(alias) -> FinalInst)
+ ;
+ Mode = Mode0
).
+% Find a procedure in the ProcTable that has argmodes equivalent to those
+% given.
+:- pred find_matching_proc(proc_table, argument_modes, module_info, proc_id).
+:- mode find_matching_proc(in, in, in, out) is semidet.
+
+find_matching_proc(ProcTable, ArgModesA, Module, ProcId) :-
+ ArgModesA = argument_modes(InstTableA, ModesA),
+ Lambda = lambda([ProcInfo::in] is semidet,
+ (
+ proc_info_argmodes(ProcInfo, ArgModesB),
+ ArgModesB = argument_modes(InstTableB, ModesB),
+ assoc_list__from_corresponding_lists(ModesA, ModesB,
+ ModesAB),
+ \+ ( list__member(A - B, ModesAB),
+ \+ (
+ mode_get_insts(Module, A, IA, FA),
+ mode_get_insts(Module, B, IB, FB),
+ inst_expand(InstTableA, Module, IA, I),
+ inst_expand(InstTableB, Module, IB, I),
+ inst_expand(InstTableA, Module, FA, F),
+ inst_expand(InstTableB, Module, FB, F),
+ alias_iff_alias(IA, IB),
+ alias_iff_alias(FA, FB)
+ )
+ )
+ )),
+ get_first_from_map(Lambda, ProcTable, ProcId).
+
+% XXX InstA = alias(_) <=> InstB = alias(_).
+% Get around a bug which currently does not allow this goal as written above.
+:- pred alias_iff_alias((inst)::in, (inst)::in) is semidet.
+
+alias_iff_alias(alias(_), alias(_)).
+alias_iff_alias(IA, IB) :-
+ IA \= alias(_),
+ IB \= alias(_).
+
+:- pred create_new_proc(proc_table, proc_id, argument_modes, inst_table,
+ proc_table, proc_id).
+:- mode create_new_proc(in, in, in, in, out, out) is det.
+
+create_new_proc(ProcTable0, OldProcId, ArgModes, InstTable, ProcTable,
+ NewProcId) :-
+ get_unused_proc_id(OldProcId, ProcTable0, NewProcId),
+ map__lookup(ProcTable0, OldProcId, ProcInfo0),
+ proc_info_set_argmodes(ProcInfo0, ArgModes, ProcInfo1),
+ proc_info_set_inst_table(ProcInfo1, InstTable, ProcInfo),
+ map__det_insert(ProcTable0, NewProcId, ProcInfo, ProcTable).
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
+:- pred modify_instantiations(list(hlds_goal), list(hlds_goal), hlds_goal,
+ hlds_goal, list(hlds_goal), module_info, set(var), set(var),
+ proc_info, proc_info).
+:- mode modify_instantiations(in, out, in, out, in, in, in, out, in, out)
+ is det.
+
+modify_instantiations([], [], Call, Call, _NoTagUnifies, _Module,
+ VarSet, VarSet, ProcInfo, ProcInfo).
+modify_instantiations([Unify0 | Unifies0], [Unify | Unifies], Call0, Call,
+ NoTagUnifies, Module, VarSet0, VarSet, ProcInfo0, ProcInfo) :-
+ (
+ Unify0 = UnifyExpr0 - UnifyInfo0,
+ UnifyExpr0 = unify(Var, RHS, Mode, Unification0, Context),
+ Unification0 = construct(UnifVar, ConsId, UnifVars, UniModes0),
+ Call0 = CallExpr - CallInfo0,
+ CallExpr = call(_, _, _CallVars, _, _, _)
+ ->
+ goal_info_get_instmap_delta(UnifyInfo0, UnifIMD0),
+ goal_info_get_instmap_delta(CallInfo0, CallIMD0),
+ assoc_list__from_corresponding_lists(UnifVars, UniModes0,
+ UnifVarModes0),
+ proc_info_inst_table(ProcInfo0, InstTable0),
+
+ modify_instmap_deltas(UnifVarModes0, UniModes, NoTagUnifies,
+ InstTable0, InstTable, Module, UnifIMD0, UnifIMD,
+ CallIMD0, CallIMD, VarSet0, VarSet1),
+
+ proc_info_set_inst_table(ProcInfo0, InstTable, ProcInfo1),
+ Unification = construct(UnifVar, ConsId, UnifVars, UniModes),
+ UnifyExpr = unify(Var, RHS, Mode, Unification, Context),
+ goal_info_set_instmap_delta(UnifyInfo0, UnifIMD, UnifyInfo),
+ Unify = UnifyExpr - UnifyInfo,
+ goal_info_set_instmap_delta(CallInfo0, CallIMD, CallInfo),
+ Call1 = CallExpr - CallInfo,
+ modify_instantiations(Unifies0, Unifies, Call1, Call,
+ NoTagUnifies, Module, VarSet1, VarSet,
+ ProcInfo1, ProcInfo)
+ ;
+ error("modify_instantiations: goal not of correct type")
+ ).
+
+:- pred modify_instmap_deltas(assoc_list(var, uni_mode), list(uni_mode),
+ list(hlds_goal), inst_table, inst_table, module_info,
+ instmap_delta, instmap_delta, instmap_delta, instmap_delta,
+ set(var), set(var)).
+:- mode modify_instmap_deltas(in, out, in, in, out, in, in, out, in, out,
+ in, out) is det.
+
+modify_instmap_deltas([], [], _, InstTable, InstTable, _, UnifIMD, UnifIMD,
+ CallIMD, CallIMD, VarSet, VarSet).
+modify_instmap_deltas([UnifVar - UniMode0 | VarModes], [UniMode | UniModes],
+ NoTagUnifies, InstTable0, InstTable, Module, UnifIMD0, UnifIMD,
+ CallIMD0, CallIMD, VarSet0, VarSet) :-
+ ( bound_in_imds(UnifVar, CallIMD0, NoTagUnifies, InstTable0, Module) ->
+ % We don't actually need to modify CallIMD here because it is
+ % done by `recompute_instmap_delta'.
+ CallIMD1 = CallIMD0,
+ inst_table_get_inst_key_table(InstTable0, IKT0),
+ inst_key_table_add(IKT0, free(alias), IK, IKT),
+ inst_table_set_inst_key_table(InstTable0, IKT,
+ InstTable1),
+ NewInst = alias(IK),
+ UniMode = ((free(unique) - free(unique)) ->
+ (NewInst - NewInst)),
+ (
+ instmap_delta_search_var(UnifIMD0, UnifVar, Inst0),
+ Inst0 = alias(IK0)
+ ->
+ instmap_delta_to_assoc_list(UnifIMD0, AL0),
+ assoc_list__values(AL0, Insts0),
+ map__init(Sub0),
+ map__set(Sub0, IK0, IK, Sub),
+ list__map(inst_apply_sub(Sub), Insts0, Insts),
+ assoc_list__keys(AL0, Vars),
+ assoc_list__from_corresponding_lists(Vars,
+ Insts, AL),
+ instmap_delta_from_assoc_list(AL, UnifIMD1)
+ ;
+ UnifIMD1 = UnifIMD0
+ ),
+ set__insert(VarSet0, UnifVar, VarSet1)
+ ;
+ UniMode = UniMode0,
+ UnifIMD1 = UnifIMD0,
+ CallIMD1 = CallIMD0,
+ InstTable1 = InstTable0,
+ VarSet1 = VarSet0
+ ),
+ modify_instmap_deltas(VarModes, UniModes, NoTagUnifies,
+ InstTable1, InstTable, Module, UnifIMD1, UnifIMD,
+ CallIMD1, CallIMD, VarSet1, VarSet).
+
+% bound_in_imds(Var, IMD, Goals, InstTable, Module)
+% succeeds if variable is bound in IMD or any of the IMD's in Goals..
+:- pred bound_in_imds(var::in, instmap_delta::in, list(hlds_goal)::in,
+ inst_table::in, module_info::in) is semidet.
+
+bound_in_imds(Var, IMD, _Goals, InstTable, Module) :-
+ bound_in_imd(Var, IMD, InstTable, Module).
+bound_in_imds(Var, _IMD, Goals, InstTable, Module) :-
+ list__member(_ - GoalInfo, Goals),
+ goal_info_get_instmap_delta(GoalInfo, GoalIMD),
+ bound_in_imd(Var, GoalIMD, InstTable, Module).
+
+:- pred bound_in_imd(var::in, instmap_delta::in, inst_table::in,
+ module_info::in) is semidet.
+
+bound_in_imd(Var, IMD, InstTable, Module) :-
+ instmap_delta_search_var(IMD, Var, Inst),
+ inst_is_bound(Inst, InstTable, Module).
+
+%---------------------------------------------------------------------------%
+
+:- type fix_modes_info
+ ---> fix_modes_info(varset, map(var, type), inst_table, instmap).
+
+:- pred fix_modes_info_apply_instmap_delta(fix_modes_info, instmap_delta,
+ fix_modes_info).
+:- mode fix_modes_info_apply_instmap_delta(in, in, out) is det.
+
+fix_modes_info_apply_instmap_delta(FMI0, IMD, FMI) :-
+ FMI0 = fix_modes_info(A, B, C, IM0),
+ instmap__apply_instmap_delta(IM0, IMD, IM),
+ FMI = fix_modes_info(A, B, C, IM).
+
+:- pred fix_modes_info_get_instmap(fix_modes_info, instmap).
+:- mode fix_modes_info_get_instmap(in, out) is det.
+
+fix_modes_info_get_instmap(fix_modes_info(_, _, _, InstMap), InstMap).
+
+:- pred fix_modes_info_set_instmap(fix_modes_info, instmap, fix_modes_info).
+:- mode fix_modes_info_set_instmap(in, in, out) is det.
+
+fix_modes_info_set_instmap(fix_modes_info(A, B, C, _), InstMap,
+ fix_modes_info(A, B, C, InstMap)).
+
+% After creating a new proc with aliased output arguments, it is necessary
+% to alter the modes of any unifications within the proc goal that bind those
+% arguments. If the arguments are bound in a call then an assignment
+% may need to be added after the call.
+
+:- pred fix_modes_of_binding_goal(module_info, set(var), var,
+ hlds_goal, hlds_goal, fix_modes_info, fix_modes_info).
+:- mode fix_modes_of_binding_goal(in, in, in, in, out, in, out) is det.
+
+fix_modes_of_binding_goal(Module, AliasedVars, Var, GoalExpr0 - GoalInfo,
+ GoalExpr - GoalInfo, FMI0, FMI) :-
+ goal_info_get_instmap_delta(GoalInfo, IMD),
+ FMI0 = fix_modes_info(_, VarTypes, InstTable, InstMap0),
+ instmap__lookup_var(InstMap0, Var, InitialInst),
+ map__lookup(VarTypes, Var, Type),
+ (
+ % Does the goal bind Var?
+ instmap_delta_search_var(IMD, Var, FinalInst),
+ mode_to_arg_mode(InstTable, Module, (InitialInst -> FinalInst),
+ Type, ref_in)
+ ->
+ fix_modes_of_binding_goal_2(GoalExpr0, FMI0, GoalInfo,
+ Module, AliasedVars, Var, GoalExpr, FMI1)
+ ;
+ GoalExpr = GoalExpr0,
+ FMI1 = FMI0
+ ),
+ fix_modes_info_apply_instmap_delta(FMI1, IMD, FMI).
+
+:- pred fix_modes_of_binding_goal_2(hlds_goal_expr, fix_modes_info,
+ hlds_goal_info, module_info, set(var), var, hlds_goal_expr,
+ fix_modes_info).
+:- mode fix_modes_of_binding_goal_2(in, in, in, in, in, in, out, out) is det.
+
+fix_modes_of_binding_goal_2(conj(Goals0), FMI0, _, Module, AliasedVars, Var,
+ conj(Goals), FMI) :-
+ list__map_foldl(fix_modes_of_binding_goal(Module, AliasedVars, Var),
+ Goals0, Goals, FMI0, FMI).
+
+fix_modes_of_binding_goal_2(par_conj(Goals0, SM), FMI0, _, Module,
+ AliasedVars, Var, par_conj(Goals, SM), FMI) :-
+ Lambda = lambda([Goal0::in, Goal::out, F0::in, F::out] is det,
+ (
+ fix_modes_info_get_instmap(F0, InstMap),
+ fix_modes_of_binding_goal(Module, AliasedVars, Var,
+ Goal0, Goal, F0, F1),
+ fix_modes_info_set_instmap(F1, InstMap, F)
+ )),
+ list__map_foldl(Lambda, Goals0, Goals, FMI0, FMI).
+
+fix_modes_of_binding_goal_2(call(PredId, ProcId0, Vars0, D, E, F), FMI0,
+ GoalInfo0, Module, AliasedVars, Var, Goal, FMI) :-
+ (
+ replace_call_proc_with_aliased_version(PredId, ProcId0, FMI0,
+ Module, Var, AliasedVars, Vars0, ProcId)
+ ->
+ FMI = FMI0,
+ Goal = call(PredId, ProcId, Vars0, D, E, F)
+ ;
+ add_unification_to_goal(Vars0, FMI0, GoalInfo0, Module, Var,
+ Vars, FMI, GoalInfo, Assign),
+ ( Vars = Vars0 ->
+ Goal = call(PredId, ProcId0, Vars0, D, E, F)
+ ;
+ Call = call(PredId, ProcId0, Vars, D, E, F) - GoalInfo,
+ Goal = conj([Call, Assign])
+ )
+ ).
+
+fix_modes_of_binding_goal_2(higher_order_call(A, Vars0, C, D, E, F), FMI0,
+ GoalInfo0, Module, _AliasedVars, Var, Goal, FMI) :-
+ add_unification_to_goal(Vars0, FMI0, GoalInfo0, Module, Var,
+ Vars, FMI, GoalInfo, Assign),
+ HigherOrder = higher_order_call(A, Vars, C, D, E, F) - GoalInfo,
+ Goal = conj([HigherOrder, Assign]).
+
+fix_modes_of_binding_goal_2(switch(SVar, Det, Cases0, SM), FMI0, _,
+ Module, AliasedVars, Var, switch(SVar, Det, Cases, SM), FMI) :-
+ Lambda = lambda([Case0::in, Case::out, F0::in, F::out] is det,
+ (
+ Case0 = case(ConsId, CaseIMD, Goal0),
+ fix_modes_info_get_instmap(F0, InstMap),
+ fix_modes_of_binding_goal(Module, AliasedVars, Var,
+ Goal0, Goal, F0, F1),
+ Case = case(ConsId, CaseIMD, Goal),
+ fix_modes_info_set_instmap(F1, InstMap, F)
+ )),
+ list__map_foldl(Lambda, Cases0, Cases, FMI0, FMI).
+
+fix_modes_of_binding_goal_2(unify(LHS, RHS0, Modes0, Unif0, Cont), FMI0,
+ GoalInfo0, Module, _AliasedVars, Var, Goal, FMI) :-
+ fix_modes_of_unify(Unif0, RHS0, Modes0, FMI0, GoalInfo0, Module, Var,
+ Unif, RHS, Modes, FMI, GoalInfo, MaybeAssign),
+ UnifyGoal = unify(LHS, RHS, Modes, Unif, Cont),
+ (
+ MaybeAssign = no,
+ Goal = UnifyGoal
+ ;
+ MaybeAssign = yes(Assign),
+ Goal = conj([UnifyGoal - GoalInfo, Assign])
+ ).
+
+fix_modes_of_binding_goal_2(disj(Goals0, SM), FMI0, _, Module, AliasedVars,
+ Var, disj(Goals, SM), FMI) :-
+ Lambda = lambda([Goal0::in, Goal::out, F0::in, F::out] is det,
+ (
+ fix_modes_info_get_instmap(F0, InstMap),
+ fix_modes_of_binding_goal(Module, AliasedVars, Var,
+ Goal0, Goal, F0, F1),
+ fix_modes_info_set_instmap(F1, InstMap, F)
+ )),
+ list__map_foldl(Lambda, Goals0, Goals, FMI0, FMI).
+
+fix_modes_of_binding_goal_2(not(Goal), FMI, _, _, _, _, not(Goal),
+ FMI).
+
+fix_modes_of_binding_goal_2(some(Vars, Goal0), FMI0, _, Module, AliasedVars,
+ Var, some(Vars, Goal), FMI) :-
+ fix_modes_of_binding_goal(Module, AliasedVars, Var, Goal0, Goal, FMI0,
+ FMI).
+
+fix_modes_of_binding_goal_2(if_then_else(Vars, Cond, Then0, Else0, SM),
+ FMI0, _, Module, AliasedVars, Var,
+ if_then_else(Vars, Cond, Then, Else, SM), FMI) :-
+ fix_modes_info_get_instmap(FMI0, InstMap0),
+ Cond = _ - CondGoalInfo,
+ goal_info_get_instmap_delta(CondGoalInfo, IMD),
+ fix_modes_info_apply_instmap_delta(FMI0, IMD, FMI1),
+ fix_modes_of_binding_goal(Module, AliasedVars, Var, Then0, Then, FMI1,
+ FMI2),
+ fix_modes_info_set_instmap(FMI2, InstMap0, FMI3),
+ fix_modes_of_binding_goal(Module, AliasedVars, Var, Else0, Else, FMI3,
+ FMI).
+
+fix_modes_of_binding_goal_2(pragma_c_code(A, B, C, Vars0, E, F, G),
+ FMI0, GoalInfo0, Module, _AliasedVars, Var, Goal, FMI) :-
+ add_unification_to_goal(Vars0, FMI0, GoalInfo0, Module, Var,
+ Vars, FMI, GoalInfo, Assign),
+ PragmaC = pragma_c_code(A, B, C, Vars, E, F, G) - GoalInfo,
+ Goal = conj([PragmaC, Assign]).
+
+fix_modes_of_binding_goal_2(class_method_call(A, B, Vars0, D, E, F), FMI0,
+ GoalInfo0, Module, _AliasedVars, Var, Goal, FMI) :-
+ add_unification_to_goal(Vars0, FMI0, GoalInfo0, Module, Var, Vars, FMI,
+ GoalInfo, Assign),
+ ClassMethodCall = class_method_call(A, B, Vars, D, E, F) - GoalInfo,
+ Goal = conj([ClassMethodCall, Assign]).
+
+:- pred add_unification_to_goal(list(var), fix_modes_info, hlds_goal_info,
+ module_info, var, list(var), fix_modes_info, hlds_goal_info,
+ hlds_goal).
+:- mode add_unification_to_goal(in, in, in, in, in, out, out, out, out) is det.
+
+add_unification_to_goal(Vars0, FMI0, GoalInfo0, Module, Var,
+ Vars, FMI, CallGoalInfo, Assign):-
+ FMI0 = fix_modes_info(VarSet0, VarTypes0, InstTable, InstMap),
+ varset__new_var(VarSet0, NewVar, VarSet),
+ map__lookup(VarTypes0, Var, Type),
+ map__det_insert(VarTypes0, NewVar, Type, VarTypes),
+
+ FMI1 = fix_modes_info(VarSet, VarTypes, InstTable, InstMap),
+
+ goal_info_get_instmap_delta(GoalInfo0, IMD0),
+ ( instmap_delta_search_var(IMD0, Var, Inst0) ->
+ Inst = Inst0
+ ;
+ error("lco:fix_modes_of_binding_goal: internal error")
+ ),
+ map__init(Sub0),
+ map__det_insert(Sub0, Var, NewVar, Sub),
+ instmap_delta_apply_sub(IMD0, no, Sub, IMD),
+ goal_info_set_instmap_delta(GoalInfo0, IMD, CallGoalInfo1),
+ goal_info_get_nonlocals(CallGoalInfo1, CallNonLocals0),
+ set__delete(CallNonLocals0, Var, CallNonLocals1),
+ set__insert(CallNonLocals1, NewVar, CallNonLocals),
+ goal_info_set_nonlocals(CallGoalInfo1, CallNonLocals, CallGoalInfo),
+
+ list__replace_all(Vars0, Var, NewVar, Vars),
+ Modes = (free(alias) -> Inst) - (Inst -> Inst),
+ goal_info_init(AssignGoalInfo0),
+ instmap_delta_init_reachable(AssignIMD0),
+ instmap_delta_set(AssignIMD0, Var, Inst, AssignIMD),
+ goal_info_set_instmap_delta(AssignGoalInfo0, AssignIMD,
+ AssignGoalInfo1),
+ goal_info_set_determinism(AssignGoalInfo1, det, AssignGoalInfo2),
+ set__list_to_set([Var, NewVar], NonLocals),
+ goal_info_set_nonlocals(AssignGoalInfo2, NonLocals, AssignGoalInfo),
+ Assign0 = unify(Var, var(NewVar), Modes, assign(Var, NewVar),
+ unify_context(explicit, [])) - AssignGoalInfo,
+
+ set__init(DummyVars),
+ fix_modes_of_binding_goal(Module, DummyVars, Var, Assign0, Assign,
+ FMI1, FMI).
+
+:- pred fix_modes_of_unify(unification, unify_rhs, unify_mode, fix_modes_info,
+ hlds_goal_info, module_info, var, unification, unify_rhs,
+ unify_mode, fix_modes_info, hlds_goal_info, maybe(hlds_goal)).
+:- mode fix_modes_of_unify(in, in, in, in, in, in, in, out, out, out, out,
+ out, out) is det.
+
+fix_modes_of_unify(construct(LHSVar, ConsId, Vars, UniModes0), RHS, Modes,
+ FMI0, GoalInfo, Module, Var,
+ construct(LHSVar, ConsId, Vars, UniModes), RHS, Modes, FMI,
+ GoalInfo, no) :-
+ ( LHSVar = Var ->
+ FMI0 = fix_modes_info(VarSet, VarTypes, InstTable0, InstMap),
+ list__map_foldl(fix_uni_mode(Module),
+ UniModes0, UniModes, InstTable0, InstTable),
+ FMI = fix_modes_info(VarSet, VarTypes, InstTable, InstMap)
+ ;
+ error("lco:fix_mode_of_unify: LHSVar \\= Var")
+ ).
+
+fix_modes_of_unify(deconstruct(LHSVar, ConsId, Vars0, UniModes, CanFail),
+ RHS0, Modes, FMI0, GoalInfo0, Module, Var,
+ deconstruct(LHSVar, ConsId, Vars, UniModes, CanFail), RHS,
+ Modes, FMI, GoalInfo, yes(Assign)) :-
+ add_unification_to_goal(Vars0, FMI0, GoalInfo0, Module, Var, Vars,
+ FMI, GoalInfo, Assign),
+ ( RHS0 = functor(ConsId, _) ->
+ RHS = functor(ConsId, Vars)
+ ;
+ RHS = RHS0
+ ).
+
+fix_modes_of_unify(assign(L, R), RHS, Modes0, FMI, GoalInfo, _, _,
+ assign(L, R), RHS, Modes, FMI, GoalInfo, no) :-
+ Modes = Modes0.
+
+% Shouldn't get simple_test binding a variable.
+fix_modes_of_unify(simple_test(_, _),_,_,_,_,_,_,_,_,_,_,_,_) :-
+ error("lco:fix_modes_of_unify: simple_test in unify").
+
+% Should already have been transformed into calls by polymorphism.m.
+fix_modes_of_unify(complicated_unify(_, _),_,_,_,_,_,_,_,_,_,_,_,_) :-
+ error("lco:fix_modes_of_unify: complicated_unify").
+
+:- pred fix_uni_mode(module_info, uni_mode, uni_mode, inst_table,
+ inst_table).
+:- mode fix_uni_mode(in, in, out, in, out) is det.
+
+fix_uni_mode(Module, UniMode0, UniMode, InstTable0, InstTable) :-
+ UniMode0 = ((LI0 - RI) -> (LF - RF)),
+ ( inst_is_free(LI0, InstTable0, Module) ->
+ ( LI0 = alias(_) ->
+ LI = LI0,
+ InstTable = InstTable0
+ ;
+ inst_table_get_inst_key_table(InstTable0, IKT0),
+ inst_key_table_add(IKT0, free(alias), IK, IKT),
+ inst_table_set_inst_key_table(InstTable0, IKT,
+ InstTable),
+ LI = alias(IK)
+ ),
+ UniMode = ((LI - RI) -> (LF - RF))
+ ;
+ error("lco:fix_uni_mode: unexpected inst")
+ ).
+
+
+% Try to find a mode of the predicate that is the same as the input ProcId0
+% except that Var is ref_in intead of top_out. Any varibles in AliasedVars
+% that are top_out in ProcId0 may be either top_out or ref_in in ProcId
+% (it is better if they are ref_in). All other args must have the same
+% mode in both procedures.
+
+:- pred replace_call_proc_with_aliased_version(pred_id, proc_id,
+ fix_modes_info, module_info, var, set(var), list(var), proc_id).
+:- mode replace_call_proc_with_aliased_version(in, in, in, in, in, in, in, out)
+ is semidet.
+
+replace_call_proc_with_aliased_version(PredId, ProcId0, FMI, Module, Var,
+ AliasedVars, CallVars, ProcId) :-
+ module_info_pred_info(Module, PredId, PredInfo),
+ pred_info_procedures(PredInfo, ProcTable),
+ map__lookup(ProcTable, ProcId0, ProcInfo0),
+ proc_info_argmodes(ProcInfo0, argument_modes(InstTableA, ModesA)),
+ FMI = fix_modes_info(_, _, InstTable, InstMap),
+
+ Lambda = lambda([ProcInfo::in] is semidet,
+ (
+ proc_info_argmodes(ProcInfo, ArgModesB),
+ ArgModesB = argument_modes(InstTableB, ModesB),
+ assoc_list__from_corresponding_lists(ModesA, ModesB, ModesAB),
+ assoc_list__from_corresponding_lists(ModesAB, CallVars,
+ ModeVars),
+ \+ ( list__member(A - B - V, ModeVars),
+ \+ (
+ mode_get_insts(Module, A, IA, FA),
+ mode_get_insts(Module, B, IB, FB),
+ inst_expand(InstTableA, Module, FA, F),
+ inst_expand(InstTableB, Module, FB, F),
+ ( V = Var ->
+ inst_is_free_alias(IB, InstTableB, Module)
+ ; set__member(V, AliasedVars) ->
+ % Make sure mode is no worse than what we already
+ % have.
+ inst_is_free_alias(IA, InstTableA, Module)
+ => inst_is_free_alias(IB, InstTableB, Module),
+
+ % If V is free(alias) then either free(alias) or
+ % free(unique) will do for the initial inst here.
+ % If the new proc has free(unique) and there is
+ % another proc that is free(alias) both for
+ % V and Var, then that proc will be found when
+ % fix_modes_of_binding_goal is called for V.
+ instmap__lookup_var(InstMap, V, InstV),
+ inst_is_free_alias(InstV, InstTable, Module)
+ => inst_is_free(IB, InstTableB, Module)
+ ;
+ inst_expand(InstTableA, Module, IA, I),
+ inst_expand(InstTableB, Module, IB, I)
+ )
+ )
+ )
+ )),
+ get_first_from_map(Lambda, ProcTable, ProcId).
+
+
+% Perhaps these two preds should be in the library?
+
+:- pred get_first_from_map(pred(V), map(K, V), K).
+:- mode get_first_from_map(pred(in) is semidet, in, out) is semidet.
+
+get_first_from_map(P, M, K) :-
+ map__to_assoc_list(M, AL),
+ get_first_from_assoc_list(P, AL, K).
+
+:- pred get_first_from_assoc_list(pred(V), assoc_list(K, V), K).
+:- mode get_first_from_assoc_list(pred(in) is semidet, in, out) is semidet.
+
+get_first_from_assoc_list(P, [K0 - V0 | Rest], K) :-
+ ( call(P, V0) ->
+ K = K0
+ ;
+ get_first_from_assoc_list(P, Rest, K)
+ ).
Index: compiler/live_vars.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/live_vars.m,v
retrieving revision 1.67.2.6
diff -u -r1.67.2.6 live_vars.m
--- 1.67.2.6 1998/06/17 04:12:59
+++ live_vars.m 1998/06/22 01:02:57
@@ -46,7 +46,7 @@
proc_info_goal(ProcInfo0, Goal0),
proc_info_interface_code_model(ProcInfo0, CodeModel),
- initial_liveness(ProcInfo0, PredId, ModuleInfo, Liveness0),
+ initial_liveness(ProcInfo0, PredId, ModuleInfo, Liveness0, _Refs),
set__init(LiveSets0),
module_info_globals(ModuleInfo, Globals),
globals__get_trace_level(Globals, TraceLevel),
Index: compiler/liveness.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/liveness.m,v
retrieving revision 1.81.2.9
diff -u -r1.81.2.9 liveness.m
--- 1.81.2.9 1998/06/17 04:13:04
+++ liveness.m 1998/06/22 01:02:57
@@ -135,8 +135,8 @@
% Return the set of variables live at the start of the procedure.
-:- pred initial_liveness(proc_info, pred_id, module_info, set(var)).
-:- mode initial_liveness(in, in, in, out) is det.
+:- pred initial_liveness(proc_info, pred_id, module_info, set(var), set(var)).
+:- mode initial_liveness(in, in, in, out, out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -174,9 +174,9 @@
live_info_init(ModuleInfo, ProcInfo1, TypeInfoLiveness,
VarTypes, Varset, LiveInfo),
- initial_liveness(ProcInfo1, PredId, ModuleInfo, Liveness0),
- detect_liveness_in_goal(Goal0, Liveness0, LiveInfo,
- _, Goal1),
+ initial_liveness(ProcInfo1, PredId, ModuleInfo, Liveness0, Refs0),
+ detect_liveness_in_goal(Goal0, Liveness0, Refs0, LiveInfo,
+ _, _, Goal1),
initial_deadness(ProcInfo1, LiveInfo, ModuleInfo, Deadness0),
detect_deadness_in_goal(Goal1, Deadness0, LiveInfo, _, Goal2),
@@ -196,12 +196,12 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-:- pred detect_liveness_in_goal(hlds_goal, set(var), live_info,
- set(var), hlds_goal).
-:- mode detect_liveness_in_goal(in, in, in, out, out) is det.
+:- pred detect_liveness_in_goal(hlds_goal, set(var), set(var), live_info,
+ set(var), set(var), hlds_goal).
+:- mode detect_liveness_in_goal(in, in, in, in, out, out, out) is det.
-detect_liveness_in_goal(Goal0 - GoalInfo0, Liveness0, LiveInfo,
- Liveness, Goal - GoalInfo) :-
+detect_liveness_in_goal(Goal0 - GoalInfo0, Liveness0, Refs0, LiveInfo,
+ Liveness, Refs, Goal - GoalInfo) :-
% work out which variables get born in this goal
liveness__get_nonlocals_and_typeinfos(LiveInfo, GoalInfo0, NonLocals),
@@ -210,13 +210,16 @@
goal_info_get_instmap_delta(GoalInfo0, InstMapDelta),
set__init(Empty),
( instmap_delta_is_unreachable(InstMapDelta) ->
- Births = Empty
+ Births = Empty,
+ RefBirths = Empty
;
set__init(Births0),
+ set__init(RefBirths0),
find_value_giving_occurrences(NewVarsList, LiveInfo,
- InstMapDelta, Births0, Births)
+ InstMapDelta, Births0, Births, RefBirths0, RefBirths)
),
set__union(Liveness0, Births, Liveness),
+ set__union(Refs0, RefBirths, Refs),
(
goal_is_atomic(Goal0)
->
@@ -228,7 +231,7 @@
;
PreDeaths = Empty,
PreBirths = Empty,
- detect_liveness_in_goal_2(Goal0, Liveness0, NonLocals,
+ detect_liveness_in_goal_2(Goal0, Liveness0, Refs0, NonLocals,
LiveInfo, ActualLiveness, Goal),
set__intersect(NonLocals, ActualLiveness, NonLocalLiveness),
set__union(NonLocalLiveness, Liveness0, FinalLiveness),
@@ -241,47 +244,51 @@
goal_info_set_pre_births(GoalInfo1, PreBirths, GoalInfo2),
goal_info_set_post_deaths(GoalInfo2, PostDeaths, GoalInfo3),
goal_info_set_post_births(GoalInfo3, PostBirths, GoalInfo4),
- goal_info_set_resume_point(GoalInfo4, no_resume_point, GoalInfo).
+ goal_info_set_refs(GoalInfo4, Refs, GoalInfo5),
+ goal_info_set_resume_point(GoalInfo5, no_resume_point, GoalInfo).
%-----------------------------------------------------------------------------%
% Here we process each of the different sorts of goals.
-:- pred detect_liveness_in_goal_2(hlds_goal_expr, set(var), set(var),
+:- pred detect_liveness_in_goal_2(hlds_goal_expr, set(var), set(var), set(var),
live_info, set(var), hlds_goal_expr).
-:- mode detect_liveness_in_goal_2(in, in, in, in, out, out) is det.
+:- mode detect_liveness_in_goal_2(in, in, in, in, in, out, out) is det.
-detect_liveness_in_goal_2(conj(Goals0), Liveness0, _, LiveInfo,
+detect_liveness_in_goal_2(conj(Goals0), Liveness0, Refs0, _, LiveInfo,
Liveness, conj(Goals)) :-
- detect_liveness_in_conj(Goals0, Liveness0, LiveInfo, Liveness, Goals).
+ detect_liveness_in_conj(Goals0, Liveness0, Refs0, LiveInfo, Liveness,
+ Goals).
-detect_liveness_in_goal_2(par_conj(Goals0, SM), Liveness0, NonLocals, LiveInfo,
- Liveness, par_conj(Goals, SM)) :-
+detect_liveness_in_goal_2(par_conj(Goals0, SM), Liveness0, Refs0, NonLocals,
+ LiveInfo, Liveness, par_conj(Goals, SM)) :-
set__init(Union0),
detect_liveness_in_par_conj(Goals0, Liveness0, NonLocals, LiveInfo,
- Union0, Union, Goals),
+ Union0, Union, Refs0, _Refs, Goals),
set__union(Liveness0, Union, Liveness).
-detect_liveness_in_goal_2(disj(Goals0, SM), Liveness0, NonLocals, LiveInfo,
- Liveness, disj(Goals, SM)) :-
+detect_liveness_in_goal_2(disj(Goals0, SM), Liveness0, Refs0, NonLocals,
+ LiveInfo, Liveness, disj(Goals, SM)) :-
set__init(Union0),
detect_liveness_in_disj(Goals0, Liveness0, NonLocals, LiveInfo,
- Union0, Union, Goals),
+ Union0, Union, Refs0, _Refs, Goals),
set__union(Liveness0, Union, Liveness).
-detect_liveness_in_goal_2(switch(Var, Det, Cases0, SM), Liveness0, NonLocals,
- LiveInfo, Liveness, switch(Var, Det, Cases, SM)) :-
+detect_liveness_in_goal_2(switch(Var, Det, Cases0, SM), Liveness0, Refs0,
+ NonLocals, LiveInfo, Liveness, switch(Var, Det, Cases, SM)) :-
detect_liveness_in_cases(Cases0, Liveness0, NonLocals, LiveInfo,
- Liveness0, Liveness, Cases).
+ Liveness0, Liveness, Refs0, _Refs, Cases).
-detect_liveness_in_goal_2(not(Goal0), Liveness0, _, LiveInfo,
+detect_liveness_in_goal_2(not(Goal0), Liveness0, Refs0, _, LiveInfo,
Liveness, not(Goal)) :-
- detect_liveness_in_goal(Goal0, Liveness0, LiveInfo, Liveness, Goal).
+ detect_liveness_in_goal(Goal0, Liveness0, Refs0, LiveInfo, Liveness,
+ _, Goal).
detect_liveness_in_goal_2(if_then_else(Vars, Cond0, Then0, Else0, SM),
- Liveness0, NonLocals, LiveInfo, Liveness,
+ Liveness0, Refs0, NonLocals, LiveInfo, Liveness,
if_then_else(Vars, Cond, Then, Else, SM)) :-
- detect_liveness_in_goal(Cond0, Liveness0, LiveInfo, LivenessCond, Cond),
+ detect_liveness_in_goal(Cond0, Liveness0, Refs0, LiveInfo, LivenessCond,
+ RefsCond, Cond),
%
% If the condition cannot succeed, any variables which become live
@@ -292,14 +299,15 @@
goal_info_get_instmap_delta(CondInfo, CondDelta),
( instmap_delta_is_unreachable(CondDelta) ->
LivenessThen = LivenessCond,
- Then1 = Then0
+ Then1 = Then0,
+ RefsThen = RefsCond
;
- detect_liveness_in_goal(Then0, LivenessCond, LiveInfo,
- LivenessThen, Then1)
+ detect_liveness_in_goal(Then0, LivenessCond, RefsCond, LiveInfo,
+ LivenessThen, RefsThen, Then1)
),
- detect_liveness_in_goal(Else0, Liveness0, LiveInfo, LivenessElse,
- Else1),
+ detect_liveness_in_goal(Else0, Liveness0, Refs0, LiveInfo, LivenessElse,
+ RefsElse, Else1),
set__union(LivenessThen, LivenessElse, Liveness),
set__intersect(Liveness, NonLocals, NonLocalLiveness),
@@ -307,38 +315,42 @@
set__difference(NonLocalLiveness, LivenessThen, ResidueThen),
set__difference(NonLocalLiveness, LivenessElse, ResidueElse),
- add_liveness_after_goal(Then1, ResidueThen, Then),
- add_liveness_after_goal(Else1, ResidueElse, Else).
+ set__union(RefsThen, RefsElse, Refs),
+
+ add_liveness_after_goal(Then1, ResidueThen, Refs, Then),
+ add_liveness_after_goal(Else1, ResidueElse, Refs, Else).
-detect_liveness_in_goal_2(some(Vars, Goal0), Liveness0, _, LiveInfo,
+detect_liveness_in_goal_2(some(Vars, Goal0), Liveness0, Refs0, _, LiveInfo,
Liveness, some(Vars, Goal)) :-
- detect_liveness_in_goal(Goal0, Liveness0, LiveInfo, Liveness, Goal).
+ detect_liveness_in_goal(Goal0, Liveness0, Refs0, LiveInfo, Liveness, _,
+ Goal).
-detect_liveness_in_goal_2(higher_order_call(_,_,_,_,_,_), _, _, _, _, _) :-
+detect_liveness_in_goal_2(higher_order_call(_,_,_,_,_,_), _, _, _, _, _, _) :-
error("higher-order-call in detect_liveness_in_goal_2").
-detect_liveness_in_goal_2(class_method_call(_,_,_,_,_,_), _, _, _, _, _) :-
+detect_liveness_in_goal_2(class_method_call(_,_,_,_,_,_), _, _, _, _, _, _) :-
error("class method call in detect_liveness_in_goal_2").
-detect_liveness_in_goal_2(call(_,_,_,_,_,_), _, _, _, _, _) :-
+detect_liveness_in_goal_2(call(_,_,_,_,_,_), _, _, _, _, _, _) :-
error("call in detect_liveness_in_goal_2").
-detect_liveness_in_goal_2(unify(_,_,_,_,_), _, _, _, _, _) :-
+detect_liveness_in_goal_2(unify(_,_,_,_,_), _, _, _, _, _, _) :-
error("unify in detect_liveness_in_goal_2").
-detect_liveness_in_goal_2(pragma_c_code(_,_,_,_,_,_,_), _, _, _, _, _) :-
+detect_liveness_in_goal_2(pragma_c_code(_,_,_,_,_,_,_), _, _, _, _, _, _) :-
error("pragma_c_code in detect_liveness_in_goal_2").
%-----------------------------------------------------------------------------%
-:- pred detect_liveness_in_conj(list(hlds_goal), set(var), live_info,
+:- pred detect_liveness_in_conj(list(hlds_goal), set(var), set(var), live_info,
set(var), list(hlds_goal)).
-:- mode detect_liveness_in_conj(in, in, in, out, out) is det.
+:- mode detect_liveness_in_conj(in, in, in, in, out, out) is det.
-detect_liveness_in_conj([], Liveness, _LiveInfo, Liveness, []).
-detect_liveness_in_conj([Goal0 | Goals0], Liveness0, LiveInfo, Liveness,
+detect_liveness_in_conj([], Liveness, _Refs0, _LiveInfo, Liveness, []).
+detect_liveness_in_conj([Goal0 | Goals0], Liveness0, Refs0, LiveInfo, Liveness,
[Goal | Goals]) :-
- detect_liveness_in_goal(Goal0, Liveness0, LiveInfo, Liveness1, Goal),
+ detect_liveness_in_goal(Goal0, Liveness0, Refs0, LiveInfo, Liveness1,
+ Refs1, Goal),
(
Goal0 = _ - GoalInfo,
goal_info_get_instmap_delta(GoalInfo, InstmapDelta),
@@ -347,7 +359,7 @@
Goals = Goals0,
Liveness = Liveness1
;
- detect_liveness_in_conj(Goals0, Liveness1, LiveInfo,
+ detect_liveness_in_conj(Goals0, Liveness1, Refs1, LiveInfo,
Liveness, Goals)
).
@@ -354,57 +366,61 @@
%-----------------------------------------------------------------------------%
:- pred detect_liveness_in_disj(list(hlds_goal), set(var), set(var),
- live_info, set(var), set(var), list(hlds_goal)).
-:- mode detect_liveness_in_disj(in, in, in, in, in, out, out) is det.
+ live_info, set(var), set(var), set(var), set(var), list(hlds_goal)).
+:- mode detect_liveness_in_disj(in, in, in, in, in, out, in, out, out) is det.
detect_liveness_in_disj([], _Liveness, _NonLocals, _LiveInfo,
- Union, Union, []).
+ Union, Union, Refs, Refs, []).
detect_liveness_in_disj([Goal0 | Goals0], Liveness, NonLocals, LiveInfo,
- Union0, Union, [Goal | Goals]) :-
- detect_liveness_in_goal(Goal0, Liveness, LiveInfo, Liveness1, Goal1),
+ Union0, Union, Refs0, Refs, [Goal | Goals]) :-
+ detect_liveness_in_goal(Goal0, Liveness, Refs0, LiveInfo, Liveness1,
+ Refs1, Goal1),
set__union(Union0, Liveness1, Union1),
detect_liveness_in_disj(Goals0, Liveness, NonLocals, LiveInfo,
- Union1, Union, Goals),
+ Union1, Union, Refs1, Refs, Goals),
set__intersect(Union, NonLocals, NonLocalUnion),
set__difference(NonLocalUnion, Liveness1, Residue),
- add_liveness_after_goal(Goal1, Residue, Goal).
+ add_liveness_after_goal(Goal1, Residue, Refs, Goal).
%-----------------------------------------------------------------------------%
:- pred detect_liveness_in_cases(list(case), set(var), set(var),
- live_info, set(var), set(var), list(case)).
-:- mode detect_liveness_in_cases(in, in, in, in, in, out, out) is det.
+ live_info, set(var), set(var), set(var), set(var), list(case)).
+:- mode detect_liveness_in_cases(in, in, in, in, in, out, in, out, out) is det.
detect_liveness_in_cases([], _Liveness, _NonLocals, _LiveInfo,
- Union, Union, []).
+ Union, Union, Refs, Refs, []).
detect_liveness_in_cases([case(Cons, IMDelta, Goal0) | Goals0], Liveness,
- NonLocals, LiveInfo, Union0, Union,
+ NonLocals, LiveInfo, Union0, Union, Refs0, Refs,
[case(Cons, IMDelta, Goal) | Goals]) :-
- detect_liveness_in_goal(Goal0, Liveness, LiveInfo, Liveness1, Goal1),
+ detect_liveness_in_goal(Goal0, Liveness, Refs0, LiveInfo, Liveness1,
+ Refs1, Goal1),
set__union(Union0, Liveness1, Union1),
detect_liveness_in_cases(Goals0, Liveness, NonLocals, LiveInfo,
- Union1, Union, Goals),
+ Union1, Union, Refs1, Refs, Goals),
set__intersect(Union, NonLocals, NonLocalUnion),
set__difference(NonLocalUnion, Liveness1, Residue),
- add_liveness_after_goal(Goal1, Residue, Goal).
+ add_liveness_after_goal(Goal1, Residue, Refs, Goal).
%-----------------------------------------------------------------------------%
:- pred detect_liveness_in_par_conj(list(hlds_goal), set(var), set(var),
- live_info, set(var), set(var), list(hlds_goal)).
-:- mode detect_liveness_in_par_conj(in, in, in, in, in, out, out) is det.
+ live_info, set(var), set(var), set(var), set(var), list(hlds_goal)).
+:- mode detect_liveness_in_par_conj(in, in, in, in, in, out, in, out, out)
+ is det.
detect_liveness_in_par_conj([], _Liveness, _NonLocals, _LiveInfo,
- Union, Union, []).
+ Union, Union, Refs, Refs, []).
detect_liveness_in_par_conj([Goal0 | Goals0], Liveness0, NonLocals, LiveInfo,
- Union0, Union, [Goal | Goals]) :-
- detect_liveness_in_goal(Goal0, Liveness0, LiveInfo, Liveness1, Goal1),
+ Union0, Union, Refs0, Refs, [Goal | Goals]) :-
+ detect_liveness_in_goal(Goal0, Liveness0, Refs0, LiveInfo, Liveness1,
+ Refs1, Goal1),
set__union(Union0, Liveness1, Union1),
detect_liveness_in_par_conj(Goals0, Liveness0, NonLocals, LiveInfo,
- Union1, Union, Goals),
+ Union1, Union, Refs1, Refs, Goals),
set__intersect(Union, NonLocals, NonLocalUnion),
set__difference(NonLocalUnion, Liveness1, Residue),
- add_liveness_after_goal(Goal1, Residue, Goal).
+ add_liveness_after_goal(Goal1, Residue, Refs, Goal).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -454,11 +470,15 @@
LiveInfo, Deadness3, Goal)
),
set__union(PostDeaths0, NewPostDeaths, PostDeaths),
- goal_info_set_post_deaths(GoalInfo0, PostDeaths, GoalInfo),
+ goal_info_set_post_deaths(GoalInfo0, PostDeaths, GoalInfo1),
set__difference(Deadness3, PreBirths0, Deadness4),
- set__union(Deadness4, PreDeaths0, Deadness).
+ set__union(Deadness4, PreDeaths0, Deadness),
+ goal_info_get_refs(GoalInfo1, Refs0),
+ set__intersect(Refs0, Deadness0, Refs),
+ goal_info_set_refs(GoalInfo1, Refs, GoalInfo).
+
% Here we process each of the different sorts of goals.
:- pred detect_deadness_in_goal_2(hlds_goal_expr, hlds_goal_info,
@@ -951,17 +971,19 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-initial_liveness(ProcInfo, PredId, ModuleInfo, Liveness) :-
+initial_liveness(ProcInfo, PredId, ModuleInfo, Liveness, Refs) :-
proc_info_headvars(ProcInfo, Vars),
proc_info_argmodes(ProcInfo, argument_modes(InstTable, Modes)),
proc_info_vartypes(ProcInfo, VarTypes),
map__apply_to_list(Vars, VarTypes, Types),
set__init(Liveness0),
+ set__init(Refs0),
(
initial_liveness_2(Vars, Modes, Types, InstTable, ModuleInfo,
- Liveness0, Liveness1)
+ Liveness0, Liveness1, Refs0, Refs1)
->
- Liveness2 = Liveness1
+ Liveness2 = Liveness1,
+ Refs2 = Refs1
;
error("initial_liveness: list length mismatch")
),
@@ -993,24 +1015,33 @@
;
NonLocals = NonLocals0
),
- set__intersect(Liveness2, NonLocals, Liveness).
+ set__intersect(Liveness2, NonLocals, Liveness),
+ set__intersect(Refs2, NonLocals, Refs).
:- pred initial_liveness_2(list(var), list(mode), list(type), inst_table,
- module_info, set(var), set(var)).
-:- mode initial_liveness_2(in, in, in, in, in, in, out) is semidet.
+ module_info, set(var), set(var), set(var), set(var)).
+:- mode initial_liveness_2(in, in, in, in, in, in, out, in, out) is semidet.
-initial_liveness_2([], [], [], _InstTable, _ModuleInfo, Liveness, Liveness).
+initial_liveness_2([], [], [], _InstTable, _ModuleInfo, Liveness, Liveness,
+ Refs, Refs).
initial_liveness_2([V | Vs], [M | Ms], [T | Ts], InstTable, ModuleInfo,
- Liveness0, Liveness) :-
+ Liveness0, Liveness, Refs0, Refs) :-
+ mode_to_arg_mode(InstTable, ModuleInfo, M, T, ArgMode),
(
- mode_to_arg_mode(InstTable, ModuleInfo, M, T, top_in)
+ ( ArgMode = top_in ; ArgMode = ref_in )
->
set__insert(Liveness0, V, Liveness1)
;
Liveness1 = Liveness0
),
- initial_liveness_2(Vs, Ms, Ts, InstTable, ModuleInfo, Liveness1, Liveness).
+ ( ArgMode = ref_in ->
+ set__insert(Refs0, V, Refs1)
+ ;
+ Refs1 = Refs0
+ ),
+ initial_liveness_2(Vs, Ms, Ts, InstTable, ModuleInfo, Liveness1,
+ Liveness, Refs1, Refs).
%-----------------------------------------------------------------------------%
@@ -1053,8 +1084,9 @@
initial_deadness_2([], [], [], _InstTable, _ModuleInfo, Deadness, Deadness).
initial_deadness_2([V | Vs], [M | Ms], [T | Ts], InstTable, ModuleInfo,
Deadness0, Deadness) :-
+ mode_to_arg_mode(InstTable, ModuleInfo, M, T, ArgMode),
(
- mode_to_arg_mode(InstTable, ModuleInfo, M, T, top_out)
+ ( ArgMode = top_out ; ArgMode = ref_out )
->
set__insert(Deadness0, V, Deadness1)
;
@@ -1065,13 +1097,14 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-:- pred add_liveness_after_goal(hlds_goal, set(var), hlds_goal).
-:- mode add_liveness_after_goal(in, in, out) is det.
+:- pred add_liveness_after_goal(hlds_goal, set(var), set(var), hlds_goal).
+:- mode add_liveness_after_goal(in, in, in, out) is det.
-add_liveness_after_goal(Goal - GoalInfo0, Residue, Goal - GoalInfo) :-
+add_liveness_after_goal(Goal - GoalInfo0, Residue, Refs, Goal - GoalInfo) :-
goal_info_get_post_births(GoalInfo0, PostBirths0),
set__union(PostBirths0, Residue, PostBirths),
- goal_info_set_post_births(GoalInfo0, PostBirths, GoalInfo).
+ goal_info_set_post_births(GoalInfo0, PostBirths, GoalInfo1),
+ goal_info_set_refs(GoalInfo1, Refs, GoalInfo).
:- pred add_deadness_before_goal(hlds_goal, set(var), hlds_goal).
:- mode add_deadness_before_goal(in, in, out) is det.
@@ -1089,16 +1122,14 @@
% or aliased; in the latter case the "value" is the location they
% should be stored in), and insert them into the accumulated set
% of value-given vars.
- %
- % We don't handle the aliasing part yet.
:- pred find_value_giving_occurrences(list(var), live_info,
- instmap_delta, set(var), set(var)).
-:- mode find_value_giving_occurrences(in, in, in, in, out) is det.
+ instmap_delta, set(var), set(var), set(var), set(var)).
+:- mode find_value_giving_occurrences(in, in, in, in, out, in, out) is det.
-find_value_giving_occurrences([], _, _, ValueVars, ValueVars).
+find_value_giving_occurrences([], _, _, ValueVars, ValueVars, RefVars, RefVars).
find_value_giving_occurrences([Var | Vars], LiveInfo, InstMapDelta,
- ValueVars0, ValueVars) :-
+ ValueVars0, ValueVars, RefVars0, RefVars) :-
live_info_get_var_types(LiveInfo, VarTypes),
live_info_get_module_info(LiveInfo, ModuleInfo),
live_info_get_inst_table(LiveInfo, InstTable),
@@ -1105,15 +1136,22 @@
map__lookup(VarTypes, Var, Type),
(
instmap_delta_search_var(InstMapDelta, Var, Inst),
- mode_to_arg_mode(InstTable, ModuleInfo, (free -> Inst), Type,
- top_out)
+ mode_to_arg_mode(InstTable, ModuleInfo,
+ (free(unique) -> Inst), Type, Mode),
+ ( Mode = top_out ; Mode = ref_out )
->
- set__insert(ValueVars0, Var, ValueVars1)
+ set__insert(ValueVars0, Var, ValueVars1),
+ ( Mode = ref_out ->
+ set__insert(RefVars0, Var, RefVars1)
+ ;
+ RefVars1 = RefVars0
+ )
;
- ValueVars1 = ValueVars0
+ ValueVars1 = ValueVars0,
+ RefVars1 = RefVars0
),
find_value_giving_occurrences(Vars, LiveInfo, InstMapDelta,
- ValueVars1, ValueVars).
+ ValueVars1, ValueVars, RefVars1, RefVars).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/llds.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/llds.m,v
retrieving revision 1.210.2.7
diff -u -r1.210.2.7 llds.m
--- 1.210.2.7 1998/06/17 04:13:07
+++ llds.m 1998/06/22 01:28:00
@@ -581,7 +581,7 @@
:- type mem_ref
---> stackvar_ref(int) % stack slot number
; framevar_ref(int) % stack slot number
- ; heap_ref(rval, int, int). % the cell pointer,
+ ; heap_ref(rval, tag, int). % the cell pointer,
% the tag to subtract,
% and the field number
@@ -743,6 +743,13 @@
% signed or unsigned
% (used for registers, stack slots, etc.)
+ % Arguments to procedures may be either pass-by-value or
+ % pass-by-reference.
+:- type val_or_ref
+ ---> value(rval) % rval is the value of the variable.
+ ; reference(lval). % lval points to the location of the variable.
+
+
% given a non-var rval, figure out its type
:- pred llds__rval_type(rval::in, llds_type::out) is det.
Index: compiler/llds_out.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/llds_out.m,v
retrieving revision 1.55.2.9
diff -u -r1.55.2.9 llds_out.m
--- 1.55.2.9 1998/06/17 04:13:11
+++ llds_out.m 1998/06/22 01:02:57
@@ -3069,9 +3069,9 @@
io__write_int(Num)
).
output_lval(mem_ref(Rval)) -->
- io__write_string("XXX("),
+ io__write_string("(*(Word *)("),
output_rval(Rval),
- io__write_string(")").
+ io__write_string("))").
%-----------------------------------------------------------------------------%
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/make_hlds.m,v
retrieving revision 1.239.2.9
diff -u -r1.239.2.9 make_hlds.m
--- 1.239.2.9 1998/06/17 04:13:15
+++ make_hlds.m 1998/06/22 01:02:57
@@ -4070,7 +4070,6 @@
HLDS_Goal0, VarSet3, HLDS_Goal, VarSet, Info2, Info),
{ instmap_delta_init_reachable(InstMapDelta) },
{ inst_table_init(InstTable) },
-
% quantification will reduce this down to
% the proper set of nonlocal arguments.
{ goal_util__goal_vars(HLDS_Goal, LambdaGoalVars0) },
@@ -4187,8 +4186,10 @@
create_atomic_unification(A, B, Context, UnifyMainContext, UnifySubContext,
Goal) :-
- UMode = ((free - free) -> (free - free)),
- Mode = ((free -> free) - (free -> free)),
+ UMode = ((free(unique) - free(unique)) ->
+ (free(unique) - free(unique))),
+ Mode = ((free(unique) -> free(unique)) -
+ (free(unique) -> free(unique))),
UnifyInfo = complicated_unify(UMode, can_fail),
UnifyC = unify_context(UnifyMainContext, UnifySubContext),
goal_info_init(GoalInfo0),
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_compile.m,v
retrieving revision 1.53.2.6
diff -u -r1.53.2.6 mercury_compile.m
--- 1.53.2.6 1998/06/17 04:13:19
+++ mercury_compile.m 1998/06/22 03:56:30
@@ -925,16 +925,16 @@
mercury_compile__maybe_unused_args(HLDS40, Verbose, Stats, HLDS43), !,
mercury_compile__maybe_dump_hlds(HLDS43, "43", "unused_args"), !,
- mercury_compile__maybe_dead_procs(HLDS43, Verbose, Stats, HLDS46), !,
- mercury_compile__maybe_dump_hlds(HLDS46, "46", "dead_procs"), !,
+ mercury_compile__maybe_lco(HLDS43, Verbose, Stats, HLDS45), !,
+ mercury_compile__maybe_dump_hlds(HLDS45, "45", "lco"), !,
- mercury_compile__maybe_lco(HLDS46, Verbose, Stats, HLDS47), !,
- mercury_compile__maybe_dump_hlds(HLDS47, "47", "lco"), !,
+ mercury_compile__maybe_dead_procs(HLDS45, Verbose, Stats, HLDS46), !,
+ mercury_compile__maybe_dump_hlds(HLDS46, "46", "dead_procs"), !,
% map_args_to_regs affects the interface to a predicate,
% so it must be done in one phase immediately before code generation
- mercury_compile__map_args_to_regs(HLDS47, Verbose, Stats, HLDS49), !,
+ mercury_compile__map_args_to_regs(HLDS46, Verbose, Stats, HLDS49), !,
mercury_compile__maybe_dump_hlds(HLDS49, "49", "args_to_regs"), !,
{ HLDS50 = HLDS49 },
@@ -1646,7 +1646,7 @@
maybe_write_string(Verbose, "% Looking for LCO modulo constructor application ...\n"),
maybe_flush_output(Verbose),
process_all_nonimported_procs(
- update_proc_io(lco_modulo_constructors), HLDS0, HLDS),
+ update_module_io(lco_modulo_constructors), HLDS0, HLDS),
maybe_write_string(Verbose, "% done.\n"),
maybe_report_stats(Stats)
;
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.115.2.11
diff -u -r1.115.2.11 mercury_to_mercury.m
--- 1.115.2.11 1998/06/17 04:13:24
+++ mercury_to_mercury.m 1998/06/22 01:02:58
@@ -185,7 +185,7 @@
:- implementation.
-:- import_module prog_out, prog_util, hlds_pred, hlds_out, (inst), instmap.
+:- import_module prog_out, prog_util, hlds_pred, hlds_out, instmap.
:- import_module globals, options, termination.
:- import_module int, string, set, term_io, lexer, require.
:- import_module char.
@@ -648,12 +648,18 @@
{ inst_key_table_lookup(IKT, Key, Inst) },
mercury_output_inst(Expand, Inst, VarSet, InstTable)
).
-mercury_output_structured_inst(_, free, Indent, _, _) -->
+mercury_output_structured_inst(_, free(unique), Indent, _, _) -->
mercury_output_tabs(Indent),
io__write_string("free\n").
-mercury_output_structured_inst(_, free(_T), Indent, _, _) -->
+mercury_output_structured_inst(_, free(alias), Indent, _, _) -->
mercury_output_tabs(Indent),
+ io__write_string("free_alias\n").
+mercury_output_structured_inst(_, free(unique, _T), Indent, _, _) -->
+ mercury_output_tabs(Indent),
io__write_string("free(with some type)\n").
+mercury_output_structured_inst(_, free(alias, _T), Indent, _, _) -->
+ mercury_output_tabs(Indent),
+ io__write_string("free_alias(with some type)\n").
mercury_output_structured_inst(Expand, bound(Uniq, BoundInsts), Indent,
VarSet, InstTable) -->
mercury_output_tabs(Indent),
@@ -748,10 +754,14 @@
{ inst_key_table_lookup(IKT, Key, Inst) },
mercury_output_inst(Expand, Inst, VarSet, InstTable)
).
-mercury_output_inst(_, free, _, _) -->
+mercury_output_inst(_, free(unique), _, _) -->
io__write_string("free").
-mercury_output_inst(_, free(_T), _, _) -->
+mercury_output_inst(_, free(alias), _, _) -->
+ io__write_string("free_alias").
+mercury_output_inst(_, free(unique, _T), _, _) -->
io__write_string("free(with some type)").
+mercury_output_inst(_, free(alias, _T), _, _) -->
+ io__write_string("free_alias(with some type)").
mercury_output_inst(Expand, bound(Uniq, BoundInsts), VarSet, InstTable) -->
mercury_output_uniqueness(Uniq, "bound"),
io__write_string("("),
Index: compiler/mode_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mode_util.m,v
retrieving revision 1.99.2.17
diff -u -r1.99.2.17 mode_util.m
--- 1.99.2.17 1998/06/17 04:13:33
+++ mode_util.m 1998/06/22 04:07:13
@@ -197,14 +197,6 @@
%-----------------------------------------------------------------------------%
- % Given a list of variables, and a list of livenesses,
- % select the live variables.
- %
-:- pred get_live_vars(list(var), list(is_live), list(var)).
-:- mode get_live_vars(in, in, out) is det.
-
-%-----------------------------------------------------------------------------%
-
% Construct a mode corresponding to the standard `in',
% `out', or `uo' mode.
:- pred in_mode((mode)::out) is det.
@@ -212,6 +204,14 @@
:- pred uo_mode((mode)::out) is det.
%-----------------------------------------------------------------------------%
+
+ % Given a list of variables, and a list of livenesses,
+ % select the live variables.
+ %
+:- pred get_live_vars(list(var), list(is_live), list(var)).
+:- mode get_live_vars(in, in, out) is det.
+
+%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
@@ -249,11 +249,11 @@
% This is just to make error messages and inferred modes
% more readable.
%
- ( Initial = free, Final = ground(shared, no) ->
+ ( Initial = free(unique), Final = ground(shared, no) ->
make_std_mode("out", [], Mode)
- ; Initial = free, Final = ground(unique, no) ->
+ ; Initial = free(unique), Final = ground(unique, no) ->
make_std_mode("uo", [], Mode)
- ; Initial = free, Final = ground(mostly_unique, no) ->
+ ; Initial = free(unique), Final = ground(mostly_unique, no) ->
make_std_mode("muo", [], Mode)
; Initial = ground(shared, no), Final = ground(shared, no) ->
make_std_mode("in", [], Mode)
@@ -267,7 +267,7 @@
; Initial = ground(mostly_unique, no),
Final = ground(mostly_unique, no) ->
make_std_mode("mdi", [], Mode)
- ; Initial = free ->
+ ; Initial = free(unique) ->
make_std_mode("out", [Final], Mode)
; Final = ground(clobbered, no) ->
make_std_mode("di", [Initial], Mode)
@@ -351,14 +351,25 @@
:- pred mode_to_arg_mode_2(inst_table, module_info, mode, arg_mode).
:- mode mode_to_arg_mode_2(in, in, in, out) is det.
+
mode_to_arg_mode_2(InstTable, ModuleInfo, Mode, ArgMode) :-
mode_get_insts(ModuleInfo, Mode, InitialInst, FinalInst),
( inst_is_bound(InitialInst, InstTable, ModuleInfo) ->
ArgMode = top_in
; inst_is_bound(FinalInst, InstTable, ModuleInfo) ->
- ArgMode = top_out
+ ( inst_is_free_alias(InitialInst, InstTable, ModuleInfo) ->
+ ArgMode = ref_in
+ ;
+ ArgMode = top_out
+ )
;
- ArgMode = top_unused
+ (
+ inst_is_free_alias(FinalInst, InstTable, ModuleInfo)
+ ->
+ ArgMode = ref_out
+ ;
+ ArgMode = top_unused
+ )
).
%-----------------------------------------------------------------------------%
@@ -385,8 +396,9 @@
% the code is unreachable
ArgInst = not_reached
).
-get_single_arg_inst(free, _InstTable, _, _, free).
-get_single_arg_inst(free(_Type), _InstTable, _, _, free). % XXX loses type info
+get_single_arg_inst(free(A), _InstTable, _, _, free(A)).
+get_single_arg_inst(free(A, _Type), _InstTable, _, _, free(A)).
+ % XXX loses type info
get_single_arg_inst(alias(Key), InstTable, ModuleInfo, ConsId, Inst) :-
inst_table_get_inst_key_table(InstTable, IKT),
inst_key_table_lookup(IKT, Key, Inst0),
@@ -445,10 +457,10 @@
% the code is unreachable
list__duplicate(Arity, not_reached, ArgInsts)
).
-get_arg_insts(free, _ConsId, Arity, ArgInsts) :-
- list__duplicate(Arity, free, ArgInsts).
-get_arg_insts(free(_Type), _ConsId, Arity, ArgInsts) :-
- list__duplicate(Arity, free, ArgInsts).
+get_arg_insts(free(A), _ConsId, Arity, ArgInsts) :-
+ list__duplicate(Arity, free(A), ArgInsts).
+get_arg_insts(free(A, _Type), _ConsId, Arity, ArgInsts) :-
+ list__duplicate(Arity, free(A), ArgInsts).
get_arg_insts(any(Uniq), _ConsId, Arity, ArgInsts) :-
list__duplicate(Arity, any(Uniq), ArgInsts).
@@ -606,8 +618,8 @@
inst_table_get_inst_key_table(InstTable, IKT),
inst_key_table_lookup(IKT, Key, Inst),
inst_has_no_duplicate_inst_keys(Set1, Set, Inst, InstTable, ModuleInfo).
+inst_has_no_duplicate_inst_keys(Set, Set, free(_, _), _InstTable, _ModuleInfo).
inst_has_no_duplicate_inst_keys(Set, Set, free(_), _InstTable, _ModuleInfo).
-inst_has_no_duplicate_inst_keys(Set, Set, free, _InstTable, _ModuleInfo).
inst_has_no_duplicate_inst_keys(Set0, Set, bound(_, BoundInsts), InstTable,
ModuleInfo) :-
bound_insts_list_has_no_duplicate_inst_keys(Set0, Set, BoundInsts,
@@ -787,10 +799,10 @@
% propagate_ctor_info(free, Type, _, _, _, free(Type)).
% temporarily disabled
-propagate_ctor_info(free, _Type, _, _, _, free).
+propagate_ctor_info(free(A), _Type, _, _, _, free(A)).
% XXX temporary hack
-propagate_ctor_info(free(_), _, _, _, _, _) :-
+propagate_ctor_info(free(_, _), _, _, _, _, _) :-
error("propagate_ctor_info: type info already present").
propagate_ctor_info(bound(Uniq, BoundInsts0), Type, _Constructors, InstTable,
ModuleInfo, Inst) :-
@@ -860,10 +872,10 @@
% propagate_ctor_info_lazily(free, Type, _, _, _, free(Type)).
% temporarily disabled
-propagate_ctor_info_lazily(free, _Type, _, _, _, free).
+propagate_ctor_info_lazily(free(A), _Type, _, _, _, free(A)).
% XXX temporary hack
-propagate_ctor_info_lazily(free(_), _, _, _, _, _) :-
+propagate_ctor_info_lazily(free(_, _), _, _, _, _, _) :-
error("propagate_ctor_info_lazily: type info already present").
propagate_ctor_info_lazily(bound(Uniq, BoundInsts0), Type0, Subst,
InstTable, ModuleInfo, Inst) :-
@@ -945,7 +957,7 @@
default_higher_order_func_inst(PredArgTypes, ModuleInfo, PredInstInfo) :-
In = (ground(shared, no) -> ground(shared, no)),
- Out = (free -> ground(shared, no)),
+ Out = (free(unique) -> ground(shared, no)),
list__length(PredArgTypes, NumPredArgs),
NumFuncArgs is NumPredArgs - 1,
list__duplicate(NumFuncArgs, In, FuncArgModes),
@@ -1163,8 +1175,8 @@
inst_apply_substitution(any(Uniq), _, any(Uniq)).
inst_apply_substitution(alias(Var), _, alias(Var)) :-
error("inst_apply_substitution: alias").
-inst_apply_substitution(free, _, free).
-inst_apply_substitution(free(T), _, free(T)).
+inst_apply_substitution(free(A), _, free(A)).
+inst_apply_substitution(free(A, T), _, free(A, T)).
inst_apply_substitution(ground(Uniq, PredStuff0), Subst,
ground(Uniq, PredStuff)) :-
maybe_pred_inst_apply_substitution(PredStuff0, Subst, PredStuff).
@@ -1435,8 +1447,15 @@
goal_info_set_instmap_delta(GoalInfo1, InstMapDelta, GoalInfo),
instmap__init_unreachable(InstMap)
;
- goal_info_get_nonlocals(GoalInfo1, NonLocals),
- instmap_delta_restrict(InstMapDelta0, NonLocals, InstMapDelta),
+ % AAA some non-locals that have their insts changed by
+ % this call may not be in the non-locals set, if they were
+ % changed via aliases. Andrew Bromage is working on
+ % a solution to this, but for now it is necessary to
+ % keep all vars in the instmap_delta, even if they're
+ % not in NonLocals.
+ %goal_info_get_nonlocals(GoalInfo1, NonLocals),
+ %instmap_delta_restrict(InstMapDelta0, NonLocals, InstMapDelta),
+ InstMapDelta = InstMapDelta0,
goal_info_set_instmap_delta(GoalInfo1, InstMapDelta, GoalInfo),
instmap__apply_instmap_delta(InstMap0, InstMapDelta, InstMap)
),
@@ -2051,7 +2070,14 @@
InstMap0 = InstMap,
IKT0 = IKT
;
- inst_key_table_add(IKT0, Inst, InstKey, IKT),
+ ( Inst = free(_) ->
+ NewInst = free(alias)
+ ; Inst = free(_, T) ->
+ NewInst = free(alias, T)
+ ;
+ NewInst = Inst
+ ),
+ inst_key_table_add(IKT0, NewInst, InstKey, IKT),
instmap__set(InstMap0, Var, alias(InstKey), InstMap)
).
@@ -2131,8 +2157,8 @@
strip_builtin_qualifiers_from_inst(inst_var(V), inst_var(V)).
strip_builtin_qualifiers_from_inst(alias(V), alias(V)).
strip_builtin_qualifiers_from_inst(not_reached, not_reached).
-strip_builtin_qualifiers_from_inst(free, free).
-strip_builtin_qualifiers_from_inst(free(Type), free(Type)).
+strip_builtin_qualifiers_from_inst(free(A), free(A)).
+strip_builtin_qualifiers_from_inst(free(A, Type), free(A, Type)).
strip_builtin_qualifiers_from_inst(any(Uniq), any(Uniq)).
strip_builtin_qualifiers_from_inst(ground(Uniq, Pred0), ground(Uniq, Pred)) :-
strip_builtin_qualifiers_from_pred_inst(Pred0, Pred).
@@ -2265,7 +2291,7 @@
InstTable, ModuleInfo) :-
( ConsId = cons(_, Arity) ->
list__duplicate(Arity, dead, ArgLives),
- list__duplicate(Arity, free, ArgInsts)
+ list__duplicate(Arity, free(unique), ArgInsts)
;
ArgLives = [],
ArgInsts = []
@@ -2290,14 +2316,6 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-in_mode(Mode) :- make_std_mode("in", [], Mode).
-
-out_mode(Mode) :- make_std_mode("out", [], Mode).
-
-uo_mode(Mode) :- make_std_mode("uo", [], Mode).
-
-%-----------------------------------------------------------------------------%
-
:- pred make_std_mode(string, list(inst), mode).
:- mode make_std_mode(in, in, out) is det.
@@ -2414,6 +2432,14 @@
%-----------------------------------------------------------------------------%
+in_mode(Mode) :- make_std_mode("in", [], Mode).
+
+out_mode(Mode) :- make_std_mode("out", [], Mode).
+
+uo_mode(Mode) :- make_std_mode("uo", [], Mode).
+
+%-----------------------------------------------------------------------------%
+
% Given a list of variables, and a list of livenesses,
% select the live variables.
Index: compiler/modecheck_unify.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modecheck_unify.m,v
retrieving revision 1.22.2.12
diff -u -r1.22.2.12 modecheck_unify.m
--- 1.22.2.12 1998/06/05 08:46:16
+++ modecheck_unify.m 1998/06/22 01:02:59
@@ -578,7 +578,8 @@
% return any old garbage
RHS = lambda_goal(PredOrFunc, ArgVars, Vars,
Modes0, Det, IMDelta, LambdaGoal0),
- Mode = (free -> free) - (free -> free),
+ Mode = (free(unique) -> free(unique)) -
+ (free(unique) -> free(unique)),
Unification = Unification0
),
Goal = unify(X, RHS, Mode, Unification, UnifyContext).
@@ -723,8 +724,15 @@
;
map__init(Sub0),
abstractly_unify_inst_functor(LiveX, InstOfX, ConsId,
- InstArgs, LiveArgs, real_unify, InstTable1, ModuleInfo1, Sub0,
- UnifyInst, Det1, InstTable2, ModuleInfo2, Sub)
+ InstArgs, LiveArgs, real_unify, InstTable1, ModuleInfo1,
+ Sub0, UnifyInst, Det1, InstTable2, ModuleInfo2, Sub),
+ \+ inst_contains_free_alias(UnifyInst, InstTable2, ModuleInfo2)
+ % AAA when we allow users to create
+ % free(alias) insts themselves we will need a
+ % better scheduling algorithm. For now, it's
+ % ok to disallow free(alias) insts in
+ % mode-checking because they are only created
+ % in the LCO pass.
->
Inst = UnifyInst,
mode_info_set_module_info(ModeInfo1, ModuleInfo2, ModeInfo2),
@@ -917,7 +925,8 @@
mode_info_set_var_types(VarTypes, ModeInfo1, ModeInfo2),
% change the main unification to use `Var' instead of Var0
- UniMode = (InitialInstX - free -> InitialInstX - InitialInstX),
+ UniMode = (InitialInstX - free(unique) ->
+ InitialInstX - InitialInstX),
% Compute the instmap that results after the main unification.
% We just need to set the inst of `Var'.
Index: compiler/module_qual.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/module_qual.m,v
retrieving revision 1.22.2.8
diff -u -r1.22.2.8 module_qual.m
--- 1.22.2.8 1998/06/05 08:46:25
+++ module_qual.m 1998/06/22 01:02:59
@@ -514,9 +514,11 @@
qualify_inst(any(A), any(A), Info, Info) --> [].
qualify_inst(alias(V), alias(V), Info, Info) -->
{ error("qualify_inst: alias") }.
-qualify_inst(free, free, Info, Info) --> [].
+qualify_inst(free(unique), free(unique), Info, Info) --> [].
+qualify_inst(free(alias), _, _, _) -->
+ { error("compiler generated inst not expected") }.
qualify_inst(not_reached, not_reached, Info, Info) --> [].
-qualify_inst(free(_), _, _, _) -->
+qualify_inst(free(_, _), _, _, _) -->
{ error("compiler generated inst not expected") }.
qualify_inst(bound(Uniq, BoundInsts0), bound(Uniq, BoundInsts),
Info0, Info) -->
Index: compiler/par_conj_gen.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/par_conj_gen.m,v
retrieving revision 1.1.2.1
diff -u -r1.1.2.1 par_conj_gen.m
--- 1.1.2.1 1998/06/17 04:54:55
+++ par_conj_gen.m 1998/06/22 01:02:59
@@ -159,7 +159,8 @@
code_info__get_stack_slots(AllSlots),
code_info__get_known_variables(Variables),
{ set__list_to_set(Variables, LiveVars) },
- { map__select(AllSlots, LiveVars, StoreMap) },
+ { map__select(AllSlots, LiveVars, LiveSlots) },
+ code_info__stack_slots_to_store_map(LiveSlots, StoreMap),
code_info__generate_branch_end(model_det, StoreMap, SaveCode),
{ Goal = _GoalExpr - GoalInfo },
{ goal_info_get_instmap_delta(GoalInfo, Delta) },
Index: compiler/pd_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/pd_util.m,v
retrieving revision 1.1.6.1
diff -u -r1.1.6.1 pd_util.m
--- 1.1.6.1 1998/06/09 04:28:28
+++ pd_util.m 1998/06/22 01:03:00
@@ -160,7 +160,10 @@
{ simplify_info_init(DetInfo0, Simplifications, InstMap0,
VarSet0, VarTypes0, SimplifyInfo0) },
- { simplify__process_goal(Goal0, Goal, SimplifyInfo0, SimplifyInfo) },
+ pd_info_get_io_state(IO0),
+ { simplify__process_goal(Goal0, Goal, SimplifyInfo0, SimplifyInfo,
+ IO0, IO) },
+ pd_info_set_io_state(IO),
%
% Deconstruct the simplify_info.
@@ -479,7 +482,7 @@
Case = case(_, CaseIMD, _ - CaseInfo),
goal_info_get_instmap_delta(CaseInfo, GoalIMD),
instmap_delta_apply_instmap_delta(CaseIMD, GoalIMD,
- InstMapDelta) % AAA is this right?
+ InstMapDelta)
)),
list__map(GetCaseInstMapDelta, Cases, InstMapDeltas).
pd_util__get_branch_instmap_deltas(disj(Disjuncts, _) - _, InstMapDeltas) :-
@@ -727,7 +730,7 @@
:- mode inst_MSG_2(in, in, in, in, out) is semidet.
inst_MSG_2(any(_), any(Uniq), _IT, _M, any(Uniq)).
-inst_MSG_2(free, free, _IT, _M, free).
+inst_MSG_2(free(Aliasing), free(Aliasing), _IT, _M, free(Aliasing)).
inst_MSG_2(bound(_, ListA), bound(UniqB, ListB), InstTable, ModuleInfo, Inst) :-
bound_inst_list_MSG(ListA, ListB, InstTable, ModuleInfo, UniqB, ListB,
@@ -814,8 +817,8 @@
pd_util__inst_size_2(_, _, not_reached, _, 0).
pd_util__inst_size_2(_, _, any(_), _, 0).
-pd_util__inst_size_2(_, _, free, _, 0).
pd_util__inst_size_2(_, _, free(_), _, 0).
+pd_util__inst_size_2(_, _, free(_,_), _, 0).
pd_util__inst_size_2(_, _, ground(_, _), _, 0).
pd_util__inst_size_2(_, _, inst_var(_), _, 0).
pd_util__inst_size_2(_, _, abstract_inst(_, _), _, 0).
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/polymorphism.m,v
retrieving revision 1.117.2.10
diff -u -r1.117.2.10 polymorphism.m
--- 1.117.2.10 1998/06/17 04:13:51
+++ polymorphism.m 1998/06/22 01:03:00
@@ -1487,7 +1487,7 @@
% create the construction unification to initialize the variable
BaseUnification = construct(BaseVar, ConsId, [], []),
- BaseUnifyMode = (free -> ground(shared, no)) -
+ BaseUnifyMode = (free(unique) -> ground(shared, no)) -
(ground(shared, no) -> ground(shared, no)),
BaseUnifyContext = unify_context(explicit, []),
% XXX the UnifyContext is wrong
@@ -1515,13 +1515,13 @@
% create the construction unification to initialize the
% variable
- UniMode = (free - ground(shared, no) ->
+ UniMode = (free(unique) - ground(shared, no) ->
ground(shared, no) - ground(shared, no)),
list__length(NewArgVars, NumArgVars),
list__duplicate(NumArgVars, UniMode, UniModes),
Unification = construct(NewVar, NewConsId, NewArgVars,
UniModes),
- UnifyMode = (free -> ground(shared, no)) -
+ UnifyMode = (free(unique) -> ground(shared, no)) -
(ground(shared, no) -> ground(shared, no)),
UnifyContext = unify_context(explicit, []),
% XXX the UnifyContext is wrong
@@ -1860,7 +1860,8 @@
CountTerm = functor(CountConsId, []),
CountInst = bound(unique, [functor(int_const(Num), [])]),
- CountUnifyMode = (free -> CountInst) - (CountInst -> CountInst),
+ CountUnifyMode = (free(unique) -> CountInst) -
+ (CountInst -> CountInst),
CountUnifyContext = unify_context(explicit, []),
% XXX the UnifyContext is wrong
CountUnify = unify(CountVar, CountTerm, CountUnifyMode,
@@ -1933,7 +1934,7 @@
Term = functor(cons(PredName2, 0), []),
Inst = bound(unique, [functor(cons(PredName2, 0), [])]),
- UnifyMode = (free -> Inst) - (Inst -> Inst),
+ UnifyMode = (free(unique) -> Inst) - (Inst -> Inst),
UnifyContext = unify_context(explicit, []),
% XXX the UnifyContext is wrong
Unify = unify(Var, Term, UnifyMode, Unification, UnifyContext),
@@ -2042,12 +2043,12 @@
TypeInfoVar, VarSet, VarTypes),
% create the construction unification to initialize the variable
- UniMode = (free - ground(shared, no) ->
+ UniMode = (free(unique) - ground(shared, no) ->
ground(shared, no) - ground(shared, no)),
list__length(ArgVars, NumArgVars),
list__duplicate(NumArgVars, UniMode, UniModes),
Unification = construct(TypeInfoVar, ConsId, ArgVars, UniModes),
- UnifyMode = (free -> ground(shared, no)) -
+ UnifyMode = (free(unique) -> ground(shared, no)) -
(ground(shared, no) -> ground(shared, no)),
UnifyContext = unify_context(explicit, []),
% XXX the UnifyContext is wrong
@@ -2100,7 +2101,7 @@
% create the construction unification to initialize the variable
Unification = construct(BaseTypeInfoVar, ConsId, [], []),
- UnifyMode = (free -> ground(shared, no)) -
+ UnifyMode = (free(unique) -> ground(shared, no)) -
(ground(shared, no) -> ground(shared, no)),
UnifyContext = unify_context(explicit, []),
% XXX the UnifyContext is wrong
Index: compiler/prog_io_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/prog_io_util.m,v
retrieving revision 1.5.4.7
diff -u -r1.5.4.7 prog_io_util.m
--- 1.5.4.7 1998/06/05 08:47:28
+++ prog_io_util.m 1998/06/22 01:03:01
@@ -175,7 +175,7 @@
Term = term__functor(Name, Args0, _Context),
% `free' insts
( Name = term__atom("free"), Args0 = [] ->
- Result = free
+ Result = free(unique)
% `any' insts
; Name = term__atom("any"), Args0 = [] ->
Index: compiler/prog_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/prog_util.m,v
retrieving revision 1.35.4.5
diff -u -r1.35.4.5 prog_util.m
--- 1.35.4.5 1998/06/17 04:13:58
+++ prog_util.m 1998/06/22 01:03:01
@@ -176,7 +176,7 @@
:- pred split_type_and_mode(type_and_mode, bool, type, mode, bool).
:- mode split_type_and_mode(in, in, out, out, out) is det.
-split_type_and_mode(type_only(T), _, T, (free -> free), no).
+split_type_and_mode(type_only(T), _, T, (free(unique) -> free(unique)), no).
split_type_and_mode(type_and_mode(T,M), R, T, M, R).
split_type_and_mode(type_only(T), T, no).
Index: compiler/simplify.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/simplify.m,v
retrieving revision 1.46.2.12
diff -u -r1.46.2.12 simplify.m
--- 1.46.2.12 1998/06/17 04:14:05
+++ simplify.m 1998/06/22 01:03:01
@@ -38,8 +38,8 @@
:- mode simplify__proc(in, in, in, in, out, in, out, out, out, di, uo) is det.
:- pred simplify__process_goal(hlds_goal, hlds_goal,
- simplify_info, simplify_info).
-:- mode simplify__process_goal(in, out, in, out) is det.
+ simplify_info, simplify_info, io__state, io__state).
+:- mode simplify__process_goal(in, out, in, out, di, uo) is det.
% Find out which simplifications should be run from the options table
% stored in the globals. The first argument states whether warnings
@@ -70,6 +70,7 @@
:- import_module hlds_module, hlds_data, (inst), inst_match.
:- import_module options, passes_aux, prog_data, mode_util, type_util.
:- import_module code_util, quantification, modes, purity, pd_cost.
+:- import_module unify_proc, mode_info.
:- import_module set, require, std_util, int.
%-----------------------------------------------------------------------------%
@@ -109,13 +110,13 @@
simplify_info_init(DetInfo0, Simplifications, InstMap0,
VarSet0, VarTypes0, Info0),
proc_info_goal(ProcInfo0, Goal0),
- simplify__process_goal(Goal0, Goal, Info0, Info),
+ simplify__process_goal(Goal0, Goal, Info0, Info, State1, State2),
simplify_info_get_module_info(Info, ModuleInfo),
simplify_info_get_msgs(Info, Msgs0),
set__to_sorted_list(Msgs0, Msgs),
det_report_msgs(Msgs, ModuleInfo, WarnCnt,
- ErrCnt, State1, State),
+ ErrCnt, State2, State),
simplify_info_get_varset(Info, VarSet),
simplify_info_get_var_types(Info, VarTypes),
simplify_info_get_inst_table(Info, InstTable),
@@ -124,7 +125,7 @@
proc_info_set_goal(ProcInfo2, Goal, ProcInfo3),
proc_info_set_inst_table(ProcInfo3, InstTable, ProcInfo).
-simplify__process_goal(Goal0, Goal, Info0, Info) :-
+simplify__process_goal(Goal0, Goal, Info0, Info, IOState0, IOState) :-
simplify_info_get_simplifications(Info0, Simplifications0),
simplify_info_get_instmap(Info0, InstMap0),
@@ -137,7 +138,8 @@
simplify_info_set_simplifications(Info0, Simplifications1,
Info1),
- simplify__do_process_goal(Goal0, Goal1, Info1, Info2),
+ simplify__do_process_goal(Goal0, Goal1, Info1, Info2,
+ IOState0, IOState1),
NotOnSecondPass = [warn_simple_code, warn_duplicate_calls,
common_struct, duplicate_calls],
@@ -146,16 +148,18 @@
simplify_info_reinit(Simplifications2, InstMap0, Info2, Info3)
;
Info3 = Info0,
- Goal1 = Goal0
+ Goal1 = Goal0,
+ IOState1 = IOState0
),
% On the second pass do excess assignment elimination and
% some cleaning up after the common structure pass.
- simplify__do_process_goal(Goal1, Goal, Info3, Info).
+ simplify__do_process_goal(Goal1, Goal, Info3, Info, IOState1, IOState).
:- pred simplify__do_process_goal(hlds_goal::in, hlds_goal::out,
- simplify_info::in, simplify_info::out) is det.
+ simplify_info::in, simplify_info::out, io__state::di,
+ io__state::uo) is det.
-simplify__do_process_goal(Goal0, Goal, Info0, Info) :-
+simplify__do_process_goal(Goal0, Goal, Info0, Info, IOState0, IOState) :-
simplify_info_get_instmap(Info0, InstMap0),
simplify__goal(Goal0, Goal1, Info0, Info1),
simplify_info_get_varset(Info1, VarSet0),
@@ -178,12 +182,16 @@
proc_info_arglives(ProcInfo, ModuleInfo1, ArgLives),
recompute_instmap_delta(ArgVars, ArgLives, VarTypes, Goal2,
Goal, InstMap0, InstTable0, InstTable, _, ModuleInfo1,
- ModuleInfo),
+ ModuleInfo2),
+ modecheck_queued_procs(check_unique_modes(
+ may_change_called_proc), ModuleInfo2, ModuleInfo,
+ _Changed, IOState0, IOState),
simplify_info_set_module_info(Info3, ModuleInfo, Info4),
simplify_info_set_inst_table(Info4, InstTable, Info)
;
Goal = Goal1,
- Info = Info1
+ Info = Info1,
+ IOState = IOState0
).
%-----------------------------------------------------------------------------%
@@ -1029,7 +1037,7 @@
RevGoals0, RevGoals, GoalNeeded, Info0, Info) :-
(
simplify_do_excess_assigns(Info0),
- Goal0 = unify(_, _, _, Unif, _) - _,
+ Goal0 = unify(_, _, LMode - RMode, Unif, _) - _,
goal_info_get_nonlocals(ConjInfo, NonLocals),
Unif = assign(LeftVar, RightVar),
( \+ set__member(LeftVar, NonLocals) ->
@@ -1038,7 +1046,16 @@
LocalVar = RightVar, ReplacementVar = LeftVar
;
fail
- )
+ ),
+
+ % If one of the variables is free(alias) before the call
+ % then we can't remove the assignment.
+ simplify_info_get_module_info(Info0, ModuleInfo),
+ simplify_info_get_inst_table(Info0, InstTable),
+ mode_get_insts(ModuleInfo, LMode, LInitInst, _LFinInst),
+ \+ inst_is_free_alias(LInitInst, InstTable, ModuleInfo),
+ mode_get_insts(ModuleInfo, RMode, RInitInst, _RFinInst),
+ \+ inst_is_free_alias(RInitInst, InstTable, ModuleInfo)
->
GoalNeeded = no,
map__init(Subn0),
@@ -1137,7 +1154,8 @@
),
InstToUniMode =
lambda([ArgInst::in, ArgUniMode::out] is det, (
- ArgUniMode = ((ArgInst - free) -> (ArgInst - ArgInst))
+ ArgUniMode = ((ArgInst - free(unique)) ->
+ (ArgInst - ArgInst))
)),
list__map(InstToUniMode, ArgInsts, UniModes),
UniMode = (Inst0 -> Inst0) - (Inst0 -> Inst0),
Index: compiler/store_alloc.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/store_alloc.m,v
retrieving revision 1.55.2.7
diff -u -r1.55.2.7 store_alloc.m
--- 1.55.2.7 1998/06/17 04:14:07
+++ store_alloc.m 1998/06/22 01:03:02
@@ -36,8 +36,8 @@
:- implementation.
-:- import_module follow_vars, liveness, hlds_goal, llds.
-:- import_module options, globals, goal_util, mode_util, instmap, trace.
+:- import_module follow_vars, liveness, hlds_goal, hlds_data, llds, trace.
+:- import_module options, globals, goal_util, mode_util, instmap, inst_match.
:- import_module list, map, set, std_util, assoc_list.
:- import_module bool, int, require, term.
@@ -54,9 +54,9 @@
store_alloc_in_proc(ProcInfo0, PredId, ModuleInfo, ProcInfo) :-
module_info_globals(ModuleInfo, Globals),
globals__lookup_bool_option(Globals, follow_vars, ApplyFollowVars),
+ proc_info_inst_table(ProcInfo0, InstTable),
( ApplyFollowVars = yes ->
proc_info_goal(ProcInfo0, Goal0),
- proc_info_inst_table(ProcInfo0, InstTable),
find_final_follow_vars(ProcInfo0, FollowVars0),
find_follow_vars_in_goal(Goal0, InstTable, ModuleInfo,
@@ -68,7 +68,7 @@
;
proc_info_goal(ProcInfo0, Goal2)
),
- initial_liveness(ProcInfo0, PredId, ModuleInfo, Liveness0),
+ initial_liveness(ProcInfo0, PredId, ModuleInfo, Liveness0, _Refs),
globals__get_trace_level(Globals, TraceLevel),
( ( TraceLevel = interface ; TraceLevel = full ) ->
trace__fail_vars(ModuleInfo, ProcInfo0, ResumeVars0)
@@ -109,13 +109,14 @@
% Any variables that become magically live at the end of the goal
% should not be included in the store map.
set__union(Liveness4, PostBirths, Liveness),
+ goal_info_get_refs(GoalInfo0, Refs),
(
Goal1 = switch(Var, CanFail, Cases, FollowVars)
->
set__union(Liveness4, ResumeVars0, MappedSet),
set__to_sorted_list(MappedSet, MappedVars),
- store_alloc_allocate_storage(MappedVars, FollowVars,
- StackSlotInfo, StoreMap),
+ store_alloc_allocate_storage(MappedVars, FollowVars,
+ StackSlotInfo, Refs, StoreMap),
Goal = switch(Var, CanFail, Cases, StoreMap)
;
Goal1 = if_then_else(Vars, Cond, Then, Else, FollowVars)
@@ -123,7 +124,7 @@
set__union(Liveness4, ResumeVars0, MappedSet),
set__to_sorted_list(MappedSet, MappedVars),
store_alloc_allocate_storage(MappedVars, FollowVars,
- StackSlotInfo, StoreMap),
+ StackSlotInfo, Refs, StoreMap),
Goal = if_then_else(Vars, Cond, Then, Else, StoreMap)
;
Goal1 = disj(Disjuncts, FollowVars)
@@ -131,7 +132,7 @@
set__union(Liveness4, ResumeVars0, MappedSet),
set__to_sorted_list(MappedSet, MappedVars),
store_alloc_allocate_storage(MappedVars, FollowVars,
- StackSlotInfo, StoreMap),
+ StackSlotInfo, Refs, StoreMap),
Goal = disj(Disjuncts, StoreMap)
;
Goal = Goal1
@@ -301,10 +302,11 @@
% real location.
:- pred store_alloc_allocate_storage(list(var), follow_vars, stack_slot_info,
- store_map).
-:- mode store_alloc_allocate_storage(in, in, in, out) is det.
+ set(var), store_map).
+:- mode store_alloc_allocate_storage(in, in, in, in, out) is det.
-store_alloc_allocate_storage(LiveVars, FollowVars, StackSlotInfo, StoreMap) :-
+store_alloc_allocate_storage(LiveVars, FollowVars, StackSlotInfo, Refs,
+ StoreMap) :-
% This addresses point 1
map__keys(FollowVars, FollowKeys),
@@ -317,8 +319,8 @@
SeenLvals0, SeenLvals, StoreMap0, StoreMap1),
% This addresses point 2
- store_alloc_allocate_extras(LiveVars, N, SeenLvals, StackSlotInfo,
- StoreMap1, StoreMap).
+ store_alloc_allocate_extras(LiveVars, N, SeenLvals, Refs,
+ StackSlotInfo, StoreMap1, StoreMap).
:- pred store_alloc_remove_nonlive(list(var), list(var), store_map, store_map).
:- mode store_alloc_remove_nonlive(in, in, in, out) is det.
@@ -341,7 +343,7 @@
StoreMap, StoreMap).
store_alloc_handle_conflicts_and_nonreal([Var | Vars], N0, N,
SeenLvals0, SeenLvals, StoreMap0, StoreMap) :-
- map__lookup(StoreMap0, Var, Lval),
+ map__lookup(StoreMap0, Var, store_info(ValOrRef, Lval)),
(
( artificial_lval(Lval)
; set__member(Lval, SeenLvals0)
@@ -349,7 +351,8 @@
->
next_free_reg(N0, SeenLvals0, N1),
FinalLval = reg(r, N1),
- map__det_update(StoreMap0, Var, FinalLval, StoreMap1)
+ map__det_update(StoreMap0, Var,
+ store_info(ValOrRef, FinalLval), StoreMap1)
;
N1 = N0,
FinalLval = Lval,
@@ -359,12 +362,13 @@
store_alloc_handle_conflicts_and_nonreal(Vars, N1, N,
SeenLvals1, SeenLvals, StoreMap1, StoreMap).
-:- pred store_alloc_allocate_extras(list(var), int, set(lval), stack_slot_info,
- store_map, store_map).
-:- mode store_alloc_allocate_extras(in, in, in, in, in, out) is det.
+:- pred store_alloc_allocate_extras(list(var), int, set(lval), set(var),
+ stack_slot_info, store_map, store_map).
+:- mode store_alloc_allocate_extras(in, in, in, in, in, in, out) is det.
-store_alloc_allocate_extras([], _, _, _, StoreMap, StoreMap).
-store_alloc_allocate_extras([Var | Vars], N0, SeenLvals0, StackSlotInfo,
+store_alloc_allocate_extras([], _N, _SeenLvals, _Refs, _StackSlotInfo,
+ StoreMap, StoreMap).
+store_alloc_allocate_extras([Var | Vars], N0, SeenLvals0, Refs, StackSlotInfo,
StoreMap0, StoreMap) :-
(
map__contains(StoreMap0, Var)
@@ -402,10 +406,18 @@
next_free_reg(N0, SeenLvals0, N1),
Locn = reg(r, N1)
),
- map__det_insert(StoreMap0, Var, Locn, StoreMap1),
+ (
+ set__member(Var, Refs)
+ ->
+ ValOrRef = ref
+ ;
+ ValOrRef = val
+ ),
+ map__det_insert(StoreMap0, Var, store_info(ValOrRef, Locn),
+ StoreMap1),
set__insert(SeenLvals0, Locn, SeenLvals1)
),
- store_alloc_allocate_extras(Vars, N1, SeenLvals1, StackSlotInfo,
+ store_alloc_allocate_extras(Vars, N1, SeenLvals1, Refs, StackSlotInfo,
StoreMap1, StoreMap).
%-----------------------------------------------------------------------------%
Index: compiler/stratify.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/stratify.m,v
retrieving revision 1.10.2.8
diff -u -r1.10.2.8 stratify.m
--- 1.10.2.8 1998/06/17 04:14:09
+++ stratify.m 1998/06/22 01:03:02
@@ -770,7 +770,7 @@
% always to case, but should be a suitable approximation for
% the stratification analysis
RHS = lambda_goal(_PredOrFunc, _NonLocals, _Vars, _Modes,
- _Determinism, _IMelta, Goal - _GoalInfo)
+ _Determinism, _IMDelta, Goal - _GoalInfo)
->
get_called_procs(Goal, [], CalledProcs),
set__insert_list(HasAT0, CalledProcs, HasAT)
Index: compiler/table_gen.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/table_gen.m,v
retrieving revision 1.1.6.1
diff -u -r1.1.6.1 table_gen.m
--- 1.1.6.1 1998/06/09 04:28:33
+++ table_gen.m 1998/06/22 01:03:02
@@ -654,7 +654,7 @@
),
TableVarInst = ground(unique, no),
- TableVarMode = (free -> TableVarInst),
+ TableVarMode = (free(unique) -> TableVarInst),
get_table_var_type(TableVarType),
inst_table_init(InstTable),
@@ -1201,7 +1201,7 @@
Inst = bound(unique, [functor(int_const(VarValue), [])]),
VarUnify = unify(Var, functor(int_const(VarValue), []),
- (free -> Inst) - (Inst -> Inst),
+ (free(unique) -> Inst) - (Inst -> Inst),
construct(Var, int_const(VarValue), [], []),
unify_context(explicit, [])),
set__singleton_set(VarNonLocals, Var),
@@ -1225,7 +1225,7 @@
Inst = bound(unique, [functor(string_const(VarValue), [])]),
VarUnify = unify(Var, functor(string_const(VarValue), []),
- (free -> Inst) - (Inst -> Inst),
+ (free(unique) -> Inst) - (Inst -> Inst),
construct(Var, string_const(VarValue), [], []),
unify_context(explicit, [])),
set__singleton_set(VarNonLocals, Var),
Index: compiler/unify_gen.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/unify_gen.m,v
retrieving revision 1.83.2.5
diff -u -r1.83.2.5 unify_gen.m
--- 1.83.2.5 1998/03/26 00:45:22
+++ unify_gen.m 1998/06/22 01:03:03
@@ -33,9 +33,10 @@
:- mode unify_gen__generate_assignment(in, in, out, in, out) is det.
% Generate a construction unification
-:- pred unify_gen__generate_construction(var, cons_id,
- list(var), list(uni_mode), code_tree, code_info, code_info).
-:- mode unify_gen__generate_construction(in, in, in, in, out, in, out) is det.
+:- pred unify_gen__generate_construction(var, cons_id, list(var),
+ list(uni_mode), code_tree, code_info, code_info).
+:- mode unify_gen__generate_construction(in, in, in, in, out, in, out)
+ is det.
:- pred unify_gen__generate_det_deconstruction(var, cons_id,
list(var), list(uni_mode), code_tree, code_info, code_info).
@@ -75,16 +76,22 @@
% bound variable as the expression that generates the free
% variable. No immediate code is generated.
-unify_gen__generate_assignment(VarA, VarB, empty) -->
- (
- code_info__variable_is_forward_live(VarA)
- ->
- code_info__cache_expression(VarA, var(VarB))
- ;
- % For free-free unifications, the mode analysis reports
- % them as assignment to the dead variable. For such
- % unifications we of course don't generate any code
- { true }
+unify_gen__generate_assignment(VarA, VarB, Code) -->
+ ( code_info__var_is_free_alias(VarA) ->
+ code_info__cache_expression(VarA, var(VarB)),
+ code_info__produce_variable_in_references(VarA, Code)
+ ;
+ (
+ code_info__variable_is_forward_live(VarA)
+ ->
+ code_info__cache_expression(VarA, var(VarB))
+ ;
+ % For free-free unifications, the mode analysis reports
+ % them as assignment to the dead variable. For such
+ % unifications we of course don't generate any code
+ { true }
+ ),
+ { Code = empty }
).
%---------------------------------------------------------------------------%
@@ -232,25 +239,21 @@
code_info__cons_id_to_tag(Var, Cons, Tag),
unify_gen__generate_construction_2(Tag, Var, Args, Modes, Code).
-:- pred unify_gen__generate_construction_2(cons_tag, var,
- list(var), list(uni_mode),
- code_tree, code_info, code_info).
-:- mode unify_gen__generate_construction_2(in, in, in, in, out,
- in, out) is det.
+:- pred unify_gen__generate_construction_2(cons_tag, var, list(var),
+ list(uni_mode), code_tree, code_info, code_info).
+:- mode unify_gen__generate_construction_2(in, in, in, in, out, in, out) is det.
unify_gen__generate_construction_2(string_constant(String),
Var, _Args, _Modes, Code) -->
- { Code = empty },
- code_info__cache_expression(Var, const(string_const(String))).
+ unify_gen__cache_unification(Var, const(string_const(String)), Code).
unify_gen__generate_construction_2(int_constant(Int),
Var, _Args, _Modes, Code) -->
- { Code = empty },
- code_info__cache_expression(Var, const(int_const(Int))).
+ unify_gen__cache_unification(Var, const(int_const(Int)), Code).
unify_gen__generate_construction_2(float_constant(Float),
Var, _Args, _Modes, Code) -->
- { Code = empty },
- code_info__cache_expression(Var, const(float_const(Float))).
-unify_gen__generate_construction_2(no_tag, Var, Args, Modes, Code) -->
+ unify_gen__cache_unification(Var, const(float_const(Float)), Code).
+unify_gen__generate_construction_2(no_tag,
+ Var, Args, Modes, Code) -->
( { Args = [Arg], Modes = [Mode] } ->
code_info__variable_type(Arg, Type),
unify_gen__generate_sub_unify(ref(Var), ref(Arg),
@@ -267,13 +270,16 @@
unify_gen__var_types(Args, ArgTypes),
{ unify_gen__generate_cons_args(Args, ArgTypes, Modes, InstTable,
ModuleInfo, RVals) },
- { Code = empty },
code_info__variable_type(Var, VarType),
{ unify_gen__var_type_msg(VarType, VarTypeMsg) },
% XXX Later we will need to worry about
% whether the cell must be unique or not.
{ Expr = create(SimpleTag, RVals, no, CellNo, VarTypeMsg) },
- code_info__cache_expression(Var, Expr).
+ code_info__cache_expression(Var, Expr),
+ unify_gen__aliased_vars_set_location(Args, ArgTypes, Modes, InstTable,
+ ModuleInfo, Var, SimpleTag, 0, Code0),
+ unify_gen__maybe_place_refs(Var, Code1),
+ { Code = tree(Code0, Code1) }.
unify_gen__generate_construction_2(complicated_tag(Bits0, Num0),
Var, Args, Modes, Code) -->
code_info__get_module_info(ModuleInfo),
@@ -284,18 +290,20 @@
ModuleInfo, RVals0) },
% the first field holds the secondary tag
{ RVals = [yes(const(int_const(Num0))) | RVals0] },
- { Code = empty },
code_info__variable_type(Var, VarType),
{ unify_gen__var_type_msg(VarType, VarTypeMsg) },
% XXX Later we will need to worry about
% whether the cell must be unique or not.
{ Expr = create(Bits0, RVals, no, CellNo, VarTypeMsg) },
- code_info__cache_expression(Var, Expr).
+ code_info__cache_expression(Var, Expr),
+ unify_gen__aliased_vars_set_location(Args, ArgTypes, Modes, InstTable,
+ ModuleInfo, Var, Bits0, 1, Code0),
+ unify_gen__maybe_place_refs(Var, Code1),
+ { Code = tree(Code0, Code1) }.
unify_gen__generate_construction_2(complicated_constant_tag(Bits1, Num1),
Var, _Args, _Modes, Code) -->
- { Code = empty },
- code_info__cache_expression(Var,
- mkword(Bits1, unop(mkbody, const(int_const(Num1))))).
+ unify_gen__cache_unification(Var,
+ mkword(Bits1, unop(mkbody, const(int_const(Num1)))), Code).
unify_gen__generate_construction_2(base_type_info_constant(ModuleName,
TypeName, TypeArity), Var, Args, _Modes, Code) -->
( { Args = [] } ->
@@ -303,9 +311,8 @@
;
{ error("unify_gen: type-info constant has args") }
),
- { Code = empty },
- code_info__cache_expression(Var, const(data_addr_const(data_addr(
- ModuleName, base_type(info, TypeName, TypeArity))))).
+ unify_gen__cache_unification(Var, const(data_addr_const(data_addr(
+ ModuleName, base_type(info, TypeName, TypeArity)))), Code).
unify_gen__generate_construction_2(base_typeclass_info_constant(ModuleName,
ClassId, Instance), Var, Args, _Modes, Code) -->
( { Args = [] } ->
@@ -313,9 +320,8 @@
;
{ error("unify_gen: typeclass-info constant has args") }
),
- { Code = empty },
- code_info__cache_expression(Var, const(data_addr_const(data_addr(
- ModuleName, base_typeclass_info(ClassId, Instance))))).
+ unify_gen__cache_unification(Var, const(data_addr_const(data_addr(
+ ModuleName, base_typeclass_info(ClassId, Instance)))), Code).
unify_gen__generate_construction_2(code_addr_constant(PredId, ProcId),
Var, Args, _Modes, Code) -->
( { Args = [] } ->
@@ -323,12 +329,12 @@
;
{ error("unify_gen: address constant has args") }
),
- { Code = empty },
code_info__get_module_info(ModuleInfo),
code_info__make_entry_label(ModuleInfo, PredId, ProcId, no, CodeAddr),
- code_info__cache_expression(Var, const(code_addr_const(CodeAddr))).
+ unify_gen__cache_unification(Var, const(code_addr_const(CodeAddr)),
+ Code).
unify_gen__generate_construction_2(pred_closure_tag(PredId, ProcId),
- Var, Args, _Modes, Code) -->
+ Var, Args, Modes, Code) -->
code_info__get_module_info(ModuleInfo),
{ module_info_preds(ModuleInfo, Preds) },
{ map__lookup(Preds, PredId, PredInfo) },
@@ -382,7 +388,7 @@
( { CallArgs = [] } ->
% if there are no new arguments, we can just use the old
% closure
- code_info__produce_variable(CallPred, Code, Value)
+ code_info__produce_variable(CallPred, Code98, Value)
;
code_info__get_next_label(LoopEnd),
code_info__get_next_label(LoopStart),
@@ -430,11 +436,13 @@
code_info__release_reg(LoopCounter),
code_info__release_reg(NumOldArgs),
code_info__release_reg(NewClosure),
- { Code = tree(Code1, tree(Code2, Code3)) },
+ { Code98 = tree(Code1, tree(Code2, Code3)) },
{ Value = lval(NewClosure) }
- )
+ ),
+ { list__length(ProcArgs, NumExtraProcArgs) },
+ { SkipFirstArg = yes }
;
- { Code = empty },
+ { Code98 = empty },
{ proc_info_arg_info(ProcInfo, ArgInfo) },
code_info__make_entry_label(ModuleInfo, PredId, ProcId, no,
CodeAddress),
@@ -443,9 +451,55 @@
{ unify_gen__generate_pred_args(Args, ArgInfo, PredArgs) },
{ Vector = [yes(const(int_const(NumArgs))),
yes(const(code_addr_const(CodeAddress))) | PredArgs] },
- { Value = create(0, Vector, no, CellNo, "closure") }
+ { Value = create(0, Vector, no, CellNo, "closure") },
+ { NumExtraProcArgs = 0 },
+ { SkipFirstArg = no }
+ ),
+ unify_gen__cache_unification(Var, Value, Code99),
+ code_info__get_inst_table(InstTable),
+ { FirstField is NumExtraProcArgs + 2 },
+ (
+ { SkipFirstArg = yes },
+ (
+ { Args = [_ | ArgsPrime] },
+ { Modes = [_ | ModesPrime] }
+ ->
+ unify_gen__var_types(ArgsPrime, ArgTypes),
+ unify_gen__aliased_vars_set_location(ArgsPrime,
+ ArgTypes, ModesPrime, InstTable, ModuleInfo,
+ Var, 0, FirstField, Code100)
+ ;
+ { Code100 = empty }
+ )
+ ;
+ { SkipFirstArg = no },
+ unify_gen__var_types(Args, ArgTypes),
+ unify_gen__aliased_vars_set_location(Args,
+ ArgTypes, Modes, InstTable, ModuleInfo, Var, 0,
+ FirstField, Code100)
),
- code_info__cache_expression(Var, Value).
+ { Code = tree(Code98, tree(Code99, Code100)) }.
+
+% Cache a unification. If the mode of the LHS variable is ref_in then
+% produce code to place it's value in the required locations.
+
+:- pred unify_gen__cache_unification(var, rval, code_tree,
+ code_info, code_info).
+:- mode unify_gen__cache_unification(in, in, out, in, out) is det.
+
+unify_gen__cache_unification(Var, Rval, Code) -->
+ code_info__cache_expression(Var, Rval),
+ unify_gen__maybe_place_refs(Var, Code).
+
+:- pred unify_gen__maybe_place_refs(var, code_tree, code_info, code_info).
+:- mode unify_gen__maybe_place_refs(in, out, in, out) is det.
+
+unify_gen__maybe_place_refs(Var, Code) -->
+ ( code_info__var_is_free_alias(Var) ->
+ code_info__produce_variable_in_references(Var, Code)
+ ;
+ { Code = empty }
+ ).
:- pred unify_gen__generate_extra_closure_args(list(var), lval, lval,
code_tree, code_info, code_info).
@@ -514,7 +568,8 @@
unify_gen__generate_cons_args_2([Var|Vars], [Type|Types], [UniMode|UniModes],
InstTable, ModuleInfo, [Arg|RVals]) :-
UniMode = ((_LI - RI) -> (_LF - RF)),
- ( mode_to_arg_mode(InstTable, ModuleInfo, (RI -> RF), Type, top_in) ->
+ mode_to_arg_mode(InstTable, ModuleInfo, (RI -> RF), Type, ArgMode),
+ ( ArgMode = top_in ->
Arg = yes(var(Var))
;
Arg = no
@@ -522,6 +577,53 @@
unify_gen__generate_cons_args_2(Vars, Types, UniModes, InstTable,
ModuleInfo, RVals).
+:- pred unify_gen__aliased_vars_set_location(list(var), list(type),
+ list(uni_mode), inst_table, module_info, var, tag, int,
+ code_tree, code_info, code_info).
+:- mode unify_gen__aliased_vars_set_location(in, in, in, in, in, in, in, in,
+ out, in, out) is det.
+
+unify_gen__aliased_vars_set_location(Args, Types, Modes, InstTable, ModuleInfo,
+ Var, Tag, FieldNum, Code) -->
+ (
+ unify_gen__aliased_vars_set_location_2(Args, Types, Modes,
+ InstTable, ModuleInfo, Var, Tag, FieldNum, Code0)
+ ->
+ { Code = Code0 }
+ ;
+ { error("unify_gen__aliased_vars_set_location: length mismatch") }
+ ).
+
+:- pred unify_gen__aliased_vars_set_location_2(list(var), list(type),
+ list(uni_mode), inst_table, module_info, var, tag,
+ int, code_tree, code_info, code_info).
+:- mode unify_gen__aliased_vars_set_location_2(in, in, in, in, in, in, in, in,
+ out, in, out) is semidet.
+
+unify_gen__aliased_vars_set_location_2([], [], [], _, _, _, _, _, empty) --> [].
+unify_gen__aliased_vars_set_location_2([Var | Vars], [Type | Types],
+ [Mode | Modes], InstTable, ModuleInfo, LHSVar, Tag, FieldNum,
+ Code) -->
+ { Mode = ((_LI - RI) -> (_LF - RF)) },
+ (
+ { mode_to_arg_mode(InstTable, ModuleInfo, (RI -> RF), Type,
+ ref_out) }
+ ->
+ code_info__acquire_reg_for_var(Var, Reg),
+ code_info__set_var_reference_location(Var, Reg),
+ code_info__produce_variable(LHSVar, Code0, RVal),
+ { Code1 = node(
+ [assign(Reg, mem_addr(heap_ref(RVal, Tag, FieldNum))) -
+ "place reference in reg"]) },
+ { Code2 = tree(Code0, Code1) }
+ ;
+ { Code2 = empty }
+ ),
+ { NextFieldNum is FieldNum + 1 },
+ unify_gen__aliased_vars_set_location_2(Vars, Types, Modes, InstTable,
+ ModuleInfo, LHSVar, Tag, NextFieldNum, Code3),
+ { Code = tree(Code2, Code3) }.
+
%---------------------------------------------------------------------------%
:- pred unify_gen__var_types(list(var), list(type), code_info, code_info).
@@ -686,12 +788,12 @@
;
% Input - Output== assignment ->
{ LeftMode = top_in },
- { RightMode = top_out }
+ { RightMode = top_out ; RightMode = ref_in }
->
unify_gen__generate_sub_assign(R, L, Code)
;
% Input - Output== assignment <-
- { LeftMode = top_out },
+ { LeftMode = top_out ; LeftMode = ref_in },
{ RightMode = top_in }
->
unify_gen__generate_sub_assign(L, R, Code)
@@ -702,6 +804,11 @@
{ Code = empty } % free-free - ignore
% XXX I think this will have to change
% if we start to support aliasing
+ ;
+ { LeftMode = ref_out },
+ { RightMode = ref_out }
+ ->
+ { Code = empty }
;
{ error("unify_gen__generate_sub_unify: some strange unify") }
).
@@ -747,22 +854,24 @@
{ error("unify_gen__generate_sub_assign: lval vanished with ref") }
).
% assignment to a variable, so cache it.
-unify_gen__generate_sub_assign(ref(Var), lval(Rval), empty) -->
+unify_gen__generate_sub_assign(ref(Var), lval(Rval), Code) -->
(
code_info__variable_is_forward_live(Var)
->
- code_info__cache_expression(Var, lval(Rval))
+ code_info__cache_expression(Var, lval(Rval)),
+ code_info__produce_variable_in_references(Var, Code)
;
- { true }
+ { Code = empty }
).
% assignment to a variable, so cache it.
-unify_gen__generate_sub_assign(ref(Lvar), ref(Rvar), empty) -->
+unify_gen__generate_sub_assign(ref(Lvar), ref(Rvar), Code) -->
(
code_info__variable_is_forward_live(Lvar)
->
- code_info__cache_expression(Lvar, var(Rvar))
+ code_info__cache_expression(Lvar, var(Rvar)),
+ code_info__produce_variable_in_references(Lvar, Code)
;
- { true }
+ { Code = empty }
).
%---------------------------------------------------------------------------%
More information about the developers
mailing list