for review: last call modulo constructors [3/3]
David Matthew Overton
dmo at students.cs.mu.OZ.AU
Mon Jun 22 16:32:53 AEST 1998
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