[m-rev.] diff/for review: last call modulo construction
Zoltan Somogyi
zs at cs.mu.OZ.AU
Mon Sep 12 14:50:08 AEST 2005
We have been missing this optimization for a long time. Now we ought to
get significantly better results on some standard benchmarks such as
naive reverse. However, the impact on the compiler performance in general
is not as good. My preliminary benchmarking shows that the new optimization
gives a 2% speedup at -O2, but slowdowns at higher optimization levels.
This must be due to an unfavourable interaction with some other optimization.
I will look into this later.
EXTRA_MCFLAGS = -O2
mercury_compile.01 average of 6 with ignore=1 41.82
EXTRA_MCFLAGS = -O2 --optimize-constructor-last-call
mercury_compile.02 average of 6 with ignore=1 41.05
EXTRA_MCFLAGS = -O3
mercury_compile.03 average of 6 with ignore=1 39.95
EXTRA_MCFLAGS = -O3 --optimize-constructor-last-call
mercury_compile.04 average of 6 with ignore=1 42.14
EXTRA_MCFLAGS = -O4
mercury_compile.05 average of 6 with ignore=1 39.57
EXTRA_MCFLAGS = -O4 --optimize-constructor-last-call
mercury_compile.06 average of 6 with ignore=1 39.92
EXTRA_MCFLAGS = -O5
mercury_compile.07 average of 6 with ignore=1 39.23
EXTRA_MCFLAGS = -O5 --optimize-constructor-last-call
mercury_compile.08 average of 6 with ignore=1 40.22
Zoltan.
Optimize calls that would be tail calls in Prolog but are followed by
construction unifications in Mercury: last call modulo construction.
For now, the optimization is available only for the LLDS backend.
compiler/lco.m:
Turn this module from a placeholder to a real implementation
of the optimization.
compiler/hlds_goal.m:
Allow lco.m to attach to construction unifications a note that says
that certain arguments, instead of being filled in by the unification,
should have their addresses taken and stored in the corresponding
variables.
Group this note together with the note that asks for term size
profiling to avoid an increase in the sizes of goals in the compiler
in most cases.
compiler/hlds_pred.m:
Provide a predicate for setting the name of a predicate after its
creation. This functionality is used by lco.m.
Extend the pred_transformation part of the pred_origin type to allow
it to express that a procedure was created by lco.m.
List the new primitive store_at_ref as a no-typeinfo builtin.
Fix some problems with indentation.
compiler/layout_out.m:
Handle the new pred_transformation.
compiler/unify_gen.m:
When processing construction unifications that have the new feaure
turned on, perform the requested action.
Fix some departures from coding style. Shorten lines by deleting
unnecessary module qualifications. Add some auxiliary predicates
to make the code easier to read.
compiler/var_locn.m:
Fix an earlier oversight: when materializing variables inside rvals
and lvals, look inside memory references too. Previously, the omission
didn't matter, since we didn't generate such references, but now we do.
Fix some departures from coding style.
compiler/llds_out.m:
Fix some old XXXs in code handling memory references. We didn't use to
generate such references, but now we do.
Move some functionality here from code_aux.m.
compiler/code_info.m:
Provide some primitive operations needed by the new code in var_locn.m.
Delete an unneeded predicate.
compiler/options.m:
Rename the existing option optimize_constructor_last_call as
optimize_constructor_last_call_accumulator, since that optimization
is done by accumulator.m.
Make optimize_constructor_last_call be the option that calls for the
new optimization.
compiler/handle_options.m:
Handle the implications of the new option.
compiler/mercury_compile.m:
Invoke the lco module by its new interface.
librrary/private_builtin.m:
Add a new primitive operation, store_at_ref, for use by the new
optimization.
Switch the module to four-space indentation.
compiler/add_clause.m:
Comment out the warning for clauses for builtin, since this is needed
to bootstrap the addition of the new builtin.
compiler/term_constr_initial.m:
Handle the new builtin.
compiler/accumulator.m:
Conform to the change in options.
compiler/builtin_ops.m:
Provide a third template for builtins, for use by store_at_ref.
Convert the file to four-space indentation.
compiler/call_gen.m:
Generate code following the new builtin template.
compiler/rl_exprn.m:
Minor changes to conform to the changes in builtin templates.
compiler/quantification.m:
Minor changes to conform to the changes in construct unifications.
Don't make the "get" predicates operating on quantification_infos
to return the "new" quantification_info: it is always the same
as the old one.
compiler/aditi_builtin_ops.m:
compiler/common.m:
compiler/deep_profiling.m:
compiler/higher_order.m:
compiler/hlds_out.m:
compiler/lambda.m:
compiler/magic_util.m:
compiler/ml_unify_gen.m:
compiler/modecheck_unify.m:
compiler/polymorphism.m:
compiler/size_prof.m:
Minor changes to conform to the changes in construct unifications.
compiler/dependency_graph.m:
Add a new predicate to recompute the dependency information,
even if a previous (and possibly now inaccurate) version is present.
Change the interface to make it clearer, by changing bools into types
specific to the situation.
Convert the file to four-space indentation.
compiler/mode_constraints.m:
Minor changes to conform to the changes in dependency_graph.m.
compiler/code_aux.m:
Delete this module. Half its functionality has been moved into
llds_out.m, half to middle_rec.m (its only user).
compiler/goal_form.m:
Move the predicates in this module that are used only by middle_rec.m
to middle_rec.m.
Convert the file to four-space indentation.
compiler/goal_util.m:
compiler/det_util.m:
Move update_instmap from det_util to goal_util, since it is usefulness
extends beyond determinism analysis.
Convert det_util.m to four-space indentation.
compiler/middle_rec.m:
Move here the code required only here from code_aux and goal_form.
Update the moved code for the changes in construct unifications.
The updates are specific to middle_rec.m: they wouldn't be of use
to other modules. They basically say that any code that takes the
addresses of fields cannot be handled by middle_rec.m.
compiler/code_gen.m:
compiler/det_analysis.m:
compiler/live_vars.m:
compiler/ll_backend.m:
compiler/loop_inv.m:
compiler/switch_detection.m:
compiler/switch_gen.m:
compiler/notes/compiler_design.html:
Minor changes to conform to the deletion of code_aux.m and/or the
movement of code from det_util to goal_util.m.
compiler/opt_debug.m:
Print info for vars in rvals.
compiler/hlds_module.m:
Convert a lambda to an explicit predicate to make some code easier to
read.
Switch the module to four-space indentation.
cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/accumulator.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/accumulator.m,v
retrieving revision 1.40
diff -u -b -r1.40 accumulator.m
--- compiler/accumulator.m 30 Aug 2005 04:11:45 -0000 1.40
+++ compiler/accumulator.m 6 Sep 2005 03:18:28 -0000
@@ -225,7 +225,8 @@
% Attempt to transform a procedure into accumulator recursive form.
%
process_proc(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO) :-
- globals__io_lookup_bool_option(optimize_constructor_last_call, DoLCO, !IO),
+ globals__io_lookup_bool_option(optimize_constructor_last_call_accumulator,
+ DoLCO, !IO),
globals__io_lookup_bool_option(fully_strict, FullyStrict, !IO),
(
module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
Index: compiler/add_clause.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_clause.m,v
retrieving revision 1.5
diff -u -b -r1.5 add_clause.m
--- compiler/add_clause.m 30 Aug 2005 04:11:45 -0000 1.5
+++ compiler/add_clause.m 6 Sep 2005 15:24:02 -0000
@@ -217,8 +217,11 @@
% easier when redefining builtins to use normal Mercury code.
pred_info_is_builtin(!.PredInfo)
->
- prog_out__write_context(Context, !IO),
- report_warning("Warning: clause for builtin.\n", !IO)
+ % prog_out__write_context(Context, !IO),
+ % report_warning("Warning: clause for builtin.\n", !IO)
+ % The above code is commented out while store_at_ref is
+ % bootstrapped.
+ true
;
pred_info_clauses_info(!.PredInfo, Clauses0),
pred_info_typevarset(!.PredInfo, TVarSet0),
Index: compiler/aditi_builtin_ops.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/aditi_builtin_ops.m,v
retrieving revision 1.16
diff -u -b -r1.16 aditi_builtin_ops.m
--- compiler/aditi_builtin_ops.m 12 Aug 2005 05:14:08 -0000 1.16
+++ compiler/aditi_builtin_ops.m 6 Sep 2005 02:52:21 -0000
@@ -236,8 +236,8 @@
proc(BuiltinPredId, BuiltinProcId)) },
{ BuiltinConsId = pred_const(ShroudedPredProcId, normal) },
{ Unification = construct(NewVar, BuiltinConsId, BuiltinArgs,
- UniModes, construct_dynamically,
- cell_is_unique, no) },
+ UniModes, construct_dynamically, cell_is_unique,
+ no_construct_sub_info) },
{ set__list_to_set([NewVar | BuiltinArgs], NonLocals) },
{ instmap_delta_from_assoc_list([NewVar - ground_inst],
InstMapDelta) },
Index: compiler/builtin_ops.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/builtin_ops.m,v
retrieving revision 1.16
diff -u -b -r1.16 builtin_ops.m
--- compiler/builtin_ops.m 19 Jan 2005 03:10:28 -0000 1.16
+++ compiler/builtin_ops.m 6 Sep 2005 14:10:42 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 1999-2001, 2003-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -94,11 +96,11 @@
% translate_builtin:
%
- % Given a module name, a predicate name, a proc_id and a list of
- % the arguments, find out if that procedure of that predicate
- % is an inline builtin. If so, return code which can be used
- % to evaluate that call: either an assignment (if the builtin is det)
- % or a test (if the builtin is semidet).
+ % Given a module name, a predicate name, a proc_id and a list of the
+ % arguments, find out if that procedure of that predicate is an inline
+ % builtin. If so, return code which can be used to evaluate that call:
+ % either an assignment (if the builtin is det) or a test (if the builtin
+ % is semidet).
%
% There are some further guarantees on the form of the expressions
% in the code returned -- see below for details.
@@ -109,6 +111,7 @@
:- type simple_code(T)
---> assign(T, simple_expr(T))
+ ; ref_assign(T, T)
; test(simple_expr(T)).
:- type simple_expr(T)
@@ -127,6 +130,7 @@
:- inst simple_code
---> assign(ground, simple_assign_expr)
+ ; ref_assign(ground, ground)
; test(simple_test_expr).
:- inst simple_arg_expr
@@ -160,10 +164,13 @@
:- pred builtin_translation(string::in, string::in, int::in, list(T)::in,
simple_code(T)::out) is semidet.
- % Note that the code we generate for unsafe_type_cast is not
- % type-correct. Back-ends that require type-correct intermediate
- % code (e.g. the MLDS back-end) must handle unsafe_type_cast
- % separately, rather than by calling builtin_translation.
+builtin_translation("private_builtin", "store_at_ref", 0, [X, Y],
+ ref_assign(X, Y)).
+
+ % Note that the code we generate for unsafe_type_cast is not type-correct.
+ % Back-ends that require type-correct intermediate code (e.g. the MLDS
+ % back-end) must handle unsafe_type_cast separately, rather than by calling
+ % builtin_translation.
builtin_translation("private_builtin", "unsafe_type_cast", 0, [X, Y],
assign(Y, leaf(X))).
builtin_translation("builtin", "unsafe_promise_unique", 0, [X, Y],
Index: compiler/bytecode_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/bytecode_gen.m,v
retrieving revision 1.89
diff -u -b -r1.89 bytecode_gen.m
--- compiler/bytecode_gen.m 24 Mar 2005 05:33:58 -0000 1.89
+++ compiler/bytecode_gen.m 6 Sep 2005 14:24:07 -0000
@@ -409,8 +409,10 @@
bytecode_gen__map_test(ByteInfo, Test, Code)
;
SimpleCode = assign(Var, Expr),
- bytecode_gen__map_assign(ByteInfo, Var, Expr,
- Code)
+ bytecode_gen__map_assign(ByteInfo, Var, Expr, Code)
+ ;
+ SimpleCode = ref_assign(_Var, _Expr),
+ unexpected(this_file, "ref_assign")
)
;
string__append("unknown builtin predicate ", PredName, Msg),
Index: compiler/call_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/call_gen.m,v
retrieving revision 1.165
diff -u -b -r1.165 call_gen.m
--- compiler/call_gen.m 29 Aug 2005 15:44:18 -0000 1.165
+++ compiler/call_gen.m 6 Sep 2005 14:17:42 -0000
@@ -523,31 +523,43 @@
SimpleCode = SimpleCode0
;
length(Args, Arity),
- format("Unknown builtin predicate: %s/%d",
+ format("unknown builtin predicate: %s/%d",
[s(PredName), i(Arity)], Msg),
- error(Msg)
+ unexpected(this_file, Msg)
),
(
CodeModel = model_det,
- ( SimpleCode = assign(Var, AssignExpr) ->
- call_gen__generate_assign_builtin(Var,
- AssignExpr, Code, !CI)
+ (
+ SimpleCode = assign(Var, AssignExpr),
+ call_gen__generate_assign_builtin(Var, AssignExpr, Code, !CI)
+ ;
+ SimpleCode = ref_assign(AddrVar, ValueVar),
+ produce_variable(AddrVar, AddrVarCode, AddrRval, !CI),
+ produce_variable(ValueVar, ValueVarCode, ValueRval, !CI),
+ StoreCode = node([assign(mem_ref(AddrRval), ValueRval) - ""]),
+ Code = tree_list([AddrVarCode, ValueVarCode, StoreCode])
;
- error("Malformed det builtin predicate")
+ SimpleCode = test(_),
+ unexpected(this_file, "malformed det builtin predicate")
)
;
CodeModel = model_semi,
- ( SimpleCode = test(TestExpr) ->
+ (
+ SimpleCode = test(TestExpr),
call_gen__generate_simple_test(TestExpr, Rval,
ArgCode, !CI),
code_info__fail_if_rval_is_false(Rval, TestCode, !CI),
Code = tree(ArgCode, TestCode)
;
- error("Malformed semi builtin predicate")
+ SimpleCode = assign(_, _),
+ unexpected(this_file, "malformed semi builtin predicate")
+ ;
+ SimpleCode = ref_assign(_, _),
+ unexpected(this_file, "malformed semi builtin predicate")
)
;
CodeModel = model_non,
- error("Nondet builtin predicate")
+ unexpected(this_file, "nondet builtin predicate")
).
:- pred call_gen__generate_assign_builtin(prog_var::in,
Index: compiler/code_aux.m
===================================================================
RCS file: compiler/code_aux.m
diff -N compiler/code_aux.m
--- compiler/code_aux.m 24 Mar 2005 02:00:16 -0000 1.69
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,118 +0,0 @@
-%-----------------------------------------------------------------------------%
-% Copyright (C) 1994-2005 The University of Melbourne.
-% This file may only be copied under the terms of the GNU General
-% Public License - see the file COPYING in the Mercury distribution.
-%---------------------------------------------------------------------------%
-%
-% Auxiliary code generator module. Unlike code_util, it imports code_info.
-%
-% Main authors: conway, zs.
-%
-%---------------------------------------------------------------------------%
-%---------------------------------------------------------------------------%
-
-:- module ll_backend__code_aux.
-
-:- interface.
-
-:- import_module hlds__hlds_goal.
-:- import_module hlds__hlds_llds.
-:- import_module ll_backend__code_info.
-:- import_module parse_tree__prog_data.
-
-:- import_module bool.
-
- % code_aux__contains_simple_recursive_call(G, CI, Last) succeeds
- % if G is a conjunction of goals, exactly one of which is a recursive
- % call (CI says what the current procedure is), and there are no
- % other goals that cause control to leave this procedure. Last is
- % set dependening on whether the recursive call is last in the
- % conjunction or not.
-
- % XXX should avoid the dependency on code_info here
-:- pred code_aux__contains_simple_recursive_call(hlds_goal::in, code_info::in,
- bool::out) is semidet.
-
-:- pred code_aux__explain_stack_slots(stack_slots::in, prog_varset::in,
- string::out) is det.
-
-%---------------------------------------------------------------------------%
-
-:- implementation.
-
-:- import_module hlds__goal_form.
-:- import_module ll_backend__llds.
-:- import_module ll_backend__llds_out.
-
-:- import_module assoc_list.
-:- import_module list.
-:- import_module map.
-:- import_module std_util.
-:- import_module string.
-:- import_module varset.
-
-%-----------------------------------------------------------------------------%
-
-code_aux__contains_simple_recursive_call(Goal - _, CodeInfo, Last) :-
- Goal = conj(Goals),
- code_aux__contains_simple_recursive_call_expr(Goals, CodeInfo, Last).
-
-:- pred code_aux__contains_simple_recursive_call_expr(list(hlds_goal)::in,
- code_info::in, bool::out) is semidet.
-
-code_aux__contains_simple_recursive_call_expr([Goal|Goals], CodeInfo, Last) :-
- Goal = GoalExpr - _,
- ( contains_only_builtins_expr(GoalExpr) ->
- code_aux__contains_simple_recursive_call_expr(Goals, CodeInfo,
- Last)
- ;
- code_aux__is_recursive_call(GoalExpr, CodeInfo),
- (
- Goals = [],
- Last = yes
- ;
- Goals = [_ | _],
- contains_only_builtins_list(Goals),
- Last = no
- )
- ).
-
-:- pred code_aux__is_recursive_call(hlds_goal_expr::in, code_info::in)
- is semidet.
-
-code_aux__is_recursive_call(Goal, CodeInfo) :-
- Goal = call(CallPredId, CallProcId, _, BuiltinState, _, _),
- BuiltinState = not_builtin,
- code_info__get_pred_id(CodeInfo, PredId),
- PredId = CallPredId,
- code_info__get_proc_id(CodeInfo, ProcId),
- ProcId = CallProcId.
-
-%-----------------------------------------------------------------------------%
-
-code_aux__explain_stack_slots(StackSlots, VarSet, Explanation) :-
- map__to_assoc_list(StackSlots, StackSlotsList),
- code_aux__explain_stack_slots_2(StackSlotsList, VarSet, "",
- Explanation1),
- string__append("\nStack slot assignments (if any):\n", Explanation1,
- Explanation).
-
-:- pred code_aux__explain_stack_slots_2(assoc_list(prog_var, stack_slot)::in,
- prog_varset::in, string::in, string::out) is det.
-
-code_aux__explain_stack_slots_2([], _, !Explanation).
-code_aux__explain_stack_slots_2([Var - Slot | Rest], VarSet, !Explanation) :-
- code_aux__explain_stack_slots_2(Rest, VarSet, !Explanation),
- (
- Slot = det_slot(SlotNum),
- StackStr = "stackvar"
- ;
- Slot = nondet_slot(SlotNum),
- StackStr = "framevar"
- ),
- int_to_string(SlotNum, SlotStr),
- varset__lookup_name(VarSet, Var, VarName),
- string__append_list([VarName, "\t ->\t", StackStr, SlotStr, "\n",
- !.Explanation], !:Explanation).
-
-%---------------------------------------------------------------------------%
Index: compiler/code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/code_gen.m,v
retrieving revision 1.139
diff -u -b -r1.139 code_gen.m
--- compiler/code_gen.m 7 Sep 2005 06:51:50 -0000 1.139
+++ compiler/code_gen.m 7 Sep 2005 10:53:32 -0000
@@ -88,7 +88,6 @@
% LLDS code generator modules.
:- import_module ll_backend__call_gen.
-:- import_module ll_backend__code_aux.
:- import_module ll_backend__code_util.
:- import_module ll_backend__commit_gen.
:- import_module ll_backend__continuation_info.
@@ -754,7 +753,7 @@
EntryCode) :-
code_info__get_stack_slots(CI, StackSlots),
code_info__get_varset(CI, VarSet),
- code_aux__explain_stack_slots(StackSlots, VarSet, SlotsComment),
+ SlotsComment = explain_stack_slots(StackSlots, VarSet),
StartComment = node([
comment("Start of procedure prologue") - "",
comment(SlotsComment) - ""
Index: compiler/code_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/code_info.m,v
retrieving revision 1.303
diff -u -b -r1.303 code_info.m
--- compiler/code_info.m 7 Sep 2005 06:51:51 -0000 1.303
+++ compiler/code_info.m 7 Sep 2005 14:22:51 -0000
@@ -3112,7 +3112,7 @@
code_info::in, code_info::out) is det.
% code_info__assign_cell_to_var(Var, ReserveWordAtStart, Ptag, Vector,
- % Size, TypeMsg, Code, !CI).
+ % MaybeSize, TypeMsg, Where, Code, !CI).
%
:- pred code_info__assign_cell_to_var(prog_var::in, bool::in, tag::in,
list(maybe(rval))::in, maybe(term_size_value)::in, string::in,
@@ -3130,7 +3130,7 @@
:- pred code_info__produce_variable_in_reg_or_stack(prog_var::in,
code_tree::out, lval::out, code_info::in, code_info::out) is det.
-:- pred code_info__materialize_vars_in_rval(rval::in, rval::out,
+:- pred code_info__materialize_vars_in_lval(lval::in, lval::out,
code_tree::out, code_info::in, code_info::out) is det.
:- pred code_info__acquire_reg_for_var(prog_var::in, lval::out,
@@ -3250,12 +3250,12 @@
),
code_info__set_var_locn_info(VarLocnInfo, !CI).
-code_info__assign_cell_to_var(Var, ReserveWordAtStart, Ptag, Vector, Size,
+code_info__assign_cell_to_var(Var, ReserveWordAtStart, Ptag, Vector, MaybeSize,
TypeMsg, Code, !CI) :-
code_info__get_var_locn_info(!.CI, VarLocnInfo0),
code_info__get_static_cell_info(!.CI, StaticCellInfo0),
var_locn__assign_cell_to_var(Var, ReserveWordAtStart, Ptag, Vector,
- Size, TypeMsg, Code, StaticCellInfo0, StaticCellInfo,
+ MaybeSize, TypeMsg, Code, StaticCellInfo0, StaticCellInfo,
VarLocnInfo0, VarLocnInfo),
code_info__set_static_cell_info(StaticCellInfo, !CI),
code_info__set_var_locn_info(VarLocnInfo, !CI).
@@ -3313,19 +3313,10 @@
VarLocnInfo0, VarLocnInfo),
code_info__set_var_locn_info(VarLocnInfo, !CI).
-code_info__materialize_vars_in_rval(Rval0, Rval, Code, !CI) :-
+code_info__materialize_vars_in_lval(Lval0, Lval, Code, !CI) :-
code_info__get_var_locn_info(!.CI, VarLocnInfo0),
- ( Rval0 = lval(Lval0) ->
var_locn__materialize_vars_in_lval(Lval0, Lval, Code,
VarLocnInfo0, VarLocnInfo),
- Rval = lval(Lval)
- ; exprn_aux__vars_in_rval(Rval0, []) ->
- Rval = Rval0,
- Code = empty,
- VarLocnInfo = VarLocnInfo0
- ;
- error("code_info__materialize_vars_in_rval")
- ),
code_info__set_var_locn_info(VarLocnInfo, !CI).
code_info__acquire_reg_for_var(Var, Lval, !CI) :-
Index: compiler/common.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/common.m,v
retrieving revision 1.81
diff -u -b -r1.81 common.m
--- compiler/common.m 27 Aug 2005 09:41:54 -0000 1.81
+++ compiler/common.m 6 Sep 2005 03:09:24 -0000
@@ -235,9 +235,17 @@
common__optimise_unification(Unification0, _Left0, _Right0, Mode, _Context,
Goal0, Goal, GoalInfo0, GoalInfo, !Info) :-
(
- Unification0 = construct(Var, ConsId, ArgVars, _, _, _, _),
+ Unification0 = construct(Var, ConsId, ArgVars, _, _, _, SubInfo),
+ (
+ SubInfo = construct_sub_info(MaybeTakeAddr, _),
+ MaybeTakeAddr = yes(_)
+ ->
+ Goal = Goal0,
+ GoalInfo = GoalInfo0
+ ;
common__optimise_construct(Var, ConsId, ArgVars, Mode,
Goal0, Goal, GoalInfo0, GoalInfo, !Info)
+ )
;
Unification0 = deconstruct(Var, ConsId, ArgVars, UniModes, CanFail, _),
common__optimise_deconstruct(Var, ConsId, ArgVars, UniModes, CanFail,
Index: compiler/deep_profiling.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/deep_profiling.m,v
retrieving revision 1.35
diff -u -b -r1.35 deep_profiling.m
--- compiler/deep_profiling.m 30 Aug 2005 04:11:48 -0000 1.35
+++ compiler/deep_profiling.m 6 Sep 2005 14:34:17 -0000
@@ -196,8 +196,7 @@
Goal = Goal0,
Continue = no
;
- GoalExpr0 = call(PredId, ProcId, Args,
- Builtin, UnifyContext, SymName),
+ GoalExpr0 = call(PredId, ProcId, Args, Builtin, UnifyContext, SymName),
(
PredProcId = proc(PredId, ProcId),
assoc_list__search(ApplyInfo ^ scc_ppids, PredProcId,
@@ -1657,7 +1656,7 @@
Goal = unify(Var, functor(ConsId, no, []),
(free -> Ground) - (Ground -> Ground),
construct(Var, ConsId, [], [], construct_statically([]),
- cell_is_shared, no),
+ cell_is_shared, no_construct_sub_info),
unify_context(explicit, [])) - GoalInfo.
:- pred generate_cell_unify(int::in, cons_id::in, list(prog_var)::in,
@@ -1674,7 +1673,7 @@
Goal = unify(Var, functor(ConsId, no, Args),
(free -> Ground) - (Ground -> Ground),
construct(Var, ConsId, Args, ArgModes,
- construct_statically([]), cell_is_shared, no),
+ construct_statically([]), cell_is_shared, no_construct_sub_info),
unify_context(explicit, [])) - GoalInfo.
%-----------------------------------------------------------------------------%
Index: compiler/dependency_graph.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dependency_graph.m,v
retrieving revision 1.78
diff -u -b -r1.78 dependency_graph.m
--- compiler/dependency_graph.m 8 Jul 2005 04:22:01 -0000 1.78
+++ compiler/dependency_graph.m 6 Sep 2005 03:01:29 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 1995-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -24,36 +26,50 @@
:- import_module hlds__hlds_module.
:- import_module hlds__hlds_pred.
-:- import_module bool.
:- import_module io.
:- import_module list.
- % Ensure that the module_info contains a version of the
- % dependency_info which only contains arcs between procedures
- % for which there are clauses defined (ie not imported except
- % for opt_imported).
+ % Ensure that the module_info contains a version of the dependency_info
+ % which only contains arcs between procedures for which there are clauses
+ % defined (everything that is not imported, plus opt_imported). There is
+ % no guarantee that the dependency_info is current.
%
:- pred module_info_ensure_dependency_info(module_info::in, module_info::out)
is det.
- % Build the dependency graph, if the bool is yes then
- % imported procedures are included in the dependency graph,
- % otherwise they aren't.
+ % Ensure that the module_info contains a version of the dependency_info
+ % which only contains arcs between procedures for which there are clauses
+ % defined (everything that is not imported, plus opt_imported). The
+ % dependency_info will be up-to-date.
+ %
+:- pred module_info_rebuild_dependency_info(module_info::in, module_info::out,
+ dependency_info(pred_proc_id)::out) is det.
+
+:- type include_imported
+ ---> include_imported
+ ; do_not_include_imported.
+
+ % Build the dependency graph of procedures.
%
:- pred dependency_graph__build_pred_dependency_graph(module_info::in,
- bool::in, dependency_info(pred_id)::out) is det.
+ include_imported::in, dependency_info(pred_id)::out) is det.
+
+ % Build the dependency graph of predicates.
+ %
+:- pred dependency_graph__build_proc_dependency_graph(module_info::in,
+ include_imported::in, dependency_info(pred_proc_id)::out) is det.
- % Output a form of the static call graph to a file, in a format
- % suitable for use in .dependency_info files. After the heading,
- % the format of each line is
+ % Output a form of the static call graph to a file, in a format suitable
+ % for use in .dependency_info files. After the heading, the format of
+ % each line is
%
% CallerModeDecl \t CalleeModeDecl
%
:- pred dependency_graph__write_dependency_graph(module_info::in,
module_info::out, io::di, io::uo) is det.
- % Output a form of the static call graph to a file for use by the
- % profiler. There is no heading, and the format of each line is
+ % Output a form of the static call graph to a file for use by the profiler.
+ % There is no heading, and the format of each line is
%
% CallerLabel \t CalleeLabel
%
@@ -66,27 +82,25 @@
% called from outside the SCC.
%
:- pred dependency_graph__get_scc_entry_points(list(pred_proc_id)::in,
- dependency_ordering::in, module_info::in, list(pred_proc_id)::out)
- is det.
+ dependency_ordering::in, module_info::in, list(pred_proc_id)::out) is det.
- % Create the Aditi dependency ordering. This contains all the Aditi
- % SCCs in the original program. The difference is that SCCs which
- % are only called from one other SCC and are not called through
- % negation or aggregation are merged into the parent SCC. This makes
- % the low-level RL optimizations more effective while maintaining
- % stratification.
- % dead_proc_elim.m should be be run before this is called
- % to avoid missing some opportunities for merging where
- % a procedure is called from a dead procedure.
+ % Create the Aditi dependency ordering. This contains all the Aditi SCCs
+ % in the original program. The difference is that SCCs which are only
+ % called from one other SCC and are not called through negation or
+ % aggregation are merged into the parent SCC. This makes the low-level
+ % RL optimizations more effective while maintaining stratification.
+ %
+ % dead_proc_elim.m should be be run before this is called to avoid missing
+ % some opportunities for merging where a procedure is called from a dead
+ % procedure.
%
:- pred module_info_ensure_aditi_dependency_info(module_info::in,
module_info::out) is det.
% write_graph(Graph, WriteNode, WriteEdge)
%
- % Write out the dependency graph using WriteNode to decide what
- % to output for a node in the dependency graph and WriteEdge for
- % an edge.
+ % Write out the dependency graph using WriteNode to decide what to output
+ % for a node in the dependency graph and WriteEdge for an edge.
%
:- pred dependency_graph__write_graph(dependency_info::in,
pred(pred_proc_id, io, io)::pred(in, di, uo) is det,
@@ -99,8 +113,7 @@
% any edges originating in Nodes, using WriteEdge.
%
:- pred dependency_graph__write_graph_nodes(list(pred_proc_id)::in,
- dependency_graph::in,
- pred(pred_proc_id, io, io)::pred(in, di, uo) is det,
+ dependency_graph::in, pred(pred_proc_id, io, io)::pred(in, di, uo) is det,
pred(pred_proc_id, pred_proc_id, io, io)::pred(in, in, di, uo) is det,
io::di, io::uo) is det.
@@ -145,20 +158,28 @@
MaybeDepInfo = yes(_)
;
MaybeDepInfo = no,
- dependency_graph__build_dependency_graph(!.ModuleInfo, no,
- DepInfo),
+ dependency_graph__build_dependency_graph(!.ModuleInfo,
+ do_not_include_imported, DepInfo),
module_info_set_dependency_info(DepInfo, !ModuleInfo)
).
+module_info_rebuild_dependency_info(!ModuleInfo, DepInfo) :-
+ dependency_graph__build_dependency_graph(!.ModuleInfo,
+ do_not_include_imported, DepInfo),
+ module_info_set_dependency_info(DepInfo, !ModuleInfo).
+
+dependency_graph__build_proc_dependency_graph(ModuleInfo, Imported, DepInfo) :-
+ dependency_graph__build_dependency_graph(ModuleInfo, Imported, DepInfo).
+
dependency_graph__build_pred_dependency_graph(ModuleInfo, Imported, DepInfo) :-
- dependency_graph__build_dependency_graph(ModuleInfo, Imported,
- DepInfo).
+ dependency_graph__build_dependency_graph(ModuleInfo, Imported, DepInfo).
% Traverse the module structure, calling `dependency_graph__add_arcs'
% for each procedure body.
-
-:- pred dependency_graph__build_dependency_graph(module_info::in, bool::in,
- dependency_info(T)::out) is det <= dependency_node(T).
+ %
+:- pred dependency_graph__build_dependency_graph(module_info::in,
+ include_imported::in, dependency_info(T)::out) is det
+ <= dependency_node(T).
dependency_graph__build_dependency_graph(ModuleInfo, Imported, !:DepInfo) :-
module_info_predids(ModuleInfo, PredIds),
@@ -186,12 +207,12 @@
:- typeclass dependency_node(T) where [
pred dependency_graph__add_nodes(list(pred_id)::in, module_info::in,
- bool::in, dependency_graph(T)::in, dependency_graph(T)::out)
- is det,
+ include_imported::in,
+ dependency_graph(T)::in, dependency_graph(T)::out) is det,
pred dependency_graph__add_arcs(list(pred_id)::in, module_info::in,
- bool::in, dependency_graph(T)::in, dependency_graph(T)::out)
- is det,
+ include_imported::in,
+ dependency_graph(T)::in, dependency_graph(T)::out) is det,
func dependency_node(pred_proc_id) = T
].
@@ -216,7 +237,7 @@
%-----------------------------------------------------------------------------%
:- pred dependency_graph__add_pred_proc_nodes(list(pred_id)::in,
- module_info::in, bool::in,
+ module_info::in, include_imported::in,
dependency_graph::in, dependency_graph::out) is det.
dependency_graph__add_pred_proc_nodes([], _ModuleInfo, _, !DepGraph).
@@ -225,17 +246,15 @@
module_info_preds(ModuleInfo, PredTable),
map__lookup(PredTable, PredId, PredInfo),
(
- % Don't bother adding nodes (or arcs) for procedures
- % which are imported (i.e. which we don't have any
- % `clauses' for).
- Imported = no,
+ % Don't bother adding nodes (or arcs) for procedures which are imported
+ % (i.e. which we don't have any `clauses' for).
+ Imported = do_not_include_imported,
ProcIds = pred_info_non_imported_procids(PredInfo)
;
- Imported = yes,
+ Imported = include_imported,
ProcIds = pred_info_procids(PredInfo)
),
- dependency_graph__add_proc_nodes(ProcIds, PredId, ModuleInfo,
- !DepGraph),
+ dependency_graph__add_proc_nodes(ProcIds, PredId, ModuleInfo, !DepGraph),
dependency_graph__add_pred_proc_nodes(PredIds, ModuleInfo, Imported,
!DepGraph).
@@ -246,13 +265,12 @@
dependency_graph__add_proc_nodes([ProcId | ProcIds], PredId, ModuleInfo,
!DepGraph) :-
relation__add_element(!.DepGraph, proc(PredId, ProcId), _, !:DepGraph),
- dependency_graph__add_proc_nodes(ProcIds, PredId, ModuleInfo,
- !DepGraph).
+ dependency_graph__add_proc_nodes(ProcIds, PredId, ModuleInfo, !DepGraph).
%-----------------------------------------------------------------------------%
:- pred dependency_graph__add_pred_nodes(list(pred_id)::in, module_info::in,
- bool::in,
+ include_imported::in,
dependency_graph(pred_id)::in, dependency_graph(pred_id)::out) is det.
dependency_graph__add_pred_nodes([], _ModuleInfo, _, DepGraph, DepGraph).
@@ -263,7 +281,7 @@
% Don't bother adding nodes (or arcs) for predicates
% which are imported (i.e. which we don't have any `clauses' for).
(
- IncludeImported = no,
+ IncludeImported = do_not_include_imported,
pred_info_is_imported(PredInfo)
->
true
@@ -277,7 +295,7 @@
%-----------------------------------------------------------------------------%
:- pred dependency_graph__add_pred_proc_arcs(list(pred_id)::in,
- module_info::in, bool::in,
+ module_info::in, include_imported::in,
dependency_graph::in, dependency_graph::out) is det.
dependency_graph__add_pred_proc_arcs([], _ModuleInfo, _, !DepGraph).
@@ -286,13 +304,12 @@
module_info_preds(ModuleInfo, PredTable),
map__lookup(PredTable, PredId, PredInfo),
(
- % Don't bother adding nodes (or arcs) for procedures
- % which are imported (i.e. which we don't have any
- % `clauses' for).
- Imported = no,
+ % Don't bother adding nodes (or arcs) for procedures which are imported
+ % (i.e. which we don't have any `clauses' for).
+ Imported = do_not_include_imported,
ProcIds = pred_info_non_imported_procids(PredInfo)
;
- Imported = yes,
+ Imported = include_imported,
ProcIds = pred_info_procids(PredInfo)
),
dependency_graph__add_proc_arcs(ProcIds, PredId, ModuleInfo, Imported,
@@ -301,7 +318,7 @@
!DepGraph).
:- pred dependency_graph__add_proc_arcs(list(proc_id)::in, pred_id::in,
- module_info::in, bool::in,
+ module_info::in, include_imported::in,
dependency_graph::in, dependency_graph::out) is det.
dependency_graph__add_proc_arcs([], _PredId, _ModuleInfo, _, !DepGraph).
@@ -312,14 +329,13 @@
pred_info_procedures(PredInfo0, ProcTable0),
map__lookup(ProcTable0, ProcId, ProcInfo0),
(
- IncludeImported = no,
+ IncludeImported = do_not_include_imported,
proc_info_goal(ProcInfo0, Goal),
- relation__lookup_element(!.DepGraph, proc(PredId, ProcId),
- Caller),
+ relation__lookup_element(!.DepGraph, proc(PredId, ProcId), Caller),
dependency_graph__add_arcs_in_goal(Goal, Caller, !DepGraph)
;
- IncludeImported = yes,
+ IncludeImported = include_imported,
pred_info_import_status(PredInfo0, ImportStatus),
status_is_imported(ImportStatus, Imported),
(
@@ -327,10 +343,8 @@
;
Imported = no,
proc_info_goal(ProcInfo0, Goal),
- relation__lookup_element(!.DepGraph,
- proc(PredId, ProcId), Caller),
- dependency_graph__add_arcs_in_goal(Goal, Caller,
- !DepGraph)
+ relation__lookup_element(!.DepGraph, proc(PredId, ProcId), Caller),
+ dependency_graph__add_arcs_in_goal(Goal, Caller, !DepGraph)
)
),
dependency_graph__add_proc_arcs(ProcIds, PredId, ModuleInfo,
@@ -339,7 +353,7 @@
%-----------------------------------------------------------------------------%
:- pred dependency_graph__add_pred_arcs(list(pred_id)::in, module_info::in,
- bool::in,
+ include_imported::in,
dependency_graph(pred_id)::in, dependency_graph(pred_id)::out) is det.
dependency_graph__add_pred_arcs([], _ModuleInfo, _, !DepGraph).
@@ -348,7 +362,7 @@
module_info_preds(ModuleInfo, PredTable),
map__lookup(PredTable, PredId, PredInfo),
(
- IncludeImported = no,
+ IncludeImported = do_not_include_imported,
pred_info_is_imported(PredInfo)
->
true
@@ -383,8 +397,7 @@
%-----------------------------------------------------------------------------%
:- pred dependency_graph__add_arcs_in_goal_2(hlds_goal_expr::in,
- relation_key::in,
- dependency_graph(T)::in, dependency_graph(T)::out) is det
+ relation_key::in, dependency_graph(T)::in, dependency_graph(T)::out) is det
<= dependency_node(T).
dependency_graph__add_arcs_in_goal_2(conj(Goals), Caller, !DepGraph) :-
@@ -420,9 +433,8 @@
true
;
(
- % If the node isn't in the relation, then
- % we didn't insert it because is was imported,
- % and we don't consider it.
+ % If the node isn't in the relation, then we didn't insert it
+ % because is was imported, and we don't consider it.
relation__search_element(!.DepGraph,
dependency_node(proc(PredId, ProcId)), Callee)
->
@@ -468,8 +480,7 @@
%-----------------------------------------------------------------------------%
:- pred dependency_graph__add_arcs_in_list(list(hlds_goal)::in,
- relation_key::in,
- dependency_graph(T)::in, dependency_graph(T)::out) is det
+ relation_key::in, dependency_graph(T)::in, dependency_graph(T)::out) is det
<= dependency_node(T).
dependency_graph__add_arcs_in_list([], _Caller, !DepGraph).
@@ -506,8 +517,8 @@
(
% If the node isn't in the relation, then we didn't insert it
% because it was imported, and we don't consider it.
- relation__search_element(!.DepGraph,
- dependency_node(PredProcId), Callee)
+ relation__search_element(!.DepGraph, dependency_node(PredProcId),
+ Callee)
->
relation__add(!.DepGraph, Caller, Callee, !:DepGraph)
;
@@ -701,14 +712,13 @@
MaybeAditiInfo = yes(_)
;
MaybeAditiInfo = no,
- hlds_dependency_info_get_dependency_ordering(DepInfo0,
- DepOrdering),
+ hlds_dependency_info_get_dependency_ordering(DepInfo0, DepOrdering),
aditi_scc_info_init(!.ModuleInfo, AditiInfo0),
dependency_graph__build_aditi_scc_info(DepOrdering,
AditiInfo0, AditiInfo),
dependency_graph__merge_aditi_sccs(AditiInfo, AditiOrdering),
- hlds_dependency_info_set_aditi_dependency_ordering(
- AditiOrdering, DepInfo0, DepInfo),
+ hlds_dependency_info_set_aditi_dependency_ordering(AditiOrdering,
+ DepInfo0, DepInfo),
module_info_set_dependency_info(DepInfo, !ModuleInfo)
).
@@ -726,8 +736,7 @@
\+ hlds_pred__pred_info_is_base_relation(PredInfo)
->
aditi_scc_info_add_scc(SCC, SCCs, SCCid, !Info),
- list__foldl(
- dependency_graph__process_aditi_pred_proc_id(SCCid),
+ list__foldl(dependency_graph__process_aditi_pred_proc_id(SCCid),
SCC, !Info)
;
true
@@ -756,9 +765,8 @@
pred_info_get_markers(PredInfo, Markers),
check_marker(Markers, context)
->
- % The context transformation can only be applied
- % to a single predicate SCC, so don't merge
- % other SCCs with a context-transformed SCC.
+ % The context transformation can only be applied to a single predicate
+ % SCC, so don't merge other SCCs with a context-transformed SCC.
aditi_scc_info_add_no_merge_scc(CurrSCC, !Info)
;
true
@@ -768,9 +776,10 @@
%-----------------------------------------------------------------------------%
- % Go over the goal finding predicates called through negation
- % or aggregation. The SCCs containing those predicates cannot
- % be merged into the current SCC.
+ % Go over the goal finding predicates called through negation or
+ % aggregation. The SCCs containing those predicates cannot be merged
+ % into the current SCC.
+ %
:- pred process_aditi_goal(hlds_goal::in, aditi_scc_info::in,
aditi_scc_info::out) is det.
@@ -809,10 +818,7 @@
!Map, !Info) :-
aditi_scc_info_handle_call(IsNeg, PredId, ProcId, Args, !.Map, !Info).
process_aditi_goal(_IsNeg, unify(Var, _, _, Unify, _) - _, !Map, !Info) :-
- (
- Unify = construct(_, pred_const(ShroudedPredProcId, _),
- _, _, _, _, _)
- ->
+ ( Unify = construct(_, pred_const(ShroudedPredProcId, _), _, _, _, _, _) ->
PredProcId = unshroud_pred_proc_id(ShroudedPredProcId),
aditi_scc_info_add_closure(Var, PredProcId, !Map, !Info)
;
@@ -830,8 +836,7 @@
aditi_dependency_ordering::out) is det.
dependency_graph__merge_aditi_sccs(Info, Ordering) :-
- Info = aditi_scc_info(ModuleInfo, _PredSCC, SCCPred,
- _, SCCRel, NoMerge, _),
+ Info = aditi_scc_info(ModuleInfo, _, SCCPred, _, SCCRel, NoMerge, _),
( relation__tsort(SCCRel, SCCTsort) ->
eqvclass__init(EqvSCCs0),
set__init(MergedSCCs),
@@ -841,8 +846,7 @@
),
list__foldl(AddElement, SCCTsort, EqvSCCs0, EqvSCCs),
dependency_graph__merge_aditi_sccs_2(SCCTsort, ModuleInfo,
- EqvSCCs, MergedSCCs, NoMerge, SCCRel,
- SCCPred, [], Ordering)
+ EqvSCCs, MergedSCCs, NoMerge, SCCRel, SCCPred, [], Ordering)
;
error("dependency_graph__merge_aditi_sccs: " ++
"SCC dependency relation is cyclic")
@@ -854,11 +858,10 @@
aditi_dependency_ordering::in, aditi_dependency_ordering::out) is det.
dependency_graph__merge_aditi_sccs_2([], _, _, _, _, _, _, !Ordering).
-dependency_graph__merge_aditi_sccs_2([SCCid | SCCs0], ModuleInfo, EqvSCCs0,
- MergedSCCs0, NoMergeSCCs, SCCRel, SCCPreds, !Ordering) :-
- ( set__member(SCCid, MergedSCCs0) ->
+dependency_graph__merge_aditi_sccs_2([SCCid | SCCs0], ModuleInfo, !.EqvSCCs,
+ MergedSCCs, NoMergeSCCs, SCCRel, SCCPreds, !Ordering) :-
+ ( set__member(SCCid, MergedSCCs) ->
% This SCC has been merged into its parent.
- EqvSCCs = EqvSCCs0,
SCCs = SCCs0
;
map__lookup(SCCPreds, SCCid, SCC0 - EntryPoints),
@@ -873,20 +876,18 @@
% transformation has been requested with other SCCs --
% their magic predicates are incompatible.
!:Ordering = [aditi_scc([SCC0], EntryPoints) | !.Ordering],
- EqvSCCs = EqvSCCs0,
SCCs = SCCs0
;
dependency_graph__get_called_scc_ids(SCCid, SCCRel,
CalledSCCs),
map__lookup(SCCPreds, SCCid, SCC0 - EntryPoints),
dependency_graph__do_merge_aditi_sccs(SCCid, CalledSCCs,
- NoMergeSCCs, SCCs0, SCCs, SCCPreds, SCCRel,
- EqvSCCs0, EqvSCCs,
+ NoMergeSCCs, SCCs0, SCCs, SCCPreds, SCCRel, !EqvSCCs,
aditi_scc([SCC0], EntryPoints), SCC),
!:Ordering = [SCC | !.Ordering]
),
- dependency_graph__merge_aditi_sccs_2(SCCs, ModuleInfo, EqvSCCs,
- MergedSCCs0, NoMergeSCCs, SCCRel, SCCPreds, !Ordering).
+ dependency_graph__merge_aditi_sccs_2(SCCs, ModuleInfo, !.EqvSCCs,
+ MergedSCCs, NoMergeSCCs, SCCRel, SCCPreds, !Ordering).
% Find the SCCs called from a given SCC.
%
@@ -920,8 +921,8 @@
relation__lookup_element(SCCRel, LowerSCCid, LowerSCCKey),
relation__lookup_to(SCCRel, LowerSCCKey, CallingSCCKeys),
set__to_sorted_list(CallingSCCKeys, CallingSCCKeyList),
- list__map(relation__lookup_key(SCCRel),
- CallingSCCKeyList, CallingSCCs),
+ list__map(relation__lookup_key(SCCRel), CallingSCCKeyList,
+ CallingSCCs),
( eqvclass__same_eqvclass_list(!.EqvSCCs, CallingSCCs) ->
%
@@ -929,8 +930,8 @@
% there was only one to start with) so we
% can safely merge this one in as well.
%
- eqvclass__new_equivalence(!.EqvSCCs, CurrSCCid,
- LowerSCCid, !:EqvSCCs),
+ eqvclass__new_equivalence(!.EqvSCCs, CurrSCCid, LowerSCCid,
+ !:EqvSCCs),
map__lookup(SCCPreds, LowerSCCid, LowerSCC),
LowerSCC = LowerSCCPreds - _,
@@ -942,25 +943,22 @@
%
!.SubModule = aditi_scc(CurrSCCPreds0, EntryPoints),
!:SubModule =
- aditi_scc([LowerSCCPreds | CurrSCCPreds0],
- EntryPoints),
+ aditi_scc([LowerSCCPreds | CurrSCCPreds0], EntryPoints),
%
% Add the SCCs called by the newly merged SCC
% to those we are attempting to merge.
%
- dependency_graph__get_called_scc_ids(LowerSCCid,
- SCCRel, LowerCalledSCCs),
+ dependency_graph__get_called_scc_ids(LowerSCCid, SCCRel,
+ LowerCalledSCCs),
set__union(CalledSCCs, LowerCalledSCCs, CalledSCCs1),
- dependency_graph__do_merge_aditi_sccs(CurrSCCid,
- CalledSCCs1, NoMergeSCCs, LowerSCCs0,
- LowerSCCs, SCCPreds, SCCRel, !EqvSCCs,
- !SubModule)
- ;
- dependency_graph__do_merge_aditi_sccs(CurrSCCid,
- CalledSCCs, NoMergeSCCs, LowerSCCs0,
- LowerSCCs1, SCCPreds, SCCRel,
+ dependency_graph__do_merge_aditi_sccs(CurrSCCid, CalledSCCs1,
+ NoMergeSCCs, LowerSCCs0, LowerSCCs, SCCPreds, SCCRel,
+ !EqvSCCs, !SubModule)
+ ;
+ dependency_graph__do_merge_aditi_sccs(CurrSCCid, CalledSCCs,
+ NoMergeSCCs, LowerSCCs0, LowerSCCs1, SCCPreds, SCCRel,
!EqvSCCs, !SubModule),
LowerSCCs = [LowerSCCid | LowerSCCs1]
)
@@ -973,8 +971,8 @@
%-----------------------------------------------------------------------------%
-:- type aditi_scc_info --->
- aditi_scc_info(
+:- type aditi_scc_info
+ ---> aditi_scc_info(
aditi_scc_module_info :: module_info,
aditi_scc_proc_to_scc :: map(pred_proc_id, scc_id),
aditi_scc_scc_to_procs :: scc_pred_map,
@@ -1055,8 +1053,7 @@
SCCRel1 = SCCRel0,
NoMerge1 = NoMerge0
;
- relation__add_values(SCCRel0, SCCid, CalledSCCid,
- SCCRel1),
+ relation__add_values(SCCRel0, SCCid, CalledSCCid, SCCRel1),
( IsNeg = yes ->
set__insert(NoMerge0, CalledSCCid, NoMerge1)
;
@@ -1078,8 +1075,8 @@
)
).
- % An SCC cannot be merged into its parents if one of its
- % procedures is called as an aggregate query.
+ % An SCC cannot be merged into its parents if one of its procedures
+ % is called as an aggregate query.
%
:- pred handle_higher_order_args(list(prog_var)::in, bool::in, scc_id::in,
multi_map(prog_var, pred_proc_id)::in, map(pred_proc_id, scc_id)::in,
@@ -1108,16 +1105,16 @@
( map__search(PredSCC, PredProcId, CalledSCCid) ->
% Make sure anything called through an aggregate
% is not merged into the current sub-module.
- ( IsAgg = yes ->
+ (
+ IsAgg = yes,
set__insert(!.NoMerge, CalledSCCid, !:NoMerge)
;
- true
+ IsAgg = no
),
( CalledSCCid = SCCid ->
true
;
- relation__add_values(!.SCCRel, SCCid, CalledSCCid,
- !:SCCRel)
+ relation__add_values(!.SCCRel, SCCid, CalledSCCid, !:SCCRel)
)
;
true
Index: compiler/det_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/det_analysis.m,v
retrieving revision 1.178
diff -u -b -r1.178 det_analysis.m
--- compiler/det_analysis.m 30 Aug 2005 04:11:48 -0000 1.178
+++ compiler/det_analysis.m 6 Sep 2005 12:43:58 -0000
@@ -134,6 +134,7 @@
:- import_module check_hlds__purity.
:- import_module check_hlds__type_util.
:- import_module hlds__code_model.
+:- import_module hlds__goal_util.
:- import_module hlds__hlds_out.
:- import_module hlds__passes_aux.
:- import_module libs__options.
Index: compiler/det_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/det_util.m,v
retrieving revision 1.29
diff -u -b -r1.29 det_util.m
--- compiler/det_util.m 24 Mar 2005 02:00:23 -0000 1.29
+++ compiler/det_util.m 6 Sep 2005 12:44:09 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 1996-2000,2002-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -32,28 +34,23 @@
:- type det_info.
- % Given a goal and an initial instmap, compute the final instmap that
- % results from the initial instmap after execution of the goal.
-
-:- pred update_instmap(hlds_goal::in, instmap::in, instmap::out) is det.
-
% Given a list of cases, and a list of the possible cons_ids
% that the switch variable could be bound to, select out only
% those cases whose cons_id occurs in the list of cases
% We assume that the list of cases and the list of cons_ids
% are sorted, so that we can do this using a simple sorted merge.
-
+ %
:- pred delete_unreachable_cases(list(case)::in, list(cons_id)::in,
list(case)::out) is det.
% Update the current substitution to account for the effects
% of the given unification.
-
+ %
:- pred interpret_unify(prog_var::in, unify_rhs::in,
prog_substitution::in, prog_substitution::out) is semidet.
% Look up the determinism of a procedure.
-
+ %
:- pred det_lookup_detism(det_info::in, pred_id::in, proc_id::in,
determinism::out) is det.
@@ -88,6 +85,7 @@
:- import_module check_hlds__inst_match.
:- import_module check_hlds__type_util.
:- import_module libs__options.
+:- import_module parse_tree__error_util.
:- import_module parse_tree__prog_mode.
:- import_module parse_tree__prog_util.
:- import_module parse_tree__prog_type.
@@ -97,10 +95,6 @@
:- import_module std_util.
:- import_module term.
-update_instmap(_Goal0 - GoalInfo0, !InstMap) :-
- goal_info_get_instmap_delta(GoalInfo0, DeltaInstMap),
- instmap__apply_instmap_delta(!.InstMap, DeltaInstMap, !:InstMap).
-
delete_unreachable_cases([], _, []).
delete_unreachable_cases([_ | _], [], []).
delete_unreachable_cases([Case | Cases0], [ConsId | ConsIds], Cases) :-
@@ -121,9 +115,9 @@
cons_id_and_args_to_term(ConsId, ArgTerms, RhsTerm),
term__unify(term__variable(X), RhsTerm, !Subst).
interpret_unify(_X, lambda_goal(_, _, _, _, _, _, _, _, _), !Subst).
- % For ease of implementation we just ignore unifications with
- % lambda terms. This is a safe approximation, it just
- % prevents us from optimizing them as well as we would like.
+ % For ease of implementation we just ignore unifications with lambda terms.
+ % This is a safe approximation, it just prevents us from optimizing them
+ % as well as we would like.
det_lookup_detism(DetInfo, PredId, ModeId, Detism) :-
det_info_get_module_info(DetInfo, ModuleInfo),
@@ -149,7 +143,7 @@
module_info_types(ModuleInfo, TypeTable),
map__search(TypeTable, TypeCtor, TypeDefn)
;
- error("cannot lookup the type of a variable")
+ unexpected(this_file, "det_lookup_var_type")
).
det_no_output_vars(Vars, InstMap, InstMapDelta, DetInfo) :-
@@ -159,8 +153,8 @@
%-----------------------------------------------------------------------------%
-:- type det_info --->
- det_info(
+:- type det_info
+ ---> det_info(
module_info :: module_info,
vartypes :: vartypes,
pred_id :: pred_id, % the id of the proc
@@ -187,3 +181,11 @@
det_info_set_module_info(DI, ModuleInfo, DI ^ module_info := ModuleInfo).
det_info_set_vartypes(DI, VarTypes, DI ^ vartypes := VarTypes).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "det_util.m".
+
+%-----------------------------------------------------------------------------%
Index: compiler/goal_form.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/goal_form.m,v
retrieving revision 1.16
diff -u -b -r1.16 goal_form.m
--- compiler/goal_form.m 18 May 2005 05:49:11 -0000 1.16
+++ compiler/goal_form.m 7 Sep 2005 10:18:29 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 2002-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -63,16 +65,6 @@
%
:- pred goal_can_loop_or_throw(hlds_goal::in) is semidet.
- % contains_only_builtins(G) is true if G is a leaf procedure,
- % i.e. control does not leave G to call another procedure, even
- % if that procedure is a complicated unification.
- %
-:- pred contains_only_builtins(hlds_goal::in) is semidet.
-
-:- pred contains_only_builtins_expr(hlds_goal_expr::in) is semidet.
-
-:- pred contains_only_builtins_list(list(hlds_goal)::in) is semidet.
-
% goal_is_flat(Goal) is true if Goal does not contain any
% branched structures (ie if-then-else or disjunctions or
% switches.)
@@ -154,7 +146,7 @@
goal_cannot_loop_aux(no, Goal).
goal_can_loop_or_throw(Goal) :-
- \+ goal_cannot_loop_or_throw(Goal).
+ not goal_cannot_loop_or_throw(Goal).
:- pred goal_cannot_loop_aux(maybe(module_info)::in, hlds_goal::in) is semidet.
@@ -204,9 +196,9 @@
;
proc_info_get_termination2_info(ProcInfo, Term2Info),
Term2Info ^ term_status = yes(cannot_loop(_))
-
).
goal_cannot_loop_expr(_, unify(_, _, _, Uni, _)) :-
+ % Complicated unifies are _non_builtin_
(
Uni = assign(_, _)
;
@@ -216,23 +208,22 @@
;
Uni = deconstruct(_, _, _, _, _, _)
).
- % Complicated unifies are _non_builtin_
%-----------------------------------------------------------------------------%
goal_cannot_throw(ModuleInfo, Goal) :-
goal_cannot_throw_aux(yes(ModuleInfo), Goal).
-:- pred goal_cannot_throw_aux(maybe(module_info)::in,
- hlds_goal::in) is semidet.
+:- pred goal_cannot_throw_aux(maybe(module_info)::in, hlds_goal::in)
+ is semidet.
goal_cannot_throw_aux(MaybeModuleInfo, GoalExpr - GoalInfo) :-
goal_info_get_determinism(GoalInfo, Determinism),
not Determinism = erroneous,
goal_cannot_throw_expr(MaybeModuleInfo, GoalExpr).
-:- pred goal_cannot_throw_expr(maybe(module_info)::in,
- hlds_goal_expr::in) is semidet.
+:- pred goal_cannot_throw_expr(maybe(module_info)::in, hlds_goal_expr::in)
+ is semidet.
goal_cannot_throw_expr(MaybeModuleInfo, conj(Goals)) :-
list.member(Goal, Goals) =>
@@ -267,39 +258,7 @@
module_info_exception_info(ModuleInfo, ExceptionInfo),
map.search(ExceptionInfo, proc(PredId, ProcId), will_not_throw).
goal_cannot_throw_expr(_, unify(_, _, _, Uni, _)) :-
- (
- Uni = assign(_, _)
- ;
- Uni = simple_test(_, _)
- ;
- Uni = construct(_, _, _, _, _, _, _)
- ;
- Uni = deconstruct(_, _, _, _, _, _)
- ).
% Complicated unifies are _non_builtin_
-
-%-----------------------------------------------------------------------------%
-
-contains_only_builtins(Goal - _GoalInfo) :-
- contains_only_builtins_expr(Goal).
-
-contains_only_builtins_expr(conj(Goals)) :-
- contains_only_builtins_list(Goals).
-contains_only_builtins_expr(disj(Goals)) :-
- contains_only_builtins_list(Goals).
-contains_only_builtins_expr(switch(_Var, _Category, Cases)) :-
- contains_only_builtins_cases(Cases).
-contains_only_builtins_expr(not(Goal)) :-
- contains_only_builtins(Goal).
-contains_only_builtins_expr(scope(_, Goal)) :-
- contains_only_builtins(Goal).
-contains_only_builtins_expr(if_then_else(_Vars, Cond, Then, Else)) :-
- contains_only_builtins(Cond),
- contains_only_builtins(Then),
- contains_only_builtins(Else).
-contains_only_builtins_expr(call(_, _, _, BuiltinState, _, _)) :-
- BuiltinState = inline_builtin.
-contains_only_builtins_expr(unify(_, _, _, Uni, _)) :-
(
Uni = assign(_, _)
;
@@ -309,19 +268,6 @@
;
Uni = deconstruct(_, _, _, _, _, _)
).
- % Complicated unifies are _non_builtin_
-
-:- pred contains_only_builtins_cases(list(case)::in) is semidet.
-
-contains_only_builtins_cases([]).
-contains_only_builtins_cases([case(_ConsId, Goal)|Cases]) :-
- contains_only_builtins(Goal),
- contains_only_builtins_cases(Cases).
-
-contains_only_builtins_list([]).
-contains_only_builtins_list([Goal|Goals]) :-
- contains_only_builtins(Goal),
- contains_only_builtins_list(Goals).
%-----------------------------------------------------------------------------%
@@ -344,7 +290,7 @@
:- pred goal_is_flat_list(list(hlds_goal)::in) is semidet.
goal_is_flat_list([]).
-goal_is_flat_list([Goal|Goals]) :-
+goal_is_flat_list([Goal | Goals]) :-
goal_is_flat(Goal),
goal_is_flat_list(Goals).
@@ -371,7 +317,10 @@
May = yes
).
goal_may_allocate_heap_2(unify(_, _, _, Unification, _), May) :-
- ( Unification = construct(_, _, Args, _, _, _, _), Args = [_|_] ->
+ (
+ Unification = construct(_, _, Args, _, _, _, _),
+ Args = [_ | _]
+ ->
May = yes
;
May = no
@@ -379,8 +328,8 @@
% We cannot safely say that a foreign code fragment does not
% allocate memory without knowing all the #defined macros that
% expand to incr_hp and variants thereof.
- % XXX although you could make it an attribute of the foreign code and
- % trust the programmer
+ % XXX You could make it an attribute of the foreign code and
+ % trust the programmer.
goal_may_allocate_heap_2(foreign_proc(_, _, _, _, _, _), yes).
goal_may_allocate_heap_2(scope(_, Goal), May) :-
goal_may_allocate_heap(Goal, May).
@@ -471,9 +420,10 @@
cannot_fail_before_stack_flush(GoalExpr - GoalInfo) :-
goal_info_get_determinism(GoalInfo, Detism),
determinism_components(Detism, CanFail, _),
- ( CanFail = cannot_fail ->
- true
+ (
+ CanFail = cannot_fail
;
+ CanFail = can_fail,
cannot_fail_before_stack_flush_2(GoalExpr)
).
@@ -568,9 +518,11 @@
count_recursive_calls_disj([], _, _, 0, 0).
count_recursive_calls_disj([Goal | Goals], PredId, ProcId, Min, Max) :-
- ( Goals = [] ->
+ (
+ Goals = [],
count_recursive_calls(Goal, PredId, ProcId, Min, Max)
;
+ Goals = [_ | _],
count_recursive_calls(Goal, PredId, ProcId, Min0, Max0),
count_recursive_calls_disj(Goals, PredId, ProcId, Min1, Max1),
int__min(Min0, Min1, Min),
@@ -584,12 +536,13 @@
unexpected(this_file, "empty cases in count_recursive_calls_cases").
count_recursive_calls_cases([case(_, Goal) | Cases], PredId, ProcId,
Min, Max) :-
- ( Cases = [] ->
+ (
+ Cases = [],
count_recursive_calls(Goal, PredId, ProcId, Min, Max)
;
+ Cases = [_ | _],
count_recursive_calls(Goal, PredId, ProcId, Min0, Max0),
- count_recursive_calls_cases(Cases, PredId, ProcId,
- Min1, Max1),
+ count_recursive_calls_cases(Cases, PredId, ProcId, Min1, Max1),
int__min(Min0, Min1, Min),
int__max(Max0, Max1, Max)
).
Index: compiler/goal_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/goal_util.m,v
retrieving revision 1.112
diff -u -b -r1.112 goal_util.m
--- compiler/goal_util.m 30 Aug 2005 04:11:50 -0000 1.112
+++ compiler/goal_util.m 6 Sep 2005 14:37:51 -0000
@@ -30,6 +30,11 @@
:- import_module set.
:- import_module term.
+ % Given a goal and an initial instmap, compute the final instmap that
+ % results from the initial instmap after execution of the goal.
+ %
+:- pred update_instmap(hlds_goal::in, instmap::in, instmap::out) is det.
+
:- type prog_var_renaming == map(prog_var, prog_var).
% create_renaming(OutputVars, InstMapDelta, !VarTypes, !VarSet,
@@ -319,6 +324,12 @@
%-----------------------------------------------------------------------------%
+update_instmap(_Goal0 - GoalInfo0, !InstMap) :-
+ goal_info_get_instmap_delta(GoalInfo0, DeltaInstMap),
+ instmap__apply_instmap_delta(!.InstMap, DeltaInstMap, !:InstMap).
+
+%-----------------------------------------------------------------------------%
+
create_renaming(OrigVars, InstMapDelta, !VarTypes, !VarSet, Unifies, NewVars,
Renaming) :-
create_renaming_2(OrigVars, InstMapDelta, !VarTypes, !VarSet,
@@ -595,8 +606,8 @@
unification::in, unification::out) is det.
goal_util__rename_unify(Must, Subn,
- construct(Var0, ConsId, Vars0, Modes, How0, Uniq, MaybeSize0),
- construct(Var, ConsId, Vars, Modes, How, Uniq, MaybeSize)) :-
+ construct(Var0, ConsId, Vars0, Modes, How0, Uniq, SubInfo0),
+ construct(Var, ConsId, Vars, Modes, How, Uniq, SubInfo)) :-
goal_util__rename_var(Must, Subn, Var0, Var),
goal_util__rename_var_list(Must, Subn, Vars0, Vars),
(
@@ -611,6 +622,8 @@
How = How0
),
(
+ SubInfo0 = construct_sub_info(MTA, MaybeSize0),
+ (
MaybeSize0 = no,
MaybeSize = no
;
@@ -624,6 +637,11 @@
Size = dynamic_size(SizeVar)
),
MaybeSize = yes(Size)
+ ),
+ SubInfo = construct_sub_info(MTA, MaybeSize)
+ ;
+ SubInfo0 = no_construct_sub_info,
+ SubInfo = no_construct_sub_info
).
goal_util__rename_unify(Must, Subn,
deconstruct(Var0, ConsId, Vars0, Modes, Cat, CanCGC),
@@ -1444,8 +1462,7 @@
%-----------------------------------------------------------------------------%
goal_util__generate_simple_call(ModuleName, ProcName, PredOrFunc, ModeNo,
- Detism, Args, Features, InstMap, ModuleInfo, Context,
- Goal) :-
+ Detism, Args, Features, InstMap, ModuleInfo, Context, Goal) :-
list__length(Args, Arity),
lookup_builtin_pred_proc_id(ModuleInfo, ModuleName, ProcName,
PredOrFunc, Arity, ModeNo, PredId, ProcId),
@@ -1454,8 +1471,7 @@
% this is the "recursive" clause generated for the compiler
% for each builtin, so an invalid pred_id won't cause problems.
InvalidPredId = invalid_pred_id,
- BuiltinState = builtin_state(ModuleInfo, InvalidPredId,
- PredId, ProcId),
+ BuiltinState = builtin_state(ModuleInfo, InvalidPredId, PredId, ProcId),
GoalExpr = call(PredId, ProcId, Args, BuiltinState, no,
qualified(ModuleName, ProcName)),
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.235
diff -u -b -r1.235 handle_options.m
--- compiler/handle_options.m 2 Sep 2005 08:20:24 -0000 1.235
+++ compiler/handle_options.m 7 Sep 2005 03:38:49 -0000
@@ -1050,6 +1050,8 @@
add_error("deep profiling is incompatible " ++
"with high level code", !Errors)
),
+ globals__set_option(optimize_constructor_last_call,
+ bool(no), !Globals),
globals__lookup_bool_option(!.Globals,
use_lots_of_ho_specialization, LotsOfHOSpec),
(
@@ -1078,12 +1080,18 @@
;
( RecordTermSizesAsWords = yes
; RecordTermSizesAsCells = yes
- ),
- HighLevel = yes
+ )
->
+ globals__set_option(optimize_constructor_last_call, bool(no),
+ !Globals),
+ (
+ HighLevel = yes,
add_error("term size profiling is incompatible "
++ "with high level code", !Errors)
;
+ HighLevel = no
+ )
+ ;
true
),
@@ -1625,6 +1633,9 @@
globals__set_option(can_compare_constants_as_ints, bool(no),
!Globals)
),
+
+ option_implies(highlevel_code, optimize_constructor_last_call,
+ bool(no), !Globals),
(
HighLevel = no,
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.134
diff -u -b -r1.134 higher_order.m
--- compiler/higher_order.m 30 Aug 2005 04:11:51 -0000 1.134
+++ compiler/higher_order.m 6 Sep 2005 03:03:04 -0000
@@ -1147,7 +1147,12 @@
(
Goal0 = unify(_, _, UniMode, Unify0, Context),
Unify0 = construct(LVar, ConsId0, Args0, _,
- HowToConstruct, CellIsUnique, no),
+ HowToConstruct, CellIsUnique, SubInfo),
+ (
+ SubInfo = no_construct_sub_info
+ ;
+ SubInfo = construct_sub_info(no, no)
+ ),
ConsId0 = pred_const(ShroudedPredProcId, EvalMethod),
PredProcId = unshroud_pred_proc_id(ShroudedPredProcId),
proc(PredId, ProcId) = PredProcId,
@@ -1216,7 +1221,7 @@
NewShroudedPredProcId = shroud_pred_proc_id(NewPredProcId),
NewConsId = pred_const(NewShroudedPredProcId, EvalMethod),
Unify = construct(LVar, NewConsId, NewArgs, UniModes,
- HowToConstruct, CellIsUnique, no),
+ HowToConstruct, CellIsUnique, no_construct_sub_info),
Goal2 = unify(LVar, functor(NewConsId, no, NewArgs),
UniMode, Unify, Context),
%
@@ -3035,7 +3040,7 @@
UniMode = (free -> ConstInst) - (ConstInst -> ConstInst),
ConstGoal = unify(LVar, RHS, UniMode,
construct(LVar, ConsId, CurriedHeadVars1, UniModes,
- construct_dynamically, cell_is_unique, no),
+ construct_dynamically, cell_is_unique, no_construct_sub_info),
unify_context(explicit, [])) - ConstGoalInfo,
ConstGoals0 = CurriedConstGoals ++ [ConstGoal]
;
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.136
diff -u -b -r1.136 hlds_goal.m
--- compiler/hlds_goal.m 30 Aug 2005 04:11:51 -0000 1.136
+++ compiler/hlds_goal.m 6 Sep 2005 03:14:23 -0000
@@ -466,6 +466,33 @@
%
:- type is_existential_construction == bool.
+ % This type contains the fields of a construct unification that are needed
+ % only rarely. If a value of this type is bound to no_construct_sub_info,
+ % this means the same as construct_sub_info(no, no), but takes less space.
+ % This matters because a modules have lots of construct unifications.
+:- type construct_sub_info
+ ---> construct_sub_info(
+ take_address_fields :: maybe(list(int)),
+
+ term_size_slot :: maybe(term_size_value)
+ % The value `yes' tells the code
+ % generator to reserve an extra slot,
+ % at offset -1, to hold an integer
+ % giving the size of the term.
+ % The argument specifies the value
+ % to be put into this slot, either
+ % as an integer constant or as the
+ % value of a given variable.
+ %
+ % The value `no' means there is no
+ % extra slot, and is the default.
+ %
+ % The content of this slot is not
+ % meaningful before the size_prof pass
+ % has been run.
+ )
+ ; no_construct_sub_info.
+
:- type unification
---> construct(
@@ -511,22 +538,7 @@
% Can the cell be allocated
% in shared data.
- term_size_slot :: maybe(term_size_value)
- % The value `yes' tells the code
- % generator to reserve an extra slot,
- % at offset -1, to hold an integer
- % giving the size of the term.
- % The argument specifies the value
- % to be put into this slot, either
- % as an integer constant or as the
- % value of a given variable.
- %
- % The value `no' means there is no
- % extra slot, and is the default.
- %
- % The content of this slot is not
- % meaningful before the size_prof pass
- % has been run.
+ construct_sub_info :: construct_sub_info
)
; deconstruct(
@@ -2194,7 +2206,7 @@
Inst = bound(unique, [functor(ConsId, [])]),
Mode = (free -> Inst) - (Inst -> Inst),
Unification = construct(Var, ConsId, [], [],
- construct_dynamically, cell_is_unique, no),
+ construct_dynamically, cell_is_unique, no_construct_sub_info),
Context = unify_context(explicit, []),
Goal = unify(Var, RHS, Mode, Unification, Context),
set__singleton_set(NonLocals, Var),
@@ -2209,7 +2221,7 @@
UniMode = ((free_inst - ground_inst) -> (ground_inst - ground_inst)),
list__duplicate(Arity, UniMode, UniModes),
Unification = construct(Var, ConsId, Args, UniModes,
- construct_dynamically, cell_is_unique, no),
+ construct_dynamically, cell_is_unique, no_construct_sub_info),
UnifyContext = unify_context(explicit, []),
Unify = unify(Var, Rhs, UnifyMode, Unification, UnifyContext),
set__list_to_set([Var | Args], NonLocals),
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_module.m,v
retrieving revision 1.117
diff -u -b -r1.117 hlds_module.m
--- compiler/hlds_module.m 29 Aug 2005 03:22:18 -0000 1.117
+++ compiler/hlds_module.m 31 Aug 2005 05:20:39 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 1996-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -53,6 +55,8 @@
:- import_module int.
:- import_module require.
:- import_module string.
+:- import_module svmap.
+:- import_module svmulti_map.
%-----------------------------------------------------------------------------%
@@ -90,7 +94,7 @@
% maybe(pred_proc_id) % prettyprinter, if relevant
).
- % map from proc to a list of unused argument numbers.
+ % Map from proc to a list of unused argument numbers.
:- type unused_arg_info == map(pred_proc_id, list(int)).
% Map from proc to an indication of whether or not it
@@ -101,11 +105,13 @@
% specializations, and a list of predicates which should be
% processed by higher_order.m to ensure the production of those
% versions.
-:- type type_spec_info --->
- type_spec_info(
- set(pred_proc_id), % Procedures for which there are
+:- type type_spec_info
+ ---> type_spec_info(
+ set(pred_proc_id),
+ % Procedures for which there are
% user-requested type specializations.
- set(pred_id), % Set of procedures which need to be
+ set(pred_id),
+ % Set of procedures which need to be
% processed by higher_order.m to
% produce those specialized versions.
multi_map(pred_id, pred_id),
@@ -133,29 +139,24 @@
% Maps the full names of procedures (in the sense of
% complexity_proc_name in complexity.m) to the number of their slot
% in MR_complexity_proc_table.
-
:- type complexity_proc_map == map(string, int).
-:- type complexity_proc_info --->
- complexity_proc_info(
+:- type complexity_proc_info
+ ---> complexity_proc_info(
complexity_proc_num :: int,
- % The index of the procedure
- % in the runtime system's
- % MR_complexity_procs array.
+ % The index of the procedure in the runtime
+ % system's MR_complexity_procs array.
complexity_proc_name :: string,
- % The full name of the
- % procedure, in the form
- % fqn/arity-modenum, where
- % fqn is the predicate or
- % function's fully qualified
- % name.
+ % The full name of the procedure, in the form
+ % fqn/arity-modenum, where fqn is the predicate or
+ % function's fully qualified name.
complexity_proc_args :: list(complexity_arg_info)
).
-:- type complexity_arg_info --->
- complexity_arg_info(
+:- type complexity_arg_info
+ ---> complexity_arg_info(
complexity_arg_name :: maybe(string),
complexity_arg_kind :: complexity_arg_kind
).
@@ -196,8 +197,8 @@
:- pred module_info_set_predicate_table(predicate_table::in,
module_info::in, module_info::out) is det.
- % For an explanation of the proc_requests structure,
- % see unify_proc.m.
+ % For an explanation of the proc_requests structure, see unify_proc.m.
+ %
:- pred module_info_get_proc_requests(module_info::in, proc_requests::out)
is det.
@@ -285,16 +286,16 @@
:- pred module_info_get_indirectly_imported_module_specifiers(module_info::in,
set(module_specifier)::out) is det.
- % The visible modules are the current module, any
- % imported modules, any ancestor modules and any
- % modules imported by ancestor modules.
- % It excludes transitively imported modules (those
- % for which we read `.int2' files).
+ % The visible modules are the current module, any imported modules,
+ % any ancestor modules and any modules imported by ancestor modules.
+ % It excludes transitively imported modules (those for which we read
+ % `.int2' files).
:- pred visible_module(module_name::out, module_info::in) is multi.
% This returns all the modules that this module's code depends on,
% i.e. all modules that have been used or imported by this module,
% directly or indirectly, including parent modules.
+ %
:- pred module_info_get_all_deps(module_info::in, set(module_name)::out)
is det.
@@ -345,8 +346,9 @@
:- pred module_add_fact_table_file(string::in,
module_info::in, module_info::out) is det.
- % Please see module_info_ensure_dependency_info for the
- % constraints on this dependency_info.
+ % Please see module_info_ensure_dependency_info for the constraints
+ % on this dependency_info.
+ %
:- pred module_info_get_maybe_dependency_info(module_info::in,
maybe(dependency_info)::out) is det.
@@ -453,8 +455,8 @@
% Given a pred_proc_id, return the proc_info of the specified procedure.
%
-:- pred module_info_proc_info(module_info::in, pred_proc_id::in, proc_info::out)
- is det.
+:- pred module_info_proc_info(module_info::in, pred_proc_id::in,
+ proc_info::out) is det.
:- pred module_info_proc_info(module_info::in, pred_id::in, proc_id::in,
proc_info::out) is det.
@@ -500,12 +502,10 @@
module_info::in, module_info::out) is det.
:- pred module_info_set_pred_proc_info(pred_id::in, proc_id::in,
- pred_info::in, proc_info::in, module_info::in, module_info::out)
- is det.
+ pred_info::in, proc_info::in, module_info::in, module_info::out) is det.
:- pred module_info_set_pred_proc_info(pred_proc_id::in,
- pred_info::in, proc_info::in, module_info::in, module_info::out)
- is det.
+ pred_info::in, proc_info::in, module_info::in, module_info::out) is det.
:- pred module_info_typeids(module_info::in, list(type_ctor)::out) is det.
@@ -539,6 +539,7 @@
% lambda predicates which appear on the same line in the same file.
% This predicate returns the next number for the given context
% and increments the counter for that context.
+ %
:- pred module_info_next_lambda_count(prog_context::in, int::out,
module_info::in, module_info::out) is det.
@@ -578,8 +579,8 @@
:- pred module_info_set_maybe_dependency_info(maybe(dependency_info)::in,
module_info::in, module_info::out) is det.
-:- type module_info --->
- module(
+:- type module_info
+ ---> module(
sub_info :: module_sub_info,
predicate_table :: predicate_table,
proc_requests :: proc_requests,
@@ -598,121 +599,90 @@
maybe_recompilation_info :: maybe(recompilation_info)
).
-:- type module_sub_info --->
- module_sub(
+:- type module_sub_info
+ ---> module_sub(
module_name :: module_name,
globals :: globals,
contains_foreign_type :: bool,
foreign_decl_info :: foreign_decl_info,
foreign_body_info :: foreign_body_info,
foreign_import_module_info :: foreign_import_module_info,
+
+ % The names of the files containing fact tables implementing
+ % predicates defined in this module.
fact_table_file_names :: list(string),
- % The names of the files
- % containing fact tables
- % implementing predicates
- % defined in this module.
+ % This dependency info is constrained to be only for between
+ % procedures which have clauses defined for them in this
+ % compilation unit (that includes opt_imported procedures).
maybe_dependency_info :: maybe(dependency_info),
- % This dependency info is
- % constrained to be only for
- % between procedures which
- % have clauses defined for
- % them in this compilation
- % unit (that includes
- % opt_imported procedures).
num_errors :: int,
+ % List of the procs for which there is a pragma export(...)
+ % declaration.
pragma_exported_procs :: list(pragma_exported_proc),
- % list of the procs for which
- % there is a pragma export(...)
- % declaration
type_ctor_gen_infos :: list(type_ctor_gen_info),
must_be_stratified_preds :: set(pred_id),
+ % Unused argument info about predicates in the current module
+ % which has been exported in .opt files.
unused_arg_info :: unused_arg_info,
- % unused argument info about
- % predicates in the current
- % module which has been
- % exported in .opt files.
+ % Exception information about procedures in the current module
+ % (this includes opt_imported procedures).
exception_info :: exception_info,
- % exception information about
- % procedures in the current
- % module (this includes
- % opt_imported procedures).
+ % How many lambda expressions there are at different contexts
+ % in the module. This is used to uniquely identify lambda
+ % expressions that appear on the same line of the same file.
lambdas_per_context :: map(prog_context, counter),
- % How many lambda expressions
- % there are at different
- % contexts in the module.
- % This is used to uniquely
- % identify lambda expressions
- % that appear on the same
- % line of the same file.
+ % Used to ensure uniqueness of the structure types defined
+ % so far for model_non foreign_procs.
model_non_pragma_counter :: counter,
- % Used to ensure uniqueness of
- % the structure types defined
- % so far for model_non
- % foreign_procs.
+ % All the directly imported module specifiers (used during type
+ % checking, and by the MLDS back-end).
imported_module_specifiers :: set(module_specifier),
- % All the directly
- % imported module specifiers
- % (used during type
- % checking, and by the
- % MLDS back-end)
- indirectly_imported_module_specifiers :: set(module_specifier),
- % All the indirectly imported
- % modules (used by the MLDS
+ % All the indirectly imported modules (used by the MLDS
% back-end).
+ indirectly_imported_module_specifiers :: set(module_specifier),
+ % Are there any local Aditi predicates for which Aditi-RL
+ % must be produced?
do_aditi_compilation :: do_aditi_compilation,
- % are there any local Aditi
- % predicates for which
- % Aditi-RL must be produced?
+ % Data used for user-guided type specialization.
type_spec_info :: type_spec_info,
- % data used for user-guided
- % type specialization.
+ % Information about no tag types. This information is also
+ % in the type_table, but lookups in this table will be much
+ % faster.
no_tag_type_table :: no_tag_type_table,
- % Information about no tag
- % types. This information is
- % also in the type_table,
- % but lookups in this table
- % will be much faster.
+ % Information about the procedures we are performing
+ % complexity experiments on.
maybe_complexity_proc_map :: maybe(pair(int,
complexity_proc_map)),
complexity_proc_infos :: list(complexity_proc_info),
- % Information about the
- % procedures we are performing
- % complexity experiments on.
+ % Information for the inter-module analysis framework.
analysis_info :: analysis_info,
- % Information for the
- % inter-module analysis
- % framework.
- aditi_top_down_procs :: list(aditi_top_down_proc),
- % List of top-down procedures
- % which could be called from
+ % List of top-down procedures which could be called from
% bottom-up Aditi procedures.
+ aditi_top_down_procs :: list(aditi_top_down_proc),
+
aditi_proc_counter :: counter,
+
+ % Exported C names for preds appearing in `:- initialise
+ % initpred' directives in this module, in order of appearance.
user_init_pred_c_names :: assoc_list(sym_name, string)
- % Exported C names for
- % preds appearing in
- % `:- initialise initpred'
- % directives in this module,
- % in order of appearance.
).
- % A predicate which creates an empty module
-
module_info_init(Name, Items, Globals, QualifierInfo, RecompInfo,
ModuleInfo) :-
predicate_table_init(PredicateTable),
@@ -730,8 +700,8 @@
set__init(TypeSpecForcePreds),
map__init(SpecMap),
map__init(PragmaMap),
- TypeSpecInfo = type_spec_info(TypeSpecPreds,
- TypeSpecForcePreds, SpecMap, PragmaMap),
+ TypeSpecInfo = type_spec_info(TypeSpecPreds, TypeSpecForcePreds,
+ SpecMap, PragmaMap),
map__init(ClassTable),
map__init(InstanceTable),
@@ -845,12 +815,10 @@
counter__allocate(Proc, Counter0, Counter),
MI = MI0 ^ sub_info ^ aditi_proc_counter := Counter.
- % XXX There is some debate as to whether duplicate
- % initialise directives in the same module should
- % constitute an error. Currently it is not, but
- % we may wish to revisit this code. The reference
- % manual is therefore deliberately quiet on the
- % subject.
+ % XXX There is some debate as to whether duplicate initialise directives
+ % in the same module should constitute an error. Currently it is not, but
+ % we may wish to revisit this code. The reference manual is therefore
+ % deliberately quiet on the subject.
%
module_info_new_user_init_pred(SymName, CName, MI0, MI) :-
InitPredCNames0 = MI0 ^ sub_info ^ user_init_pred_c_names,
@@ -864,9 +832,7 @@
module_info_user_init_pred_c_name(MI, SymName, CName) :-
InitPredCNames = MI ^ sub_info ^ user_init_pred_c_names,
- (
- assoc_list__search(InitPredCNames, SymName, CName0)
- ->
+ ( assoc_list__search(InitPredCNames, SymName, CName0) ->
CName = CName0
;
module_info_name(MI, ModuleSymName),
@@ -914,13 +880,11 @@
MI ^ sub_info ^ model_non_pragma_counter := NewVal).
module_add_imported_module_specifiers(ModuleSpecifiers, MI,
MI ^ sub_info ^ imported_module_specifiers :=
- set__insert_list(
- MI ^ sub_info ^ imported_module_specifiers,
+ set__insert_list(MI ^ sub_info ^ imported_module_specifiers,
ModuleSpecifiers)).
module_add_indirectly_imported_module_specifiers(Modules, MI,
MI ^ sub_info ^ indirectly_imported_module_specifiers :=
- set__insert_list(
- MI ^ sub_info ^ indirectly_imported_module_specifiers,
+ set__insert_list(MI ^ sub_info ^ indirectly_imported_module_specifiers,
Modules)).
module_info_set_do_aditi_compilation(MI,
MI ^ sub_info ^ do_aditi_compilation := do_aditi_compilation).
@@ -1072,8 +1036,7 @@
;
map.lookup(ContextCounter0, Context, Counter0),
counter.allocate(Count, Counter0, Counter),
- map.det_update(ContextCounter0, Context, Counter,
- ContextCounter)
+ map.det_update(ContextCounter0, Context, Counter, ContextCounter)
),
module_info_set_lambdas_per_context(ContextCounter, !MI).
@@ -1082,10 +1045,6 @@
counter__allocate(Count, Counter0, Counter),
module_info_set_model_non_pragma_counter(Counter, !MI).
- % After we have finished constructing the symbol tables,
- % we balance all the binary trees, to improve performance
- % in later stages of the compiler.
-
module_info_optimize(!ModuleInfo) :-
module_info_get_predicate_table(!.ModuleInfo, Preds0),
predicate_table_optimize(Preds0, Preds),
@@ -1140,8 +1099,7 @@
module_add_foreign_body_code(Lang, Foreign_Body_Code, Context, !Module) :-
module_info_get_foreign_body_code(!.Module, Foreign_Body_List0),
- % store the decls in reverse order and reverse them later
- % for efficiency
+ % Store the decls in reverse order and reverse them later for efficiency.
Foreign_Body_List =
[foreign_body_code(Lang, Foreign_Body_Code, Context) |
Foreign_Body_List0],
@@ -1149,8 +1107,7 @@
module_add_foreign_import_module(Lang, ModuleName, Context, !Module) :-
module_info_get_foreign_import_module(!.Module, ForeignImportIndex0),
- % store the decls in reverse order and reverse them later
- % for efficiency
+ % Store the decls in reverse order and reverse them later for efficiency.
ForeignImportIndex =
[foreign_import_module(Lang, ModuleName, Context) |
ForeignImportIndex0],
@@ -1174,12 +1131,11 @@
:- type aditi_dependency_ordering == list(aditi_scc).
- % Each Aditi SCC contains one or more SCCs from the original
- % dependency ordering and the entry points of the SCC.
- % SCCs which are only called from one other SCC and are not
- % called through negation or aggregation are merged into the
- % parent SCC. This makes the low-level RL optimizations more
- % effective while maintaining stratification.
+ % Each Aditi SCC contains one or more SCCs from the original dependency
+ % ordering and the entry points of the SCC. SCCs which are only called from
+ % one other SCC and are not called through negation or aggregation are
+ % merged into the parent SCC. This makes the low-level RL optimizations
+ % more effective while maintaining stratification.
:- type aditi_scc
---> aditi_scc(dependency_ordering, list(pred_proc_id)).
@@ -1268,11 +1224,10 @@
%
:- pred predicate_table_get_preds(predicate_table::in, pred_table::out) is det.
- % Restrict the predicate table to the list of predicates.
- % This predicate should only be used when the set of predicates
- % to restrict the table to is significantly smaller then the
- % predicate_table size, as rather than removing entries from
- % the table it builds a new table from scratch.
+ % Restrict the predicate table to the list of predicates. This predicate
+ % should only be used when the set of predicates to restrict the table
+ % to is significantly smaller then the predicate_table size, as rather than
+ % removing entries from the table it builds a new table from scratch.
%
:- pred predicate_table_restrict(partial_qualifier_info::in,
list(pred_id)::in, predicate_table::in, predicate_table::out) is det.
@@ -1297,9 +1252,8 @@
:- pred predicate_table_remove_predicate(pred_id::in,
predicate_table::in, predicate_table::out) is det.
- % Search the table for (a) predicates or functions
- % (b) predicates only or (c) functions only
- % matching this (possibly module-qualified) sym_name.
+ % Search the table for (a) predicates or functions (b) predicates only
+ % or (c) functions only matching this (possibly module-qualified) sym_name.
%
:- pred predicate_table_search_sym(predicate_table::in, is_fully_qualified::in,
sym_name::in, list(pred_id)::out) is semidet.
@@ -1310,9 +1264,9 @@
:- pred predicate_table_search_func_sym(predicate_table::in,
is_fully_qualified::in, sym_name::in, list(pred_id)::out) is semidet.
- % Search the table for (a) predicates or functions
- % (b) predicates only or (c) functions only matching this
- % (possibly module-qualified) sym_name & arity.
+ % Search the table for (a) predicates or functions (b) predicates only
+ % or (c) functions only matching this (possibly module-qualified)
+ % sym_name & arity.
%
:- pred predicate_table_search_sym_arity(predicate_table::in,
is_fully_qualified::in, sym_name::in, arity::in, list(pred_id)::out)
@@ -1338,12 +1292,10 @@
:- pred predicate_table_search_func_name(predicate_table::in, string::in,
list(pred_id)::out) is semidet.
- % Search the table for (a) predicates or functions
- % (b) predicates only or (c) functions only
- % matching this name & arity.
- % When searching for functions, the arity used
- % is the arity of the function, not the arity N+1 predicate
- % that it gets converted to.
+ % Search the table for (a) predicates or functions (b) predicates only
+ % or (c) functions only matching this name & arity. When searching for
+ % functions, the arity used is the arity of the function, not the arity
+ % N+1 predicate that it gets converted to.
%
:- pred predicate_table_search_name_arity(predicate_table::in, string::in,
arity::in, list(pred_id)::out) is semidet.
@@ -1354,27 +1306,23 @@
:- pred predicate_table_search_func_name_arity(predicate_table::in, string::in,
arity::in, list(pred_id)::out) is semidet.
- % Search the table for (a) predicates or functions
- % (b) predicates only or (c) functions only
- % matching this module, name & arity.
- % When searching for functions, the arity used
- % is the arity of the function, not the arity N+1 predicate
- % that it gets converted to.
- %
- % Note that in cases (b) and (c) it was previously the case
- % that there could only be one matching pred_id, since
- % each predicate or function could be uniquely identified
- % by its module, name, arity, and category (function/predicate).
- % However this is no longer true, due to nested modules.
- % (For example, `pred foo:bar/2' might match both
- % `pred mod1:foo:bar/2' and `pred mod2:foo:bar/2').
- % I hope it doesn't break anything too badly...
+ % Search the table for (a) predicates or functions (b) predicates only
+ % or (c) functions only matching this module, name & arity. When searching
+ % for functions, the arity used is the arity of the function, not the arity
+ % N+1 predicate that it gets converted to.
+ %
+ % Note that in cases (b) and (c) it was previously the case that there
+ % could only be one matching pred_id, since each predicate or function
+ % could be uniquely identified by its module, name, arity, and category
+ % (function/predicate). However this is no longer true, due to nested
+ % modules. (For example, `pred foo:bar/2' might match both
+ % `pred mod1:foo:bar/2' and `pred mod2:foo:bar/2'). I hope it doesn't
+ % break anything too badly...
%
% (`m_n_a' here is short for "module, name, arity".)
- % Is the item known to be fully qualified?
- % If so, a search for `pred foo.bar/2' will not match
- % `pred baz.foo.bar/2'.
+ % Is the item known to be fully qualified? If so, a search for
+ % `pred foo.bar/2' will not match `pred baz.foo.bar/2'.
:- type is_fully_qualified
---> is_fully_qualified
; may_be_partially_qualified.
@@ -1391,37 +1339,34 @@
is_fully_qualified::in, module_name::in, string::in, arity::in,
list(pred_id)::out) is semidet.
- % Search the table for predicates or functions matching
- % this pred_or_func category, module, name, and arity.
- % When searching for functions, the arity used
- % is the arity of the predicate that the function gets converted
+ % Search the table for predicates or functions matching this pred_or_func
+ % category, module, name, and arity. When searching for functions, the
+ % arity used is the arity of the predicate that the function gets converted
% to, i.e. the arity of the function plus one.
- % NB. This is opposite to what happens with the search
- % predicates declared above!!
+ % NB. This is opposite to what happens with the search predicates
+ % declared above!!
%
:- pred predicate_table_search_pf_m_n_a(predicate_table::in,
is_fully_qualified::in, pred_or_func::in, module_name::in, string::in,
arity::in, list(pred_id)::out) is semidet.
- % Search the table for predicates or functions matching
- % this pred_or_func category, name, and arity.
- % When searching for functions, the arity used
- % is the arity of the predicate that the function gets converted
- % to, i.e. the arity of the function plus one.
- % NB. This is opposite to what happens with the search
- % predicates declared above!!
+ % Search the table for predicates or functions matching this pred_or_func
+ % category, name, and arity. When searching for functions, the arity used
+ % is the arity of the predicate that the function gets converted to,
+ % i.e. the arity of the function plus one.
+ % NB. This is opposite to what happens with the search predicates
+ % declared above!!
%
:- pred predicate_table_search_pf_name_arity(predicate_table::in,
pred_or_func::in, string::in, arity::in, list(pred_id)::out)
is semidet.
- % Search the table for predicates or functions matching
- % this pred_or_func category, sym_name, and arity.
- % When searching for functions, the arity used
- % is the arity of the predicate that the function gets converted
- % to, i.e. the arity of the function plus one.
- % NB. This is opposite to what happens with the search
- % predicates declared above!!
+ % Search the table for predicates or functions matching this pred_or_func
+ % category, sym_name, and arity. When searching for functions, the arity
+ % used is the arity of the predicate that the function gets converted to,
+ % i.e. the arity of the function plus one.
+ % NB. This is opposite to what happens with the search predicates
+ % declared above!!
%
:- pred predicate_table_search_pf_sym_arity(predicate_table::in,
is_fully_qualified::in, pred_or_func::in, sym_name::in, arity::in,
@@ -1435,7 +1380,7 @@
list(pred_id)::out) is semidet.
% predicate_table_insert(PredTable0, PredInfo,
- % NeedQual, PartialQualInfo, PredId, PredTable).
+ % NeedQual, PartialQualInfo, PredId, PredTable):
%
% Insert PredInfo into PredTable0 and assign it a new pred_id.
% You should check beforehand that the pred doesn't already
@@ -1446,10 +1391,9 @@
predicate_table::in, predicate_table::out) is det.
% Equivalent to predicate_table_insert/6, except that only the
- % fully-qualified version of the predicate will be inserted into
- % the predicate symbol table. This is useful for creating
- % compiler-generated predicates which will only ever be accessed
- % via fully-qualified names.
+ % fully-qualified version of the predicate will be inserted into the
+ % predicate symbol table. This is useful for creating % compiler-generated
+ % predicates which will only ever be accessed via fully-qualified names.
%
:- pred predicate_table_insert(pred_info::in, pred_id::out,
predicate_table::in, predicate_table::out) is det.
@@ -1492,57 +1436,56 @@
:- implementation.
-:- type predicate_table --->
- predicate_table(
+:- type predicate_table
+ ---> predicate_table(
preds :: pred_table,
- % map from pred_id to pred_info
+ % Map from pred_id to pred_info.
next_pred_id :: pred_id,
- % next available pred_id
+ % The next available pred_id.
pred_ids :: list(pred_id),
- % the keys of the pred_table - cached
- % here for efficiency
+ % The keys of the pred_table - cached
+ % here for efficiency.
accessibility_table :: accessibility_table,
% How is the predicate accessible?
- % indexes on predicates
+ % Indexes on predicates
pred_name_index :: name_index,
- % map from pred name to pred_id
+ % Map from pred name to pred_id.
pred_name_arity_index :: name_arity_index,
- % map from pred name & arity to pred_id
+ % Map from pred name & arity to pred_id.
pred_module_name_arity_index :: module_name_arity_index,
- % map from pred module, name & arity
- % to pred_id
+ % Map from pred module, name & arity
+ % to pred_id.
- % indexes on functions
+ % Indexes on functions
func_name_index :: name_index,
- % map from func name to pred_id
+ % Map from func name to pred_id.
func_name_arity_index :: name_arity_index,
- % map from func name & arity to pred_id
+ % Map from func name & arity to pred_id.
func_module_name_arity_index :: module_name_arity_index
- % map from func module, name & arity
- % to pred_id
+ % Map from func module, name & arity
+ % to pred_id.
).
:- type accessibility_table == map(pred_id, name_accessibility).
-:- type name_accessibility --->
- access(
+:- type name_accessibility
+ ---> access(
+ % Is this predicate accessible by its unqualified name.
accessible_by_unqualifed_name :: bool,
- % Is this predicate accessible by its
- % unqualified name.
+ % Is this predicate accessible by any partially qualified
+ % names.
accessible_by_partially_qualified_names :: bool
- % Is this predicate accessible by any
- % partially qualified names.
).
:- type name_index == map(string, list(pred_id)).
@@ -1550,11 +1493,11 @@
:- type name_arity_index == map(name_arity, list(pred_id)).
:- type name_arity ---> string / arity.
- % First search on module and name, then search on arity. The two
- % levels are needed because typecheck.m needs to be able to search
- % on module and name only for higher-order terms.
-:- type module_name_arity_index == map(pair(module_name, string),
- map(arity, list(pred_id))).
+ % First search on module and name, then search on arity. The two levels
+ % are needed because typecheck.m needs to be able to search on module
+ % and name only for higher-order terms.
+:- type module_name_arity_index ==
+ map(pair(module_name, string), map(arity, list(pred_id))).
predicate_table_init(PredicateTable) :-
PredicateTable = predicate_table(Preds, NextPredId, PredIds,
@@ -1662,7 +1605,8 @@
map__lookup(MNA0, Module - Name, Arities0),
map__lookup(Arities0, Arity, PredIds0),
list__delete_all(PredIds0, PredId, PredIds),
- ( PredIds = [] ->
+ (
+ PredIds = [],
map__delete(Arities0, Arity, Arities),
( map__is_empty(Arities) ->
map__delete(MNA0, Module - Name, MNA)
@@ -1670,6 +1614,7 @@
map__det_update(MNA0, Module - Name, Arities, MNA)
)
;
+ PredIds = [_ | _],
map__det_update(Arities0, Arity, PredIds, Arities),
map__det_update(MNA0, Module - Name, Arities, MNA)
).
@@ -1712,9 +1657,6 @@
IsFullyQualified, Module, Name, PredIdList),
PredIdList = [_ | _].
- % Given a list of predicates, and a module name, find all the
- % predicates which came from that module.
-
%-----------------------------------------------------------------------------%
predicate_table_search_sym_arity(PredicateTable, IsFullyQualified,
@@ -1723,8 +1665,7 @@
IsFullyQualified, Module, Name, Arity, PredIdList).
predicate_table_search_sym_arity(PredicateTable, may_be_partially_qualified,
unqualified(Name), Arity, PredIdList) :-
- predicate_table_search_name_arity(PredicateTable, Name, Arity,
- PredIdList).
+ predicate_table_search_name_arity(PredicateTable, Name, Arity, PredIdList).
predicate_table_search_pred_sym_arity(PredicateTable, IsFullyQualified,
qualified(Module, Name), Arity, PredIdList) :-
@@ -1749,18 +1690,12 @@
%-----------------------------------------------------------------------------%
predicate_table_search_name(PredicateTable, Name, PredIds) :-
- (
- predicate_table_search_pred_name(PredicateTable, Name,
- PredPredIds0)
- ->
+ ( predicate_table_search_pred_name(PredicateTable, Name, PredPredIds0) ->
PredPredIds = PredPredIds0
;
PredPredIds = []
),
- (
- predicate_table_search_func_name(PredicateTable, Name,
- FuncPredIds0)
- ->
+ ( predicate_table_search_func_name(PredicateTable, Name, FuncPredIds0) ->
FuncPredIds = FuncPredIds0
;
FuncPredIds = []
@@ -1883,35 +1818,38 @@
PredIds = [_ | _].
predicate_table_search_pred_m_n_a(PredicateTable, IsFullyQualified,
- Module, PredName, Arity, PredIds) :-
+ Module, PredName, Arity, !:PredIds) :-
P_MNA_Index = PredicateTable ^ pred_module_name_arity_index,
map__search(P_MNA_Index, Module - PredName, ArityIndex),
- map__search(ArityIndex, Arity, PredIds0),
- maybe_filter_pred_ids_matching_module(IsFullyQualified,
- Module, PredicateTable, PredIds0, PredIds).
+ map__search(ArityIndex, Arity, !:PredIds),
+ maybe_filter_pred_ids_matching_module(IsFullyQualified, Module,
+ PredicateTable, !PredIds).
predicate_table_search_func_m_n_a(PredicateTable, IsFullyQualified,
- Module, FuncName, Arity, PredIds) :-
+ Module, FuncName, Arity, !:PredIds) :-
F_MNA_Index = PredicateTable ^ func_module_name_arity_index,
map__search(F_MNA_Index, Module - FuncName, ArityIndex),
- map__search(ArityIndex, Arity, PredIds0),
- maybe_filter_pred_ids_matching_module(IsFullyQualified,
- Module, PredicateTable, PredIds0, PredIds).
+ map__search(ArityIndex, Arity, !:PredIds),
+ maybe_filter_pred_ids_matching_module(IsFullyQualified, Module,
+ PredicateTable, !PredIds).
:- pred maybe_filter_pred_ids_matching_module(is_fully_qualified::in,
module_name::in, predicate_table::in, list(pred_id)::in,
list(pred_id)::out) is det.
maybe_filter_pred_ids_matching_module(may_be_partially_qualified, _, _,
- PredIds, PredIds).
+ !PredIds).
maybe_filter_pred_ids_matching_module(is_fully_qualified, ModuleName,
- PredicateTable, PredIds0, PredIds) :-
+ PredicateTable, !PredIds) :-
predicate_table_get_preds(PredicateTable, Preds),
- PredIds = list__filter(
- (pred(PredId::in) is semidet :-
+ list__filter(pred_id_matches_module(Preds, ModuleName), !PredIds).
+
+:- pred pred_id_matches_module(pred_table::in, module_name::in, pred_id::in)
+ is semidet.
+
+pred_id_matches_module(Preds, ModuleName, PredId) :-
map__lookup(Preds, PredId, PredInfo),
- ModuleName = pred_info_module(PredInfo)
- ), PredIds0).
+ ModuleName = pred_info_module(PredInfo).
%-----------------------------------------------------------------------------%
@@ -1962,14 +1900,19 @@
predicate_table_get_preds(OrigPredicateTable, Preds),
AccessibilityTable = OrigPredicateTable ^ accessibility_table,
- % Note that we use foldr here rather than foldl,
- % so that the PredIds list in the predicate table
- % is the same as the PredIds list argument here
- % (if we used foldl, it would get reversed, since each
- % new predicate inserted into the table gets its pred_id
- % added at the start of the list).
- PredicateTable = list__foldr(
- (func(PredId, Table0) = Table :-
+ % Note that we use foldr here rather than foldl, so that the PredIds list
+ % in the predicate table is the same as the PredIds list argument here
+ % (if we used foldl, it would get reversed, since each new predicate
+ % inserted into the table gets its pred_id added at the start of the list).
+ list__foldr(reinsert_for_restrict(PartialQualInfo, Preds,
+ AccessibilityTable), PredIds, PredicateTable0, PredicateTable).
+
+:- pred reinsert_for_restrict(partial_qualifier_info::in, pred_table::in,
+ accessibility_table::in, pred_id::in,
+ predicate_table::in, predicate_table::out) is det.
+
+reinsert_for_restrict(PartialQualInfo, Preds, AccessibilityTable, PredId,
+ !Table) :-
PredInfo = map__lookup(Preds, PredId),
Access = map__lookup(AccessibilityTable, PredId),
Access = access(Unqualified, PartiallyQualified),
@@ -1988,9 +1931,7 @@
MaybeQualInfo = no
),
predicate_table_insert_2(yes(PredId), PredInfo,
- NeedQual, MaybeQualInfo, _, Table0, Table)
-
- ), PredIds, PredicateTable0).
+ NeedQual, MaybeQualInfo, _, !Table).
:- pred predicate_table_reset(predicate_table::in, predicate_table::out)
is det.
@@ -1998,28 +1939,27 @@
predicate_table_reset(PredicateTable0, PredicateTable) :-
NextPredId = PredicateTable0 ^ next_pred_id,
PredicateTable = predicate_table(map__init, NextPredId, [], map__init,
- map__init, map__init, map__init,
- map__init, map__init, map__init).
+ map__init, map__init, map__init, map__init, map__init, map__init).
%-----------------------------------------------------------------------------%
-predicate_table_insert(PredInfo, PredId, PredicateTable0, PredicateTable) :-
+predicate_table_insert(PredInfo, PredId, !PredicateTable) :-
predicate_table_insert_2(no, PredInfo, must_be_qualified, no, PredId,
- PredicateTable0, PredicateTable).
+ !PredicateTable).
predicate_table_insert(PredInfo, NeedQual, QualInfo, PredId,
- PredicateTable0, PredicateTable) :-
+ !PredicateTable) :-
predicate_table_insert_2(no, PredInfo, NeedQual, yes(QualInfo), PredId,
- PredicateTable0, PredicateTable).
+ !PredicateTable).
:- pred predicate_table_insert_2(maybe(pred_id)::in, pred_info::in,
need_qualifier::in, maybe(partial_qualifier_info)::in, pred_id::out,
predicate_table::in, predicate_table::out) is det.
predicate_table_insert_2(MaybePredId, PredInfo, NeedQual, MaybeQualInfo,
- PredId, PredicateTable0, PredicateTable) :-
+ PredId, !PredicateTable) :-
- PredicateTable0 = predicate_table(Preds0, NextPredId0, PredIds0,
+ !.PredicateTable = predicate_table(Preds0, NextPredId0, PredIds0,
AccessibilityTable0,
Pred_N_Index0, Pred_NA_Index0, Pred_MNA_Index0,
Func_N_Index0, Func_NA_Index0, Func_MNA_Index0),
@@ -2030,13 +1970,13 @@
MaybePredId = yes(PredId),
NextPredId = NextPredId0
;
- % allocate a new pred_id
+ % Allocate a new pred_id.
MaybePredId = no,
PredId = NextPredId0,
hlds_pred__next_pred_id(PredId, NextPredId)
),
- % insert the pred_id into either the function or predicate
- % indices, as appropriate
+ % Insert the pred_id into either the function or predicate indices,
+ % as appropriate.
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
(
PredOrFunc = predicate,
@@ -2065,13 +2005,13 @@
Pred_MNA_Index = Pred_MNA_Index0
),
- % insert the pred_id into the pred_id list
+ % Insert the pred_id into the pred_id list.
PredIds = [PredId | PredIds0],
- % save the pred_info for this pred_id
+ % Save the pred_info for this pred_id.
map__det_insert(Preds0, PredId, PredInfo, Preds),
- PredicateTable = predicate_table(Preds, NextPredId, PredIds,
+ !:PredicateTable = predicate_table(Preds, NextPredId, PredIds,
AccessibilityTable,
Pred_N_Index, Pred_NA_Index, Pred_MNA_Index,
Func_N_Index, Func_NA_Index, Func_MNA_Index).
@@ -2084,66 +2024,55 @@
module_name_arity_index::in, module_name_arity_index::out) is det.
predicate_table_do_insert(Module, Name, Arity, NeedQual, MaybeQualInfo,
- PredId, AccessibilityTable0, AccessibilityTable,
- N_Index0, N_Index, NA_Index0, NA_Index,
- MNA_Index0, MNA_Index) :-
+ PredId, !AccessibilityTable, !N_Index, !NA_Index, !MNA_Index) :-
(
NeedQual = may_be_unqualified,
- % insert the unqualified name into the name index
- multi_map__set(N_Index0, Name, PredId, N_Index),
+ % Insert the unqualified name into the name index.
+ svmulti_map__set(Name, PredId, !N_Index),
- % insert the unqualified name/arity into the
- % name/arity index
+ % Insert the unqualified name/arity into the name/arity index.
NA = Name / Arity,
- multi_map__set(NA_Index0, NA, PredId, NA_Index),
+ svmulti_map__set(NA, PredId, !NA_Index),
AccessibleByUnqualifiedName = yes
;
NeedQual = must_be_qualified,
- N_Index = N_Index0,
- NA_Index = NA_Index0,
AccessibleByUnqualifiedName = no
),
(
MaybeQualInfo = yes(QualInfo),
- % insert partially module-qualified versions
- % of the name into the module:name/arity index
+ % Insert partially module-qualified versions of the name into the
+ % module.name/arity index.
get_partial_qualifiers(Module, QualInfo, PartialQuals),
- list__map_foldl((pred(AncModule::in, AncModule::out,
- MNAs0::in, MNAs::out) is det :-
- insert_into_mna_index(AncModule, Name, Arity,
- PredId, MNAs0, MNAs)
- ), PartialQuals, _, MNA_Index0, MNA_Index1),
+ list__foldl((pred(AncModule::in, MNAs0::in, MNAs::out) is det :-
+ insert_into_mna_index(AncModule, Name, Arity, PredId,
+ MNAs0, MNAs)
+ ), PartialQuals, !MNA_Index),
AccessibleByPartiallyQualifiedNames = yes
;
MaybeQualInfo = no,
- MNA_Index1 = MNA_Index0,
AccessibleByPartiallyQualifiedNames = no
),
- % insert the fully-qualified name into the
- % module:name/arity index
- insert_into_mna_index(Module, Name, Arity, PredId,
- MNA_Index1, MNA_Index),
+ % Insert the fully-qualified name into the module.name/arity index.
+ insert_into_mna_index(Module, Name, Arity, PredId, !MNA_Index),
Access = access(AccessibleByUnqualifiedName,
AccessibleByPartiallyQualifiedNames),
- map__set(AccessibilityTable0, PredId, Access, AccessibilityTable).
+ svmap__set(PredId, Access, !AccessibilityTable).
:- pred insert_into_mna_index(module_name::in, string::in, arity::in,
pred_id::in, module_name_arity_index::in,
module_name_arity_index::out) is det.
-insert_into_mna_index(Module, Name, Arity, PredId, MNA_Index0, MNA_Index) :-
- ( map__search(MNA_Index0, Module - Name, MN_Arities0) ->
+insert_into_mna_index(Module, Name, Arity, PredId, !MNA_Index) :-
+ ( map__search(!.MNA_Index, Module - Name, MN_Arities0) ->
multi_map__set(MN_Arities0, Arity, PredId, MN_Arities),
- map__det_update(MNA_Index0, Module - Name, MN_Arities,
- MNA_Index)
+ svmap__det_update(Module - Name, MN_Arities, !MNA_Index)
;
map__init(MN_Arities0),
map__det_insert(MN_Arities0, Arity, [PredId], MN_Arities),
- map__det_insert(MNA_Index0, Module - Name, MN_Arities,
- MNA_Index)
+ svmap__det_insert(Module - Name, MN_Arities, !MNA_Index)
).
%-----------------------------------------------------------------------------%
@@ -2153,9 +2082,8 @@
module_info_get_predicate_table(ModuleInfo, PredicateTable),
list__length(ArgTypes, Arity),
(
- predicate_table_search_pf_sym_arity(PredicateTable,
- IsFullyQualified, PredOrFunc, SymName,
- Arity, PredIds),
+ predicate_table_search_pf_sym_arity(PredicateTable, IsFullyQualified,
+ PredOrFunc, SymName, Arity, PredIds),
% Resolve overloading using the argument types.
typecheck__find_matching_pred_id(PredIds, ModuleInfo,
TVarSet, ArgTypes, PredId0, _PredName)
@@ -2174,8 +2102,8 @@
->
PredId = PredId0
;
- % Undefined/invalid pred or func.
- % the type-checker should ensure that this never happens
+ % Undefined/invalid pred or func. The type-checker should ensure
+ % that this never happens
list__length(ArgTypes, Arity),
PredOrFuncStr = prog_out__pred_or_func_to_str(PredOrFunc),
mdbcomp__prim_data__sym_name_to_string(SymName, Name2),
@@ -2203,18 +2131,15 @@
ProcIds = [],
string__append_list([
"cannot take address of ", PredOrFuncStr,
- "\n`", Name, "/", ArityString,
- "' with no modes.\n",
- "(Sorry, confused by earlier errors -- ",
- "bailing out.)"],
+ "\n`", Name, "/", ArityString, "' with no modes.\n",
+ "(Sorry, confused by earlier errors -- bailing out.)"],
Message)
;
ProcIds = [_ | _],
string__append_list([
"sorry, not implemented: ",
"taking address of ", PredOrFuncStr,
- "\n`", Name, "/", ArityString,
- "' with multiple modes.\n",
+ "\n`", Name, "/", ArityString, "' with multiple modes.\n",
"(use an explicit lambda expression instead)"],
Message)
),
@@ -2227,42 +2152,37 @@
(
(
PredOrFunc = predicate,
- predicate_table_search_pred_m_n_a(PredTable,
- is_fully_qualified, ModuleName, ProcName,
- Arity, [PredId0])
+ predicate_table_search_pred_m_n_a(PredTable, is_fully_qualified,
+ ModuleName, ProcName, Arity, [PredId0])
;
PredOrFunc = function,
- predicate_table_search_func_m_n_a(PredTable,
- is_fully_qualified, ModuleName, ProcName,
- Arity, [PredId0])
+ predicate_table_search_func_m_n_a(PredTable, is_fully_qualified,
+ ModuleName, ProcName, Arity, [PredId0])
)
->
PredId = PredId0
;
- % Some of the table builtins are polymorphic,
- % and for them we need to subtract one from the arity
- % to take into account the type_info argument.
- % XXX The caller should supply us with the exact arity.
+ % Some of the table builtins are polymorphic, and for them we need
+ % to subtract one from the arity to take into account the type_info
+ % argument. XXX The caller should supply us with the exact arity.
% Guessing how many of the arguments are typeinfos and/or
- % typeclass_infos, as this code here does, is error-prone
- % as well as inefficient.
+ % typeclass_infos, as this code here does, is error-prone as well as
+ % inefficient.
(
PredOrFunc = predicate,
- predicate_table_search_pred_m_n_a(PredTable,
- is_fully_qualified, ModuleName, ProcName,
- Arity - 1, [PredId0])
+ predicate_table_search_pred_m_n_a(PredTable, is_fully_qualified,
+ ModuleName, ProcName, Arity - 1, [PredId0])
;
PredOrFunc = function,
- predicate_table_search_func_m_n_a(PredTable,
- is_fully_qualified, ModuleName, ProcName,
- Arity - 1, [PredId0])
+ predicate_table_search_func_m_n_a(PredTable, is_fully_qualified,
+ ModuleName, ProcName, Arity - 1, [PredId0])
)
->
PredId = PredId0
;
string__int_to_string(Arity, ArityS),
- string__append_list(["can't locate ", ProcName,
- "/", ArityS], ErrorMessage),
+ string__append_list(["can't locate ", ProcName, "/", ArityS],
+ ErrorMessage),
error(ErrorMessage)
),
module_info_pred_info(Module, PredId, PredInfo),
@@ -2272,8 +2192,7 @@
( ProcIds = [ProcId0] ->
ProcId = ProcId0
;
- error(string__format(
- "expected single mode for %s/%d",
+ error(string__format("expected single mode for %s/%d",
[s(ProcName), i(Arity)]))
)
;
@@ -2281,8 +2200,7 @@
( list__index0(ProcIds, N, ProcId0) ->
ProcId = ProcId0
;
- error(string__format(
- "there is no mode %d for %s/%d",
+ error(string__format("there is no mode %d for %s/%d",
[i(N), s(ProcName), i(Arity)]))
)
).
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.365
diff -u -b -r1.365 hlds_out.m
--- compiler/hlds_out.m 22 Aug 2005 03:55:10 -0000 1.365
+++ compiler/hlds_out.m 7 Sep 2005 04:18:23 -0000
@@ -2352,8 +2352,8 @@
io__write_string("\n", !IO).
hlds_out__write_unification(construct(Var, ConsId, ArgVars, ArgModes,
- _ConstructHow, Uniqueness, Size), ModuleInfo, ProgVarSet,
- InstVarSet, AppendVarNums, Indent, !IO) :-
+ _ConstructHow, Uniqueness, SubInfo), ModuleInfo,
+ ProgVarSet, InstVarSet, AppendVarNums, Indent, !IO) :-
hlds_out__write_indent(Indent, !IO),
io__write_string("% ", !IO),
mercury_output_var(Var, ProgVarSet, AppendVarNums, !IO),
@@ -2368,7 +2368,20 @@
Uniqueness = cell_is_shared
),
(
- Size = yes(SizeSource),
+ SubInfo = no_construct_sub_info
+ ;
+ SubInfo = construct_sub_info(MaybeTakeAddr, MaybeSize),
+ (
+ MaybeTakeAddr = yes(TakeAddressFields),
+ hlds_out__write_indent(Indent, !IO),
+ io__write_string("% take address fields: ", !IO),
+ write_intlist(TakeAddressFields, !IO),
+ io__write_string("\n", !IO)
+ ;
+ MaybeTakeAddr = no
+ ),
+ (
+ MaybeSize = yes(SizeSource),
hlds_out__write_indent(Indent, !IO),
io__write_string("% term size ", !IO),
(
@@ -2383,7 +2396,8 @@
io__write_string("\n", !IO)
)
;
- Size = no
+ MaybeSize = no
+ )
).
hlds_out__write_unification(deconstruct(Var, ConsId, ArgVars, ArgModes,
@@ -3861,7 +3875,7 @@
io__write_string("[]", !IO)
;
IntList = [H | T],
- io__write_string("[ ", !IO),
+ io__write_string("[", !IO),
hlds_out__write_intlist_2(H, T, !IO),
io__write_string("]", !IO)
).
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.175
diff -u -b -r1.175 hlds_pred.m
--- compiler/hlds_pred.m 27 Aug 2005 09:41:55 -0000 1.175
+++ compiler/hlds_pred.m 7 Sep 2005 06:48:49 -0000
@@ -1195,17 +1195,17 @@
; context % Perform the context transformation on the predicate.
% See context.m
- ; generate_inline % Used for small Aditi predicates which
- % project a relation to be used as input to a
- % call to an Aditi predicate in a lower SCC.
- % The goal for the predicate should consist
- % of fail, true or a single rule.
- % These relations are never memoed.
- % The reason for this marker is explained
- % where it is introduced in
+ ; generate_inline
+ % Used for small Aditi predicates which project a
+ % relation to be used as input to a call to an Aditi
+ % predicate in a lower SCC. The goal for the predicate
+ % should consist of fail, true or a single rule.
+ % These relations are never memoed. The reason for this
+ % marker is explained where it is introduced in
% magic_util__create_closure.
- ; class_method % Requests that this predicate be transformed into
+ ; class_method
+ % Requests that this predicate be transformed into
% the appropriate call to a class method.
; class_instance_method
@@ -1232,7 +1232,8 @@
% calls to this predicate. This includes removing
% redundant calls to it on different sides of an
% impure goal.
- ; promised_pure % Requests that calls to this predicate be transformed
+ ; promised_pure
+ % Requests that calls to this predicate be transformed
% as usual, despite any impure or semipure markers
% present.
; promised_semipure
@@ -1311,6 +1312,13 @@
; untuple(
int % The procedure number of the original procedure.
)
+ ; return_via_ptr(
+ proc_id,
+ % The id of the procedure this predicate is derived from.
+ list(int)
+ % The arguments in these positions are returned via
+ % pointer.
+ )
; table_generator
; dnf(
int % This predicate was originally part of a predicate
@@ -1328,37 +1336,31 @@
:- type pred_origin
---> special_pred(special_pred)
- % If the predicate is a unify, compare,
- % index or initialisation predicate, specify
- % which one, and for which type constructor.
+ % If the predicate is a unify, compare, index or initialisation
+ % predicate, specify which one, and for which type constructor.
; instance_method(instance_method_constraints)
- % If this predicate is a class method
- % implementation, record extra information
- % about the class context to allow
- % polymorphism.m to correctly set up the extra
- % type_info and typeclass_info arguments.
+ % If this predicate is a class method implementation, record
+ % extra information about the class context to allow
+ % polymorphism.m to correctly set up the extra type_info
+ % and typeclass_info arguments.
; transformed(pred_transformation, pred_origin, pred_id)
- % The predicate is a transformed version of
- % another predicate, whose origin and identity
- % are given by the second and third arguments.
+ % The predicate is a transformed version of another predicate,
+ % whose origin and identity are given by the second and third
+ % arguments.
; created(pred_creation)
- % The predicate was created by the compiler,
- % and there is no information available on
- % where it came from. (Mostly because such
- % relationships are fuzzy in the aditi
- % backend.)
+ % The predicate was created by the compiler, and there is no
+ % information available on where it came from. (Mostly because
+ % such relationships are fuzzy in the Aditi backend.)
; assertion(string, int)
% The predicate represents an assertion.
; lambda(string, int, int)
- % The predicate is a higher-order manifest
- % constant. The arguments specify its location
- % in the source, as a filename/line number
- % pair, and a sequence number used to
- % distinguish multiple lambdas on the same
- % line.
+ % The predicate is a higher-order manifest constant.
+ % The arguments specify its location in the source, as a
+ % filename/line number pair, and a sequence number used to
+ % distinguish multiple lambdas on the same line.
; user(sym_name).
- % The predicate is a normal user-written
- % predicate; the string is its name.
+ % The predicate is a normal user-written predicate;
+ % the string is its name.
% pred_info_init(ModuleName, SymName, Arity, PredOrFunc, Context,
% Origin, Status, GoalType, Markers, ArgTypes, TypeVarSet,
@@ -1458,6 +1460,14 @@
:- pred pred_info_clauses_info(pred_info::in, clauses_info::out) is det.
:- pred pred_info_procedures(pred_info::in, proc_table::out) is det.
+ % Setting the name of a pred_info after its creation won't remove its name
+ % from the indexes under its old name or insert into the indexes under its
+ % new name. If is therefore safe to do this only after all the passes that
+ % look up predicates by name.
+ %
+:- pred pred_info_set_name(string::in,
+ pred_info::in, pred_info::out) is det.
+
:- pred pred_info_set_origin(pred_origin::in,
pred_info::in, pred_info::out) is det.
:- pred pred_info_set_import_status(import_status::in,
@@ -2039,6 +2049,7 @@
pred_info_clauses_info(PI, PI ^ clauses_info).
pred_info_procedures(PI, PI ^ procedures).
+pred_info_set_name(X, PI, PI ^ name := X).
pred_info_set_origin(X, PI, PI ^ pred_origin := X).
pred_info_set_import_status(X, PI, PI ^ import_status := X).
pred_info_set_goal_type(X, PI, PI ^ goal_type := X).
@@ -3366,6 +3377,7 @@
:- pred no_type_info_builtin_2(builtin_mod::out, string::in, int::in)
is semidet.
+no_type_info_builtin_2(private_builtin, "store_at_ref", 2).
no_type_info_builtin_2(private_builtin, "unsafe_type_cast", 2).
no_type_info_builtin_2(builtin, "unsafe_promise_unique", 2).
no_type_info_builtin_2(private_builtin, "superclass_from_typeclass_info", 3).
Index: compiler/lambda.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/lambda.m,v
retrieving revision 1.102
diff -u -b -r1.102 lambda.m
--- compiler/lambda.m 27 Aug 2005 09:41:55 -0000 1.102
+++ compiler/lambda.m 6 Sep 2005 03:03:19 -0000
@@ -584,7 +584,7 @@
Functor = functor(ConsId, no, ArgVars),
Unification = construct(Var, ConsId, ArgVars, UniModes,
- construct_dynamically, cell_is_unique, no),
+ construct_dynamically, cell_is_unique, no_construct_sub_info),
LambdaInfo = lambda_info(VarSet, VarTypes, Constraints, TVarSet,
InstVarSet, RttiVarMaps, Markers, POF, OrigPredName, Owner,
ModuleInfo, MustRecomputeNonLocals).
Index: compiler/layout_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/layout_out.m,v
retrieving revision 1.50
diff -u -b -r1.50 layout_out.m
--- compiler/layout_out.m 14 Aug 2005 03:20:39 -0000 1.50
+++ compiler/layout_out.m 6 Sep 2005 10:56:44 -0000
@@ -1227,8 +1227,16 @@
pred_transform_name(loop_invariant(Proc)) = "inv_" ++ int_to_string(Proc).
pred_transform_name(tuple(Proc)) = "tup_" ++ int_to_string(Proc).
pred_transform_name(untuple(Proc)) = "untup_" ++ int_to_string(Proc).
+pred_transform_name(return_via_ptr(ProcId, ArgPos)) =
+ "retptr_" ++ int_to_string(proc_id_to_int(ProcId)) ++ "_args"
+ ++ ints_to_string(ArgPos).
pred_transform_name(table_generator) = "table_gen".
pred_transform_name(dnf(N)) = "dnf_" ++ int_to_string(N).
+
+:- func ints_to_string(list(int)) = string.
+
+ints_to_string([]) = "".
+ints_to_string([N | Ns]) = "_" ++ int_to_string(N) ++ ints_to_string(Ns).
:- func subst_to_name(pair(int, type)) = string.
Index: compiler/lco.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/lco.m,v
retrieving revision 1.24
diff -u -b -r1.24 lco.m
--- compiler/lco.m 24 Mar 2005 05:34:05 -0000 1.24
+++ compiler/lco.m 12 Sep 2005 04:38:27 -0000
@@ -1,13 +1,102 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 1996-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
-
-% Main author: zs
-
-% This module looks for opportunities to apply the "last call modulo
-% constructor application" optimization.
+%
+% Author: zs
+%
+% Transform predicates with calls that are tail recursive modulo construction
+% where (1) all recursive calls have the same args participating in the "modulo
+% construction" part and (2) all the other output args are returned in the same
+% registers in all recursive calls as expected by the head.
+%
+% p(In1, ... InN, Out1, ... OutM) :-
+% Out1 = ground
+% p(In1, ... InN, Out1, ... OutM) :-
+% ...
+% p(In1, ... InN, Mid1, Out2... OutM)
+% Out1 = f1(...Mid1...)
+%
+% The definition of append fits this pattern:
+%
+% app(list(T)::in, list(T)::in, list(T)::out)
+% app(A, B, C) :-
+% (
+% A == [],
+% C := B
+% ;
+% A => [H | T],
+% app(T, B, NT),
+% C <= [H | NT]
+% )
+%
+% Concrete example of what the original predicate and its return-via-memory
+% variant should look like for append:
+%
+% app(list(T)::in, list(T)::in, list(T)::out)
+% app(A, B, C) :-
+% (
+% A == [],
+% C := B
+% ;
+% A => [H | T],
+% C <= [H | _NT] capture &HT in AddrHT
+% app'(T, B, AddrHT)
+% )
+%
+% app'(list(T)::in, list(T)::in, c_pointer::in)
+% app'(A, B, AddrC) :-
+% (
+% A == [],
+% C := B,
+% store_at_ref(AddrC, C)
+% ;
+% A => [H | T],
+% C <= [H | _NT] capture &HT in AddrHT
+% store_at_ref(AddrC, C)
+% app'(T, B, AddrHT)
+% )
+%
+% The transformation done on the original predicate is to take recursive calls
+% followed by construction unifications that use outputs of the recursive calls
+% (each being used just once) and
+%
+% 1 move the constructions from after the recursive call to before, and attach
+% a feature to them that tells the code generator to not define a given list
+% of fields, but to capture their addresses in the related variable instead,
+%
+% 2 make the call go to the variant, and pass the address variables (e.g.
+% AddrHT) as inputs instead of the original variables (e.g. HT) as outputs.
+%
+% The variant predicate is based on the transformed version of the original
+% predicate, but it has a further transformation performed on it. This further
+% transformation
+%
+% 3 replaces the output arguments with input arguments of type c_pointer, and
+%
+% 4 follows each primitive goal that binds one of the output arguments
+% with a store to the memory location indicated by the corresponding pointer.
+%
+% p(In1, ... InN, Out1, ... OutM) :-
+% Out1 = ground
+% p(In1, ... InN, Out1, ... OutM) :-
+% ...
+% Out1 = f1(...Mid1...)
+% capture addr of Mid1 in Addr1
+% p'(In1, ... InN, Addr1, Out2... OutM)
+%
+% p'(In1, ... InN, Ref1, ... OutM) :-
+% Out1 = ground,
+% store_at_ref(Ref1, Out1)
+% p'(In1, ... InN, Ref1, Out2... OutM) :-
+% ...
+% Out1 = f1(...Mid1...)
+% capture addr of Mid1 in Addr1
+% store_at_ref(Ref1, Out1)
+% p'(In1, ... InN, Addr1, Out2... OutM)
%-----------------------------------------------------------------------------%
@@ -16,145 +105,851 @@
:- interface.
:- import_module hlds__hlds_module.
-:- import_module hlds__hlds_pred.
-
-:- import_module io.
-:- 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.
+:- pred lco_modulo_constructors(module_info::in, module_info::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
+:- import_module check_hlds__inst_match.
+:- import_module check_hlds__mode_util.
+:- import_module check_hlds__type_util.
+:- import_module hlds__arg_info.
+:- import_module hlds__goal_util.
+:- import_module hlds__hlds_code_util.
+:- import_module hlds__hlds_data.
:- import_module hlds__hlds_goal.
-:- import_module hlds__hlds_out.
-:- import_module hlds__passes_aux.
-
+:- import_module hlds__hlds_pred.
+:- import_module hlds__instmap.
+:- import_module hlds__quantification.
+:- import_module parse_tree__error_util.
+:- import_module parse_tree__prog_data.
+:- import_module parse_tree__prog_mode.
+:- import_module transform_hlds__dependency_graph.
+
+:- import_module mdbcomp__prim_data.
+
+:- import_module assoc_list.
+:- import_module bag.
+:- import_module bool.
+:- import_module int.
:- import_module list.
+:- import_module map.
:- import_module require.
+:- import_module set.
:- import_module std_util.
+:- import_module string.
+:- import_module svbag.
+:- import_module svmap.
+:- import_module svvarset.
+:- import_module term.
+:- import_module varset.
+
+%-----------------------------------------------------------------------------%
+
+:- type variant_id
+ ---> variant_id(
+ list(int), % Positions of output arguments returned in
+ % memory.
+ pred_proc_id % The id of the variant.
+ ).
+
+:- type variant_map == map(pred_proc_id, variant_id).
+
+:- type permitted
+ ---> permitted
+ ; not_permitted.
+
+:- type changed
+ ---> changed
+ ; not_changed.
+
+:- type lco_info
+ ---> lco_info(
+ module_info :: module_info,
+ cur_scc_variants :: variant_map,
+ var_set :: prog_varset,
+ var_types :: vartypes,
+ permitted :: permitted,
+ changed :: changed
+ ).
+
+:- type lco_const_info
+ ---> lco_const_info(
+ lower_scc_variants :: variant_map,
+ cur_scc :: set(pred_proc_id),
+ cur_proc_id :: pred_proc_id,
+ cur_proc_pred :: pred_info,
+ cur_proc_proc :: proc_info,
+ cur_proc_outputs :: list(prog_var),
+ cur_proc_detism :: determinism
+ ).
%-----------------------------------------------------------------------------%
-lco_modulo_constructors(PredId, ProcId, ModuleInfo, !ProcInfo, !IO) :-
- proc_info_goal(!.ProcInfo, Goal0),
- lco_in_goal(Goal0, ModuleInfo, Goal),
- ( Goal = Goal0 ->
+lco_modulo_constructors(!ModuleInfo) :-
+ module_info_rebuild_dependency_info(!ModuleInfo, DepInfo),
+ hlds_dependency_info_get_dependency_ordering(DepInfo, SCCs),
+ list__foldl2(lco_scc, SCCs, map__init, _, !ModuleInfo).
+
+:- pred lco_scc(list(pred_proc_id)::in, variant_map::in, variant_map::out,
+ module_info::in, module_info::out) is det.
+
+lco_scc(SCC, !VariantMap, !ModuleInfo) :-
+ ModuleInfo0 = !.ModuleInfo,
+ list__foldl4(lco_proc(!.VariantMap, SCC), SCC, !ModuleInfo,
+ map__init, CurSCCVariantMap, map__init, CurSCCUpdateMap,
+ permitted, Permitted),
+ map__to_assoc_list(CurSCCVariantMap, CurSCCVariants),
+ map__to_assoc_list(CurSCCUpdateMap, CurSCCUpdates),
+ (
+ Permitted = permitted,
+ CurSCCUpdates = [_ | _]
+ ->
+ list__foldl(process_proc_update, CurSCCUpdates, !ModuleInfo),
+ list__foldl(process_proc_variant, CurSCCVariants, !ModuleInfo)
+ ;
+ !:ModuleInfo = ModuleInfo0
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred process_proc_update(pair(pred_proc_id, proc_info)::in,
+ module_info::in, module_info::out) is det.
+
+process_proc_update(PredProcId - NewProcInfo, !ModuleInfo) :-
+ PredProcId = proc(PredId, ProcId),
+
+ module_info_preds(!.ModuleInfo, Preds0),
+ map__lookup(Preds0, PredId, PredInfo0),
+ pred_info_procedures(PredInfo0, Procs0),
+ map__det_update(Procs0, ProcId, NewProcInfo, Procs),
+ pred_info_set_procedures(Procs, PredInfo0, PredInfo),
+ map__det_update(Preds0, PredId, PredInfo, Preds),
+ module_info_set_preds(Preds, !ModuleInfo).
+
+:- pred process_proc_variant(pair(pred_proc_id, variant_id)::in,
+ module_info::in, module_info::out) is det.
+
+process_proc_variant(PredProcId - VariantId, !ModuleInfo) :-
+ VariantId = variant_id(AddrOutArgPosns, VariantPredProcId),
+ VariantPredProcId = proc(VariantPredId, VariantProcId),
+ PredProcId = proc(PredId, ProcId),
+
+ module_info_pred_proc_info(!.ModuleInfo, PredId, ProcId,
+ _PredInfo, ProcInfo),
+ transform_variant_proc(!.ModuleInfo, AddrOutArgPosns,
+ ProcInfo, VariantProcInfo),
+
+ some [!VariantPredInfo] (
+ module_info_preds(!.ModuleInfo, Preds0),
+ map__lookup(Preds0, VariantPredId, !:VariantPredInfo),
+ Name0 = pred_info_name(!.VariantPredInfo),
+ pred_info_get_origin(!.VariantPredInfo, Origin0),
+ create_variant_name(AddrOutArgPosns, Name0, Name),
+ Transform = return_via_ptr(ProcId, AddrOutArgPosns),
+ Origin = transformed(Transform, Origin0, PredId),
+ pred_info_set_name(Name, !VariantPredInfo),
+ pred_info_set_origin(Origin, !VariantPredInfo),
+
+ % We throw away any other procs in the variant predicate, because
+ % we create a separate predicate for each variant.
+ map__det_insert(map__init, VariantProcId, VariantProcInfo,
+ VariantProcs),
+ pred_info_set_procedures(VariantProcs, !VariantPredInfo),
+ map__det_update(Preds0, VariantPredId, !.VariantPredInfo, Preds),
+ module_info_set_preds(Preds, !ModuleInfo)
+ ).
+
+:- pred create_variant_name(list(int)::in, string::in, string::out) is det.
+
+create_variant_name([], !Name) :-
+ !:Name = "LCMC_" ++ !.Name.
+create_variant_name([ArgPos | ArgPoss], !Name) :-
+ !:Name = !.Name ++ "_" ++ int_to_string(ArgPos),
+ create_variant_name(ArgPoss, !Name).
+
+%-----------------------------------------------------------------------------%
+
+:- pred lco_proc(variant_map::in, list(pred_proc_id)::in,
+ pred_proc_id::in, module_info::in, module_info::out,
+ variant_map::in, variant_map::out,
+ map(pred_proc_id, proc_info)::in, map(pred_proc_id, proc_info)::out,
+ permitted::in, permitted::out) is det.
+
+lco_proc(LowerSCCVariants, SCC, CurProc, !ModuleInfo, !CurSCCVariants,
+ !CurSCCUpdates, !Permitted) :-
+ (
+ !.Permitted = not_permitted
+ ;
+ !.Permitted = permitted,
+ CurProc = proc(PredId, ProcId),
+ module_info_pred_proc_info(!.ModuleInfo, PredId, ProcId,
+ PredInfo, ProcInfo0),
+ pred_info_import_status(PredInfo, Status),
+ status_defined_in_this_module(Status, DefInThisModule),
+ proc_info_inferred_determinism(ProcInfo0, Detism),
+ (
+ ( DefInThisModule = no
+ ; not acceptable_detism_for_lco(Detism)
+ )
+ ->
+ !:Permitted = not_permitted
+ ;
+ proc_info_varset(ProcInfo0, VarSet0),
+ proc_info_vartypes(ProcInfo0, VarTypes0),
+ proc_info_headvars(ProcInfo0, HeadVars),
+ proc_info_argmodes(ProcInfo0, ArgModes),
+ list__map(map__lookup(VarTypes0), HeadVars, ArgTypes),
+ arg_info__compute_in_and_out_vars(!.ModuleInfo, HeadVars,
+ ArgModes, ArgTypes, _InputHeadVars, OutputHeadVars),
+ proc_info_inferred_determinism(ProcInfo0, CurProcDetism),
+ ConstInfo = lco_const_info(LowerSCCVariants, list_to_set(SCC),
+ CurProc, PredInfo, ProcInfo0, OutputHeadVars, CurProcDetism),
+ Info0 = lco_info(!.ModuleInfo, !.CurSCCVariants,
+ VarSet0, VarTypes0, permitted, not_changed),
+ proc_info_goal(ProcInfo0, Goal0),
+ lco_in_goal(Goal0, Goal, Info0, Info, ConstInfo),
+ Info = lco_info(!:ModuleInfo, !:CurSCCVariants, VarSet, VarTypes,
+ !:Permitted, Changed),
+ (
+ !.Permitted = permitted,
+ Changed = changed
+ ->
+ some [!ProcInfo] (
+ !:ProcInfo = ProcInfo0,
+ proc_info_set_varset(VarSet, !ProcInfo),
+ proc_info_set_vartypes(VarTypes, !ProcInfo),
+ proc_info_set_goal(Goal, !ProcInfo),
+ requantify_proc(!ProcInfo),
+ svmap__det_insert(CurProc, !.ProcInfo, !CurSCCUpdates)
+ )
+ ;
true
+ )
+ )
+ ).
+
+ % Procedures which can succeed more than once can't do proper tail calls,
+ % and procedures that cannot succeed at all should not be optimized
+ % for time.
+ %
+:- pred acceptable_detism_for_lco(determinism::in) is semidet.
+
+acceptable_detism_for_lco(det).
+acceptable_detism_for_lco(semidet).
+acceptable_detism_for_lco(cc_multidet).
+acceptable_detism_for_lco(cc_nondet).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- pred lco_in_goal(hlds_goal::in, hlds_goal::out, lco_info::in, lco_info::out,
+ lco_const_info::in) is det.
+
+lco_in_goal(Goal0 - GoalInfo, Goal - GoalInfo, !Info, ConstInfo) :-
+ (
+ Goal0 = conj(Goals0),
+ lco_in_conj(list__reverse(Goals0), [], bag__init, MaybeGoals,
+ !Info, ConstInfo),
+ (
+ MaybeGoals = yes(Goals),
+ Goal = conj(Goals)
+ ;
+ MaybeGoals = no,
+ % If the top-level conjunction doesn't end with some unifications
+ % we can move before a recursive call, maybe it ends with a switch
+ % or if-then-else, some of whose arms fit that pattern.
+ ( list__split_last(Goals0, AllButLast, Last0) ->
+ lco_in_goal(Last0, Last, !Info, ConstInfo),
+ Goal = conj(AllButLast ++ [Last])
+ ;
+ Goal = Goal0
+ )
+ )
+ ;
+ Goal0 = par_conj(_),
+ Goal = Goal0,
+ !:Info = !.Info ^ permitted := not_permitted
+ ;
+ Goal0 = disj(Goals0),
+ % There is no point in looking for tail calls in the non-last
+ % disjuncts.
+ ( list__split_last(Goals0, AllButLast, Last0) ->
+ lco_in_goal(Last0, Last, !Info, ConstInfo),
+ Goal = disj(AllButLast ++ [Last])
+ ;
+ Goal = Goal0
+ )
+ ;
+ Goal0 = switch(Var, CanFail, Cases0),
+ lco_in_cases(Cases0, Cases, !Info, ConstInfo),
+ Goal = switch(Var, CanFail, Cases)
+ ;
+ Goal0 = if_then_else(Vars, Cond, Then0, Else0),
+ lco_in_goal(Then0, Then, !Info, ConstInfo),
+ lco_in_goal(Else0, Else, !Info, ConstInfo),
+ Goal = if_then_else(Vars, Cond, Then, Else)
;
- % 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)
+ Goal0 = scope(Reason, SubGoal0),
+ lco_in_goal(SubGoal0, SubGoal, !Info, ConstInfo),
+ Goal = scope(Reason, SubGoal)
+ ;
+ Goal0 = not(_),
+ Goal = Goal0
+ ;
+ Goal0 = generic_call(_, _, _, _),
+ Goal = Goal0
+ ;
+ Goal0 = call(_, _, _, _, _, _),
+ Goal = Goal0
+ ;
+ Goal0 = unify(_, _, _, _, _),
+ Goal = Goal0
+ ;
+ Goal0 = foreign_proc(_, _,_, _, _, _),
+ Goal = Goal0
+ ;
+ Goal0 = shorthand(_),
+ unexpected(this_file, "lco_in_goal: shorthand")
).
%-----------------------------------------------------------------------------%
+
+:- pred lco_in_disj(list(hlds_goal)::in, list(hlds_goal)::out,
+ lco_info::in, lco_info::out, lco_const_info::in) is det.
+
+lco_in_disj([], [], !Info, _ConstInfo).
+lco_in_disj([Goal0 | Goals0], [Goal | Goals], !Info, ConstInfo) :-
+ lco_in_goal(Goal0, Goal, !Info, ConstInfo),
+ lco_in_disj(Goals0, Goals, !Info, ConstInfo).
+
+:- pred lco_in_cases(list(case)::in, list(case)::out,
+ lco_info::in, lco_info::out, lco_const_info::in) is det.
+
+lco_in_cases([], [], !Info, _ConstInfo).
+lco_in_cases([case(Cons, Goal0) | Cases0], [case(Cons, Goal) | Cases],
+ !Info, ConstInfo) :-
+ lco_in_goal(Goal0, Goal, !Info, ConstInfo),
+ lco_in_cases(Cases0, Cases, !Info, ConstInfo).
+
+%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-:- pred lco_in_goal(hlds_goal::in, module_info::in, hlds_goal::out) is det.
+ % lco_in_conj(RevGoals, Unifies, ModuleInfo, Goals)
+ %
+ % Given a conjunction whose structure is:
+ %
+ % zero or more arbitrary goals
+ % recursive call that could be a last call modulo constructors
+ % one or more construction unifications
+ %
+ % move the construction unifications before the call.
+ %
+ % We traverse the conjunction backwards (the caller has reversed the list).
+ % RevGoals is the list of remaining goals in the reversed conjunction list.
+ % RevUnifies is the list of assignments and constructions delayed by any
+ % previous recursive invocations of lco_in_conj.
+ %
+ % invariant: append(reverse(RevGoals), Unifies) = original conjunction
+ %
+:- pred lco_in_conj(list(hlds_goal)::in, list(hlds_goal)::in,
+ bag(prog_var)::in, maybe(list(hlds_goal))::out,
+ lco_info::in, lco_info::out, lco_const_info::in) is det.
+
+lco_in_conj([], _Unifies, _UnifyInputVars, no, !Info, _ConstInfo).
+lco_in_conj([RevGoal | RevGoals], !.Unifies, !.UnifyInputVars, MaybeGoals,
+ !Info, ConstInfo) :-
+ RevGoal = RevGoalExpr - RevGoalInfo,
+ ModuleInfo = !.Info ^ module_info,
+ ProcInfo = ConstInfo ^ cur_proc_proc,
+ proc_info_vartypes(ProcInfo, VarTypes),
+ (
+ RevGoalExpr = unify(_, _, _, Unification, _),
+ Unification = construct(ConstructedVar, ConsId, ConstructArgs,
+ ArgUniModes, _, _, SubInfo),
+ (
+ SubInfo = no_construct_sub_info
+ ;
+ SubInfo = construct_sub_info(no, _)
+ ),
+ all_true(acceptable_construct_mode(ModuleInfo), ArgUniModes),
+ map__lookup(VarTypes, ConstructedVar, ConstructedType),
+ ConsTag = cons_id_to_tag(ConsId, ConstructedType, ModuleInfo),
+ % The code generator can't handle the other tags. For example, it
+ % doesn't make sense to the address of the field of a function symbol
+ % of a `notag' type.
+ (
+ ConsTag = unshared_tag(_)
+ ;
+ ConsTag = shared_remote_tag(_, _)
+ )
+ ->
+ svbag__delete(ConstructedVar, !UnifyInputVars),
+ svbag__insert_list(ConstructArgs, !UnifyInputVars),
+ !:Unifies = [RevGoal | !.Unifies],
+ lco_in_conj(RevGoals, !.Unifies, !.UnifyInputVars, MaybeGoals,
+ !Info, ConstInfo)
+ ;
+ RevGoalExpr = call(PredId, ProcId, Args, Builtin, UnifyContext,
+ SymName),
+ set__member(proc(PredId, ProcId), ConstInfo ^ cur_scc),
+ goal_info_get_determinism(RevGoalInfo, RevGoalDetism),
+ RevGoalDetism = ConstInfo ^ cur_proc_detism,
+
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
+ _CalleePredInfo, CalleeProcInfo),
+ proc_info_argmodes(CalleeProcInfo, CalleeArgModes),
+ classify_proc_call_args(ModuleInfo, VarTypes, Args, CalleeArgModes,
+ _InArgs, OutArgs, UnusedArgs),
+ UnusedArgs = [],
+ list__length(OutArgs, NumOutArgs),
+ CurrProcOutArgs = ConstInfo ^ cur_proc_outputs,
+ list__length(CurrProcOutArgs, NumCurrProcOutArgs),
+ NumOutArgs = NumCurrProcOutArgs,
+
+ assoc_list__from_corresponding_lists(OutArgs, CurrProcOutArgs,
+ CallHeadPairs),
+ find_args_to_pass_by_addr(CallHeadPairs, 1, Mismatches,
+ UpdatedCallOutArgs, map__init, Subst, !Info),
+ % If there are no mismatches, we would create an identical "variant".
+ % Such cases should be optimized using other means.
+ Mismatches = [_ | _],
+ assoc_list__values(Mismatches, MismatchedCallArgs),
+ % The variants we create return each output in only one place in
+ % memory.
+ all_true(occurs_once(!.UnifyInputVars), MismatchedCallArgs),
+ ensure_variant_exists(PredId, ProcId, assoc_list__keys(Mismatches),
+ VariantPredProcId, !Info)
+ ->
+ list__map(update_construct(Subst), !.Unifies, UpdatedUnifies),
+ proc_info_argmodes(CalleeProcInfo, CalleeModes),
+ update_call_args(ModuleInfo, VarTypes, CalleeModes, Args,
+ UpdatedCallOutArgs, UpdatedArgs),
+ VariantPredProcId = proc(VariantPredId, VariantProcId),
+ UpdatedGoalExpr = call(VariantPredId, VariantProcId, UpdatedArgs,
+ Builtin, UnifyContext, SymName),
+ UpdatedGoalInfo = RevGoalInfo,
+ UpdatedGoal = UpdatedGoalExpr - UpdatedGoalInfo,
+ Goals = list__reverse(RevGoals) ++ UpdatedUnifies ++ [UpdatedGoal],
+ MaybeGoals = yes(Goals),
+ !:Info = !.Info ^ changed := changed
+ ;
+ % The reversed conjunction does not follow the pattern we are looking
+ % for, so we cannot optimize it.
+ MaybeGoals = no
+ ).
-lco_in_goal(Goal0 - GoalInfo, ModuleInfo, Goal - GoalInfo) :-
- lco_in_goal_2(Goal0, ModuleInfo, Goal).
+:- pred update_call_args(module_info::in, vartypes::in, list(mode)::in,
+ list(prog_var)::in, list(prog_var)::in, list(prog_var)::out) is det.
+
+update_call_args(_ModuleInfo, _VarTypes, [], [], UpdatedCallOutArgs, []) :-
+ require(unify(UpdatedCallOutArgs, []),
+ "update_call_args: updating nonexistent arg").
+update_call_args(_ModuleInfo, _VarTypes, [], [_ | _], _, _) :-
+ unexpected(this_file, "update_call_args: mismatches lists").
+update_call_args(_ModuleInfo, _VarTypes, [_ | _], [], _, _) :-
+ unexpected(this_file, "update_call_args: mismatches lists").
+update_call_args(ModuleInfo, VarTypes, [CalleeMode | CalleeModes],
+ [Arg | Args], !.UpdatedCallOutArgs, !:UpdatedArgs) :-
+ map__lookup(VarTypes, Arg, CalleeType),
+ mode_to_arg_mode(ModuleInfo, CalleeMode, CalleeType, ArgMode),
+ (
+ ArgMode = top_in,
+ update_call_args(ModuleInfo, VarTypes, CalleeModes, Args,
+ !.UpdatedCallOutArgs, !:UpdatedArgs),
+ !:UpdatedArgs = [Arg | !.UpdatedArgs]
+ ;
+ ArgMode = top_out,
+ (
+ !.UpdatedCallOutArgs = [UpdatedArg | !:UpdatedCallOutArgs]
+ ;
+ !.UpdatedCallOutArgs = [],
+ unexpected(this_file, "update_call_args: no UpdatedCallOutArgs")
+ ),
+ update_call_args(ModuleInfo, VarTypes, CalleeModes, Args,
+ !.UpdatedCallOutArgs, !:UpdatedArgs),
+ !:UpdatedArgs = [UpdatedArg | !.UpdatedArgs]
+ ;
+ ArgMode = top_unused,
+ unexpected(this_file, "update_call_args: top_unused")
+ ).
%-----------------------------------------------------------------------------%
-:- pred lco_in_goal_2(hlds_goal_expr::in, module_info::in, hlds_goal_expr::out)
- is det.
+:- pred classify_proc_call_args(module_info::in, vartypes::in,
+ list(prog_var)::in, list(mode)::in,
+ list(prog_var)::out, list(prog_var)::out, list(prog_var)::out) is det.
+
+classify_proc_call_args(_ModuleInfo, _VarTypes, [], [], [], [], []).
+classify_proc_call_args(_ModuleInfo, _VarTypes, [], [_ | _], _, _, _) :-
+ unexpected(this_file, "classify_proc_call_args: mismatches lists").
+classify_proc_call_args(_ModuleInfo, _VarTypes, [_ | _], [], _, _, _) :-
+ unexpected(this_file, "classify_proc_call_args: mismatches lists").
+classify_proc_call_args(ModuleInfo, VarTypes, [Arg | Args],
+ [CalleeMode | CalleeModes], !:InArgs, !:OutArgs, !:UnusedArgs) :-
+ classify_proc_call_args(ModuleInfo, VarTypes, Args, CalleeModes,
+ !:InArgs, !:OutArgs, !:UnusedArgs),
+ map__lookup(VarTypes, Arg, CalleeType),
+ mode_to_arg_mode(ModuleInfo, CalleeMode, CalleeType, ArgMode),
+ (
+ ArgMode = top_in,
+ !:InArgs = [Arg | !.InArgs]
+ ;
+ ArgMode = top_out,
+ !:OutArgs = [Arg | !.OutArgs]
+ ;
+ ArgMode = top_unused,
+ !:UnusedArgs = [Arg | !.UnusedArgs]
+ ).
-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(scope(Reason, Goal0), ModuleInfo, scope(Reason, Goal)) :-
- lco_in_goal(Goal0, ModuleInfo, Goal).
-lco_in_goal_2(not(Goal), _ModuleInfo, not(Goal)).
-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).
+%-----------------------------------------------------------------------------%
+
+:- pred find_args_to_pass_by_addr(assoc_list(prog_var, prog_var)::in, int::in,
+ assoc_list(int, prog_var)::out, list(prog_var)::out,
+ map(prog_var, prog_var)::in, map(prog_var, prog_var)::out,
+ lco_info::in, lco_info::out) is det.
+
+find_args_to_pass_by_addr([], _, [], [], !Subst, !Info).
+find_args_to_pass_by_addr([CallArg - HeadArg | CallHeadArgs], ArgNum,
+ Mismatches, [UpdatedCallArg | UpdatedCallArgs], !Subst, !Info) :-
+ find_args_to_pass_by_addr(CallHeadArgs, ArgNum + 1, MismatchesTail,
+ UpdatedCallArgs, !Subst, !Info),
+ ( CallArg = HeadArg ->
+ UpdatedCallArg = CallArg,
+ Mismatches = MismatchesTail
+ ;
+ make_address_var(CallArg, UpdatedCallArg, !Info),
+ Mismatches = [ArgNum - CallArg | MismatchesTail],
+ svmap__det_insert(CallArg, UpdatedCallArg, !Subst)
+ ).
+
+:- pred make_address_var(prog_var::in, prog_var::out,
+ lco_info::in, lco_info::out) is det.
-lco_in_goal_2(shorthand(_), _, _) :-
- % these should have been expanded out by now
- error("lco_in_goal_2: unexpected shorthand").
+make_address_var(Var, AddrVar, !Info) :-
+ VarSet0 = !.Info ^ var_set,
+ VarTypes0 = !.Info ^ var_types,
+ varset__lookup_name(VarSet0, Var, "SCCcallarg", Name),
+ AddrName = "Addr" ++ Name,
+ varset__new_named_var(VarSet0, AddrName, AddrVar, VarSet),
+ map__det_insert(VarTypes0, AddrVar, c_pointer_type, VarTypes),
+ !:Info = !.Info ^ var_set := VarSet,
+ !:Info = !.Info ^ var_types := VarTypes.
%-----------------------------------------------------------------------------%
-:- pred lco_in_disj(list(hlds_goal)::in, module_info::in, list(hlds_goal)::out)
- is det.
+:- pred ensure_variant_exists(pred_id::in, proc_id::in, list(int)::in,
+ pred_proc_id::out, lco_info::in, lco_info::out) is semidet.
+
+ensure_variant_exists(PredId, ProcId, AddrArgNums, VariantPredProcId, !Info) :-
+ CurSCCVariants0 = !.Info ^ cur_scc_variants,
+ ( map__search(CurSCCVariants0, proc(PredId, ProcId), ExistingVariant) ->
+ ExistingVariant = variant_id(ExistingAddrArgNums, VariantPredProcId),
+ AddrArgNums = ExistingAddrArgNums
+ ;
+ ModuleInfo0 = !.Info ^ module_info,
+ clone_pred_proc(PredId, ClonePredId, ModuleInfo0, ModuleInfo),
+ VariantPredProcId = proc(ClonePredId, ProcId),
+ !:Info = !.Info ^ module_info := ModuleInfo,
+ NewVariant = variant_id(AddrArgNums, VariantPredProcId),
+ map__det_insert(CurSCCVariants0, proc(PredId, ProcId), NewVariant,
+ CurSCCVariants),
+ !:Info = !.Info ^ cur_scc_variants := CurSCCVariants
+ ).
+
+:- pred clone_pred_proc(pred_id::in, pred_id::out,
+ module_info::in, module_info::out) is det.
-lco_in_disj([], __ModuleInfo, []).
-lco_in_disj([Goal0 | Goals0], ModuleInfo, [Goal | Goals]) :-
- lco_in_goal(Goal0, ModuleInfo, Goal),
- lco_in_disj(Goals0, ModuleInfo, Goals).
+clone_pred_proc(PredId, ClonePredId, !ModuleInfo) :-
+ module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
+ module_info_get_predicate_table(!.ModuleInfo, PredTable0),
+ predicate_table_insert(PredInfo, ClonePredId, PredTable0, PredTable),
+ module_info_set_predicate_table(PredTable, !ModuleInfo).
%-----------------------------------------------------------------------------%
-:- pred lco_in_cases(list(case)::in, module_info::in, list(case)::out)
- is det.
+:- pred update_construct(map(prog_var, prog_var)::in,
+ hlds_goal::in, hlds_goal::out) is det.
+
+update_construct(Subst, Goal0, Goal) :-
+ Goal0 = GoalExpr0 - GoalInfo0,
+ (
+ GoalExpr0 = unify(LHS, RHS0, Mode, Unification0, UnifyContext),
+ Unification0 = construct(Var, ConsId, ArgVars, UniModes,
+ How, IsUnique, SubInfo0),
+ (
+ SubInfo0 = no_construct_sub_info,
+ TermSizeSlot = no
+ ;
+ SubInfo0 = construct_sub_info(no, TermSizeSlot)
+ )
+ ->
+ goal_info_get_instmap_delta(GoalInfo0, InstMapDelta0),
+ update_construct_args(Subst, 1, ArgVars, UpdatedArgVars, AddrFields,
+ InstMapDelta0, InstMapDelta),
+ (
+ AddrFields = [],
+ Goal = Goal0
+ ;
+ AddrFields = [_ | _],
+ SubInfo = construct_sub_info(yes(AddrFields), TermSizeSlot),
+ Unification = construct(Var, ConsId, UpdatedArgVars, UniModes,
+ How, IsUnique, SubInfo),
+ % We must update RHS because quantification gets the set of
+ % variables in the unification from there, not from Unification.
+ (
+ RHS0 = var(_),
+ unexpected(this_file, "update_construct: var RHS")
+ ;
+ RHS0 = functor(RHSConsId, IsExistConstr, RHSVars0),
+ require(unify(ConsId, RHSConsId),
+ "update_construct: cons_id mismatch"),
+ rename_var_list(no, Subst, RHSVars0, RHSVars),
+ RHS = functor(RHSConsId, IsExistConstr, RHSVars)
+ ;
+ RHS0 = lambda_goal(_, _, _, _, _, _, _, _, _),
+ unexpected(this_file, "update_construct: lambda RHS")
+ ),
+ GoalExpr = unify(LHS, RHS, Mode, Unification, UnifyContext),
+
+ goal_info_set_instmap_delta(InstMapDelta, GoalInfo0, GoalInfo),
+ Goal = GoalExpr - GoalInfo
+ )
+ ;
+ unexpected(this_file, "update_construct: not construct")
+ ).
-lco_in_cases([], __ModuleInfo, []).
-lco_in_cases([case(Cons, Goal0) | Cases0], ModuleInfo,
- [case(Cons, Goal) | Cases]) :-
- lco_in_goal(Goal0, ModuleInfo, Goal),
- lco_in_cases(Cases0, ModuleInfo, Cases).
+:- pred update_construct_args(map(prog_var, prog_var)::in, int::in,
+ list(prog_var)::in, list(prog_var)::out, list(int)::out,
+ instmap_delta::in, instmap_delta::out) is det.
+
+update_construct_args(_, _, [], [], [], !InstMapDelta).
+update_construct_args(Subst, ArgNum, [OrigVar | OrigVars],
+ [UpdatedVar | UpdatedVars], AddrArgs, !InstMapDelta) :-
+ update_construct_args(Subst, ArgNum + 1, OrigVars, UpdatedVars,
+ AddrArgsTail, !InstMapDelta),
+ ( map__search(Subst, OrigVar, AddrVar) ->
+ UpdatedVar = AddrVar,
+ instmap_delta_set(AddrVar, ground(shared, none), !InstMapDelta),
+ AddrArgs = [ArgNum | AddrArgsTail]
+ ;
+ UpdatedVar = OrigVar,
+ AddrArgs = AddrArgsTail
+ ).
%-----------------------------------------------------------------------------%
+
+:- pred acceptable_construct_mode(module_info::in, uni_mode::in) is semidet.
+
+acceptable_construct_mode(ModuleInfo, UniMode) :-
+ UniMode = ((InitInstX - InitInstY) -> (FinalInstX - FinalInstY)),
+ inst_is_free(ModuleInfo, InitInstX),
+ inst_is_ground(ModuleInfo, InitInstY),
+ inst_is_ground(ModuleInfo, FinalInstX),
+ inst_is_ground(ModuleInfo, FinalInstY).
+
+:- pred occurs_once(bag(prog_var)::in, prog_var::in) is semidet.
+
+occurs_once(Bag, Var) :-
+ bag__count_value(Bag, Var, 1).
+
%-----------------------------------------------------------------------------%
-% lco_in_conj(RevGoals, Unifies, ModuleInfo, Goals)
-%
-% Given a conjunction whose structure is: "goals*,call,construct*",
-% move the construction unifications before the call.
-%
-% For now the transformation results are usable by humans only.
-% XXX Later we will have to modify the instantiation states
-% recorded for the variables involved in the constructions.
-% The ModuleInfo will be probably be needed by this code.
-%
-% We traverse the conjunction backwards (the caller has reversed the list).
-% RevGoals is the list of remaining goals in the reversed conjunction list.
-% RevUnifies is the list of assignments and constructions delayed by any
-% previous recursive invocations of lco_in_conj.
-%
-% invariant: append(reverse(RevGoals), Unifies) = original conjunction
+:- pred transform_variant_proc(module_info::in, list(int)::in,
+ proc_info::in, proc_info::out) is det.
+
+transform_variant_proc(ModuleInfo, AddrOutArgPosns,
+ ProcInfo, !:VariantProcInfo) :-
+ !:VariantProcInfo = ProcInfo,
+ proc_info_varset(ProcInfo, VarSet0),
+ proc_info_vartypes(ProcInfo, VarTypes0),
+ proc_info_headvars(ProcInfo, HeadVars0),
+ proc_info_argmodes(ProcInfo, ArgModes0),
+ make_addr_vars(HeadVars0, ArgModes0, HeadVars, ArgModes,
+ AddrOutArgPosns, 1, ModuleInfo, VarToAddr,
+ VarSet0, VarSet, VarTypes0, VarTypes),
+ proc_info_set_headvars(HeadVars, !VariantProcInfo),
+ proc_info_set_argmodes(ArgModes, !VariantProcInfo),
+ proc_info_set_varset(VarSet, !VariantProcInfo),
+ proc_info_set_vartypes(VarTypes, !VariantProcInfo),
+
+ proc_info_get_initial_instmap(ProcInfo, ModuleInfo, InstMap0),
+ proc_info_goal(ProcInfo, Goal0),
+ transform_variant_goal(ModuleInfo, VarToAddr, InstMap0, Goal0, Goal),
+ proc_info_set_goal(Goal, !VariantProcInfo),
+ % We changed the scopes of the headvars we now return via pointers.
+ requantify_proc(!VariantProcInfo).
+
+:- pred make_addr_vars(list(prog_var)::in, list(mode)::in,
+ list(prog_var)::out, list(mode)::out, list(int)::in,
+ int::in, module_info::in, assoc_list(prog_var)::out,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out) is det.
+
+make_addr_vars([], [], [], [], AddrOutArgPosns, _, _, [], !VarSet, !VarTypes) :-
+ require(unify(AddrOutArgPosns, []),
+ "make_addr_vars: AddrOutArgPosns != []").
+make_addr_vars([], [_ | _], _, _, _, _, _, _, !VarSet, !VarTypes) :-
+ unexpected(this_file, "make_addr_vars: mismatched lists").
+make_addr_vars([_ | _], [], _, _, _, _, _, _, !VarSet, !VarTypes) :-
+ unexpected(this_file, "make_addr_vars: mismatched lists").
+make_addr_vars([HeadVar0 | HeadVars0], [Mode0 | Modes0],
+ [HeadVar | HeadVars], [Mode | Modes], !.AddrOutArgPosns,
+ NextOutArgNum, ModuleInfo, VarToAddr, !VarSet, !VarTypes) :-
+ map__lookup(!.VarTypes, HeadVar0, HeadVarType),
+ mode_to_arg_mode(ModuleInfo, Mode0, HeadVarType, ArgMode),
+ (
+ ArgMode = top_in,
+ HeadVar = HeadVar0,
+ Mode = Mode0,
+ make_addr_vars(HeadVars0, Modes0, HeadVars, Modes, !.AddrOutArgPosns,
+ NextOutArgNum, ModuleInfo, VarToAddr, !VarSet, !VarTypes)
+ ;
+ ArgMode = top_out,
+ ( !.AddrOutArgPosns = [NextOutArgNum | !:AddrOutArgPosns] ->
+ varset__lookup_name(!.VarSet, HeadVar0, Name),
+ AddrName = "AddrOf" ++ Name,
+ svvarset__new_named_var(AddrName, AddrVar, !VarSet),
+ svmap__det_insert(AddrVar, c_pointer_type, !VarTypes),
+ HeadVar = AddrVar,
+ Mode = in_mode,
+ make_addr_vars(HeadVars0, Modes0, HeadVars, Modes,
+ !.AddrOutArgPosns, NextOutArgNum + 1, ModuleInfo,
+ VarToAddrTail, !VarSet, !VarTypes),
+ VarToAddr = [HeadVar0 - AddrVar | VarToAddrTail]
+ ;
+ HeadVar = HeadVar0,
+ Mode = Mode0,
+ make_addr_vars(HeadVars0, Modes0, HeadVars, Modes,
+ !.AddrOutArgPosns, NextOutArgNum + 1, ModuleInfo,
+ VarToAddr, !VarSet, !VarTypes)
+ )
+ ;
+ ArgMode = top_unused,
+ unexpected(this_file, "make_addr_vars: top_unused")
+ ).
-:- pred lco_in_conj(list(hlds_goal)::in, list(hlds_goal)::in, module_info::in,
- list(hlds_goal)::out) is det.
+:- pred transform_variant_goal(module_info::in, assoc_list(prog_var)::in,
+ instmap::in, hlds_goal::in, hlds_goal::out) is det.
-lco_in_conj([], Unifies, __ModuleInfo, Unifies).
-lco_in_conj([Goal0 | Goals0], Unifies0, ModuleInfo, Goals) :-
- Goal0 = GoalExpr0 - _,
+transform_variant_goal(ModuleInfo, VarToAddr, InstMap0,
+ GoalExpr0 - GoalInfo, GoalExpr - GoalInfo) :-
(
- GoalExpr0 = unify(_, _, _, Unif, _),
- Unif = construct(_, _, _, _, _, _, _)
- ->
- Unifies1 = [Goal0 | Unifies0],
- lco_in_conj(Goals0, Unifies1, ModuleInfo, Goals)
+ GoalExpr0 = conj(Goals0),
+ transform_variant_conj(ModuleInfo, VarToAddr, InstMap0, Goals0, Goals),
+ GoalExpr = conj(Goals)
;
- GoalExpr0 = call(_, _, _, _, _, _)
- ->
- list__append(Unifies0, [Goal0], LaterGoals),
- list__reverse(Goals0, FrontGoals),
- list__append(FrontGoals, LaterGoals, Goals)
+ GoalExpr0 = par_conj(_),
+ unexpected(this_file, "transform_variant_goal: par_conj")
+ ;
+ GoalExpr0 = disj(Goals0),
+ list__map(transform_variant_goal(ModuleInfo, VarToAddr, InstMap0),
+ Goals0, Goals),
+ GoalExpr = disj(Goals)
+ ;
+ GoalExpr0 = switch(Var, CanFail, Cases0),
+ list__map(transform_variant_case(ModuleInfo, VarToAddr, InstMap0),
+ Cases0, Cases),
+ GoalExpr = switch(Var, CanFail, Cases)
+ ;
+ GoalExpr0 = if_then_else(Vars, Cond, Then0, Else0),
+ update_instmap(Cond, InstMap0, InstMap1),
+ transform_variant_goal(ModuleInfo, VarToAddr, InstMap1, Then0, Then),
+ transform_variant_goal(ModuleInfo, VarToAddr, InstMap0, Else0, Else),
+ GoalExpr = if_then_else(Vars, Cond, Then, Else)
+ ;
+ GoalExpr0 = scope(Reason, SubGoal0),
+ transform_variant_goal(ModuleInfo, VarToAddr, InstMap0,
+ SubGoal0, SubGoal),
+ GoalExpr = scope(Reason, SubGoal)
+ ;
+ GoalExpr0 = not(_),
+ GoalExpr = GoalExpr0
;
- % The conjunction does not follow the pattern "unify*, goal"
- % so we cannot optimize it; reconstruct the original goal list
- list__reverse([Goal0 | Goals0], FrontGoals),
- list__append(FrontGoals, Unifies0, Goals)
+ GoalExpr0 = generic_call(_, _, _, _),
+ transform_variant_atomic_goal(ModuleInfo, VarToAddr, InstMap0,
+ GoalInfo, GoalExpr0, GoalExpr)
+ ;
+ GoalExpr0 = call(_, _, _, _, _, _),
+ % XXX We could handle recursive calls better.
+ transform_variant_atomic_goal(ModuleInfo, VarToAddr, InstMap0,
+ GoalInfo, GoalExpr0, GoalExpr)
+ ;
+ GoalExpr0 = unify(_, _, _, _, _),
+ transform_variant_atomic_goal(ModuleInfo, VarToAddr, InstMap0,
+ GoalInfo, GoalExpr0, GoalExpr)
+ ;
+ GoalExpr0 = foreign_proc(_, _,_, _, _, _),
+ transform_variant_atomic_goal(ModuleInfo, VarToAddr, InstMap0,
+ GoalInfo, GoalExpr0, GoalExpr)
+ ;
+ GoalExpr0 = shorthand(_),
+ unexpected(this_file, "transform_variant_goal: shorthand")
+ ).
+
+:- pred transform_variant_conj(module_info::in, assoc_list(prog_var)::in,
+ instmap::in, list(hlds_goal)::in, list(hlds_goal)::out) is det.
+
+transform_variant_conj(_, _, _, [], []).
+transform_variant_conj(ModuleInfo, VarToAddr, InstMap0, [Goal0 | Goals0],
+ Conj) :-
+ transform_variant_goal(ModuleInfo, VarToAddr, InstMap0, Goal0, Goal),
+ update_instmap(Goal0, InstMap0, InstMap1),
+ transform_variant_conj(ModuleInfo, VarToAddr, InstMap1, Goals0, Goals),
+ ( Goal = conj(SubConj) - _ ->
+ Conj = SubConj ++ Goals
+ ;
+ Conj = [Goal | Goals]
+ ).
+
+:- pred transform_variant_case(module_info::in,
+ assoc_list(prog_var)::in, instmap::in, case::in, case::out) is det.
+
+transform_variant_case(ModuleInfo, VarToAddr, InstMap0, case(ConsId, Goal0),
+ case(ConsId, Goal)) :-
+ transform_variant_goal(ModuleInfo, VarToAddr, InstMap0, Goal0, Goal).
+
+:- pred transform_variant_atomic_goal(module_info::in,
+ assoc_list(prog_var)::in, instmap::in, hlds_goal_info::in,
+ hlds_goal_expr::in, hlds_goal_expr::out) is det.
+
+transform_variant_atomic_goal(ModuleInfo, VarToAddr, InstMap0, GoalInfo,
+ GoalExpr0, GoalExpr) :-
+ update_instmap(GoalExpr0 - GoalInfo, InstMap0, InstMap1),
+ list__filter(is_grounding(ModuleInfo, InstMap0, InstMap1), VarToAddr,
+ GroundingVarToAddr),
+ (
+ GroundingVarToAddr = [],
+ GoalExpr = GoalExpr0
+ ;
+ GroundingVarToAddr = [_ | _],
+ list__map(make_store_goal(ModuleInfo), GroundingVarToAddr, StoreGoals),
+ GoalExpr = conj([GoalExpr0 - GoalInfo | StoreGoals])
).
+:- pred is_grounding(module_info::in, instmap::in, instmap::in,
+ pair(prog_var)::in) is semidet.
+
+is_grounding(ModuleInfo, InstMap0, InstMap, Var - _AddrVar) :-
+ instmap__lookup_var(InstMap0, Var, Inst0),
+ not inst_is_ground(ModuleInfo, Inst0),
+ instmap__lookup_var(InstMap, Var, Inst),
+ inst_is_ground(ModuleInfo, Inst).
+
+:- pred make_store_goal(module_info::in, pair(prog_var)::in,
+ hlds_goal::out) is det.
+
+make_store_goal(ModuleInfo, Var - AddrVar, Goal) :-
+ generate_simple_call(mercury_private_builtin_module, "store_at_ref",
+ predicate, only_mode, det, [AddrVar, Var], [impure], [], ModuleInfo,
+ term__context_init, Goal).
+
%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "lco.m".
+
%-----------------------------------------------------------------------------%
Index: compiler/live_vars.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/live_vars.m,v
retrieving revision 1.111
diff -u -b -r1.111 live_vars.m
--- compiler/live_vars.m 30 Aug 2005 04:11:53 -0000 1.111
+++ compiler/live_vars.m 7 Sep 2005 10:34:04 -0000
@@ -71,7 +71,6 @@
:- import_module hlds__hlds_goal.
:- import_module hlds__hlds_llds.
:- import_module hlds__instmap.
-:- import_module ll_backend__code_aux.
:- import_module ll_backend__liveness.
:- import_module ll_backend__llds.
Index: compiler/ll_backend.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ll_backend.m,v
retrieving revision 1.10
diff -u -b -r1.10 ll_backend.m
--- compiler/ll_backend.m 8 Jul 2005 04:22:03 -0000 1.10
+++ compiler/ll_backend.m 7 Sep 2005 10:33:58 -0000
@@ -51,7 +51,6 @@
:- include_module code_info.
:- include_module exprn_aux.
- :- include_module code_aux.
:- include_module continuation_info.
:- include_module var_locn.
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.254
diff -u -b -r1.254 llds_out.m
--- compiler/llds_out.m 7 Sep 2005 06:51:54 -0000 1.254
+++ compiler/llds_out.m 7 Sep 2005 10:37:02 -0000
@@ -21,9 +21,12 @@
:- import_module aditi_backend__rl_file.
:- import_module backend_libs__builtin_ops.
+:- import_module hlds__hlds_llds.
:- import_module hlds__hlds_module.
:- import_module libs__globals.
:- import_module ll_backend__llds.
+:- import_module parse_tree__prog_data.
+
:- import_module mdbcomp__prim_data.
:- import_module bool.
@@ -171,6 +174,10 @@
%-----------------------------------------------------------------------------%
+:- func explain_stack_slots(stack_slots, prog_varset) = string.
+
+%-----------------------------------------------------------------------------%
+
:- implementation.
:- import_module backend_libs__c_util.
@@ -192,7 +199,6 @@
:- import_module ll_backend__rtti_out.
:- import_module parse_tree__mercury_to_mercury.
:- import_module parse_tree__modules.
-:- import_module parse_tree__prog_data.
:- import_module parse_tree__prog_foreign.
:- import_module parse_tree__prog_out.
:- import_module parse_tree__prog_util.
@@ -4939,7 +4945,7 @@
io__write_int(Num, !IO)
).
output_lval(mem_ref(Rval), !IO) :-
- io__write_string("XXX(", !IO),
+ io__write_string("* (MR_Word *) (", !IO),
output_rval(Rval, !IO),
io__write_string(")", !IO).
@@ -5029,8 +5035,8 @@
io__write_string("MR_tempf", !IO),
io__write_int(Num, !IO)
).
-output_lval_for_assign(mem_ref(_), _, !IO) :-
- error("output_lval_for_assign: mem_ref").
+output_lval_for_assign(mem_ref(MemRef), word, !IO) :-
+ output_lval(mem_ref(MemRef), !IO).
%-----------------------------------------------------------------------------%
@@ -5154,3 +5160,28 @@
gather_labels_from_instrs(Instrs, Labels1, Labels).
%-----------------------------------------------------------------------------%
+
+explain_stack_slots(StackSlots, VarSet) = Explanation :-
+ map__to_assoc_list(StackSlots, StackSlotsList),
+ explain_stack_slots_2(StackSlotsList, VarSet, "", Explanation1),
+ Explanation = "\nStack slot assignments (if any):\n" ++ Explanation1.
+
+:- pred explain_stack_slots_2(assoc_list(prog_var, stack_slot)::in,
+ prog_varset::in, string::in, string::out) is det.
+
+explain_stack_slots_2([], _, !Explanation).
+explain_stack_slots_2([Var - Slot | Rest], VarSet, !Explanation) :-
+ explain_stack_slots_2(Rest, VarSet, !Explanation),
+ (
+ Slot = det_slot(SlotNum),
+ StackStr = "sv"
+ ;
+ Slot = nondet_slot(SlotNum),
+ StackStr = "fv"
+ ),
+ int_to_string(SlotNum, SlotStr),
+ varset__lookup_name(VarSet, Var, VarName),
+ string__append_list([VarName, "\t ->\t", StackStr, SlotStr, "\n",
+ !.Explanation], !:Explanation).
+
+%---------------------------------------------------------------------------%
Index: compiler/loop_inv.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/loop_inv.m,v
retrieving revision 1.21
diff -u -b -r1.21 loop_inv.m
--- compiler/loop_inv.m 22 Jul 2005 12:31:56 -0000 1.21
+++ compiler/loop_inv.m 6 Sep 2005 12:45:16 -0000
@@ -119,7 +119,6 @@
:- implementation.
:- import_module check_hlds.
-:- import_module check_hlds__det_util.
:- import_module check_hlds__inst_match.
:- import_module check_hlds__mode_util.
:- import_module check_hlds__purity.
@@ -699,13 +698,6 @@
inst_is_input({ModuleInfo, _InstMap}, Inst) :-
inst_match__inst_is_ground(ModuleInfo, Inst),
inst_match__inst_is_not_partly_unique(ModuleInfo, Inst).
-
-%------------------------------------------------------------------------------%
-
-:- func update_inst_info(hlds_goal, inst_info) = inst_info.
-
-update_inst_info(Goal, {ModuleInfo, InstMap0}) = {ModuleInfo, InstMap} :-
- det_util__update_instmap(Goal, InstMap0, InstMap).
%------------------------------------------------------------------------------%
Index: compiler/magic_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/magic_util.m,v
retrieving revision 1.50
diff -u -b -r1.50 magic_util.m
--- compiler/magic_util.m 30 Aug 2005 04:11:54 -0000 1.50
+++ compiler/magic_util.m 6 Sep 2005 02:53:25 -0000
@@ -522,7 +522,8 @@
no, InputVars) },
{ Uni = construct(Var, ConsId, InputVars, Modes,
- construct_dynamically, cell_is_unique, no) },
+ construct_dynamically, cell_is_unique,
+ no_construct_sub_info) },
{ Goal1 = unify(Var, Rhs, UniMode, Uni, Context) - Info },
{ list__append(InputGoals, [Goal1], InputAndClosure) }
@@ -864,7 +865,7 @@
{ Unify = construct(InputVar,
pred_const(ShroudedSuppPredProcId, (aditi_bottom_up)),
LambdaInputs, UniModes, construct_dynamically,
- cell_is_unique, no) },
+ cell_is_unique, no_construct_sub_info) },
{ UnifyContext = unify_context(explicit, []) },
% Construct a goal_info.
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.344
diff -u -b -r1.344 mercury_compile.m
--- compiler/mercury_compile.m 7 Sep 2005 06:57:36 -0000 1.344
+++ compiler/mercury_compile.m 7 Sep 2005 07:13:22 -0000
@@ -2568,7 +2568,8 @@
MaybeDupProcMap = no
;
ProcDups = yes,
- dependency_graph__build_pred_dependency_graph(!.HLDS, no, DepInfo),
+ dependency_graph__build_pred_dependency_graph(!.HLDS,
+ do_not_include_imported, DepInfo),
hlds_dependency_info_get_dependency_ordering(DepInfo, PredSCCs),
list__condense(PredSCCs, OrderedPredIds),
MaybeDupProcMap = yes(map.init)
@@ -3824,8 +3825,7 @@
maybe_write_string(Verbose,
"% Looking for LCO modulo constructor application ...\n", !IO),
maybe_flush_output(Verbose, !IO),
- process_all_nonimported_nonaditi_procs(
- update_proc_io(lco_modulo_constructors), !HLDS, !IO),
+ lco_modulo_constructors(!HLDS),
maybe_write_string(Verbose, "% done.\n", !IO),
maybe_report_stats(Stats, !IO)
;
Index: compiler/middle_rec.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/middle_rec.m,v
retrieving revision 1.104
diff -u -b -r1.104 middle_rec.m
--- compiler/middle_rec.m 7 Sep 2005 06:51:55 -0000 1.104
+++ compiler/middle_rec.m 7 Sep 2005 10:54:56 -0000
@@ -1,14 +1,15 @@
%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
% Copyright (C) 1994-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%---------------------------------------------------------------------------%
%
-% Code generation - do middle recursion optimization
+% Code generation - do middle recursion optimization.
% Main authors: zs and conway.
%
%---------------------------------------------------------------------------%
-%---------------------------------------------------------------------------%
:- module ll_backend__middle_rec.
@@ -33,11 +34,12 @@
:- import_module hlds__hlds_llds.
:- import_module hlds__hlds_module.
:- import_module libs__tree.
-:- import_module ll_backend__code_aux.
:- import_module ll_backend__code_gen.
:- import_module ll_backend__code_util.
+:- import_module ll_backend__llds_out.
:- import_module ll_backend__opt_util.
:- import_module ll_backend__unify_gen.
+:- import_module parse_tree__error_util.
:- import_module parse_tree__prog_data.
:- import_module parse_tree__prog_out.
@@ -54,67 +56,121 @@
middle_rec__match_and_generate(Goal, Instrs, !CI) :-
Goal = GoalExpr - GoalInfo,
- (
GoalExpr = switch(Var, cannot_fail, [Case1, Case2]),
Case1 = case(ConsId1, Goal1),
Case2 = case(ConsId2, Goal2),
(
contains_only_builtins(Goal1),
- code_aux__contains_simple_recursive_call(Goal2,
- !.CI, _)
+ contains_simple_recursive_call(Goal2, !.CI)
->
middle_rec__generate_switch(Var, ConsId1, Goal1, Goal2,
GoalInfo, Instrs, !CI)
;
contains_only_builtins(Goal2),
- code_aux__contains_simple_recursive_call(Goal1,
- !.CI, _)
+ contains_simple_recursive_call(Goal1, !.CI)
->
middle_rec__generate_switch(Var, ConsId2, Goal2, Goal1,
GoalInfo, Instrs, !CI)
;
fail
- )
+ ).
+
+%---------------------------------------------------------------------------%
+
+ % contains_simple_recursive_call(G, CI, Last, ContainsTakeAddr)
+ % succeeds if G is a conjunction of goals, exactly one of which is a
+ % recursive call (CI says what the current procedure is), there are no
+ % other goals that cause control to leave this procedure, and there are
+ % no unifications that take the addresses of fields.
+ %
+:- pred contains_simple_recursive_call(hlds_goal::in, code_info::in)
+ is semidet.
+
+contains_simple_recursive_call(Goal - _, CodeInfo) :-
+ Goal = conj(Goals),
+ contains_simple_recursive_call_conj(Goals, CodeInfo).
+
+:- pred contains_simple_recursive_call_conj(list(hlds_goal)::in, code_info::in)
+ is semidet.
+
+contains_simple_recursive_call_conj([Goal | Goals], CodeInfo) :-
+ Goal = GoalExpr - _,
+ ( contains_only_builtins_expr(GoalExpr) ->
+ contains_simple_recursive_call_conj(Goals, CodeInfo)
;
- GoalExpr = if_then_else(Vars, Cond, Then, Else),
- (
+ is_recursive_call(GoalExpr, CodeInfo),
+ contains_only_builtins_list(Goals)
+ ).
+
+:- pred is_recursive_call(hlds_goal_expr::in, code_info::in)
+ is semidet.
+
+is_recursive_call(Goal, CodeInfo) :-
+ Goal = call(CallPredId, CallProcId, _, BuiltinState, _, _),
+ BuiltinState = not_builtin,
+ code_info__get_pred_id(CodeInfo, PredId),
+ PredId = CallPredId,
+ code_info__get_proc_id(CodeInfo, ProcId),
+ ProcId = CallProcId.
+
+ % contains_only_builtins(G) is true if G is a leaf procedure,
+ % i.e. control does not leave G to call another procedure, even
+ % if that procedure is a complicated unification. It also does not contain
+ % unifications that take the addresses of fields.
+ %
+:- pred contains_only_builtins(hlds_goal::in) is semidet.
+
+contains_only_builtins(Goal - _GoalInfo) :-
+ contains_only_builtins_expr(Goal).
+
+:- pred contains_only_builtins_expr(hlds_goal_expr::in) is semidet.
+
+contains_only_builtins_expr(conj(Goals)) :-
+ contains_only_builtins_list(Goals).
+contains_only_builtins_expr(disj(Goals)) :-
+ contains_only_builtins_list(Goals).
+contains_only_builtins_expr(switch(_Var, _Category, Cases)) :-
+ contains_only_builtins_cases(Cases).
+contains_only_builtins_expr(not(Goal)) :-
+ contains_only_builtins(Goal).
+contains_only_builtins_expr(scope(_, Goal)) :-
+ contains_only_builtins(Goal).
+contains_only_builtins_expr(if_then_else(_Vars, Cond, Then, Else)) :-
contains_only_builtins(Cond),
contains_only_builtins(Then),
- code_aux__contains_simple_recursive_call(Else, !.CI,
- no)
- ->
- semidet_fail,
- middle_rec__generate_ite(Vars, Cond, Then, Else,
- in_else, GoalInfo, Instrs, !CI)
+ contains_only_builtins(Else).
+contains_only_builtins_expr(call(_, _, _, BuiltinState, _, _)) :-
+ BuiltinState = inline_builtin.
+contains_only_builtins_expr(unify(_, _, _, Uni, _)) :-
+ % Complicated unifies are _non_builtin_
+ (
+ Uni = assign(_, _)
;
- contains_only_builtins(Cond),
- code_aux__contains_simple_recursive_call(Then, !.CI,
- no),
- contains_only_builtins(Else)
- ->
- semidet_fail,
- middle_rec__generate_ite(Vars, Cond, Then, Else,
- in_then, GoalInfo, Instrs, !CI)
+ Uni = simple_test(_, _)
;
- fail
+ Uni = construct(_, _, _, _, _, _, SubInfo),
+ (
+ SubInfo = no_construct_sub_info
+ ;
+ SubInfo = construct_sub_info(no, _)
)
+ ;
+ Uni = deconstruct(_, _, _, _, _, _)
).
-:- type ite_rec ---> in_then ; in_else.
-
-%---------------------------------------------------------------------------%
+:- pred contains_only_builtins_cases(list(case)::in) is semidet.
-:- pred middle_rec__generate_ite(list(prog_var)::in, hlds_goal::in,
- hlds_goal::in, hlds_goal::in, ite_rec::in, hlds_goal_info::in,
- code_tree::out, code_info::in, code_info::out) is det.
-
-middle_rec__generate_ite(_Vars, _Cond, _Then, _Else, _Rec, _IteGoalInfo,
- Instrs, !CI) :-
- ( semidet_fail ->
- Instrs = empty
- ;
- error("middle_rec__generate_ite reached")
- ).
+contains_only_builtins_cases([]).
+contains_only_builtins_cases([case(_ConsId, Goal) | Cases]) :-
+ contains_only_builtins(Goal),
+ contains_only_builtins_cases(Cases).
+
+:- pred contains_only_builtins_list(list(hlds_goal)::in) is semidet.
+
+contains_only_builtins_list([]).
+contains_only_builtins_list([Goal | Goals]) :-
+ contains_only_builtins(Goal),
+ contains_only_builtins_list(Goals).
%---------------------------------------------------------------------------%
@@ -126,7 +182,7 @@
Instrs, !CI) :-
code_info__get_stack_slots(!.CI, StackSlots),
code_info__get_varset(!.CI, VarSet),
- code_aux__explain_stack_slots(StackSlots, VarSet, SlotsComment),
+ SlotsComment = explain_stack_slots(StackSlots, VarSet),
code_info__get_module_info(!.CI, ModuleInfo),
code_info__get_pred_id(!.CI, PredId),
code_info__get_proc_id(!.CI, ProcId),
@@ -176,8 +232,7 @@
middle_rec__find_unused_register(AvoidList, AuxReg),
middle_rec__split_rec_code(RecList, BeforeList0, AfterList),
- middle_rec__add_counter_to_livevals(BeforeList0, AuxReg,
- BeforeList),
+ middle_rec__add_counter_to_livevals(BeforeList0, AuxReg, BeforeList),
code_info__get_next_label(Loop1Label, !CI),
code_info__get_next_label(Loop2Label, !CI),
@@ -189,38 +244,37 @@
( FrameSize = 0 ->
MaybeIncrSp = [],
MaybeDecrSp = [],
- InitAuxReg = [assign(AuxReg, const(int_const(0)))
+ InitAuxReg = [
+ assign(AuxReg, const(int_const(0)))
- "initialize counter register"],
- IncrAuxReg = [assign(AuxReg, binop((+),
- lval(AuxReg),
- const(int_const(1))))
+ IncrAuxReg = [
+ assign(AuxReg, binop((+), lval(AuxReg), const(int_const(1))))
- "increment loop counter"],
- DecrAuxReg = [assign(AuxReg, binop((-),
- lval(AuxReg),
- const(int_const(1))))
+ DecrAuxReg = [
+ assign(AuxReg, binop((-), lval(AuxReg), const(int_const(1))))
- "decrement loop counter"],
- TestAuxReg = [if_val(binop((>),
- lval(AuxReg), const(int_const(0))),
+ TestAuxReg = [
+ if_val(binop((>), lval(AuxReg), const(int_const(0))),
label(Loop2Label))
- "test on upward loop"]
;
PushMsg = code_gen__push_msg(ModuleInfo, PredId, ProcId),
MaybeIncrSp = [incr_sp(FrameSize, PushMsg) - ""],
MaybeDecrSp = [decr_sp(FrameSize) - ""],
- InitAuxReg = [assign(AuxReg, lval(sp))
+ InitAuxReg = [
+ assign(AuxReg, lval(sp))
- "initialize counter register"],
IncrAuxReg = [],
DecrAuxReg = [],
- TestAuxReg = [if_val(binop((>),
- lval(sp), lval(AuxReg)),
+ TestAuxReg = [
+ if_val(binop((>), lval(sp), lval(AuxReg)),
label(Loop2Label))
- "test on upward loop"]
),
- % Even though the recursive call is followed by some goals
- % in the HLDS, these goals may generate no LLDS code, so
- % it is in fact possible for AfterList to be empty.
- % There is no point in testing BeforeList for empty,
+ % Even though the recursive call is followed by some goals in the HLDS,
+ % these goals may generate no LLDS code, so it is in fact possible for
+ % AfterList to be empty. There is no point in testing BeforeList for empty,
% since if it is, the code is an infinite loop anyway.
(
@@ -232,31 +286,26 @@
],
EntryTestList,
[
- label(Loop1Label)
- - "start of the down loop"
+ label(Loop1Label) - "start of the down loop"
],
BeforeList,
Loop1Test,
[
- label(BaseLabel)
- - "start of base case"
+ label(BaseLabel) - "start of base case"
],
BaseList,
LiveValCode,
[
- goto(succip)
- - "exit from base case"
+ goto(succip) - "exit from base case"
]
], InstrList)
;
AfterList = [_ | _],
- % The instruction list we are constructing has two copies
- % of BaseList. If this list of instructions defines any
- % labels, we must either not apply this version of the
- % optimization, or we must consistently substitute the
- % labels (which will be referred to only from within the
- % BaseList instructions themselves). We choose the former
- % course.
+ % The instruction list we are constructing has two copies of BaseList.
+ % If this list of instructions defines any labels, we must either not
+ % apply this version of the optimization, or we must consistently
+ % substitute the labels (which will be referred to only from within the
+ % BaseList instructions themselves). We choose the former course.
middle_rec__find_labels(BaseList, BaseLabels),
BaseLabels = [],
list__condense([
@@ -267,8 +316,7 @@
EntryTestList,
InitAuxReg,
[
- label(Loop1Label)
- - "start of the down loop"
+ label(Loop1Label) - "start of the down loop"
],
MaybeIncrSp,
IncrAuxReg,
@@ -284,16 +332,13 @@
TestAuxReg,
LiveValCode,
[
- goto(succip)
- - "exit from recursive case",
- label(BaseLabel)
- - "start of base case"
+ goto(succip) - "exit from recursive case",
+ label(BaseLabel) - "start of base case"
],
BaseList,
LiveValCode,
[
- goto(succip)
- - "exit from base case"
+ goto(succip) - "exit from base case"
]
], InstrList)
),
@@ -306,19 +351,19 @@
list(instruction)::out) is det.
middle_rec__generate_downloop_test([], _, _) :-
- error("middle_rec__generate_downloop_test on empty list").
+ unexpected(this_file, "generate_downloop_test on empty list").
middle_rec__generate_downloop_test([Instr0 | Instrs0], Target, Instrs) :-
( Instr0 = if_val(Test, _OldTarget) - _Comment ->
(
Instrs0 = []
;
Instrs0 = [_ | _],
- error("middle_rec__generate_downloop_test: " ++
+ unexpected(this_file,
+ "generate_downloop_test: " ++
"if_val followed by other instructions")
),
code_util__neg_rval(Test, NewTest),
- Instrs = [if_val(NewTest, label(Target))
- - "test on downward loop"]
+ Instrs = [if_val(NewTest, label(Target)) - "test on downward loop"]
;
middle_rec__generate_downloop_test(Instrs0, Target, Instrs1),
Instrs = [Instr0 | Instrs1]
@@ -330,7 +375,7 @@
list(instruction)::out, list(instruction)::out) is det.
middle_rec__split_rec_code([], _, _) :-
- error("did not find call in middle_rec__split_rec_code").
+ unexpected(this_file, "did not find call in split_rec_code").
middle_rec__split_rec_code([Instr0 | Instrs1], Before, After) :-
( Instr0 = call(_, _, _, _, _, _) - _ ->
(
@@ -341,8 +386,7 @@
Before = [],
After = Instrs3
;
- error("middle_rec__split_rec_code: " ++
- "call not followed by label")
+ unexpected(this_file, "split_rec_code: call not followed by label")
)
;
middle_rec__split_rec_code(Instrs1, Before1, After),
@@ -356,9 +400,7 @@
middle_rec__add_counter_to_livevals([], _Lval, []).
middle_rec__add_counter_to_livevals([I0 | Is0], Lval, [I | Is]) :-
- (
- I0 = livevals(Lives0) - Comment
- ->
+ ( I0 = livevals(Lives0) - Comment ->
set__insert(Lives0, Lval, Lives),
I = livevals(Lives) - Comment
;
@@ -490,7 +532,7 @@
middle_rec__find_used_registers_rval(Rval, !Used),
middle_rec__find_used_registers_rval(FieldNum, !Used)
; Lval = lvar(_) ->
- error("lvar found in middle_rec__find_used_registers_lval")
+ unexpected(this_file, "lvar found in find_used_registers_lval")
;
true
).
@@ -504,7 +546,7 @@
middle_rec__find_used_registers_lval(Lval, !Used)
;
Rval = var(_),
- error("var found in middle_rec__find_used_registers_rval")
+ unexpected(this_file, "var found in find_used_registers_rval")
;
Rval = mkword(_, Rval1),
middle_rec__find_used_registers_rval(Rval1, !Used)
@@ -584,3 +626,11 @@
true
),
middle_rec__find_labels_2(Instrs, !Labels).
+
+%---------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "middle_rec.m".
+
+%---------------------------------------------------------------------------%
Index: compiler/ml_unify_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_unify_gen.m,v
retrieving revision 1.82
diff -u -b -r1.82 ml_unify_gen.m
--- compiler/ml_unify_gen.m 16 Aug 2005 10:42:37 -0000 1.82
+++ compiler/ml_unify_gen.m 6 Sep 2005 03:07:23 -0000
@@ -154,12 +154,19 @@
ml_gen_set_success(!.Info, Test, Context, Statement).
ml_gen_unification(construct(Var, ConsId, Args, ArgModes,
- HowToConstruct, _CellIsUnique, MaybeSizeProfInfo),
+ HowToConstruct, _CellIsUnique, SubInfo),
CodeModel, Context, Decls, Statements, !Info) :-
require(unify(CodeModel, model_det),
"ml_code_gen: construct not det"),
+ (
+ SubInfo = no_construct_sub_info
+ ;
+ SubInfo = construct_sub_info(MaybeTakeAddr, MaybeSizeProfInfo),
+ require(unify(MaybeTakeAddr, no),
+ "ml_code_gen: take field addresses not yet supported"),
require(unify(MaybeSizeProfInfo, no),
- "ml_code_gen: term size profiling not yet supported"),
+ "ml_code_gen: term size profiling not yet supported")
+ ),
ml_gen_construct(Var, ConsId, Args, ArgModes, HowToConstruct, Context,
Decls, Statements, !Info).
Index: compiler/mode_constraints.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_constraints.m,v
retrieving revision 1.12
diff -u -b -r1.12 mode_constraints.m
--- compiler/mode_constraints.m 27 Aug 2005 09:41:56 -0000 1.12
+++ compiler/mode_constraints.m 6 Sep 2005 02:03:34 -0000
@@ -1686,7 +1686,8 @@
get_predicate_sccs(ModuleInfo, SCCs) :-
% Obtain the SCCs for the module.
- dependency_graph__build_pred_dependency_graph(ModuleInfo, no, DepInfo),
+ dependency_graph__build_pred_dependency_graph(ModuleInfo,
+ do_not_include_imported, DepInfo),
hlds_dependency_info_get_dependency_ordering(DepInfo, SCCs0),
% Remove predicates that have mode declarations and place them in
Index: compiler/modecheck_unify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modecheck_unify.m,v
retrieving revision 1.85
diff -u -b -r1.85 modecheck_unify.m
--- compiler/modecheck_unify.m 30 Aug 2005 04:11:55 -0000 1.85
+++ compiler/modecheck_unify.m 6 Sep 2005 03:20:23 -0000
@@ -1046,7 +1046,7 @@
% between a variable and a lambda expression is - whether it is a
% construction unification or a deconstruction. It also works out
% whether it will be deterministic or semideterministic.
-
+ %
:- pred categorize_unify_var_lambda((mode)::in, list(mode)::in,
prog_var::in, list(prog_var)::in, pred_or_func::in,
unify_rhs::in, unify_rhs::out, unification::in, unification::out,
@@ -1057,19 +1057,26 @@
% If we are re-doing mode analysis, preserve the existing cons_id.
list__length(ArgVars, Arity),
(
- Unification0 = construct(_, ConsId0, _, _, _, _, MaybeSize0)
+ Unification0 = construct(_, ConsId0, _, _, _, _, SubInfo0)
->
- MaybeSize = MaybeSize0,
+ (
+ SubInfo0 = construct_sub_info(MaybeTakeAddr, _MaybeSize),
+ require(unify(MaybeTakeAddr, no),
+ "categorize_unify_var_lambda: take_addr")
+ ;
+ SubInfo0 = no_construct_sub_info
+ ),
+ SubInfo = SubInfo0,
ConsId = ConsId0
;
Unification0 = deconstruct(_, ConsId1, _, _, _, _)
->
- MaybeSize = no,
+ SubInfo = no_construct_sub_info,
ConsId = ConsId1
;
% The real cons_id will be computed by lambda.m;
% we just put in a dummy one for now.
- MaybeSize = no,
+ SubInfo = no_construct_sub_info,
ConsId = cons(unqualified("__LambdaGoal__"), Arity)
),
mode_info_get_module_info(!.ModeInfo, ModuleInfo),
@@ -1109,7 +1116,7 @@
RHS = RHS0
),
Unification = construct(X, ConsId, ArgVars, ArgModes,
- construct_dynamically, cell_is_unique, MaybeSize)
+ construct_dynamically, cell_is_unique, SubInfo)
; instmap__is_reachable(InstMap) ->
% If it's a deconstruction, it is a mode error.
% The error message would be incorrect in unreachable code,
@@ -1146,14 +1153,25 @@
mode_info_get_module_info(!.ModeInfo, ModuleInfo),
map__lookup(VarTypes, X, TypeOfX),
% If we are re-doing mode analysis, preserve the existing cons_id.
- ( Unification0 = construct(_, ConsId0, _, _, _, _, MaybeSize0) ->
- MaybeSize = MaybeSize0,
+ (
+ Unification0 = construct(_, ConsId0, _, _, _, _, SubInfo0)
+ ->
+ (
+ SubInfo0 = construct_sub_info(MaybeTakeAddr, _MaybeSize0),
+ require(unify(MaybeTakeAddr, no),
+ "categorize_unify_var_functor: take_addr")
+ ;
+ SubInfo0 = no_construct_sub_info
+ ),
+ SubInfo = SubInfo0,
ConsId = ConsId0
- ; Unification0 = deconstruct(_, ConsId1, _, _, _, _) ->
- MaybeSize = no,
+ ;
+ Unification0 = deconstruct(_, ConsId1, _, _, _, _)
+ ->
+ SubInfo = no_construct_sub_info,
ConsId = ConsId1
;
- MaybeSize = no,
+ SubInfo = no_construct_sub_info,
ConsId = NewConsId
),
mode_util__modes_to_uni_modes(ModuleInfo, ModeOfXArgs,
@@ -1161,7 +1179,7 @@
( mode_is_output(ModuleInfo, ModeOfX) ->
% It's a construction.
Unification = construct(X, ConsId, ArgVars, ArgModes,
- construct_dynamically, cell_is_unique, MaybeSize),
+ construct_dynamically, cell_is_unique, SubInfo),
% For existentially quantified data types, check that any type_info
% or type_class_info variables in the construction are ground.
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/opt_debug.m,v
retrieving revision 1.154
diff -u -b -r1.154 opt_debug.m
--- compiler/opt_debug.m 7 Sep 2005 06:51:55 -0000 1.154
+++ compiler/opt_debug.m 7 Sep 2005 11:41:19 -0000
@@ -135,6 +135,7 @@
:- import_module map.
:- import_module set.
:- import_module string.
+:- import_module term.
msg(OptDebug, LabelNo, Msg, !IO) :-
(
@@ -272,8 +273,8 @@
dump_rval(lval(Lval)) =
dump_lval(Lval).
-dump_rval(var(_)) =
- "var(_)".
+dump_rval(var(Var)) =
+ "var(" ++ int_to_string(term__var_to_int(Var)) ++ ")".
dump_rval(mkword(T, N)) =
"mkword(" ++ int_to_string(T) ++ ", " ++ dump_rval(N) ++ ")".
dump_rval(const(C)) =
Index: compiler/options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.465
diff -u -b -r1.465 options.m
--- compiler/options.m 12 Sep 2005 03:03:00 -0000 1.465
+++ compiler/options.m 12 Sep 2005 03:25:49 -0000
@@ -484,6 +484,7 @@
; type_specialization
; user_guided_type_specialization
; introduce_accumulators
+ ; optimize_constructor_last_call_accumulator
; optimize_constructor_last_call
; optimize_duplicate_calls
; constant_propagation
@@ -1208,6 +1209,7 @@
type_specialization - bool(no),
user_guided_type_specialization - bool(no),
introduce_accumulators - bool(no),
+ optimize_constructor_last_call_accumulator - bool(no),
optimize_constructor_last_call - bool(no),
optimize_dead_procs - bool(no),
deforestation - bool(no),
@@ -1886,6 +1888,8 @@
long_option("fixed-user-guided-type-specialization",
user_guided_type_specialization).
long_option("introduce-accumulators", introduce_accumulators).
+long_option("optimise-constructor-last-call-accumulator", optimize_constructor_last_call_accumulator).
+long_option("optimize-constructor-last-call-accumulator", optimize_constructor_last_call_accumulator).
long_option("optimise-constructor-last-call", optimize_constructor_last_call).
long_option("optimize-constructor-last-call", optimize_constructor_last_call).
long_option("optimize-dead-procs", optimize_dead_procs).
@@ -3932,6 +3936,9 @@
"--introduce-accumulators",
"\tAttempt to introduce accumulating variables into",
"\tprocedures, so as to make them tail recursive.",
+% "--optimize-constructor-last-call-accumulator",
+% "\tEnable the optimization via accumulators of ""last"" calls",
+% "\tthat are followed by constructor application.",
"--optimize-constructor-last-call",
"\tEnable the optimization of ""last"" calls that are followed by",
"\tconstructor application.",
Index: compiler/passes_aux.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/passes_aux.m,v
retrieving revision 1.71
diff -u -b -r1.71 passes_aux.m
--- compiler/passes_aux.m 7 Sep 2005 06:57:37 -0000 1.71
+++ compiler/passes_aux.m 7 Sep 2005 07:13:22 -0000
@@ -335,9 +335,8 @@
!:Task = update_module_cookie(Closure, Cookie1)
),
- % If the pass changed the module_info, it may have changed
- % the pred table or the proc table for this pred_id. Don't
- % take any chances.
+ % If the pass changed the module_info, it may have changed the pred table
+ % or the proc table for this pred_id. Don't take any chances.
module_info_preds(!.ModuleInfo, Preds8),
map__lookup(Preds8, PredId, Pred8),
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.272
diff -u -b -r1.272 polymorphism.m
--- compiler/polymorphism.m 9 Sep 2005 07:00:51 -0000 1.272
+++ compiler/polymorphism.m 12 Sep 2005 03:25:49 -0000
@@ -2457,7 +2457,7 @@
% create the construction unification to initialize the variable
BaseUnification = construct(BaseVar, ConsId, [], [],
- construct_dynamically, cell_is_shared, no),
+ construct_dynamically, cell_is_shared, no_construct_sub_info),
BaseUnifyMode = (free -> ground(shared, none)) -
(ground(shared, none) -> ground(shared, none)),
BaseUnifyContext = unify_context(explicit, []),
@@ -2490,7 +2490,7 @@
list__length(NewArgVars, NumArgVars),
list__duplicate(NumArgVars, UniMode, UniModes),
Unification = construct(NewVar, NewConsId, NewArgVars, UniModes,
- construct_dynamically, cell_is_unique, no),
+ construct_dynamically, cell_is_unique, no_construct_sub_info),
UnifyMode = (free -> ground(shared, none)) -
(ground(shared, none) -> ground(shared, none)),
UnifyContext = unify_context(explicit, []),
@@ -2918,7 +2918,7 @@
list__length(ArgVars, NumArgVars),
list__duplicate(NumArgVars, UniMode, UniModes),
Unification = construct(TypeInfoVar, ConsId, ArgVars, UniModes,
- construct_dynamically, cell_is_unique, no),
+ construct_dynamically, cell_is_unique, no_construct_sub_info),
UnifyMode = (free -> ground(shared, none)) -
(ground(shared, none) -> ground(shared, none)),
UnifyContext = unify_context(explicit, []),
@@ -2955,7 +2955,7 @@
% create the construction unification to initialize the variable
Unification = construct(TypeCtorInfoVar, ConsId, [], [],
- construct_dynamically, cell_is_shared, no),
+ construct_dynamically, cell_is_shared, no_construct_sub_info),
UnifyMode = (free -> ground(shared, none)) -
(ground(shared, none) -> ground(shared, none)),
UnifyContext = unify_context(explicit, []),
Index: compiler/quantification.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/quantification.m,v
retrieving revision 1.94
diff -u -b -r1.94 quantification.m
--- compiler/quantification.m 30 Aug 2005 04:11:58 -0000 1.94
+++ compiler/quantification.m 7 Sep 2005 14:24:11 -0000
@@ -249,20 +249,20 @@
quantification__init(RecomputeNonLocals, OutsideVars,
!.Varset, !.VarTypes, QuantInfo0),
implicitly_quantify_goal(!Goal, QuantInfo0, QuantInfo),
- quantification__get_varset(!:Varset, QuantInfo, _),
- quantification__get_vartypes(!:VarTypes, QuantInfo, _),
- quantification__get_warnings(Warnings0, QuantInfo, _),
+ quantification__get_varset(QuantInfo, !:Varset),
+ quantification__get_vartypes(QuantInfo, !:VarTypes),
+ quantification__get_warnings(QuantInfo, Warnings0),
list__reverse(Warnings0, Warnings).
:- pred implicitly_quantify_goal(hlds_goal::in, hlds_goal::out,
quant_info::in, quant_info::out) is det.
implicitly_quantify_goal(Goal0 - GoalInfo0, Goal - GoalInfo, !Info) :-
- quantification__get_seen(SeenVars, !Info),
+ quantification__get_seen(!.Info, SeenVars),
goal_info_get_context(GoalInfo0, Context),
implicitly_quantify_goal_2(Goal0, Goal1, Context, !Info),
- quantification__get_nonlocals(NonLocalVars, !Info),
- quantification__get_nonlocals_to_recompute(NonLocalsToRecompute, !Info),
+ quantification__get_nonlocals(!.Info, NonLocalVars),
+ quantification__get_nonlocals_to_recompute(!.Info, NonLocalsToRecompute),
(
% If there are any variables that are local to the goal
% which we have come across before, then we rename them apart.
@@ -329,9 +329,9 @@
Reason1 = Reason0,
Vars0 = []
),
- quantification__get_outside(OutsideVars, !Info),
- quantification__get_lambda_outside(LambdaOutsideVars, !Info),
- quantification__get_quant_vars(QuantVars, !Info),
+ quantification__get_outside(!.Info, OutsideVars),
+ quantification__get_lambda_outside(!.Info, LambdaOutsideVars),
+ quantification__get_quant_vars(!.Info, QuantVars),
% Rename apart all the quantified variables that occur outside this goal.
list_to_set(Vars0, QVars),
intersect(OutsideVars, QVars, RenameVars1),
@@ -373,7 +373,7 @@
insert_list(QuantVars, Vars, QuantVars1),
quantification__set_quant_vars(QuantVars1, !Info),
implicitly_quantify_goal(Goal1, Goal, !Info),
- quantification__get_nonlocals(NonLocals0, !Info),
+ quantification__get_nonlocals(!.Info, NonLocals0),
delete_list(NonLocals0, Vars, NonLocals),
quantification__set_quant_vars(QuantVars, !Info),
quantification__set_nonlocals(NonLocals, !Info),
@@ -399,7 +399,7 @@
implicitly_quantify_cases(Cases0, Cases, !Info),
% The switch variable is guaranteed to be non-local to the switch, since
% it has to be bound elsewhere, so we put it in the nonlocals here.
- quantification__get_nonlocals(NonLocals0, !Info),
+ quantification__get_nonlocals(!.Info, NonLocals0),
insert(NonLocals0, Var, NonLocals),
quantification__set_nonlocals(NonLocals, !Info),
Expr = switch(Var, Det, Cases).
@@ -410,8 +410,8 @@
% the quantified vars into the outside vars set, and initialize the new
% quantified vars set to be empty (the lambda outside vars remain
% unchanged).
- quantification__get_quant_vars(QuantVars, !Info),
- quantification__get_outside(OutsideVars, !Info),
+ quantification__get_quant_vars(!.Info, QuantVars),
+ quantification__get_outside(!.Info, OutsideVars),
union(OutsideVars, QuantVars, OutsideVars1),
init(QuantVars1),
quantification__set_quant_vars(QuantVars1, !Info),
@@ -427,9 +427,9 @@
% `if_then_else([], ...)'.
implicitly_quantify_goal_2(Expr0, Expr, Context, !Info) :-
Expr0 = if_then_else(Vars0, Cond0, Then0, Else0),
- quantification__get_quant_vars(QuantVars, !Info),
- quantification__get_outside(OutsideVars, !Info),
- quantification__get_lambda_outside(LambdaOutsideVars, !Info),
+ quantification__get_quant_vars(!.Info, QuantVars),
+ quantification__get_outside(!.Info, OutsideVars),
+ quantification__get_lambda_outside(!.Info, LambdaOutsideVars),
list_to_set(Vars0, QVars),
% Rename apart those variables that are quantified to the cond and then
% of the i-t-e that occur outside the i-t-e.
@@ -448,7 +448,7 @@
goal_util__rename_var_list(no, RenameMap, Vars0, Vars)
),
insert_list(QuantVars, Vars, QuantVars1),
- quantification__get_nonlocals_to_recompute(NonLocalsToRecompute, !Info),
+ quantification__get_nonlocals_to_recompute(!.Info, NonLocalsToRecompute),
quantification__goal_vars(NonLocalsToRecompute, Then1, VarsThen,
LambdaVarsThen),
union(OutsideVars, VarsThen, OutsideVars1),
@@ -458,18 +458,18 @@
quantification__set_lambda_outside(LambdaOutsideVars1, !Info),
quantification__update_seen_vars(QVars, !Info),
implicitly_quantify_goal(Cond1, Cond, !Info),
- quantification__get_nonlocals(NonLocalsCond, !Info),
+ quantification__get_nonlocals(!.Info, NonLocalsCond),
union(OutsideVars, NonLocalsCond, OutsideVars2),
quantification__set_outside(OutsideVars2, !Info),
quantification__set_lambda_outside(LambdaOutsideVars, !Info),
implicitly_quantify_goal(Then1, Then, !Info),
- quantification__get_nonlocals(NonLocalsThen, !Info),
+ quantification__get_nonlocals(!.Info, NonLocalsThen),
quantification__set_outside(OutsideVars, !Info),
quantification__set_quant_vars(QuantVars, !Info),
implicitly_quantify_goal(Else0, Else, !Info),
Expr = if_then_else([], Cond, Then, Else),
- quantification__get_nonlocals(NonLocalsElse, !Info),
+ quantification__get_nonlocals(!.Info, NonLocalsElse),
union(NonLocalsCond, NonLocalsThen, NonLocalsIfThen),
union(NonLocalsIfThen, NonLocalsElse, NonLocalsIfThenElse),
intersect(NonLocalsIfThenElse, OutsideVars, NonLocalsO),
@@ -489,10 +489,10 @@
implicitly_quantify_goal_2(Expr0, Expr, Context, !Info) :-
Expr0 = unify(Var, UnifyRHS0, Mode, Unification0, UnifyContext),
- quantification__get_outside(OutsideVars, !Info),
- quantification__get_lambda_outside(LambdaOutsideVars, !Info),
+ quantification__get_outside(!.Info, OutsideVars),
+ quantification__get_lambda_outside(!.Info, LambdaOutsideVars),
TypeInfoVars = quantification__get_unify_typeinfos(Unification0),
- ( Unification0 = construct(_, _, _, _, How, _, MaybeSize) ->
+ ( Unification0 = construct(_, _, _, _, How, _, SubInfo) ->
( How = reuse_cell(cell_to_reuse(ReuseVar0, _, SetArgs)) ->
MaybeSetArgs = yes(SetArgs),
MaybeReuseVar = yes(ReuseVar0)
@@ -500,7 +500,10 @@
MaybeSetArgs = no,
MaybeReuseVar = no
),
- ( MaybeSize = yes(dynamic_size(SizeVar0)) ->
+ (
+ SubInfo = construct_sub_info(_, MaybeSize),
+ MaybeSize = yes(dynamic_size(SizeVar0))
+ ->
MaybeSizeVar = yes(SizeVar0)
;
MaybeSizeVar = no
@@ -513,7 +516,7 @@
implicitly_quantify_unify_rhs(MaybeSetArgs, Context,
UnifyRHS0, UnifyRHS, Unification0, Unification, !Info),
Expr = unify(Var, UnifyRHS, Mode, Unification, UnifyContext),
- quantification__get_nonlocals(VarsUnifyRHS, !Info),
+ quantification__get_nonlocals(!.Info, VarsUnifyRHS),
insert(VarsUnifyRHS, Var, GoalVars0),
insert_list(GoalVars0, TypeInfoVars, GoalVars1),
(
@@ -555,9 +558,9 @@
!Info) :-
% Get the initial values of various settings.
- quantification__get_quant_vars(QuantVars0, !Info),
- quantification__get_outside(OutsideVars0, !Info),
- quantification__get_lambda_outside(LambdaOutsideVars0, !Info),
+ quantification__get_quant_vars(!.Info, QuantVars0),
+ quantification__get_outside(!.Info, OutsideVars0),
+ quantification__get_lambda_outside(!.Info, LambdaOutsideVars0),
% Quantified variables cannot be pushed inside a negation, so we insert
% the quantified vars into the outside vars set, and initialize the new
@@ -570,7 +573,7 @@
% Prepare for quantifying the LHS: add variables from the RHS to the
% outside vars and the outside lambda vars sets.
- quantification__get_nonlocals_to_recompute(NonLocalsToRecompute, !Info),
+ quantification__get_nonlocals_to_recompute(!.Info, NonLocalsToRecompute),
quantification__goal_vars(NonLocalsToRecompute, RHS0, RHS_Vars,
RHS_LambdaVars),
union(OutsideVars1, RHS_Vars, LHS_OutsideVars),
@@ -580,7 +583,7 @@
quantification__set_outside(LHS_OutsideVars, !Info),
quantification__set_lambda_outside(LHS_LambdaOutsideVars, !Info),
implicitly_quantify_goal(LHS0, LHS, !Info),
- quantification__get_nonlocals(LHS_NonLocalVars, !Info),
+ quantification__get_nonlocals(!.Info, LHS_NonLocalVars),
% Prepare for quantifying the RHS: add nonlocals from the LHS to the
% outside vars. (We use the nonlocals rather than the more symmetric
@@ -593,7 +596,7 @@
quantification__set_outside(RHS_OutsideVars, !Info),
quantification__set_lambda_outside(RHS_LambdaOutsideVars, !Info),
implicitly_quantify_goal(RHS0, RHS, !Info),
- quantification__get_nonlocals(RHS_NonLocalVars, !Info),
+ quantification__get_nonlocals(!.Info, RHS_NonLocalVars),
% Compute the nonlocals for this goal.
union(LHS_NonLocalVars, RHS_NonLocalVars, AllNonLocalVars),
@@ -643,8 +646,8 @@
implicitly_quantify_atomic_goal(HeadVars, !Info) :-
list_to_set(HeadVars, GoalVars),
quantification__update_seen_vars(GoalVars, !Info),
- quantification__get_outside(OutsideVars, !Info),
- quantification__get_lambda_outside(LambdaOutsideVars, !Info),
+ quantification__get_outside(!.Info, OutsideVars),
+ quantification__get_lambda_outside(!.Info, LambdaOutsideVars),
intersect(GoalVars, OutsideVars, NonLocals1),
intersect(GoalVars, LambdaOutsideVars, NonLocals2),
union(NonLocals1, NonLocals2, NonLocals),
@@ -660,7 +663,7 @@
quantification__set_nonlocals(Vars, !Info).
implicitly_quantify_unify_rhs(ReuseArgs, _, !RHS, !Unification, !Info) :-
!.RHS = functor(_, _, ArgVars),
- quantification__get_nonlocals_to_recompute(NonLocalsToRecompute, !Info),
+ quantification__get_nonlocals_to_recompute(!.Info, NonLocalsToRecompute),
(
NonLocalsToRecompute = code_gen_nonlocals,
ReuseArgs = yes(SetArgs)
@@ -684,7 +687,7 @@
% guaranteed to be fresh distinct variables. However, the code below
% does not assume this.
%
- quantification__get_outside(OutsideVars0, !Info),
+ quantification__get_outside(!.Info, OutsideVars0),
list_to_set(LambdaVars0, QVars),
% Figure out which variables have overlapping scopes because they occur
% outside the goal and are also lambda-quantified vars.
@@ -696,7 +699,7 @@
),
% We need to rename apart any of the lambda vars that we have already seen,
% since they are new instances.
- quantification__get_seen(Seen0, !Info),
+ quantification__get_seen(!.Info, Seen0),
intersect(Seen0, QVars, RenameVars1),
union(RenameVars0, RenameVars1, RenameVars),
@@ -706,7 +709,7 @@
% Quantified variables cannot be pushed inside a lambda goal,
% so we insert the quantified vars into the outside vars set,
% and initialize the new quantified vars set to be empty.
- quantification__get_quant_vars(QuantVars0, !Info),
+ quantification__get_quant_vars(!.Info, QuantVars0),
union(OutsideVars0, QuantVars0, OutsideVars1),
init(QuantVars),
quantification__set_quant_vars(QuantVars, !Info),
@@ -717,12 +720,12 @@
% Set the LambdaOutsideVars set to empty, because variables that occur
% outside this lambda expression only in other lambda expressions
% should not be considered non-local.
- quantification__get_lambda_outside(LambdaOutsideVars0, !Info),
+ quantification__get_lambda_outside(!.Info, LambdaOutsideVars0),
init(LambdaOutsideVars),
quantification__set_lambda_outside(LambdaOutsideVars, !Info),
implicitly_quantify_goal(Goal1, Goal, !Info),
- quantification__get_nonlocals(NonLocals0, !Info),
+ quantification__get_nonlocals(!.Info, NonLocals0),
% Lambda-quantified variables are local.
delete_list(NonLocals0, LambdaVars, NonLocals),
quantification__set_quant_vars(QuantVars0, !Info),
@@ -752,14 +755,20 @@
%
(
!.Unification = construct(ConstructVar, ConsId, Args0,
- ArgModes0, HowToConstruct, Uniq, Size)
+ ArgModes0, HowToConstruct, Uniq, SubInfo)
->
- require(unify(Size, no), "lambda term has size info"),
+ (
+ SubInfo = no_construct_sub_info
+ ;
+ SubInfo = construct_sub_info(MaybeTakeAddr, MaybeSize),
+ require(unify(MaybeTakeAddr, no), "lambda term has take addr"),
+ require(unify(MaybeSize, no), "lambda term has size info")
+ ),
map__from_corresponding_lists(Args0, ArgModes0, ArgModesMap),
to_sorted_list(NonLocals, Args),
map__apply_to_list(Args, ArgModesMap, ArgModes),
!:Unification = construct(ConstructVar, ConsId, Args,
- ArgModes, HowToConstruct, Uniq, Size)
+ ArgModes, HowToConstruct, Uniq, SubInfo)
;
% After mode analysis, unifications with lambda variables should always
% be construction unifications, but quantification gets invoked before
@@ -771,7 +780,7 @@
quant_info::in, quant_info::out) is det.
implicitly_quantify_conj(!Goals, !Info) :-
- quantification__get_nonlocals_to_recompute(NonLocalsToRecompute, !Info),
+ quantification__get_nonlocals_to_recompute(!.Info, NonLocalsToRecompute),
get_vars(NonLocalsToRecompute, !.Goals, FollowingVarsList),
implicitly_quantify_conj_2(FollowingVarsList, !Goals, !Info).
@@ -787,19 +796,19 @@
implicitly_quantify_conj_2(
[FollowingVars - LambdaFollowingVars | FollowingVarsList],
[Goal0 | Goals0], [Goal | Goals], !Info) :-
- quantification__get_outside(OutsideVars, !Info),
- quantification__get_lambda_outside(LambdaOutsideVars, !Info),
+ quantification__get_outside(!.Info, OutsideVars),
+ quantification__get_lambda_outside(!.Info, LambdaOutsideVars),
union(OutsideVars, FollowingVars, OutsideVars1),
union(LambdaOutsideVars, LambdaFollowingVars, LambdaOutsideVars1),
quantification__set_outside(OutsideVars1, !Info),
quantification__set_lambda_outside(LambdaOutsideVars1, !Info),
implicitly_quantify_goal(Goal0, Goal, !Info),
- quantification__get_nonlocals(NonLocalVars1, !Info),
+ quantification__get_nonlocals(!.Info, NonLocalVars1),
union(OutsideVars, NonLocalVars1, OutsideVars2),
quantification__set_outside(OutsideVars2, !Info),
quantification__set_lambda_outside(LambdaOutsideVars, !Info),
implicitly_quantify_conj_2(FollowingVarsList, Goals0, Goals, !Info),
- quantification__get_nonlocals(NonLocalVars2, !Info),
+ quantification__get_nonlocals(!.Info, NonLocalVars2),
union(NonLocalVars1, NonLocalVars2, NonLocalVarsConj),
intersect(NonLocalVarsConj, OutsideVars, NonLocalVarsO),
intersect(NonLocalVarsConj, LambdaOutsideVars, NonLocalVarsL),
@@ -815,9 +824,9 @@
quantification__set_nonlocals(NonLocalVars, !Info).
implicitly_quantify_disj([Goal0 | Goals0], [Goal | Goals], !Info) :-
implicitly_quantify_goal(Goal0, Goal, !Info),
- quantification__get_nonlocals(NonLocalVars0, !Info),
+ quantification__get_nonlocals(!.Info, NonLocalVars0),
implicitly_quantify_disj(Goals0, Goals, !Info),
- quantification__get_nonlocals(NonLocalVars1, !Info),
+ quantification__get_nonlocals(!.Info, NonLocalVars1),
union(NonLocalVars0, NonLocalVars1, NonLocalVars),
quantification__set_nonlocals(NonLocalVars, !Info).
@@ -830,9 +839,9 @@
implicitly_quantify_cases([case(Cons, Goal0) | Cases0],
[case(Cons, Goal) | Cases], !Info) :-
implicitly_quantify_goal(Goal0, Goal, !Info),
- quantification__get_nonlocals(NonLocalVars0, !Info),
+ quantification__get_nonlocals(!.Info, NonLocalVars0),
implicitly_quantify_cases(Cases0, Cases, !Info),
- quantification__get_nonlocals(NonLocalVars1, !Info),
+ quantification__get_nonlocals(!.Info, NonLocalVars1),
union(NonLocalVars0, NonLocalVars1, NonLocalVars),
quantification__set_nonlocals(NonLocalVars, !Info).
@@ -844,7 +853,7 @@
quant_info::in, quant_info::out) is det.
quantification__update_seen_vars(NewVars, !Info) :-
- quantification__get_seen(SeenVars0, !Info),
+ quantification__get_seen(!.Info, SeenVars0),
union(SeenVars0, NewVars, SeenVars),
quantification__set_seen(SeenVars, !Info).
@@ -936,14 +945,17 @@
quantification__goal_vars_2(NonLocalsToRecompute,
unify(LHS, RHS, _, Unification, _), !Set, !LambdaSet) :-
insert(!.Set, LHS, !:Set),
- ( Unification = construct(_, _, _, _, How, _, Size) ->
+ ( Unification = construct(_, _, _, _, How, _, SubInfo) ->
( How = reuse_cell(cell_to_reuse(ReuseVar, _, SetArgs)) ->
MaybeSetArgs = yes(SetArgs),
insert(!.Set, ReuseVar, !:Set)
;
MaybeSetArgs = no
),
- ( Size = yes(dynamic_size(SizeVar)) ->
+ (
+ SubInfo = construct_sub_info(_, MaybeSize),
+ MaybeSize = yes(dynamic_size(SizeVar))
+ ->
insert(!.Set, SizeVar, !:Set)
;
true
@@ -1126,7 +1138,7 @@
quantification__warn_overlapping_scope(OverlapVars, Context, !Info) :-
to_sorted_list(OverlapVars, Vars),
- quantification__get_warnings(Warnings0, !Info),
+ quantification__get_warnings(!.Info, Warnings0),
Warnings = [warn_overlap(Vars, Context) | Warnings0],
quantification__set_warnings(Warnings, !Info).
@@ -1143,7 +1155,7 @@
quant_info::in, quant_info::out) is det.
quantification__rename_apart(RenameSet, RenameMap, !Goal, !Info) :-
- quantification__get_nonlocals_to_recompute(NonLocalsToRecompute, !Info),
+ quantification__get_nonlocals_to_recompute(!.Info, NonLocalsToRecompute),
(
%
% Don't rename apart variables when recomputing the code-gen nonlocals
@@ -1159,8 +1171,8 @@
map__init(RenameMap)
;
to_sorted_list(RenameSet, RenameList),
- quantification__get_varset(Varset0, !Info),
- quantification__get_vartypes(VarTypes0, !Info),
+ quantification__get_varset(!.Info, Varset0),
+ quantification__get_vartypes(!.Info, VarTypes0),
map__init(RenameMap0),
goal_util__create_variables(RenameList, Varset0, VarTypes0,
Varset0, Varset, VarTypes0, VarTypes, RenameMap0, RenameMap),
@@ -1172,7 +1184,7 @@
% because we won't find them anywhere else in the enclosing
% goal. This is a performance improvement because it keeps
% the size of the seen var set down.
- % quantification__get_seen(SeenVars0, !Info),
+ % quantification__get_seen(!.Info, SeenVars0),
% map__values(RenameMap, NewVarsList),
% insert_list(SeenVars0, NewVarsList, SeenVars),
% quantification__set_seen(SeenVars, !Info)
@@ -1193,7 +1205,7 @@
quantification__set_goal_nonlocals(NonLocals0, NonLocals, !GoalInfo, !Info) :-
NonLocals = bitset_to_set(NonLocals0),
- quantification__get_nonlocals_to_recompute(NonLocalsToRecompute, !Info),
+ quantification__get_nonlocals_to_recompute(!.Info, NonLocalsToRecompute),
(
NonLocalsToRecompute = ordinary_nonlocals,
goal_info_set_nonlocals(NonLocals, !GoalInfo)
@@ -1225,76 +1237,55 @@
init(LambdaOutsideVars),
Seen = OutsideVars.
-:- pred quantification__get_nonlocals_to_recompute(nonlocals_to_recompute::out,
- quant_info::in, quant_info::out) is det.
-
-:- pred quantification__get_outside(set_of_var::out,
- quant_info::in, quant_info::out) is det.
-
-:- pred quantification__get_quant_vars(set_of_var::out,
- quant_info::in, quant_info::out) is det.
-
-:- pred quantification__get_lambda_outside(set_of_var::out,
- quant_info::in, quant_info::out) is det.
-
-:- pred quantification__get_nonlocals(set_of_var::out,
- quant_info::in, quant_info::out) is det.
-
-:- pred quantification__get_seen(set_of_var::out,
- quant_info::in, quant_info::out) is det.
-
-:- pred quantification__get_varset(prog_varset::out,
- quant_info::in, quant_info::out) is det.
-
-:- pred quantification__get_vartypes(vartypes::out,
- quant_info::in, quant_info::out) is det.
-
-:- pred quantification__get_warnings(list(quant_warning)::out,
- quant_info::in, quant_info::out) is det.
+:- pred quantification__get_nonlocals_to_recompute(quant_info::in,
+ nonlocals_to_recompute::out) is det.
+:- pred quantification__get_outside(quant_info::in, set_of_var::out) is det.
+:- pred quantification__get_quant_vars(quant_info::in, set_of_var::out) is det.
+:- pred quantification__get_lambda_outside(quant_info::in, set_of_var::out)
+ is det.
+:- pred quantification__get_nonlocals(quant_info::in, set_of_var::out) is det.
+:- pred quantification__get_seen(quant_info::in, set_of_var::out) is det.
+:- pred quantification__get_varset(quant_info::in, prog_varset::out) is det.
+:- pred quantification__get_vartypes(quant_info::in, vartypes::out) is det.
+:- pred quantification__get_warnings(quant_info::in, list(quant_warning)::out)
+ is det.
:- pred quantification__set_outside(set_of_var::in,
quant_info::in, quant_info::out) is det.
-
:- pred quantification__set_quant_vars(set_of_var::in,
quant_info::in, quant_info::out) is det.
-
:- pred quantification__set_lambda_outside(set_of_var::in,
quant_info::in, quant_info::out) is det.
-
:- pred quantification__set_nonlocals(set_of_var::in,
quant_info::in, quant_info::out) is det.
-
:- pred quantification__set_seen(set_of_var::in,
quant_info::in, quant_info::out) is det.
-
:- pred quantification__set_varset(prog_varset::in,
quant_info::in, quant_info::out) is det.
-
:- pred quantification__set_vartypes(vartypes::in,
quant_info::in, quant_info::out) is det.
-
:- pred quantification__set_warnings(list(quant_warning)::in,
quant_info::in, quant_info::out) is det.
-quantification__get_nonlocals_to_recompute(Q ^ nonlocals_to_recompute, Q, Q).
-quantification__get_outside(Q ^ outside, Q, Q).
-quantification__get_quant_vars(Q ^ quant_vars, Q, Q).
-quantification__get_lambda_outside(Q ^ lambda_outside, Q, Q).
-quantification__get_nonlocals(Q ^ nonlocals, Q, Q).
-quantification__get_seen(Q ^ seen, Q, Q).
-quantification__get_varset(Q ^ varset, Q, Q).
-quantification__get_vartypes(Q ^ vartypes, Q, Q).
-quantification__get_warnings(Q ^ warnings, Q, Q).
-
-quantification__set_outside(Outside, Q0, Q0 ^ outside := Outside).
-quantification__set_quant_vars(QuantVars, Q0, Q0 ^ quant_vars := QuantVars).
-quantification__set_lambda_outside(LambdaOutsideVars, Q0,
- Q0 ^ lambda_outside := LambdaOutsideVars).
-quantification__set_nonlocals(NonLocals, Q0, Q0 ^ nonlocals := NonLocals).
-quantification__set_seen(Seen, Q0, Q0 ^ seen := Seen).
-quantification__set_varset(Varset, Q0, Q0 ^ varset := Varset).
-quantification__set_vartypes(VarTypes, Q0, Q0 ^ vartypes := VarTypes).
-quantification__set_warnings(Warnings, Q0, Q0 ^ warnings := Warnings).
+quantification__get_nonlocals_to_recompute(Q, Q ^ nonlocals_to_recompute).
+quantification__get_outside(Q, Q ^ outside).
+quantification__get_quant_vars(Q, Q ^ quant_vars).
+quantification__get_lambda_outside(Q, Q ^ lambda_outside).
+quantification__get_nonlocals(Q, Q ^ nonlocals).
+quantification__get_seen(Q, Q ^ seen).
+quantification__get_varset(Q, Q ^ varset).
+quantification__get_vartypes(Q, Q ^ vartypes).
+quantification__get_warnings(Q, Q ^ warnings).
+
+quantification__set_outside(Outside, Q, Q ^ outside := Outside).
+quantification__set_quant_vars(QuantVars, Q, Q ^ quant_vars := QuantVars).
+quantification__set_lambda_outside(LambdaOutsideVars, Q,
+ Q ^ lambda_outside := LambdaOutsideVars).
+quantification__set_nonlocals(NonLocals, Q, Q ^ nonlocals := NonLocals).
+quantification__set_seen(Seen, Q, Q ^ seen := Seen).
+quantification__set_varset(Varset, Q, Q ^ varset := Varset).
+quantification__set_vartypes(VarTypes, Q, Q ^ vartypes := VarTypes).
+quantification__set_warnings(Warnings, Q, Q ^ warnings := Warnings).
%-----------------------------------------------------------------------------%
Index: compiler/rl_exprn.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rl_exprn.m,v
retrieving revision 1.53
diff -u -b -r1.53 rl_exprn.m
--- compiler/rl_exprn.m 30 Aug 2005 04:11:58 -0000 1.53
+++ compiler/rl_exprn.m 6 Sep 2005 14:23:36 -0000
@@ -2191,6 +2191,9 @@
AditiType, RvalCode),
rl_exprn__generate_pop(reg(OutputLoc), Type, PopCode),
{ Code = tree(RvalCode, PopCode) }
+ ;
+ { SimpleCode = ref_assign(_, _) },
+ { error("rl_exprn__generate_builtin_call: ref_assign") }
)
;
{ mdbcomp__prim_data__sym_name_to_string(PredModule0,
Index: compiler/size_prof.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/size_prof.m,v
retrieving revision 1.20
diff -u -b -r1.20 size_prof.m
--- compiler/size_prof.m 30 Aug 2005 04:11:59 -0000 1.20
+++ compiler/size_prof.m 6 Sep 2005 03:07:12 -0000
@@ -635,7 +635,8 @@
;
!:Info = !.Info
),
- Unification = construct(Var, ConsId, Args, ArgModes, How, Unique, no),
+ Unification = construct(Var, ConsId, Args, ArgModes, How, Unique,
+ no_construct_sub_info),
GoalExpr = unify(LHS, RHS, UniMode, Unification, UnifyContext)
;
ConsId = cons(_Name, _Arity),
@@ -647,7 +648,8 @@
% All ConsIds other than cons/2 with at least one argument
% construct terms that we consider zero-sized.
record_known_size(Var, 0, !Info),
- Unification = construct(Var, ConsId, Args, ArgModes, How, Unique, no),
+ Unification = construct(Var, ConsId, Args, ArgModes, How, Unique,
+ no_construct_sub_info),
GoalExpr = unify(LHS, RHS, UniMode, Unification, UnifyContext)
).
@@ -712,14 +714,14 @@
true
),
Unification = construct(Var, ConsId, Args, ArgModes, How, Unique,
- yes(known_size(KnownSize))),
+ construct_sub_info(no, yes(known_size(KnownSize)))),
GoalExpr = unify(LHS, RHS, UniMode, Unification, UnifyContext)
;
MaybeDynamicSizeVar = yes(SizeVar0),
generate_size_var(SizeVar0, KnownSize, Context, SizeVar, SizeGoals,
!Info),
Unification = construct(Var, ConsId, Args, ArgModes, How, Unique,
- yes(dynamic_size(SizeVar))),
+ construct_sub_info(no, yes(dynamic_size(SizeVar)))),
UnifyExpr = unify(LHS, RHS, UniMode, Unification, UnifyContext),
goal_info_get_nonlocals(GoalInfo0, NonLocals0),
set__insert(NonLocals0, SizeVar, NonLocals),
Index: compiler/switch_detection.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/switch_detection.m,v
retrieving revision 1.112
diff -u -b -r1.112 switch_detection.m
--- compiler/switch_detection.m 2 Sep 2005 04:56:28 -0000 1.112
+++ compiler/switch_detection.m 6 Sep 2005 12:46:29 -0000
@@ -61,6 +61,7 @@
:- import_module check_hlds__det_util.
:- import_module check_hlds__inst_match.
:- import_module check_hlds__type_util.
+:- import_module hlds__goal_util.
:- import_module hlds__hlds_data.
:- import_module hlds__hlds_goal.
:- import_module hlds__instmap.
Index: compiler/switch_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/switch_gen.m,v
retrieving revision 1.86
diff -u -b -r1.86 switch_gen.m
--- compiler/switch_gen.m 22 Mar 2005 06:40:26 -0000 1.86
+++ compiler/switch_gen.m 7 Sep 2005 10:32:24 -0000
@@ -69,7 +69,6 @@
:- import_module libs__globals.
:- import_module libs__options.
:- import_module libs__tree.
-:- import_module ll_backend__code_aux.
:- import_module ll_backend__code_gen.
:- import_module ll_backend__dense_switch.
:- import_module ll_backend__lookup_switch.
Index: compiler/term_constr_initial.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/term_constr_initial.m,v
retrieving revision 1.3
diff -u -b -r1.3 term_constr_initial.m
--- compiler/term_constr_initial.m 29 Aug 2005 08:44:13 -0000 1.3
+++ compiler/term_constr_initial.m 7 Sep 2005 23:40:22 -0000
@@ -541,7 +541,8 @@
proc_info_get_termination2_info(ProcInfo0, !:TermInfo),
!:TermInfo = !.TermInfo ^ success_constrs := ArgSizeInfo,
!:TermInfo = !.TermInfo ^ term_status := yes(cannot_loop(builtin)),
- !:TermInfo = !.TermInfo ^ intermod_status := yes(not_mutually_recursive),
+ !:TermInfo = !.TermInfo ^ intermod_status :=
+ yes(not_mutually_recursive),
!:TermInfo = !.TermInfo ^ size_var_map := SizeVarMap,
!:TermInfo = !.TermInfo ^ head_vars := HeadSizeVars,
proc_info_set_termination2_info(!.TermInfo, ProcInfo0, ProcInfo)
@@ -556,11 +557,25 @@
process_no_type_info_builtin(PredName, HeadVars, SizeVarMap) = Constraints :-
(
HeadVars = [HVar1, HVar2],
- (PredName = "unsafe_type_cast" ; PredName = "unsafe_promise_unique")
+ (
+ (
+ PredName = "unsafe_type_cast"
+ ;
+ PredName = "unsafe_promise_unique"
+ )
->
SizeVar1 = prog_var_to_size_var(SizeVarMap, HVar1),
SizeVar2 = prog_var_to_size_var(SizeVarMap, HVar2),
- Constraints = [make_vars_eq_constraint(SizeVar1, SizeVar2)]
+ ConstraintsPrime = [make_vars_eq_constraint(SizeVar1, SizeVar2)]
+ ;
+ PredName = "store_at_ref"
+ ->
+ ConstraintsPrime = []
+ ;
+ fail
+ )
+ ->
+ Constraints = ConstraintsPrime
;
unexpected(this_file,
"Unrecognised predicate passed to process_special_builtin.")
Index: compiler/unify_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unify_gen.m,v
retrieving revision 1.150
diff -u -b -r1.150 unify_gen.m
--- compiler/unify_gen.m 26 May 2005 00:17:03 -0000 1.150
+++ compiler/unify_gen.m 7 Sep 2005 14:32:51 -0000
@@ -30,11 +30,10 @@
---> branch_on_success
; branch_on_failure.
-:- pred unify_gen__generate_unification(code_model::in, unification::in,
- hlds_goal_info::in, code_tree::out, code_info::in, code_info::out)
- is det.
+:- pred generate_unification(code_model::in, unification::in,
+ hlds_goal_info::in, code_tree::out, code_info::in, code_info::out) is det.
-:- pred unify_gen__generate_tag_test(prog_var::in, cons_id::in, test_sense::in,
+:- pred generate_tag_test(prog_var::in, cons_id::in, test_sense::in,
label::out, code_tree::out, code_info::in, code_info::out) is det.
%---------------------------------------------------------------------------%
@@ -56,10 +55,10 @@
:- import_module libs__globals.
:- import_module libs__options.
:- import_module libs__tree.
-:- import_module ll_backend__code_aux.
:- import_module ll_backend__code_util.
:- import_module ll_backend__continuation_info.
:- import_module ll_backend__layout.
+:- import_module ll_backend__llds_out.
:- import_module ll_backend__stack_layout.
:- import_module parse_tree__error_util.
:- import_module parse_tree__prog_data.
@@ -67,6 +66,7 @@
:- import_module parse_tree__prog_type.
:- import_module mdbcomp__prim_data.
+:- import_module assoc_list.
:- import_module bool.
:- import_module int.
:- import_module list.
@@ -82,81 +82,95 @@
%---------------------------------------------------------------------------%
-unify_gen__generate_unification(CodeModel, Uni, GoalInfo, Code, !CI) :-
+generate_unification(CodeModel, Uni, GoalInfo, Code, !CI) :-
( CodeModel = model_non ->
- error("nondet unification in unify_gen__generate_unification")
+ unexpected(this_file, "nondet unification in generate_unification")
;
true
),
(
Uni = assign(Left, Right),
( code_info__variable_is_forward_live(!.CI, Left) ->
- unify_gen__generate_assignment(Left, Right, Code, !CI)
+ generate_assignment(Left, Right, Code, !CI)
;
Code = empty
)
;
- Uni = construct(Var, ConsId, Args, Modes, _, _, Size),
- ( code_info__variable_is_forward_live(!.CI, Var) ->
- unify_gen__generate_construction(Var, ConsId,
- Args, Modes, Size, GoalInfo, Code, !CI)
+ Uni = construct(Var, ConsId, Args, Modes, _, _, SubInfo),
+ (
+ SubInfo = no_construct_sub_info,
+ MaybeTakeAddr = no,
+ MaybeSize = no
+ ;
+ SubInfo = construct_sub_info(MaybeTakeAddr, MaybeSize)
+ ),
+ (
+ ( code_info__variable_is_forward_live(!.CI, Var)
+ ; MaybeTakeAddr = yes(_)
+ )
+ ->
+ (
+ MaybeTakeAddr = yes(TakeAddr)
+ ;
+ MaybeTakeAddr = no,
+ TakeAddr = []
+ ),
+ generate_construction(Var, ConsId, Args, Modes,
+ TakeAddr, MaybeSize, GoalInfo, Code, !CI)
;
Code = empty
)
;
Uni = deconstruct(Var, ConsId, Args, Modes, _CanFail, _CanCGC),
( CodeModel = model_det ->
- unify_gen__generate_det_deconstruction(Var, ConsId,
- Args, Modes, Code, !CI)
+ generate_det_deconstruction(Var, ConsId, Args, Modes, Code, !CI)
;
- unify_gen__generate_semi_deconstruction(Var, ConsId,
- Args, Modes, Code, !CI)
+ generate_semi_deconstruction(Var, ConsId, Args, Modes, Code, !CI)
)
;
Uni = simple_test(Var1, Var2),
( CodeModel = model_det ->
- error("det simple_test during code generation")
+ unexpected(this_file, "det simple_test during code generation")
;
- unify_gen__generate_test(Var1, Var2, Code, !CI)
+ generate_test(Var1, Var2, Code, !CI)
)
;
- % These should have been transformed into calls
- % to unification procedures by polymorphism.m.
+ % These should have been transformed into calls to unification
+ % procedures by polymorphism.m.
Uni = complicated_unify(_UniMode, _CanFail, _TypeInfoVars),
- error("complicated unify during code generation")
+ unexpected(this_file, "complicated unify during code generation")
).
%---------------------------------------------------------------------------%
- % assignment unifications are generated by simply caching the
- % bound variable as the expression that generates the free
- % variable. No immediate code is generated.
-
-:- pred unify_gen__generate_assignment(prog_var::in, prog_var::in,
- code_tree::out, code_info::in, code_info::out) is det.
+ % Assignment unifications are generated by simply caching the bound
+ % variable as the expression that generates the free variable.
+ % No immediate code is generated.
+ %
+:- pred generate_assignment(prog_var::in, prog_var::in, code_tree::out,
+ code_info::in, code_info::out) is det.
-unify_gen__generate_assignment(VarA, VarB, empty, !CI) :-
+generate_assignment(VarA, VarB, empty, !CI) :-
( code_info__variable_is_forward_live(!.CI, VarA) ->
code_info__assign_var_to_var(VarA, VarB, !CI)
;
- % For free-free unifications, the mode analysis reports
- % them as assignment to the dead variable. For such
- % unifications we of course don't generate any code.
+ % For free-free unifications, the mode analysis reports them as
+ % assignment to the dead variable. For such unifications we of course
+ % do not generate any code.
true
).
%---------------------------------------------------------------------------%
- % A [simple] test unification is generated by flushing both
- % variables from the cache, and producing code that branches
- % to the fall-through point if the two values are not the same.
- % Simple tests are in-in unifications on enumerations, integers,
- % strings and floats.
-
-:- pred unify_gen__generate_test(prog_var::in, prog_var::in, code_tree::out,
+ % A [simple] test unification is generated by flushing both variables
+ % from the cache, and producing code that branches to the fall-through
+ % point if the two values are not the same. Simple tests are in-in
+ % unifications on enumerations, integers, strings and floats.
+ %
+:- pred generate_test(prog_var::in, prog_var::in, code_tree::out,
code_info::in, code_info::out) is det.
-unify_gen__generate_test(VarA, VarB, Code, !CI) :-
+generate_test(VarA, VarB, Code, !CI) :-
code_info__produce_variable(VarA, CodeA, ValA, !CI),
code_info__produce_variable(VarB, CodeB, ValB, !CI),
CodeAB = tree(CodeA, CodeB),
@@ -173,14 +187,12 @@
%---------------------------------------------------------------------------%
-unify_gen__generate_tag_test(Var, ConsId, Sense, ElseLab, Code, !CI) :-
+generate_tag_test(Var, ConsId, Sense, ElseLab, Code, !CI) :-
code_info__produce_variable(Var, VarCode, Rval, !CI),
- %
% As an optimization, for data types with exactly two alternatives,
% one of which is a constant, we make sure that we test against the
% constant (negating the result of the test, if needed),
% since a test against a constant is cheaper than a tag test.
- %
(
ConsId = cons(_, Arity),
Arity > 0
@@ -217,14 +229,14 @@
ConsIdName], Comment),
CommentCode = node([comment(Comment) - ""]),
Tag = code_info__cons_id_to_tag(!.CI, Var, ConsId),
- unify_gen__generate_tag_test_rval_2(Tag, Rval, TestRval)
+ generate_tag_test_rval_2(Tag, Rval, TestRval)
;
Reverse = yes(TestConsId),
string__append_list(["checking that ", VarName, " has functor ",
ConsIdName, " (inverted test)"], Comment),
CommentCode = node([comment(Comment) - ""]),
Tag = code_info__cons_id_to_tag(!.CI, Var, TestConsId),
- unify_gen__generate_tag_test_rval_2(Tag, Rval, NegTestRval),
+ generate_tag_test_rval_2(Tag, Rval, NegTestRval),
code_util__neg_rval(NegTestRval, TestRval)
),
code_info__get_next_label(ElseLab, !CI),
@@ -235,98 +247,99 @@
Sense = branch_on_failure,
code_util__neg_rval(TestRval, TheRval)
),
- TestCode = node([
- if_val(TheRval, label(ElseLab)) - "tag test"
- ]),
+ TestCode = node([if_val(TheRval, label(ElseLab)) - "tag test"]),
Code = tree(VarCode, tree(CommentCode, TestCode)).
%---------------------------------------------------------------------------%
-:- pred unify_gen__generate_tag_test_rval(prog_var::in, cons_id::in,
+:- pred generate_tag_test_rval(prog_var::in, cons_id::in,
rval::out, code_tree::out, code_info::in, code_info::out) is det.
-unify_gen__generate_tag_test_rval(Var, ConsId, TestRval, Code, !CI) :-
+generate_tag_test_rval(Var, ConsId, TestRval, Code, !CI) :-
code_info__produce_variable(Var, Code, Rval, !CI),
Tag = code_info__cons_id_to_tag(!.CI, Var, ConsId),
- unify_gen__generate_tag_test_rval_2(Tag, Rval, TestRval).
+ generate_tag_test_rval_2(Tag, Rval, TestRval).
-:- pred unify_gen__generate_tag_test_rval_2(cons_tag::in, rval::in, rval::out)
+:- pred generate_tag_test_rval_2(cons_tag::in, rval::in, rval::out)
is det.
-unify_gen__generate_tag_test_rval_2(string_constant(String), Rval, TestRval) :-
- TestRval = binop(str_eq, Rval, const(string_const(String))).
-unify_gen__generate_tag_test_rval_2(float_constant(Float), Rval, TestRval) :-
- TestRval = binop(float_eq, Rval, const(float_const(Float))).
-unify_gen__generate_tag_test_rval_2(int_constant(Int), Rval, TestRval) :-
- TestRval = binop(eq, Rval, const(int_const(Int))).
-unify_gen__generate_tag_test_rval_2(pred_closure_tag(_, _, _), _Rval,
- _TestRval) :-
+generate_tag_test_rval_2(ConsTag, Rval, TestRval) :-
+ (
+ ConsTag = string_constant(String),
+ TestRval = binop(str_eq, Rval, const(string_const(String)))
+ ;
+ ConsTag = float_constant(Float),
+ TestRval = binop(float_eq, Rval, const(float_const(Float)))
+ ;
+ ConsTag = int_constant(Int),
+ TestRval = binop(eq, Rval, const(int_const(Int)))
+ ;
+ ConsTag = pred_closure_tag(_, _, _),
% This should never happen, since the error will be detected
% during mode checking.
- error("Attempted higher-order unification").
-unify_gen__generate_tag_test_rval_2(type_ctor_info_constant(_, _, _), _, _) :-
- % This should never happen
- error("Attempted type_ctor_info unification").
-unify_gen__generate_tag_test_rval_2(base_typeclass_info_constant(_, _, _), _,
- _) :-
- % This should never happen
- error("Attempted base_typeclass_info unification").
-unify_gen__generate_tag_test_rval_2(tabling_pointer_constant(_, _), _, _) :-
- % This should never happen
- error("Attempted tabling_pointer unification").
-unify_gen__generate_tag_test_rval_2(deep_profiling_proc_layout_tag(_, _),
- _, _) :-
- % This should never happen
- error("Attempted deep_profiling_proc_layout_tag unification").
-unify_gen__generate_tag_test_rval_2(table_io_decl_tag(_, _), _, _) :-
- % This should never happen
- error("Attempted table_io_decl_tag unification").
-unify_gen__generate_tag_test_rval_2(no_tag, _Rval, TestRval) :-
- TestRval = const(true).
-unify_gen__generate_tag_test_rval_2(single_functor, _Rval, TestRval) :-
- TestRval = const(true).
-unify_gen__generate_tag_test_rval_2(unshared_tag(UnsharedTag), Rval,
- TestRval) :-
+ unexpected(this_file, "Attempted higher-order unification")
+ ;
+ ConsTag = type_ctor_info_constant(_, _, _),
+ unexpected(this_file, "Attempted type_ctor_info unification")
+ ;
+ ConsTag = base_typeclass_info_constant(_, _, _),
+ unexpected(this_file, "Attempted base_typeclass_info unification")
+ ;
+ ConsTag = tabling_pointer_constant(_, _),
+ unexpected(this_file, "Attempted tabling_pointer unification")
+ ;
+ ConsTag = deep_profiling_proc_layout_tag(_, _),
+ unexpected(this_file,
+ "Attempted deep_profiling_proc_layout_tag unification")
+ ;
+ ConsTag = table_io_decl_tag(_, _),
+ unexpected(this_file, "Attempted table_io_decl_tag unification")
+ ;
+ ConsTag = no_tag,
+ TestRval = const(true)
+ ;
+ ConsTag = single_functor,
+ TestRval = const(true)
+ ;
+ ConsTag = unshared_tag(UnsharedTag),
VarPtag = unop(tag, Rval),
ConstPtag = unop(mktag, const(int_const(UnsharedTag))),
- TestRval = binop(eq, VarPtag, ConstPtag).
-unify_gen__generate_tag_test_rval_2(shared_remote_tag(Bits, Num), Rval,
- TestRval) :-
+ TestRval = binop(eq, VarPtag, ConstPtag)
+ ;
+ ConsTag = shared_remote_tag(Bits, Num),
VarPtag = unop(tag, Rval),
ConstPtag = unop(mktag, const(int_const(Bits))),
PtagTestRval = binop(eq, VarPtag, ConstPtag),
VarStag = lval(field(yes(Bits), Rval, const(int_const(0)))),
ConstStag = const(int_const(Num)),
StagTestRval = binop(eq, VarStag, ConstStag),
- TestRval = binop(and, PtagTestRval, StagTestRval).
-unify_gen__generate_tag_test_rval_2(shared_local_tag(Bits, Num), Rval,
- TestRval) :-
+ TestRval = binop(and, PtagTestRval, StagTestRval)
+ ;
+ ConsTag = shared_local_tag(Bits, Num),
ConstStag = mkword(Bits, unop(mkbody, const(int_const(Num)))),
- TestRval = binop(eq, Rval, ConstStag).
-unify_gen__generate_tag_test_rval_2(reserved_address(RA), Rval, TestRval) :-
- TestRval = binop(eq, Rval, unify_gen__generate_reserved_address(RA)).
-unify_gen__generate_tag_test_rval_2(
- shared_with_reserved_addresses(ReservedAddrs, ThisTag),
- Rval, FinalTestRval) :-
- %
- % We first check that the Rval doesn't match any of the
- % ReservedAddrs, and then check that it matches ThisTag.
- %
- CheckReservedAddrs = (func(RA, TestRval0) = TestRval :-
- unify_gen__generate_tag_test_rval_2(reserved_address(RA), Rval,
- EqualRA),
- TestRval = binop((and), unop(not, EqualRA), TestRval0)
+ TestRval = binop(eq, Rval, ConstStag)
+ ;
+ ConsTag = reserved_address(RA),
+ TestRval = binop(eq, Rval, generate_reserved_address(RA))
+ ;
+ ConsTag = shared_with_reserved_addresses(ReservedAddrs, ThisTag),
+ % We first check that the Rval doesn't match any of the ReservedAddrs,
+ % and then check that it matches ThisTag.
+ CheckReservedAddrs = (func(RA, InnerTestRval0) = InnerTestRval :-
+ generate_tag_test_rval_2(reserved_address(RA), Rval, EqualRA),
+ InnerTestRval = binop((and), unop(not, EqualRA), InnerTestRval0)
),
- unify_gen__generate_tag_test_rval_2(ThisTag, Rval, MatchesThisTag),
- FinalTestRval = list__foldr(CheckReservedAddrs, ReservedAddrs,
- MatchesThisTag).
-
-:- func unify_gen__generate_reserved_address(reserved_address) = rval.
-
-unify_gen__generate_reserved_address(null_pointer) = const(int_const(0)).
-unify_gen__generate_reserved_address(small_pointer(N)) = const(int_const(N)).
-unify_gen__generate_reserved_address(reserved_object(_, _, _)) = _ :-
- % These should only be used for the MLDS back-end
+ generate_tag_test_rval_2(ThisTag, Rval, MatchesThisTag),
+ TestRval = list__foldr(CheckReservedAddrs, ReservedAddrs,
+ MatchesThisTag)
+ ).
+
+:- func generate_reserved_address(reserved_address) = rval.
+
+generate_reserved_address(null_pointer) = const(int_const(0)).
+generate_reserved_address(small_pointer(N)) = const(int_const(N)).
+generate_reserved_address(reserved_object(_, _, _)) = _ :-
+ % These should only be used for the MLDS back-end.
unexpected(this_file, "reserved_object").
%---------------------------------------------------------------------------%
@@ -339,115 +352,116 @@
% constants, the construction is implemented as a heap-increment
% to create a term, and a series of [optional] assignments to
% instantiate the arguments of that term.
+ %
+:- pred generate_construction(prog_var::in, cons_id::in,
+ list(prog_var)::in, list(uni_mode)::in, list(int)::in,
+ maybe(term_size_value)::in, hlds_goal_info::in, code_tree::out,
+ code_info::in, code_info::out) is det.
-:- pred unify_gen__generate_construction(prog_var::in, cons_id::in,
- list(prog_var)::in, list(uni_mode)::in, maybe(term_size_value)::in,
- hlds_goal_info::in, code_tree::out, code_info::in, code_info::out)
- is det.
-
-unify_gen__generate_construction(Var, Cons, Args, Modes, Size, GoalInfo,
+generate_construction(Var, ConsId, Args, Modes, TakeAddr, MaybeSize, GoalInfo,
Code, !CI) :-
- Tag = code_info__cons_id_to_tag(!.CI, Var, Cons),
- unify_gen__generate_construction_2(Tag, Var, Args,
- Modes, Size, GoalInfo, Code, !CI).
+ Tag = code_info__cons_id_to_tag(!.CI, Var, ConsId),
+ generate_construction_2(Tag, Var, Args, Modes, TakeAddr, MaybeSize,
+ GoalInfo, Code, !CI).
-:- pred unify_gen__generate_construction_2(cons_tag::in, prog_var::in,
- list(prog_var)::in, list(uni_mode)::in, maybe(term_size_value)::in,
- hlds_goal_info::in, code_tree::out, code_info::in, code_info::out)
- is det.
+:- pred generate_construction_2(cons_tag::in, prog_var::in,
+ list(prog_var)::in, list(uni_mode)::in, list(int)::in,
+ maybe(term_size_value)::in, hlds_goal_info::in, code_tree::out,
+ code_info::in, code_info::out) is det.
-unify_gen__generate_construction_2(string_constant(String),
- Var, _Args, _Modes, _, _, empty, !CI) :-
- code_info__assign_const_to_var(Var, const(string_const(String)), !CI).
-unify_gen__generate_construction_2(int_constant(Int),
- Var, _Args, _Modes, _, _, empty, !CI) :-
- code_info__assign_const_to_var(Var, const(int_const(Int)), !CI).
-unify_gen__generate_construction_2(float_constant(Float),
- Var, _Args, _Modes, _, _, empty, !CI) :-
- code_info__assign_const_to_var(Var, const(float_const(Float)), !CI).
-unify_gen__generate_construction_2(no_tag, Var, Args, Modes, _, _, Code,
- !CI) :-
+generate_construction_2(ConsTag, Var, Args, Modes, TakeAddr, MaybeSize,
+ GoalInfo, Code, !CI) :-
+ (
+ ConsTag = string_constant(String),
+ code_info__assign_const_to_var(Var, const(string_const(String)), !CI),
+ Code = empty
+ ;
+ ConsTag = int_constant(Int),
+ code_info__assign_const_to_var(Var, const(int_const(Int)), !CI),
+ Code = empty
+ ;
+ ConsTag = float_constant(Float),
+ code_info__assign_const_to_var(Var, const(float_const(Float)), !CI),
+ Code = empty
+ ;
+ ConsTag = no_tag,
(
Args = [Arg],
Modes = [Mode]
->
+ (
+ TakeAddr = [],
+ MaybeSize = no
+ ->
Type = code_info__variable_type(!.CI, Arg),
- unify_gen__generate_sub_unify(ref(Var), ref(Arg), Mode, Type, Code,
- !CI)
+ generate_sub_unify(ref(Var), ref(Arg), Mode, Type, Code, !CI)
;
- error("unify_gen__generate_construction_2: no_tag: arity != 1")
- ).
-unify_gen__generate_construction_2(single_functor,
- Var, Args, Modes, Size, GoalInfo, Code, !CI) :-
- % treat single_functor the same as unshared_tag(0)
- unify_gen__generate_construction_2(unshared_tag(0),
- Var, Args, Modes, Size, GoalInfo, Code, !CI).
-unify_gen__generate_construction_2(unshared_tag(Ptag),
- Var, Args, Modes, Size, _, Code, !CI) :-
+ unexpected(this_file,
+ "generate_construction_2: notag: take_addr or maybe_size")
+ )
+ ;
+ unexpected(this_file,
+ "generate_construction_2: no_tag: arity != 1")
+ )
+ ;
+ ConsTag = single_functor,
+ % Treat single_functor the same as unshared_tag(0).
+ generate_construction_2(unshared_tag(0),
+ Var, Args, Modes, TakeAddr, MaybeSize, GoalInfo, Code, !CI)
+ ;
+ ConsTag = unshared_tag(Ptag),
code_info__get_module_info(!.CI, ModuleInfo),
- unify_gen__var_types(!.CI, Args, ArgTypes),
- unify_gen__generate_cons_args(Args, ArgTypes, Modes, ModuleInfo, Rvals),
- unify_gen__construct_cell(Var, Ptag, Rvals, Size, Code, !CI).
-unify_gen__generate_construction_2(shared_remote_tag(Ptag, Sectag),
- Var, Args, Modes, Size, _, Code, !CI) :-
+ var_types(!.CI, Args, ArgTypes),
+ generate_cons_args(Args, ArgTypes, Modes, 0, 1, TakeAddr, ModuleInfo,
+ Rvals, FieldAddrs),
+ construct_cell(Var, Ptag, Rvals, MaybeSize, FieldAddrs, Code, !CI)
+ ;
+ ConsTag = shared_remote_tag(Ptag, Sectag),
code_info__get_module_info(!.CI, ModuleInfo),
- unify_gen__var_types(!.CI, Args, ArgTypes),
- unify_gen__generate_cons_args(Args, ArgTypes, Modes, ModuleInfo,
- Rvals0),
- % the first field holds the secondary tag
+ var_types(!.CI, Args, ArgTypes),
+ generate_cons_args(Args, ArgTypes, Modes, 1, 1, TakeAddr, ModuleInfo,
+ Rvals0, FieldAddrs),
+ % The first field holds the secondary tag.
Rvals = [yes(const(int_const(Sectag))) | Rvals0],
- unify_gen__construct_cell(Var, Ptag, Rvals, Size, Code, !CI).
-unify_gen__generate_construction_2(shared_local_tag(Bits1, Num1),
- Var, _Args, _Modes, _, _, empty, !CI) :-
+ construct_cell(Var, Ptag, Rvals, MaybeSize, FieldAddrs, Code, !CI)
+ ;
+ ConsTag = shared_local_tag(Bits1, Num1),
code_info__assign_const_to_var(Var,
- mkword(Bits1, unop(mkbody, const(int_const(Num1)))), !CI).
-unify_gen__generate_construction_2(type_ctor_info_constant(ModuleName,
- TypeName, TypeArity), Var, Args, _Modes, _, _, empty, !CI) :-
- (
- Args = []
+ mkword(Bits1, unop(mkbody, const(int_const(Num1)))), !CI),
+ Code = empty
;
- Args = [_ | _],
- error("unify_gen: type-info constant has args")
- ),
+ ConsTag = type_ctor_info_constant(ModuleName, TypeName, TypeArity),
+ require(unify(Args, []),
+ "generate_construction_2: type_ctor_info constant has args"),
RttiTypeCtor = rtti_type_ctor(ModuleName, TypeName, TypeArity),
DataAddr = rtti_addr(ctor_rtti_id(RttiTypeCtor, type_ctor_info)),
code_info__assign_const_to_var(Var,
- const(data_addr_const(DataAddr, no)), !CI).
-unify_gen__generate_construction_2(base_typeclass_info_constant(ModuleName,
- ClassId, Instance), Var, Args, _Modes, _, _, empty, !CI) :-
- (
- Args = []
+ const(data_addr_const(DataAddr, no)), !CI),
+ Code = empty
;
- Args = [_ | _],
- error("unify_gen: typeclass-info constant has args")
- ),
+ ConsTag = base_typeclass_info_constant(ModuleName, ClassId, Instance),
+ require(unify(Args, []),
+ "generate_construction_2: base_typeclass_info constant has args"),
TCName = generate_class_name(ClassId),
code_info__assign_const_to_var(Var,
const(data_addr_const(rtti_addr(tc_rtti_id(TCName,
- base_typeclass_info(ModuleName, Instance))), no)), !CI).
-unify_gen__generate_construction_2(tabling_pointer_constant(PredId, ProcId),
- Var, Args, _Modes, _, _, empty, !CI) :-
- (
- Args = []
+ base_typeclass_info(ModuleName, Instance))), no)), !CI),
+ Code = empty
;
- Args = [_ | _],
- error("unify_gen: tabling pointer constant has args")
- ),
+ ConsTag = tabling_pointer_constant(PredId, ProcId),
+ require(unify(Args, []),
+ "generate_construction_2: tabling_pointer constant has args"),
code_info__get_module_info(!.CI, ModuleInfo),
ProcLabel = make_proc_label(ModuleInfo, PredId, ProcId),
module_info_name(ModuleInfo, ModuleName),
DataAddr = data_addr(ModuleName, tabling_pointer(ProcLabel)),
code_info__assign_const_to_var(Var,
- const(data_addr_const(DataAddr, no)), !CI).
-unify_gen__generate_construction_2(
- deep_profiling_proc_layout_tag(PredId, ProcId),
- Var, Args, _Modes, _, _, empty, !CI) :-
- (
- Args = []
+ const(data_addr_const(DataAddr, no)), !CI),
+ Code = empty
;
- Args = [_ | _],
- error("unify_gen: deep_profiling_proc_static has args")
- ),
+ ConsTag = deep_profiling_proc_layout_tag(PredId, ProcId),
+ require(unify(Args, []),
+ "generate_construction_2: deep_profiling_proc_static has args"),
code_info__get_module_info(!.CI, ModuleInfo),
RttiProcLabel = make_rtti_proc_label(ModuleInfo, PredId, ProcId),
Origin = RttiProcLabel ^ pred_info_origin,
@@ -459,51 +473,56 @@
ProcKind = proc_layout_proc_id(UserOrUCI),
DataAddr = layout_addr(proc_layout(RttiProcLabel, ProcKind)),
code_info__assign_const_to_var(Var,
- const(data_addr_const(DataAddr, no)), !CI).
-unify_gen__generate_construction_2(table_io_decl_tag(PredId, ProcId),
- Var, Args, _Modes, _, _, empty, !CI) :-
- (
- Args = []
+ const(data_addr_const(DataAddr, no)), !CI),
+ Code = empty
;
- Args = [_ | _],
- error("unify_gen: table_io_decl has args")
- ),
+ ConsTag = table_io_decl_tag(PredId, ProcId),
+ require(unify(Args, []),
+ "generate_construction_2: table_io_decl has args"),
code_info__get_module_info(!.CI, ModuleInfo),
RttiProcLabel = make_rtti_proc_label(ModuleInfo, PredId, ProcId),
DataAddr = layout_addr(table_io_decl(RttiProcLabel)),
code_info__assign_const_to_var(Var,
- const(data_addr_const(DataAddr, no)), !CI).
-unify_gen__generate_construction_2(reserved_address(RA),
- Var, Args, _Modes, _, _, empty, !CI) :-
- (
- Args = []
+ const(data_addr_const(DataAddr, no)), !CI),
+ Code = empty
;
- Args = [_ | _],
- error("unify_gen: reserved_address constant has args")
- ),
- code_info__assign_const_to_var(Var,
- unify_gen__generate_reserved_address(RA), !CI).
-unify_gen__generate_construction_2(
- shared_with_reserved_addresses(_RAs, ThisTag),
- Var, Args, Modes, Size, GoalInfo, Code, !CI) :-
- % For shared_with_reserved_address, the sharing is only
- % important for tag tests, not for constructions,
- % so here we just recurse on the real representation.
- unify_gen__generate_construction_2(ThisTag,
- Var, Args, Modes, Size, GoalInfo, Code, !CI).
-unify_gen__generate_construction_2(
- pred_closure_tag(PredId, ProcId, EvalMethod),
- Var, Args, _Modes, _, GoalInfo, Code, !CI) :-
- % This code constructs or extends a closure.
+ ConsTag = reserved_address(RA),
+ require(unify(Args, []),
+ "generate_construction_2: reserved_address constant has args"),
+ code_info__assign_const_to_var(Var, generate_reserved_address(RA),
+ !CI),
+ Code = empty
+ ;
+ ConsTag = shared_with_reserved_addresses(_RAs, ThisTag),
+ % For shared_with_reserved_address, the sharing is only important
+ % for tag tests, not for constructions, so here we just recurse
+ % on the real representation.
+ generate_construction_2(ThisTag,
+ Var, Args, Modes, TakeAddr, MaybeSize, GoalInfo, Code, !CI)
+ ;
+ ConsTag = pred_closure_tag(PredId, ProcId, EvalMethod),
+ require(unify(TakeAddr, []),
+ "generate_construction_2: pred_closure_tag has take_addr"),
+ require(unify(MaybeSize, no),
+ "generate_construction_2: pred_closure_tag has size"),
+ generate_closure(PredId, ProcId, EvalMethod, Var, Args, GoalInfo,
+ Code, !CI)
+ ).
+
+ % This predicate constructs or extends a closure.
% The structure of closures is defined in runtime/mercury_ho_call.h.
+ %
+:- pred generate_closure(pred_id::in, proc_id::in, lambda_eval_method::in,
+ prog_var::in, list(prog_var)::in, hlds_goal_info::in, code_tree::out,
+ code_info::in, code_info::out) is det.
+generate_closure(PredId, ProcId, EvalMethod, Var, Args, GoalInfo, Code, !CI) :-
code_info__get_module_info(!.CI, ModuleInfo),
module_info_preds(ModuleInfo, Preds),
map__lookup(Preds, PredId, PredInfo),
pred_info_procedures(PredInfo, Procs),
map__lookup(Procs, ProcId, ProcInfo),
- %
% We handle currying of a higher-order pred variable as a special case.
% We recognize
%
@@ -527,7 +546,6 @@
% typecheck.m contains code to detect such constructs, because it does not
% have code to typecheck them (you get a message about call/2 should be
% used as a goal, not an expression).
- %
proc_info_goal(ProcInfo, ProcInfoGoal),
proc_info_interface_code_model(ProcInfo, CodeModel),
@@ -539,9 +557,8 @@
ProcInfoGoal = generic_call(higher_order(ProcPred, _, _, _),
ProcArgs, _, CallDeterminism) - _GoalInfo,
determinism_to_code_model(CallDeterminism, CallCodeModel),
- % Check that the code models are compatible.
- % Note that det is not compatible with semidet,
- % and semidet is not compatible with nondet,
+ % Check that the code models are compatible. Note that det is not
+ % compatible with semidet, and semidet is not compatible with nondet,
% since the arguments go in different registers.
% But det is compatible with nondet.
(
@@ -550,8 +567,8 @@
CodeModel = model_non,
CallCodeModel = model_det
),
- % This optimization distorts deep profiles, so don't
- % perform it in deep profiling grades.
+ % This optimization distorts deep profiles, so don't perform it
+ % in deep profiling grades.
module_info_globals(ModuleInfo, Globals),
globals__lookup_bool_option(Globals, profile_deep, Deep),
Deep = no
@@ -583,8 +600,8 @@
assign(NumOldArgs, lval(field(yes(0), OldClosure, Two)))
- "get number of arguments",
incr_hp(NewClosure, no, no,
- binop(+, lval(NumOldArgs),
- NumNewArgsPlusThree_Rval), "closure")
+ binop(+, lval(NumOldArgs), NumNewArgsPlusThree_Rval),
+ "closure")
- "allocate new closure",
assign(field(yes(0), lval(NewClosure), Zero),
lval(field(yes(0), OldClosure, Zero)))
@@ -599,11 +616,9 @@
- "set up loop limit",
assign(LoopCounter, Three)
- "initialize loop counter",
- % It is possible for the number of hidden
- % arguments to be zero, in which case the body
- % of this loop should not be executed at all.
- % This is why we jump to the loop condition
- % test.
+ % It is possible for the number of hidden arguments to be zero,
+ % in which case the body of this loop should not be executed
+ % at all. This is why we jump to the loop condition test.
goto(label(LoopTest))
- ("enter the copy loop at the conceptual top"),
label(LoopStart) - "start of loop",
@@ -618,8 +633,8 @@
label(LoopStart))
- "repeat the loop?"
]),
- unify_gen__generate_extra_closure_args(CallArgs,
- LoopCounter, NewClosure, ExtraArgsCode, !CI),
+ generate_extra_closure_args(CallArgs, LoopCounter, NewClosure,
+ ExtraArgsCode, !CI),
code_info__release_reg(LoopCounter, !CI),
code_info__release_reg(NumOldArgs, !CI),
code_info__release_reg(NewClosure, !CI),
@@ -674,23 +689,23 @@
ClosureLayoutRval = const(data_addr_const(ClosureDataAddr, no)),
list__length(Args, NumArgs),
proc_info_arg_info(ProcInfo, ArgInfo),
- unify_gen__generate_pred_args(Args, ArgInfo, PredArgs),
+ generate_pred_args(Args, ArgInfo, PredArgs),
Vector = [
yes(ClosureLayoutRval),
yes(CallArgsRval),
yes(const(int_const(NumArgs)))
| PredArgs
],
- code_info__assign_cell_to_var(Var, no, 0, Vector, no,
- "closure", Code, !CI)
+ code_info__assign_cell_to_var(Var, no, 0, Vector, no, "closure",
+ Code, !CI)
).
-:- pred unify_gen__generate_extra_closure_args(list(prog_var)::in, lval::in,
+:- pred generate_extra_closure_args(list(prog_var)::in, lval::in,
lval::in, code_tree::out, code_info::in, code_info::out) is det.
-unify_gen__generate_extra_closure_args([], _, _, empty, !CI).
-unify_gen__generate_extra_closure_args([Var | Vars], LoopCounter,
- NewClosure, Code, !CI) :-
+generate_extra_closure_args([], _, _, empty, !CI).
+generate_extra_closure_args([Var | Vars], LoopCounter, NewClosure, Code,
+ !CI) :-
code_info__produce_variable(Var, Code0, Value, !CI),
One = const(int_const(1)),
Code1 = node([
@@ -699,17 +714,16 @@
assign(LoopCounter, binop(+, lval(LoopCounter), One))
- "increment argument counter"
]),
- unify_gen__generate_extra_closure_args(Vars, LoopCounter, NewClosure,
- Code2, !CI),
+ generate_extra_closure_args(Vars, LoopCounter, NewClosure, Code2, !CI),
Code = tree_list([Code0, Code1, Code2]).
-:- pred unify_gen__generate_pred_args(list(prog_var)::in, list(arg_info)::in,
+:- pred generate_pred_args(list(prog_var)::in, list(arg_info)::in,
list(maybe(rval))::out) is det.
-unify_gen__generate_pred_args([], _, []).
-unify_gen__generate_pred_args([_|_], [], _) :-
- error("unify_gen__generate_pred_args: insufficient args").
-unify_gen__generate_pred_args([Var | Vars], [ArgInfo | ArgInfos],
+generate_pred_args([], _, []).
+generate_pred_args([_ | _], [], _) :-
+ unexpected(this_file, "generate_pred_args: insufficient args").
+generate_pred_args([Var | Vars], [ArgInfo | ArgInfos],
[Rval | Rvals]) :-
ArgInfo = arg_info(_, ArgMode),
( ArgMode = top_in ->
@@ -717,16 +731,22 @@
;
Rval = no
),
- unify_gen__generate_pred_args(Vars, ArgInfos, Rvals).
+ generate_pred_args(Vars, ArgInfos, Rvals).
-:- pred unify_gen__generate_cons_args(list(prog_var)::in, list(type)::in,
- list(uni_mode)::in, module_info::in, list(maybe(rval))::out) is det.
+:- pred generate_cons_args(list(prog_var)::in, list(type)::in,
+ list(uni_mode)::in, int::in, int::in, list(int)::in, module_info::in,
+ list(maybe(rval))::out, assoc_list(int, prog_var)::out) is det.
-unify_gen__generate_cons_args(Vars, Types, Modes, ModuleInfo, Args) :-
- ( unify_gen__generate_cons_args_2(Vars, Types, Modes, ModuleInfo, Args0) ->
- Args = Args0
+generate_cons_args(Vars, Types, Modes, FirstOffset, FirstArgNum, TakeAddr,
+ ModuleInfo, Args, FieldAddrs) :-
+ (
+ generate_cons_args_2(Vars, Types, Modes, FirstOffset, FirstArgNum,
+ TakeAddr, ModuleInfo, Args0, FieldAddrs0)
+ ->
+ Args = Args0,
+ FieldAddrs = FieldAddrs0
;
- error("unify_gen__generate_cons_args: length mismatch")
+ unexpected(this_file, "generate_cons_args: length mismatch")
).
% Create a list of maybe(rval) for the arguments for a construction
@@ -734,29 +754,43 @@
% unification, we produce `yes(var(Var))', but if the argument is free,
% we just produce `no', meaning don't generate an assignment to that
% field.
-
-:- pred unify_gen__generate_cons_args_2(list(prog_var)::in, list(type)::in,
- list(uni_mode)::in, module_info::in, list(maybe(rval))::out)
- is semidet.
-
-unify_gen__generate_cons_args_2([], [], [], _, []).
-unify_gen__generate_cons_args_2([Var | Vars], [Type | Types],
- [UniMode | UniModes], ModuleInfo, [Rval | RVals]) :-
+ %
+:- pred generate_cons_args_2(list(prog_var)::in, list(type)::in,
+ list(uni_mode)::in, int::in, int::in, list(int)::in, module_info::in,
+ list(maybe(rval))::out, assoc_list(int, prog_var)::out) is semidet.
+
+generate_cons_args_2([], [], [], _, _, [], _, [], []).
+generate_cons_args_2([Var | Vars], [Type | Types], [UniMode | UniModes],
+ FirstOffset, CurArgNum, !.TakeAddr, ModuleInfo, [Rval | Rvals],
+ FieldAddrs) :-
+ ( !.TakeAddr = [CurArgNum | !:TakeAddr] ->
+ Rval = no,
+ generate_cons_args_2(Vars, Types, UniModes, FirstOffset,
+ CurArgNum + 1, !.TakeAddr, ModuleInfo, Rvals, FieldAddrs1),
+ % Whereas CurArgNum starts numbering the arguments from 1, offsets
+ % into fields start from zero. However, if FirstOffset = 1, then the
+ % first word in the cell is the secondary tag.
+ Offset = CurArgNum - 1 + FirstOffset,
+ FieldAddrs = [Offset - Var | FieldAddrs1]
+ ;
UniMode = ((_LI - RI) -> (_LF - RF)),
- ( mode_to_arg_mode(ModuleInfo, (RI -> RF), Type, top_in) ->
+ mode_to_arg_mode(ModuleInfo, (RI -> RF), Type, ArgMode),
+ ( ArgMode = top_in ->
Rval = yes(var(Var))
;
Rval = no
),
- unify_gen__generate_cons_args_2(Vars, Types, UniModes, ModuleInfo, RVals).
+ generate_cons_args_2(Vars, Types, UniModes, FirstOffset,
+ CurArgNum + 1, !.TakeAddr, ModuleInfo, Rvals, FieldAddrs)
+ ).
-:- pred unify_gen__construct_cell(prog_var::in, tag::in, list(maybe(rval))::in,
- maybe(term_size_value)::in, code_tree::out,
+:- pred construct_cell(prog_var::in, tag::in, list(maybe(rval))::in,
+ maybe(term_size_value)::in, assoc_list(int, prog_var)::in, code_tree::out,
code_info::in, code_info::out) is det.
-unify_gen__construct_cell(Var, Ptag, Rvals, Size, Code, !CI) :-
+construct_cell(Var, Ptag, MaybeRvals, MaybeSize, FieldAddrs, Code, !CI) :-
VarType = code_info__variable_type(!.CI, Var),
- unify_gen__var_type_msg(VarType, VarTypeMsg),
+ var_type_msg(VarType, VarTypeMsg),
% If we're doing accurate GC, then for types which hold RTTI that
% will be traversed by the collector at GC-time, we need to allocate
% an extra word at the start, to hold the forwarding pointer.
@@ -773,34 +807,58 @@
;
ReserveWordAtStart = no
),
- code_info__assign_cell_to_var(Var, ReserveWordAtStart, Ptag, Rvals,
- Size, VarTypeMsg, Code, !CI).
+ code_info__assign_cell_to_var(Var, ReserveWordAtStart, Ptag, MaybeRvals,
+ MaybeSize, VarTypeMsg, CellCode, !CI),
+ (
+ FieldAddrs = [],
+ % Optimize common case.
+ Code = CellCode
+ ;
+ FieldAddrs = [_ | _],
+ % Any field whose address we take will be represented by a `no'
+ % in MaybeRvals, which should prevent the cell from being made
+ % into static data.
+ generate_field_take_address_assigns(FieldAddrs, Var, Ptag,
+ FieldCode, !CI),
+ Code = tree(CellCode, FieldCode)
+ ).
+
+:- pred generate_field_take_address_assigns(assoc_list(int, prog_var)::in,
+ prog_var::in, int::in, code_tree::out, code_info::in, code_info::out)
+ is det.
+
+generate_field_take_address_assigns([], _, _, empty, !CI).
+generate_field_take_address_assigns([FieldNum - Var | FieldAddrs],
+ CellVar, CellPtag, tree(ThisCode, RestCode), !CI) :-
+ Addr = mem_addr(heap_ref(var(CellVar), CellPtag, FieldNum)),
+ assign_expr_to_var(Var, Addr, ThisCode, !CI),
+ generate_field_take_address_assigns(FieldAddrs, CellVar, CellPtag,
+ RestCode, !CI).
%---------------------------------------------------------------------------%
-:- pred unify_gen__var_types(code_info::in, list(prog_var)::in,
- list(type)::out) is det.
+:- pred var_types(code_info::in, list(prog_var)::in, list(type)::out) is det.
-unify_gen__var_types(CI, Vars, Types) :-
+var_types(CI, Vars, Types) :-
code_info__get_proc_info(CI, ProcInfo),
proc_info_vartypes(ProcInfo, VarTypes),
map__apply_to_list(Vars, VarTypes, Types).
%---------------------------------------------------------------------------%
- % Construct a pair of lists that associates the fields of
- % a term with variables.
-
-:- pred unify_gen__make_fields_and_argvars(list(prog_var)::in, rval::in,
+ % Construct a pair of lists that associates the fields of a term
+ % with variables.
+ %
+:- pred make_fields_and_argvars(list(prog_var)::in, rval::in,
int::in, int::in, list(uni_val)::out, list(uni_val)::out) is det.
-unify_gen__make_fields_and_argvars([], _, _, _, [], []).
-unify_gen__make_fields_and_argvars([Var | Vars], Rval, Field0, TagNum,
+make_fields_and_argvars([], _, _, _, [], []).
+make_fields_and_argvars([Var | Vars], Rval, Field0, TagNum,
[F | Fs], [A | As]) :-
F = lval(field(yes(TagNum), Rval, const(int_const(Field0)))),
A = ref(Var),
Field1 = Field0 + 1,
- unify_gen__make_fields_and_argvars(Vars, Rval, Field1, TagNum, Fs, As).
+ make_fields_and_argvars(Vars, Rval, Field1, TagNum, Fs, As).
%---------------------------------------------------------------------------%
@@ -808,24 +866,23 @@
% deconstruction, we know the value of the tag, so we don't
% need to generate a test.
- % Deconstructions are generated semi-eagerly. Any test sub-
- % unifications are generated eagerly (they _must_ be), but
- % assignment unifications are cached.
-
-:- pred unify_gen__generate_det_deconstruction(prog_var::in, cons_id::in,
+ % Deconstructions are generated semi-eagerly. Any test sub-unifications
+ % are generated eagerly (they _must_ be), but assignment unifications
+ % are cached.
+ %
+:- pred generate_det_deconstruction(prog_var::in, cons_id::in,
list(prog_var)::in, list(uni_mode)::in, code_tree::out,
code_info::in, code_info::out) is det.
-unify_gen__generate_det_deconstruction(Var, Cons, Args, Modes, Code, !CI) :-
+generate_det_deconstruction(Var, Cons, Args, Modes, Code, !CI) :-
Tag = code_info__cons_id_to_tag(!.CI, Var, Cons),
- unify_gen__generate_det_deconstruction_2(Var, Cons, Args, Modes,
- Tag, Code, !CI).
+ generate_det_deconstruction_2(Var, Cons, Args, Modes, Tag, Code, !CI).
-:- pred unify_gen__generate_det_deconstruction_2(prog_var::in, cons_id::in,
+:- pred generate_det_deconstruction_2(prog_var::in, cons_id::in,
list(prog_var)::in, list(uni_mode)::in, cons_tag::in,
code_tree::out, code_info::in, code_info::out) is det.
-unify_gen__generate_det_deconstruction_2(Var, Cons, Args, Modes, Tag, Code,
+generate_det_deconstruction_2(Var, Cons, Args, Modes, Tag, Code,
!CI) :-
% For constants, if the deconstruction is det, then we already know
% the value of the constant, so Code = empty.
@@ -855,7 +912,7 @@
Code = empty
;
Tag = table_io_decl_tag(_, _),
- error("unify_gen__generate_det_deconstruction: table_io_decl_tag")
+ unexpected(this_file, "generate_det_deconstruction: table_io_decl_tag")
;
Tag = no_tag,
(
@@ -864,16 +921,13 @@
->
VarType = code_info__variable_type(!.CI, Var),
( is_dummy_argument_type(VarType) ->
- % We must handle this case specially. If we
- % didn't, the generated code would copy the
- % reference to the Var's current location,
- % which may be stackvar(N) or framevar(N) for
- % negative N, to be the location of Arg, and
- % since Arg may not be a dummy type, it would
- % actually use that location. This can happen
- % in the unify/compare routines for e.g.
+ % We must handle this case specially. If we didn't, the
+ % generated code would copy the reference to the Var's
+ % current location, which may be stackvar(N) or framevar(N)
+ % for negative N, to be the location of Arg, and since Arg
+ % may not be a dummy type, it would actually use that location.
+ % This can happen in the unify/compare routines for e.g.
% io__state.
-
( variable_is_forward_live(!.CI, Arg) ->
code_info__assign_const_to_var(Arg, const(int_const(0)),
!CI)
@@ -883,46 +937,43 @@
Code = empty
;
ArgType = code_info__variable_type(!.CI, Arg),
- unify_gen__generate_sub_unify(ref(Var), ref(Arg),
- Mode, ArgType, Code, !CI)
+ generate_sub_unify(ref(Var), ref(Arg), Mode, ArgType, Code,
+ !CI)
)
;
- error("unify_gen__generate_det_deconstruction: no_tag: arity != 1")
+ unexpected(this_file,
+ "generate_det_deconstruction: no_tag: arity != 1")
)
;
Tag = single_functor,
- % treat single_functor the same as unshared_tag(0)
- unify_gen__generate_det_deconstruction_2(Var, Cons, Args,
- Modes, unshared_tag(0), Code, !CI)
+ % Treat single_functor the same as unshared_tag(0).
+ generate_det_deconstruction_2(Var, Cons, Args, Modes, unshared_tag(0),
+ Code, !CI)
;
Tag = unshared_tag(Ptag),
Rval = var(Var),
- unify_gen__make_fields_and_argvars(Args, Rval, 0, Ptag, Fields,
- ArgVars),
- unify_gen__var_types(!.CI, Args, ArgTypes),
- unify_gen__generate_unify_args(Fields, ArgVars, Modes, ArgTypes, Code,
- !CI)
+ make_fields_and_argvars(Args, Rval, 0, Ptag, Fields, ArgVars),
+ var_types(!.CI, Args, ArgTypes),
+ generate_unify_args(Fields, ArgVars, Modes, ArgTypes, Code, !CI)
;
Tag = shared_remote_tag(Ptag, _Sectag1),
Rval = var(Var),
- unify_gen__make_fields_and_argvars(Args, Rval, 1, Ptag, Fields,
- ArgVars),
- unify_gen__var_types(!.CI, Args, ArgTypes),
- unify_gen__generate_unify_args(Fields, ArgVars, Modes, ArgTypes, Code,
- !CI)
+ make_fields_and_argvars(Args, Rval, 1, Ptag, Fields, ArgVars),
+ var_types(!.CI, Args, ArgTypes),
+ generate_unify_args(Fields, ArgVars, Modes, ArgTypes, Code, !CI)
;
Tag = shared_local_tag(_Ptag, _Sectag2),
- Code = empty % if this is det, then nothing happens
+ Code = empty
;
Tag = reserved_address(_RA),
- Code = empty % if this is det, then nothing happens
+ Code = empty
;
- % For shared_with_reserved_address, the sharing is only
- % important for tag tests, not for det deconstructions,
- % so here we just recurse on the real representation.
+ % For shared_with_reserved_address, the sharing is only important
+ % for tag tests, not for det deconstructions, so here we just recurse
+ % on the real representation.
Tag = shared_with_reserved_addresses(_RAs, ThisTag),
- unify_gen__generate_det_deconstruction_2(Var, Cons, Args, Modes,
- ThisTag, Code, !CI)
+ generate_det_deconstruction_2(Var, Cons, Args, Modes, ThisTag, Code,
+ !CI)
).
%---------------------------------------------------------------------------%
@@ -930,59 +981,54 @@
% Generate a semideterministic deconstruction.
% A semideterministic deconstruction unification is tag-test
% followed by a deterministic deconstruction.
-
-:- pred unify_gen__generate_semi_deconstruction(prog_var::in, cons_id::in,
+ %
+:- pred generate_semi_deconstruction(prog_var::in, cons_id::in,
list(prog_var)::in, list(uni_mode)::in,
code_tree::out, code_info::in, code_info::out) is det.
-unify_gen__generate_semi_deconstruction(Var, Tag, Args, Modes, Code, !CI) :-
- unify_gen__generate_tag_test(Var, Tag, branch_on_success,
- SuccLab, TagTestCode, !CI),
+generate_semi_deconstruction(Var, Tag, Args, Modes, Code, !CI) :-
+ generate_tag_test(Var, Tag, branch_on_success, SuccLab, TagTestCode, !CI),
code_info__remember_position(!.CI, AfterUnify),
code_info__generate_failure(FailCode, !CI),
code_info__reset_to_position(AfterUnify, !CI),
- unify_gen__generate_det_deconstruction(Var, Tag, Args, Modes, DeconsCode,
- !CI),
- SuccessLabelCode = node([
- label(SuccLab) - ""
- ]),
+ generate_det_deconstruction(Var, Tag, Args, Modes, DeconsCode, !CI),
+ SuccessLabelCode = node([label(SuccLab) - ""]),
Code = tree_list([TagTestCode, FailCode, SuccessLabelCode, DeconsCode]).
%---------------------------------------------------------------------------%
% Generate code to perform a list of deterministic subunifications
% for the arguments of a construction.
-
-:- pred unify_gen__generate_unify_args(list(uni_val)::in, list(uni_val)::in,
+ %
+:- pred generate_unify_args(list(uni_val)::in, list(uni_val)::in,
list(uni_mode)::in, list(type)::in, code_tree::out,
code_info::in, code_info::out) is det.
-unify_gen__generate_unify_args(Ls, Rs, Ms, Ts, Code, !CI) :-
- ( unify_gen__generate_unify_args_2(Ls, Rs, Ms, Ts, Code0, !CI) ->
+generate_unify_args(Ls, Rs, Ms, Ts, Code, !CI) :-
+ ( generate_unify_args_2(Ls, Rs, Ms, Ts, Code0, !CI) ->
Code = Code0
;
- error("unify_gen__generate_unify_args: length mismatch")
+ unexpected(this_file, "generate_unify_args: length mismatch")
).
-:- pred unify_gen__generate_unify_args_2(list(uni_val)::in, list(uni_val)::in,
+:- pred generate_unify_args_2(list(uni_val)::in, list(uni_val)::in,
list(uni_mode)::in, list(type)::in, code_tree::out,
code_info::in, code_info::out) is semidet.
-unify_gen__generate_unify_args_2([], [], [], [], empty, !CI).
-unify_gen__generate_unify_args_2([L | Ls], [R | Rs], [M | Ms], [T | Ts],
- Code, !CI) :-
- unify_gen__generate_sub_unify(L, R, M, T, CodeA, !CI),
- unify_gen__generate_unify_args_2(Ls, Rs, Ms, Ts, CodeB, !CI),
+generate_unify_args_2([], [], [], [], empty, !CI).
+generate_unify_args_2([L | Ls], [R | Rs], [M | Ms], [T | Ts], Code, !CI) :-
+ generate_sub_unify(L, R, M, T, CodeA, !CI),
+ generate_unify_args_2(Ls, Rs, Ms, Ts, CodeB, !CI),
Code = tree(CodeA, CodeB).
%---------------------------------------------------------------------------%
- % Generate a subunification between two [field|variable].
-
-:- pred unify_gen__generate_sub_unify(uni_val::in, uni_val::in, uni_mode::in,
+ % Generate a subunification between two [field | variable].
+ %
+:- pred generate_sub_unify(uni_val::in, uni_val::in, uni_mode::in,
(type)::in, code_tree::out, code_info::in, code_info::out) is det.
-unify_gen__generate_sub_unify(L, R, Mode, Type, Code, !CI) :-
+generate_sub_unify(L, R, Mode, Type, Code, !CI) :-
Mode = ((LI - RI) -> (LF - RF)),
code_info__get_module_info(!.CI, ModuleInfo),
mode_to_arg_mode(ModuleInfo, (LI -> LF), Type, LeftMode),
@@ -995,83 +1041,80 @@
% This shouldn't happen, since mode analysis should
% avoid creating any tests in the arguments
% of a construction or deconstruction unification.
- error("test in arg of [de]construction")
+ unexpected(this_file, "test in arg of [de]construction")
;
% Input - Output== assignment ->
LeftMode = top_in,
RightMode = top_out
->
- unify_gen__generate_sub_assign(R, L, Code, !CI)
+ generate_sub_assign(R, L, Code, !CI)
;
% Output - Input== assignment <-
LeftMode = top_out,
RightMode = top_in
->
- unify_gen__generate_sub_assign(L, R, Code, !CI)
+ generate_sub_assign(L, R, Code, !CI)
;
LeftMode = top_unused,
RightMode = top_unused
->
- Code = empty % free-free - ignore
- % XXX I think this will have to change
- % if we start to support aliasing
+ Code = empty
+ % free-free - ignore
+ % XXX I think this will have to change if we start to support aliasing.
;
- error("unify_gen__generate_sub_unify: some strange unify")
+ unexpected(this_file, "generate_sub_unify: some strange unify")
).
%---------------------------------------------------------------------------%
-:- pred unify_gen__generate_sub_assign(uni_val::in, uni_val::in,
- code_tree::out, code_info::in, code_info::out) is det.
+:- pred generate_sub_assign(uni_val::in, uni_val::in, code_tree::out,
+ code_info::in, code_info::out) is det.
+generate_sub_assign(Left, Right, Code, !CI) :-
+ (
+ Left = lval(_Lval),
+ Right = lval(_Rval),
% Assignment between two lvalues - cannot happen.
-unify_gen__generate_sub_assign(lval(_Lval0), lval(_Rval), _Code, !CI) :-
- error("unify_gen__generate_sub_assign: lval/lval").
-
+ unexpected(this_file, "generate_sub_assign: lval/lval")
+ ;
+ Left = lval(Lval0),
+ Right = ref(Var),
% Assignment from a variable to an lvalue - cannot cache
% so generate immediately.
-unify_gen__generate_sub_assign(lval(Lval0), ref(Var), Code, !CI) :-
code_info__produce_variable(Var, SourceCode, Source, !CI),
- code_info__materialize_vars_in_rval(lval(Lval0), NewLval,
- MaterializeCode, !CI),
- ( NewLval = lval(Lval) ->
- Code = tree(
- tree(SourceCode, MaterializeCode),
- node([
- assign(Lval, Source) - "Copy value"
- ])
- )
- ;
- error("unify_gen__generate_sub_assign: " ++
- "lval vanished with ref")
- ).
- % Assignment to a variable, so cache it.
-unify_gen__generate_sub_assign(ref(Var), lval(Lval), Code, !CI) :-
- ( code_info__variable_is_forward_live(!.CI, Var) ->
- code_info__assign_lval_to_var(Var, Lval, Code, !CI)
+ code_info__materialize_vars_in_lval(Lval0, Lval, MaterializeCode, !CI),
+ CopyCode = node([assign(Lval, Source) - "Copy value"]),
+ Code = tree_list([SourceCode, MaterializeCode, CopyCode])
;
- Code = empty
- ).
- % Assignment to a variable, so cache it.
-unify_gen__generate_sub_assign(ref(Lvar), ref(Rvar), empty, !CI) :-
+ Left = ref(Lvar),
( code_info__variable_is_forward_live(!.CI, Lvar) ->
- code_info__assign_var_to_var(Lvar, Rvar, !CI)
+ (
+ Right = lval(Lval),
+ % Assignment of a value to a variable, generate now.
+ code_info__assign_lval_to_var(Lvar, Lval, Code, !CI)
+ ;
+ Right = ref(Rvar),
+ % Assignment of a variable to a variable, so cache it.
+ code_info__assign_var_to_var(Lvar, Rvar, !CI),
+ Code = empty
+ )
;
- true
+ Code = empty
+ )
).
%---------------------------------------------------------------------------%
-:- pred unify_gen__var_type_msg((type)::in, string::out) is det.
+:- pred var_type_msg((type)::in, string::out) is det.
-unify_gen__var_type_msg(Type, Msg) :-
+var_type_msg(Type, Msg) :-
( type_to_ctor_and_args(Type, TypeCtor, _) ->
TypeCtor = TypeSym - TypeArity,
mdbcomp__prim_data__sym_name_to_string(TypeSym, TypeSymStr),
string__int_to_string(TypeArity, TypeArityStr),
string__append_list([TypeSymStr, "/", TypeArityStr], Msg)
;
- error("type is still a type variable in var_type_msg")
+ unexpected(this_file, "type is still a type variable in var_type_msg")
).
%---------------------------------------------------------------------------%
Index: compiler/var_locn.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/var_locn.m,v
retrieving revision 1.26
diff -u -b -r1.26 var_locn.m
--- compiler/var_locn.m 15 Aug 2005 07:18:31 -0000 1.26
+++ compiler/var_locn.m 7 Sep 2005 14:34:09 -0000
@@ -164,7 +164,7 @@
var_locn_info::in, var_locn_info::out) is det.
% assign_cell_to_var(Var, ReserveWordAtStart, Ptag, Vector, SizeInfo,
- % TypeMsg, Code, !StaticCellInfo, !VarLocnInfo):
+ % TypeMsg, Where, Code, !StaticCellInfo, !VarLocnInfo):
%
% Generates code to assign to Var a pointer, tagged by Ptag, to the cell
% whose contents are given by the other arguments, and updates the state
@@ -174,14 +174,14 @@
% to use to hold a forwarding pointer. If SizeInfo is yes(SizeVal), then
% reserve an extra word immediately before the allocated object (regardless
% of whether it is allocated statically or dynamically), and initialize
- % this word with the value determined by SizeVal.
- % NOTE: ReserveWordAtStart and SizeInfo should not both be yes / yes(_),
- % because that will cause an obvious conflict!
+ % this word with the value determined by SizeVal. (NOTE: ReserveWordAtStart
+ % and SizeInfo should not be yes / yes(_), because that will cause an
+ % obvious conflict.) Where will say where the created cell is.
%
:- pred assign_cell_to_var(prog_var::in, bool::in, tag::in,
- list(maybe(rval))::in, maybe(term_size_value)::in,
- string::in, code_tree::out, static_cell_info::in,
- static_cell_info::out, var_locn_info::in, var_locn_info::out) is det.
+ list(maybe(rval))::in, maybe(term_size_value)::in, string::in,
+ code_tree::out, static_cell_info::in, static_cell_info::out,
+ var_locn_info::in, var_locn_info::out) is det.
% place_var(Var, Lval, Code, !VarLocnInfo):
%
@@ -522,7 +522,7 @@
true
;
( map__search(!.VarStateMap, Var, _) ->
- error("init_state_2: repeated variable")
+ unexpected(this_file, "init_state_2: repeated variable")
;
set__singleton_set(NewLocs, Lval),
set__init(Using),
@@ -603,7 +603,7 @@
->
true
;
- error("clobber_lval_in_var_state_map: empty state")
+ unexpected(this_file, "clobber_lval_in_var_state_map: empty state")
).
% Try to record in VarStateMap that Var is no longer reachable through
@@ -755,7 +755,7 @@
map__det_insert(VarStateMap0, Var, State, VarStateMap),
set_var_state_map(VarStateMap, !VLI)
;
- error("set_var_state_map: supposed constant isn't")
+ unexpected(this_file, "set_var_state_map: supposed constant isn't")
).
%----------------------------------------------------------------------------%
@@ -868,9 +868,8 @@
ArgsCode, !VLI),
Code = tree(CellCode, ArgsCode).
-:- pred assign_cell_args(list(maybe(rval))::in,
- maybe(tag)::in, rval::in, int::in, code_tree::out,
- var_locn_info::in, var_locn_info::out) is det.
+:- pred assign_cell_args(list(maybe(rval))::in, maybe(tag)::in, rval::in,
+ int::in, code_tree::out, var_locn_info::in, var_locn_info::out) is det.
assign_cell_args([], _, _, _, empty, !VLI).
assign_cell_args([MaybeRval0 | MaybeRvals0], Ptag, Base, Offset, Code, !VLI) :-
@@ -894,18 +893,14 @@
add_additional_lval_for_var(Var, Target, !VLI),
get_var_name(!.VLI, Var, VarName),
Comment = "assigning from " ++ VarName,
- AssignCode = node([
- assign(Target, Rval) - Comment
- ])
+ AssignCode = node([assign(Target, Rval) - Comment])
)
; Rval0 = const(_) ->
EvalCode = empty,
Comment = "assigning field from const",
- AssignCode = node([
- assign(Target, Rval0) - Comment
- ])
+ AssignCode = node([assign(Target, Rval0) - Comment])
;
- error("assign_cell_args: unknown rval")
+ unexpected(this_file, "assign_cell_args: unknown rval")
),
ThisCode = tree(EvalCode, AssignCode)
;
@@ -963,7 +958,7 @@
( set__remove(Using0, UsingVar, Using1) ->
Using = Using1
;
- error("remove_use_refs_2: using ref not present")
+ unexpected(this_file, "remove_use_refs_2: using ref not present")
),
State = state(Lvals, MaybeConstRval, MaybeExprRval, Using, DeadOrAlive),
map__det_update(VarStateMap0, ContainedVar, State, VarStateMap),
@@ -982,7 +977,7 @@
check_and_set_magic_var_location(Var, Lval, !VLI) :-
( lval_in_use(!.VLI, Lval) ->
- error("check_and_set_magic_var_location: in use")
+ unexpected(this_file, "check_and_set_magic_var_location: in use")
;
set_magic_var_location(Var, Lval, !VLI)
).
@@ -1007,7 +1002,7 @@
( map__search(VarStateMap0, Var, _) ->
get_var_name(VLI, Var, Name),
Msg = "assign_to_var: existing definition of variable " ++ Name,
- error(Msg)
+ unexpected(this_file, Msg)
;
true
).
@@ -1113,7 +1108,7 @@
actually_place_var(Var, Target, ForbiddenLvals, Code, !VLI) :-
get_acquired(!.VLI, Acquired),
( set__member(Target, Acquired) ->
- error("actually_place_var: target is acquired reg")
+ unexpected(this_file, "actually_place_var: target is acquired reg")
;
true
),
@@ -1165,9 +1160,7 @@
( is_dummy_argument_type(Type) ->
AssignCode = empty
;
- AssignCode = node([
- assign(Target, Rval) - Msg
- ])
+ AssignCode = node([assign(Target, Rval) - Msg])
)
),
Code = tree(FreeCode, tree(EvalCode, AssignCode))
@@ -1481,10 +1474,11 @@
( map__search(VarStateMap0, Var, State0) ->
State0 = state(Lvals, MaybeConstRval, MaybeExprRval, Using,
DeadOrAlive0),
- ( DeadOrAlive0 = dead ->
+ (
+ DeadOrAlive0 = dead,
require(unify(FirstTime, no), "var_becomes_dead: already dead")
;
- true
+ DeadOrAlive0 = alive
),
( set__empty(Using) ->
map__det_remove(VarStateMap0, Var, _, VarStateMap),
@@ -1533,7 +1527,7 @@
; select_cheapest_lval(Lvals, Lval3) ->
Lval = Lval3
;
- error("select_lval: nothing to select")
+ unexpected(this_file, "select_lval: nothing to select")
).
% From the given list of lvals and maybe a constant rval, select the
@@ -1545,7 +1539,7 @@
( maybe_select_lval_or_rval(Lvals, MaybeConstRval, Rval1) ->
Rval = Rval1
;
- error("select_lval_or_rval: nothing to select")
+ unexpected(this_file, "select_lval_or_rval: nothing to select")
).
:- pred maybe_select_lval_or_rval(list(lval)::in, maybe(rval)::in,
@@ -1637,10 +1631,11 @@
(
PrefLocn = abs_reg(N),
PrefLval = reg(r, N),
- ( CheckInUse = yes ->
+ (
+ CheckInUse = yes,
\+ lval_in_use(VLI, PrefLval)
;
- true
+ CheckInUse = no
),
\+ list__member(PrefLval, Avoid)
->
@@ -1682,10 +1677,11 @@
(
PrefLocn = abs_reg(N),
PrefLval = reg(r, N),
- ( CheckInUse = yes ->
+ (
+ CheckInUse = yes,
\+ lval_in_use(VLI, PrefLval)
;
- true
+ CheckInUse = no
)
->
Lval = PrefLval
@@ -1697,10 +1693,11 @@
get_stack_slots(VLI, StackSlots),
map__search(StackSlots, Var, StackSlotLocn),
StackSlot = stack_slot_to_lval(StackSlotLocn),
- ( CheckInUse = yes ->
+ (
+ CheckInUse = yes,
\+ lval_in_use(VLI, StackSlot)
;
- true
+ CheckInUse = no
)
->
Lval = StackSlot
@@ -1787,7 +1784,7 @@
acquire_reg_require_given(Lval, !VLI) :-
( lval_in_use(!.VLI, Lval) ->
- error("acquire_reg_require_given: lval in use")
+ unexpected(this_file, "acquire_reg_require_given: lval in use")
;
true
),
@@ -1823,7 +1820,7 @@
set__delete(Acquired0, Lval, Acquired),
set_acquired(Acquired, !VLI)
;
- error("release_reg: unacquired reg")
+ unexpected(this_file, "release_reg: unacquired reg")
).
%----------------------------------------------------------------------------%
@@ -1863,7 +1860,7 @@
% Check if Rval0 is a constant rval, after substituting the values of the
% variables inside it. Returns the substituted, ground rval in Rval.
% Note that this predicate is similar to code_exprn__expr_is_constant,
- % but of courses its own version of the variable state data structure.
+ % but it uses its own version of the variable state data structure.
%
:- pred expr_is_constant(var_state_map::in, exprn_opts::in,
rval::in, rval::out) is semidet.
@@ -1954,18 +1951,16 @@
Lval = mem_ref(Rval)
;
Lval0 = field(Tag, RvalA0, RvalB0),
- materialize_vars_in_rval(RvalA0, no, Avoid, RvalA, CodeA,
- !VLI),
- materialize_vars_in_rval(RvalB0, no, Avoid, RvalB, CodeB,
- !VLI),
+ materialize_vars_in_rval(RvalA0, no, Avoid, RvalA, CodeA, !VLI),
+ materialize_vars_in_rval(RvalB0, no, Avoid, RvalB, CodeB, !VLI),
Lval = field(Tag, RvalA, RvalB),
Code = tree(CodeA, CodeB)
;
Lval0 = temp(_, _),
- error("materialize_vars_in_lval: temp")
+ unexpected(this_file, "materialize_vars_in_lval: temp")
;
Lval0 = lvar(_),
- error("materialize_vars_in_lval: lvar")
+ unexpected(this_file, "materialize_vars_in_lval: lvar")
).
% Rval is Rval0 with all variables in Rval0 replaced by their values.
@@ -1999,9 +1994,9 @@
Rval = Rval0,
Code = empty
;
- Rval0 = mem_addr(_),
- Rval = Rval0,
- Code = empty
+ Rval0 = mem_addr(MemRef0),
+ materialize_vars_in_mem_ref(MemRef0, MemRef, Avoid, Code, !VLI),
+ Rval = mem_addr(MemRef)
;
Rval0 = var(Var),
find_var_availability(!.VLI, Var, MaybePrefer, Avail),
@@ -2014,6 +2009,27 @@
)
).
+ % MemRef is MemRef0 with all variables in MemRef replaced by their values.
+ %
+:- pred materialize_vars_in_mem_ref(mem_ref::in, mem_ref::out,
+ list(lval)::in, code_tree::out,
+ var_locn_info::in, var_locn_info::out) is det.
+
+materialize_vars_in_mem_ref(MemRef0, MemRef, Avoid, Code, !VLI) :-
+ (
+ MemRef0 = stackvar_ref(_),
+ MemRef = MemRef0,
+ Code = empty
+ ;
+ MemRef0 = framevar_ref(_),
+ MemRef = MemRef0,
+ Code = empty
+ ;
+ MemRef0 = heap_ref(PtrRval0, Ptag, FieldNum),
+ materialize_vars_in_rval(PtrRval0, no, Avoid, PtrRval, Code, !VLI),
+ MemRef = heap_ref(PtrRval, Ptag, FieldNum)
+ ).
+
:- type var_avail
---> available(rval)
; needs_materialization.
@@ -2053,7 +2069,7 @@
MaybeExprRval = yes(ExprRval)
;
MaybeExprRval = no,
- error("materialize_var: no expr")
+ unexpected(this_file, "materialize_var: no expr")
),
materialize_vars_in_rval(ExprRval, MaybePrefer, Avoid, Rval0, ExprCode,
!VLI),
@@ -2121,7 +2137,7 @@
map__det_update(!.LocVarMap, Lval, Vars, !:LocVarMap)
)
;
- error("make_var_not_depend_on_root_lval: no record")
+ unexpected(this_file, "make_var_not_depend_on_root_lval: no record")
).
:- pred is_root_lval(lval::in) is semidet.
@@ -2146,7 +2162,7 @@
rval_depends_on_search_lval(lval(Lval), SearchLval) :-
lval_depends_on_search_lval(Lval, SearchLval).
rval_depends_on_search_lval(var(_Var), _SearchLval) :-
- error("rval_depends_on_search_lval: var").
+ unexpected(this_file, "rval_depends_on_search_lval: var").
rval_depends_on_search_lval(mkword(_Tag, Rval), SearchLval) :-
rval_depends_on_search_lval(Rval, SearchLval).
rval_depends_on_search_lval(const(_Const), _SearchLval) :-
@@ -2176,7 +2192,7 @@
SearchLval = specific_reg_or_stack(Lval),
Lval = framevar(Num).
lval_depends_on_search_lval(lvar(_Var), _SearchLval) :-
- error("lval_depends_on_search_lval: lvar").
+ unexpected(this_file, "lval_depends_on_search_lval: lvar").
lval_depends_on_search_lval(field(_Tag, Rval0, Rval1), SearchLval) :-
(
rval_depends_on_search_lval(Rval0, SearchLval)
cvs diff: Diffing compiler/notes
Index: compiler/notes/compiler_design.html
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/notes/compiler_design.html,v
retrieving revision 1.104
diff -u -b -r1.104 compiler_design.html
--- compiler/notes/compiler_design.html 26 Jul 2005 01:56:30 -0000 1.104
+++ compiler/notes/compiler_design.html 7 Sep 2005 10:34:53 -0000
@@ -1152,10 +1152,6 @@
<dt> code_util.m
<dd>
Some miscellaneous preds used for code generation.
- <dt> code_aux.m
- <dd>
- Some miscellaneous preds which, unlike those in
- code_util, use code_info.
<dt> continuation_info.m
<dd>
For accurate garbage collection, collects
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
Index: library/private_builtin.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/private_builtin.m,v
retrieving revision 1.140
diff -u -b -r1.140 private_builtin.m
--- library/private_builtin.m 16 Jun 2005 04:08:03 -0000 1.140
+++ library/private_builtin.m 6 Sep 2005 15:33:13 -0000
@@ -1,4 +1,6 @@
%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%---------------------------------------------------------------------------%
% Copyright (C) 1994-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
@@ -6,7 +8,7 @@
% File: private_builtin.m.
% Main authors: fjh, zs.
-% Stability: low.
+% Stability: medium.
% This file is automatically imported, as if via `use_module', into every
% module. It is intended for builtins that are just implementation details,
@@ -15,14 +17,13 @@
% Note that the builtins used for tabling and deep profiling are in separate
% modules (table_builtin.m and profiling_builtin.m).
-% This module is a private part of the Mercury implementation;
-% user modules should never explicitly import this module.
-% The interface for this module does not get included in the
-% Mercury library reference manual.
-
-% Many of the predicates defined in this module are builtin -
-% they do not have definitions because the compiler generates code
-% for them inline. Some others are implemented in the runtime.
+% This module is a private part of the Mercury implementation; user modules
+% should never explicitly import this module. The interface for this module
+% does not get included in the Mercury library reference manual.
+
+% Many of the predicates defined in this module are builtin - they do not have
+% definitions because the compiler generates code for them inline. Some others
+% are implemented in the runtime.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -60,34 +61,37 @@
:- pred builtin_compare_pred(comparison_result::uo, (pred)::in, (pred)::in)
is det.
- % These should never be called -- the compiler never
- % specializes them because the generic compare is just
- % as good as anything we could put here.
+ % These should never be called -- the compiler never specializes them
+ % because the generic compare is just as good as anything we could put
+ % here.
+ %
:- pred builtin_unify_tuple(T::in, T::in) is semidet.
:- pred builtin_compare_tuple(comparison_result::uo, T::in, T::in) is det.
- % The following pred is used for compare/3
- % on non-canonical types (types for which there is a
- % `where equality is ...' declaration).
+ % The following pred is used for compare/3 on non-canonical types
+ % (types for which there is a `where equality is ...' declaration).
+ %
:- pred builtin_compare_non_canonical_type(comparison_result::uo,
T::in, T::in) is det.
% Compare_error is used in the code generated for compare/3 preds.
+ %
:- pred compare_error is erroneous.
% The builtin < operator on ints, used in the code generated
% for compare/3 preds.
-:- pred builtin_int_lt(int, int).
-:- mode builtin_int_lt(in, in) is semidet.
+ %
+:- pred builtin_int_lt(int::in, int::in) is semidet.
% The builtin > operator on ints, used in the code generated
% for compare/3 preds.
-:- pred builtin_int_gt(int, int).
-:- mode builtin_int_gt(in, in) is semidet.
+ %
+:- pred builtin_int_gt(int::in, int::in) is semidet.
% A "typed" version of unify/2 -- i.e. one that can handle arguments
% of different types. It first unifies their types, and then if
% the types are equal it unifies the values.
+ %
:- pred typed_unify(T1, T2).
:- mode typed_unify(in, in) is semidet.
:- mode typed_unify(in, out) is semidet.
@@ -95,8 +99,8 @@
% A "typed" version of compare/3 -- i.e. one that can handle arguments
% of different types. It first compares the types, and then if the
% types are equal it compares the values.
-:- pred typed_compare(comparison_result, T1, T2).
-:- mode typed_compare(uo, in, in) is det.
+ %
+:- pred typed_compare(comparison_result::uo, T1::in, T2::in) is det.
% N.B. interface continued below.
@@ -165,12 +169,13 @@
R = (>)
).
-:- pred builtin_strcmp(int, string, string).
-:- mode builtin_strcmp(out, in, in) is det.
+:- pred builtin_strcmp(int::out, string::in, string::in) is det.
:- pragma foreign_proc("C", builtin_strcmp(Res::out, S1::in, S2::in),
[will_not_call_mercury, promise_pure, thread_safe],
- "Res = strcmp(S1, S2);").
+"
+ Res = strcmp(S1, S2);
+").
:- pragma foreign_proc("C#", builtin_strcmp(Res::out, S1::in, S2::in),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -200,7 +205,7 @@
% should handle this itself.
error("builtin_unify_tuple called")
;
- % the following is never executed
+ % The following is never executed.
semidet_succeed
).
@@ -210,7 +215,7 @@
% should handle this itself.
error("builtin_compare_tuple called")
;
- % the following is never executed
+ % The following is never executed.
Res = (<)
).
@@ -219,7 +224,7 @@
( semidet_succeed ->
error("attempted higher-order unification")
;
- % the following is never executed
+ % The following is never executed.
semidet_succeed
).
@@ -228,7 +233,7 @@
( semidet_succeed ->
error("attempted higher-order comparison")
;
- % the following is never executed
+ % The following is never executed.
Result = (<)
).
@@ -236,18 +241,14 @@
builtin_compare_non_canonical_type(Res, X, _Y) :-
% suppress determinism warning
( semidet_succeed ->
- string__append_list([
- "call to compare/3 for non-canonical type `",
- type_name(type_of(X)),
- "'"],
- Message),
+ Message = "call to compare/3 for non-canonical type `"
+ ++ type_name(type_of(X)) ++ "'",
error(Message)
;
- % the following is never executed
+ % The following is never executed.
Res = (<)
).
- % This is used by the code that the compiler generates for compare/3.
:- pragma no_inline(compare_error/0).
compare_error :-
error("internal error in compare/3").
@@ -302,46 +303,52 @@
/*, ... */).
:- type base_typeclass_info(_) ---> typeclass_info(int /*, ... */).
- % The following types are used by compiler/ml_code_util.m
- % as the types used for copying type_info/1 and typeclass_info/1
- % types. XXX Document me better
+ % The following types are used by compiler/ml_code_util.m as the types
+ % used for copying type_info/1 and typeclass_info/1 types.
+ % XXX Document me better
+ %
:- type sample_type_info ---> sample_type_info(type_info(int)).
:- type sample_typeclass_info ---> sample_typeclass_info(typeclass_info(int)).
- % type_info_from_typeclass_info(TypeClassInfo, Index, TypeInfo)
- % extracts TypeInfo from TypeClassInfo, where TypeInfo is the Indexth
+ % type_info_from_typeclass_info(TypeClassInfo, Index, TypeInfo):
+ %
+ % Extracts TypeInfo from TypeClassInfo, where TypeInfo is the Indexth
% type_info in the typeclass_info.
%
% Note: Index must be equal to the number of the desired type_info
% plus the number of superclasses for this class.
-:- pred type_info_from_typeclass_info(typeclass_info(_), int, type_info(T)).
-:- mode type_info_from_typeclass_info(in, in, out) is det.
+ %
+:- pred type_info_from_typeclass_info(typeclass_info(_)::in, int::in,
+ type_info(T)::out) is det.
% unconstrained_type_info_from_typeclass_info(TypeClassInfo,
- % Index, TypeInfo)
- % extracts the TypeInfo for the Indexth unconstrained type variable
+ % Index, TypeInfo):
+ %
+ % Extracts the TypeInfo for the Indexth unconstrained type variable
% from the instance represented by TypeClassInfo.
-:- pred unconstrained_type_info_from_typeclass_info(typeclass_info(_),
- int, type_info(_)).
-:- mode unconstrained_type_info_from_typeclass_info(in, in, out) is det.
+ %
+:- pred unconstrained_type_info_from_typeclass_info(typeclass_info(_)::in,
+ int::in, type_info(_)::out) is det.
- % superclass_from_typeclass_info(TypeClassInfo, Index, SuperClass)
- % extracts SuperClass from TypeClassInfo where SuperClass is the
+ % superclass_from_typeclass_info(TypeClassInfo, Index, SuperClass):
+ %
+ % Extracts SuperClass from TypeClassInfo where SuperClass is the
% Indexth superclass of the class.
-:- pred superclass_from_typeclass_info(typeclass_info(_),
- int, typeclass_info(_)).
-:- mode superclass_from_typeclass_info(in, in, out) is det.
+ %
+:- pred superclass_from_typeclass_info(typeclass_info(_)::in,
+ int::in, typeclass_info(_)::out) is det.
% instance_constraint_from_typeclass_info(TypeClassInfo, Index,
- % InstanceConstraintTypeClassInfo)
- % extracts the typeclass_info for the Indexth typeclass constraint
+ % InstanceConstraintTypeClassInfo):
+ %
+ % Extracts the typeclass_info for the Indexth typeclass constraint
% of the instance described by TypeClassInfo.
%
% Note: Index must be equal to the number of the desired constraint
% plus the number of unconstrained type variables for this instance.
-:- pred instance_constraint_from_typeclass_info(
- typeclass_info(_), int, typeclass_info(_)).
-:- mode instance_constraint_from_typeclass_info(in, in, out) is det.
+ %
+:- pred instance_constraint_from_typeclass_info(typeclass_info(_)::in,
+ int::in, typeclass_info(_)::out) is det.
% N.B. interface continued below.
@@ -563,8 +570,7 @@
Index::in, TypeInfo::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
- TypeInfo = MR_typeclass_info_instance_tvar_type_info(TypeClassInfo,
- Index);
+ TypeInfo = MR_typeclass_info_instance_tvar_type_info(TypeClassInfo, Index);
").
:- pragma foreign_proc("C",
@@ -598,8 +604,7 @@
Index::in, TypeInfo::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
- TypeInfo = MR_typeclass_info_instance_tvar_type_info(TypeClassInfo,
- Index);
+ TypeInfo = MR_typeclass_info_instance_tvar_type_info(TypeClassInfo, Index);
").
:- pragma foreign_proc("C#",
@@ -607,8 +612,7 @@
TypeClassInfo::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
- TypeClassInfo =
- MR_typeclass_info_superclass_info(TypeClassInfo0, Index);
+ TypeClassInfo = MR_typeclass_info_superclass_info(TypeClassInfo0, Index);
").
:- pragma foreign_proc("C#",
@@ -927,57 +931,51 @@
:- interface.
- % free_heap/1 is used internally by the compiler to implement
- % compile-time garbage collection.
- % (Note that currently compile-time garbage collection
+ % free_heap/1 is used internally by the compiler to implement compile-time
+ % garbage collection. (Note that currently compile-time garbage collection
% is not yet fully implemented.)
- % free_heap/1 explicitly deallocates a cell on the heap.
- % It works by calling GC_free(), which will put the cell
- % on the appropriate free list.
- % It can only be used when doing conservative GC,
- % since with `--gc none' or `--gc accurate',
- % allocation does not use a free list.
- % The `di' mode on the argument is overly conservative -- only
- % the top-level cell is clobbered. This is handled correctly by
- % mode_util__recompute_instmap_delta.
+ %
+ % free_heap/1 explicitly deallocates a cell on the heap. It works by
+ % calling GC_free(), which will put the cell on the appropriate free list.
+ % It can only be used when doing conservative GC, since with `--gc none'
+ % or `--gc accurate', allocation does not use a free list. The `di' mode
+ % on the argument is overly conservative -- only the top-level cell is
+ % clobbered. This is handled correctly by recompute_instmap_delta in
+ % mode_util.
:- impure pred free_heap(T::di) is det.
- % gc_trace/1 is used for accurate garbage collection in the
- % the MLDS->C backend. It takes as parameters a pointer to
- % a variable (normally on the stack) and, implicitly,
- % a type_info which describes the type of that variable.
- % It traverses the heap object(s) pointed to by that variable,
- % copying them to the new heap area, and updating the
- % variable to point to the new copy. This is done by calling
- % MR_agc_deep_copy() (from runtime/mercury_deep_copy*).
-
:- type mutvar(T) ---> mutvar(c_pointer).
% a no_tag type, i.e. the representation is just a c_pointer.
+ % gc_trace/1 is used for accurate garbage collection in the MLDS->C
+ % backend. It takes as parameters a pointer to a variable (normally on
+ % the stack) and, implicitly, a type_info which describes the type of
+ % that variable. It traverses the heap object(s) pointed to by that
+ % variable, copying them to the new heap area, and updating the variable
+ % to point to the new copy. This is done by calling MR_agc_deep_copy()
+ % (from runtime/mercury_deep_copy*).
+ %
:- impure pred gc_trace(mutvar(T)::in) is det.
- % mark_hp/1 and restore_hp/1 are used by the MLDS back-end,
- % to implement heap reclamation on failure.
- % (The LLDS back-end does not use these; instead it inserts
- % the corresponding LLDS instructions directly during code
- % generation.)
- % For documentation, see the corresponding LLDS instructions
- % in compiler/llds.m. See also compiler/notes/trailing.html.
+ % mark_hp/1 and restore_hp/1 are used by the MLDS back-end, to implement
+ % heap reclamation on failure. (The LLDS back-end does not use these;
+ % instead it inserts the corresponding LLDS instructions directly during
+ % code generation.) For documentation, see the corresponding LLDS
+ % instructions in compiler/llds.m. See also compiler/notes/trailing.html.
:- type heap_pointer.
:- impure pred mark_hp(heap_pointer::out) is det.
:- impure pred restore_hp(heap_pointer::in) is det.
- % XXX currently we don't support nondet pragma
- % foreign_code when trailing is enabled.
- % Instead we generate code which calls this procedure,
+ % XXX currently we don't support nondet foreign_procs when trailing
+ % is enabled. Instead we generate code which calls this procedure,
% which will call error/1 with an appropriate message.
+ %
:- pred reclaim_heap_nondet_pragma_foreign_code is erroneous.
- % The following is a built-in reference type.
- % It is used to define the types store.generic_ref/2,
- % store.generic_mutvar/2, std_util.mutvar/1,
+ % The following is a built-in reference type. It is used to define the
+ % types store.generic_ref/2, store.generic_mutvar/2, std_util.mutvar/1,
% benchmarking.int_ref/0, etc.
:- type ref(T).
@@ -985,12 +983,11 @@
:- implementation.
-/*
-** These routines are defined in C in ways which may make it not obvious
-** to the Mercury compiler that they are worth inlining.
-**
-** (Note: it's probably not worth inlining gc_trace/1...)
-*/
+% These routines are defined in C in ways which may make it not obvious
+% to the Mercury compiler that they are worth inlining.
+%
+% (Note: it's probably not worth inlining gc_trace/1...)
+
:- pragma inline(free_heap/1).
:- pragma inline(mark_hp/1).
:- pragma inline(restore_hp/1).
@@ -1005,8 +1002,7 @@
"
#ifdef MR_NATIVE_GC
*(MR_Word *)Pointer =
- MR_agc_deep_copy(* (MR_Word *) Pointer,
- (MR_TypeInfo) TypeInfo_for_T,
+ MR_agc_deep_copy(* (MR_Word *) Pointer, (MR_TypeInfo) TypeInfo_for_T,
MR_ENGINE(MR_eng_heap_zone2->min),
MR_ENGINE(MR_eng_heap_zone2->hardmax));
#else
@@ -1222,23 +1218,30 @@
% since for efficiency the code generator treats it as a builtin.
% With the MLDS back-end, it is defined in runtime/mercury.h.
-:- pred unsafe_type_cast(T1, T2).
-:- mode unsafe_type_cast(in, out) is det.
+:- pred unsafe_type_cast(T1::in, T2::out) is det.
+
+ % store_at_ref/2 is used internally by the compiler. Bad things
+ % will happen if this is used in programs.
+ %
+:- pred store_at_ref(c_pointer::in, T::in) is det.
% unused/0 should never be called.
% The compiler sometimes generates references to this procedure,
% but they should never get executed.
:- pred unused is det.
- % N.B. interface continued below.
-
:- pred nyi_foreign_type_unify(T::in, T::in) is semidet.
:- pred nyi_foreign_type_compare(comparison_result::uo, T::in, T::in) is det.
+ % N.B. interface continued below.
+
:- implementation.
% unsafe_type_cast is a builtin; the compiler generates inline code for it
+store_at_ref(_X, _Y) :-
+ true.
+
unused :-
( semidet_succeed ->
error("attempted use of dead predicate")
@@ -1265,12 +1268,11 @@
:- interface.
-% var/1 is intended to make it possible to write code that effectively
-% has different implementations for different modes (see type_to_univ
-% in std_util.m as an example).
-% It has to be impure to ensure that reordering doesn't cause the wrong
-% mode to be selected.
-
+ % var/1 is intended to make it possible to write code that effectively
+ % has different implementations for different modes (see type_to_univ
+ % in std_util.m as an example). It has to be impure to ensure that
+ % reordering doesn't cause the wrong mode to be selected.
+ %
:- impure pred var(T).
:- mode var(ui) is failure.
:- mode var(in) is failure.
@@ -1281,24 +1283,26 @@
:- mode nonvar(in) is det.
:- mode nonvar(unused) is failure.
-% no_clauses/1 is used to report a run-time error when there is a call
-% to a procedure for which there are no clauses, and the procedure was
-% compiled with `--allow-stubs' and is not part of the Mercury standard
-% library. (If the procedure is part of the Mercury standard library,
-% the compiler will generate a call to sorry/1 instead of no_clauses/1.)
-
+ % no_clauses/1 is used to report a run-time error when there is a call
+ % to a procedure for which there are no clauses, and the procedure was
+ % compiled with `--allow-stubs' and is not part of the Mercury standard
+ % library. (If the procedure is part of the Mercury standard library,
+ % the compiler will generate a call to sorry/1 instead of no_clauses/1.)
+ %
:- pred no_clauses(string::in) is erroneous.
-% sorry/1 is used to apologize about the fact that we have not implemented
-% some predicate or function in the Mercury standard library for a given
-% back end. The argument should give the name of the predicate or function.
-
+ % sorry/1 is used to apologize about the fact that we have not implemented
+ % some predicate or function in the Mercury standard library for a given
+ % back end. The argument should give the name of the predicate or function.
+ %
:- pred sorry(string::in) is erroneous.
-% imp/0 is used to make pure predicates impure.
+ % imp/0 is used to make pure predicates impure.
+ %
:- impure pred imp is det.
-% semip/0 is used to make pure predicates semipure.
+ % semip/0 is used to make pure predicates semipure.
+ %
:- semipure pred semip is det.
%-----------------------------------------------------------------------------%
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
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