[m-rev.] diff: tabling via extra args (part 3 of 4)
Zoltan Somogyi
zs at cs.mu.OZ.AU
Mon Jun 7 19:04:21 AEST 2004
Index: compiler/lco.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/lco.m,v
retrieving revision 1.20
diff -u -b -r1.20 lco.m
--- compiler/lco.m 15 Mar 2003 03:08:54 -0000 1.20
+++ compiler/lco.m 7 Jun 2004 08:49:55 -0000
@@ -20,9 +20,8 @@
:- 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::in, proc_id::in, module_info::in,
+ proc_info::in, proc_info::out, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -37,67 +36,54 @@
%-----------------------------------------------------------------------------%
-lco_modulo_constructors(PredId, ProcId, ModuleInfo, ProcInfo0, ProcInfo) -->
- { proc_info_goal(ProcInfo0, Goal0) },
- { lco_in_goal(Goal0, ModuleInfo, Goal) },
- ( { Goal = Goal0 } ->
- { ProcInfo = ProcInfo0 }
+lco_modulo_constructors(PredId, ProcId, ModuleInfo, !ProcInfo, !IO) :-
+ proc_info_goal(!.ProcInfo, Goal0),
+ lco_in_goal(Goal0, ModuleInfo, Goal),
+ ( Goal = Goal0 ->
+ true
;
- { 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")
+ % proc_info_set_goal(!.ProcInfo, Goal, !:ProcInfo),
+ io__write_string("% Can introduce LCO in ", !IO),
+ hlds_out__write_pred_proc_id(ModuleInfo, PredId, ProcId, !IO),
+ io__write_string("\n", !IO)
).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-:- pred lco_in_goal(hlds_goal, module_info, hlds_goal).
-:- mode lco_in_goal(in, in, out) is det.
+:- pred lco_in_goal(hlds_goal::in, module_info::in, hlds_goal::out) is det.
lco_in_goal(Goal0 - GoalInfo, ModuleInfo, Goal - GoalInfo) :-
lco_in_goal_2(Goal0, ModuleInfo, Goal).
%-----------------------------------------------------------------------------%
-:- 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::in, module_info::in, hlds_goal_expr::out)
+ is det.
lco_in_goal_2(conj(Goals0), ModuleInfo, conj(Goals)) :-
list__reverse(Goals0, RevGoals0),
lco_in_conj(RevGoals0, [], ModuleInfo, Goals).
-
% XXX Some execution algorithm issues here.
lco_in_goal_2(par_conj(_Goals0), _ModuleInfo, par_conj(_Goals)) :-
error("sorry: lco of parallel conjunction not implemented").
-
lco_in_goal_2(disj(Goals0), ModuleInfo, disj(Goals)) :-
lco_in_disj(Goals0, ModuleInfo, Goals).
-
lco_in_goal_2(switch(Var, Det, Cases0), ModuleInfo,
switch(Var, Det, Cases)) :-
lco_in_cases(Cases0, ModuleInfo, Cases).
-
lco_in_goal_2(if_then_else(Vars, Cond, Then0, Else0), ModuleInfo,
if_then_else(Vars, Cond, Then, Else)) :-
lco_in_goal(Then0, ModuleInfo, Then),
lco_in_goal(Else0, ModuleInfo, Else).
-
lco_in_goal_2(some(Vars, CanRemove, Goal0), ModuleInfo,
some(Vars, CanRemove, Goal)) :-
lco_in_goal(Goal0, ModuleInfo, Goal).
-
lco_in_goal_2(not(Goal), _ModuleInfo, not(Goal)).
-
-lco_in_goal_2(generic_call(A,B,C,D), _ModuleInfo, generic_call(A,B,C,D)).
-
-lco_in_goal_2(call(A,B,C,D,E,F), _ModuleInfo, call(A,B,C,D,E,F)).
-
-lco_in_goal_2(unify(A,B,C,D,E), _ModuleInfo, unify(A,B,C,D,E)).
-
-lco_in_goal_2(foreign_proc(A,B,C,D,E,F,G), _,
- foreign_proc(A,B,C,D,E,F,G)).
+lco_in_goal_2(Goal @ generic_call(_, _, _, _), _ModuleInfo, Goal).
+lco_in_goal_2(Goal @ call(_, _, _, _, _, _), _ModuleInfo, Goal).
+lco_in_goal_2(Goal @ unify(_, _, _, _, _), _ModuleInfo, Goal).
+lco_in_goal_2(Goal @ foreign_proc(_, _, _, _, _, _), _, Goal).
lco_in_goal_2(shorthand(_), _, _) :-
% these should have been expanded out by now
@@ -105,8 +91,8 @@
%-----------------------------------------------------------------------------%
-:- 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)::in, module_info::in, list(hlds_goal)::out)
+ is det.
lco_in_disj([], __ModuleInfo, []).
lco_in_disj([Goal0 | Goals0], ModuleInfo, [Goal | Goals]) :-
@@ -115,8 +101,8 @@
%-----------------------------------------------------------------------------%
-:- 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)::in, module_info::in, list(case)::out)
+ is det.
lco_in_cases([], __ModuleInfo, []).
lco_in_cases([case(Cons, Goal0) | Cases0], ModuleInfo,
@@ -144,9 +130,8 @@
%
% 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.
+:- pred lco_in_conj(list(hlds_goal)::in, list(hlds_goal)::in, module_info::in,
+ list(hlds_goal)::out) is det.
lco_in_conj([], Unifies, __ModuleInfo, Unifies).
lco_in_conj([Goal0 | Goals0], Unifies0, ModuleInfo, Goals) :-
Index: compiler/live_vars.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/live_vars.m,v
retrieving revision 1.104
diff -u -b -r1.104 live_vars.m
--- compiler/live_vars.m 23 Mar 2004 10:52:04 -0000 1.104
+++ compiler/live_vars.m 7 Jun 2004 08:49:55 -0000
@@ -330,11 +330,12 @@
build_live_sets_in_goal_2(Goal, Goal, GoalInfo0, GoalInfo, ResumeVars0,
AllocData, !StackAlloc, !Liveness, !NondetLiveness) :-
- Goal = foreign_proc(Attributes, PredId, ProcId, ArgVars, _, _, _),
+ Goal = foreign_proc(Attributes, PredId, ProcId, Args, _, _),
ModuleInfo = AllocData ^ module_info,
CallerProcInfo = AllocData ^ proc_info,
proc_info_vartypes(CallerProcInfo, VarTypes),
module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, ProcInfo),
+ ArgVars = list__map(foreign_arg_var, Args),
arg_info__partition_proc_call_args(ProcInfo, VarTypes, ModuleInfo,
ArgVars, _InVars, OutVars, _UnusedVars),
goal_info_get_code_model(GoalInfo0, CodeModel),
Index: compiler/livemap.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/livemap.m,v
retrieving revision 1.59
diff -u -b -r1.59 livemap.m
--- compiler/livemap.m 11 Nov 2003 03:35:07 -0000 1.59
+++ compiler/livemap.m 7 Jun 2004 08:49:55 -0000
@@ -268,7 +268,7 @@
livemap__build_live_lval_info(LiveLvalInfo,
!Livevals, !ContainsUserCode)
;
- Uinstr0 = pragma_c(_, Components, _, _, _, _, _, _),
+ Uinstr0 = pragma_c(_, Components, _, _, _, _, _, _, _),
livemap__build_livemap_pragma_components(Components,
!Livevals, !ContainsUserCode)
).
Index: compiler/liveness.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/liveness.m,v
retrieving revision 1.127
diff -u -b -r1.127 liveness.m
--- compiler/liveness.m 23 Mar 2004 10:52:05 -0000 1.127
+++ compiler/liveness.m 7 Jun 2004 08:49:55 -0000
@@ -403,16 +403,16 @@
Liveness, some(Vars, CanRemove, Goal)) :-
detect_liveness_in_goal(Goal0, Liveness0, LiveInfo, Liveness, Goal).
-detect_liveness_in_goal_2(generic_call(_,_,_,_), _, _, _, _, _) :-
+detect_liveness_in_goal_2(generic_call(_, _, _, _), _, _, _, _, _) :-
error("higher-order-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(foreign_proc(_,_,_,_,_,_,_),
+detect_liveness_in_goal_2(foreign_proc(_, _, _, _, _, _),
_, _, _, _, _) :-
error("foreign_proc in detect_liveness_in_goal_2").
@@ -655,7 +655,7 @@
detect_deadness_in_goal_2(unify(_,_,_,_,_), _, _, _, _, _, _) :-
error("unify in detect_deadness_in_goal_2").
-detect_deadness_in_goal_2(foreign_proc(_, _, _, _, _, _, _),
+detect_deadness_in_goal_2(foreign_proc(_, _, _, _, _, _),
_, _, _, _, _, _) :-
error("foreign_proc in detect_deadness_in_goal_2").
@@ -861,8 +861,7 @@
update_liveness_expr(call(_, _, _, _, _, _), _, _, Liveness, Liveness).
update_liveness_expr(generic_call(_, _, _, _), _, _, Liveness, Liveness).
update_liveness_expr(unify(_, _, _, _, _), _, _, Liveness, Liveness).
-update_liveness_expr(foreign_proc(_, _, _, _, _, _, _), _, _,
- Liveness, Liveness).
+update_liveness_expr(foreign_proc(_, _, _, _, _, _), _, _, Liveness, Liveness).
update_liveness_expr(conj(Goals), _, LiveInfo, Liveness0, Liveness) :-
update_liveness_conj(Goals, LiveInfo, Liveness0, Liveness).
update_liveness_expr(par_conj(Goals), _, LiveInfo, Liveness0, Liveness) :-
@@ -1034,7 +1033,7 @@
BornVars = BornVars0,
DelayedDead = DelayedDead0
;
- GoalExpr0 = foreign_proc(_, _, _, _, _, _, _),
+ GoalExpr0 = foreign_proc(_, _, _, _, _, _),
GoalExpr = GoalExpr0,
GoalInfo = GoalInfo0,
BornVars = BornVars0,
@@ -1361,17 +1360,17 @@
Resume = resume_point(ResumeVars1, ResumeLocs),
goal_set_resume_point(Goal1, Resume, Goal).
-detect_resume_points_in_goal_2(generic_call(A,B,C,D), _, Liveness,
- _, _, generic_call(A,B,C,D), Liveness).
+detect_resume_points_in_goal_2(Goal @ generic_call(_, _, _, _), _,
+ Liveness, _, _, Goal, Liveness).
-detect_resume_points_in_goal_2(call(A,B,C,D,E,F), _, Liveness, _, _,
- call(A,B,C,D,E,F), Liveness).
+detect_resume_points_in_goal_2(Goal @ call(_, _, _, _, _, _), _,
+ Liveness, _, _, Goal, Liveness).
-detect_resume_points_in_goal_2(unify(A,B,C,D,E), _, Liveness, _, _,
- unify(A,B,C,D,E), Liveness).
+detect_resume_points_in_goal_2(Goal @ unify(_, _, _, _, _), _,
+ Liveness, _, _, Goal, Liveness).
-detect_resume_points_in_goal_2(foreign_proc(A,B,C,D,E,F,G), _,
- Liveness, _, _, foreign_proc(A,B,C,D,E,F,G), Liveness).
+detect_resume_points_in_goal_2(Goal @ foreign_proc(_, _, _, _, _, _), _,
+ Liveness, _, _, Goal, Liveness).
detect_resume_points_in_goal_2(shorthand(_), _, _, _, _, _, _) :-
% these should have been expanded out by now
Index: compiler/llds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds.m,v
retrieving revision 1.305
diff -u -b -r1.305 llds.m
--- compiler/llds.m 23 May 2004 23:14:29 -0000 1.305
+++ compiler/llds.m 7 Jun 2004 08:49:55 -0000
@@ -416,7 +416,8 @@
pragma_c_fix_layout :: maybe(label),
pragma_c_fix_onlylayout :: maybe(label),
pragma_c_nofix :: maybe(label),
- pragma_c_stack_slot_ref :: bool
+ pragma_c_stack_slot_ref :: bool,
+ pragma_c_maybe_dupl :: bool
)
% The first argument says what local variable
% declarations are required for the following
@@ -455,11 +456,14 @@
% structure, being mentioned only in pragma_c_fail_to
% components).
%
- % The last argument says whether the contents
+ % The stack_slot_ref argument says whether the contents
% of the pragma C code can refer to stack slots.
% User-written shouldn't refer to stack slots,
% the question is whether the compiler-generated
% C code does.
+ %
+ % The maybe_dupl says whether this instruction may be
+ % duplicated by jump optimization.
; init_sync_term(lval, int)
% Initialize a synchronization term.
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.233
diff -u -b -r1.233 llds_out.m
--- compiler/llds_out.m 23 May 2004 23:14:30 -0000 1.233
+++ compiler/llds_out.m 7 Jun 2004 08:49:55 -0000
@@ -1689,7 +1689,7 @@
output_instr_decls(_, incr_sp(_, _), !DeclSet, !IO).
output_instr_decls(_, decr_sp(_), !DeclSet, !IO).
output_instr_decls(StackLayoutLabels, pragma_c(_, Comps, _, _,
- MaybeLayoutLabel, MaybeOnlyLayoutLabel, _, _),
+ MaybeLayoutLabel, MaybeOnlyLayoutLabel, _, _, _),
!DeclSet, !IO) :-
( MaybeLayoutLabel = yes(Label) ->
map__lookup(StackLayoutLabels, Label, DataAddr),
@@ -2124,7 +2124,7 @@
io__write_int(N, !IO),
io__write_string(");\n", !IO).
-output_instruction(pragma_c(Decls, Components, _, _, _, _, _, _), _, !IO) :-
+output_instruction(pragma_c(Decls, Components, _, _, _, _, _, _, _), _, !IO) :-
io__write_string("\t{\n", !IO),
output_pragma_decls(Decls, !IO),
list__foldl(output_pragma_c_component, Components, !IO),
Index: compiler/loop_inv.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/loop_inv.m,v
retrieving revision 1.9
diff -u -b -r1.9 loop_inv.m
--- compiler/loop_inv.m 23 Mar 2004 10:52:05 -0000 1.9
+++ compiler/loop_inv.m 7 Jun 2004 08:49:55 -0000
@@ -338,7 +338,7 @@
IGCs).
invariant_goal_candidates_2(_PPId,
- ForeignProc @ foreign_proc(_,_,_,_,_,_,_) - GoalInfo, IGCs) =
+ ForeignProc @ foreign_proc(_,_,_,_,_,_) - GoalInfo, IGCs) =
invariant_goal_candidates_handle_non_recursive_call(ForeignProc - GoalInfo,
IGCs).
@@ -879,7 +879,7 @@
gen_aux_proc_2(Info, Unification @ unify(_, _, _, _, _) - GoalInfo) =
gen_aux_proc_handle_non_recursive_call(Info, Unification - GoalInfo).
-gen_aux_proc_2(Info, ForeignProc @ foreign_proc(_, _, _, _, _, _, _) -
+gen_aux_proc_2(Info, ForeignProc @ foreign_proc(_, _, _, _, _, _) -
GoalInfo) =
gen_aux_proc_handle_non_recursive_call(Info, ForeignProc - GoalInfo).
@@ -999,7 +999,7 @@
Unification - GoalInfo.
gen_out_proc_2(_PPId, _CallAux,
- ForeignProc @ foreign_proc(_,_,_,_,_,_,_) - GoalInfo) =
+ ForeignProc @ foreign_proc(_,_,_,_,_,_) - GoalInfo) =
ForeignProc - GoalInfo.
gen_out_proc_2(PPId, CallAux,
@@ -1098,18 +1098,15 @@
:- func uniquely_used_vars_2(module_info, hlds_goal) = prog_vars.
uniquely_used_vars_2(MI, call(PredId, ProcId, Args, _, _, _) - _) =
- list__filter_map_corresponding(uniquely_used_args(MI),
- Args,
+ list__filter_map_corresponding(uniquely_used_args(MI), Args,
argmodes(MI,PredId,ProcId)).
uniquely_used_vars_2(MI, generic_call(_, Args, Modes, _) - _) =
- list__filter_map_corresponding(uniquely_used_args(MI),
- Args,
- Modes).
+ list__filter_map_corresponding(uniquely_used_args(MI), Args, Modes).
-uniquely_used_vars_2(MI, foreign_proc(_, PredId, ProcId, Args, _, _, _) - _) =
+uniquely_used_vars_2(MI, foreign_proc(_, PredId, ProcId, Args, Extras, _) - _) =
list__filter_map_corresponding(uniquely_used_args(MI),
- Args,
+ list__map(foreign_arg_var, Args ++ Extras),
argmodes(MI,PredId,ProcId)).
% XXX This is very conservative!
@@ -1174,9 +1171,9 @@
list__filter_map_corresponding(
input_arg(MI), Args, ArgModes).
-goal_inputs(MI, foreign_proc(_, PredId, ProcId, Args, _, _, _) - _) =
- list__filter_map_corresponding(
- input_arg(MI), Args, argmodes(MI, PredId, ProcId)).
+goal_inputs(MI, foreign_proc(_, PredId, ProcId, Args, _, _) - _) =
+ list__filter_map_corresponding(input_arg(MI),
+ list__map(foreign_arg_var, Args), argmodes(MI, PredId, ProcId)).
goal_inputs(MI, unify(LHS, UnifyRHS, _, Kind, _) - _) = Inputs :-
(
@@ -1258,9 +1255,10 @@
list__filter_map_corresponding(
output_arg(MI), Args, ArgModes).
-goal_outputs(MI, foreign_proc(_, PredId, ProcId, Args, _, _, _) - _) =
+goal_outputs(MI, foreign_proc(_, PredId, ProcId, Args, _, _) - _) =
list__filter_map_corresponding(
- output_arg(MI), Args, argmodes(MI, PredId, ProcId)).
+ output_arg(MI), list__map(foreign_arg_var, Args),
+ argmodes(MI, PredId, ProcId)).
goal_outputs(MI, unify(LHS, _RHS, _, Kind, _) - _) = Outputs :-
(
Index: compiler/magic.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/magic.m,v
retrieving revision 1.43
diff -u -b -r1.43 magic.m
--- compiler/magic.m 20 May 2004 22:18:36 -0000 1.43
+++ compiler/magic.m 7 Jun 2004 08:49:55 -0000
@@ -1395,8 +1395,7 @@
{ error("Sorry, not yet implemented: parallel conjunction in Aditi procedures") }.
magic__preprocess_goal_2(generic_call(_, _, _, _) - _, _, _, _) -->
{ error("Sorry, not yet implemented: higher-order or class-method calls in Aditi procedures") }.
-magic__preprocess_goal_2(foreign_proc(_, _, _, _, _, _, _) -
- _, _, _, _) -->
+magic__preprocess_goal_2(foreign_proc(_, _, _, _, _, _) - _, _, _, _) -->
{ error("Sorry, not yet implemented: foreign_proc calls in Aditi procedures") }.
magic__preprocess_goal_2(conj(Goals0) - GoalInfo, [conj(Goals) - GoalInfo],
HOMap0, HOMap) -->
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.469
diff -u -b -r1.469 make_hlds.m
--- compiler/make_hlds.m 24 May 2004 02:47:45 -0000 1.469
+++ compiler/make_hlds.m 7 Jun 2004 08:49:55 -0000
@@ -5300,12 +5300,13 @@
warn_singletons_in_unify(Var, RHS, GoalInfo, QuantVars, VarSet,
PredCallId, MI).
-warn_singletons_in_goal_2(foreign_proc(Attrs, _, _, _, ArgInfo, _, PragmaImpl),
+warn_singletons_in_goal_2(foreign_proc(Attrs, _, _, Args, _, PragmaImpl),
GoalInfo, _QuantVars, _VarSet, PredCallId, MI) -->
{ goal_info_get_context(GoalInfo, Context) },
{ Lang = foreign_language(Attrs) },
+ { NamesModes = list__map(foreign_arg_maybe_name_mode, Args) },
warn_singletons_in_pragma_foreign_proc(PragmaImpl, Lang,
- ArgInfo, Context, PredCallId, MI).
+ NamesModes, Context, PredCallId, MI).
warn_singletons_in_goal_2(shorthand(ShorthandGoal), GoalInfo, QuantVars,
VarSet, PredCallId, MI) -->
@@ -5414,17 +5415,18 @@
prog_context::in, simple_call_id::in, module_info::in,
io::di, io::uo) is det.
-warn_singletons_in_pragma_foreign_proc(PragmaImpl, Lang, ArgInfo, Context,
+warn_singletons_in_pragma_foreign_proc(PragmaImpl, Lang, Args, Context,
PredOrFuncCallId, ModuleInfo, !IO) :-
LangStr = foreign_language_string(Lang),
(
PragmaImpl = ordinary(C_Code, _),
c_code_to_name_list(C_Code, C_CodeList),
- solutions((pred(Name::out) is nondet :-
- list__member(yes(Name - _), ArgInfo),
+ Filter = (pred(Name::out) is nondet :-
+ list__member(yes(Name - _), Args),
\+ string__prefix(Name, "_"),
\+ list__member(Name, C_CodeList)
- ), UnmentionedVars),
+ ),
+ solutions(Filter, UnmentionedVars),
( UnmentionedVars = [] ->
true
;
@@ -5444,12 +5446,13 @@
c_code_to_name_list(FirstCode, FirstCodeList),
c_code_to_name_list(LaterCode, LaterCodeList),
c_code_to_name_list(SharedCode, SharedCodeList),
- solutions((pred(Name::out) is nondet :-
- list__member(yes(Name - Mode), ArgInfo),
+ InputFilter = (pred(Name::out) is nondet :-
+ list__member(yes(Name - Mode), Args),
mode_is_input(ModuleInfo, Mode),
\+ string__prefix(Name, "_"),
\+ list__member(Name, FirstCodeList)
- ), UnmentionedInputVars),
+ ),
+ solutions(InputFilter, UnmentionedInputVars),
( UnmentionedInputVars = [] ->
true
;
@@ -5463,13 +5466,14 @@
io__write_string("not occur in the first " ++
LangStr ++ " code.\n ", !IO)
),
- solutions((pred(Name::out) is nondet :-
- list__member(yes(Name - Mode), ArgInfo),
+ FirstOutputFilter = (pred(Name::out) is nondet :-
+ list__member(yes(Name - Mode), Args),
mode_is_output(ModuleInfo, Mode),
\+ string__prefix(Name, "_"),
\+ list__member(Name, FirstCodeList),
\+ list__member(Name, SharedCodeList)
- ), UnmentionedFirstOutputVars),
+ ),
+ solutions(FirstOutputFilter, UnmentionedFirstOutputVars),
( UnmentionedFirstOutputVars = [] ->
true
;
@@ -5485,13 +5489,14 @@
LangStr ++ " code or the shared " ++ LangStr ++
" code.\n ", !IO)
),
- solutions((pred(Name::out) is nondet :-
- list__member(yes(Name - Mode), ArgInfo),
+ LaterOutputFilter = (pred(Name::out) is nondet :-
+ list__member(yes(Name - Mode), Args),
mode_is_output(ModuleInfo, Mode),
\+ string__prefix(Name, "_"),
\+ list__member(Name, LaterCodeList),
\+ list__member(Name, SharedCodeList)
- ), UnmentionedLaterOutputVars),
+ ),
+ solutions(LaterOutputFilter, UnmentionedLaterOutputVars),
( UnmentionedLaterOutputVars = [] ->
true
;
@@ -5943,8 +5948,10 @@
% Put the purity in the goal_info in case
% this foreign code is inlined
add_goal_info_purity_feature(GoalInfo1, Purity, GoalInfo),
- HldsGoal0 = foreign_proc(Attributes, PredId,
- ProcId, HeadVars, ArgInfo, OrigArgTypes, PragmaImpl)
+ make_foreign_args(HeadVars, ArgInfo, OrigArgTypes,
+ ForeignArgs),
+ HldsGoal0 = foreign_proc(Attributes, PredId, ProcId,
+ ForeignArgs, [], PragmaImpl)
- GoalInfo,
map__init(EmptyVarTypes),
implicitly_quantify_clause_body(HeadVars, _Warnings, HldsGoal0,
Index: compiler/mark_static_terms.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mark_static_terms.m,v
retrieving revision 1.11
diff -u -b -r1.11 mark_static_terms.m
--- compiler/mark_static_terms.m 24 Oct 2003 06:17:42 -0000 1.11
+++ compiler/mark_static_terms.m 7 Jun 2004 08:49:55 -0000
@@ -98,18 +98,17 @@
goal_mark_static_terms(Then0, Then, SI_Cond, _SI_Then),
goal_mark_static_terms(Else0, Else, SI0, _SI_Else).
-goal_expr_mark_static_terms(call(A,B,C,D,E,F), call(A,B,C,D,E,F), SI, SI).
+goal_expr_mark_static_terms(Goal @ call(_, _, _, _, _, _), Goal, SI, SI).
-goal_expr_mark_static_terms(generic_call(A,B,C,D), generic_call(A,B,C,D),
- SI, SI).
+goal_expr_mark_static_terms(Goal @ generic_call(_, _, _, _), Goal, SI, SI).
-goal_expr_mark_static_terms(unify(A,B,C, Unification0, E),
- unify(A,B,C, Unification, E), SI0, SI) :-
+goal_expr_mark_static_terms(unify(LHS, RHS, Mode, Unification0, Context),
+ unify(LHS, RHS, Mode, Unification, Context), SI0, SI) :-
unification_mark_static_terms(Unification0, Unification,
SI0, SI).
-goal_expr_mark_static_terms(foreign_proc(A,B,C,D,E,F,G),
- foreign_proc(A,B,C,D,E,F,G), SI, SI).
+goal_expr_mark_static_terms(Goal @ foreign_proc(_, _, _, _, _, _), Goal,
+ SI, SI).
goal_expr_mark_static_terms(shorthand(_), _, _, _) :-
% these should have been expanded out by now
@@ -117,11 +116,13 @@
:- pred conj_mark_static_terms(hlds_goals::in, hlds_goals::out,
static_info::in, static_info::out) is det.
+
conj_mark_static_terms(Goals0, Goals) -->
list__map_foldl(goal_mark_static_terms, Goals0, Goals).
:- pred disj_mark_static_terms(hlds_goals::in, hlds_goals::out,
static_info::in) is det.
+
disj_mark_static_terms([], [], _).
disj_mark_static_terms([Goal0 | Goals0], [Goal | Goals], SI0) :-
% we throw away the static_info obtained after each branch
@@ -130,6 +131,7 @@
:- pred cases_mark_static_terms(list(case)::in, list(case)::out,
static_info::in) is det.
+
cases_mark_static_terms([], [], _SI0).
cases_mark_static_terms([Case0 | Cases0], [Case | Cases], SI0) :-
Case0 = case(ConsId, Goal0),
@@ -140,6 +142,7 @@
:- pred unification_mark_static_terms(unification::in, unification::out,
static_info::in, static_info::out) is det.
+
unification_mark_static_terms(Unification0, Unification,
StaticVars0, StaticVars) :-
(
@@ -175,21 +178,19 @@
_CanFail, _CanCGC),
Unification = Unification0,
StaticVars = StaticVars0
-/*****************
- (
- % if the variable being deconstructed is static,
- % and the deconstruction cannot fail,
- % then the newly extracted argument variables
- % are static too
- % (XXX is the "cannot fail" bit really necessary?)
- map__search(StaticVars0, Var, Data),
- CanFail = cannot_fail
- ->
- XXX insert ArgVars into StaticVars0
- ;
- StaticVars = StaticVars0
- )
-*****************/
+% (
+% % if the variable being deconstructed is static,
+% % and the deconstruction cannot fail,
+% % then the newly extracted argument variables
+% % are static too
+% % (XXX is the "cannot fail" bit really necessary?)
+% map__search(StaticVars0, Var, Data),
+% CanFail = cannot_fail
+% ->
+% XXX insert ArgVars into StaticVars0
+% ;
+% StaticVars = StaticVars0
+% )
;
Unification0 = assign(TargetVar, SourceVar),
Unification = Unification0,
@@ -212,4 +213,3 @@
Unification = Unification0,
StaticVars = StaticVars0
).
-
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.308
diff -u -b -r1.308 mercury_compile.m
--- compiler/mercury_compile.m 28 May 2004 04:24:04 -0000 1.308
+++ compiler/mercury_compile.m 7 Jun 2004 08:49:55 -0000
@@ -1815,8 +1815,8 @@
( MaybeTransOptDeps = yes(TransOptDeps) ->
% When creating the trans_opt file, only import the
% trans_opt files which are lower in the ordering.
- trans_opt__grab_optfiles(Imports1, TransOptDeps,
- Imports, Error2, !IO)
+ trans_opt__grab_optfiles(TransOptDeps,
+ Imports1, Imports, Error2, !IO)
;
Imports = Imports1,
Error2 = no,
@@ -1861,8 +1861,8 @@
list__condense([Imports0 ^ parent_deps,
Imports0 ^ int_deps, Imports0 ^ impl_deps],
TransOptFiles),
- trans_opt__grab_optfiles(Imports1, TransOptFiles,
- Imports, Error2, !IO)
+ trans_opt__grab_optfiles(TransOptFiles,
+ Imports1, Imports, Error2, !IO)
;
Imports = Imports1,
Error2 = no
Index: compiler/middle_rec.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/middle_rec.m,v
retrieving revision 1.98
diff -u -b -r1.98 middle_rec.m
--- compiler/middle_rec.m 23 Mar 2004 10:52:07 -0000 1.98
+++ compiler/middle_rec.m 7 Jun 2004 08:49:55 -0000
@@ -436,7 +436,7 @@
middle_rec__find_used_registers_instr(incr_sp(_, _), !Used).
middle_rec__find_used_registers_instr(decr_sp(_), !Used).
middle_rec__find_used_registers_instr(pragma_c(_, Components,
- _, _, _, _, _, _), !Used) :-
+ _, _, _, _, _, _, _), !Used) :-
middle_rec__find_used_registers_components(Components, !Used).
middle_rec__find_used_registers_instr(init_sync_term(Lval, _), !Used) :-
middle_rec__find_used_registers_lval(Lval, !Used).
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.139
diff -u -b -r1.139 ml_code_gen.m
--- compiler/ml_code_gen.m 12 May 2004 14:24:28 -0000 1.139
+++ compiler/ml_code_gen.m 7 Jun 2004 08:49:55 -0000
@@ -2101,9 +2101,7 @@
ml_gen_goal_expr(call(PredId, ProcId, ArgVars, BuiltinState, _, _),
CodeModel, Context, Decls, Statements, !Info) :-
- (
- BuiltinState = not_builtin
- ->
+ ( BuiltinState = not_builtin ->
ml_gen_var_list(!.Info, ArgVars, ArgLvals),
ml_gen_info_get_varset(!.Info, VarSet),
ArgNames = ml_gen_var_names(VarSet, ArgVars),
@@ -2115,40 +2113,44 @@
Decls, Statements, !Info)
).
-ml_gen_goal_expr(unify(_A, _B, _, Unification, _), CodeModel, Context,
- Decls, Statements, !Info) :-
+ml_gen_goal_expr(unify(_LHS, _RHS, _Mode, Unification, _UnifyContext),
+ CodeModel, Context, Decls, Statements, !Info) :-
ml_gen_unification(Unification, CodeModel, Context,
Decls, Statements, !Info).
-ml_gen_goal_expr(foreign_proc(Attributes,
- PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes, PragmaImpl),
- CodeModel, OuterContext, Decls, Statements, !Info) :-
+ml_gen_goal_expr(foreign_proc(Attributes, PredId, ProcId, Args, ExtraArgs,
+ PragmaImpl), CodeModel, OuterContext, Decls, Statements,
+ !Info) :-
(
- PragmaImpl = ordinary(Foreign_Code, MaybeContext),
+ PragmaImpl = ordinary(ForeignCode, MaybeContext),
( MaybeContext = yes(Context)
; MaybeContext = no,
Context = OuterContext
),
ml_gen_ordinary_pragma_foreign_proc(CodeModel, Attributes,
- PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
- Foreign_Code, Context, Decls, Statements, !Info)
+ PredId, ProcId, Args, ExtraArgs, ForeignCode,
+ Context, Decls, Statements, !Info)
;
PragmaImpl = nondet(
LocalVarsDecls, LocalVarsContext,
FirstCode, FirstContext, LaterCode, LaterContext,
_Treatment, SharedCode, SharedContext),
+ require(unify(ExtraArgs, []),
+ "ml_gen_goal_expr: extra args"),
ml_gen_nondet_pragma_foreign_proc(CodeModel, Attributes,
- PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
- OuterContext, LocalVarsDecls, LocalVarsContext,
+ PredId, ProcId, Args, OuterContext,
+ LocalVarsDecls, LocalVarsContext,
FirstCode, FirstContext, LaterCode, LaterContext,
SharedCode, SharedContext, Decls, Statements, !Info)
;
PragmaImpl = import(Name, HandleReturn, Vars, _Context),
+ require(unify(ExtraArgs, []),
+ "ml_gen_goal_expr: extra args"),
ForeignCode = string__append_list([HandleReturn, " ",
Name, "(", Vars, ");"]),
ml_gen_ordinary_pragma_foreign_proc(CodeModel, Attributes,
- PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
- ForeignCode, OuterContext, Decls, Statements, !Info)
+ PredId, ProcId, Args, ExtraArgs, ForeignCode,
+ OuterContext, Decls, Statements, !Info)
).
ml_gen_goal_expr(shorthand(_), _, _, _, _, !Info) :-
@@ -2163,8 +2165,7 @@
:- pred ml_gen_nondet_pragma_foreign_proc(code_model::in,
pragma_foreign_proc_attributes::in,
- pred_id::in, proc_id::in, list(prog_var)::in,
- list(maybe(pair(string, mode)))::in, list(prog_type)::in,
+ pred_id::in, proc_id::in, list(foreign_arg)::in,
prog_context::in, string::in, maybe(prog_context)::in, string::in,
maybe(prog_context)::in, string::in, maybe(prog_context)::in,
string::in, maybe(prog_context)::in,
@@ -2223,11 +2224,10 @@
% gets inlined and optimized away. Of course we also need to
% #undef it afterwards.
%
-ml_gen_nondet_pragma_foreign_proc(CodeModel, Attributes,
- PredId, _ProcId, ArgVars, ArgDatas, OrigArgTypes, Context,
- LocalVarsDecls, LocalVarsContext, FirstCode, FirstContext,
- LaterCode, LaterContext, SharedCode, SharedContext,
- Decls, Statements, !Info) :-
+ml_gen_nondet_pragma_foreign_proc(CodeModel, Attributes, PredId, _ProcId,
+ Args, Context, LocalVarsDecls, LocalVarsContext,
+ FirstCode, FirstContext, LaterCode, LaterContext,
+ SharedCode, SharedContext, Decls, Statements, !Info) :-
Lang = foreign_language(Attributes),
( Lang = csharp ->
@@ -2236,14 +2236,9 @@
true
),
%
- % Combine all the information about the each arg
- %
- ml_make_c_arg_list(ArgVars, ArgDatas, OrigArgTypes, ArgList),
-
- %
% Generate <declaration of one local variable for each arg>
%
- ml_gen_pragma_c_decls(!.Info, Lang, ArgList, ArgDeclsList),
+ ml_gen_pragma_c_decls(!.Info, Lang, Args, ArgDeclsList),
%
% Generate definitions of the FAIL, SUCCEED, SUCCEED_LAST,
@@ -2265,12 +2260,12 @@
%
% Generate code to set the values of the input variables.
%
- ml_gen_pragma_c_input_arg_list(Lang, ArgList, AssignInputsList, !Info),
+ ml_gen_pragma_c_input_arg_list(Lang, Args, AssignInputsList, !Info),
%
% Generate code to assign the values of the output variables.
%
- ml_gen_pragma_c_output_arg_list(Lang, ArgList, Context,
+ ml_gen_pragma_c_output_arg_list(Lang, Args, Context,
AssignOutputsList, ConvDecls, ConvStatements, !Info),
%
@@ -2364,74 +2359,70 @@
Decls = ConvDecls.
:- pred ml_gen_ordinary_pragma_foreign_proc(code_model::in,
- pragma_foreign_proc_attributes::in,
- pred_id::in, proc_id::in, list(prog_var)::in,
- list(maybe(pair(string, mode)))::in, list(prog_type)::in,
- string::in, prog_context::in,
- mlds__defns::out, mlds__statements::out,
+ pragma_foreign_proc_attributes::in, pred_id::in, proc_id::in,
+ list(foreign_arg)::in, list(foreign_arg)::in, string::in,
+ prog_context::in, mlds__defns::out, mlds__statements::out,
ml_gen_info::in, ml_gen_info::out) is det.
-ml_gen_ordinary_pragma_foreign_proc(CodeModel, Attributes,
- PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
- Foreign_Code, Context, Decls, Statements, !Info) :-
+ml_gen_ordinary_pragma_foreign_proc(CodeModel, Attributes, PredId, ProcId,
+ Args, ExtraArgs, Foreign_Code, Context, Decls, Statements,
+ !Info) :-
Lang = foreign_language(Attributes),
(
Lang = c,
ml_gen_ordinary_pragma_c_proc(CodeModel, Attributes,
- PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
+ PredId, ProcId, Args, ExtraArgs,
Foreign_Code, Context, Decls, Statements, !Info)
;
Lang = managed_cplusplus,
ml_gen_ordinary_pragma_managed_proc(CodeModel, Attributes,
- PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
+ PredId, ProcId, Args, ExtraArgs,
Foreign_Code, Context, Decls, Statements, !Info)
;
Lang = csharp,
ml_gen_ordinary_pragma_managed_proc(CodeModel, Attributes,
- PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
+ PredId, ProcId, Args, ExtraArgs,
Foreign_Code, Context, Decls, Statements, !Info)
;
Lang = il,
ml_gen_ordinary_pragma_il_proc(CodeModel, Attributes,
- PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
+ PredId, ProcId, Args, ExtraArgs,
Foreign_Code, Context, Decls, Statements, !Info)
;
Lang = java,
ml_gen_ordinary_pragma_java_proc(CodeModel, Attributes,
- PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
+ PredId, ProcId, Args, ExtraArgs,
Foreign_Code, Context, Decls, Statements, !Info)
).
:- pred ml_gen_ordinary_pragma_java_proc(code_model::in,
pragma_foreign_proc_attributes::in, pred_id::in, proc_id::in,
- list(prog_var)::in, list(maybe(pair(string, mode)))::in,
- list(prog_type)::in, string::in, prog_context::in, mlds__defns::out,
- mlds__statements::out, ml_gen_info::in, ml_gen_info::out) is det.
+ list(foreign_arg)::in, list(foreign_arg)::in, string::in,
+ prog_context::in, mlds__defns::out, mlds__statements::out,
+ ml_gen_info::in, ml_gen_info::out) is det.
% For ordinary (not model_non) pragma foreign_code in Java.
%
-ml_gen_ordinary_pragma_java_proc(_CodeModel, Attributes,
- _PredId, _ProcId, ArgVars, ArgDatas, OrigArgTypes,
- JavaCode, Context, Decls, Statements, !Info) :-
+ml_gen_ordinary_pragma_java_proc(_CodeModel, Attributes, _PredId, _ProcId,
+ Args, ExtraArgs, JavaCode, Context, Decls, Statements,
+ !Info) :-
Lang = foreign_language(Attributes),
%
- % Combine all the information about the each arg
- %
- ml_make_c_arg_list(ArgVars, ArgDatas, OrigArgTypes, ArgList),
- %
% Generate <declaration of one local variable for each arg>
%
- ml_gen_pragma_c_decls(!.Info, Lang, ArgList, ArgDeclsList),
+ ml_gen_pragma_c_decls(!.Info, Lang, Args, ArgDeclsList),
+ require(unify(ExtraArgs, []),
+ "ml_gen_ordinary_pragma_java_proc: extra args"),
%
% Generate code to set the values of the input variables.
%
- ml_gen_pragma_c_input_arg_list(Lang, ArgList, AssignInputsList, !Info),
+ ml_gen_pragma_c_input_arg_list(Lang, Args, AssignInputsList, !Info),
%
% Generate MLDS statements to assign the values of the output
% variables.
%
- ml_gen_pragma_java_output_arg_list(Lang, ArgList, Context,
+ ml_gen_pragma_java_output_arg_list(Lang, Args, Context,
AssignOutputsList, ConvDecls, ConvStatements, !Info),
%
% Put it all together
@@ -2456,21 +2447,21 @@
:- pred ml_gen_ordinary_pragma_managed_proc(code_model::in,
pragma_foreign_proc_attributes::in, pred_id::in, proc_id::in,
- list(prog_var)::in, list(maybe(pair(string, mode)))::in,
- list(prog_type)::in, string::in, prog_context::in,
- mlds__defns::out, mlds__statements::out,
+ list(foreign_arg)::in, list(foreign_arg)::in, string::in,
+ prog_context::in, mlds__defns::out, mlds__statements::out,
ml_gen_info::in, ml_gen_info::out) is det.
% For ordinary (not model_non) pragma foreign_code in C# or MC++,
% we generate a call to an out-of-line procedure that contains
% the user's code.
-ml_gen_ordinary_pragma_managed_proc(CodeModel, Attributes,
- _PredId, _ProcId, ArgVars, ArgDatas, OrigArgTypes,
- ForeignCode, Context, Decls, Statements, !Info) :-
+ml_gen_ordinary_pragma_managed_proc(CodeModel, Attributes, _PredId, _ProcId,
+ Args, ExtraArgs, ForeignCode, Context, Decls, Statements,
+ !Info) :-
- ml_make_c_arg_list(ArgVars, ArgDatas, OrigArgTypes, ArgList),
- ml_gen_outline_args(ArgList, OutlineArgs, !Info),
+ ml_gen_outline_args(Args, OutlineArgs, !Info),
+ require(unify(ExtraArgs, []),
+ "ml_gen_ordinary_pragma_managed_proc: extra args"),
ForeignLang = foreign_language(Attributes),
MLDSContext = mlds__make_context(Context),
@@ -2511,11 +2502,11 @@
],
Decls = SuccessVarLocals.
-:- pred ml_gen_outline_args(list(ml_c_arg)::in, list(outline_arg)::out,
+:- pred ml_gen_outline_args(list(foreign_arg)::in, list(outline_arg)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_outline_args([], [], !Info).
-ml_gen_outline_args([ml_c_arg(Var, MaybeVarMode, OrigType) | Args],
+ml_gen_outline_args([foreign_arg(Var, MaybeVarMode, OrigType) | Args],
[OutlineArg | OutlineArgs], !Info) :-
ml_gen_outline_args(Args, OutlineArgs, !Info),
ml_gen_info_get_module_info(!.Info, ModuleInfo),
@@ -2540,14 +2531,16 @@
:- pred ml_gen_ordinary_pragma_il_proc(code_model::in,
pragma_foreign_proc_attributes::in, pred_id::in, proc_id::in,
- list(prog_var)::in, list(maybe(pair(string, mode)))::in,
- list(prog_type)::in, string::in, prog_context::in,
- mlds__defns::out, mlds__statements::out,
+ list(foreign_arg)::in, list(foreign_arg)::in, string::in,
+ prog_context::in, mlds__defns::out, mlds__statements::out,
ml_gen_info::in, ml_gen_info::out) is det.
-ml_gen_ordinary_pragma_il_proc(_CodeModel, Attributes,
- PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
- ForeignCode, Context, Decls, Statements, !Info) :-
+ml_gen_ordinary_pragma_il_proc(_CodeModel, Attributes, PredId, ProcId,
+ Args, ExtraArgs, ForeignCode, Context, Decls, Statements,
+ !Info) :-
+
+ require(unify(ExtraArgs, []),
+ "ml_gen_ordinary_pragma_managed_proc: extra args"),
% XXX FIXME need to handle model_semi code here,
% i.e. provide some equivalent to SUCCESS_INDICATOR.
@@ -2563,14 +2556,11 @@
% proc_info_vartypes(ProcInfo, VarTypes),
% note that for headvars we must use the types from
% the procedure interface, not from the procedure body
- HeadVarTypes = map__from_corresponding_lists(ArgVars, OrigArgTypes),
ml_gen_info_get_byref_output_vars(!.Info, ByRefOutputVars),
ml_gen_info_get_value_output_vars(!.Info, CopiedOutputVars),
module_info_name(ModuleInfo, ModuleName),
MLDSModuleName = mercury_module_name_to_mlds(ModuleName),
- ArgVarDataMap = map__from_corresponding_lists(ArgVars, ArgDatas),
-
% XXX in the code to marshall parameters, fjh says:
% We need to handle the case where the types in the procedure interface
% are polymorphic, but the types of the vars in the `foreign_proc' HLDS
@@ -2579,23 +2569,24 @@
% generate here with ml_gen_assign won't be type-correct. In general
% you may need to box/unbox the arguments.
+ build_arg_map(Args, map__init, ArgMap),
+
% Generate statements to assign by-ref output arguments
list__filter_map(ml_gen_pragma_il_proc_assign_output(ModuleInfo,
- MLDSModuleName, HeadVarTypes, VarSet, Context,
- ArgVarDataMap, yes),
+ MLDSModuleName, ArgMap, VarSet, Context, yes),
ByRefOutputVars, ByRefAssignStatements),
% Generate statements to assign copied output arguments
list__filter_map(ml_gen_pragma_il_proc_assign_output(ModuleInfo,
- MLDSModuleName, HeadVarTypes, VarSet, Context,
- ArgVarDataMap, no),
+ MLDSModuleName, ArgMap, VarSet, Context, no),
CopiedOutputVars, CopiedOutputStatements),
+ ArgVars = list__map(foreign_arg_var, Args),
% Generate declarations for all the variables, and
% initializers for input variables.
list__map(ml_gen_pragma_il_proc_var_decl_defn(ModuleInfo,
- MLDSModuleName, HeadVarTypes, VarSet, MLDSContext,
- ArgVarDataMap, ByRefOutputVars, CopiedOutputVars),
+ MLDSModuleName, ArgMap, VarSet, MLDSContext,
+ ByRefOutputVars, CopiedOutputVars),
ArgVars, VarLocals),
OutlineStmt = inline_target_code(lang_il, [
@@ -2611,14 +2602,24 @@
mlds__make_context(Context))],
Decls = [].
+:- pred build_arg_map(list(foreign_arg)::in, map(prog_var, foreign_arg)::in,
+ map(prog_var, foreign_arg)::out) is det.
+
+build_arg_map([], !ArgMap).
+build_arg_map([ForeignArg | ForeignArgs], !ArgMap) :-
+ ForeignArg = foreign_arg(Var, _, _),
+ map__det_insert(!.ArgMap, Var, ForeignArg, !:ArgMap),
+ build_arg_map(ForeignArgs, !ArgMap).
+
:- pred ml_gen_pragma_il_proc_assign_output(module_info::in,
- mlds_module_name::in, vartypes::in, prog_varset::in, prog_context::in,
- map(prog_var, maybe(pair(string, mode)))::in, bool::in,
- prog_var::in, mlds__statement::out) is semidet.
-
-ml_gen_pragma_il_proc_assign_output(ModuleInfo, MLDSModuleName, HeadVarTypes,
- VarSet, Context, ArgVarDataMap, IsByRef, Var, Statement) :-
- map__lookup(HeadVarTypes, Var, Type),
+ mlds_module_name::in, map(prog_var, foreign_arg)::in, prog_varset::in,
+ prog_context::in, bool::in, prog_var::in, mlds__statement::out)
+ is semidet.
+
+ml_gen_pragma_il_proc_assign_output(ModuleInfo, MLDSModuleName, ArgMap,
+ VarSet, Context, IsByRef, Var, Statement) :-
+ map__lookup(ArgMap, Var, ForeignArg),
+ ForeignArg = foreign_arg(_, MaybeNameMode, Type),
not type_util__is_dummy_argument_type(Type),
MLDSType = mercury_type_to_mlds_type(ModuleInfo, Type),
@@ -2633,8 +2634,7 @@
OutputVarLval = var(QualVarName, MLDSType)
),
- map__lookup(ArgVarDataMap, Var, MaybeVarName),
- MaybeVarName = yes(UserVarNameString - _),
+ MaybeNameMode = yes(UserVarNameString - _),
NonMangledVarName = mlds__var_name(UserVarNameString, no),
QualLocalVarName= qual(MLDSModuleName, NonMangledVarName),
LocalVarLval = var(QualLocalVarName, MLDSType),
@@ -2642,19 +2642,16 @@
Statement = ml_gen_assign(OutputVarLval, lval(LocalVarLval), Context).
:- pred ml_gen_pragma_il_proc_var_decl_defn(module_info::in,
- mlds_module_name::in, vartypes::in, prog_varset::in,
- mlds__context::in, map(prog_var, maybe(pair(string, mode)))::in,
- list(prog_var)::in, list(prog_var)::in,
+ mlds_module_name::in, map(prog_var, foreign_arg)::in, prog_varset::in,
+ mlds__context::in, list(prog_var)::in, list(prog_var)::in,
prog_var::in, mlds__defn::out) is det.
-ml_gen_pragma_il_proc_var_decl_defn(ModuleInfo, MLDSModuleName,
- HeadVarTypes, VarSet, MLDSContext, ArgVarDataMap,
- ByRefOutputVars, CopiedOutputVars, Var, Defn) :-
- map__lookup(HeadVarTypes, Var, Type),
+ml_gen_pragma_il_proc_var_decl_defn(ModuleInfo, MLDSModuleName, ArgMap, VarSet,
+ MLDSContext, ByRefOutputVars, CopiedOutputVars, Var, Defn) :-
+ map__lookup(ArgMap, Var, ForeignArg),
+ ForeignArg = foreign_arg(_, MaybeNameMode, Type),
VarName = ml_gen_var_name(VarSet, Var),
-
- map__lookup(ArgVarDataMap, Var, MaybeVarName),
- ( MaybeVarName = yes(UserVarNameString - _) ->
+ ( MaybeNameMode = yes(UserVarNameString - _) ->
NonMangledVarName = mlds__var_name(UserVarNameString, no)
;
sorry(this_file, "no variable name for var")
@@ -2688,9 +2685,8 @@
:- pred ml_gen_ordinary_pragma_c_proc(code_model::in,
pragma_foreign_proc_attributes::in, pred_id::in, proc_id::in,
- list(prog_var)::in, list(maybe(pair(string, mode)))::in,
- list(prog_type)::in, string::in, prog_context::in,
- mlds__defns::out, mlds__statements::out,
+ list(foreign_arg)::in, list(foreign_arg)::in, string::in,
+ prog_context::in, mlds__defns::out, mlds__statements::out,
ml_gen_info::in, ml_gen_info::out) is det.
% For ordinary (not model_non) pragma c_proc,
@@ -2751,32 +2747,27 @@
% different for targets other than C, e.g. when compiling to
% Java.
%
-ml_gen_ordinary_pragma_c_proc(CodeModel, Attributes,
- PredId, _ProcId, ArgVars, ArgDatas, OrigArgTypes,
- C_Code, Context, Decls, Statements, !Info) :-
+ml_gen_ordinary_pragma_c_proc(CodeModel, Attributes, PredId, _ProcId,
+ OrigArgs, ExtraArgs, C_Code, Context, Decls, Statements,
+ !Info) :-
Lang = foreign_language(Attributes),
%
- % Combine all the information about the each arg
- %
- ml_make_c_arg_list(ArgVars, ArgDatas, OrigArgTypes,
- ArgList),
-
- %
% Generate <declaration of one local variable for each arg>
%
- ml_gen_pragma_c_decls(!.Info, Lang, ArgList, ArgDeclsList),
+ list__append(OrigArgs, ExtraArgs, Args),
+ ml_gen_pragma_c_decls(!.Info, Lang, Args, ArgDeclsList),
%
% Generate code to set the values of the input variables.
%
- ml_gen_pragma_c_input_arg_list(Lang, ArgList, AssignInputsList, !Info),
+ ml_gen_pragma_c_input_arg_list(Lang, Args, AssignInputsList, !Info),
%
% Generate code to assign the values of the output variables.
%
- ml_gen_pragma_c_output_arg_list(Lang, ArgList, Context,
+ ml_gen_pragma_c_output_arg_list(Lang, Args, Context,
AssignOutputsList, ConvDecls, ConvStatements, !Info),
%
@@ -2910,47 +2901,11 @@
%---------------------------------------------------------------------------%
-%
-% we gather all the information about each pragma_c argument
-% together into this struct
-%
-
-:- type ml_c_arg
- ---> ml_c_arg(
- prog_var,
- maybe(pair(string, mode)), % name and mode
- prog_type % original type before
- % inlining/specialization
- % (the actual type may be an instance
- % of this type, if this type is
- % polymorphic).
- ).
-
-:- pred ml_make_c_arg_list(list(prog_var)::in,
- list(maybe(pair(string, mode)))::in, list(prog_type)::in,
- list(ml_c_arg)::out) is det.
-
- % XXX Maybe this ought to be renamed as it works for, and
- % is used by the Java back-end as well.
- %
-ml_make_c_arg_list(Vars, ArgDatas, Types, ArgList) :-
- ( Vars = [], ArgDatas = [], Types = [] ->
- ArgList = []
- ; Vars = [V | Vs], ArgDatas = [N | Ns], Types = [T | Ts] ->
- Arg = ml_c_arg(V, N, T),
- ml_make_c_arg_list(Vs, Ns, Ts, Args),
- ArgList = [Arg | Args]
- ;
- error("ml_code_gen:make_c_arg_list - length mismatch")
- ).
-
-%---------------------------------------------------------------------------%
-
% ml_gen_pragma_c_decls generates C code to declare the arguments
% for a `pragma foreign_proc' declaration.
%
:- pred ml_gen_pragma_c_decls(ml_gen_info::in, foreign_language::in,
- list(ml_c_arg)::in, list(target_code_component)::out) is det.
+ list(foreign_arg)::in, list(target_code_component)::out) is det.
% XXX Maybe this ought to be renamed as it works for, and
% is used by the Java back-end as well.
@@ -2964,9 +2919,9 @@
% of a `pragma foreign_proc' declaration.
%
:- pred ml_gen_pragma_c_decl(ml_gen_info::in, foreign_language::in,
- ml_c_arg::in, target_code_component::out) is det.
+ foreign_arg::in, target_code_component::out) is det.
-ml_gen_pragma_c_decl(Info, Lang, ml_c_arg(_Var, MaybeNameAndMode, Type),
+ml_gen_pragma_c_decl(Info, Lang, foreign_arg(_Var, MaybeNameAndMode, Type),
Decl) :-
ml_gen_info_get_module_info(Info, ModuleInfo),
(
@@ -3002,7 +2957,7 @@
%-----------------------------------------------------------------------------%
:- pred ml_gen_pragma_c_input_arg_list(foreign_language::in,
- list(ml_c_arg)::in, list(target_code_component)::out,
+ list(foreign_arg)::in, list(target_code_component)::out,
ml_gen_info::in, ml_gen_info::out) is det.
% XXX Maybe this ought to be renamed as it works for, and
@@ -3016,11 +2971,11 @@
% ml_gen_pragma_c_input_arg generates C code to assign the value of an
% input arg for a `pragma foreign_proc' declaration.
%
-:- pred ml_gen_pragma_c_input_arg(foreign_language::in, ml_c_arg::in,
+:- pred ml_gen_pragma_c_input_arg(foreign_language::in, foreign_arg::in,
list(target_code_component)::out,
ml_gen_info::in, ml_gen_info::out) is det.
-ml_gen_pragma_c_input_arg(Lang, ml_c_arg(Var, MaybeNameAndMode, OrigType),
+ml_gen_pragma_c_input_arg(Lang, foreign_arg(Var, MaybeNameAndMode, OrigType),
AssignInput, !Info) :-
ml_gen_info_get_module_info(!.Info, ModuleInfo),
(
@@ -3108,7 +3063,7 @@
).
:- pred ml_gen_pragma_java_output_arg_list(foreign_language::in,
- list(ml_c_arg)::in, prog_context::in, mlds__statements::out,
+ list(foreign_arg)::in, prog_context::in, mlds__statements::out,
mlds__defns::out, mlds__statements::out,
ml_gen_info::in, ml_gen_info::out) is det.
@@ -3128,13 +3083,13 @@
% declaration.
%
:- pred ml_gen_pragma_java_output_arg(foreign_language::in,
- ml_c_arg::in, prog_context::in, mlds__statements::out,
+ foreign_arg::in, prog_context::in, mlds__statements::out,
mlds__defns::out, mlds__statements::out,
ml_gen_info::in, ml_gen_info::out) is det.
-ml_gen_pragma_java_output_arg(_Lang, ml_c_arg(Var, MaybeNameAndMode, OrigType),
- Context, AssignOutput, ConvDecls, ConvOutputStatements,
- !Info) :-
+ml_gen_pragma_java_output_arg(_Lang, ForeignArg, Context, AssignOutput,
+ ConvDecls, ConvOutputStatements, !Info) :-
+ ForeignArg = foreign_arg(Var, MaybeNameAndMode, OrigType),
ml_gen_info_get_module_info(!.Info, ModuleInfo),
(
MaybeNameAndMode = yes(ArgName - Mode),
@@ -3179,16 +3134,16 @@
).
:- pred ml_gen_pragma_c_output_arg_list(foreign_language::in,
- list(ml_c_arg)::in, prog_context::in, list(target_code_component)::out,
- mlds__defns::out, mlds__statements::out,
- ml_gen_info::in, ml_gen_info::out) is det.
+ list(foreign_arg)::in, prog_context::in,
+ list(target_code_component)::out, mlds__defns::out,
+ mlds__statements::out, ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_pragma_c_output_arg_list(_, [], _, [], [], [], !Info).
-ml_gen_pragma_c_output_arg_list(Lang, [C_Arg | C_Args], Context,
+ml_gen_pragma_c_output_arg_list(Lang, [ForeignArg | ForeignArgs], Context,
Components, ConvDecls, ConvStatements, !Info) :-
- ml_gen_pragma_c_output_arg(Lang, C_Arg, Context, Components1,
+ ml_gen_pragma_c_output_arg(Lang, ForeignArg, Context, Components1,
ConvDecls1, ConvStatements1, !Info),
- ml_gen_pragma_c_output_arg_list(Lang, C_Args, Context,
+ ml_gen_pragma_c_output_arg_list(Lang, ForeignArgs, Context,
Components2, ConvDecls2, ConvStatements2, !Info),
Components = list__append(Components1, Components2),
ConvDecls = list__append(ConvDecls1, ConvDecls2),
@@ -3197,12 +3152,12 @@
% ml_gen_pragma_c_output_arg generates C code to assign the value of an output
% arg for a `pragma foreign_proc' declaration.
%
-:- pred ml_gen_pragma_c_output_arg(foreign_language::in, ml_c_arg::in,
+:- pred ml_gen_pragma_c_output_arg(foreign_language::in, foreign_arg::in,
prog_context::in, list(target_code_component)::out,
mlds__defns::out, mlds__statements::out,
ml_gen_info::in, ml_gen_info::out) is det.
-ml_gen_pragma_c_output_arg(Lang, ml_c_arg(Var, MaybeNameAndMode, OrigType),
+ml_gen_pragma_c_output_arg(Lang, foreign_arg(Var, MaybeNameAndMode, OrigType),
Context, AssignOutput, ConvDecls, ConvOutputStatements,
!Info) :-
ml_gen_info_get_module_info(!.Info, ModuleInfo),
Index: compiler/mode_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mode_util.m,v
retrieving revision 1.156
diff -u -b -r1.156 mode_util.m
--- compiler/mode_util.m 5 Nov 2003 03:17:40 -0000 1.156
+++ compiler/mode_util.m 7 Jun 2004 08:49:55 -0000
@@ -256,7 +256,8 @@
:- import_module parse_tree__prog_io.
:- import_module parse_tree__prog_util.
-:- import_module require, int, map, set, term, std_util, assoc_list, varset.
+:- import_module require, int, string, map, set, term, std_util.
+:- import_module assoc_list, varset.
%-----------------------------------------------------------------------------%
@@ -1296,9 +1297,9 @@
InstMap0, _, RI0, RI),
ModuleInfo = RI^module_info.
-:- pred recompute_instmap_delta_1(bool, hlds_goal, hlds_goal, vartypes,
- instmap, instmap_delta, recompute_info, recompute_info).
-:- mode recompute_instmap_delta_1(in, in, out, in, in, out, in, out) is det.
+:- pred recompute_instmap_delta_1(bool::in, hlds_goal::in, hlds_goal::out,
+ vartypes::in, instmap::in, instmap_delta::out,
+ recompute_info::in, recompute_info::out) is det.
recompute_instmap_delta_1(RecomputeAtomic, Goal0 - GoalInfo0, Goal - GoalInfo,
VarTypes, InstMap0, InstMapDelta, RI0, RI) :-
@@ -1340,118 +1341,134 @@
% update_module_info(P, R, RI0, RI) will call predicate P, passing it
% the module_info from RI0 and placing the output module_info in RI.
% The output of P's first argument is returned in R.
-:- pred update_module_info(pred(T, module_info, module_info), T,
- recompute_info, recompute_info).
-:- mode update_module_info(pred(out, in, out) is det, out, in, out) is det.
-
-update_module_info(P, R) -->
- ModuleInfo0 =^ module_info,
- { P(R, ModuleInfo0, ModuleInfo) },
- ^module_info := ModuleInfo.
-
-:- pred recompute_instmap_delta_2(bool, hlds_goal_expr, hlds_goal_info,
- hlds_goal_expr, vartypes, instmap, instmap_delta,
- recompute_info, recompute_info).
-:- mode recompute_instmap_delta_2(in, in, in, out, in, in, out, in, out) is det.
+:- pred update_module_info(
+ pred(T, module_info, module_info)::in(pred(out, in, out) is det),
+ T::out, recompute_info::in, recompute_info::out) is det.
+
+update_module_info(P, R, !RI) :-
+ ModuleInfo0 = !.RI ^ module_info,
+ P(R, ModuleInfo0, ModuleInfo),
+ !:RI = !.RI ^ module_info := ModuleInfo.
+
+:- pred recompute_instmap_delta_2(bool::in, hlds_goal_expr::in,
+ hlds_goal_info::in, hlds_goal_expr::out, vartypes::in, instmap::in,
+ instmap_delta::out, recompute_info::in, recompute_info::out) is det.
recompute_instmap_delta_2(Atomic, switch(Var, Det, Cases0), GoalInfo,
- switch(Var, Det, Cases), VarTypes, InstMap, InstMapDelta) -->
- { goal_info_get_nonlocals(GoalInfo, NonLocals) },
+ switch(Var, Det, Cases), VarTypes, InstMap, InstMapDelta,
+ !RI) :-
+ goal_info_get_nonlocals(GoalInfo, NonLocals),
recompute_instmap_delta_cases(Atomic, Var, Cases0, Cases,
- VarTypes, InstMap, NonLocals, InstMapDelta).
+ VarTypes, InstMap, NonLocals, InstMapDelta, !RI).
recompute_instmap_delta_2(Atomic, conj(Goals0), _, conj(Goals),
- VarTypes, InstMap, InstMapDelta) -->
+ VarTypes, InstMap, InstMapDelta, !RI) :-
recompute_instmap_delta_conj(Atomic, Goals0, Goals,
- VarTypes, InstMap, InstMapDelta).
+ VarTypes, InstMap, InstMapDelta, !RI).
recompute_instmap_delta_2(Atomic, par_conj(Goals0), GoalInfo,
- par_conj(Goals), VarTypes, InstMap, InstMapDelta) -->
- { goal_info_get_nonlocals(GoalInfo, NonLocals) },
+ par_conj(Goals), VarTypes, InstMap, InstMapDelta, !RI) :-
+ goal_info_get_nonlocals(GoalInfo, NonLocals),
recompute_instmap_delta_par_conj(Atomic, Goals0, Goals,
- VarTypes, InstMap, NonLocals, InstMapDelta).
+ VarTypes, InstMap, NonLocals, InstMapDelta, !RI).
recompute_instmap_delta_2(Atomic, disj(Goals0), GoalInfo, disj(Goals),
- VarTypes, InstMap, InstMapDelta) -->
- { goal_info_get_nonlocals(GoalInfo, NonLocals) },
+ VarTypes, InstMap, InstMapDelta, !RI) :-
+ goal_info_get_nonlocals(GoalInfo, NonLocals),
recompute_instmap_delta_disj(Atomic, Goals0, Goals,
- VarTypes, InstMap, NonLocals, InstMapDelta).
+ VarTypes, InstMap, NonLocals, InstMapDelta, !RI).
recompute_instmap_delta_2(Atomic, not(Goal0), _, not(Goal),
- VarTypes, InstMap, InstMapDelta) -->
- { instmap_delta_init_reachable(InstMapDelta) },
- recompute_instmap_delta_1(Atomic, Goal0, Goal, VarTypes, InstMap, _).
-
-recompute_instmap_delta_2(Atomic, if_then_else(Vars, A0, B0, C0), GoalInfo,
- if_then_else(Vars, A, B, C), VarTypes, InstMap0,
- InstMapDelta) -->
- recompute_instmap_delta_1(Atomic, A0, A, VarTypes, InstMap0,
- InstMapDelta1),
- { instmap__apply_instmap_delta(InstMap0, InstMapDelta1, InstMap1) },
- recompute_instmap_delta_1(Atomic, B0, B, VarTypes, InstMap1,
- InstMapDelta2),
- recompute_instmap_delta_1(Atomic, C0, C, VarTypes, InstMap0,
- InstMapDelta3),
- { instmap_delta_apply_instmap_delta(InstMapDelta1, InstMapDelta2,
- InstMapDelta4) },
- { goal_info_get_nonlocals(GoalInfo, NonLocals) },
+ VarTypes, InstMap, InstMapDelta, !RI) :-
+ instmap_delta_init_reachable(InstMapDelta),
+ recompute_instmap_delta_1(Atomic, Goal0, Goal, VarTypes, InstMap, _,
+ !RI).
+
+recompute_instmap_delta_2(Atomic, if_then_else(Vars, Cond0, Then0, Else0),
+ GoalInfo, if_then_else(Vars, Cond, Then, Else), VarTypes,
+ InstMap0, InstMapDelta, !RI) :-
+ recompute_instmap_delta_1(Atomic, Cond0, Cond, VarTypes, InstMap0,
+ InstMapDeltaCond, !RI),
+ instmap__apply_instmap_delta(InstMap0, InstMapDeltaCond, InstMapCond),
+ recompute_instmap_delta_1(Atomic, Then0, Then, VarTypes, InstMapCond,
+ InstMapDeltaThen, !RI),
+ recompute_instmap_delta_1(Atomic, Else0, Else, VarTypes, InstMap0,
+ InstMapDeltaElse, !RI),
+ instmap_delta_apply_instmap_delta(InstMapDeltaCond, InstMapDeltaThen,
+ InstMapDeltaCondThen),
+ goal_info_get_nonlocals(GoalInfo, NonLocals),
update_module_info(merge_instmap_delta(InstMap0, NonLocals,
- VarTypes, InstMapDelta3, InstMapDelta4), InstMapDelta).
+ VarTypes, InstMapDeltaElse, InstMapDeltaCondThen),
+ InstMapDelta, !RI).
recompute_instmap_delta_2(Atomic, some(Vars, CanRemove, Goal0), _,
- some(Vars, CanRemove, Goal),
- VarTypes, InstMap, InstMapDelta) -->
+ some(Vars, CanRemove, Goal), VarTypes, InstMap, InstMapDelta,
+ !RI) :-
recompute_instmap_delta_1(Atomic, Goal0, Goal, VarTypes, InstMap,
- InstMapDelta).
+ InstMapDelta, !RI).
-recompute_instmap_delta_2(_, generic_call(A, Vars, Modes, D), _,
- generic_call(A, Vars, Modes, D),
- _VarTypes, _InstMap, InstMapDelta) -->
- ModuleInfo =^ module_info,
- { instmap_delta_from_mode_list(Vars, Modes,
- ModuleInfo, InstMapDelta) }.
+recompute_instmap_delta_2(_, generic_call(Details, Vars, Modes, Detism), _,
+ generic_call(Details, Vars, Modes, Detism),
+ _VarTypes, _InstMap, InstMapDelta, !RI) :-
+ ModuleInfo = !.RI ^ module_info,
+ instmap_delta_from_mode_list(Vars, Modes, ModuleInfo, InstMapDelta).
recompute_instmap_delta_2(_, call(PredId, ProcId, Args, D, E, F), _,
call(PredId, ProcId, Args, D, E, F), VarTypes,
- InstMap, InstMapDelta) -->
+ InstMap, InstMapDelta, !RI) :-
recompute_instmap_delta_call(PredId, ProcId,
- Args, VarTypes, InstMap, InstMapDelta).
+ Args, VarTypes, InstMap, InstMapDelta, !RI).
-recompute_instmap_delta_2(Atomic, unify(A, Rhs0, UniMode0, Uni, E), GoalInfo,
- unify(A, Rhs, UniMode, Uni, E), VarTypes, InstMap0,
- InstMapDelta) -->
+recompute_instmap_delta_2(Atomic, unify(LHS, RHS0, UniMode0, Uni, Context),
+ GoalInfo, unify(LHS, RHS, UniMode, Uni, Context), VarTypes,
+ InstMap0, InstMapDelta, !RI) :-
(
- { Rhs0 = lambda_goal(Purity, PorF, EvalMethod, FixModes,
- NonLocals, LambdaVars, Modes, Det, Goal0) }
+ RHS0 = lambda_goal(Purity, PorF, EvalMethod, FixModes,
+ NonLocals, LambdaVars, Modes, Det, Goal0)
->
- ModuleInfo0 =^ module_info,
- { instmap__pre_lambda_update(ModuleInfo0, LambdaVars, Modes,
- InstMap0, InstMap) },
+ ModuleInfo0 = !.RI ^ module_info,
+ instmap__pre_lambda_update(ModuleInfo0, LambdaVars, Modes,
+ InstMap0, InstMap),
recompute_instmap_delta_1(Atomic, Goal0, Goal, VarTypes,
- InstMap, _),
- { Rhs = lambda_goal(Purity, PorF, EvalMethod, FixModes,
- NonLocals, LambdaVars, Modes, Det, Goal) }
+ InstMap, _, !RI),
+ RHS = lambda_goal(Purity, PorF, EvalMethod, FixModes,
+ NonLocals, LambdaVars, Modes, Det, Goal)
;
- { Rhs = Rhs0 }
+ RHS = RHS0
),
- ( { Atomic = yes } ->
+ (
+ Atomic = yes,
recompute_instmap_delta_unify(Uni, UniMode0, UniMode,
- GoalInfo, InstMap0, InstMapDelta)
+ GoalInfo, InstMap0, InstMapDelta, !.RI)
;
- { UniMode = UniMode0 },
- { goal_info_get_instmap_delta(GoalInfo, InstMapDelta) }
+ Atomic = no,
+ UniMode = UniMode0,
+ goal_info_get_instmap_delta(GoalInfo, InstMapDelta)
).
recompute_instmap_delta_2(_,
- foreign_proc(A, PredId, ProcId, Args, E, F, G), _,
- foreign_proc(A, PredId, ProcId, Args, E, F, G),
- VarTypes, InstMap, InstMapDelta) -->
+ foreign_proc(A, PredId, ProcId, Args, ExtraArgs, F), GoalInfo,
+ foreign_proc(A, PredId, ProcId, Args, ExtraArgs, F),
+ VarTypes, InstMap, InstMapDelta, !RI) :-
+ ArgVars = list__map(foreign_arg_var, Args),
recompute_instmap_delta_call(PredId, ProcId,
- Args, VarTypes, InstMap, InstMapDelta).
+ ArgVars, VarTypes, InstMap, InstMapDelta0, !RI),
+ (
+ ExtraArgs = [],
+ InstMapDelta = InstMapDelta0
+ ;
+ ExtraArgs = [_ | _],
+ goal_info_get_instmap_delta(GoalInfo, OldInstMapDelta),
+ ExtraArgVars = list__map(foreign_arg_var, ExtraArgs),
+ instmap_delta_restrict(OldInstMapDelta,
+ set__list_to_set(ExtraArgVars), ExtraArgsInstMapDelta),
+ instmap_delta_apply_instmap_delta(InstMapDelta0,
+ ExtraArgsInstMapDelta, InstMapDelta)
+ ).
-recompute_instmap_delta_2(_, shorthand(_), _, _, _, _, _) -->
+recompute_instmap_delta_2(_, shorthand(_), _, _, _, _, _, !RI) :-
% these should have been expanded out by now
- { error("recompute_instmap_delta_2: unexpected shorthand") }.
+ error("recompute_instmap_delta_2: unexpected shorthand").
%-----------------------------------------------------------------------------%
@@ -1459,17 +1476,17 @@
list(hlds_goal)::out, vartypes::in, instmap::in, instmap_delta::out,
recompute_info::in, recompute_info::out) is det.
-recompute_instmap_delta_conj(_, [], [], _, _, InstMapDelta) -->
- { instmap_delta_init_reachable(InstMapDelta) }.
+recompute_instmap_delta_conj(_, [], [], _, _, InstMapDelta, !RI) :-
+ instmap_delta_init_reachable(InstMapDelta).
recompute_instmap_delta_conj(Atomic, [Goal0 | Goals0], [Goal | Goals],
- VarTypes, InstMap0, InstMapDelta) -->
- recompute_instmap_delta_1(Atomic, Goal0, Goal,
- VarTypes, InstMap0, InstMapDelta0),
- { instmap__apply_instmap_delta(InstMap0, InstMapDelta0, InstMap1) },
+ VarTypes, InstMap0, InstMapDelta, !RI) :-
+ recompute_instmap_delta_1(Atomic, Goal0, Goal, VarTypes, InstMap0,
+ InstMapDelta0, !RI),
+ instmap__apply_instmap_delta(InstMap0, InstMapDelta0, InstMap1),
recompute_instmap_delta_conj(Atomic, Goals0, Goals, VarTypes, InstMap1,
- InstMapDelta1),
- { instmap_delta_apply_instmap_delta(InstMapDelta0, InstMapDelta1,
- InstMapDelta) }.
+ InstMapDelta1, !RI),
+ instmap_delta_apply_instmap_delta(InstMapDelta0, InstMapDelta1,
+ InstMapDelta).
%-----------------------------------------------------------------------------%
@@ -1477,41 +1494,41 @@
list(hlds_goal)::out, vartypes::in, instmap::in, set(prog_var)::in,
instmap_delta::out, recompute_info::in, recompute_info::out) is det.
-recompute_instmap_delta_disj(_, [], [], _, _, _, InstMapDelta) -->
- { instmap_delta_init_unreachable(InstMapDelta) }.
+recompute_instmap_delta_disj(_, [], [], _, _, _, InstMapDelta, !RI) :-
+ instmap_delta_init_unreachable(InstMapDelta).
recompute_instmap_delta_disj(Atomic, [Goal0], [Goal],
- VarTypes, InstMap, _, InstMapDelta) -->
+ VarTypes, InstMap, _, InstMapDelta, !RI) :-
recompute_instmap_delta_1(Atomic, Goal0, Goal, VarTypes, InstMap,
- InstMapDelta).
+ InstMapDelta, !RI).
recompute_instmap_delta_disj(Atomic, [Goal0 | Goals0], [Goal | Goals],
- VarTypes, InstMap, NonLocals, InstMapDelta) -->
- { Goals0 = [_|_] },
+ VarTypes, InstMap, NonLocals, InstMapDelta, !RI) :-
+ Goals0 = [_ | _],
recompute_instmap_delta_1(Atomic, Goal0, Goal,
- VarTypes, InstMap, InstMapDelta0),
+ VarTypes, InstMap, InstMapDelta0, !RI),
recompute_instmap_delta_disj(Atomic, Goals0, Goals,
- VarTypes, InstMap, NonLocals, InstMapDelta1),
+ VarTypes, InstMap, NonLocals, InstMapDelta1, !RI),
update_module_info(merge_instmap_delta(InstMap, NonLocals,
- VarTypes, InstMapDelta0, InstMapDelta1), InstMapDelta).
+ VarTypes, InstMapDelta0, InstMapDelta1), InstMapDelta, !RI).
:- pred recompute_instmap_delta_par_conj(bool::in, list(hlds_goal)::in,
list(hlds_goal)::out, vartypes::in, instmap::in, set(prog_var)::in,
instmap_delta::out, recompute_info::in, recompute_info::out) is det.
-recompute_instmap_delta_par_conj(_, [], [], _, _, _, InstMapDelta) -->
- { instmap_delta_init_unreachable(InstMapDelta) }.
+recompute_instmap_delta_par_conj(_, [], [], _, _, _, InstMapDelta, !RI) :-
+ instmap_delta_init_unreachable(InstMapDelta).
recompute_instmap_delta_par_conj(Atomic, [Goal0], [Goal],
- VarTypes, InstMap, _, InstMapDelta) -->
+ VarTypes, InstMap, _, InstMapDelta, !RI) :-
recompute_instmap_delta_1(Atomic, Goal0, Goal, VarTypes, InstMap,
- InstMapDelta).
+ InstMapDelta, !RI).
recompute_instmap_delta_par_conj(Atomic, [Goal0 | Goals0], [Goal | Goals],
- VarTypes, InstMap, NonLocals, InstMapDelta) -->
- { Goals0 = [_|_] },
+ VarTypes, InstMap, NonLocals, InstMapDelta, !RI) :-
+ Goals0 = [_ | _],
recompute_instmap_delta_1(Atomic, Goal0, Goal,
- VarTypes, InstMap, InstMapDelta0),
+ VarTypes, InstMap, InstMapDelta0, !RI),
recompute_instmap_delta_par_conj(Atomic, Goals0, Goals,
- VarTypes, InstMap, NonLocals, InstMapDelta1),
+ VarTypes, InstMap, NonLocals, InstMapDelta1, !RI),
update_module_info(unify_instmap_delta(InstMap, NonLocals,
- InstMapDelta0, InstMapDelta1), InstMapDelta).
+ InstMapDelta0, InstMapDelta1), InstMapDelta, !RI).
%-----------------------------------------------------------------------------%
@@ -1519,23 +1536,23 @@
list(case)::out, vartypes::in, instmap::in, set(prog_var)::in,
instmap_delta::out, recompute_info::in, recompute_info::out) is det.
-recompute_instmap_delta_cases(_, _, [], [], _, _, _, InstMapDelta) -->
- { instmap_delta_init_unreachable(InstMapDelta) }.
+recompute_instmap_delta_cases(_, _, [], [], _, _, _, InstMapDelta, !RI) :-
+ instmap_delta_init_unreachable(InstMapDelta).
recompute_instmap_delta_cases(Atomic, Var, [Case0 | Cases0], [Case | Cases],
- VarTypes, InstMap0, NonLocals, InstMapDelta) -->
- { Case0 = case(Functor, Goal0) },
- { map__lookup(VarTypes, Var, Type) },
+ VarTypes, InstMap0, NonLocals, InstMapDelta, !RI) :-
+ Case0 = case(Functor, Goal0),
+ map__lookup(VarTypes, Var, Type),
update_module_info(instmap__bind_var_to_functor(Var, Type, Functor,
- InstMap0), InstMap),
+ InstMap0), InstMap, !RI),
recompute_instmap_delta_1(Atomic, Goal0, Goal, VarTypes, InstMap,
- InstMapDelta0),
+ InstMapDelta0, !RI),
update_module_info(instmap_delta_bind_var_to_functor(Var, Type, Functor,
- InstMap0, InstMapDelta0), InstMapDelta1),
- { Case = case(Functor, Goal) },
+ InstMap0, InstMapDelta0), InstMapDelta1, !RI),
+ Case = case(Functor, Goal),
recompute_instmap_delta_cases(Atomic, Var, Cases0, Cases,
- VarTypes, InstMap0, NonLocals, InstMapDelta2),
+ VarTypes, InstMap0, NonLocals, InstMapDelta2, !RI),
update_module_info(merge_instmap_delta(InstMap0, NonLocals,
- VarTypes, InstMapDelta1, InstMapDelta2), InstMapDelta).
+ VarTypes, InstMapDelta1, InstMapDelta2), InstMapDelta, !RI).
%-----------------------------------------------------------------------------%
@@ -1544,122 +1561,122 @@
recompute_info::in, recompute_info::out) is det.
recompute_instmap_delta_call(PredId, ProcId, Args, VarTypes, InstMap,
- InstMapDelta) -->
- ModuleInfo =^ module_info,
- { module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, ProcInfo) },
- { proc_info_interface_determinism(ProcInfo, Detism) },
- ( { determinism_components(Detism, _, at_most_zero) } ->
- { instmap_delta_init_unreachable(InstMapDelta) }
- ;
- { proc_info_argmodes(ProcInfo, ArgModes0) },
- { proc_info_inst_varset(ProcInfo, ProcInstVarSet) },
- InstVarSet =^ inst_varset,
- { rename_apart_inst_vars(InstVarSet, ProcInstVarSet,
- ArgModes0, ArgModes1) },
- { mode_list_get_initial_insts(ArgModes1, ModuleInfo,
- InitialInsts) },
+ InstMapDelta, !RI) :-
+ ModuleInfo = !.RI ^ module_info,
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, ProcInfo),
+ proc_info_interface_determinism(ProcInfo, Detism),
+ ( determinism_components(Detism, _, at_most_zero) ->
+ instmap_delta_init_unreachable(InstMapDelta)
+ ;
+ proc_info_argmodes(ProcInfo, ArgModes0),
+ proc_info_inst_varset(ProcInfo, ProcInstVarSet),
+ InstVarSet = !.RI ^ inst_varset,
+ rename_apart_inst_vars(InstVarSet, ProcInstVarSet,
+ ArgModes0, ArgModes1),
+ mode_list_get_initial_insts(ArgModes1, ModuleInfo,
+ InitialInsts),
% Compute the inst_var substitution from the initial insts
% of the called procedure and the insts of the argument
% variables.
- { map__init(InstVarSub0) },
+ map__init(InstVarSub0),
update_module_info(compute_inst_var_sub(Args, VarTypes, InstMap,
- InitialInsts, InstVarSub0), InstVarSub),
+ InitialInsts, InstVarSub0), InstVarSub, !RI),
% Apply the inst_var substitution to the argument modes.
- { mode_list_apply_substitution(ArgModes1, InstVarSub,
- ArgModes2) },
+ mode_list_apply_substitution(ArgModes1, InstVarSub,
+ ArgModes2),
% Calculate the final insts of the argument variables
% from their initial insts and the final insts of the called
% procedure (with inst_var substitutions applied).
update_module_info(recompute_instmap_delta_call_2(Args, InstMap,
- ArgModes2), ArgModes),
- { instmap_delta_from_mode_list(Args, ArgModes,
- ModuleInfo, InstMapDelta) }
+ ArgModes2), ArgModes, !RI),
+ instmap_delta_from_mode_list(Args, ArgModes,
+ ModuleInfo, InstMapDelta)
).
-:- pred compute_inst_var_sub(list(prog_var), vartypes, instmap,
- list(inst), inst_var_sub, inst_var_sub, module_info, module_info).
-:- mode compute_inst_var_sub(in, in, in, in, in, out, in, out) is det.
+:- pred compute_inst_var_sub(list(prog_var)::in, vartypes::in, instmap::in,
+ list(inst)::in, inst_var_sub::in, inst_var_sub::out,
+ module_info::in, module_info::out) is det.
-compute_inst_var_sub([], _, _, [], Sub, Sub, ModuleInfo, ModuleInfo).
-compute_inst_var_sub([_|_], _, _, [], _, _, _, _) :-
+compute_inst_var_sub([], _, _, [], !Sub, !ModuleInfo).
+compute_inst_var_sub([_|_], _, _, [], !Sub, !ModuleInfo) :-
error("compute_inst_var_sub").
-compute_inst_var_sub([], _, _, [_|_], _, _, _, _) :-
+compute_inst_var_sub([], _, _, [_|_], !Sub, !ModuleInfo) :-
error("compute_inst_var_sub").
compute_inst_var_sub([Arg | Args], VarTypes, InstMap, [Inst | Insts],
- Sub0, Sub, ModuleInfo0, ModuleInfo) :-
+ !Sub, !ModuleInfo) :-
% This is similar to modecheck_var_has_inst.
+ SaveModuleInfo = !.ModuleInfo,
+ SaveSub = !.Sub,
( instmap__is_reachable(InstMap) ->
instmap__lookup_var(InstMap, Arg, ArgInst),
map__lookup(VarTypes, Arg, Type),
(
- inst_matches_initial(ArgInst, Inst, Type, ModuleInfo0,
- ModuleInfo1, Sub0, Sub1)
+ inst_matches_initial(ArgInst, Inst, Type, !ModuleInfo,
+ !Sub)
->
- ModuleInfo2 = ModuleInfo1,
- Sub2 = Sub1
+ true
;
- % error("compute_inst_var_sub: inst_matches_initial failed")
- % XXX We shouldn't ever get here, but unfortunately the
- % mode system currently has several problems (most
+ % error("compute_inst_var_sub: " ++
+ % ++ "inst_matches_initial failed")
+ % XXX We shouldn't ever get here, but unfortunately
+ % the mode system currently has several problems (most
% noticeably lack of alias tracking for unique modes)
% which mean inst_matches_initial can sometimes fail
% here.
- ModuleInfo2 = ModuleInfo0,
- Sub2 = Sub0
+ !:ModuleInfo = SaveModuleInfo,
+ !:Sub = SaveSub
)
;
- ModuleInfo2 = ModuleInfo0,
- Sub2 = Sub0
+ true
),
- compute_inst_var_sub(Args, VarTypes, InstMap, Insts, Sub2,
- Sub, ModuleInfo2, ModuleInfo).
+ compute_inst_var_sub(Args, VarTypes, InstMap, Insts, !Sub,
+ !ModuleInfo).
:- pred recompute_instmap_delta_call_2(list(prog_var)::in, instmap::in,
list(mode)::in, list(mode)::out, module_info::in, module_info::out)
is det.
-recompute_instmap_delta_call_2([], _, [], [], ModuleInfo, ModuleInfo).
-recompute_instmap_delta_call_2([_|_], _, [], _, _, _) :-
+recompute_instmap_delta_call_2([], _, [], [], !ModuleInfo).
+recompute_instmap_delta_call_2([_ | _], _, [], _, !ModuleInfo) :-
error("recompute_instmap_delta_call_2").
-recompute_instmap_delta_call_2([], _, [_|_], _, _, _) :-
+recompute_instmap_delta_call_2([], _, [_ | _], _, !ModuleInfo) :-
error("recompute_instmap_delta_call_2").
recompute_instmap_delta_call_2([Arg | Args], InstMap, [Mode0 | Modes0],
- [Mode | Modes], ModuleInfo0, ModuleInfo) :-
+ [Mode | Modes], !ModuleInfo) :-
% This is similar to modecheck_set_var_inst.
( instmap__is_reachable(InstMap) ->
instmap__lookup_var(InstMap, Arg, ArgInst0),
- mode_get_insts(ModuleInfo0, Mode0, _, FinalInst),
+ mode_get_insts(!.ModuleInfo, Mode0, _, FinalInst),
(
abstractly_unify_inst(dead, ArgInst0, FinalInst,
- fake_unify, ModuleInfo0, UnifyInst, _,
- ModuleInfo1)
+ fake_unify, !.ModuleInfo, UnifyInst, _,
+ !:ModuleInfo)
->
- ModuleInfo2 = ModuleInfo1,
Mode = (ArgInst0 -> UnifyInst)
;
- error("recompute_instmap_delta_call_2: unify_inst failed")
+ error("recompute_instmap_delta_call_2: " ++
+ "unify_inst failed")
)
;
- Mode = (not_reached -> not_reached),
- ModuleInfo2 = ModuleInfo0
+ Mode = (not_reached -> not_reached)
),
- recompute_instmap_delta_call_2(Args, InstMap,
- Modes0, Modes, ModuleInfo2, ModuleInfo).
+ recompute_instmap_delta_call_2(Args, InstMap, Modes0, Modes,
+ !ModuleInfo).
:- pred recompute_instmap_delta_unify(unification::in, unify_mode::in,
unify_mode::out, hlds_goal_info::in, instmap::in, instmap_delta::out,
- recompute_info::in, recompute_info::out) is det.
+ recompute_info::in) is det.
recompute_instmap_delta_unify(Uni, UniMode0, UniMode, GoalInfo,
- InstMap, InstMapDelta) -->
+ InstMap, InstMapDelta, RI) :-
% Deconstructions are the only types of unifications
% that can require updating of the instmap_delta after simplify.m
% has been run.
- ModuleInfo =^ module_info,
- {
+ ModuleInfo = RI ^ module_info,
+ (
Uni = deconstruct(Var, _ConsId, Vars, UniModes, _, _CanCGC)
->
% Get the final inst of the deconstructed var, which
@@ -1685,7 +1702,7 @@
;
goal_info_get_instmap_delta(GoalInfo, InstMapDelta),
UniMode = UniMode0
- }.
+ ).
%-----------------------------------------------------------------------------%
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.277
diff -u -b -r1.277 modes.m
--- compiler/modes.m 31 Mar 2004 12:32:28 -0000 1.277
+++ compiler/modes.m 7 Jun 2004 08:49:55 -0000
@@ -1275,20 +1275,24 @@
% to modecheck a pragma_c_code, we just modecheck the proc for
% which it is the goal.
-modecheck_goal_expr(foreign_proc(Attributes, PredId, ProcId0,
- Args0, ArgNameMap, OrigArgTypes, PragmaCode),
- GoalInfo, Goal, !ModeInfo, !IO) :-
+modecheck_goal_expr(foreign_proc(Attributes, PredId, ProcId0, Args0, ExtraArgs,
+ PragmaCode), GoalInfo, Goal, !ModeInfo, !IO) :-
mode_checkpoint(enter, "pragma_foreign_code", !ModeInfo, !IO),
mode_info_get_call_id(!.ModeInfo, PredId, CallId),
mode_info_get_instmap(!.ModeInfo, InstMap0),
DeterminismKnown = no,
mode_info_set_call_context(call(call(CallId)), !ModeInfo),
+ ArgVars0 = list__map(foreign_arg_var, Args0),
modecheck_call_pred(PredId, DeterminismKnown, ProcId0, ProcId,
- Args0, Args, ExtraGoals, !ModeInfo),
+ ArgVars0, ArgVars, ExtraGoals, !ModeInfo),
- Pragma = foreign_proc(Attributes, PredId, ProcId, Args0, ArgNameMap,
- OrigArgTypes, PragmaCode),
- handle_extra_goals(Pragma, ExtraGoals, GoalInfo, Args0, Args,
+ % zs: The assignment to Pragma looks wrong: instead of Args0,
+ % I think we should use Args after the following call:
+ % replace_foreign_arg_vars(Args0, ArgVars, Args)
+ % or is there some reason why Args0 and Args would be the same?
+ Pragma = foreign_proc(Attributes, PredId, ProcId, Args0, ExtraArgs,
+ PragmaCode),
+ handle_extra_goals(Pragma, ExtraGoals, GoalInfo, ArgVars0, ArgVars,
InstMap0, Goal, !ModeInfo, !IO),
mode_info_unset_call_context(!ModeInfo),
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.300
diff -u -b -r1.300 modules.m
--- compiler/modules.m 12 May 2004 14:24:31 -0000 1.300
+++ compiler/modules.m 7 Jun 2004 08:49:55 -0000
@@ -388,34 +388,26 @@
:- pred module_imports_get_source_file_name(module_imports::in, file_name::out)
is det.
-
:- pred module_imports_get_module_name(module_imports::in, module_name::out)
is det.
-
:- pred module_imports_get_impl_deps(module_imports::in,
list(module_name)::out) is det.
-
:- pred module_imports_get_items(module_imports::in, item_list::out) is det.
-
-:- pred module_imports_set_items(module_imports::in, item_list::in,
- module_imports::out) is det.
-
:- pred module_imports_get_error(module_imports::in, module_error::out) is det.
-:- pred module_imports_set_error(module_imports::in, module_error::in,
- module_imports::out) is det.
-
+:- pred module_imports_set_items(item_list::in,
+ module_imports::in, module_imports::out) is det.
+:- pred module_imports_set_error(module_error::in,
+ module_imports::in, module_imports::out) is det.
% set the interface dependencies
-:- pred module_imports_set_int_deps(module_imports::in, list(module_name)::in,
- module_imports::out) is det.
-
+:- pred module_imports_set_int_deps(list(module_name)::in,
+ module_imports::in, module_imports::out) is det.
% set the implementation dependencies
-:- pred module_imports_set_impl_deps(module_imports::in, list(module_name)::in,
- module_imports::out) is det.
-
+:- pred module_imports_set_impl_deps(list(module_name)::in,
+ module_imports::in, module_imports::out) is det.
% set the indirect dependencies
-:- pred module_imports_set_indirect_deps(module_imports::in,
- list(module_name)::in, module_imports::out) is det.
+:- pred module_imports_set_indirect_deps(list(module_name)::in,
+ module_imports::in, module_imports::out) is det.
% make an item_and_context for a module declaration
% or pseudo-declaration such as `:- imported'
@@ -2070,7 +2062,7 @@
[[make_pseudo_decl(interface) | InterfaceItems],
[make_pseudo_decl(private_interface) | ImplDecls],
[make_pseudo_decl(implementation) | Clauses]], Items1),
- module_imports_set_items(!.Module, Items1, !:Module)
+ module_imports_set_items(Items1, !Module)
),
% Add `builtin' and `private_builtin' to the
@@ -2296,13 +2288,13 @@
module_imports_get_module_name(Module, Module ^ module_name).
module_imports_get_impl_deps(Module, Module ^ impl_deps).
module_imports_get_items(Module, Module ^ items).
-module_imports_set_items(Module, Items, Module ^ items := Items).
module_imports_get_error(Module, Module ^ error).
-module_imports_set_error(Module, Error, Module ^ error := Error).
-module_imports_set_int_deps(Module, IntDeps, Module ^ int_deps := IntDeps).
-module_imports_set_impl_deps(Module, ImplDeps,
+module_imports_set_items(Items, Module, Module ^ items := Items).
+module_imports_set_error(Error, Module, Module ^ error := Error).
+module_imports_set_int_deps(IntDeps, Module, Module ^ int_deps := IntDeps).
+module_imports_set_impl_deps(ImplDeps, Module,
Module ^ impl_deps := ImplDeps).
-module_imports_set_indirect_deps(Module, IndirectDeps,
+module_imports_set_indirect_deps(IndirectDeps, Module,
Module ^ indirect_deps := IndirectDeps).
append_pseudo_decl(PseudoDecl, Module0, Module) :-
@@ -3822,10 +3814,9 @@
!:Module = !.Module ^ foreign_import_module_info
:= ForeignImports,
- module_imports_set_int_deps(!.Module, IntDeps, !:Module),
- module_imports_set_impl_deps(!.Module, ImplDeps, !:Module),
- module_imports_set_indirect_deps(!.Module, IndirectDeps,
- !:Module),
+ module_imports_set_int_deps(IntDeps, !Module),
+ module_imports_set_impl_deps(ImplDeps, !Module),
+ module_imports_set_indirect_deps(IndirectDeps, !Module),
%
% Compute the trans-opt dependencies for this module.
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/opt_debug.m,v
retrieving revision 1.141
diff -u -b -r1.141 opt_debug.m
--- compiler/opt_debug.m 23 May 2004 23:14:31 -0000 1.141
+++ compiler/opt_debug.m 7 Jun 2004 08:49:55 -0000
@@ -838,7 +838,7 @@
opt_debug__dump_label(Label, LabelStr),
string__append_list(["join(", LvalStr, ", ", LabelStr, ")"], Str).
% XXX should probably give more info than this
-opt_debug__dump_instr(pragma_c(_, Comps, _, _, _, _, _, _), Str) :-
+opt_debug__dump_instr(pragma_c(_, Comps, _, _, _, _, _, _, _), Str) :-
opt_debug__dump_components(Comps, C_str),
string__append_list(["pragma_c(", C_str, ")"], Str).
Index: compiler/opt_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/opt_util.m,v
retrieving revision 1.124
diff -u -b -r1.124 opt_util.m
--- compiler/opt_util.m 23 May 2004 23:14:32 -0000 1.124
+++ compiler/opt_util.m 7 Jun 2004 08:49:55 -0000
@@ -899,7 +899,7 @@
Uinstr0 = decr_sp(_),
Need = no
;
- Uinstr0 = pragma_c(_, _, _, _, _, _, _, _),
+ Uinstr0 = pragma_c(_, _, _, _, _, _, _, _, _),
Need = no
;
Uinstr0 = init_sync_term(Lval, _),
@@ -1014,7 +1014,7 @@
opt_util__can_instr_branch_away(fork(_, _, _), yes).
opt_util__can_instr_branch_away(join_and_terminate(_), no).
opt_util__can_instr_branch_away(join_and_continue(_, _), yes).
-opt_util__can_instr_branch_away(pragma_c(_, Comps, _, _, _, _, _, _),
+opt_util__can_instr_branch_away(pragma_c(_, Comps, _, _, _, _, _, _, _),
BranchAway) :-
opt_util__can_components_branch_away(Comps, BranchAway).
@@ -1082,7 +1082,7 @@
opt_util__can_instr_fall_through(fork(_, _, _), no).
opt_util__can_instr_fall_through(join_and_terminate(_), no).
opt_util__can_instr_fall_through(join_and_continue(_, _), no).
-opt_util__can_instr_fall_through(pragma_c(_, _, _, _, _, _, _, _), yes).
+opt_util__can_instr_fall_through(pragma_c(_, _, _, _, _, _, _, _, _), yes).
% Check whether an instruction sequence can possibly fall through
% to the next instruction without using its label.
@@ -1128,7 +1128,7 @@
opt_util__can_use_livevals(fork(_, _, _), no).
opt_util__can_use_livevals(join_and_terminate(_), no).
opt_util__can_use_livevals(join_and_continue(_, _), no).
-opt_util__can_use_livevals(pragma_c(_, _, _, _, _, _, _, _), no).
+opt_util__can_use_livevals(pragma_c(_, _, _, _, _, _, _, _, _), no).
% determine all the labels and code_addresses that are referenced by Instr
@@ -1193,7 +1193,7 @@
opt_util__instr_labels_2(join_and_terminate(_), [], []).
opt_util__instr_labels_2(join_and_continue(_, Label), [Label], []).
opt_util__instr_labels_2(pragma_c(_, _, _, MaybeFixLabel, MaybeLayoutLabel,
- MaybeOnlyLayoutLabel, MaybeSubLabel, _), Labels, []) :-
+ MaybeOnlyLayoutLabel, MaybeSubLabel, _, _), Labels, []) :-
opt_util__pragma_c_labels(MaybeFixLabel, MaybeLayoutLabel,
MaybeOnlyLayoutLabel, MaybeSubLabel, Labels).
@@ -1241,7 +1241,7 @@
opt_util__possible_targets(join_and_terminate(_), []).
opt_util__possible_targets(join_and_continue(_, L), [L]).
opt_util__possible_targets(pragma_c(_, _, _, MaybeFixedLabel, MaybeLayoutLabel,
- _, MaybeSubLabel, _), Labels) :-
+ _, MaybeSubLabel, _, _), Labels) :-
opt_util__pragma_c_labels(MaybeFixedLabel, MaybeLayoutLabel,
no, MaybeSubLabel, Labels).
@@ -1305,7 +1305,7 @@
opt_util__instr_rvals_and_lvals(fork(_, _, _), [], []).
opt_util__instr_rvals_and_lvals(join_and_terminate(Lval), [], [Lval]).
opt_util__instr_rvals_and_lvals(join_and_continue(Lval, _), [], [Lval]).
-opt_util__instr_rvals_and_lvals(pragma_c(_, Cs, _, _, _, _, _, _),
+opt_util__instr_rvals_and_lvals(pragma_c(_, Cs, _, _, _, _, _, _, _),
Rvals, Lvals) :-
pragma_c_components_get_rvals_and_lvals(Cs, Rvals, Lvals).
@@ -1400,76 +1400,73 @@
opt_util__livevals_addr(do_call_class_method, yes).
opt_util__livevals_addr(do_not_reached, no).
-opt_util__count_temps_instr_list([], R, R, F, F).
-opt_util__count_temps_instr_list([Uinstr - _Comment | Instrs], R0, R, F0, F) :-
- opt_util__count_temps_instr(Uinstr, R0, R1, F0, F1),
- opt_util__count_temps_instr_list(Instrs, R1, R, F1, F).
-
-opt_util__count_temps_instr(comment(_), R, R, F, F).
-opt_util__count_temps_instr(livevals(_), R, R, F, F).
-opt_util__count_temps_instr(block(_, _, _), R, R, F, F).
-opt_util__count_temps_instr(assign(Lval, Rval), R0, R, F0, F) :-
- opt_util__count_temps_lval(Lval, R0, R1, F0, F1),
- opt_util__count_temps_rval(Rval, R1, R, F1, F).
-opt_util__count_temps_instr(call(_, _, _, _, _, _), R, R, F, F).
-opt_util__count_temps_instr(mkframe(_, _), R, R, F, F).
-opt_util__count_temps_instr(label(_), R, R, F, F).
-opt_util__count_temps_instr(goto(_), R, R, F, F).
-opt_util__count_temps_instr(computed_goto(Rval, _), R0, R, F0, F) :-
- opt_util__count_temps_rval(Rval, R0, R, F0, F).
-opt_util__count_temps_instr(if_val(Rval, _), R0, R, F0, F) :-
- opt_util__count_temps_rval(Rval, R0, R, F0, F).
-opt_util__count_temps_instr(c_code(_, _), R, R, F, F).
-opt_util__count_temps_instr(incr_hp(Lval, _, _, Rval, _), R0, R, F0, F) :-
- opt_util__count_temps_lval(Lval, R0, R1, F0, F1),
- opt_util__count_temps_rval(Rval, R1, R, F1, F).
-opt_util__count_temps_instr(mark_hp(Lval), R0, R, F0, F) :-
- opt_util__count_temps_lval(Lval, R0, R, F0, F).
-opt_util__count_temps_instr(restore_hp(Rval), R0, R, F0, F) :-
- opt_util__count_temps_rval(Rval, R0, R, F0, F).
-opt_util__count_temps_instr(free_heap(Rval), R0, R, F0, F) :-
- opt_util__count_temps_rval(Rval, R0, R, F0, F).
-opt_util__count_temps_instr(store_ticket(Lval), R0, R, F0, F) :-
- opt_util__count_temps_lval(Lval, R0, R, F0, F).
-opt_util__count_temps_instr(reset_ticket(Rval, _Reason), R0, R, F0, F) :-
- opt_util__count_temps_rval(Rval, R0, R, F0, F).
-opt_util__count_temps_instr(discard_ticket, R, R, F, F).
-opt_util__count_temps_instr(prune_ticket, R, R, F, F).
-opt_util__count_temps_instr(mark_ticket_stack(Lval), R0, R, F0, F) :-
- opt_util__count_temps_lval(Lval, R0, R, F0, F).
-opt_util__count_temps_instr(prune_tickets_to(Rval), R0, R, F0, F) :-
- opt_util__count_temps_rval(Rval, R0, R, F0, F).
-opt_util__count_temps_instr(incr_sp(_, _), R, R, F, F).
-opt_util__count_temps_instr(decr_sp(_), R, R, F, F).
-opt_util__count_temps_instr(init_sync_term(Lval, _), R0, R, F0, F) :-
- opt_util__count_temps_lval(Lval, R0, R, F0, F).
-opt_util__count_temps_instr(fork(_, _, _), R, R, F, F).
-opt_util__count_temps_instr(join_and_terminate(Lval), R0, R, F0, F) :-
- opt_util__count_temps_lval(Lval, R0, R, F0, F).
-opt_util__count_temps_instr(join_and_continue(Lval, _), R0, R, F0, F) :-
- opt_util__count_temps_lval(Lval, R0, R, F0, F).
-opt_util__count_temps_instr(pragma_c(_, _, _, _, _, _, _, _), R, R, F, F).
+opt_util__count_temps_instr_list([], !R, !F).
+opt_util__count_temps_instr_list([Uinstr - _Comment | Instrs], !R, !F) :-
+ opt_util__count_temps_instr(Uinstr, !R, !F),
+ opt_util__count_temps_instr_list(Instrs, !R, !F).
+
+opt_util__count_temps_instr(comment(_), !R, !F).
+opt_util__count_temps_instr(livevals(_), !R, !F).
+opt_util__count_temps_instr(block(_, _, _), !R, !F).
+opt_util__count_temps_instr(assign(Lval, Rval), !R, !F) :-
+ opt_util__count_temps_lval(Lval, !R, !F),
+ opt_util__count_temps_rval(Rval, !R, !F).
+opt_util__count_temps_instr(call(_, _, _, _, _, _), !R, !F).
+opt_util__count_temps_instr(mkframe(_, _), !R, !F).
+opt_util__count_temps_instr(label(_), !R, !F).
+opt_util__count_temps_instr(goto(_), !R, !F).
+opt_util__count_temps_instr(computed_goto(Rval, _), !R, !F) :-
+ opt_util__count_temps_rval(Rval, !R, !F).
+opt_util__count_temps_instr(if_val(Rval, _), !R, !F) :-
+ opt_util__count_temps_rval(Rval, !R, !F).
+opt_util__count_temps_instr(c_code(_, _), !R, !F).
+opt_util__count_temps_instr(incr_hp(Lval, _, _, Rval, _), !R, !F) :-
+ opt_util__count_temps_lval(Lval, !R, !F),
+ opt_util__count_temps_rval(Rval, !R, !F).
+opt_util__count_temps_instr(mark_hp(Lval), !R, !F) :-
+ opt_util__count_temps_lval(Lval, !R, !F).
+opt_util__count_temps_instr(restore_hp(Rval), !R, !F) :-
+ opt_util__count_temps_rval(Rval, !R, !F).
+opt_util__count_temps_instr(free_heap(Rval), !R, !F) :-
+ opt_util__count_temps_rval(Rval, !R, !F).
+opt_util__count_temps_instr(store_ticket(Lval), !R, !F) :-
+ opt_util__count_temps_lval(Lval, !R, !F).
+opt_util__count_temps_instr(reset_ticket(Rval, _Reason), !R, !F) :-
+ opt_util__count_temps_rval(Rval, !R, !F).
+opt_util__count_temps_instr(discard_ticket, !R, !F).
+opt_util__count_temps_instr(prune_ticket, !R, !F).
+opt_util__count_temps_instr(mark_ticket_stack(Lval), !R, !F) :-
+ opt_util__count_temps_lval(Lval, !R, !F).
+opt_util__count_temps_instr(prune_tickets_to(Rval), !R, !F) :-
+ opt_util__count_temps_rval(Rval, !R, !F).
+opt_util__count_temps_instr(incr_sp(_, _), !R, !F).
+opt_util__count_temps_instr(decr_sp(_), !R, !F).
+opt_util__count_temps_instr(init_sync_term(Lval, _), !R, !F) :-
+ opt_util__count_temps_lval(Lval, !R, !F).
+opt_util__count_temps_instr(fork(_, _, _), !R, !F).
+opt_util__count_temps_instr(join_and_terminate(Lval), !R, !F) :-
+ opt_util__count_temps_lval(Lval, !R, !F).
+opt_util__count_temps_instr(join_and_continue(Lval, _), !R, !F) :-
+ opt_util__count_temps_lval(Lval, !R, !F).
+opt_util__count_temps_instr(pragma_c(_, _, _, _, _, _, _, _, _), !R, !F).
:- pred opt_util__count_temps_lval(lval, int, int, int, int).
:- mode opt_util__count_temps_lval(in, in, out, in, out) is det.
-opt_util__count_temps_lval(Lval, R0, R, F0, F) :-
+opt_util__count_temps_lval(Lval, !R, !F) :-
( Lval = temp(Type, N) ->
(
Type = r,
- int__max(R0, N, R),
- F = F0
+ int__max(N, !R)
;
Type = f,
- int__max(F0, N, F),
- R = R0
+ int__max(N, !F)
)
; Lval = field(_, Rval, FieldNum) ->
- opt_util__count_temps_rval(Rval, R0, R1, F0, F1),
- opt_util__count_temps_rval(FieldNum, R1, R, F1, F)
+ opt_util__count_temps_rval(Rval, !R, !F),
+ opt_util__count_temps_rval(FieldNum, !R, !F)
;
- R = R0,
- F = F0
+ true
).
:- pred opt_util__count_temps_rval(rval, int, int, int, int).
@@ -1477,7 +1474,7 @@
% XXX assume that we don't generate code
% that uses a temp var without defining it.
-opt_util__count_temps_rval(_, R, R, F, F).
+opt_util__count_temps_rval(_, !R, !F).
opt_util__format_label(internal(_, ProcLabel), Str) :-
opt_util__format_proclabel(ProcLabel, Str).
@@ -1553,7 +1550,7 @@
opt_util__touches_nondet_ctrl_lval(Lval, Touch)
; Uinstr = restore_hp(Rval) ->
opt_util__touches_nondet_ctrl_rval(Rval, Touch)
- ; Uinstr = pragma_c(_, Components, _, _, _, _, _, _) ->
+ ; Uinstr = pragma_c(_, Components, _, _, _, _, _, _, _) ->
opt_util__touches_nondet_ctrl_components(Components, Touch)
;
Touch = yes
@@ -1906,9 +1903,9 @@
opt_util__replace_labels_label(Label0, Replmap, Label),
opt_util__replace_labels_lval(Lval0, Replmap, Lval).
opt_util__replace_labels_instr(pragma_c(A, Comps0, C, MaybeFix, MaybeLayout,
- MaybeOnlyLayout, MaybeSub0, F), ReplMap, _,
+ MaybeOnlyLayout, MaybeSub0, H, I), ReplMap, _,
pragma_c(A, Comps, C, MaybeFix, MaybeLayout, MaybeOnlyLayout,
- MaybeSub, F)) :-
+ MaybeSub, H, I)) :-
(
MaybeFix = no
;
Index: compiler/options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.425
diff -u -b -r1.425 options.m
--- compiler/options.m 31 May 2004 04:12:53 -0000 1.425
+++ compiler/options.m 7 Jun 2004 08:49:55 -0000
@@ -156,6 +156,7 @@
; delay_death
; suppress_trace
; stack_trace_higher_order
+ ; tabling_via_extra_args
; generate_bytecode
; line_numbers
; auto_comments
@@ -812,6 +813,7 @@
suppress_trace - string(""),
delay_death - bool(yes),
stack_trace_higher_order - bool(no),
+ tabling_via_extra_args - bool(yes),
generate_bytecode - bool(no),
line_numbers - bool(yes),
auto_comments - bool(no),
@@ -1452,6 +1454,7 @@
long_option("suppress-trace", suppress_trace).
long_option("delay-death", delay_death).
long_option("stack-trace-higher-order", stack_trace_higher_order).
+long_option("tabling-via-extra-args", tabling_via_extra_args).
long_option("generate-bytecode", generate_bytecode).
long_option("line-numbers", line_numbers).
long_option("auto-comments", auto_comments).
@@ -2790,6 +2793,8 @@
"\tEnable stack traces through predicates and functions with",
"\thigher-order arguments, even if stack tracing is not",
"\tsupported in general.",
+% "--tabling-via-extra-args",
+% "\tGenerate output via extra_args in foreign_procs.",
"--generate-bytecode",
"\tOutput a bytecode form of the module for use",
"\tby an experimental debugger.",
Index: compiler/pd_cost.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pd_cost.m,v
retrieving revision 1.18
diff -u -b -r1.18 pd_cost.m
--- compiler/pd_cost.m 21 Dec 2003 05:04:36 -0000 1.18
+++ compiler/pd_cost.m 7 Jun 2004 08:49:55 -0000
@@ -93,7 +93,7 @@
goal_info_get_nonlocals(GoalInfo, NonLocals),
pd_cost__unify(NonLocals, Unification, Cost).
-pd_cost__goal(foreign_proc(Attributes, _, _, Args, _, _, _) - _,
+pd_cost__goal(foreign_proc(Attributes, _, _, Args, _, _) - _,
Cost) :-
( may_call_mercury(Attributes) = will_not_call_mercury ->
Cost1 = 0
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.251
diff -u -b -r1.251 polymorphism.m
--- compiler/polymorphism.m 23 Mar 2004 10:52:10 -0000 1.251
+++ compiler/polymorphism.m 7 Jun 2004 08:49:55 -0000
@@ -998,15 +998,16 @@
polymorphism__process_goal_expr(Goal0, GoalInfo0, Goal, !Info) :-
PredId = Goal0 ^ call_pred_id,
ArgVars0 = Goal0 ^ call_args,
- polymorphism__process_call(PredId, ArgVars0, ArgVars,
- GoalInfo0, GoalInfo, _ExtraVars, ExtraGoals, !Info),
+ polymorphism__process_call(PredId, ArgVars0, GoalInfo0, GoalInfo,
+ ExtraVars, ExtraGoals, !Info),
+ ArgVars = ExtraVars ++ ArgVars0,
CallExpr = Goal0 ^ call_args := ArgVars,
Call = CallExpr - GoalInfo,
list__append(ExtraGoals, [Call], GoalList),
conj_list_to_goal(GoalList, GoalInfo0, Goal).
polymorphism__process_goal_expr(Goal0, GoalInfo0, Goal, !Info) :-
- Goal0 = foreign_proc(_, PredId, _, _, _, _, _),
+ Goal0 = foreign_proc(_, PredId, _, _, _, _),
poly_info_get_module_info(!.Info, ModuleInfo),
module_info_pred_info(ModuleInfo, PredId, PredInfo),
PredModule = pred_info_module(PredInfo),
@@ -1066,13 +1067,14 @@
% onto a string of variables.
% It places an & at the start of the variable name if the variable
% is an output variable.
-:- func type_info_vars(module_info, list(maybe(pair(string, mode))),
- string) = string.
+:- func type_info_vars(module_info, list(foreign_arg), string) = string.
type_info_vars(_ModuleInfo, [], InitString) = InitString.
-type_info_vars(ModuleInfo, [ArgInfo | ArgInfos], InitString) = String :-
- String0 = type_info_vars(ModuleInfo, ArgInfos, InitString),
- ( ArgInfo = yes(ArgName0 - Mode) ->
+type_info_vars(ModuleInfo, [Arg | Args], InitString) = String :-
+ String0 = type_info_vars(ModuleInfo, Args, InitString),
+ Arg = foreign_arg(_, MaybeNameMode, _),
+ (
+ MaybeNameMode = yes(ArgName0 - Mode),
( mode_is_output(ModuleInfo, Mode) ->
string__append("&", ArgName0, ArgName)
;
@@ -1084,6 +1086,7 @@
String = string__append_list([ArgName, ", ", String0])
)
;
+ MaybeNameMode = no,
String = String0
).
@@ -1521,7 +1524,7 @@
:- pred polymorphism__process_foreign_proc(module_info::in, pred_info::in,
hlds_goal_expr::in(bound(foreign_proc(ground,ground,ground,ground,
- ground,ground,ground))), hlds_goal_info::in, hlds_goal::out,
+ ground,ground))), hlds_goal_info::in, hlds_goal::out,
poly_info::in, poly_info::out) is det.
polymorphism__process_foreign_proc(ModuleInfo, PredInfo, Goal0, GoalInfo0,
@@ -1531,26 +1534,21 @@
% so that the foreign_proc can refer to the type_info variable
% for type T as `TypeInfo_for_T'.
%
- Goal0 = foreign_proc(Attributes, PredId, ProcId,
- ArgVars0, ArgInfo0, OrigArgTypes0, PragmaCode0),
- polymorphism__process_call(PredId, ArgVars0, ArgVars,
- GoalInfo0, GoalInfo, ExtraVars, ExtraGoals, !Info),
- list__length(ExtraVars, NumExtraVars),
- polymorphism__process_foreign_proc_args(PredInfo, NumExtraVars,
- PragmaCode0, OrigArgTypes0, OrigArgTypes,
- ArgInfo0, ArgInfo),
+ Goal0 = foreign_proc(Attributes, PredId, ProcId, Args0,
+ ProcExtraArgs, PragmaCode0),
+ ArgVars0 = list__map(foreign_arg_var, Args0),
+ polymorphism__process_call(PredId, ArgVars0, GoalInfo0, GoalInfo,
+ ExtraVars, ExtraGoals, !Info),
+ polymorphism__process_foreign_proc_args(PredInfo, PragmaCode0,
+ ExtraVars, ExtraArgs),
+ Args = ExtraArgs ++ Args0,
%
% Add the type info arguments to the list of variables
% to call for a pragma import.
%
( PragmaCode0 = import(Name, HandleReturn, Variables0, MaybeContext) ->
- ( list__remove_suffix(ArgInfo, ArgInfo0, TypeVarArgInfos) ->
- Variables = type_info_vars(ModuleInfo,
- TypeVarArgInfos, Variables0)
- ;
- error("polymorphism__process_goal_expr")
- ),
+ Variables = type_info_vars(ModuleInfo, ExtraArgs, Variables0),
PragmaCode = import(Name, HandleReturn,
Variables, MaybeContext)
;
@@ -1560,19 +1558,17 @@
%
% plug it all back together
%
- CallExpr = foreign_proc(Attributes, PredId, ProcId, ArgVars,
- ArgInfo, OrigArgTypes, PragmaCode),
+ CallExpr = foreign_proc(Attributes, PredId, ProcId, Args,
+ ProcExtraArgs, PragmaCode),
Call = CallExpr - GoalInfo,
list__append(ExtraGoals, [Call], GoalList),
conj_list_to_goal(GoalList, GoalInfo0, Goal).
-:- pred polymorphism__process_foreign_proc_args(pred_info::in, int::in,
- pragma_foreign_code_impl::in, list(type)::in, list(type)::out,
- list(maybe(pair(string, mode)))::in,
- list(maybe(pair(string, mode)))::out) is det.
+:- pred polymorphism__process_foreign_proc_args(pred_info::in,
+ pragma_foreign_code_impl::in, list(prog_var)::in,
+ list(foreign_arg)::out) is det.
-polymorphism__process_foreign_proc_args(PredInfo, NumExtraVars, Impl,
- OrigArgTypes0, OrigArgTypes, ArgInfo0, ArgInfo) :-
+polymorphism__process_foreign_proc_args(PredInfo, Impl, Vars, Args) :-
pred_info_arg_types(PredInfo, PredTypeVarSet, ExistQVars,
PredArgTypes),
@@ -1589,30 +1585,32 @@
list__delete_elems(PredTypeVars1, UnivConstrainedVars, PredTypeVars2),
list__delete_elems(PredTypeVars2, ExistConstrainedVars, PredTypeVars),
- % sanity check
- list__length(UnivCs, NUCs),
- list__length(ExistCs, NECs),
- NCs = NUCs + NECs,
- list__length(PredTypeVars, NTs),
- NEVs = NCs + NTs,
- require(unify(NEVs, NumExtraVars),
- "list length mismatch in polymorphism processing pragma_c"),
-
% The argument order is as follows:
% first the UnivTypeInfos (for universally quantified type variables)
% then the ExistTypeInfos (for existentially quantified type variables)
% then the UnivTypeClassInfos (for universally quantified constraints)
% then the ExistTypeClassInfos (for existentially quantified constraints)
% and finally the original arguments of the predicate.
-%
-% But since we're building ArgInfo by starting with the original
-% arguments and prepending things as we go, we need to do it in
-% reverse order.
-
- polymorphism__foreign_proc_add_typeclass_infos(UnivCs, ExistCs,
- PredTypeVarSet, Impl, ArgInfo0, ArgInfo1),
- polymorphism__foreign_proc_add_typeinfos( PredTypeVars, PredTypeVarSet,
- ExistQVars, Impl, ArgInfo1, ArgInfo),
+
+ in_mode(In),
+ out_mode(Out),
+
+ list__map(polymorphism__foreign_proc_add_typeclass_info(Out, Impl,
+ PredTypeVarSet), ExistCs, ExistTypeClassArgInfos),
+ list__map(polymorphism__foreign_proc_add_typeclass_info(In, Impl,
+ PredTypeVarSet), UnivCs, UnivTypeClassArgInfos),
+ TypeClassArgInfos = UnivTypeClassArgInfos ++ ExistTypeClassArgInfos,
+
+ list__filter((pred(X::in) is semidet :- list__member(X, ExistQVars)),
+ PredTypeVars, ExistUnconstrainedVars, UnivUnconstrainedVars),
+
+ list__map(polymorphism__foreign_proc_add_typeinfo(Out, Impl,
+ PredTypeVarSet), ExistUnconstrainedVars, ExistTypeArgInfos),
+ list__map(polymorphism__foreign_proc_add_typeinfo(In, Impl,
+ PredTypeVarSet), UnivUnconstrainedVars, UnivTypeArgInfos),
+ TypeInfoArgInfos = UnivTypeArgInfos ++ ExistTypeArgInfos,
+
+ ArgInfos = TypeInfoArgInfos ++ TypeClassArgInfos,
%
% insert type_info/typeclass_info types for all the inserted
@@ -1623,36 +1621,16 @@
TypeInfoTypes),
list__map(polymorphism__build_typeclass_info_type, UnivCs, UnivTypes),
list__map(polymorphism__build_typeclass_info_type, ExistCs, ExistTypes),
- list__append(ExistTypes, OrigArgTypes0, OrigArgTypes1),
- list__append(UnivTypes, OrigArgTypes1, OrigArgTypes2),
- list__append(TypeInfoTypes, OrigArgTypes2, OrigArgTypes).
+ OrigArgTypes = TypeInfoTypes ++ UnivTypes ++ ExistTypes,
-:- pred polymorphism__foreign_proc_add_typeclass_infos(
- list(class_constraint)::in, list(class_constraint)::in,
- tvarset::in, pragma_foreign_code_impl::in,
- list(maybe(pair(string, mode)))::in,
- list(maybe(pair(string, mode)))::out) is det.
+ make_foreign_args(Vars, ArgInfos, OrigArgTypes, Args).
-polymorphism__foreign_proc_add_typeclass_infos(UnivCs, ExistCs,
- PredTypeVarSet, Impl, ArgInfo0, ArgInfo) :-
- in_mode(In),
- out_mode(Out),
- polymorphism__foreign_proc_add_typeclass_infos_2(ExistCs, Out,
- PredTypeVarSet, Impl, ArgInfo0, ArgInfo1),
- polymorphism__foreign_proc_add_typeclass_infos_2(UnivCs, In,
- PredTypeVarSet, Impl, ArgInfo1, ArgInfo).
-
-:- pred polymorphism__foreign_proc_add_typeclass_infos_2(
- list(class_constraint)::in, (mode)::in, tvarset::in,
- pragma_foreign_code_impl::in,
- list(maybe(pair(string, mode)))::in,
- list(maybe(pair(string, mode)))::out) is det.
-
-polymorphism__foreign_proc_add_typeclass_infos_2([], _, _, _, !ArgNames).
-polymorphism__foreign_proc_add_typeclass_infos_2([Constraint | Constraints],
- Mode, TypeVarSet, Impl, !ArgNames) :-
- polymorphism__foreign_proc_add_typeclass_infos_2(Constraints,
- Mode, TypeVarSet, Impl, !ArgNames),
+:- pred polymorphism__foreign_proc_add_typeclass_info((mode)::in,
+ pragma_foreign_code_impl::in, tvarset::in, class_constraint::in,
+ maybe(pair(string, mode))::out) is det.
+
+polymorphism__foreign_proc_add_typeclass_info(Mode, Impl, TypeVarSet,
+ Constraint, MaybeArgName) :-
Constraint = constraint(Name0, Types),
prog_out__sym_name_to_string(Name0, "__", Name),
term__vars_list(Types, TypeVars),
@@ -1660,61 +1638,35 @@
list__map(underscore_and_tvar_name(TypeVarSet), TypeVars),
string__append_list(["TypeClassInfo_for_", Name | TypeVarNames],
ConstraintVarName),
- (
% If the variable name corresponding to the
% typeclass-info isn't mentioned in the C code
% fragment, don't pass the variable to the
% C code at all.
-
- foreign_code_does_not_use_variable(Impl, ConstraintVarName)
- ->
- !:ArgNames = [no | !.ArgNames]
+ ( foreign_code_does_not_use_variable(Impl, ConstraintVarName) ->
+ MaybeArgName = no
;
- !:ArgNames = [yes(ConstraintVarName - Mode) | !.ArgNames]
+ MaybeArgName = yes(ConstraintVarName - Mode)
).
-:- pred polymorphism__foreign_proc_add_typeinfos(list(tvar)::in, tvarset::in,
- existq_tvars::in, pragma_foreign_code_impl::in,
- list(maybe(pair(string, mode)))::in,
- list(maybe(pair(string, mode)))::out) is det.
+:- pred polymorphism__foreign_proc_add_typeinfo((mode)::in,
+ pragma_foreign_code_impl::in, tvarset::in, tvar::in,
+ maybe(pair(string, mode))::out) is det.
-polymorphism__foreign_proc_add_typeinfos(TVars, TypeVarSet,
- ExistQVars, Impl, ArgNames0, ArgNames) :-
- list__filter((pred(X::in) is semidet :- list__member(X, ExistQVars)),
- TVars, ExistUnconstrainedVars, UnivUnconstrainedVars),
- in_mode(In),
- out_mode(Out),
- polymorphism__foreign_proc_add_typeinfos_2(ExistUnconstrainedVars,
- TypeVarSet, Out, Impl, ArgNames0, ArgNames1),
- polymorphism__foreign_proc_add_typeinfos_2(UnivUnconstrainedVars,
- TypeVarSet, In, Impl, ArgNames1, ArgNames).
-
-:- pred polymorphism__foreign_proc_add_typeinfos_2(list(tvar)::in, tvarset::in,
- (mode)::in, pragma_foreign_code_impl::in,
- list(maybe(pair(string, mode)))::in,
- list(maybe(pair(string, mode)))::out) is det.
-
-polymorphism__foreign_proc_add_typeinfos_2([], _, _, _, !ArgNames).
-polymorphism__foreign_proc_add_typeinfos_2([TVar | TVars], TypeVarSet, Mode,
- Impl, !ArgNames) :-
- polymorphism__foreign_proc_add_typeinfos_2(TVars, TypeVarSet, Mode,
- Impl, !ArgNames),
+polymorphism__foreign_proc_add_typeinfo(Mode, Impl, TypeVarSet, TVar,
+ MaybeArgName) :-
( varset__search_name(TypeVarSet, TVar, TypeVarName) ->
string__append("TypeInfo_for_", TypeVarName, C_VarName),
- (
% If the variable name corresponding to the
% type-info isn't mentioned in the C code
% fragment, don't pass the variable to the
% C code at all.
-
- foreign_code_does_not_use_variable(Impl, C_VarName)
- ->
- !:ArgNames = [no | !.ArgNames]
+ ( foreign_code_does_not_use_variable(Impl, C_VarName) ->
+ MaybeArgName = no
;
- !:ArgNames = [yes(C_VarName - Mode) | !.ArgNames]
+ MaybeArgName = yes(C_VarName - Mode)
)
;
- !:ArgNames = [no | !.ArgNames]
+ MaybeArgName = no
).
:- pred foreign_code_does_not_use_variable(pragma_foreign_code_impl::in,
@@ -1766,13 +1718,12 @@
% existential/universal type_infos and type_class_infos
% in a more consistent manner.
-:- pred polymorphism__process_call(pred_id::in,
- list(prog_var)::in, list(prog_var)::out,
+:- pred polymorphism__process_call(pred_id::in, list(prog_var)::in,
hlds_goal_info::in, hlds_goal_info::out,
list(prog_var)::out, list(hlds_goal)::out,
poly_info::in, poly_info::out) is det.
-polymorphism__process_call(PredId, ArgVars0, ArgVars, GoalInfo0, GoalInfo,
+polymorphism__process_call(PredId, ArgVars0, GoalInfo0, GoalInfo,
ExtraVars, ExtraGoals, !Info) :-
poly_info_get_var_types(!.Info, VarTypes),
poly_info_get_typevarset(!.Info, TypeVarSet0),
@@ -1834,7 +1785,6 @@
hlds_pred__pred_info_is_aditi_aggregate(PredInfo)
)
->
- ArgVars = ArgVars0,
GoalInfo = GoalInfo0,
ExtraGoals = [],
ExtraVars = []
@@ -1900,11 +1850,9 @@
polymorphism__make_type_info_vars(ActualTypes, Context,
ExtraTypeInfoVars, ExtraTypeInfoGoals, !Info),
- list__append(ExtraTypeClassVars, ArgVars0, ArgVars1),
- list__append(ExtraTypeInfoVars, ArgVars1, ArgVars),
ExtraGoals = ExtraTypeClassGoals ++ ExtraExistClassGoals
++ ExtraTypeInfoGoals,
- ExtraVars = ExtraTypeClassVars ++ ExtraTypeInfoVars,
+ ExtraVars = ExtraTypeInfoVars ++ ExtraTypeClassVars,
%
% update the non-locals
@@ -2294,8 +2242,8 @@
% extra type_info arguments even though its declaration
% is polymorphic.
goal_util__generate_simple_call(mercury_private_builtin_module,
- "superclass_from_typeclass_info", predicate,
- [SubClassVar, IndexVar, Var], only_mode, det, no,
+ "superclass_from_typeclass_info", predicate, only_mode, det,
+ [SubClassVar, IndexVar, Var], no,
[], ModuleInfo, term__context_init, SuperClassGoal),
!:ExtraGoals = [SuperClassGoal, IndexGoal | !.ExtraGoals].
@@ -2946,8 +2894,8 @@
polymorphism__new_type_info_var_raw(term__variable(TypeVar), type_info,
TypeInfoVar, !VarSet, !VarTypes),
goal_util__generate_simple_call(mercury_private_builtin_module,
- "type_info_from_typeclass_info", predicate,
- [TypeClassInfoVar, IndexVar, TypeInfoVar], only_mode, det, no,
+ "type_info_from_typeclass_info", predicate, only_mode, det,
+ [TypeClassInfoVar, IndexVar, TypeInfoVar], no,
[TypeInfoVar - ground(shared, none)], ModuleInfo,
term__context_init, CallGoal),
Goals = [IndexGoal, CallGoal].
Index: compiler/pragma_c_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pragma_c_gen.m,v
retrieving revision 1.68
diff -u -b -r1.68 pragma_c_gen.m
--- compiler/pragma_c_gen.m 12 May 2004 14:24:33 -0000 1.68
+++ compiler/pragma_c_gen.m 7 Jun 2004 08:49:55 -0000
@@ -28,12 +28,12 @@
:- import_module ll_backend__llds.
:- import_module parse_tree__prog_data.
-:- import_module list, std_util.
+:- import_module list.
:- pred pragma_c_gen__generate_pragma_c_code(code_model::in,
pragma_foreign_proc_attributes::in, pred_id::in, proc_id::in,
- list(prog_var)::in, list(maybe(pair(string, mode)))::in, list(type)::in,
- hlds_goal_info::in, pragma_foreign_code_impl::in, code_tree::out,
+ list(foreign_arg)::in, list(foreign_arg)::in, hlds_goal_info::in,
+ pragma_foreign_code_impl::in, code_tree::out,
code_info::in, code_info::out) is det.
:- pred pragma_c_gen__struct_name(module_name::in, string::in, int::in,
@@ -46,6 +46,7 @@
:- import_module backend_libs__c_util.
:- import_module backend_libs__foreign.
:- import_module backend_libs__name_mangle.
+:- import_module check_hlds__mode_util.
:- import_module check_hlds__type_util.
:- import_module hlds__hlds_data.
:- import_module hlds__hlds_llds.
@@ -60,7 +61,8 @@
:- import_module ll_backend__trace.
:- import_module parse_tree__error_util.
-:- import_module bool, string, int, assoc_list, set, map, require, term.
+:- import_module bool, string, int, assoc_list, set, map.
+:- import_module std_util, require, term.
% The code we generate for an ordinary (model_det or model_semi) pragma_c_code
% must be able to fit into the middle of a procedure, since such
@@ -325,44 +327,44 @@
% pragma c_code procedure gets inlined and optimized away.
% Of course we also need to #undef it afterwards.
-pragma_c_gen__generate_pragma_c_code(CodeModel, Attributes,
- PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes, GoalInfo,
- PragmaImpl, Code, !CI) :-
+pragma_c_gen__generate_pragma_c_code(CodeModel, Attributes, PredId, ProcId,
+ Args, ExtraArgs, GoalInfo, PragmaImpl, Code, !CI) :-
(
PragmaImpl = ordinary(C_Code, Context),
pragma_c_gen__ordinary_pragma_c_code(CodeModel, Attributes,
- PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
- C_Code, Context, GoalInfo, Code, !CI)
+ PredId, ProcId, Args, ExtraArgs, C_Code, Context,
+ GoalInfo, Code, !CI)
;
PragmaImpl = nondet(
Fields, FieldsContext, First, FirstContext,
Later, LaterContext, Treat, Shared, SharedContext),
+ require(unify(ExtraArgs, []),
+ "generate_pragma_c_code: extra args nondet"),
pragma_c_gen__nondet_pragma_c_code(CodeModel, Attributes,
- PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
- Fields, FieldsContext, First, FirstContext,
- Later, LaterContext, Treat, Shared, SharedContext,
- Code, !CI)
+ PredId, ProcId, Args, Fields, FieldsContext,
+ First, FirstContext, Later, LaterContext,
+ Treat, Shared, SharedContext, Code, !CI)
;
PragmaImpl = import(Name, HandleReturn, Vars, Context),
+ require(unify(ExtraArgs, []),
+ "generate_pragma_c_code: extra args import"),
C_Code = string__append_list([HandleReturn, " ",
Name, "(", Vars, ");"]),
pragma_c_gen__ordinary_pragma_c_code(CodeModel, Attributes,
- PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
- C_Code, Context, GoalInfo, Code, !CI)
+ PredId, ProcId, Args, ExtraArgs, C_Code, Context,
+ GoalInfo, Code, !CI)
).
%---------------------------------------------------------------------------%
:- pred pragma_c_gen__ordinary_pragma_c_code(code_model::in,
pragma_foreign_proc_attributes::in, pred_id::in, proc_id::in,
- list(prog_var)::in, list(maybe(pair(string, mode)))::in,
- list(type)::in, string::in, maybe(prog_context)::in,
- hlds_goal_info::in, code_tree::out, code_info::in, code_info::out)
- is det.
-
-pragma_c_gen__ordinary_pragma_c_code(CodeModel, Attributes,
- PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
- C_Code, Context, GoalInfo, Code, !CI) :-
+ list(foreign_arg)::in, list(foreign_arg)::in, string::in,
+ maybe(prog_context)::in, hlds_goal_info::in, code_tree::out,
+ code_info::in, code_info::out) is det.
+
+pragma_c_gen__ordinary_pragma_c_code(CodeModel, Attributes, PredId, ProcId,
+ Args, ExtraArgs, C_Code, Context, GoalInfo, Code, !CI) :-
%
% Extract the attributes
@@ -374,13 +376,16 @@
% First we need to get a list of input and output arguments
%
ArgInfos = code_info__get_pred_proc_arginfo(!.CI, PredId, ProcId),
- make_c_arg_list(ArgVars, ArgDatas, OrigArgTypes, ArgInfos, Args),
- pragma_select_in_args(Args, InArgs),
- pragma_select_out_args(Args, OutArgs),
+ make_c_arg_list(Args, ArgInfos, OrigCArgs),
+ code_info__get_module_info(!.CI, ModuleInfo),
+ make_extra_c_arg_list(ExtraArgs, ModuleInfo, ArgInfos, ExtraCArgs),
+ list__append(OrigCArgs, ExtraCArgs, CArgs),
+ pragma_select_in_args(CArgs, InCArgs),
+ pragma_select_out_args(CArgs, OutCArgs),
goal_info_get_post_deaths(GoalInfo, PostDeaths),
set__init(DeadVars0),
- find_dead_input_vars(InArgs, PostDeaths, DeadVars0, DeadVars),
+ find_dead_input_vars(InCArgs, PostDeaths, DeadVars0, DeadVars),
%
% Generate code to <save live variables on stack>
@@ -388,16 +393,16 @@
( MayCallMercury = will_not_call_mercury ->
SaveVarsCode = empty
;
- % the C code might call back Mercury code
- % which clobbers the succip
+ % The C code might call back Mercury code
+ % which clobbers the succip.
code_info__succip_is_used(!CI),
- % the C code might call back Mercury code which clobbers the
+ % The C code might call back Mercury code which clobbers the
% other registers, so we need to save any live variables
- % (other than the output args) onto the stack
- get_c_arg_list_vars(OutArgs, OutArgs1),
- set__list_to_set(OutArgs1, OutArgsSet),
- code_info__save_variables(OutArgsSet, _, SaveVarsCode, !CI)
+ % (other than the output args) onto the stack.
+ get_c_arg_list_vars(OutCArgs, OutVars),
+ set__list_to_set(OutVars, OutVarsSet),
+ code_info__save_variables(OutVarsSet, _, SaveVarsCode, !CI)
),
goal_info_get_determinism(GoalInfo, Detism),
@@ -415,7 +420,7 @@
% (NB we need to be careful that the rvals generated here
% remain valid below.)
%
- get_pragma_input_vars(InArgs, InputDescs, InputVarsCode, !CI),
+ get_pragma_input_vars(InCArgs, InputDescs, InputVarsCode, !CI),
%
% For semidet pragma c_code, we have to move anything that is
@@ -423,7 +428,7 @@
% SUCCESS_INDICATOR without clobbering anything important.
%
% The call to code_info__reserve_r1 will have reserved r1,
- % ensuring that none of InArgs is placed there, and
+ % ensuring that none of InCArgs is placed there, and
% code_info__clear_r1 just releases r1. This reservation of r1
% is not strictly necessary, as we generate assignments from
% the input registers to C variables before we invoke code that could
@@ -453,8 +458,7 @@
%
% Generate <declaration of one local variable for each arg>
%
- code_info__get_module_info(!.CI, ModuleInfo),
- make_pragma_decls(Args, ModuleInfo, Decls),
+ make_pragma_decls(CArgs, ModuleInfo, Decls),
%
% Generate #define MR_PROC_LABEL <procedure label> /* see note (5) */
@@ -530,7 +534,8 @@
RestoreRegsComp = pragma_c_noop
;
RestoreRegsComp = pragma_c_raw_code(
- "#ifndef MR_CONSERVATIVE_GC\n\tMR_restore_registers();\n#endif\n",
+ "#ifndef MR_CONSERVATIVE_GC\n\t" ++
+ "MR_restore_registers();\n#endif\n",
live_lvals_info(set__init)
)
),
@@ -556,8 +561,8 @@
%
% <assignment of the output values from local variables to registers>
%
- pragma_acquire_regs(OutArgs, Regs, !CI),
- place_pragma_output_args_in_regs(OutArgs, Regs, OutputDescs, !CI),
+ pragma_acquire_regs(OutCArgs, Regs, !CI),
+ place_pragma_output_args_in_regs(OutCArgs, Regs, OutputDescs, !CI),
OutputComp = pragma_c_outputs(OutputDescs),
%
@@ -567,9 +572,16 @@
ObtainLock, C_Code_Comp, ReleaseLock,
CheckR1_Comp, RestoreRegsComp,
OutputComp, ProcLabelHashUndef],
+ (
+ ExtraArgs = [],
+ MaybeDupl = yes
+ ;
+ ExtraArgs = [_ | _],
+ MaybeDupl = no
+ ),
PragmaCCode = node([
pragma_c(Decls, Components, MayCallMercury, no, no, no,
- MaybeFailLabel, no)
+ MaybeFailLabel, no, MaybeDupl)
- "Pragma C inclusion"
]),
@@ -644,7 +656,7 @@
:- pred pragma_c_gen__nondet_pragma_c_code(code_model::in,
pragma_foreign_proc_attributes::in, pred_id::in, proc_id::in,
- list(prog_var)::in, list(maybe(pair(string, mode)))::in, list(type)::in,
+ list(foreign_arg)::in,
string::in, maybe(prog_context)::in,
string::in, maybe(prog_context)::in,
string::in, maybe(prog_context)::in, pragma_shared_code_treatment::in,
@@ -652,7 +664,7 @@
code_info::in, code_info::out) is det.
pragma_c_gen__nondet_pragma_c_code(CodeModel, Attributes, PredId, ProcId,
- ArgVars, ArgDatas, OrigArgTypes, _Fields, _FieldsContext,
+ Args, _Fields, _FieldsContext,
First, FirstContext, Later, LaterContext, Treat, Shared,
SharedContext, Code, !CI) :-
require(unify(CodeModel, model_non),
@@ -682,14 +694,14 @@
% Get a list of input and output arguments
%
ArgInfos = code_info__get_pred_proc_arginfo(!.CI, PredId, ProcId),
- make_c_arg_list(ArgVars, ArgDatas, OrigArgTypes, ArgInfos, Args),
- pragma_select_in_args(Args, InArgs),
- pragma_select_out_args(Args, OutArgs),
- make_pragma_decls(Args, ModuleInfo, Decls),
- make_pragma_decls(OutArgs, ModuleInfo, OutDecls),
+ make_c_arg_list(Args, ArgInfos, CArgs),
+ pragma_select_in_args(CArgs, InCArgs),
+ pragma_select_out_args(CArgs, OutCArgs),
+ make_pragma_decls(CArgs, ModuleInfo, Decls),
+ make_pragma_decls(OutCArgs, ModuleInfo, OutDecls),
- input_descs_from_arg_info(!.CI, InArgs, InputDescs),
- output_descs_from_arg_info(!.CI, OutArgs, OutputDescs),
+ input_descs_from_arg_info(!.CI, InCArgs, InputDescs),
+ output_descs_from_arg_info(!.CI, OutCArgs, OutputDescs),
module_info_pred_info(ModuleInfo, PredId, PredInfo),
ModuleName = pred_info_module(PredInfo),
@@ -862,7 +874,7 @@
],
CallBlockCode = node([
pragma_c(CallDecls, CallComponents,
- MayCallMercury, no, no, no, no, yes)
+ MayCallMercury, no, no, no, no, yes, no)
- "Call and shared pragma C inclusion"
]),
@@ -893,7 +905,7 @@
],
RetryBlockCode = node([
pragma_c(RetryDecls, RetryComponents,
- MayCallMercury, no, no, no, no, yes)
+ MayCallMercury, no, no, no, no, yes, no)
- "Retry and shared pragma C inclusion"
]),
@@ -911,9 +923,11 @@
"Start of the shared block"
]),
- SharedDef1 = "#define\tSUCCEED \tgoto MR_shared_success_"
+ SharedDef1 =
+ "#define\tSUCCEED \tgoto MR_shared_success_"
++ ProcLabelString ++ "\n",
- SharedDef2 = "#define\tSUCCEED_LAST\tgoto MR_shared_success_last_"
+ SharedDef2 =
+ "#define\tSUCCEED_LAST\tgoto MR_shared_success_last_"
++ ProcLabelString ++ "\n",
SharedDef3 = "#define\tFAIL\tMR_fail()\n",
@@ -954,7 +968,7 @@
],
CallBlockCode = node([
pragma_c(CallDecls, CallComponents, MayCallMercury,
- yes(SharedLabel), no, no, no, yes)
+ yes(SharedLabel), no, no, no, yes, no)
- "Call pragma C inclusion"
]),
@@ -985,7 +999,7 @@
],
RetryBlockCode = node([
pragma_c(RetryDecls, RetryComponents, MayCallMercury,
- yes(SharedLabel), no, no, no, yes)
+ yes(SharedLabel), no, no, no, yes, no)
- "Retry pragma C inclusion"
]),
@@ -1015,7 +1029,7 @@
],
SharedBlockCode = node([
pragma_c(SharedDecls, SharedComponents,
- MayCallMercury, no, no, no, no, yes)
+ MayCallMercury, no, no, no, no, yes, no)
- "Shared pragma C inclusion"
]),
@@ -1044,37 +1058,73 @@
arg_info
).
-:- pred make_c_arg_list(list(prog_var)::in, list(maybe(pair(string, mode)))::in,
- list(type)::in, list(arg_info)::in, list(c_arg)::out) is det.
+:- pred make_c_arg_list(list(foreign_arg)::in, list(arg_info)::in,
+ list(c_arg)::out) is det.
-make_c_arg_list(Vars, ArgDatas, Types, ArgInfos, ArgList) :-
+make_c_arg_list(Args, ArgInfos, CArgs) :-
(
- Vars = [],
- ArgDatas = [],
- Types = [],
+ Args = [],
ArgInfos = []
->
- ArgList = []
+ CArgs = []
;
- Vars = [V|Vs],
- ArgDatas = [MN|Ns],
- Types = [T|Ts],
- ArgInfos = [A|As]
+ Args = [Arg | ArgTail],
+ ArgInfos = [ArgInfo | ArgInfoTail]
->
+ Arg = foreign_arg(Var, MaybeNameMode, Type),
(
- MN = yes(Name - _),
- N = yes(Name)
+ MaybeNameMode = yes(Name - _),
+ MaybeName = yes(Name)
;
- MN = no,
- N = no
+ MaybeNameMode = no,
+ MaybeName = no
),
- Arg = c_arg(V, N, T, A),
- make_c_arg_list(Vs, Ns, Ts, As, Args),
- ArgList = [Arg | Args]
+ CArg = c_arg(Var, MaybeName, Type, ArgInfo),
+ make_c_arg_list(ArgTail, ArgInfoTail, CArgTail),
+ CArgs = [CArg | CArgTail]
;
- error("pragma_c_gen:make_c_arg_list - length mismatch")
+ error("pragma_c_gen__make_c_arg_list length mismatch")
).
+%---------------------------------------------------------------------------%
+
+:- pred make_extra_c_arg_list(list(foreign_arg)::in, module_info::in,
+ list(arg_info)::in, list(c_arg)::out) is det.
+
+make_extra_c_arg_list(ExtraArgs, ModuleInfo, ArgInfos, ExtraCArgs) :-
+ get_highest_arg_num(ArgInfos, 0, MaxArgNum),
+ make_extra_c_arg_list_seq(ExtraArgs, ModuleInfo, MaxArgNum,
+ ExtraCArgs).
+
+:- pred get_highest_arg_num(list(arg_info)::in, int::in, int::out) is det.
+
+get_highest_arg_num([], !Max).
+get_highest_arg_num([arg_info(Loc, _) | ArgInfos], !Max) :-
+ int__max(Loc, !Max),
+ get_highest_arg_num(ArgInfos, !Max).
+
+:- pred make_extra_c_arg_list_seq(list(foreign_arg)::in, module_info::in,
+ int::in, list(c_arg)::out) is det.
+
+make_extra_c_arg_list_seq([], _, _, []).
+make_extra_c_arg_list_seq([ExtraArg | ExtraArgs], ModuleInfo, LastReg,
+ [CArg | CArgs]) :-
+ ExtraArg = foreign_arg(Var, MaybeNameMode, OrigType),
+ (
+ MaybeNameMode = yes(Name - Mode),
+ mode_to_arg_mode(ModuleInfo, Mode, OrigType, ArgMode)
+ ;
+ MaybeNameMode = no,
+ error("make_extra_c_arg_list_seq: no name")
+ ),
+ NextReg = LastReg + 1,
+ % Extra args are always input.
+ ArgInfo = arg_info(NextReg, ArgMode),
+ CArg = c_arg(Var, yes(Name), OrigType, ArgInfo),
+ make_extra_c_arg_list_seq(ExtraArgs, ModuleInfo, NextReg, CArgs).
+
+%---------------------------------------------------------------------------%
+
:- pred get_c_arg_list_vars(list(c_arg)::in, list(prog_var)::out) is det.
get_c_arg_list_vars([], []).
@@ -1084,8 +1134,8 @@
%---------------------------------------------------------------------------%
-% pragma_select_out_args returns the list of variables which are outputs for
-% a procedure
+ % pragma_select_out_args returns the list of variables
+ % which are outputs for a procedure
:- pred pragma_select_out_args(list(c_arg)::in, list(c_arg)::out) is det.
@@ -1094,16 +1144,14 @@
pragma_select_out_args(Rest, Out0),
Arg = c_arg(_, _, _, ArgInfo),
ArgInfo = arg_info(_Loc, Mode),
- (
- Mode = top_out
- ->
+ ( Mode = top_out ->
Out = [Arg | Out0]
;
Out = Out0
).
-% pragma_select_in_args returns the list of variables which are inputs for
-% a procedure
+ % pragma_select_in_args returns the list of variables
+ % which are inputs for a procedure
:- pred pragma_select_in_args(list(c_arg)::in, list(c_arg)::out) is det.
@@ -1112,9 +1160,7 @@
pragma_select_in_args(Rest, In0),
Arg = c_arg(_, _, _, ArgInfo),
ArgInfo = arg_info(_Loc, Mode),
- (
- Mode = top_in
- ->
+ ( Mode = top_in ->
In = [Arg | In0]
;
In = In0
@@ -1151,9 +1197,7 @@
make_pragma_decls([], _, []).
make_pragma_decls([Arg | Args], Module, Decls) :-
Arg = c_arg(_Var, ArgName, OrigType, _ArgInfo),
- (
- var_is_not_singleton(ArgName, Name)
- ->
+ ( var_is_not_singleton(ArgName, Name) ->
OrigTypeString = foreign__to_type_string(c, Module, OrigType),
Decl = pragma_c_arg_decl(OrigType, OrigTypeString, Name),
make_pragma_decls(Args, Module, Decls1),
Index: compiler/prog_rep.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_rep.m,v
retrieving revision 1.24
diff -u -b -r1.24 prog_rep.m
--- compiler/prog_rep.m 19 May 2004 03:59:33 -0000 1.24
+++ compiler/prog_rep.m 7 Jun 2004 08:49:55 -0000
@@ -237,10 +237,10 @@
DetismRep, FilenameRep, LinenoRep, ChangedVarsRep),
Rep = atomic_goal_rep(DetismRep, FilenameRep, LinenoRep,
ChangedVarsRep, AtomicGoalRep).
-prog_rep__represent_goal_expr(foreign_proc(_,
- _PredId, _, Args, _, _, _),
+prog_rep__represent_goal_expr(foreign_proc(_, _PredId, _, Args, _, _),
GoalInfo, InstMap0, Info, Rep) :-
- list__map(term__var_to_int, Args, ArgsRep),
+ ArgVars = list__map(foreign_arg_var, Args),
+ list__map(term__var_to_int, ArgVars, ArgsRep),
AtomicGoalRep = pragma_foreign_code_rep(ArgsRep),
prog_rep__represent_atomic_goal(GoalInfo, InstMap0, Info,
DetismRep, FilenameRep, LinenoRep, ChangedVarsRep),
Index: compiler/purity.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/purity.m,v
retrieving revision 1.64
diff -u -b -r1.64 purity.m
--- compiler/purity.m 19 Mar 2004 10:19:25 -0000 1.64
+++ compiler/purity.m 7 Jun 2004 08:49:55 -0000
@@ -689,7 +689,7 @@
worst_purity(Purity1, Purity2) = Purity12,
worst_purity(Purity12, Purity3) = Purity.
compute_expr_purity(ForeignProc0, ForeignProc, _, Purity, !Info) :-
- ForeignProc0 = foreign_proc(_, _, _, _, _, _, _),
+ ForeignProc0 = foreign_proc(_, _, _, _, _, _),
Attributes = ForeignProc0 ^ foreign_attr,
PredId = ForeignProc0 ^ foreign_pred_id,
ModuleInfo = !.Info ^ module_info,
Index: compiler/quantification.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/quantification.m,v
retrieving revision 1.88
diff -u -b -r1.88 quantification.m
--- compiler/quantification.m 11 Nov 2003 03:23:26 -0000 1.88
+++ compiler/quantification.m 7 Jun 2004 08:49:55 -0000
@@ -485,8 +485,11 @@
quantification__set_nonlocals(NonLocalVars, !Info).
implicitly_quantify_goal_2(Expr, Expr, _, !Info) :-
- Expr = foreign_proc(_, _, _, Vars, _, _, _),
- implicitly_quantify_atomic_goal(Vars, !Info).
+ Expr = foreign_proc(_, _, _, Args, ExtraArgs, _),
+ Vars = list__map(foreign_arg_var, Args),
+ ExtraVars = list__map(foreign_arg_var, ExtraArgs),
+ list__append(Vars, ExtraVars, AllVars),
+ implicitly_quantify_atomic_goal(AllVars, !Info).
implicitly_quantify_goal_2(Expr0, Expr, Context, !Info) :-
Expr0 = shorthand(ShorthandGoal),
@@ -992,9 +995,12 @@
union(!.Set, ElseSet, !:Set),
union(!.LambdaSet, ElseLambdaSet, !:LambdaSet).
-quantification__goal_vars_2(_, foreign_proc(_,_,_, ArgVars, _, _, _),
+quantification__goal_vars_2(_, foreign_proc(_, _, _, Args, ExtraArgs, _),
!Set, !LambdaSet) :-
- insert_list(!.Set, ArgVars, !:Set).
+ Vars = list__map(foreign_arg_var, Args),
+ ExtraVars = list__map(foreign_arg_var, ExtraArgs),
+ list__append(Vars, ExtraVars, AllVars),
+ insert_list(!.Set, AllVars, !:Set).
quantification__goal_vars_2(NonLocalsToRecompute, shorthand(ShorthandGoal),
!Set, !LambdaSet) :-
Index: compiler/reassign.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/reassign.m,v
retrieving revision 1.7
diff -u -b -r1.7 reassign.m
--- compiler/reassign.m 11 Nov 2003 03:35:08 -0000 1.7
+++ compiler/reassign.m 7 Jun 2004 08:49:55 -0000
@@ -299,7 +299,7 @@
KnownContentsMap = map__init,
DepLvalMap = map__init
;
- Uinstr0 = pragma_c(_, _, _, _, _, _, _, _),
+ Uinstr0 = pragma_c(_, _, _, _, _, _, _, _, _),
RevInstrs1 = [Instr0 | RevInstrs0],
% The C code may clobber any lval.
KnownContentsMap = map__init,
Index: compiler/rl_exprn.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl_exprn.m,v
retrieving revision 1.40
diff -u -b -r1.40 rl_exprn.m
--- compiler/rl_exprn.m 19 May 2004 03:59:33 -0000 1.40
+++ compiler/rl_exprn.m 7 Jun 2004 08:49:55 -0000
@@ -881,7 +881,7 @@
{ Code = tree(SwitchCode, node([rl_PROC_label(EndSwitch)])) }.
rl_exprn__goal(generic_call(_, _, _, _) - _, _, _) -->
{ error("rl_exprn__goal: higher-order and class-method calls not yet implemented") }.
-rl_exprn__goal(foreign_proc(_, _, _, _, _, _, _) - _, _, _) -->
+rl_exprn__goal(foreign_proc(_, _, _, _, _, _) - _, _, _) -->
{ error("rl_exprn__goal: foreign_proc not yet implemented") }.
rl_exprn__goal(some(_, _, Goal) - _, Fail, Code) -->
rl_exprn__goal(Goal, Fail, Code).
Index: compiler/saved_vars.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/saved_vars.m,v
retrieving revision 1.39
diff -u -b -r1.39 saved_vars.m
--- compiler/saved_vars.m 19 May 2004 03:59:36 -0000 1.39
+++ compiler/saved_vars.m 7 Jun 2004 08:49:55 -0000
@@ -142,7 +142,7 @@
Goal = GoalExpr0 - GoalInfo0,
SlotInfo = SlotInfo0
;
- GoalExpr0 = foreign_proc(_, _, _, _, _, _, _),
+ GoalExpr0 = foreign_proc(_, _, _, _, _, _),
Goal = GoalExpr0 - GoalInfo0,
SlotInfo = SlotInfo0
;
@@ -322,7 +322,7 @@
IsNonLocal, SlotInfo1, Goals1, SlotInfo),
Goals = [NewConstruct, Goal1 | Goals1]
;
- Goal0Expr = foreign_proc(_, _, _, _, _, _, _),
+ Goal0Expr = foreign_proc(_, _, _, _, _, _),
rename_var(SlotInfo0, Var, _NewVar, Subst, SlotInfo1),
goal_util__rename_vars_in_goal(Construct, Subst,
NewConstruct),
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.130
diff -u -b -r1.130 simplify.m
--- compiler/simplify.m 3 May 2004 09:40:40 -0000 1.130
+++ compiler/simplify.m 7 Jun 2004 08:49:55 -0000
@@ -1081,12 +1081,14 @@
).
simplify__goal_2(Goal0, Goal, GoalInfo, GoalInfo, !Info) :-
- Goal0 = foreign_proc(_, PredId, ProcId, Args, _, _, _),
+ Goal0 = foreign_proc(_, PredId, ProcId, Args, ExtraArgs, _),
(
simplify_do_calls(!.Info),
- goal_info_is_pure(GoalInfo)
+ goal_info_is_pure(GoalInfo),
+ ExtraArgs = []
->
- common__optimise_call(PredId, ProcId, Args, GoalInfo,
+ ArgVars = list__map(foreign_arg_var, Args),
+ common__optimise_call(PredId, ProcId, ArgVars, GoalInfo,
Goal0, Goal, !Info)
;
Goal = Goal0
@@ -1139,7 +1141,7 @@
Unique = ground(unique, none),
ArgInsts = [R - Unique],
goal_util__generate_simple_call(BuiltinModule, "compare", predicate,
- Args, mode_no(ModeNo), det, no, ArgInsts, ModuleInfo, Context,
+ mode_no(ModeNo), det, Args, no, ArgInsts, ModuleInfo, Context,
CmpGoal0),
CmpGoal0 = CmpExpr - CmpInfo0,
goal_info_get_nonlocals(CmpInfo0, CmpNonLocals0),
@@ -1378,9 +1380,8 @@
%
goal_info_get_context(GoalInfo0, GContext),
generate_simple_call(mercury_private_builtin_module,
- "builtin_unify_pred", predicate, [XVar, YVar],
- mode_no(0), semidet, no, [], ModuleInfo,
- GContext, Call0 - _),
+ "builtin_unify_pred", predicate, mode_no(0), semidet,
+ [XVar, YVar], no, [], ModuleInfo, GContext, Call0 - _),
simplify__goal_2(Call0, Call1, GoalInfo0, GoalInfo, !Info),
Call = Call1 - GoalInfo,
ExtraGoals = []
@@ -1456,7 +1457,7 @@
ArgVars = [TypeInfoVar, XVar, YVar],
goal_info_get_context(GoalInfo, Context),
goal_util__generate_simple_call(mercury_public_builtin_module,
- "unify", predicate, ArgVars, mode_no(0), semidet, no, [],
+ "unify", predicate, mode_no(0), semidet, ArgVars, no, [],
ModuleInfo, Context, Call).
:- pred simplify__call_specific_unify(type_ctor::in, list(prog_var)::in,
@@ -2488,7 +2489,7 @@
Goal = GoalExpr - _,
GoalExpr \= call(_, _, _, _, _, _),
GoalExpr \= generic_call(_, _, _, _),
- GoalExpr \= foreign_proc(_, _, _, _, _, _, _)
+ GoalExpr \= foreign_proc(_, _, _, _, _, _)
)
->
simplify_info_get_common_info(!.Info, CommonInfo0),
Index: compiler/size_prof.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/size_prof.m,v
retrieving revision 1.6
diff -u -b -r1.6 size_prof.m
--- compiler/size_prof.m 5 Apr 2004 05:07:42 -0000 1.6
+++ compiler/size_prof.m 7 Jun 2004 08:49:55 -0000
@@ -302,7 +302,7 @@
!:Info = !.Info ^ type_ctor_map := map__init,
GoalExpr = GoalExpr0
;
- GoalExpr0 = foreign_proc(_, _, _, _, _, _, _),
+ GoalExpr0 = foreign_proc(_, _, _, _, _, _),
GoalExpr = GoalExpr0
;
GoalExpr0 = conj(Goals0),
@@ -719,9 +719,8 @@
% so we make it a no_type_info_builtin.
TermSizeProfBuiltin = mercury_term_size_prof_builtin_module,
goal_util__generate_simple_call(TermSizeProfBuiltin,
- "increment_size", predicate,
- [Var, SizeVar], only_mode, det,
- yes(impure), [], !.Info ^ module_info,
+ "increment_size", predicate, only_mode, det,
+ [Var, SizeVar], yes(impure), [], !.Info ^ module_info,
Context, UpdateGoal),
% Put UnifyGoal first in case it fails.
Goals = list__condense([[UnifyGoal], ArgGoals, SizeGoals,
@@ -789,8 +788,8 @@
get_new_var(int_type, "FinalSizeVar", SizeVar, !Info),
TermSizeProfModule = mercury_term_size_prof_builtin_module,
goal_util__generate_simple_call(TermSizeProfModule,
- "term_size_plus", function,
- [SizeVar0, KnownSizeVar, SizeVar], mode_no(0), det, no,
+ "term_size_plus", function, mode_no(0), det,
+ [SizeVar0, KnownSizeVar, SizeVar], no,
[SizeVar - ground(shared, none)],
!.Info ^ module_info, Context, AddGoal),
Goals = [KnownSizeGoal, AddGoal]
@@ -851,8 +850,8 @@
PrivateBuiltin = mercury_private_builtin_module,
goal_util__generate_simple_call(PrivateBuiltin,
"type_info_from_typeclass_info", predicate,
- [TypeClassInfoVar, SlotVar, TypeInfoVar],
- only_mode, det, no,
+ only_mode, det,
+ [TypeClassInfoVar, SlotVar, TypeInfoVar], no,
[TypeInfoVar - ground(shared, none)],
!.Info ^ module_info, Context, ExtractGoal),
record_type_info_var(Type, TypeInfoVar, !Info),
@@ -966,7 +965,7 @@
),
TermSizeProfBuiltin = mercury_term_size_prof_builtin_module,
goal_util__generate_simple_call(TermSizeProfBuiltin, Pred, predicate,
- Args, only_mode, det, no, [SizeVar - ground(shared, none)],
+ only_mode, det, Args, no, [SizeVar - ground(shared, none)],
!.Info ^ module_info, Context, SizeGoal),
MaybeSizeVar = yes(SizeVar).
Index: compiler/stack_opt.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/stack_opt.m,v
retrieving revision 1.11
diff -u -b -r1.11 stack_opt.m
--- compiler/stack_opt.m 23 Mar 2004 10:52:12 -0000 1.11
+++ compiler/stack_opt.m 7 Jun 2004 08:49:55 -0000
@@ -77,8 +77,7 @@
:- import_module io.
:- pred stack_opt_cell(pred_id::in, proc_id::in, proc_info::in, proc_info::out,
- module_info::in, module_info::out, io__state::di, io__state::uo)
- is det.
+ module_info::in, module_info::out, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
@@ -274,7 +273,7 @@
:- pred optimize_live_sets(module_info::in, opt_stack_alloc::in,
proc_info::in, proc_info::out, bool::out, int::in, int::in,
- io__state::di, io__state::uo) is det.
+ io::di, io::uo) is det.
optimize_live_sets(ModuleInfo, OptAlloc, !ProcInfo, Changed, DebugStackOpt,
PredIdInt, !IO) :-
@@ -365,22 +364,22 @@
:- pred optimize_live_sets_in_goal(hlds_goal::in,
opt_info::in, opt_info::out) is det.
-optimize_live_sets_in_goal(conj(Goals) - _GoalInfo) -->
- optimize_live_sets_in_conj(Goals).
+optimize_live_sets_in_goal(conj(Goals) - _GoalInfo, !OptInfo) :-
+ optimize_live_sets_in_conj(Goals, !OptInfo).
-optimize_live_sets_in_goal(par_conj(Goals) - _GoalInfo) -->
- optimize_live_sets_in_par_conj(Goals).
+optimize_live_sets_in_goal(par_conj(Goals) - _GoalInfo, !OptInfo) :-
+ optimize_live_sets_in_par_conj(Goals, !OptInfo).
-optimize_live_sets_in_goal(disj(Goals) - GoalInfo) -->
- ( { Goals = [FirstDisjunct | _] } ->
+optimize_live_sets_in_goal(disj(Goals) - GoalInfo, !OptInfo) :-
+ ( Goals = [FirstDisjunct | _] ->
reached_branch_end(GoalInfo, yes(FirstDisjunct), disj,
StartAnchor, EndAnchor, BeforeId, AfterId,
- MaybeResumeVars),
+ MaybeResumeVars, !OptInfo),
optimize_live_sets_in_disj(Goals, doesnt_need_flush,
StartAnchor, EndAnchor, BeforeId, AfterId,
- OpenIntervals),
+ OpenIntervals, !OptInfo),
leave_branch_start(disj, StartAnchor, BeforeId,
- MaybeResumeVars, OpenIntervals)
+ MaybeResumeVars, OpenIntervals, !OptInfo)
;
% We could reset the set of variables in the current interval
% to the empty set, since any variable accesses after a fail
@@ -389,158 +388,166 @@
% any goals in the current branch from after the fail, so the
% set of variables in the current interval will already be
% the empty set.
- no_open_intervals
+ no_open_intervals(!OptInfo)
).
-optimize_live_sets_in_goal(switch(Var, _Det, Cases) - GoalInfo) -->
+optimize_live_sets_in_goal(switch(Var, _Det, Cases) - GoalInfo, !OptInfo) :-
reached_branch_end(GoalInfo, no, switch,
- StartAnchor, EndAnchor, BeforeId, AfterId, MaybeResumeVars),
+ StartAnchor, EndAnchor, BeforeId, AfterId, MaybeResumeVars,
+ !OptInfo),
optimize_live_sets_in_cases(Cases, StartAnchor, EndAnchor,
- BeforeId, AfterId, OpenIntervalsList),
- { OpenIntervals = set__union_list(OpenIntervalsList) },
+ BeforeId, AfterId, OpenIntervalsList, !OptInfo),
+ OpenIntervals = set__union_list(OpenIntervalsList),
leave_branch_start(switch, StartAnchor, BeforeId, MaybeResumeVars,
- OpenIntervals),
- require_in_regs([Var]),
- require_access([Var]).
+ OpenIntervals, !OptInfo),
+ require_in_regs([Var], !OptInfo),
+ require_access([Var], !OptInfo).
-optimize_live_sets_in_goal(not(Goal) - GoalInfo) -->
+optimize_live_sets_in_goal(not(Goal) - GoalInfo, !OptInfo) :-
reached_branch_end(GoalInfo, yes(Goal), neg,
- StartAnchor, EndAnchor, BeforeId, AfterId, MaybeResumeVars),
- enter_branch_tail(EndAnchor, AfterId),
- optimize_live_sets_in_goal(Goal),
+ StartAnchor, EndAnchor, BeforeId, AfterId, MaybeResumeVars,
+ !OptInfo),
+ enter_branch_tail(EndAnchor, AfterId, !OptInfo),
+ optimize_live_sets_in_goal(Goal, !OptInfo),
reached_branch_start(needs_flush, StartAnchor, BeforeId,
- OpenIntervals),
+ OpenIntervals, !OptInfo),
leave_branch_start(neg, StartAnchor, BeforeId, MaybeResumeVars,
- OpenIntervals).
+ OpenIntervals, !OptInfo).
-optimize_live_sets_in_goal(if_then_else(_, Cond, Then, Else) - GoalInfo) -->
+optimize_live_sets_in_goal(if_then_else(_, Cond, Then, Else) - GoalInfo,
+ !OptInfo) :-
reached_branch_end(GoalInfo, yes(Cond), ite, StartAnchor, EndAnchor,
- BeforeId, AfterId, MaybeResumeVars),
- enter_branch_tail(EndAnchor, AfterId),
- optimize_live_sets_in_goal(Then),
- reached_cond_then(GoalInfo),
- optimize_live_sets_in_goal(Cond),
+ BeforeId, AfterId, MaybeResumeVars, !OptInfo),
+ enter_branch_tail(EndAnchor, AfterId, !OptInfo),
+ optimize_live_sets_in_goal(Then, !OptInfo),
+ reached_cond_then(GoalInfo, !OptInfo),
+ optimize_live_sets_in_goal(Cond, !OptInfo),
reached_branch_start(doesnt_need_flush, StartAnchor, BeforeId,
- CondOpenIntervals),
- enter_branch_tail(EndAnchor, AfterId),
- optimize_live_sets_in_goal(Else),
+ CondOpenIntervals, !OptInfo),
+ enter_branch_tail(EndAnchor, AfterId, !OptInfo),
+ optimize_live_sets_in_goal(Else, !OptInfo),
reached_branch_start(needs_flush, StartAnchor, BeforeId,
- _ElseOpenIntervals),
+ _ElseOpenIntervals, !OptInfo),
leave_branch_start(ite, StartAnchor, BeforeId, MaybeResumeVars,
- CondOpenIntervals).
-
-optimize_live_sets_in_goal(some(_Vars, _CanRemove, Goal) - _GoalInfo) -->
- optimize_live_sets_in_goal(Goal).
+ CondOpenIntervals, !OptInfo).
-optimize_live_sets_in_goal(Goal - GoalInfo) -->
- OptParams =^ opt_params,
- { Goal = generic_call(GenericCall, ArgVars, ArgModes, Detism) },
- { goal_info_get_maybe_need_across_call(GoalInfo, MaybeNeedAcrossCall) },
- { VarTypes = OptParams ^ var_types },
- { list__map(map__lookup(VarTypes), ArgVars, ArgTypes) },
- { ModuleInfo = OptParams ^ module_info },
- { arg_info__compute_in_and_out_vars(ModuleInfo, ArgVars,
- ArgModes, ArgTypes, InputArgs, _OutputArgs) },
- { determinism_to_code_model(Detism, CodeModel) },
+optimize_live_sets_in_goal(some(_Vars, _CanRemove, Goal) - _GoalInfo,
+ !OptInfo) :-
+ optimize_live_sets_in_goal(Goal, !OptInfo).
+
+optimize_live_sets_in_goal(Goal - GoalInfo, !OptInfo) :-
+ OptParams = !.OptInfo ^ opt_params,
+ Goal = generic_call(GenericCall, ArgVars, ArgModes, Detism),
+ goal_info_get_maybe_need_across_call(GoalInfo, MaybeNeedAcrossCall),
+ VarTypes = OptParams ^ var_types,
+ list__map(map__lookup(VarTypes), ArgVars, ArgTypes),
+ ModuleInfo = OptParams ^ module_info,
+ arg_info__compute_in_and_out_vars(ModuleInfo, ArgVars,
+ ArgModes, ArgTypes, InputArgs, _OutputArgs),
+ determinism_to_code_model(Detism, CodeModel),
% unsafe_casts are generated inline.
- ( { GenericCall = unsafe_cast } ->
- require_in_regs(InputArgs),
- require_access(InputArgs)
- ;
- { call_gen__generic_call_info(CodeModel, GenericCall, _,
- GenericVarsArgInfos, _) },
- { assoc_list__keys(GenericVarsArgInfos, GenericVars) },
- { list__append(GenericVars, InputArgs, Inputs) },
+ ( GenericCall = unsafe_cast ->
+ require_in_regs(InputArgs, !OptInfo),
+ require_access(InputArgs, !OptInfo)
+ ;
+ call_gen__generic_call_info(CodeModel, GenericCall, _,
+ GenericVarsArgInfos, _),
+ assoc_list__keys(GenericVarsArgInfos, GenericVars),
+ list__append(GenericVars, InputArgs, Inputs),
optimize_live_sets_at_call(Inputs,
- MaybeNeedAcrossCall, GoalInfo)
+ MaybeNeedAcrossCall, GoalInfo, !OptInfo)
).
-optimize_live_sets_in_goal(Goal - GoalInfo) -->
- { Goal = call(PredId, ProcId, ArgVars, Builtin, _, _) },
- OptParams =^ opt_params,
- { ModuleInfo = OptParams ^ module_info },
- { module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
- _PredInfo, ProcInfo) },
- { VarTypes = OptParams ^ var_types },
- { arg_info__partition_proc_call_args(ProcInfo, VarTypes,
- ModuleInfo, ArgVars, InputArgs, _, _) },
- { set__to_sorted_list(InputArgs, Inputs) },
- ( { Builtin = inline_builtin } ->
- require_in_regs(Inputs),
- require_access(Inputs)
+optimize_live_sets_in_goal(Goal - GoalInfo, !OptInfo) :-
+ Goal = call(PredId, ProcId, ArgVars, Builtin, _, _),
+ OptParams = !.OptInfo ^ opt_params,
+ ModuleInfo = OptParams ^ module_info,
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
+ _PredInfo, ProcInfo),
+ VarTypes = OptParams ^ var_types,
+ arg_info__partition_proc_call_args(ProcInfo, VarTypes,
+ ModuleInfo, ArgVars, InputArgs, _, _),
+ set__to_sorted_list(InputArgs, Inputs),
+ ( Builtin = inline_builtin ->
+ require_in_regs(Inputs, !OptInfo),
+ require_access(Inputs, !OptInfo)
;
- { goal_info_get_maybe_need_across_call(GoalInfo,
- MaybeNeedAcrossCall) },
+ goal_info_get_maybe_need_across_call(GoalInfo,
+ MaybeNeedAcrossCall),
optimize_live_sets_at_call(Inputs, MaybeNeedAcrossCall,
- GoalInfo)
+ GoalInfo, !OptInfo)
).
-optimize_live_sets_in_goal(Goal - GoalInfo) -->
- { Goal = foreign_proc(_Attributes, PredId, ProcId,
- ArgVars, _ArgNames, _OrigArgTypes, _PragmaCode) },
- OptParams =^ opt_params,
- { ModuleInfo = OptParams ^ module_info },
- { module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
- _PredInfo, ProcInfo) },
- { VarTypes = OptParams ^ var_types },
- { arg_info__partition_proc_call_args(ProcInfo, VarTypes,
- ModuleInfo, ArgVars, InputArgs, _, _) },
- { set__to_sorted_list(InputArgs, Inputs) },
- (
- { goal_info_maybe_get_maybe_need_across_call(GoalInfo,
- MaybeNeedAcrossCall) },
- { MaybeNeedAcrossCall = yes(_) }
+optimize_live_sets_in_goal(Goal - GoalInfo, !OptInfo) :-
+ Goal = foreign_proc(_Attributes, PredId, ProcId, Args, ExtraArgs,
+ _PragmaCode),
+ OptParams = !.OptInfo ^ opt_params,
+ ModuleInfo = OptParams ^ module_info,
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
+ _PredInfo, ProcInfo),
+ VarTypes = OptParams ^ var_types,
+ ArgVars = list__map(foreign_arg_var, Args),
+ ExtraVars = list__map(foreign_arg_var, ExtraArgs),
+ arg_info__partition_proc_call_args(ProcInfo, VarTypes,
+ ModuleInfo, ArgVars, InputArgVarSet, _, _),
+ set__to_sorted_list(InputArgVarSet, InputArgVars),
+ list__append(InputArgVars, ExtraVars, InputVars),
+ (
+ goal_info_maybe_get_maybe_need_across_call(GoalInfo,
+ MaybeNeedAcrossCall),
+ MaybeNeedAcrossCall = yes(_)
->
- optimize_live_sets_at_call(Inputs, MaybeNeedAcrossCall,
- GoalInfo)
+ optimize_live_sets_at_call(InputVars, MaybeNeedAcrossCall,
+ GoalInfo, !OptInfo)
;
- require_in_regs(Inputs),
- require_access(Inputs)
+ require_in_regs(InputVars, !OptInfo),
+ require_access(InputVars, !OptInfo)
).
-optimize_live_sets_in_goal(Goal - GoalInfo) -->
- { Goal = unify(_, _, _, Unification, _) },
+optimize_live_sets_in_goal(Goal - GoalInfo, !OptInfo) :-
+ Goal = unify(_, _, _, Unification, _),
(
- { Unification = construct(CellVar, _ConsId, ArgVars, _,
- HowToConstruct, _, _) },
- { HowToConstruct = reuse_cell(_) ->
+ Unification = construct(CellVar, _ConsId, ArgVars, _,
+ HowToConstruct, _, _),
+ ( HowToConstruct = reuse_cell(_) ->
error("optimize_live_sets_in_goal: reuse")
;
true
- },
- require_in_regs(ArgVars),
- require_access([CellVar | ArgVars])
- % use_cell(CellVar, ArgVars, ConsId, Goal - GoalInfo)
+ ),
+ require_in_regs(ArgVars, !OptInfo),
+ require_access([CellVar | ArgVars], !OptInfo)
+ % use_cell(CellVar, ArgVars, ConsId, Goal - GoalInfo, !OptInfo)
% We cannot use such cells, because some of the ArgVars
% may need to be saved on the stack before this construction.
;
- { Unification = deconstruct(CellVar, ConsId, ArgVars,
- ArgModes, _, _) },
- OptParams =^ opt_params,
- { ModuleInfo = OptParams ^ module_info },
- ( { shared_left_to_right_deconstruct(ModuleInfo, ArgModes) } ->
- use_cell(CellVar, ArgVars, ConsId, Goal - GoalInfo)
+ Unification = deconstruct(CellVar, ConsId, ArgVars,
+ ArgModes, _, _),
+ OptParams = !.OptInfo ^ opt_params,
+ ModuleInfo = OptParams ^ module_info,
+ ( shared_left_to_right_deconstruct(ModuleInfo, ArgModes) ->
+ use_cell(CellVar, ArgVars, ConsId, Goal - GoalInfo,
+ !OptInfo)
;
- []
+ true
),
- require_in_regs([CellVar]),
- require_access([CellVar | ArgVars])
+ require_in_regs([CellVar], !OptInfo),
+ require_access([CellVar | ArgVars], !OptInfo)
;
- { Unification = assign(ToVar, FromVar) },
- require_in_regs([FromVar]),
- require_access([FromVar, ToVar])
+ Unification = assign(ToVar, FromVar),
+ require_in_regs([FromVar], !OptInfo),
+ require_access([FromVar, ToVar], !OptInfo)
;
- { Unification = simple_test(Var1, Var2) },
- require_in_regs([Var1, Var2]),
- require_access([Var1, Var2])
+ Unification = simple_test(Var1, Var2),
+ require_in_regs([Var1, Var2], !OptInfo),
+ require_access([Var1, Var2], !OptInfo)
;
- { Unification = complicated_unify(_, _, _) },
- { error("optimize_live_sets_in_goal: complicated_unify") }
+ Unification = complicated_unify(_, _, _),
+ error("optimize_live_sets_in_goal: complicated_unify")
).
-optimize_live_sets_in_goal(shorthand(_) - _) -->
- { error("shorthand in optimize_live_sets_in_goal") }.
+optimize_live_sets_in_goal(shorthand(_) - _, !OptInfo) :-
+ error("shorthand in optimize_live_sets_in_goal").
:- pred shared_left_to_right_deconstruct(module_info::in, list(uni_mode)::in)
is semidet.
@@ -560,49 +567,49 @@
maybe(need_across_call)::in, hlds_goal_info::in,
opt_info::in, opt_info::out) is det.
-optimize_live_sets_at_call(Inputs, MaybeNeedAcrossCall, GoalInfo) -->
+optimize_live_sets_at_call(Inputs, MaybeNeedAcrossCall, GoalInfo, !OptInfo) :-
(
- { MaybeNeedAcrossCall = yes(NeedAcrossCall) },
- { NeedAcrossCall = need_across_call(ForwardVars,
- ResumeVars, NondetLiveVars) },
- { VarsOnStack0 = set__union_list([ForwardVars, ResumeVars,
- NondetLiveVars]) },
- { goal_info_get_goal_path(GoalInfo, GoalPath) },
- { CallAnchor = call_site(GoalPath) },
- get_cur_interval(AfterCallId),
- new_interval_id(BeforeCallId),
- record_interval_start(AfterCallId, CallAnchor),
- record_interval_end(BeforeCallId, CallAnchor),
- { goal_info_get_instmap_delta(GoalInfo, InstMapDelta) },
- OptParams =^ opt_params,
+ MaybeNeedAcrossCall = yes(NeedAcrossCall),
+ NeedAcrossCall = need_across_call(ForwardVars,
+ ResumeVars, NondetLiveVars),
+ VarsOnStack0 = set__union_list([ForwardVars, ResumeVars,
+ NondetLiveVars]),
+ goal_info_get_goal_path(GoalInfo, GoalPath),
+ CallAnchor = call_site(GoalPath),
+ get_cur_interval(AfterCallId, !OptInfo),
+ new_interval_id(BeforeCallId, !OptInfo),
+ record_interval_start(AfterCallId, CallAnchor, !OptInfo),
+ record_interval_end(BeforeCallId, CallAnchor, !OptInfo),
+ goal_info_get_instmap_delta(GoalInfo, InstMapDelta),
+ OptParams = !.OptInfo ^ opt_params,
(
- { instmap_delta_is_reachable(InstMapDelta)
+ ( instmap_delta_is_reachable(InstMapDelta)
; OptParams ^ opt_at_most_zero_calls = no
- }
+ )
->
- record_interval_succ(BeforeCallId, AfterCallId),
- { VarsOnStack = VarsOnStack0 }
+ record_interval_succ(BeforeCallId, AfterCallId, !OptInfo),
+ VarsOnStack = VarsOnStack0
;
% If the call cannot succeed, then execution cannot
% get from BeforeCallId to AfterCallId.
- record_interval_no_succ(BeforeCallId),
- { VarsOnStack = set__init }
+ record_interval_no_succ(BeforeCallId, !OptInfo),
+ VarsOnStack = set__init
+ ),
+ set_cur_interval(BeforeCallId, !OptInfo),
+ assign_open_intervals_to_anchor(CallAnchor, !OptInfo),
+ goal_info_get_code_model(GoalInfo, CodeModel),
+ ( CodeModel = model_non ->
+ record_model_non_anchor(CallAnchor, !OptInfo)
+ ;
+ true
),
- set_cur_interval(BeforeCallId),
- assign_open_intervals_to_anchor(CallAnchor),
- { goal_info_get_code_model(GoalInfo, CodeModel) },
- ( { CodeModel = model_non } ->
- record_model_non_anchor(CallAnchor)
- ;
- []
- ),
- one_open_interval(BeforeCallId),
- require_flushed(VarsOnStack),
- require_in_regs(Inputs),
- require_access(Inputs)
+ one_open_interval(BeforeCallId, !OptInfo),
+ require_flushed(VarsOnStack, !OptInfo),
+ require_in_regs(Inputs, !OptInfo),
+ require_access(Inputs, !OptInfo)
;
- { MaybeNeedAcrossCall = no },
- { error("optimize_live_sets_at_call: no need across call") }
+ MaybeNeedAcrossCall = no,
+ error("optimize_live_sets_at_call: no need across call")
).
%-----------------------------------------------------------------------------%
@@ -610,49 +617,51 @@
:- pred optimize_live_sets_in_conj(list(hlds_goal)::in,
opt_info::in, opt_info::out) is det.
-optimize_live_sets_in_conj([]) --> [].
-optimize_live_sets_in_conj([Goal | Goals]) -->
- optimize_live_sets_in_conj(Goals),
- optimize_live_sets_in_goal(Goal).
+optimize_live_sets_in_conj([], !OptInfo).
+optimize_live_sets_in_conj([Goal | Goals], !OptInfo) :-
+ optimize_live_sets_in_conj(Goals, !OptInfo),
+ optimize_live_sets_in_goal(Goal, !OptInfo).
:- pred optimize_live_sets_in_par_conj(list(hlds_goal)::in,
opt_info::in, opt_info::out) is det.
-optimize_live_sets_in_par_conj([]) --> [].
-optimize_live_sets_in_par_conj([Goal | Goals]) -->
+optimize_live_sets_in_par_conj([], !OptInfo).
+optimize_live_sets_in_par_conj([Goal | Goals], !OptInfo) :-
% XXX zs: I am not sure that passing opt_info from the first goal to
% the rest is OK. Maybe we should pass the initial opt_info to all the
% conjuncts, and then merge the resulting opt_infos.
- optimize_live_sets_in_par_conj(Goals),
- optimize_live_sets_in_goal(Goal).
+ optimize_live_sets_in_par_conj(Goals, !OptInfo),
+ optimize_live_sets_in_goal(Goal, !OptInfo).
:- pred optimize_live_sets_in_disj(list(hlds_goal)::in, maybe_needs_flush::in,
anchor::in, anchor::in, interval_id::in, interval_id::in,
set(interval_id)::out, opt_info::in, opt_info::out) is det.
-optimize_live_sets_in_disj([], _, _, _, _, _, set__init) --> [].
+optimize_live_sets_in_disj([], _, _, _, _, _, set__init, !OptInfo).
optimize_live_sets_in_disj([Goal | Goals], MaybeNeedsFlush,
- StartAnchor, EndAnchor, BeforeId, AfterId, OpenIntervals) -->
- enter_branch_tail(EndAnchor, AfterId),
- optimize_live_sets_in_goal(Goal),
+ StartAnchor, EndAnchor, BeforeId, AfterId, OpenIntervals,
+ !OptInfo) :-
+ enter_branch_tail(EndAnchor, AfterId, !OptInfo),
+ optimize_live_sets_in_goal(Goal, !OptInfo),
reached_branch_start(MaybeNeedsFlush, StartAnchor, BeforeId,
- OpenIntervals),
+ OpenIntervals, !OptInfo),
optimize_live_sets_in_disj(Goals, needs_flush, StartAnchor, EndAnchor,
- BeforeId, AfterId, _OpenIntervals).
+ BeforeId, AfterId, _OpenIntervals, !OptInfo).
:- pred optimize_live_sets_in_cases(list(case)::in,
anchor::in, anchor::in, interval_id::in, interval_id::in,
list(set(interval_id))::out, opt_info::in, opt_info::out) is det.
-optimize_live_sets_in_cases([], _, _, _, _, []) --> [].
+optimize_live_sets_in_cases([], _, _, _, _, [], !OptInfo).
optimize_live_sets_in_cases([case(_Var, Goal) | Cases], StartAnchor, EndAnchor,
- BeforeId, AfterId, [OpenIntervals | OpenIntervalsList]) -->
- enter_branch_tail(EndAnchor, AfterId),
- optimize_live_sets_in_goal(Goal),
+ BeforeId, AfterId, [OpenIntervals | OpenIntervalsList],
+ !OptInfo) :-
+ enter_branch_tail(EndAnchor, AfterId, !OptInfo),
+ optimize_live_sets_in_goal(Goal, !OptInfo),
reached_branch_start(doesnt_need_flush, StartAnchor, BeforeId,
- OpenIntervals),
+ OpenIntervals, !OptInfo),
optimize_live_sets_in_cases(Cases, StartAnchor, EndAnchor,
- BeforeId, AfterId, OpenIntervalsList).
+ BeforeId, AfterId, OpenIntervalsList, !OptInfo).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -692,10 +701,10 @@
reached_branch_end(GoalInfo, MaybeResumeGoal, Construct,
StartAnchor, EndAnchor, BeforeIntervalId, AfterIntervalId,
- MaybeResumeVars) -->
- { goal_info_get_goal_path(GoalInfo, GoalPath) },
- record_branch_end_info(GoalPath),
- {
+ MaybeResumeVars, !OptInfo) :-
+ goal_info_get_goal_path(GoalInfo, GoalPath),
+ record_branch_end_info(GoalPath, !OptInfo),
+ (
MaybeResumeGoal = yes(_ResumeGoalExpr - ResumeGoalInfo),
goal_info_maybe_get_resume_point(ResumeGoalInfo, ResumePoint),
ResumePoint = resume_point(ResumeVars, ResumeLocs),
@@ -706,92 +715,92 @@
;
HasResumeSave = has_no_resume_save,
MaybeResumeVars = no
- },
- record_branch_resume(GoalPath, HasResumeSave),
- ( { goal_info_maybe_get_store_map(GoalInfo, StoreMap) } ->
- { map__sorted_keys(StoreMap, StoreMapVarList) },
- { set__sorted_list_to_set(StoreMapVarList, StoreMapVars) },
- require_flushed(StoreMapVars)
- ;
- { error("reached_branch_end: no store map") }
- ),
- { EndAnchor = branch_end(Construct, GoalPath) },
- { StartAnchor = branch_start(Construct, GoalPath) },
- assign_open_intervals_to_anchor(EndAnchor),
- { goal_info_get_code_model(GoalInfo, CodeModel) },
- ( { CodeModel = model_non } ->
- record_model_non_anchor(EndAnchor)
- ;
- []
- ),
- no_open_intervals,
- get_cur_interval(AfterIntervalId),
- record_interval_start(AfterIntervalId, EndAnchor),
- new_interval_id(BeforeIntervalId).
+ ),
+ record_branch_resume(GoalPath, HasResumeSave, !OptInfo),
+ ( goal_info_maybe_get_store_map(GoalInfo, StoreMap) ->
+ map__sorted_keys(StoreMap, StoreMapVarList),
+ set__sorted_list_to_set(StoreMapVarList, StoreMapVars),
+ require_flushed(StoreMapVars, !OptInfo)
+ ;
+ error("reached_branch_end: no store map")
+ ),
+ EndAnchor = branch_end(Construct, GoalPath),
+ StartAnchor = branch_start(Construct, GoalPath),
+ assign_open_intervals_to_anchor(EndAnchor, !OptInfo),
+ goal_info_get_code_model(GoalInfo, CodeModel),
+ ( CodeModel = model_non ->
+ record_model_non_anchor(EndAnchor, !OptInfo)
+ ;
+ true
+ ),
+ no_open_intervals(!OptInfo),
+ get_cur_interval(AfterIntervalId, !OptInfo),
+ record_interval_start(AfterIntervalId, EndAnchor, !OptInfo),
+ new_interval_id(BeforeIntervalId, !OptInfo).
:- pred enter_branch_tail(anchor::in, interval_id::in,
opt_info::in, opt_info::out) is det.
-enter_branch_tail(EndAnchor, AfterId) -->
- new_interval_id(BranchTailId),
- record_interval_end(BranchTailId, EndAnchor),
- record_interval_succ(BranchTailId, AfterId),
- set_cur_interval(BranchTailId),
- one_open_interval(BranchTailId).
+enter_branch_tail(EndAnchor, AfterId, !OptInfo) :-
+ new_interval_id(BranchTailId, !OptInfo),
+ record_interval_end(BranchTailId, EndAnchor, !OptInfo),
+ record_interval_succ(BranchTailId, AfterId, !OptInfo),
+ set_cur_interval(BranchTailId, !OptInfo),
+ one_open_interval(BranchTailId, !OptInfo).
:- pred reached_branch_start(maybe_needs_flush::in, anchor::in,
interval_id::in, set(interval_id)::out, opt_info::in, opt_info::out)
is det.
-reached_branch_start(MaybeNeedsFlush, StartAnchor, BeforeId, OpenIntervals) -->
- get_cur_interval(BranchStartId),
- record_interval_start(BranchStartId, StartAnchor),
- record_interval_succ(BeforeId, BranchStartId),
- get_open_intervals(OpenIntervals),
+reached_branch_start(MaybeNeedsFlush, StartAnchor, BeforeId, OpenIntervals,
+ !OptInfo) :-
+ get_cur_interval(BranchStartId, !OptInfo),
+ record_interval_start(BranchStartId, StartAnchor, !OptInfo),
+ record_interval_succ(BeforeId, BranchStartId, !OptInfo),
+ get_open_intervals(!.OptInfo, OpenIntervals),
(
- { MaybeNeedsFlush = doesnt_need_flush }
+ MaybeNeedsFlush = doesnt_need_flush
;
- { MaybeNeedsFlush = needs_flush },
- assign_open_intervals_to_anchor(StartAnchor)
+ MaybeNeedsFlush = needs_flush,
+ assign_open_intervals_to_anchor(StartAnchor, !OptInfo)
).
:- pred reached_cond_then(hlds_goal_info::in, opt_info::in, opt_info::out)
is det.
-reached_cond_then(GoalInfo) -->
- { goal_info_get_goal_path(GoalInfo, GoalPath) },
- record_cond_end(GoalPath),
- get_cur_interval(ThenStartId),
- record_interval_start(ThenStartId, CondThenAnchor),
- new_interval_id(CondTailId),
- { CondThenAnchor = cond_then(GoalPath) },
- record_interval_end(CondTailId, CondThenAnchor),
- record_interval_succ(CondTailId, ThenStartId),
- set_cur_interval(CondTailId),
- get_open_intervals(OpenIntervals0),
- { OpenIntervals = set__insert(OpenIntervals0, CondTailId) },
- set_open_intervals(OpenIntervals).
+reached_cond_then(GoalInfo, !OptInfo) :-
+ goal_info_get_goal_path(GoalInfo, GoalPath),
+ record_cond_end(GoalPath, !OptInfo),
+ get_cur_interval(ThenStartId, !OptInfo),
+ record_interval_start(ThenStartId, CondThenAnchor, !OptInfo),
+ new_interval_id(CondTailId, !OptInfo),
+ CondThenAnchor = cond_then(GoalPath),
+ record_interval_end(CondTailId, CondThenAnchor, !OptInfo),
+ record_interval_succ(CondTailId, ThenStartId, !OptInfo),
+ set_cur_interval(CondTailId, !OptInfo),
+ get_open_intervals(!.OptInfo, OpenIntervals0),
+ OpenIntervals = set__insert(OpenIntervals0, CondTailId),
+ set_open_intervals(OpenIntervals, !OptInfo).
:- pred leave_branch_start(branch_construct::in, anchor::in, interval_id::in,
maybe(set(prog_var))::in, set(interval_id)::in,
opt_info::in, opt_info::out) is det.
leave_branch_start(_BranchConstruct, StartArchor, BeforeId, MaybeResumeVars,
- OpenIntervals) -->
- record_interval_end(BeforeId, StartArchor),
+ OpenIntervals, !OptInfo) :-
+ record_interval_end(BeforeId, StartArchor, !OptInfo),
(
- { MaybeResumeVars = yes(ResumeVars) },
- require_flushed(ResumeVars)
+ MaybeResumeVars = yes(ResumeVars),
+ require_flushed(ResumeVars, !OptInfo)
;
- { MaybeResumeVars = no }
+ MaybeResumeVars = no
),
- set_cur_interval(BeforeId),
- set_open_intervals(OpenIntervals).
+ set_cur_interval(BeforeId, !OptInfo),
+ set_open_intervals(OpenIntervals, !OptInfo).
-:- pred get_open_intervals(set(interval_id)::out,
- opt_info::in, opt_info::out) is det.
+:- pred get_open_intervals(opt_info::in, set(interval_id)::out) is det.
-get_open_intervals(OpenIntervals, OptInfo, OptInfo) :-
+get_open_intervals(OptInfo, OpenIntervals) :-
OpenIntervals = OptInfo ^ open_intervals.
:- pred set_open_intervals(set(interval_id)::in,
@@ -1060,63 +1069,64 @@
:- pred use_cell(prog_var::in, list(prog_var)::in, cons_id::in, hlds_goal::in,
opt_info::in, opt_info::out) is det.
-use_cell(CellVar, FieldVarList, ConsId, Goal) -->
- FlushedLater =^ flushed_later,
- OptParams =^ opt_params,
- { NonCandidateVars = OptParams ^ non_candidate_vars },
- { set__list_to_set(FieldVarList, FieldVars) },
- { set__intersect(FieldVars, FlushedLater, FlushedLaterFieldVars) },
- { set__difference(FlushedLaterFieldVars, NonCandidateVars,
- CandidateArgVars0) },
+use_cell(CellVar, FieldVarList, ConsId, Goal, !OptInfo) :-
+ FlushedLater = !.OptInfo ^ flushed_later,
+ OptParams = !.OptInfo ^ opt_params,
+ NonCandidateVars = OptParams ^ non_candidate_vars,
+ set__list_to_set(FieldVarList, FieldVars),
+ set__intersect(FieldVars, FlushedLater, FlushedLaterFieldVars),
+ set__difference(FlushedLaterFieldVars, NonCandidateVars,
+ CandidateArgVars0),
(
- { set__empty(CandidateArgVars0) }
+ set__empty(CandidateArgVars0)
->
- []
+ true
;
- { ConsId = cons(_Name, _Arity) },
- { VarTypes = OptParams ^ var_types },
- { map__lookup(VarTypes, CellVar, Type) },
+ ConsId = cons(_Name, _Arity),
+ VarTypes = OptParams ^ var_types,
+ map__lookup(VarTypes, CellVar, Type),
(
- { type_is_tuple(Type, _) }
+ type_is_tuple(Type, _)
->
- { FreeOfCost = no }
+ FreeOfCost = no
;
- { type_to_ctor_and_args(Type, TypeCtor, _) },
- { ModuleInfo = OptParams ^ module_info },
- { module_info_types(ModuleInfo, TypeTable) },
- { map__lookup(TypeTable, TypeCtor, TypeDefn) },
- { hlds_data__get_type_defn_body(TypeDefn, TypeBody) },
- { ConsTable = TypeBody ^ du_type_cons_tag_values }
+ type_to_ctor_and_args(Type, TypeCtor, _),
+ ModuleInfo = OptParams ^ module_info,
+ module_info_types(ModuleInfo, TypeTable),
+ map__lookup(TypeTable, TypeCtor, TypeDefn),
+ hlds_data__get_type_defn_body(TypeDefn, TypeBody),
+ ConsTable = TypeBody ^ du_type_cons_tag_values
->
- { map__lookup(ConsTable, ConsId, ConsTag) },
- { ConsTag = no_tag ->
+ map__lookup(ConsTable, ConsId, ConsTag),
+ ( ConsTag = no_tag ->
FreeOfCost = yes
;
FreeOfCost = no
- }
+ )
;
- { fail }
+ fail
)
->
- { RelevantVars = set__insert(FieldVars, CellVar) },
- find_all_branches_from_cur_interval(RelevantVars, MatchInfo),
- { MatchInfo = match_info(PathsInfo, RelevantAfterVars,
- AfterModelNon, InsertAnchors, InsertIntervals) },
- (
- { FreeOfCost = yes },
- { set__difference(CandidateArgVars0, RelevantAfterVars,
- ViaCellVars) },
+ RelevantVars = set__insert(FieldVars, CellVar),
+ find_all_branches_from_cur_interval(RelevantVars, MatchInfo,
+ !OptInfo),
+ MatchInfo = match_info(PathsInfo, RelevantAfterVars,
+ AfterModelNon, InsertAnchors, InsertIntervals),
+ (
+ FreeOfCost = yes,
+ set__difference(CandidateArgVars0, RelevantAfterVars,
+ ViaCellVars),
record_matching_result(CellVar, ConsId,
FieldVarList, ViaCellVars, Goal,
- InsertAnchors, InsertIntervals)
+ InsertAnchors, InsertIntervals, !OptInfo)
;
- { FreeOfCost = no },
+ FreeOfCost = no,
+ (
+ AfterModelNon = no,
+ OnStack = OptParams ^ on_stack,
+ set__difference(CandidateArgVars0,
+ RelevantAfterVars, CandidateArgVars),
(
- { AfterModelNon = no },
- { OnStack = OptParams ^ on_stack },
- { set__difference(CandidateArgVars0,
- RelevantAfterVars, CandidateArgVars) },
- {
OnStack = yes,
( set__member(CellVar, FlushedLater) ->
CellVarFlushedLater = yes
@@ -1138,19 +1148,20 @@
;
CellVarFlushedLater = no
)
- },
- { apply_matching(CellVar, CellVarFlushedLater,
+ ),
+ apply_matching(CellVar, CellVarFlushedLater,
OptParams, PathsInfo, CandidateArgVars,
- ViaCellVars) },
+ ViaCellVars),
record_matching_result(CellVar, ConsId,
FieldVarList, ViaCellVars, Goal,
- InsertAnchors, InsertIntervals)
+ InsertAnchors, InsertIntervals,
+ !OptInfo)
;
- { AfterModelNon = yes }
+ AfterModelNon = yes
)
)
;
- []
+ true
).
:- pred apply_matching(prog_var::in, bool::in, opt_params::in,
@@ -1817,7 +1828,7 @@
record_decisions_in_goal(Goal0, Goal, VarInfo0, VarInfo, VarRename0, VarRename,
InsertMap) :-
- Goal0 = foreign_proc(_,_,_,_,_,_,_) - _,
+ Goal0 = foreign_proc(_, _, _, _, _, _) - _,
record_decisions_at_call_site(Goal0, Goal, VarInfo0, VarInfo,
VarRename0, VarRename, no, InsertMap).
@@ -2065,196 +2076,199 @@
% This predicate can help debug the correctness of the transformation.
:- pred maybe_write_progress_message(string::in, int::in, int::in,
- proc_info::in, module_info::in, io__state::di, io__state::uo) is det.
+ proc_info::in, module_info::in, io::di, io::uo) is det.
maybe_write_progress_message(Message, DebugStackOpt, PredIdInt, ProcInfo,
- ModuleInfo) -->
- ( { DebugStackOpt = PredIdInt } ->
- io__write_string(Message),
- io__write_string(":\n"),
- { proc_info_goal(ProcInfo, Goal) },
- { proc_info_varset(ProcInfo, VarSet) },
- hlds_out__write_goal(Goal, ModuleInfo, VarSet, yes, 0, "\n"),
- io__write_string("\n")
+ ModuleInfo, !IO) :-
+ ( DebugStackOpt = PredIdInt ->
+ io__write_string(Message, !IO),
+ io__write_string(":\n", !IO),
+ proc_info_goal(ProcInfo, Goal),
+ proc_info_varset(ProcInfo, VarSet),
+ hlds_out__write_goal(Goal, ModuleInfo, VarSet, yes, 0, "\n",
+ !IO),
+ io__write_string("\n", !IO)
;
- []
+ true
).
%-----------------------------------------------------------------------------%
% These predicates can help debug the performance of the transformation.
-:- pred dump_opt_info(opt_info::in, io__state::di, io__state::uo) is det.
+:- pred dump_opt_info(opt_info::in, io::di, io::uo) is det.
-dump_opt_info(OptInfo) -->
- { map__keys(OptInfo ^ interval_start, StartIds) },
- { map__keys(OptInfo ^ interval_end, EndIds) },
- { map__keys(OptInfo ^ interval_vars, VarsIds) },
- { map__keys(OptInfo ^ interval_succ, SuccIds) },
- { list__condense([StartIds, EndIds, VarsIds, SuccIds], IntervalIds0) },
- { list__sort_and_remove_dups(IntervalIds0, IntervalIds) },
- io__write_string("INTERVALS:\n"),
- list__foldl(dump_interval_info(OptInfo), IntervalIds),
-
- { map__to_assoc_list(OptInfo ^ anchor_follow_map, AnchorFollows) },
- io__write_string("\nANCHOR FOLLOW:\n"),
- list__foldl(dump_anchor_follow, AnchorFollows),
-
- { map__to_assoc_list(OptInfo ^ left_anchor_inserts, Inserts) },
- io__write_string("\nANCHOR INSERT:\n"),
- list__foldl(dump_anchor_inserts, Inserts),
-
- io__write_string("\nMATCHING RESULTS:\n"),
- list__foldl(dump_matching_result, OptInfo ^ matching_results),
- io__write_string("\n").
-
-:- pred dump_interval_info(opt_info::in, interval_id::in,
- io__state::di, io__state::uo) is det.
-
-dump_interval_info(OptInfo, IntervalId) -->
- io__write_string("\ninterval "),
- io__write_int(interval_id_to_int(IntervalId)),
- io__write_string(": "),
- ( { map__search(OptInfo ^ interval_succ, IntervalId, SuccIds) } ->
- { SuccNums = list__map(interval_id_to_int, SuccIds) },
- io__write_string("succ ["),
- write_int_list(SuccNums),
- io__write_string("]\n")
- ;
- io__write_string("no succ\n")
- ),
- ( { map__search(OptInfo ^ interval_start, IntervalId, Start) } ->
- io__write_string("start "),
- io__write(Start),
- io__write_string("\n")
- ;
- io__write_string("no start\n")
- ),
- ( { map__search(OptInfo ^ interval_end, IntervalId, End) } ->
- io__write_string("end "),
- io__write(End),
- io__write_string("\n")
- ;
- io__write_string("no end\n")
- ),
- ( { map__search(OptInfo ^ interval_vars, IntervalId, Vars) } ->
- { list__map(term__var_to_int, set__to_sorted_list(Vars),
- VarNums) },
- io__write_string("vars ["),
- write_int_list(VarNums),
- io__write_string("]\n")
- ;
- io__write_string("no vars\n")
- ),
- ( { map__search(OptInfo ^ interval_delvars, IntervalId, Deletions) } ->
- io__write_string("deletions"),
- list__foldl(dump_deletion, Deletions),
- io__write_string("\n")
- ;
- []
- ).
-
-:- pred dump_deletion(set(prog_var)::in, io__state::di, io__state::uo) is det.
-
-dump_deletion(Vars) -->
- { list__map(term__var_to_int, set__to_sorted_list(Vars), VarNums) },
- io__write_string(" ["),
- write_int_list(VarNums),
- io__write_string("]").
+dump_opt_info(OptInfo, !IO) :-
+ map__keys(OptInfo ^ interval_start, StartIds),
+ map__keys(OptInfo ^ interval_end, EndIds),
+ map__keys(OptInfo ^ interval_vars, VarsIds),
+ map__keys(OptInfo ^ interval_succ, SuccIds),
+ list__condense([StartIds, EndIds, VarsIds, SuccIds], IntervalIds0),
+ list__sort_and_remove_dups(IntervalIds0, IntervalIds),
+ io__write_string("INTERVALS:\n", !IO),
+ list__foldl(dump_interval_info(OptInfo), IntervalIds, !IO),
+
+ map__to_assoc_list(OptInfo ^ anchor_follow_map, AnchorFollows),
+ io__write_string("\nANCHOR FOLLOW:\n", !IO),
+ list__foldl(dump_anchor_follow, AnchorFollows, !IO),
+
+ map__to_assoc_list(OptInfo ^ left_anchor_inserts, Inserts),
+ io__write_string("\nANCHOR INSERT:\n", !IO),
+ list__foldl(dump_anchor_inserts, Inserts, !IO),
+
+ io__write_string("\nMATCHING RESULTS:\n", !IO),
+ list__foldl(dump_matching_result, OptInfo ^ matching_results, !IO),
+ io__write_string("\n", !IO).
+
+:- pred dump_interval_info(opt_info::in, interval_id::in, io::di, io::uo)
+ is det.
+
+dump_interval_info(OptInfo, IntervalId, !IO) :-
+ io__write_string("\ninterval ", !IO),
+ io__write_int(interval_id_to_int(IntervalId), !IO),
+ io__write_string(": ", !IO),
+ ( map__search(OptInfo ^ interval_succ, IntervalId, SuccIds) ->
+ SuccNums = list__map(interval_id_to_int, SuccIds),
+ io__write_string("succ [", !IO),
+ write_int_list(SuccNums, !IO),
+ io__write_string("]\n", !IO)
+ ;
+ io__write_string("no succ\n", !IO)
+ ),
+ ( map__search(OptInfo ^ interval_start, IntervalId, Start) ->
+ io__write_string("start ", !IO),
+ io__write(Start, !IO),
+ io__write_string("\n", !IO)
+ ;
+ io__write_string("no start\n", !IO)
+ ),
+ ( map__search(OptInfo ^ interval_end, IntervalId, End) ->
+ io__write_string("end ", !IO),
+ io__write(End, !IO),
+ io__write_string("\n", !IO)
+ ;
+ io__write_string("no end\n", !IO)
+ ),
+ ( map__search(OptInfo ^ interval_vars, IntervalId, Vars) ->
+ list__map(term__var_to_int, set__to_sorted_list(Vars),
+ VarNums),
+ io__write_string("vars [", !IO),
+ write_int_list(VarNums, !IO),
+ io__write_string("]\n", !IO)
+ ;
+ io__write_string("no vars\n", !IO)
+ ),
+ ( map__search(OptInfo ^ interval_delvars, IntervalId, Deletions) ->
+ io__write_string("deletions", !IO),
+ list__foldl(dump_deletion, Deletions, !IO),
+ io__write_string("\n", !IO)
+ ;
+ true
+ ).
+
+:- pred dump_deletion(set(prog_var)::in, io::di, io::uo) is det.
+
+dump_deletion(Vars, !IO) :-
+ list__map(term__var_to_int, set__to_sorted_list(Vars), VarNums),
+ io__write_string(" [", !IO),
+ write_int_list(VarNums, !IO),
+ io__write_string("]", !IO).
:- pred dump_anchor_follow(pair(anchor, anchor_follow_info)::in,
- io__state::di, io__state::uo) is det.
+ io::di, io::uo) is det.
-dump_anchor_follow(Anchor - AnchorFollowInfo) -->
- { AnchorFollowInfo = Vars - Intervals },
- io__write_string("\n"),
- io__write(Anchor),
- io__write_string(" =>\n"),
- { list__map(term__var_to_int, set__to_sorted_list(Vars), VarNums) },
- io__write_string("vars ["),
- write_int_list(VarNums),
- io__write_string("]\nintervals: "),
- { set__to_sorted_list(Intervals, IntervalList) },
- write_int_list(list__map(interval_id_to_int, IntervalList)),
- io__write_string("\n").
+dump_anchor_follow(Anchor - AnchorFollowInfo, !IO) :-
+ AnchorFollowInfo = Vars - Intervals,
+ io__write_string("\n", !IO),
+ io__write(Anchor, !IO),
+ io__write_string(" =>\n", !IO),
+ list__map(term__var_to_int, set__to_sorted_list(Vars), VarNums),
+ io__write_string("vars [", !IO),
+ write_int_list(VarNums, !IO),
+ io__write_string("]\nintervals: ", !IO),
+ set__to_sorted_list(Intervals, IntervalList),
+ write_int_list(list__map(interval_id_to_int, IntervalList), !IO),
+ io__write_string("\n", !IO).
:- pred dump_anchor_inserts(pair(anchor, list(insert_spec))::in,
- io__state::di, io__state::uo) is det.
+ io::di, io::uo) is det.
-dump_anchor_inserts(Anchor - InsertSpecs) -->
- io__write_string("\ninsertions after "),
- io__write(Anchor),
- io__write_string(":\n"),
- list__foldl(dump_insert, InsertSpecs).
-
-:- pred dump_insert(insert_spec::in, io__state::di, io__state::uo) is det.
-
-dump_insert(insert_spec(Goal, Vars)) -->
- { list__map(term__var_to_int, set__to_sorted_list(Vars), VarNums) },
- io__write_string("vars ["),
- write_int_list(VarNums),
- io__write_string("]: "),
+dump_anchor_inserts(Anchor - InsertSpecs, !IO) :-
+ io__write_string("\ninsertions after ", !IO),
+ io__write(Anchor, !IO),
+ io__write_string(":\n", !IO),
+ list__foldl(dump_insert, InsertSpecs, !IO).
+
+:- pred dump_insert(insert_spec::in, io::di, io::uo) is det.
+
+dump_insert(insert_spec(Goal, Vars), !IO) :-
+ list__map(term__var_to_int, set__to_sorted_list(Vars), VarNums),
+ io__write_string("vars [", !IO),
+ write_int_list(VarNums, !IO),
+ io__write_string("]: ", !IO),
(
- { Goal = unify(_, _, _, Unification, _) - _ },
- { Unification = deconstruct(CellVar, ConsId, ArgVars, _,_,_) }
+ Goal = unify(_, _, _, Unification, _) - _,
+ Unification = deconstruct(CellVar, ConsId, ArgVars, _,_,_)
->
- { term__var_to_int(CellVar, CellVarNum) },
- io__write_int(CellVarNum),
- io__write_string(" => "),
- mercury_output_cons_id(ConsId, does_not_need_brackets),
- io__write_string("("),
- { list__map(term__var_to_int, ArgVars, ArgVarNums) },
- write_int_list(ArgVarNums),
- io__write_string(")\n")
+ term__var_to_int(CellVar, CellVarNum),
+ io__write_int(CellVarNum, !IO),
+ io__write_string(" => ", !IO),
+ mercury_output_cons_id(ConsId, does_not_need_brackets, !IO),
+ io__write_string("(", !IO),
+ list__map(term__var_to_int, ArgVars, ArgVarNums),
+ write_int_list(ArgVarNums, !IO),
+ io__write_string(")\n", !IO)
;
- io__write_string("BAD INSERT GOAL\n")
+ io__write_string("BAD INSERT GOAL\n", !IO)
).
:- pred dump_matching_result(matching_result::in,
- io__state::di, io__state::uo) is det.
+ io::di, io::uo) is det.
-dump_matching_result(MatchingResult) -->
- { MatchingResult = matching_result(CellVar, ConsId,
+dump_matching_result(MatchingResult, !IO) :-
+ MatchingResult = matching_result(CellVar, ConsId,
ArgVars, ViaCellVars, GoalPath,
PotentialIntervals, InsertIntervals,
- PotentialAnchors, InsertAnchors) },
- io__write_string("\nmatching result at "),
- io__write(GoalPath),
- io__write_string("\n"),
- { term__var_to_int(CellVar, CellVarNum) },
- { list__map(term__var_to_int, ArgVars, ArgVarNums) },
- { list__map(term__var_to_int, set__to_sorted_list(ViaCellVars),
- ViaCellVarNums) },
- io__write_int(CellVarNum),
- io__write_string(" => "),
- mercury_output_cons_id(ConsId, does_not_need_brackets),
- io__write_string("("),
- write_int_list(ArgVarNums),
- io__write_string("): via cell "),
- write_int_list(ViaCellVarNums),
- io__write_string("\n"),
-
- io__write_string("potential intervals: "),
- { PotentialIntervalNums = list__map(interval_id_to_int,
- set__to_sorted_list(PotentialIntervals)) },
- write_int_list(PotentialIntervalNums),
- io__write_string("\n"),
- io__write_string("insert intervals: "),
- { InsertIntervalNums = list__map(interval_id_to_int,
- set__to_sorted_list(InsertIntervals)) },
- write_int_list(InsertIntervalNums),
- io__write_string("\n"),
-
- io__write_string("potential anchors: "),
- io__write_list(set__to_sorted_list(PotentialAnchors), " ", io__write),
- io__write_string("\n"),
- io__write_string("insert anchors: "),
- io__write_list(set__to_sorted_list(InsertAnchors), " ", io__write),
- io__write_string("\n").
+ PotentialAnchors, InsertAnchors),
+ io__write_string("\nmatching result at ", !IO),
+ io__write(GoalPath, !IO),
+ io__write_string("\n", !IO),
+ term__var_to_int(CellVar, CellVarNum),
+ list__map(term__var_to_int, ArgVars, ArgVarNums),
+ list__map(term__var_to_int, set__to_sorted_list(ViaCellVars),
+ ViaCellVarNums),
+ io__write_int(CellVarNum, !IO),
+ io__write_string(" => ", !IO),
+ mercury_output_cons_id(ConsId, does_not_need_brackets, !IO),
+ io__write_string("(", !IO),
+ write_int_list(ArgVarNums, !IO),
+ io__write_string("): via cell ", !IO),
+ write_int_list(ViaCellVarNums, !IO),
+ io__write_string("\n", !IO),
+
+ io__write_string("potential intervals: ", !IO),
+ PotentialIntervalNums = list__map(interval_id_to_int,
+ set__to_sorted_list(PotentialIntervals)),
+ write_int_list(PotentialIntervalNums, !IO),
+ io__write_string("\n", !IO),
+ io__write_string("insert intervals: ", !IO),
+ InsertIntervalNums = list__map(interval_id_to_int,
+ set__to_sorted_list(InsertIntervals)),
+ write_int_list(InsertIntervalNums, !IO),
+ io__write_string("\n", !IO),
+
+ io__write_string("potential anchors: ", !IO),
+ io__write_list(set__to_sorted_list(PotentialAnchors), " ", io__write,
+ !IO),
+ io__write_string("\n", !IO),
+ io__write_string("insert anchors: ", !IO),
+ io__write_list(set__to_sorted_list(InsertAnchors), " ", io__write, !IO),
+ io__write_string("\n", !IO).
-:- pred write_int_list(list(int)::in, io__state::di, io__state::uo) is det.
+:- pred write_int_list(list(int)::in, io::di, io::uo) is det.
-write_int_list(List) --> io__write_list(List, ", ", io__write_int).
+write_int_list(List, !IO) :-
+ io__write_list(List, ", ", io__write_int, !IO).
:- func interval_id_to_int(interval_id) = int.
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list