[m-rev.] for possible review: misc MLDS code generator cleanups
Zoltan Somogyi
zs at csse.unimelb.edu.au
Wed Aug 19 20:06:02 AEST 2009
This diff makes no algorithmic changes, so while a review may be useful,
it is not strictly needed.
Zoltan.
Some cleanups of the MLDS code generator.
compiler/mlds.m:
Make some functors and field names less ambiguous.
Don't pass around big data structures such as ModuleInfos when we need
only small parts of them.
Put the argument lists of some predicates into a more logical order,
with more static things coming first.
compiler/ml_code_util.m:
Add a couple of fields to the ml_gen_info structure to hold information
that the MLDS backend needs often but used to have to get relatively
slowsly by looking it in the globals: the compilation target and the
value of the --high-level-data option.
Provide more useful access predicates to some of the counters,
and make them harder to confuse by using fewer type synonyms.
Give some other access predicates more meaningful names.
Give some other predicates less ambigious names.
Access all fields of ml_gen_info via access predicates, not via field
notation, so that the number of accesses to each field can be measured
by deep profiling.
Separate the ml_gen_info structure into a main structure whose fields
are frequently updated and which fits into an 8-word block of memory,
and a substructure whose fields are read-only or rarely updated.
This should help improve memory performance.
compiler/ml_unify_gen.m:
Divide ml_gen_new_object, a predicate that used to be 220 lines long,
into several pieces, one for each different method of constructing new
objects (memory cells).
Put the argument lists of several predicates into a more logical order,
with related arguments being together.
Conform to the changes above.
Add some XXXs at spots that seem incorrect.
compiler/ml_code_gen.m:
Give some predicates more meaningful names.
Conform to the changes above.
compiler/ml_call_gen.m:
Replace some higher order calls with direct calls.
Conform to the changes above.
compiler/ml_type_gen.m:
Put the argument lists of several predicates into a more logical order,
with related arguments being together.
Don't pass around big data structures such as ModuleInfos when we need
only small parts of them.
Conform to the changes above.
compiler/ml_closure_gen.m:
compiler/ml_elim_nested.m:
compiler/ml_string_switch.m:
compiler/ml_tag_switch.m:
compiler/mlds_to_c.m:
compiler/mlds_to_gcc.m:
Conform to the changes above.
compiler/hlds_goal.m:
Fix programming style.
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/libatomic_ops-1.2
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing boehm_gc/windows-untested
cvs diff: Diffing boehm_gc/windows-untested/vc60
cvs diff: Diffing boehm_gc/windows-untested/vc70
cvs diff: Diffing boehm_gc/windows-untested/vc71
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.208
diff -u -b -r1.208 hlds_goal.m
--- compiler/hlds_goal.m 16 Jul 2009 07:27:12 -0000 1.208
+++ compiler/hlds_goal.m 18 Aug 2009 17:10:47 -0000
@@ -650,29 +650,33 @@
---> rhs_var(prog_var)
; rhs_functor(
rhs_functor :: cons_id,
+ % The `is_existential_construction' field is only used
+ % after polymorphism.m strips off the `new ' prefix from
+ % existentially typed constructions.
rhs_is_exist_constr :: is_existential_construction,
- % The `is_existential_construction' field
- % is only used after polymorphism.m strips
- % off the `new ' prefix from existentially
- % typed constructions.
rhs_args :: list(prog_var)
)
; rhs_lambda_goal(
rhs_purity :: purity,
+
+ % Whether this closure is `ground' or `any'.
rhs_groundness :: ho_groundness,
- % Whether this closure is `ground' or
- % `any'.
+
rhs_p_or_f :: pred_or_func,
+
+ % Currently, we don't support any other value than `normal'.
rhs_eval_method :: lambda_eval_method,
- % Currently, we don't support any other
- % value than `normal'.
+
+ % Non-locals of the goal excluding the lambda quantified
+ % variables.
rhs_nonlocals :: list(prog_var),
- % Non-locals of the goal excluding
- % the lambda quantified variables.
- rhs_lambda_quant_vars :: list(prog_var),
+
% Lambda quantified variables.
- rhs_lambda_modes :: list(mer_mode),
+ rhs_lambda_quant_vars :: list(prog_var),
+
% Modes of the lambda quantified variables.
+ rhs_lambda_modes :: list(mer_mode),
+
rhs_detism :: determinism,
rhs_lambda_goal :: hlds_goal
).
@@ -716,42 +720,31 @@
% e.g. Y = f(X) where the top node of Y is output,
% Constructions are written using `:=', e.g. Y := f(X).
+ % The variable being constructed, e.g. Y in above example.
construct_cell_var :: prog_var,
- % The variable being constructed,
- % e.g. Y in above example.
+ % The cons_id of the functor f/1 in the above example.
construct_cons_id :: cons_id,
- % The cons_id of the functor
- % f/1 in the above example.
+ % The list of argument variables; [X] in the above example.
+ % For a unification with a lambda expression, this is the list
+ % of the non-local variables of the lambda expression.
construct_args :: list(prog_var),
- % The list of argument variables
- % [X] in the above example
- % For a unification with a lambda
- % expression, this is the list of
- % the non-local variables of the
- % lambda expression.
+ % The list of modes of the arguments sub-unifications.
+ % For a unification with a lambda expression, this is the list
+ % of modes of the non-local variables of the lambda expression.
construct_arg_modes :: list(uni_mode),
- % The list of modes of the arguments
- % sub-unifications.
- % For a unification with a lambda
- % expression, this is the list of
- % modes of the non-local variables
- % of the lambda expression.
+ % Specify whether to allocate statically, to allocate
+ % dynamically (and if so, on the heap or in a region),
+ % or to reuse an existing cell (and if so, which cell).
+ % Constructions for which this field is `reuse_cell(_)'
+ % are described as "reconstructions".
construct_how :: how_to_construct,
- % Specify whether to allocate
- % statically, to allocate dynamically,
- % or to reuse an existing cell
- % (and if so, which cell).
- % Constructions for which this
- % field is `reuse_cell(_)' are
- % described as "reconstructions".
+ % Can the cell be allocated in shared data.
construct_is_unique :: cell_is_unique,
- % Can the cell be allocated
- % in shared data.
construct_sub_info :: construct_sub_info
)
@@ -764,30 +757,24 @@
% Note that deconstruction of lambda expressions is
% a mode error.
+ % The variable being deconstructed, e.g. Y in the example.
deconstruct_cell_var :: prog_var,
- % The variable being deconstructed
- % e.g. Y in the above example.
+ % The cons_id of the functor, e.g. f/1 in the example.
deconstruct_cons_id :: cons_id,
- % The cons_id of the functor,
- % e.g. f/1 in the above example
+ % The list of argument variables, e.g. [X] in the example.
deconstruct_args :: list(prog_var),
- % The list of argument variables,
- % e.g. [X] in the above example.
+ % The lists of modes of the argument sub-unifications.
deconstruct_arg_modes :: list(uni_mode),
- % The lists of modes of the argument
- % sub-unifications.
+ % Whether or not the unification could possibly fail.
deconstruct_can_fail :: can_fail,
- % Whether or not the unification
- % could possibly fail.
- deconstruct_can_cgc :: can_cgc
- % Can compile time GC this cell,
- % i.e. explicitly deallocate it
+ % Can compile time GC this cell, i.e. explicitly deallocate it
% after the deconstruction.
+ deconstruct_can_cgc :: can_cgc
)
; assign(
@@ -800,7 +787,7 @@
; simple_test(
% Y = X where the type of X and Y is an atomic type and
% they are both input, written Y == X.
- %
+
test_var1 :: prog_var,
test_var2 :: prog_var
)
@@ -812,12 +799,11 @@
% out-of-line call to a compiler generated unification
% predicate for that type & mode.
- compl_unify_mode :: uni_mode,
% The mode of the unification.
+ compl_unify_mode :: uni_mode,
+ % Whether or not it could possibly fail.
compl_unify_can_fail :: can_fail,
- % Whether or not it could possibly
- % fail.
% When unifying polymorphic types such as map/2, we need to
% pass type_info variables to the unification procedure for
@@ -831,10 +817,9 @@
% It is also checked by simplify.m when it converts
% complicated unifications into procedure calls.
+ % The type_info variables needed by this unification,
+ % if it ends up being a complicated unify.
compl_unify_typeinfos :: list(prog_var)
- % The type_info variables needed
- % by this unification, if it ends up
- % being a complicated unify.
).
:- type term_size_value
Index: compiler/ml_call_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_call_gen.m,v
retrieving revision 1.84
diff -u -b -r1.84 ml_call_gen.m
--- compiler/ml_call_gen.m 10 Jun 2009 06:26:19 -0000 1.84
+++ compiler/ml_call_gen.m 18 Aug 2009 20:26:32 -0000
@@ -247,7 +247,8 @@
% since GNU C (2.95.2) ignores the function attributes on function
% pointer types in casts.
%
- ml_gen_info_new_conv_var(ConvVarNum, !Info),
+ ml_gen_info_new_conv_var(ConvVarSeq, !Info),
+ ConvVarSeq = conv_seq(ConvVarNum),
FuncVarName = mlds_var_name(string.format("func_%d", [i(ConvVarNum)]), no),
% The function address is always a pointer to code,
% not to the heap, so the GC doesn't need to trace it.
@@ -268,23 +269,27 @@
InputRvals, OutputLvals, OutputTypes,
ConvArgDecls, ConvOutputStatements, !Info),
ClosureRval = ml_unop(unbox(ClosureArgType), ml_lval(ClosureLval)),
-
- % Prepare to generate the call, passing the closure as the first argument.
- % (We can't actually generate the call yet, since it might be nondet,
- % and we don't yet know what its success continuation will be; instead
- % for now we just construct a higher-order term `DoGenCall', which when
- % called will generate it.)
ObjectRval = no,
- DoGenCall = ml_gen_mlds_call(Signature, ObjectRval, FuncVarRval,
- [ClosureRval | InputRvals], OutputLvals, OutputTypes,
- Determinism, Context),
(
ConvArgDecls = [],
ConvOutputStatements = []
->
- DoGenCall(Decls0, Statements0, !Info)
+ % Generate the call directly (as opposed to via DoGenCall)
+ % in the common case.
+ ml_gen_mlds_call(Signature, ObjectRval, FuncVarRval,
+ [ClosureRval | InputRvals], OutputLvals, OutputTypes,
+ Determinism, Context, Decls0, Statements0, !Info)
;
+ % Prepare to generate the call, passing the closure as the first
+ % argument. We can't actually generate the call yet, since it might be
+ % nondet, and we don't yet know what its success continuation will be.
+ % Instead we construct a higher-order term `DoGenCall', which, when
+ % called by ml_combine_conj, will generate it.
+ DoGenCall = ml_gen_mlds_call(Signature, ObjectRval, FuncVarRval,
+ [ClosureRval | InputRvals], OutputLvals, OutputTypes,
+ Determinism, Context),
+
% Construct a closure to generate code to convert the output arguments
% and then succeed.
DoGenConvOutputAndSucceed = (
@@ -389,21 +394,27 @@
InputRvals, OutputLvals, OutputTypes,
ConvArgDecls, ConvOutputStatements, !Info),
- % Construct a closure to generate the call (We can't actually generate
- % the call yet, since it might be nondet, and we don't yet know what its
- % success continuation will be; that's why for now we just construct
- % a closure `DoGenCall' to generate it.)
ObjectRval = no,
proc_info_interface_determinism(ProcInfo, Detism),
- DoGenCall = ml_gen_mlds_call(Signature, ObjectRval, FuncRval,
- InputRvals, OutputLvals, OutputTypes, Detism, Context),
(
ConvArgDecls = [],
ConvOutputStatements = []
->
- DoGenCall(Decls, Statements, !Info)
- ;
+ % Generate the call directly (as opposed to via DoGenCall)
+ % in the common case.
+ ml_gen_mlds_call(Signature, ObjectRval, FuncRval,
+ InputRvals, OutputLvals, OutputTypes, Detism, Context,
+ Decls, Statements, !Info)
+ ;
+ % Construct a closure to generate the call. We can't actually generate
+ % the call yet, since it might be nondet, and we don't yet know
+ % what its success continuation will be. That is why we construct
+ % a closure `DoGenCall', which, when called by ml_combine_conj, will
+ % generate it.
+ DoGenCall = ml_gen_mlds_call(Signature, ObjectRval, FuncRval,
+ InputRvals, OutputLvals, OutputTypes, Detism, Context),
+
% Construct a closure to generate code to convert the output arguments
% and then succeed.
DoGenConvOutputAndSucceed = (
@@ -835,11 +846,12 @@
% temporary variable declaration, but the CallerType is
% used to construct the type_info.
- ml_gen_info_new_conv_var(ConvVarNum, !Info),
+ ml_gen_info_new_conv_var(ConvVarSeq, !Info),
VarName = mlds_var_name(VarNameStr, MaybeNum),
- ArgVarName = mlds_var_name(
- string.format("conv%d_%s", [i(ConvVarNum), s(VarNameStr)]),
- MaybeNum),
+ ConvVarSeq = conv_seq(ConvVarNum),
+ string.format("conv%d_%s", [i(ConvVarNum), s(VarNameStr)],
+ ConvVarName),
+ ArgVarName = mlds_var_name(ConvVarName, MaybeNum),
ml_gen_type(!.Info, CalleeType, MLDS_CalleeType),
(
ForClosureWrapper = yes,
@@ -854,7 +866,7 @@
)
;
ForClosureWrapper = no,
- ml_gen_gc_statement(ArgVarName, CalleeType, CallerType,
+ ml_gen_gc_statement_poly(ArgVarName, CalleeType, CallerType,
Context, GC_Statements, !Info),
ArgVarDecl = ml_gen_mlds_var_decl(mlds_data_var(ArgVarName),
MLDS_CalleeType, GC_Statements, mlds_make_context(Context))
Index: compiler/ml_closure_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_closure_gen.m,v
retrieving revision 1.61
diff -u -b -r1.61 ml_closure_gen.m
--- compiler/ml_closure_gen.m 11 Jun 2009 07:00:13 -0000 1.61
+++ compiler/ml_closure_gen.m 18 Aug 2009 17:10:47 -0000
@@ -165,9 +165,10 @@
MaybeSecondaryTag = no,
% Generate a `new_object' statement (or static constant) for the closure.
- ml_gen_new_object(MaybeConsId, PrimaryTag, MaybeSecondaryTag,
- MaybeConsName, Var, ExtraArgRvals, ExtraArgTypes, ArgVars,
- ArgModes, [], HowToConstruct, Context, Decls0, Statements, !Info),
+ ml_gen_new_object(MaybeConsId, MaybeConsName,
+ PrimaryTag, MaybeSecondaryTag, Var, ExtraArgRvals, ExtraArgTypes,
+ ArgVars, ArgModes, [], HowToConstruct, Context, Decls0, Statements,
+ !Info),
Decls1 = ClosureLayoutDecls ++ Decls0,
% We sometimes generates two definitions of the same RTTI constant
% in ml_gen_closure_layout (e.g. two definitions of the same
@@ -198,7 +199,7 @@
ml_stack_layout_construct_closure_args(ModuleInfo, ClosureArgs,
InitClosureArgs, ClosureArgTypes, ClosureArgDefns),
ml_gen_info_new_const(TvarVectorSeqNum, !Info),
- ml_format_static_const_name(!.Info, "typevar_vector", TvarVectorSeqNum,
+ ml_format_static_const_var_name(!.Info, "typevar_vector", TvarVectorSeqNum,
TvarVectorName),
ml_stack_layout_construct_tvar_vector(ModuleInfo, TvarVectorName,
Context, TVarLocnMap, TVarVectorRval, TVarVectorType, TVarDefns),
@@ -207,21 +208,22 @@
_ArgTypes = [ProcIdType, TVarVectorType | ClosureArgTypes],
ml_gen_info_new_const(LayoutSeqNum, !Info),
- ml_format_static_const_name(!.Info, "closure_layout", LayoutSeqNum, Name),
+ ml_format_static_const_var_name(!.Info, "closure_layout", LayoutSeqNum,
+ ClosureName),
Access = acc_local,
Initializer = init_array(Inits),
% XXX There's no way in C to properly represent this type,
% since it is a struct that ends with a variable-length array.
% For now we just treat the whole struct as an array.
ClosureLayoutType = mlds_array_type(mlds_generic_type),
- ClosureLayoutDefn = ml_gen_static_const_defn(Name, ClosureLayoutType,
- Access, Initializer, Context),
+ ClosureLayoutDefn = ml_gen_static_const_defn(ClosureName,
+ ClosureLayoutType, Access, Initializer, Context),
ClosureLayoutDefns = ClosureProcIdDefns ++ TVarDefns ++
ClosureArgDefns ++ [ClosureLayoutDefn],
module_info_get_name(ModuleInfo, ModuleName),
MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
- ClosureLayoutRval = ml_lval(
- ml_var(qual(MLDS_ModuleName, module_qual, Name), ClosureLayoutType)).
+ ClosureVar = qual(MLDS_ModuleName, module_qual, ClosureName),
+ ClosureLayoutRval = ml_lval(ml_var(ClosureVar, ClosureLayoutType)).
:- pred ml_gen_closure_proc_id(module_info::in, prog_context::in,
mlds_initializer::out, mlds_type::out, list(mlds_defn)::out) is det.
@@ -968,8 +970,8 @@
ClosureKind = special_pred_closure,
unexpected(this_file, "gen_closure_gc_statement: special_pred_closure")
),
- ml_gen_gc_statement(ClosureName, ClosureDeclType,
- ClosureActualType, Context, ClosureGCStatement, !Info).
+ ml_gen_gc_statement_poly(ClosureName, ClosureDeclType, ClosureActualType,
+ Context, ClosureGCStatement, !Info).
:- pred ml_gen_wrapper_func(ml_label_func::in, mlds_func_params::in,
prog_context::in, statement::in, mlds_defn::out,
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.218
diff -u -b -r1.218 ml_code_gen.m
--- compiler/ml_code_gen.m 15 Jun 2009 06:52:43 -0000 1.218
+++ compiler/ml_code_gen.m 18 Aug 2009 20:24:49 -0000
@@ -739,8 +739,8 @@
list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
- % ml_gen_wrap_goal(OuterCodeModel, InnerCodeModel, Context,
- % Statements0, Statements):
+ % ml_gen_maybe_convert_goal_code_model(OuterCodeModel, InnerCodeModel,
+ % Context, Statements0, Statements, !Info):
%
% OuterCodeModel is the code model expected by the context in which a goal
% is called. InnerCodeModel is the code model which the goal actually has.
@@ -748,8 +748,8 @@
% InnerCodeModel into code that uses the calling convention appropriate
% for OuterCodeModel.
%
-:- pred ml_gen_wrap_goal(code_model::in, code_model::in, prog_context::in,
- list(statement)::in, list(statement)::out,
+:- pred ml_gen_maybe_convert_goal_code_model(code_model::in, code_model::in,
+ prog_context::in, list(statement)::in, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
% Generate declarations for a list of local variables.
@@ -1419,7 +1419,7 @@
Statement = ml_gen_block(Decls, Statements, Context),
FunctionBody = body_defined_here(Statement)
),
- ml_gen_info_get_env_vars(!.Info, EnvVarNames)
+ ml_gen_info_get_env_var_names(!.Info, EnvVarNames)
),
pred_info_get_attributes(PredInfo, Attributes),
@@ -1727,7 +1727,7 @@
% Add whatever wrapper is needed to convert the goal's code model
% to the desired code model.
- ml_gen_wrap_goal(CodeModel, GoalCodeModel, Context,
+ ml_gen_maybe_convert_goal_code_model(CodeModel, GoalCodeModel, Context,
GoalStatements0, GoalStatements, !Info),
ml_join_decls(VarDecls, [], GoalDecls, GoalStatements, Context,
@@ -1764,41 +1764,59 @@
set.union(UnionOfSubGoalLocals0, SubGoalLocals, UnionOfSubGoalLocals).
% If the inner and outer code models are equal, we don't need to do
- % anything special.
-
-ml_gen_wrap_goal(model_det, model_det, _, !Statements, !Info).
-ml_gen_wrap_goal(model_semi, model_semi, _, !Statements, !Info).
-ml_gen_wrap_goal(model_non, model_non, _, !Statements, !Info).
-
+ % anything.
+ %
+ % If the inner code model is less precise than the outer code model,
+ % then that is either a determinism error, or a situation in which
+ % simplify.m is supposed to wrap the goal inside a `some' to indicate that
+ % a commit is needed.
+ %
% If the inner code model is more precise than the outer code model,
% then we need to append some statements to convert the calling convention
% for the inner code model to that of the outer code model.
-ml_gen_wrap_goal(model_semi, model_det, Context, !Statements, !Info) :-
- %
+ml_gen_maybe_convert_goal_code_model(model_det, model_det, _,
+ !Statements, !Info).
+ml_gen_maybe_convert_goal_code_model(model_semi, model_semi, _,
+ !Statements, !Info).
+ml_gen_maybe_convert_goal_code_model(model_non, model_non, _,
+ !Statements, !Info).
+
+ml_gen_maybe_convert_goal_code_model(model_det, model_semi, _, _, _, !Info) :-
+ unexpected(this_file,
+ "ml_gen_maybe_convert_goal_code_model: semi in det").
+ml_gen_maybe_convert_goal_code_model(model_det, model_non, _, _, _, !Info) :-
+ unexpected(this_file,
+ "ml_gen_maybe_convert_goal_code_model: nondet in det").
+ml_gen_maybe_convert_goal_code_model(model_semi, model_non, _, _, _, !Info) :-
+ unexpected(this_file,
+ "ml_gen_maybe_convert_goal_code_model: nondet in semi").
+
+ml_gen_maybe_convert_goal_code_model(model_semi, model_det, Context,
+ !Statements, !Info) :-
% det goal in semidet context:
% <succeeded = Goal>
% ===>
% <do Goal>
% succeeded = MR_TRUE
- %
+
ml_gen_set_success(!.Info, ml_const(mlconst_true), Context,
SetSuccessTrue),
!:Statements = !.Statements ++ [SetSuccessTrue].
-ml_gen_wrap_goal(model_non, model_det, Context, !Statements, !Info) :-
- %
+ml_gen_maybe_convert_goal_code_model(model_non, model_det, Context,
+ !Statements, !Info) :-
% det goal in nondet context:
% <Goal && SUCCEED()>
% ===>
% <do Goal>
% SUCCEED()
- %
+
ml_gen_call_current_success_cont(Context, CallCont, !Info),
!:Statements = !.Statements ++ [CallCont].
-ml_gen_wrap_goal(model_non, model_semi, Context, !Statements, !Info) :-
- %
+ml_gen_maybe_convert_goal_code_model(model_non, model_semi, Context,
+ !Statements, !Info) :-
% semi goal in nondet context:
% <Goal && SUCCEED()>
% ===>
@@ -1806,27 +1824,13 @@
%
% <succeeded = Goal>
% if (succeeded) SUCCEED()
- %
+
ml_gen_test_success(!.Info, Succeeded),
ml_gen_call_current_success_cont(Context, CallCont, !Info),
IfStmt = ml_stmt_if_then_else(Succeeded, CallCont, no),
IfStatement = statement(IfStmt, mlds_make_context(Context)),
!:Statements = !.Statements ++ [IfStatement].
- % If the inner code model is less precise than the outer code model,
- % then simplify.m is supposed to wrap the goal inside a `some'
- % to indicate that a commit is needed.
-
-ml_gen_wrap_goal(model_det, model_semi, _, _, _, !Info) :-
- unexpected(this_file,
- "ml_gen_wrap_goal: code model mismatch -- semi in det").
-ml_gen_wrap_goal(model_det, model_non, _, _, _, !Info) :-
- unexpected(this_file,
- "ml_gen_wrap_goal: code model mismatch -- nondet in det").
-ml_gen_wrap_goal(model_semi, model_non, _, _, _, !Info) :-
- unexpected(this_file,
- "ml_gen_wrap_goal: code model mismatch -- nondet in semi").
-
% Generate code for a commit.
%
:- pred ml_gen_commit(hlds_goal::in, code_model::in, prog_context::in,
@@ -1887,9 +1891,7 @@
!Info),
% push nesting level
MLDS_Context = mlds_make_context(Context),
- ml_gen_info_new_commit_label(CommitLabelNum, !Info),
- CommitRef = mlds_var_name(string.format("commit_%d",
- [i(CommitLabelNum)]), no),
+ ml_gen_info_new_aux_var_name("commit", CommitRef, !Info),
ml_gen_var_lval(!.Info, CommitRef, mlds_commit_type, CommitRefLval),
CommitRefDecl = ml_gen_commit_var_decl(MLDS_Context, CommitRef),
DoCommitStmt = ml_stmt_do_commit(ml_lval(CommitRefLval)),
@@ -1967,9 +1969,7 @@
!Info),
% push nesting level
MLDS_Context = mlds_make_context(Context),
- ml_gen_info_new_commit_label(CommitLabelNum, !Info),
- CommitRef = mlds_var_name(
- string.format("commit_%d", [i(CommitLabelNum)]), no),
+ ml_gen_info_new_aux_var_name("commit", CommitRef, !Info),
ml_gen_var_lval(!.Info, CommitRef, mlds_commit_type, CommitRefLval),
CommitRefDecl = ml_gen_commit_var_decl(MLDS_Context, CommitRef),
DoCommitStmt = ml_stmt_do_commit(ml_lval(CommitRefLval)),
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.138
diff -u -b -r1.138 ml_code_util.m
--- compiler/ml_code_util.m 11 Jun 2009 07:00:13 -0000 1.138
+++ compiler/ml_code_util.m 19 Aug 2009 08:59:57 -0000
@@ -28,6 +28,7 @@
:- import_module parse_tree.prog_data.
:- import_module bool.
+:- import_module counter.
:- import_module list.
:- import_module map.
:- import_module maybe.
@@ -35,7 +36,7 @@
%-----------------------------------------------------------------------------%
%
-% Various utility routines used for MLDS code generation
+% Various utility routines used for MLDS code generation.
%
% Generate an MLDS assignment statement.
@@ -109,7 +110,7 @@
%-----------------------------------------------------------------------------%
%
-% Routines for generating expressions
+% Routines for generating expressions.
%
% conjunction: ml_gen_and(X,Y) = binop((and), X, Y),
@@ -122,7 +123,7 @@
%-----------------------------------------------------------------------------%
%
-% Routines for generating types
+% Routines for generating types.
%
% Convert a Mercury type to an MLDS type.
@@ -184,7 +185,7 @@
%-----------------------------------------------------------------------------%
%
-% Routines for generating labels and entity names
+% Routines for generating labels and entity names.
%
% Generate the mlds_entity_name and module name for the entry point
@@ -223,7 +224,7 @@
%-----------------------------------------------------------------------------%
%
-% Routines for dealing with variables
+% Routines for dealing with variables.
%
% Generate a list of the mlds_lvals corresponding to a given list
@@ -297,7 +298,7 @@
%-----------------------------------------------------------------------------%
%
-% Routines for dealing with static constants
+% Routines for dealing with static constants.
%
% ml_format_reserved_object_name(CtorName, CtorArity, ReservedObjName):
@@ -308,10 +309,10 @@
%
:- func ml_format_reserved_object_name(string, arity) = mlds_var_name.
- % Generate a name for a local static constant.
+ % Generate an mlds_var_name for a local static constant.
%
-:- pred ml_format_static_const_name(ml_gen_info::in, string::in, const_seq::in,
- mlds_var_name::out) is det.
+:- pred ml_format_static_const_var_name(ml_gen_info::in, string::in,
+ const_seq::in, mlds_var_name::out) is det.
% Generate a definition of a static constant, given the constant's name,
% type, accessibility, and initializer.
@@ -330,7 +331,7 @@
%-----------------------------------------------------------------------------%
%
-% Routines for dealing with fields
+% Routines for dealing with fields.
%
% Given the user-specified field name, if any, and the argument number
@@ -343,11 +344,11 @@
% are not word-sized, because the code for `arg' etc. in std_util.m
% relies on all arguments being word-sized.
%
-:- pred ml_must_box_field_type(mer_type::in, module_info::in) is semidet.
+:- pred ml_must_box_field_type(module_info::in, mer_type::in) is semidet.
%-----------------------------------------------------------------------------%
%
-% Routines for handling success and failure
+% Routines for handling success and failure.
%
% Generate code to succeed in the given code_model.
@@ -437,7 +438,7 @@
%-----------------------------------------------------------------------------%
%
-% Routines for dealing with the environment pointer used for nested functions
+% Routines for dealing with the environment pointer used for nested functions.
%
% Return an rval for a pointer to the current environment (the set of local
@@ -455,7 +456,7 @@
%-----------------------------------------------------------------------------%
%
-% Code to handle accurate GC
+% Code to handle accurate GC.
%
% ml_gen_gc_statement(Var, Type, Context, Code):
@@ -468,9 +469,9 @@
prog_context::in, mlds_gc_statement::out,
ml_gen_info::in, ml_gen_info::out) is det.
- % ml_gen_gc_statement(Var, DeclType, ActualType, Context, Code):
+ % ml_gen_gc_statement_poly(Var, DeclType, ActualType, Context, Code):
%
- % This is the same as the //4 version (above), except that it takes two
+ % This is the same as ml_gen_gc_statement, except that it takes two
% type arguments, rather than one. The first (DeclType) is the type that
% the variable was declared with, while the second (ActualType) is that
% type that the variable is known to have. This is used to generate GC
@@ -486,15 +487,15 @@
% doesn't (e.g. because DeclType may be a boxed float). So we need to pass
% both.
%
-:- pred ml_gen_gc_statement(mlds_var_name::in,
+:- pred ml_gen_gc_statement_poly(mlds_var_name::in,
mer_type::in, mer_type::in, prog_context::in,
mlds_gc_statement::out, ml_gen_info::in, ml_gen_info::out) is det.
% ml_gen_gc_statement_with_typeinfo(Var, DeclType, TypeInfoRval,
% Context, Code):
%
- % This is the same as ml_gen_gc_statement//5, except that rather
- % than passing ActualType, the caller constructs the type-info itself,
+ % This is the same as ml_gen_gc_statement_poly, except that rather
+ % than passing ActualType, the caller constructs the typeinfo itself,
% and just passes the rval for it to this routine.
%
% This is used by ml_closure_gen.m to generate GC tracing code
@@ -527,7 +528,7 @@
%-----------------------------------------------------------------------------%
%
-% Miscellaneous routines
+% Miscellaneous routines.
%
% Get the value of the appropriate --det-copy-out or --nondet-copy-out
@@ -560,7 +561,8 @@
:- func ml_gen_info_init(module_info, pred_id, proc_id) = ml_gen_info.
:- pred ml_gen_info_get_module_info(ml_gen_info::in, module_info::out) is det.
-:- pred ml_gen_info_get_module_name(ml_gen_info::in, mercury_module_name::out)
+:- pred ml_gen_info_get_high_level_data(ml_gen_info::in, bool::out) is det.
+:- pred ml_gen_info_get_target(ml_gen_info::in, compilation_target::out)
is det.
:- pred ml_gen_info_get_pred_id(ml_gen_info::in, pred_id::out) is det.
:- pred ml_gen_info_get_proc_id(ml_gen_info::in, proc_id::out) is det.
@@ -577,6 +579,9 @@
:- pred ml_gen_info_set_value_output_vars(list(prog_var)::in,
ml_gen_info::in, ml_gen_info::out) is det.
+:- pred ml_gen_info_get_module_name(ml_gen_info::in, mercury_module_name::out)
+ is det.
+
% Lookup the --gcc-nested-functions option.
%
:- pred ml_gen_info_use_gcc_nested_functions(ml_gen_info::in, bool::out)
@@ -613,18 +618,19 @@
%
:- pred ml_gen_info_bump_counters(ml_gen_info::in, ml_gen_info::out) is det.
- % Generate a new commit label number. This is used to give unique names
- % to the labels used when generating code for commits.
+ % Generate a new auxiliary variable name. The name of the variable
+ % will start with the given prefix and end with a sequence number
+ % that differentiates this aux var from all others.
+ %
+ % Auxiliary variables are used for purposes such as commit label numbers
+ % and holding table indexes in switches.
%
-:- type commit_sequence_num == int.
-:- pred ml_gen_info_new_commit_label(commit_sequence_num::out,
+:- pred ml_gen_info_new_aux_var_name(string::in, mlds_var_name::out,
ml_gen_info::in, ml_gen_info::out) is det.
- % Generate a new `cond' variable number. This is used to give unique names
- % to the local variables used to hold the results of nondet conditions
- % of if-then-elses.
+ % Generate a new `cond' variable number.
%
-:- type cond_seq == int.
+:- type cond_seq ---> cond_seq(int).
:- pred ml_gen_info_new_cond_var(cond_seq::out,
ml_gen_info::in, ml_gen_info::out) is det.
@@ -632,7 +638,7 @@
% to the local variables generated by ml_gen_box_or_unbox_lval, which are
% used to handle boxing/unboxing argument conversions.
%
-:- type conv_seq == int.
+:- type conv_seq ---> conv_seq(int).
:- pred ml_gen_info_new_conv_var(conv_seq::out,
ml_gen_info::in, ml_gen_info::out) is det.
@@ -640,9 +646,12 @@
% to the local constants generated for --static-ground-terms, closure
% layouts, string switch hash tables, etc.
%
-:- type const_seq == int.
+:- type const_seq ---> const_seq(int).
:- pred ml_gen_info_new_const(const_seq::out,
ml_gen_info::in, ml_gen_info::out) is det.
+:- pred ml_gen_info_get_const_counter(ml_gen_info::in, counter::out) is det.
+:- pred ml_gen_info_set_const_counter(counter::in,
+ ml_gen_info::in, ml_gen_info::out) is det.
% Set the `const' variable name corresponding to the given HLDS variable.
%
@@ -735,7 +744,8 @@
% Get the names of the used environment variables.
%
-:- pred ml_gen_info_get_env_vars(ml_gen_info::in, set(string)::out) is det.
+:- pred ml_gen_info_get_env_var_names(ml_gen_info::in, set(string)::out)
+ is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -770,7 +780,7 @@
%-----------------------------------------------------------------------------%
%
-% Code for various utility routines
+% Code for various utility routines.
%
ml_gen_assign(Lval, Rval, Context) = Statement :-
@@ -1037,7 +1054,7 @@
HeadModes, PredOrFunc, CodeModel).
ml_gen_proc_params(PredId, ProcId, FuncParams, !Info) :-
- ModuleInfo = !.Info ^ mgi_module_info,
+ ml_gen_info_get_module_info(!.Info, ModuleInfo),
module_info_pred_proc_info(ModuleInfo, PredId, ProcId, PredInfo, ProcInfo),
proc_info_get_varset(ProcInfo, VarSet),
proc_info_get_headvars(ProcInfo, HeadVars),
@@ -1083,7 +1100,7 @@
ml_gen_params(HeadVarNames, HeadTypes, HeadModes, PredOrFunc,
CodeModel, FuncParams, !Info) :-
- ModuleInfo = !.Info ^ mgi_module_info,
+ ml_gen_info_get_module_info(!.Info, ModuleInfo),
modes_to_arg_modes(ModuleInfo, HeadModes, HeadTypes, ArgModes),
ml_gen_params_base(ModuleInfo, HeadVarNames,
HeadTypes, ArgModes, PredOrFunc, CodeModel, FuncParams,
@@ -1252,8 +1269,7 @@
!.MaybeInfo = yes(Info0),
% XXX We should fill in this Context properly.
term.context_init(Context),
- ml_gen_gc_statement(Var, Type, Context, GCStatement,
- Info0, Info),
+ ml_gen_gc_statement(Var, Type, Context, GCStatement, Info0, Info),
!:MaybeInfo = yes(Info)
;
!.MaybeInfo = no,
@@ -1425,7 +1441,7 @@
%-----------------------------------------------------------------------------%
%
-% Code for dealing with variables
+% Code for dealing with variables.
%
ml_gen_var_list(_Info, [], []).
@@ -1495,11 +1511,10 @@
ml_format_reserved_object_name(CtorName, CtorArity) = ReservedObjName :-
% We add the "obj_" prefix to avoid any potential name clashes.
-
- Name = string.format("obj_%s_%d", [s(CtorName), i(CtorArity)]),
+ string.format("obj_%s_%d", [s(CtorName), i(CtorArity)], Name),
ReservedObjName = mlds_var_name(Name, no).
-ml_format_static_const_name(Info, BaseName, SequenceNum, ConstName) :-
+ml_format_static_const_var_name(Info, BaseName, ConstSeq, ConstVarName) :-
% To ensure that the names are unique, we qualify them with the pred_id
% and proc_id numbers, as well as a sequence number. This is needed to
% allow ml_elim_nested.m to hoist such constants out to top level.
@@ -1508,15 +1523,16 @@
ml_gen_info_get_proc_id(Info, ProcId),
pred_id_to_int(PredId, PredIdNum),
proc_id_to_int(ProcId, ProcIdNum),
- ConstName = mlds_var_name(
- string.format("const_%d_%d_%d_%s", [i(PredIdNum),
- i(ProcIdNum), i(SequenceNum), s(BaseName)]), no).
+ ConstSeq = const_seq(ConstNum),
+ string.format("const_var_%d_%d_%d_%s",
+ [i(PredIdNum), i(ProcIdNum), i(ConstNum), s(BaseName)], ConstName),
+ ConstVarName = mlds_var_name(ConstName, no).
ml_gen_var_lval(Info, VarName, VarType, QualifiedVarLval) :-
ml_gen_info_get_module_name(Info, ModuleName),
MLDS_Module = mercury_module_name_to_mlds(ModuleName),
- QualifiedVarLval = ml_var(qual(MLDS_Module, module_qual, VarName),
- VarType).
+ MLDS_Var = qual(MLDS_Module, module_qual, VarName),
+ QualifiedVarLval = ml_var(MLDS_Var, VarType).
ml_gen_var_decl(VarName, Type, Context, Defn, !Info) :-
ml_gen_info_get_module_info(!.Info, ModuleInfo),
@@ -1586,7 +1602,7 @@
%-----------------------------------------------------------------------------%
%
-% Code for dealing with fields
+% Code for dealing with fields.
%
% Given the user-specified field name, if any, and the argument number
@@ -1611,7 +1627,7 @@
% that don't need it, e.g. the .NET and Java back-ends. This routine should
% be modified to check the target.
%
-ml_must_box_field_type(Type, ModuleInfo) :-
+ml_must_box_field_type(ModuleInfo, Type) :-
classify_type(ModuleInfo, Type) = Category,
ml_must_box_field_type_category(Category) = yes.
@@ -1640,7 +1656,7 @@
%-----------------------------------------------------------------------------%
%
-% Code for handling success and failure
+% Code for handling success and failure.
%
ml_gen_success(model_det, _, Statements, !Info) :-
@@ -1713,8 +1729,10 @@
%
:- func ml_gen_cond_var_name(cond_seq) = mlds_var_name.
-ml_gen_cond_var_name(CondVar) =
- mlds_var_name(string.append("cond_", string.int_to_string(CondVar)), no).
+ml_gen_cond_var_name(CondVar) = VarName :-
+ CondVar = cond_seq(CondNum),
+ CondName = string.append("cond_", string.int_to_string(CondNum)),
+ VarName = mlds_var_name(CondName, no).
ml_gen_cond_var_decl(CondVar, Context) =
ml_gen_mlds_var_decl(mlds_data_var(ml_gen_cond_var_name(CondVar)),
@@ -1893,13 +1911,12 @@
%-----------------------------------------------------------------------------%
%
-% Routines for dealing with the environment pointer
-% used for nested functions.
+% Routines for dealing with the environment pointer used for nested functions.
%
ml_get_env_ptr(Info, ml_lval(EnvPtrLval)) :-
- ml_gen_var_lval(Info, mlds_var_name("env_ptr", no),
- mlds_unknown_type, EnvPtrLval).
+ ml_gen_var_lval(Info, mlds_var_name("env_ptr", no), mlds_unknown_type,
+ EnvPtrLval).
ml_declare_env_ptr_arg(mlds_argument(Name, Type, GCStatement)) :-
Name = entity_data(mlds_data_var(mlds_var_name("env_ptr_arg", no))),
@@ -1913,13 +1930,13 @@
%-----------------------------------------------------------------------------%
%
-% Code to handle accurate GC
+% Code to handle accurate GC.
%
ml_gen_gc_statement(VarName, Type, Context, GCStatement, !Info) :-
- ml_gen_gc_statement(VarName, Type, Type, Context, GCStatement, !Info).
+ ml_gen_gc_statement_poly(VarName, Type, Type, Context, GCStatement, !Info).
-ml_gen_gc_statement(VarName, DeclType, ActualType, Context,
+ml_gen_gc_statement_poly(VarName, DeclType, ActualType, Context,
GCStatement, !Info) :-
HowToGetTypeInfo = construct_from_type(ActualType),
ml_gen_gc_statement_2(VarName, DeclType, HowToGetTypeInfo, Context,
@@ -2155,9 +2172,9 @@
[MLDS_TypeInfoStatement, MLDS_TraceStatement], Context).
% ml_gen_trace_var(VarName, DeclType, TypeInfo, Context, Code):
- % Generate a call to `private_builtin.gc_trace'
- % for the specified variable, given the variable's name, type,
- % and the already-constructed type_info for that type.
+ % Generate a call to `private_builtin.gc_trace' for the specified variable,
+ % given the variable's name, type, and the already-constructed type_info
+ % for that type.
%
:- pred ml_gen_trace_var(ml_gen_info::in, mlds_var_name::in, mer_type::in,
mlds_rval::in, prog_context::in, statement::out) is det.
@@ -2188,10 +2205,9 @@
% Generate the call
% `private_builtin.gc_trace(TypeInfo, (MR_C_Pointer) &Var);'.
CastVarAddr = ml_unop(cast(CPointerType), ml_mem_addr(VarLval)),
- TraceStatement = statement(
- ml_stmt_call(Signature, FuncAddr, no,
- [TypeInfoRval, CastVarAddr], [], ordinary_call
- ), mlds_make_context(Context)).
+ TraceStmt = ml_stmt_call(Signature, FuncAddr, no,
+ [TypeInfoRval, CastVarAddr], [], ordinary_call),
+ TraceStatement = statement(TraceStmt, mlds_make_context(Context)).
% Generate HLDS code to construct the type_info for this type.
%
@@ -2200,9 +2216,9 @@
ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_make_type_info_var(Type, Context, TypeInfoVar, TypeInfoGoals, !Info) :-
- ModuleInfo0 = !.Info ^ mgi_module_info,
- PredId = !.Info ^ mgi_pred_id,
- ProcId = !.Info ^ mgi_proc_id,
+ ml_gen_info_get_module_info(!.Info, ModuleInfo0),
+ ml_gen_info_get_pred_id(!.Info, PredId),
+ ml_gen_info_get_proc_id(!.Info, ProcId),
module_info_pred_proc_info(ModuleInfo0, PredId, ProcId,
PredInfo0, ProcInfo0),
@@ -2218,9 +2234,9 @@
ModuleInfo1, ModuleInfo),
proc_info_get_varset(ProcInfo, VarSet),
proc_info_get_vartypes(ProcInfo, VarTypes),
- !:Info = !.Info ^ mgi_module_info := ModuleInfo,
- !:Info = !.Info ^ mgi_varset := VarSet,
- !:Info = !.Info ^ mgi_var_types := VarTypes.
+ ml_gen_info_set_module_info(ModuleInfo, !Info),
+ ml_gen_info_set_varset(VarSet, !Info),
+ ml_gen_info_set_var_types(VarTypes, !Info).
%-----------------------------------------------------------------------------%
@@ -2434,49 +2450,67 @@
:- type ml_gen_info
---> ml_gen_info(
- % These fields remain constant for each procedure
- % (unless accurate GC is enabled, in which case the
- % varset and var_types may get updated if we create
- % fresh variables for type_info variables needed
- % for calls to private_builtin.gc_trace).
-
- mgi_module_info :: module_info,
- mgi_pred_id :: pred_id,
- mgi_proc_id :: proc_id,
- mgi_varset :: prog_varset,
- mgi_var_types :: vartypes,
+/* 1 */ mgi_module_info :: module_info,
+
+ % These fields remain constant for each procedure unless
+ % accurate GC is enabled, in which case they may get updated
+ % if we create fresh variables for the type_info variables
+ % needed for calls to private_builtin.gc_trace.
+/* 2 */ mgi_varset :: prog_varset,
+/* 3 */ mgi_var_types :: vartypes,
% Output arguments that are passed by reference.
- mgi_byref_output_vars :: list(prog_var),
+/* 4 */ mgi_byref_output_vars :: list(prog_var),
% Output arguments that are returned as values.
- mgi_value_output_vars :: list(prog_var),
+/* 5 */ mgi_value_output_vars :: list(prog_var),
+
+ % Definitions of functions or global constants which should be
+ % inserted before the definition of the function for the
+ % current procedure.
+/* 6 */ mgi_var_lvals :: map(prog_var, mlds_lval),
- % These fields get updated as we traverse each procedure.
+/* 7 */ mgi_extra_defns :: list(mlds_defn),
- mgi_func_label :: counter,
- mgi_commit_label :: counter,
- mgi_label :: counter,
- mgi_cond_var :: counter,
- mgi_conv_var :: counter,
- mgi_const_num :: counter,
+ % All of the other pieces of information that are not among
+ % the most frequently read and/or written fields. Limiting
+ % ml_gen_info to eight fields make updating the structure
+ % quicker and less wasteful of memory.
+/* 8 */ mgi_sub_info :: ml_gen_sub_info
+ ).
+
+:- type ml_gen_sub_info
+ ---> ml_gen_sub_info(
+ % Quick-access read-only copies of parts of the globals
+ % structure taken from the module_info.
+/* 1 */ mgsi_high_level_data :: bool,
+/* 2 */ mgsi_target :: compilation_target,
+
+ % The identity of the procedure we are generating code for.
+/* 3 */ mgsi_pred_id :: pred_id,
+/* 4 */ mgsi_proc_id :: proc_id,
+
+/* 5 */ mgsi_func_counter :: counter,
+/* 6 */ mgsi_label_counter :: counter,
+/* 7 */ mgsi_aux_var_counter :: counter,
+/* 8 */ mgsi_cond_var_counter :: counter,
+/* 9 */ mgsi_conv_var_counter :: counter,
+/* 10 */ mgsi_const_counter :: counter,
- mgi_const_var_name_map :: map(prog_var, mlds_var_name),
+/* 11 */ mgsi_const_var_name_map :: map(prog_var, mlds_var_name),
% A partial mapping from vars to lvals, used to override
% the normal lval that we use for a variable.
- mgi_success_cont_stack :: stack(success_cont),
+/* 12 */ mgsi_success_cont_stack :: stack(success_cont),
- % Definitions of functions or global constants which should be
- % inserted before the definition of the function for the
- % current procedure.
- mgi_var_lvals :: map(prog_var, mlds_lval),
-
- mgi_extra_defns :: list(mlds_defn),
- mgi_env_var_names :: set(string)
+/* 13 */ mgsi_env_var_names :: set(string)
).
ml_gen_info_init(ModuleInfo, PredId, ProcId) = Info :-
+ module_info_get_globals(ModuleInfo, Globals),
+ globals.lookup_bool_option(Globals, highlevel_data, HighLevelData),
+ globals.get_target(Globals, CompilationTarget),
+
module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
_PredInfo, ProcInfo),
proc_info_get_headvars(ProcInfo, HeadVars),
@@ -2493,8 +2527,8 @@
% name (see ml_elim_nested.gen_gc_trace_func/8 for details).
%
counter.init(1, FuncLabelCounter),
- counter.init(0, CommitLabelCounter),
counter.init(0, LabelCounter),
+ counter.init(0, AuxVarCounter),
counter.init(0, CondVarCounter),
counter.init(0, ConvVarCounter),
counter.init(0, ConstCounter),
@@ -2504,43 +2538,148 @@
ExtraDefns = [],
EnvVarNames = set.init,
- Info = ml_gen_info(
- ModuleInfo,
+ SubInfo = ml_gen_sub_info(
+ HighLevelData,
+ CompilationTarget,
PredId,
ProcId,
- VarSet,
- VarTypes,
- ByRefOutputVars,
- ValueOutputVars,
FuncLabelCounter,
- CommitLabelCounter,
LabelCounter,
+ AuxVarCounter,
CondVarCounter,
ConvVarCounter,
ConstCounter,
ConstNumMap,
SuccContStack,
+ EnvVarNames
+ ),
+ Info = ml_gen_info(
+ ModuleInfo,
+ VarSet,
+ VarTypes,
+ ByRefOutputVars,
+ ValueOutputVars,
VarLvals,
ExtraDefns,
- EnvVarNames
+ SubInfo
).
-ml_gen_info_get_module_info(Info, Info ^ mgi_module_info).
-
-ml_gen_info_get_module_name(Info, ModuleName) :-
- ml_gen_info_get_module_info(Info, ModuleInfo),
- module_info_get_name(ModuleInfo, ModuleName).
+:- pred ml_gen_info_get_func_counter(ml_gen_info::in, counter::out) is det.
+:- pred ml_gen_info_get_label_counter(ml_gen_info::in, counter::out) is det.
+:- pred ml_gen_info_get_aux_var_counter(ml_gen_info::in, counter::out) is det.
+:- pred ml_gen_info_get_cond_var_counter(ml_gen_info::in, counter::out) is det.
+:- pred ml_gen_info_get_conv_var_counter(ml_gen_info::in, counter::out) is det.
+:- pred ml_gen_info_get_const_var_name_map(ml_gen_info::in,
+ map(prog_var, mlds_var_name)::out) is det.
+:- pred ml_gen_info_get_success_cont_stack(ml_gen_info::in,
+ stack(success_cont)::out) is det.
-ml_gen_info_get_pred_id(Info, Info ^ mgi_pred_id).
-ml_gen_info_get_proc_id(Info, Info ^ mgi_proc_id).
+ml_gen_info_get_module_info(Info, Info ^ mgi_module_info).
+ml_gen_info_get_high_level_data(Info,
+ Info ^ mgi_sub_info ^ mgsi_high_level_data).
+ml_gen_info_get_target(Info, Info ^ mgi_sub_info ^ mgsi_target).
+ml_gen_info_get_pred_id(Info, Info ^ mgi_sub_info ^ mgsi_pred_id).
+ml_gen_info_get_proc_id(Info, Info ^ mgi_sub_info ^ mgsi_proc_id).
ml_gen_info_get_varset(Info, Info ^ mgi_varset).
ml_gen_info_get_var_types(Info, Info ^ mgi_var_types).
ml_gen_info_get_byref_output_vars(Info, Info ^ mgi_byref_output_vars).
ml_gen_info_get_value_output_vars(Info, Info ^ mgi_value_output_vars).
-ml_gen_info_set_byref_output_vars(OutputVars, Info,
- Info ^ mgi_byref_output_vars := OutputVars).
-ml_gen_info_set_value_output_vars(OutputVars, Info,
- Info ^ mgi_value_output_vars := OutputVars).
+ml_gen_info_get_func_counter(Info, Info ^ mgi_sub_info ^ mgsi_func_counter).
+ml_gen_info_get_label_counter(Info, Info ^ mgi_sub_info ^ mgsi_label_counter).
+ml_gen_info_get_aux_var_counter(Info,
+ Info ^ mgi_sub_info ^ mgsi_aux_var_counter).
+ml_gen_info_get_cond_var_counter(Info,
+ Info ^ mgi_sub_info ^ mgsi_cond_var_counter).
+ml_gen_info_get_conv_var_counter(Info,
+ Info ^ mgi_sub_info ^ mgsi_conv_var_counter).
+ml_gen_info_get_const_counter(Info, Info ^ mgi_sub_info ^ mgsi_const_counter).
+ml_gen_info_get_const_var_name_map(Info,
+ Info ^ mgi_sub_info ^ mgsi_const_var_name_map).
+ml_gen_info_get_success_cont_stack(Info,
+ Info ^ mgi_sub_info ^ mgsi_success_cont_stack).
+ml_gen_info_get_var_lvals(Info, Info ^ mgi_var_lvals).
+ml_gen_info_get_extra_defns(Info, Info ^ mgi_extra_defns).
+ml_gen_info_get_env_var_names(Info, Info ^ mgi_sub_info ^ mgsi_env_var_names).
+
+:- pred ml_gen_info_set_module_info(module_info::in,
+ ml_gen_info::in, ml_gen_info::out) is det.
+:- pred ml_gen_info_set_varset(prog_varset::in,
+ ml_gen_info::in, ml_gen_info::out) is det.
+:- pred ml_gen_info_set_var_types(vartypes::in,
+ ml_gen_info::in, ml_gen_info::out) is det.
+:- pred ml_gen_info_set_func_counter(counter::in,
+ ml_gen_info::in, ml_gen_info::out) is det.
+:- pred ml_gen_info_set_label_counter(counter::in,
+ ml_gen_info::in, ml_gen_info::out) is det.
+:- pred ml_gen_info_set_aux_var_counter(counter::in,
+ ml_gen_info::in, ml_gen_info::out) is det.
+:- pred ml_gen_info_set_cond_var_counter(counter::in,
+ ml_gen_info::in, ml_gen_info::out) is det.
+:- pred ml_gen_info_set_conv_var_counter(counter::in,
+ ml_gen_info::in, ml_gen_info::out) is det.
+:- pred ml_gen_info_set_const_var_name_map(map(prog_var, mlds_var_name)::in,
+ ml_gen_info::in, ml_gen_info::out) is det.
+:- pred ml_gen_info_set_success_cont_stack(stack(success_cont)::in,
+ ml_gen_info::in, ml_gen_info::out) is det.
+:- pred ml_gen_info_set_extra_defns(list(mlds_defn)::in,
+ ml_gen_info::in, ml_gen_info::out) is det.
+:- pred ml_gen_info_set_env_var_names(set(string)::in,
+ ml_gen_info::in, ml_gen_info::out) is det.
+
+ml_gen_info_set_module_info(ModuleInfo, !Info) :-
+ !Info ^ mgi_module_info := ModuleInfo.
+ml_gen_info_set_varset(VarSet, !Info) :-
+ !Info ^ mgi_varset := VarSet.
+ml_gen_info_set_var_types(VarTypes, !Info) :-
+ !Info ^ mgi_var_types := VarTypes.
+ml_gen_info_set_byref_output_vars(OutputVars, !Info) :-
+ !Info ^ mgi_byref_output_vars := OutputVars.
+ml_gen_info_set_value_output_vars(OutputVars, !Info) :-
+ !Info ^ mgi_value_output_vars := OutputVars.
+ml_gen_info_set_func_counter(FuncCounter, !Info) :-
+ SubInfo0 = !.Info ^ mgi_sub_info,
+ SubInfo = SubInfo0 ^ mgsi_func_counter := FuncCounter,
+ !Info ^ mgi_sub_info := SubInfo.
+ml_gen_info_set_label_counter(LabelCounter, !Info) :-
+ SubInfo0 = !.Info ^ mgi_sub_info,
+ SubInfo = SubInfo0 ^ mgsi_label_counter := LabelCounter,
+ !Info ^ mgi_sub_info := SubInfo.
+ml_gen_info_set_aux_var_counter(AuxVarCounter, !Info) :-
+ SubInfo0 = !.Info ^ mgi_sub_info,
+ SubInfo = SubInfo0 ^ mgsi_aux_var_counter := AuxVarCounter,
+ !Info ^ mgi_sub_info := SubInfo.
+ml_gen_info_set_cond_var_counter(CondVarCounter, !Info) :-
+ SubInfo0 = !.Info ^ mgi_sub_info,
+ SubInfo = SubInfo0 ^ mgsi_cond_var_counter := CondVarCounter,
+ !Info ^ mgi_sub_info := SubInfo.
+ml_gen_info_set_conv_var_counter(ConvVarCounter, !Info) :-
+ SubInfo0 = !.Info ^ mgi_sub_info,
+ SubInfo = SubInfo0 ^ mgsi_conv_var_counter := ConvVarCounter,
+ !Info ^ mgi_sub_info := SubInfo.
+ml_gen_info_set_const_counter(ConstCounter, !Info) :-
+ SubInfo0 = !.Info ^ mgi_sub_info,
+ SubInfo = SubInfo0 ^ mgsi_const_counter := ConstCounter,
+ !Info ^ mgi_sub_info := SubInfo.
+ml_gen_info_set_const_var_name_map(ConstVarNameMap, !Info) :-
+ SubInfo0 = !.Info ^ mgi_sub_info,
+ SubInfo = SubInfo0 ^ mgsi_const_var_name_map := ConstVarNameMap,
+ !Info ^ mgi_sub_info := SubInfo.
+ml_gen_info_set_success_cont_stack(SuccessContStack, !Info) :-
+ SubInfo0 = !.Info ^ mgi_sub_info,
+ SubInfo = SubInfo0 ^ mgsi_success_cont_stack := SuccessContStack,
+ !Info ^ mgi_sub_info := SubInfo.
+ml_gen_info_set_var_lvals(VarLvals, !Info) :-
+ !Info ^ mgi_var_lvals := VarLvals.
+ml_gen_info_set_extra_defns(ExtraDefns, !Info) :-
+ !Info ^ mgi_extra_defns := ExtraDefns.
+ml_gen_info_set_env_var_names(EnvVarNames, !Info) :-
+ SubInfo0 = !.Info ^ mgi_sub_info,
+ SubInfo = SubInfo0 ^ mgsi_env_var_names := EnvVarNames,
+ !Info ^ mgi_sub_info := SubInfo.
+
+ml_gen_info_get_module_name(Info, ModuleName) :-
+ ml_gen_info_get_module_info(Info, ModuleInfo),
+ module_info_get_name(ModuleInfo, ModuleName).
ml_gen_info_use_gcc_nested_functions(Info, UseNestedFuncs) :-
ml_gen_info_get_globals(Info, Globals),
@@ -2556,86 +2695,95 @@
ml_gen_info_get_module_info(Info, ModuleInfo),
module_info_get_globals(ModuleInfo, Globals).
-ml_gen_info_new_label(Label, !Info) :-
- Counter0 = !.Info ^ mgi_label,
+ml_gen_info_new_func_label(Label, !Info) :-
+ ml_gen_info_get_func_counter(!.Info, Counter0),
counter.allocate(Label, Counter0, Counter),
- !Info ^ mgi_label := Counter.
+ ml_gen_info_set_func_counter(Counter, !Info).
-ml_gen_info_new_func_label(Label, !Info) :-
- Counter0 = !.Info ^ mgi_func_label,
+ml_gen_info_new_label(Label, !Info) :-
+ ml_gen_info_get_label_counter(!.Info, Counter0),
counter.allocate(Label, Counter0, Counter),
- !Info ^ mgi_func_label := Counter.
+ ml_gen_info_set_label_counter(Counter, !Info).
ml_gen_info_bump_counters(!Info) :-
- FuncLabelCounter0 = !.Info ^ mgi_func_label,
- ConstNumCounter0 = !.Info ^ mgi_const_num,
+ ml_gen_info_get_func_counter(!.Info, FuncLabelCounter0),
+ ml_gen_info_get_const_counter(!.Info, ConstNumCounter0),
counter.allocate(FuncLabel, FuncLabelCounter0, _),
counter.allocate(ConstNum, ConstNumCounter0, _),
FuncLabelCounter = counter.init(FuncLabel + 10000),
ConstNumCounter = counter.init(ConstNum + 10000),
- !Info ^ mgi_func_label := FuncLabelCounter,
- !Info ^ mgi_const_num := ConstNumCounter.
+ ml_gen_info_set_func_counter(FuncLabelCounter, !Info),
+ ml_gen_info_set_const_counter(ConstNumCounter, !Info).
-ml_gen_info_new_commit_label(CommitLabel, !Info) :-
- Counter0 = !.Info ^ mgi_commit_label,
- counter.allocate(CommitLabel, Counter0, Counter),
- !Info ^ mgi_commit_label := Counter.
-
-ml_gen_info_new_cond_var(CondVar, !Info) :-
- Counter0 = !.Info ^ mgi_cond_var,
- counter.allocate(CondVar, Counter0, Counter),
- !Info ^ mgi_cond_var := Counter.
-
-ml_gen_info_new_conv_var(ConvVar, !Info) :-
- Counter0 = !.Info ^ mgi_conv_var,
- counter.allocate(ConvVar, Counter0, Counter),
- !Info ^ mgi_conv_var := Counter.
-
-ml_gen_info_new_const(ConstVar, !Info) :-
- Counter0 = !.Info ^ mgi_const_num,
- counter.allocate(ConstVar, Counter0, Counter),
- !Info ^ mgi_const_num := Counter.
+ml_gen_info_new_aux_var_name(Prefix, VarName, !Info) :-
+ ml_gen_info_get_aux_var_counter(!.Info, AuxVarCounter0),
+ counter.allocate(AuxVarNum, AuxVarCounter0, AuxVarCounter),
+ ml_gen_info_set_aux_var_counter(AuxVarCounter, !Info),
+
+ string.format("%s_%d", [s(Prefix), i(AuxVarNum)], Name),
+ VarName = mlds_var_name(Name, no).
+
+ml_gen_info_new_cond_var(cond_seq(CondNum), !Info) :-
+ ml_gen_info_get_cond_var_counter(!.Info, CondCounter0),
+ counter.allocate(CondNum, CondCounter0, CondCounter),
+ ml_gen_info_set_cond_var_counter(CondCounter, !Info).
+
+ml_gen_info_new_conv_var(conv_seq(ConvNum), !Info) :-
+ ml_gen_info_get_conv_var_counter(!.Info, ConvCounter0),
+ counter.allocate(ConvNum, ConvCounter0, ConvCounter),
+ ml_gen_info_set_conv_var_counter(ConvCounter, !Info).
+
+ml_gen_info_new_const(const_seq(ConstNum), !Info) :-
+ ml_gen_info_get_const_counter(!.Info, ConstCounter0),
+ counter.allocate(ConstNum, ConstCounter0, ConstCounter),
+ ml_gen_info_set_const_counter(ConstCounter, !Info).
ml_gen_info_set_const_var_name(Var, Name, !Info) :-
- !Info ^ mgi_const_var_name_map :=
- map.set(!.Info ^ mgi_const_var_name_map, Var, Name).
+ ml_gen_info_get_const_var_name_map(!.Info, VarNameMap0),
+ % We cannot call map.det_insert, because we do not (yet) clean up the
+ % const_var_name_map at the start of later branches of a branched goal,
+ % and thus when generating code for a later branch, we may come across
+ % an entry left by an earlier branch. Using map.set instead throws away
+ % such obsolete entries.
+ map.set(VarNameMap0, Var, Name, VarNameMap),
+ ml_gen_info_set_const_var_name_map(VarNameMap, !Info).
ml_gen_info_lookup_const_var_name(Info, Var, Name) :-
- Name = map.lookup(Info ^ mgi_const_var_name_map, Var).
+ ml_gen_info_get_const_var_name_map(Info, VarNameMap),
+ map.lookup(VarNameMap, Var, Name).
ml_gen_info_search_const_var_name(Info, Var, Name) :-
- Name = map.search(Info ^ mgi_const_var_name_map, Var).
+ ml_gen_info_get_const_var_name_map(Info, VarNameMap),
+ map.search(VarNameMap, Var, Name).
ml_gen_info_push_success_cont(SuccCont, !Info) :-
- !Info ^ mgi_success_cont_stack :=
- stack.push(!.Info ^ mgi_success_cont_stack, SuccCont).
+ ml_gen_info_get_success_cont_stack(!.Info, Stack0),
+ stack.push(Stack0, SuccCont, Stack),
+ ml_gen_info_set_success_cont_stack(Stack, !Info).
ml_gen_info_pop_success_cont(!Info) :-
- Stack0 = !.Info ^ mgi_success_cont_stack,
+ ml_gen_info_get_success_cont_stack(!.Info, Stack0),
stack.pop_det(Stack0, _SuccCont, Stack),
- !Info ^ mgi_success_cont_stack := Stack.
+ ml_gen_info_set_success_cont_stack(Stack, !Info).
ml_gen_info_current_success_cont(Info, SuccCont) :-
- stack.top_det(Info ^ mgi_success_cont_stack, SuccCont).
+ ml_gen_info_get_success_cont_stack(Info, Stack),
+ stack.top_det(Stack, SuccCont).
ml_gen_info_set_var_lval(Var, Lval, !Info) :-
- !Info ^ mgi_var_lvals := map.set(!.Info ^ mgi_var_lvals, Var, Lval).
-
-ml_gen_info_get_var_lvals(Info, Info ^ mgi_var_lvals).
-ml_gen_info_set_var_lvals(VarLvals, !Info) :-
- !Info ^ mgi_var_lvals := VarLvals.
+ ml_gen_info_get_var_lvals(!.Info, VarLvals0),
+ map.set(VarLvals0, Var, Lval, VarLvals),
+ ml_gen_info_set_var_lvals(VarLvals, !Info).
ml_gen_info_add_extra_defn(ExtraDefn, !Info) :-
- !Info ^ mgi_extra_defns := [ExtraDefn | !.Info ^ mgi_extra_defns].
-
-ml_gen_info_get_extra_defns(Info, Info ^ mgi_extra_defns).
+ ml_gen_info_get_extra_defns(!.Info, ExtraDefns0),
+ ExtraDefns = [ExtraDefn | ExtraDefns0],
+ ml_gen_info_set_extra_defns(ExtraDefns, !Info).
ml_gen_info_add_env_var_name(Name, !Info) :-
- EnvVarNames0 = !.Info ^ mgi_env_var_names,
+ ml_gen_info_get_env_var_names(!.Info, EnvVarNames0),
set.insert(EnvVarNames0, Name, EnvVarNames),
- !Info ^ mgi_env_var_names := EnvVarNames.
-
-ml_gen_info_get_env_vars(Info, Info ^ mgi_env_var_names).
+ ml_gen_info_set_env_var_names(EnvVarNames, !Info).
%-----------------------------------------------------------------------------%
@@ -2709,7 +2857,7 @@
%-----------------------------------------------------------------------------%
%
-% Miscellaneous routines
+% Miscellaneous routines.
%
get_copy_out_option(Globals, CodeModel) = CopyOut :-
Index: compiler/ml_elim_nested.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.104
diff -u -b -r1.104 ml_elim_nested.m
--- compiler/ml_elim_nested.m 10 Jul 2009 05:07:25 -0000 1.104
+++ compiler/ml_elim_nested.m 18 Aug 2009 10:14:35 -0000
@@ -733,7 +733,8 @@
%
QualVarName = qual(ModuleName, module_qual, VarName),
Globals = elim_info_get_globals(Info),
- EnvModuleName = ml_env_module_name(ClassType, Globals),
+ globals.get_target(Globals, Target),
+ EnvModuleName = ml_env_module_name(Target, ClassType),
FieldNameString = ml_var_name_to_string(VarName),
FieldName = ml_field_named(qual(EnvModuleName, type_qual,
FieldNameString), EnvPtrTypeName),
@@ -2139,7 +2140,8 @@
EnvPtr = ml_lval(ml_var(qual(ModuleName, QualKind,
mlds_var_name(env_name_base(Action) ++ "_ptr", no)),
EnvPtrVarType)),
- EnvModuleName = ml_env_module_name(ClassType, Globals),
+ globals.get_target(Globals, Target),
+ EnvModuleName = ml_env_module_name(Target, ClassType),
ThisVarFieldName = ml_var_name_to_string(ThisVarName),
FieldName = ml_field_named(
qual(EnvModuleName, type_qual, ThisVarFieldName),
@@ -2229,13 +2231,13 @@
% Lval = make_envptr_ref(Depth - 1, NewEnvPtr, EnvPtrVar, Var)
% ).
-:- func ml_env_module_name(mlds_type, globals) = mlds_module_name.
+:- func ml_env_module_name(compilation_target, mlds_type) = mlds_module_name.
-ml_env_module_name(ClassType, Globals) = EnvModuleName :-
+ml_env_module_name(Target, ClassType) = EnvModuleName :-
( ClassType = mlds_class_type(ClassModuleName, Arity, _Kind) ->
ClassModuleName = qual(ClassModule, QualKind, ClassName),
- EnvModuleName = mlds_append_class_qualifier(ClassModule,
- QualKind, Globals, ClassName, Arity)
+ EnvModuleName = mlds_append_class_qualifier(Target, ClassModule,
+ QualKind, ClassName, Arity)
;
unexpected(this_file, "ml_env_module_name: ClassType is not a class")
).
Index: compiler/ml_string_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_string_switch.m,v
retrieving revision 1.39
diff -u -b -r1.39 ml_string_switch.m
--- compiler/ml_string_switch.m 10 Jun 2009 06:26:20 -0000 1.39
+++ compiler/ml_string_switch.m 18 Aug 2009 17:10:47 -0000
@@ -64,21 +64,18 @@
VarRval = ml_lval(VarLval),
% Generate the following local variable declarations:
- % int slot;
- % MR_String str;
+ % int slot_N;
+ % MR_String str_M;
- ml_gen_info_new_cond_var(SlotVarSeq, !Info),
- SlotVarName = mlds_var_name(
- string.format("slot_%d", [i(SlotVarSeq)]), no),
+ ml_gen_info_new_aux_var_name("slot", SlotVarName, !Info),
SlotVarType = mlds_native_int_type,
- SlotVarGCStatement = gc_no_stmt, % never need to trace ints
+ % We never need to trace ints.
+ SlotVarGCStatement = gc_no_stmt,
SlotVarDefn = ml_gen_mlds_var_decl(mlds_data_var(SlotVarName), SlotVarType,
SlotVarGCStatement, MLDS_Context),
ml_gen_var_lval(!.Info, SlotVarName, SlotVarType, SlotVarLval),
- ml_gen_info_new_cond_var(StringVarSeq, !Info),
- StringVarName = mlds_var_name(
- string.format("str_%d", [i(StringVarSeq)]), no),
+ ml_gen_info_new_aux_var_name("str", StringVarName, !Info),
StringVarType = ml_string_type,
% This variable always points to an element of the string_table array,
% which are all static constants; it can never point into the heap.
@@ -136,7 +133,7 @@
% static const MR_String string_table[] = { <Strings> };
ml_gen_info_new_const(NextSlotsSeq, !Info),
- ml_format_static_const_name(!.Info, "next_slots_table", NextSlotsSeq,
+ ml_format_static_const_var_name(!.Info, "next_slots_table", NextSlotsSeq,
NextSlotsName),
NextSlotsType = mlds_array_type(SlotVarType),
NextSlotsDefn = ml_gen_static_const_defn(NextSlotsName,
@@ -144,7 +141,7 @@
ml_gen_var_lval(!.Info, NextSlotsName, NextSlotsType, NextSlotsLval),
ml_gen_info_new_const(StringTableSeq, !Info),
- ml_format_static_const_name(!.Info, "string_table", StringTableSeq,
+ ml_format_static_const_var_name(!.Info, "string_table", StringTableSeq,
StringTableName),
StringTableType = mlds_array_type(StringVarType),
StringTableDefn = ml_gen_static_const_defn(StringTableName,
Index: compiler/ml_tag_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_tag_switch.m,v
retrieving revision 1.29
diff -u -b -r1.29 ml_tag_switch.m
--- compiler/ml_tag_switch.m 10 Jun 2009 06:26:20 -0000 1.29
+++ compiler/ml_tag_switch.m 18 Aug 2009 20:27:17 -0000
@@ -187,7 +187,7 @@
STagRval = ml_unop(std_unop(unmkbody), VarRval)
;
StagLocn = sectag_remote,
- STagRval = ml_gen_secondary_tag_rval(PrimaryTag, VarType, ModuleInfo,
+ STagRval = ml_gen_secondary_tag_rval(ModuleInfo, PrimaryTag, VarType,
VarRval)
;
StagLocn = sectag_none,
Index: compiler/ml_type_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_type_gen.m,v
retrieving revision 1.85
diff -u -b -r1.85 ml_type_gen.m
--- compiler/ml_type_gen.m 9 Jul 2009 05:18:07 -0000 1.85
+++ compiler/ml_type_gen.m 18 Aug 2009 20:27:17 -0000
@@ -152,17 +152,17 @@
(
DefinedThisModule = yes,
hlds_data.get_type_defn_body(TypeDefn, TypeBody),
- ml_gen_type_2(TypeBody, ModuleInfo, TypeCtor, TypeDefn,
+ ml_gen_type_2(ModuleInfo, TypeCtor, TypeDefn, TypeBody,
MLDS_Defns0, MLDS_Defns)
;
DefinedThisModule = no,
MLDS_Defns = MLDS_Defns0
).
-:- pred ml_gen_type_2(hlds_type_body::in, module_info::in, type_ctor::in,
- hlds_type_defn::in, list(mlds_defn)::in, list(mlds_defn)::out) is det.
+:- pred ml_gen_type_2(module_info::in, type_ctor::in, hlds_type_defn::in,
+ hlds_type_body::in, list(mlds_defn)::in, list(mlds_defn)::out) is det.
-ml_gen_type_2(TypeBody, ModuleInfo, TypeCtor, TypeDefn, !Defns) :-
+ml_gen_type_2(ModuleInfo, TypeCtor, TypeDefn, TypeBody, !Defns) :-
(
TypeBody = hlds_abstract_type(_)
;
@@ -180,13 +180,17 @@
( DuTypeKind = du_type_kind_mercury_enum
; DuTypeKind = du_type_kind_foreign_enum(_)
),
- ml_gen_enum_type(ModuleInfo, TypeCtor, TypeDefn, Ctors, TagValues,
+ module_info_get_globals(ModuleInfo, Globals),
+ globals.get_target(Globals, Target),
+ ml_gen_enum_type(Target, TypeCtor, TypeDefn, Ctors, TagValues,
MaybeEqualityMembers, !Defns)
;
DuTypeKind = du_type_kind_direct_dummy,
% XXX We shouldn't have to generate an MLDS type for these types,
% but it is not easy to ensure that we never refer to that type.
- ml_gen_enum_type(ModuleInfo, TypeCtor, TypeDefn, Ctors, TagValues,
+ module_info_get_globals(ModuleInfo, Globals),
+ globals.get_target(Globals, Target),
+ ml_gen_enum_type(Target, TypeCtor, TypeDefn, Ctors, TagValues,
MaybeEqualityMembers, !Defns)
;
( DuTypeKind = du_type_kind_notag(_, _, _)
@@ -219,11 +223,11 @@
% generator can treat it specially if need be (e.g. generating
% a C enum rather than a class).
%
-:- pred ml_gen_enum_type(module_info::in, type_ctor::in, hlds_type_defn::in,
- list(constructor)::in, cons_tag_values::in, list(mlds_defn)::in,
- list(mlds_defn)::in, list(mlds_defn)::out) is det.
+:- pred ml_gen_enum_type(compilation_target::in, type_ctor::in,
+ hlds_type_defn::in, list(constructor)::in, cons_tag_values::in,
+ list(mlds_defn)::in, list(mlds_defn)::in, list(mlds_defn)::out) is det.
-ml_gen_enum_type(ModuleInfo, TypeCtor, TypeDefn, Ctors, TagValues,
+ml_gen_enum_type(Target, TypeCtor, TypeDefn, Ctors, TagValues,
MaybeEqualityMembers, MLDS_Defns0, MLDS_Defns) :-
hlds_data.get_type_defn_context(TypeDefn, Context),
MLDS_Context = mlds_make_context(Context),
@@ -246,8 +250,6 @@
% Make all Java classes corresponding to types implement the MercuryType
% and MercuryEnum interfaces.
- module_info_get_globals(ModuleInfo, Globals),
- globals.get_target(Globals, Target),
(
Target = target_java,
InterfaceModuleName = mercury_module_name_to_mlds(
@@ -435,11 +437,10 @@
mlds_class),
QualBaseClassName = qual(BaseClassModuleName, QualKind, BaseClassName),
module_info_get_globals(ModuleInfo, Globals),
- BaseClassQualifier = mlds_append_class_qualifier(
- BaseClassModuleName, QualKind, Globals,
- BaseClassName, BaseClassArity),
-
globals.get_target(Globals, Target),
+ BaseClassQualifier = mlds_append_class_qualifier(Target,
+ BaseClassModuleName, QualKind, BaseClassName, BaseClassArity),
+
(
% If none of the constructors for this type need a secondary tag,
% then we don't need the members for the secondary tag.
@@ -660,9 +661,9 @@
MLDS_Context = mlds_make_context(Context),
% Generate the class name for this constructor.
+ list.length(Args, CtorArity),
module_info_get_globals(ModuleInfo, Globals),
globals.get_target(Globals, Target),
- list.length(Args, CtorArity),
UnqualCtorName = ml_gen_du_ctor_name(Target, TypeCtor,
CtorName, CtorArity),
@@ -738,11 +739,10 @@
CtorClassType = mlds_class_type(
qual(BaseClassQualifier, type_qual, UnqualCtorName),
CtorArity, mlds_class),
- CtorClassQualifier = mlds_append_class_qualifier(
- BaseClassQualifier, type_qual,
- Globals, UnqualCtorName, CtorArity)
+ CtorClassQualifier = mlds_append_class_qualifier(Target,
+ BaseClassQualifier, type_qual, UnqualCtorName, CtorArity)
),
- CtorFunction = gen_constructor_function(Globals,
+ CtorFunction = gen_constructor_function(Target,
BaseClassId, CtorClassType, CtorClassQualifier,
SecondaryTagClassId, MaybeSecTagVal, Members, MLDS_Context),
% If this constructor is going to go in the base class, then we may
@@ -765,7 +765,7 @@
),
Members = [_ | _]
->
- ZeroArgCtor = gen_constructor_function(Globals, BaseClassId,
+ ZeroArgCtor = gen_constructor_function(Target, BaseClassId,
CtorClassType, CtorClassQualifier, SecondaryTagClassId,
no, [], MLDS_Context),
Ctors = [ZeroArgCtor, CtorFunction]
@@ -867,22 +867,21 @@
target_requires_module_qualified_params(target_erlang) =
unexpected(this_file, "target erlang").
-:- func gen_constructor_function(globals, mlds_class_id,
+:- func gen_constructor_function(compilation_target, mlds_class_id,
mlds_type, mlds_module_name, mlds_class_id, maybe(int), list(mlds_defn),
mlds_context) = mlds_defn.
-gen_constructor_function(Globals, BaseClassId, ClassType, ClassQualifier,
+gen_constructor_function(Target, BaseClassId, ClassType, ClassQualifier,
SecondaryTagClassId, MaybeTag, Members, Context) = CtorDefn :-
Args = list.map(make_arg, Members),
ReturnValues = [],
- globals.get_target(Globals, Target),
InitMembers0 = list.map(gen_init_field(Target, BaseClassId,
ClassType, ClassQualifier), Members),
(
MaybeTag = yes(TagVal),
- InitTag = gen_init_tag(ClassType, SecondaryTagClassId, TagVal,
- Context, Globals),
+ InitTag = gen_init_tag(Target, ClassType, SecondaryTagClassId, TagVal,
+ Context),
InitMembers = [InitTag | InitMembers0]
;
MaybeTag = no,
@@ -965,15 +964,15 @@
% Generate "this->data_tag = <TagVal>;".
%
-:- func gen_init_tag(mlds_type, mlds_class_id, int, mlds_context, globals)
- = statement.
+:- func gen_init_tag(compilation_target, mlds_type, mlds_class_id, int,
+ mlds_context) = statement.
-gen_init_tag(ClassType, SecondaryTagClassId, TagVal, Context, Globals)
+gen_init_tag(Target, ClassType, SecondaryTagClassId, TagVal, Context)
= Statement :-
( SecondaryTagClassId = mlds_class_type(TagClass, TagArity, _) ->
TagClass = qual(BaseClassQualifier, QualKind, TagClassName),
- TagClassQualifier = mlds_append_class_qualifier(BaseClassQualifier,
- QualKind, Globals, TagClassName, TagArity)
+ TagClassQualifier = mlds_append_class_qualifier(Target,
+ BaseClassQualifier, QualKind, TagClassName, TagArity)
;
unexpected(this_file, "gen_init_tag: class_id should be a class")
),
@@ -1019,7 +1018,7 @@
ml_gen_field(ModuleInfo, Context, MaybeFieldName, Type, MLDS_Defn,
ArgNum0, ArgNum) :-
- ( ml_must_box_field_type(Type, ModuleInfo) ->
+ ( ml_must_box_field_type(ModuleInfo, Type) ->
MLDS_Type = mlds_generic_type
;
MLDS_Type = mercury_type_to_mlds_type(ModuleInfo, Type)
Index: compiler/ml_unify_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_unify_gen.m,v
retrieving revision 1.132
diff -u -b -r1.132 ml_unify_gen.m
--- compiler/ml_unify_gen.m 16 Jun 2009 07:48:56 -0000 1.132
+++ compiler/ml_unify_gen.m 19 Aug 2009 09:00:09 -0000
@@ -55,12 +55,12 @@
list(mlds_defn)::out, list(statement)::out, mlds_rval::out,
ml_gen_info::in, ml_gen_info::out) is det.
- % ml_gen_secondary_tag_rval(PrimaryTag, VarType, ModuleInfo, VarRval):
+ % ml_gen_secondary_tag_rval(ModuleInfo, PrimaryTag, VarType, VarRval):
%
% Return the rval for the secondary tag field of VarRval, assuming that
% VarRval has the specified VarType and PrimaryTag.
%
-:- func ml_gen_secondary_tag_rval(tag_bits, mer_type, module_info, mlds_rval)
+:- func ml_gen_secondary_tag_rval(module_info, tag_bits, mer_type, mlds_rval)
= mlds_rval.
% Generate an MLDS rval for a given reserved address,
@@ -69,7 +69,7 @@
:- func ml_gen_reserved_address(module_info, reserved_address, mlds_type) =
mlds_rval.
- % ml_gen_new_object(MaybeConsId, Tag, HasSecTag, MaybeCtorName, Var,
+ % ml_gen_new_object(MaybeConsId, MaybeCtorName, Tag, HasSecTag, Var,
% ExtraRvals, ExtraTypes, ArgVars, ArgModes, TakeAddr, HowToConstruct,
% Context, Decls, Statements, !Info):
%
@@ -78,9 +78,10 @@
% arguments specify additional constants to insert at the start of the
% argument list.
%
-:- pred ml_gen_new_object(maybe(cons_id)::in, mlds_tag::in, bool::in,
- maybe(ctor_name)::in, prog_var::in, list(mlds_rval)::in,
- list(mlds_type)::in, prog_vars::in, list(uni_mode)::in, list(int)::in,
+:- pred ml_gen_new_object(maybe(cons_id)::in, maybe(ctor_name)::in,
+ mlds_tag::in, bool::in, prog_var::in,
+ list(mlds_rval)::in, list(mlds_type)::in,
+ prog_vars::in, list(uni_mode)::in, list(int)::in,
how_to_construct::in, prog_context::in, list(mlds_defn)::out,
list(statement)::out, ml_gen_info::in, ml_gen_info::out) is det.
@@ -230,8 +231,8 @@
% determinism field in the goal_info is allowed to be a conservative
% approximation, so we need to handle the case were CodeModel is less
% precise than ExpectedCodeModel.
- ml_gen_wrap_goal(CodeModel, ExpectedCodeModel, Context,
- Statements0, Statements, !Info)
+ ml_gen_maybe_convert_goal_code_model(CodeModel, ExpectedCodeModel,
+ Context, Statements0, Statements, !Info)
;
Unification = complicated_unify(_, _, _),
% Simplify.m should have converted these into procedure calls.
@@ -299,7 +300,7 @@
; Tag = unshared_tag(_TagVal)
; Tag = shared_remote_tag(_PrimaryTag, _SecondaryTag)
),
- ml_gen_compound(Tag, ConsId, Var, Args, ArgModes, TakeAddr,
+ ml_gen_compound(ConsId, Tag, Var, Args, ArgModes, TakeAddr,
HowToConstruct, Context, Decls, Statements, !Info)
;
% Constants.
@@ -396,10 +397,10 @@
ml_gen_type(!.Info, VarType, MLDS_VarType),
ml_gen_info_get_globals(!.Info, Globals),
- globals.lookup_bool_option(Globals, highlevel_data, HighLevelData),
+ ml_gen_info_get_high_level_data(!.Info, HighLevelData),
UsesBaseClass = (ml_tag_uses_base_class(Tag) -> yes ; no),
- ConstType = get_type_for_cons_id(MLDS_VarType, UsesBaseClass,
- yes(ConsId), HighLevelData, Globals),
+ ConstType = get_type_for_cons_id(Globals, HighLevelData, MLDS_VarType,
+ UsesBaseClass, yes(ConsId)),
ml_gen_static_const_addr(!.Info, Var, ConstType, ConstAddrRval),
( TagVal = 0 ->
TaggedRval = ConstAddrRval
@@ -554,8 +555,9 @@
MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
TypeCtor = type_ctor(TypeName, TypeArity),
UnqualTypeName = unqualify_name(TypeName),
- MLDS_TypeName = mlds_append_class_qualifier(MLDS_ModuleName,
- module_qual, Globals, UnqualTypeName, TypeArity),
+ globals.get_target(Globals, Target),
+ MLDS_TypeName = mlds_append_class_qualifier(Target,
+ MLDS_ModuleName, module_qual, UnqualTypeName, TypeArity),
Name = ml_format_reserved_object_name(CtorName, CtorArity),
Rval0 = ml_const(mlconst_data_addr(
data_addr(MLDS_TypeName, mlds_data_var(Name)))),
@@ -570,7 +572,6 @@
% optimize downcasts). So we only do it if the back-end
% requires it.
- globals.get_target(Globals, Target),
SupportsInheritance = target_supports_inheritence(Target),
(
SupportsInheritance = yes,
@@ -612,12 +613,12 @@
% Generate code to construct a new object.
%
-:- pred ml_gen_compound(cons_tag::in, cons_id::in, prog_var::in,
+:- pred ml_gen_compound(cons_id::in, cons_tag::in, prog_var::in,
prog_vars::in, list(uni_mode)::in, list(int)::in, how_to_construct::in,
prog_context::in, list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
-ml_gen_compound(Tag, ConsId, Var, ArgVars, ArgModes, TakeAddr,
+ml_gen_compound(ConsId, Tag, Var, ArgVars, ArgModes, TakeAddr,
HowToConstruct, Context, Decls, Statements, !Info) :-
% Get the primary and secondary tags.
( get_primary_tag(Tag) = yes(PrimaryTag0) ->
@@ -627,14 +628,11 @@
),
MaybeSecondaryTag = get_secondary_tag(Tag),
- ml_gen_info_get_module_info(!.Info, ModuleInfo),
- module_info_get_globals(ModuleInfo, Globals),
-
% Figure out which class name to construct.
( ml_tag_uses_base_class(Tag) ->
MaybeCtorName = no
;
- globals.get_target(Globals, CompilationTarget),
+ ml_gen_info_get_target(!.Info, CompilationTarget),
ml_cons_name(CompilationTarget, ConsId, CtorName),
MaybeCtorName = yes(CtorName)
),
@@ -649,7 +647,7 @@
% With the low-level data representation, all fields -- even the
% secondary tag -- are boxed, and so we need box it here.
- globals.lookup_bool_option(Globals, highlevel_data, HighLevelData),
+ ml_gen_info_get_high_level_data(!.Info, HighLevelData),
(
HighLevelData = no,
SecondaryTagRval = ml_unop(box(SecondaryTagType0),
@@ -668,22 +666,17 @@
ExtraRvals = [],
ExtraArgTypes = []
),
- ml_gen_new_object(yes(ConsId), PrimaryTag, HasSecTag, MaybeCtorName,
+ ml_gen_new_object(yes(ConsId), MaybeCtorName, PrimaryTag, HasSecTag,
Var, ExtraRvals, ExtraArgTypes, ArgVars, ArgModes, TakeAddr,
HowToConstruct, Context, Decls, Statements, !Info).
- % ml_gen_new_object: Generate a `new_object' statement, or a static
- % constant, depending on the value of the how_to_construct argument.
- % The `ExtraRvals' and `ExtraTypes' arguments specify additional constants
- % to insert at the start of the argument list.
- %
-ml_gen_new_object(MaybeConsId, Tag, HasSecTag, MaybeCtorName, Var,
+ml_gen_new_object(MaybeConsId, MaybeCtorName, Tag, HasSecTag, Var,
ExtraRvals, ExtraTypes, ArgVars, ArgModes, TakeAddr, HowToConstruct,
Context, Decls, Statements, !Info) :-
% Determine the variable's type and lval, the tag to use, and the types
% of the argument vars.
- ml_variable_type(!.Info, Var, Type),
- ml_gen_type(!.Info, Type, MLDS_Type),
+ ml_variable_type(!.Info, Var, VarType),
+ ml_gen_type(!.Info, VarType, MLDS_Type),
ml_gen_var(!.Info, Var, VarLval),
( Tag = 0 ->
MaybeTag = no
@@ -694,12 +687,46 @@
(
HowToConstruct = construct_dynamically,
+ ml_gen_new_object_dynamically(MaybeConsId, MaybeCtorName,
+ MaybeTag, HasSecTag, Var, VarLval, VarType, MLDS_Type,
+ ExtraRvals, ExtraTypes, ArgVars, ArgTypes, ArgModes, TakeAddr,
+ Context, Statements, !Info),
+ Decls = []
+ ;
+ HowToConstruct = construct_statically(StaticArgs),
+ expect(unify(TakeAddr, []), this_file,
+ "ml_gen_new_object: cannot take address of static object's field"),
+ ml_gen_new_object_statically(MaybeConsId, MaybeCtorName, MaybeTag,
+ Var, VarLval, VarType, MLDS_Type, ExtraRvals, ExtraTypes,
+ ArgVars, ArgTypes, StaticArgs, Context, Decls, Statements, !Info)
+ ;
+ HowToConstruct = reuse_cell(CellToReuse),
+ ml_gen_new_object_reuse_cell(MaybeConsId, MaybeCtorName, Tag, MaybeTag,
+ HasSecTag, Var, VarLval, VarType, MLDS_Type,
+ ExtraRvals, ExtraTypes, ArgVars, ArgTypes, ArgModes, TakeAddr,
+ CellToReuse, Context, Statements, !Info),
+ Decls = []
+ ;
+ HowToConstruct = construct_in_region(_RegVar),
+ sorry(this_file, "ml_gen_new_object: construct_in_region NYI")
+ ).
+
+:- pred ml_gen_new_object_dynamically(maybe(cons_id)::in, maybe(ctor_name)::in,
+ maybe(mlds_tag)::in, bool::in, prog_var::in, mlds_lval::in, mer_type::in,
+ mlds_type::in, list(mlds_rval)::in, list(mlds_type)::in,
+ list(prog_var)::in, list(mer_type)::in, list(uni_mode)::in,
+ list(int)::in, prog_context::in, list(statement)::out,
+ ml_gen_info::in, ml_gen_info::out) is det.
+
+ml_gen_new_object_dynamically(MaybeConsId, MaybeCtorName, MaybeTag, HasSecTag,
+ _Var, VarLval, VarType, MLDS_Type, ExtraRvals, ExtraTypes,
+ ArgVars, ArgTypes, ArgModes, TakeAddr, Context, Statements, !Info) :-
% Find out the types of the constructor arguments and generate rvals
% for them (boxing/unboxing if needed).
ml_gen_var_list(!.Info, ArgVars, ArgLvals),
ml_gen_info_get_module_info(!.Info, ModuleInfo),
- get_maybe_cons_id_arg_types(MaybeConsId, ArgTypes, Type,
- ModuleInfo, ConsArgTypes),
+ get_maybe_cons_id_arg_types(ModuleInfo, MaybeConsId, ArgTypes, VarType,
+ ConsArgTypes),
FirstOffset = length(ExtraRvals),
module_info_get_globals(ModuleInfo, Globals),
globals.lookup_bool_option(Globals, use_atomic_cells, UseAtomicCells),
@@ -733,18 +760,26 @@
ml_gen_field_take_address_assigns(TakeAddrInfos, VarLval, MLDS_Type,
MaybeTag, Context, !.Info, TakeAddrStatements),
- Statements = [Statement | TakeAddrStatements],
- Decls = []
- ;
- HowToConstruct = construct_statically(StaticArgs),
- expect(unify(TakeAddr, []), this_file,
- "ml_gen_new_object: cannot take address of static object's field"),
+ Statements = [Statement | TakeAddrStatements].
+
+:- pred ml_gen_new_object_statically(maybe(cons_id)::in, maybe(ctor_name)::in,
+ maybe(mlds_tag)::in,
+ prog_var::in, mlds_lval::in, mer_type::in, mlds_type::in,
+ list(mlds_rval)::in, list(mlds_type)::in,
+ list(prog_var)::in, list(mer_type)::in, list(static_cons)::in,
+ prog_context::in, list(mlds_defn)::out, list(statement)::out,
+ ml_gen_info::in, ml_gen_info::out) is det.
+ml_gen_new_object_statically(MaybeConsId, MaybeCtorName, MaybeTag,
+ Var, VarLval, VarType, MLDS_Type, ExtraRvals, ExtraTypes,
+ ArgVars, ArgTypes, StaticArgs, Context, Decls, Statements, !Info) :-
% Find out the types of the constructor arguments.
ml_gen_info_get_module_info(!.Info, ModuleInfo),
- get_maybe_cons_id_arg_types(MaybeConsId, ArgTypes, Type,
- ModuleInfo, ConsArgTypes),
- list.map(ml_gen_field_type(!.Info), ConsArgTypes, FieldTypes),
+ ml_gen_info_get_high_level_data(!.Info, HighLevelData),
+ get_maybe_cons_id_arg_types(ModuleInfo, MaybeConsId, ArgTypes, VarType,
+ ConsArgTypes),
+ list.map(ml_type_as_field(ModuleInfo, HighLevelData),
+ ConsArgTypes, FieldTypes),
% Generate rvals for the arguments.
list.map(ml_gen_type(!.Info), ArgTypes, MLDS_ArgTypes0),
@@ -753,8 +788,6 @@
% Box or unbox the arguments, if needed, and insert the extra rvals
% at the start.
- ml_gen_info_get_globals(!.Info, Globals),
- globals.lookup_bool_option(Globals, highlevel_data, HighLevelData),
(
HighLevelData = no,
% Box *all* the arguments, including the ExtraRvals.
@@ -781,8 +814,9 @@
MaybeCtorName = no,
UsesBaseClass = yes
),
- ConstType = get_type_for_cons_id(MLDS_Type, UsesBaseClass,
- MaybeConsId, HighLevelData, Globals),
+ module_info_get_globals(ModuleInfo, Globals),
+ ConstType = get_type_for_cons_id(Globals, HighLevelData, MLDS_Type,
+ UsesBaseClass, MaybeConsId),
% XXX If the secondary tag is in a base class, then ideally its
% initializer should be wrapped in `init_struct([init_obj(X)])'
% rather than just `init_obj(X)' -- the fact that we don't leads to
@@ -797,20 +831,39 @@
acc_local, Initializer, Context),
% Assign the address of the local static constant to the variable.
+ %
+ % Any later references to Var in later code on the right hand side of
+ % another construct_statically construction unification will refer to
+ % ConstDefn, not to VarLval. If the only later references to Var
+ % are in such places, then the definition of VarLval and AssignStatement
+ % are both useless, and can be deleted without harm. Unfortunately,
+ % at this point in the code generation process, we do not know if
+ % there are any other kinds of references to Var later on.
ml_gen_static_const_addr(!.Info, Var, ConstType, ConstAddrRval),
(
MaybeTag = no,
TaggedRval = ConstAddrRval
;
- MaybeTag = yes(_),
+ MaybeTag = yes(Tag),
TaggedRval = ml_mkword(Tag, ConstAddrRval)
),
Rval = ml_unop(cast(MLDS_Type), TaggedRval),
AssignStatement = ml_gen_assign(VarLval, Rval, Context),
Decls = StaticArgDefns ++ BoxConstDefns ++ [ConstDefn],
- Statements = [AssignStatement]
- ;
- HowToConstruct = reuse_cell(CellToReuse),
+ Statements = [AssignStatement].
+
+:- pred ml_gen_new_object_reuse_cell(maybe(cons_id)::in, maybe(ctor_name)::in,
+ mlds_tag::in, maybe(mlds_tag)::in, bool::in,
+ prog_var::in, mlds_lval::in, mer_type::in, mlds_type::in,
+ list(mlds_rval)::in, list(mlds_type)::in,
+ list(prog_var)::in, list(mer_type)::in, list(uni_mode)::in,
+ list(int)::in, cell_to_reuse::in, prog_context::in,
+ list(statement)::out, ml_gen_info::in, ml_gen_info::out) is det.
+
+ml_gen_new_object_reuse_cell(MaybeConsId, MaybeCtorName, Tag, MaybeTag,
+ HasSecTag, Var, VarLval, VarType, MLDS_Type, ExtraRvals, ExtraTypes,
+ ArgVars, ArgTypes, ArgModes, TakeAddr, CellToReuse, Context,
+ Statements, !Info) :-
CellToReuse = cell_to_reuse(ReuseVar, ReuseConsIds, _),
(
MaybeConsId = yes(ConsId0),
@@ -828,7 +881,7 @@
list.remove_dups(ReusePrimaryTags0, ReusePrimaryTags),
ml_cons_id_to_tag(!.Info, ConsId, ConsIdTag),
- ml_field_names_and_types(!.Info, Type, ConsId, ArgTypes, Fields),
+ ml_field_names_and_types(!.Info, VarType, ConsId, ArgTypes, Fields),
ml_tag_offset_and_argnum(ConsIdTag, PrimaryTag, OffSet, ArgNum),
ml_gen_var(!.Info, Var, Var1Lval),
@@ -855,48 +908,40 @@
ml_unop(std_unop(strip_tag), ml_lval(Var2Lval)))
),
- ml_gen_type(!.Info, Type, MLDS_DestType),
- CastVar2Rval = ml_unop(cast(MLDS_DestType), Var2Rval),
+ CastVar2Rval = ml_unop(cast(MLDS_Type), Var2Rval),
MLDS_Context = mlds_make_context(Context),
- AssignStatement = statement(
- ml_stmt_atomic(assign_if_in_heap(Var1Lval, CastVar2Rval)),
- MLDS_Context),
+ HeapTestStmt = ml_stmt_atomic(assign_if_in_heap(Var1Lval, CastVar2Rval)),
+ HeapTestStatement = statement(HeapTestStmt, MLDS_Context),
% For each field in the construction unification we need to generate
% an rval. ExtraRvals need to be inserted at the start of the object.
- ml_gen_extra_arg_assign(ExtraRvals, ExtraTypes, Type, VarLval,
+ ml_gen_extra_arg_assign(ExtraRvals, ExtraTypes, VarType, VarLval,
0, ConsIdTag, Context, ExtraRvalStatements, !Info),
% XXX we do more work than we need to here, as some of the cells
% may already contain the correct values.
ml_gen_unify_args_for_reuse(ConsId, ArgVars, ArgModes, ArgTypes,
- Fields, TakeAddr, Type, VarLval, OffSet, ArgNum, ConsIdTag,
+ Fields, TakeAddr, VarType, VarLval, OffSet, ArgNum, ConsIdTag,
Context, FieldStatements, TakeAddrInfos, !Info),
ml_gen_field_take_address_assigns(TakeAddrInfos, VarLval, MLDS_Type,
MaybeTag, Context, !.Info, TakeAddrStatements),
- IfBody = statement(ml_stmt_block([],
- ExtraRvalStatements ++ FieldStatements ++ TakeAddrStatements),
- MLDS_Context),
+ ThenStatements =
+ ExtraRvalStatements ++ FieldStatements ++ TakeAddrStatements,
+ ThenStmt = ml_stmt_block([], ThenStatements),
+ ThenStatement = statement(ThenStmt, MLDS_Context),
% If the reassignment isn't possible because the target is statically
% allocated then fall back to dynamic allocation.
- ml_gen_new_object(MaybeConsId, Tag, HasSecTag, MaybeCtorName, Var,
+ ml_gen_new_object(MaybeConsId, MaybeCtorName, Tag, HasSecTag, Var,
ExtraRvals, ExtraTypes, ArgVars, ArgModes, TakeAddr,
construct_dynamically, Context, DynamicDecls, DynamicStmts, !Info),
- IfElse = statement(
- ml_stmt_block(DynamicDecls, DynamicStmts),
- MLDS_Context),
-
- IfStatement = statement(
- ml_stmt_if_then_else(ml_lval(Var1Lval), IfBody, yes(IfElse)),
- mlds_make_context(Context)),
+ ElseStmt = ml_stmt_block(DynamicDecls, DynamicStmts),
+ ElseStatement = statement(ElseStmt, MLDS_Context),
- Statements = [AssignStatement, IfStatement],
- Decls = []
- ;
- HowToConstruct = construct_in_region(_RegVar),
- sorry(this_file, "ml_gen_new_object: " ++
- "implementation for construct_in_region is not available")
- ).
+ IfStmt = ml_stmt_if_then_else(ml_lval(Var1Lval), ThenStatement,
+ yes(ElseStatement)),
+ IfStatement = statement(IfStmt, mlds_make_context(Context)),
+
+ Statements = [HeapTestStatement, IfStatement].
:- pred ml_gen_field_take_address_assigns(list(take_addr_info)::in,
mlds_lval::in, mlds_type::in, maybe(mlds_tag)::in, prog_context::in,
@@ -924,11 +969,11 @@
% Return the MLDS type suitable for constructing a constant static
% ground term with the specified cons_id.
%
-:- func get_type_for_cons_id(mlds_type, bool, maybe(cons_id), bool,
- globals) = mlds_type.
+:- func get_type_for_cons_id(globals, bool, mlds_type, bool, maybe(cons_id))
+ = mlds_type.
-get_type_for_cons_id(MLDS_Type, UsesBaseClass, MaybeConsId, HighLevelData,
- Globals) = ConstType :-
+get_type_for_cons_id(Globals, HighLevelData, MLDS_Type, UsesBaseClass,
+ MaybeConsId) = ConstType :-
(
HighLevelData = no,
ConstType = mlds_array_type(mlds_generic_type)
@@ -961,13 +1006,13 @@
% If so, append the name of the derived class to the name of the
% base class for this type (since the derived class will also be
% nested inside the base class).
- globals.get_target(Globals, CompilationTarget),
+ globals.get_target(Globals, Target),
QualTypeName = qual(_, _, UnqualTypeName),
- CtorName = ml_gen_du_ctor_name_unqual_type(CompilationTarget,
- UnqualTypeName, TypeArity, CtorSymName, CtorArity),
+ CtorName = ml_gen_du_ctor_name_unqual_type(Target, UnqualTypeName,
+ TypeArity, CtorSymName, CtorArity),
QualTypeName = qual(MLDS_Module, _QualKind, TypeName),
- ClassQualifier = mlds_append_class_qualifier(MLDS_Module,
- module_qual, Globals, TypeName, TypeArity),
+ ClassQualifier = mlds_append_class_qualifier(Target, MLDS_Module,
+ module_qual, TypeName, TypeArity),
ConstType = mlds_class_type(
qual(ClassQualifier, type_qual, CtorName),
CtorArity, mlds_class)
@@ -1001,19 +1046,10 @@
)
).
-:- pred ml_gen_field_type(ml_gen_info::in, mer_type::in, mer_type::out)
- is det.
-
-ml_gen_field_type(Info, Type, FieldType) :-
- ml_gen_info_get_module_info(Info, ModuleInfo),
- module_info_get_globals(ModuleInfo, Globals),
- globals.lookup_bool_option(Globals, highlevel_data, HighLevelData),
- ml_type_as_field(Type, ModuleInfo, HighLevelData, FieldType).
-
-:- pred ml_type_as_field(mer_type::in, module_info::in, bool::in,
- mer_type::out) is det.
+:- pred ml_type_as_field(module_info::in, bool::in,
+ mer_type::in, mer_type::out) is det.
-ml_type_as_field(FieldType, ModuleInfo, HighLevelData, BoxedFieldType) :-
+ml_type_as_field(ModuleInfo, HighLevelData, FieldType, BoxedFieldType) :-
(
% With the low-level data representation, we store all fields as boxed,
% so we ignore the original field type and instead generate a
@@ -1030,9 +1066,12 @@
HighLevelData = no
;
HighLevelData = yes,
- ml_must_box_field_type(FieldType, ModuleInfo)
+ ml_must_box_field_type(ModuleInfo, FieldType)
)
->
+ % XXX zs: I do not see any reason why TypeVar cannot be confused with
+ % other type variables (whether constructed the same way or not),
+ % nor do I see any reason why such confusion would not lead to errors.
varset.init(TypeVarSet0),
varset.new_var(TypeVarSet0, TypeVar, _TypeVarSet),
% The kind is `star' since there are values with this type.
@@ -1041,40 +1080,32 @@
BoxedFieldType = FieldType
).
-:- pred get_maybe_cons_id_arg_types(maybe(cons_id)::in,
- list(mer_type)::in, mer_type::in, module_info::in, list(mer_type)::out)
+:- pred get_maybe_cons_id_arg_types(module_info::in, maybe(cons_id)::in,
+ list(mer_type)::in, mer_type::in, list(mer_type)::out)
is det.
-get_maybe_cons_id_arg_types(MaybeConsId, ArgTypes, Type, ModuleInfo,
+get_maybe_cons_id_arg_types(ModuleInfo, MaybeConsId, ArgTypes, Type,
ConsArgTypes) :-
(
MaybeConsId = yes(ConsId),
- ConsArgTypes = constructor_arg_types(ConsId, ArgTypes, Type,
- ModuleInfo)
+ ConsArgTypes =
+ constructor_arg_types(ModuleInfo, ConsId, ArgTypes, Type)
;
MaybeConsId = no,
% It's a closure. In this case, the arguments are all boxed.
ConsArgTypes = ml_make_boxed_types(list.length(ArgTypes))
).
-:- func constructor_arg_types(cons_id, list(mer_type), mer_type,
- module_info) = list(mer_type).
+:- func constructor_arg_types(module_info, cons_id, list(mer_type), mer_type)
+ = list(mer_type).
-constructor_arg_types(ConsId, ArgTypes, Type, ModuleInfo) = ConsArgTypes :-
+constructor_arg_types(ModuleInfo, ConsId, ArgTypes, Type) = ConsArgTypes :-
(
ConsId = cons(_, _, _),
\+ is_introduced_type_info_type(Type)
->
- % Use the type to determine the type_ctor
- ( type_to_ctor_and_args(Type, TypeCtor0, _) ->
- TypeCtor = TypeCtor0
- ;
- % The type-checker should ensure that this never happens:
- % the type for a ctor_id should never be a free type variable.
- unexpected(this_file, "constructor_arg_types: invalid type")
- ),
-
- % Given the type_ctor, lookup up the constructor.
+ % Determine the type_ctor, and then look up the data constructor.
+ type_to_ctor_det(Type, TypeCtor),
(
type_util.get_cons_defn(ModuleInfo, TypeCtor, ConsId, ConsDefn)
->
@@ -1208,13 +1239,13 @@
)
->
% Generate a local static constant for this float.
- ml_gen_info_new_const(SequenceNum, !Info),
+ ml_gen_info_new_const(const_seq(ConstSeqNum), !Info),
ml_gen_info_get_pred_id(!.Info, PredId),
ml_gen_info_get_proc_id(!.Info, ProcId),
pred_id_to_int(PredId, PredIdNum),
proc_id_to_int(ProcId, ProcIdNum),
ConstName = mlds_var_name(string.format("float_%d_%d_%d",
- [i(PredIdNum), i(ProcIdNum), i(SequenceNum)]), no),
+ [i(PredIdNum), i(ProcIdNum), i(ConstSeqNum)]), no),
Initializer = init_obj(Rval),
ConstDefn = ml_gen_static_const_defn(ConstName, Type,
acc_local, Initializer, Context),
@@ -1252,19 +1283,13 @@
:- pred ml_gen_static_const_name(prog_var::in, mlds_var_name::out,
ml_gen_info::in, ml_gen_info::out) is det.
-ml_gen_static_const_name(Var, ConstName, !Info) :-
+ml_gen_static_const_name(Var, ConstVarName, !Info) :-
ml_gen_info_new_const(SequenceNum, !Info),
ml_gen_info_get_varset(!.Info, VarSet),
VarName = ml_gen_var_name(VarSet, Var),
- ml_format_static_const_name(!.Info, ml_var_name_to_string(VarName),
- SequenceNum, ConstName),
- ml_gen_info_set_const_var_name(Var, ConstName, !Info).
-
-:- pred ml_lookup_static_const_name(ml_gen_info::in, prog_var::in,
- mlds_var_name::out) is det.
-
-ml_lookup_static_const_name(Info, Var, ConstName) :-
- ml_gen_info_lookup_const_var_name(Info, Var, ConstName).
+ ml_format_static_const_var_name(!.Info, ml_var_name_to_string(VarName),
+ SequenceNum, ConstVarName),
+ ml_gen_info_set_const_var_name(Var, ConstVarName, !Info).
% Generate an rval containing the address of the local static constant
% for a given variable.
@@ -1273,7 +1298,7 @@
mlds_type::in, mlds_rval::out) is det.
ml_gen_static_const_addr(Info, Var, Type, ConstAddrRval) :-
- ml_lookup_static_const_name(Info, Var, ConstName),
+ ml_gen_info_lookup_const_var_name(Info, Var, ConstName),
ml_gen_var_lval(Info, ConstName, Type, ConstLval),
ConstAddrRval = ml_mem_addr(ConstLval).
@@ -1355,9 +1380,8 @@
% Figure out the type of the field. Note that for the MLDS->C and
% MLDS->asm back-ends, we need to box floating point fields.
- module_info_get_globals(ModuleInfo, Globals),
- globals.lookup_bool_option(Globals, highlevel_data, HighLevelData),
- ml_type_as_field(ConsArgType, ModuleInfo, HighLevelData, BoxedArgType),
+ ml_gen_info_get_high_level_data(!.Info, HighLevelData),
+ ml_type_as_field(ModuleInfo, HighLevelData, ConsArgType, BoxedArgType),
MLDS_Type = mercury_type_to_mlds_type(ModuleInfo, BoxedArgType),
% Compute the value of the field.
@@ -1407,15 +1431,9 @@
ml_gen_extra_arg_assign([ExtraRval | ExtraRvals], [ExtraType | ExtraTypes],
VarType, VarLval, Offset, ConsIdTag, Context,
[Statement | Statements], !Info) :-
- ml_gen_info_get_module_info(!.Info, ModuleInfo),
- module_info_get_globals(ModuleInfo, Globals),
- globals.lookup_bool_option(Globals, highlevel_data, HighLevelData),
- (
- HighLevelData = no
- ;
- HighLevelData = yes,
- sorry(this_file, "ml_gen_extra_arg_assign: high-level data")
- ),
+ ml_gen_info_get_high_level_data(!.Info, HighLevelData),
+ expect(unify(HighLevelData, no), this_file,
+ "ml_gen_extra_arg_assign: high-level data"),
ml_gen_type(!.Info, VarType, MLDS_VarType),
FieldId = ml_field_offset(ml_const(mlconst_int(Offset))),
@@ -1660,9 +1678,8 @@
FieldType = Field ^ arg_type,
ml_gen_info_get_module_info(!.Info, ModuleInfo),
- module_info_get_globals(ModuleInfo, Globals),
- globals.lookup_bool_option(Globals, highlevel_data, HighLevelData),
- ml_type_as_field(FieldType, ModuleInfo, HighLevelData,
+ ml_gen_info_get_high_level_data(!.Info, HighLevelData),
+ ml_type_as_field(ModuleInfo, HighLevelData, FieldType,
BoxedFieldType),
ml_gen_type(!.Info, FieldType, MLDS_FieldType),
ml_gen_type(!.Info, BoxedFieldType, MLDS_BoxedFieldType),
@@ -1691,9 +1708,7 @@
Offset, ArgNum, Tag, Context, !Statements, !Info) :-
MaybeFieldName = Field ^ arg_field_name,
FieldType = Field ^ arg_type,
- ml_gen_info_get_module_info(!.Info, ModuleInfo),
- module_info_get_globals(ModuleInfo, Globals),
- globals.lookup_bool_option(Globals, highlevel_data, HighLevelData),
+ ml_gen_info_get_high_level_data(!.Info, HighLevelData),
(
% With the low-level data representation, we access all fields
% using offsets.
@@ -1703,7 +1718,7 @@
% With the high-level data representation, we always use named fields,
% except for tuple types.
HighLevelData = yes,
- globals.get_target(Globals, Target),
+ ml_gen_info_get_target(!.Info, Target),
(
( type_is_tuple(VarType, _)
; type_needs_lowlevel_rep(Target, VarType)
@@ -1713,19 +1728,18 @@
;
FieldName = ml_gen_field_name(MaybeFieldName, ArgNum),
( ConsId = cons(ConsName, ConsArity, TypeCtor) ->
- globals.get_target(Globals, CompilationTarget),
- UnqualConsName = ml_gen_du_ctor_name(CompilationTarget,
- TypeCtor, ConsName, ConsArity),
- FieldId = ml_gen_field_id(VarType, Tag, UnqualConsName,
- ConsArity, FieldName, Globals)
+ UnqualConsName = ml_gen_du_ctor_name(Target, TypeCtor,
+ ConsName, ConsArity),
+ FieldId = ml_gen_field_id(Target, VarType, Tag, UnqualConsName,
+ ConsArity, FieldName)
;
unexpected(this_file, "ml_gen_unify_arg: invalid cons_id")
)
)
),
% Box the field type, if needed.
- ml_type_as_field(FieldType, ModuleInfo, HighLevelData,
- BoxedFieldType),
+ ml_gen_info_get_module_info(!.Info, ModuleInfo),
+ ml_type_as_field(ModuleInfo, HighLevelData, FieldType, BoxedFieldType),
% Generate lvals for the LHS and the RHS.
ml_gen_type(!.Info, VarType, MLDS_VarType),
@@ -1910,8 +1924,8 @@
TagTestRval = ml_binop(eq, RvalTag, UnsharedTag)
;
Tag = shared_remote_tag(PrimaryTagNum, SecondaryTagNum),
- SecondaryTagField = ml_gen_secondary_tag_rval(PrimaryTagNum, Type,
- ModuleInfo, Rval),
+ SecondaryTagField = ml_gen_secondary_tag_rval(ModuleInfo,
+ PrimaryTagNum, Type, Rval),
SecondaryTagTestRval = ml_binop(eq, SecondaryTagField,
ml_const(mlconst_int(SecondaryTagNum))),
module_info_get_globals(ModuleInfo, Globals),
@@ -1954,12 +1968,7 @@
MatchesThisTag)
).
- % ml_gen_secondary_tag_rval(PrimaryTag, VarType, ModuleInfo, VarRval):
- %
- % Return the rval for the secondary tag field of VarRval, assuming that
- % VarRval has the specified VarType and PrimaryTag.
- %
-ml_gen_secondary_tag_rval(PrimaryTagVal, VarType, ModuleInfo, Rval) =
+ml_gen_secondary_tag_rval(ModuleInfo, PrimaryTagVal, VarType, Rval) =
SecondaryTagField :-
MLDS_VarType = mercury_type_to_mlds_type(ModuleInfo, VarType),
module_info_get_globals(ModuleInfo, Globals),
@@ -1979,7 +1988,7 @@
ml_field_offset(ml_const(mlconst_int(0))),
mlds_generic_type, MLDS_VarType)))
;
- FieldId = ml_gen_hl_tag_field_id(VarType, ModuleInfo),
+ FieldId = ml_gen_hl_tag_field_id(ModuleInfo, VarType),
SecondaryTagField = ml_lval(ml_field(yes(PrimaryTagVal), Rval,
FieldId, mlds_native_int_type, MLDS_VarType))
).
@@ -1987,20 +1996,22 @@
% Return the field_id for the "data_tag" field of the specified
% Mercury type, which holds the secondary tag.
%
-:- func ml_gen_hl_tag_field_id(mer_type, module_info) = mlds_field_id.
+:- func ml_gen_hl_tag_field_id(module_info, mer_type) = mlds_field_id.
-ml_gen_hl_tag_field_id(Type, ModuleInfo) = FieldId :-
+ml_gen_hl_tag_field_id(ModuleInfo, Type) = FieldId :-
FieldName = "data_tag",
% Figure out the type name and arity.
type_to_ctor_and_args_det(Type, TypeCtor, _),
ml_gen_type_name(TypeCtor, QualifiedTypeName, TypeArity),
QualifiedTypeName = qual(MLDS_Module, TypeQualKind, TypeName),
+ module_info_get_globals(ModuleInfo, Globals),
+ globals.get_target(Globals, Target),
+
% Figure out whether this type has constructors both with and without
% secondary tags. If so, then the secondary tag field is in a class
% "tag_type" that is derived from the base class for this type,
% rather than in the base class itself.
- module_info_get_globals(ModuleInfo, Globals),
module_info_get_type_table(ModuleInfo, TypeTable),
TypeDefn = map.lookup(TypeTable, TypeCtor),
hlds_data.get_type_defn_body(TypeDefn, TypeDefnBody),
@@ -2018,8 +2029,8 @@
\+ ml_uses_secondary_tag(TypeCtor, TagValues, Ctor, _)
)
->
- ClassQualifier = mlds_append_class_qualifier(MLDS_Module,
- module_qual, Globals, TypeName, TypeArity),
+ ClassQualifier = mlds_append_class_qualifier(Target, MLDS_Module,
+ module_qual, TypeName, TypeArity),
ClassQualKind = TypeQualKind,
ClassName = "tag_type",
ClassArity = 0
@@ -2042,21 +2053,20 @@
QualClassName = qual(ClassQualifier, ClassQualKind, ClassName),
ClassPtrType = mlds_ptr_type(mlds_class_type(QualClassName, ClassArity,
mlds_class)),
- FieldQualifier = mlds_append_class_qualifier(ClassQualifier,
- ClassQualKind, Globals, ClassName, ClassArity),
+ FieldQualifier = mlds_append_class_qualifier(Target, ClassQualifier,
+ ClassQualKind, ClassName, ClassArity),
QualifiedFieldName = qual(FieldQualifier, type_qual, FieldName),
FieldId = ml_field_named(QualifiedFieldName, ClassPtrType).
-:- func ml_gen_field_id(mer_type, cons_tag, mlds_class_name, arity,
- mlds_field_name, globals) = mlds_field_id.
+:- func ml_gen_field_id(compilation_target, mer_type, cons_tag,
+ mlds_class_name, arity, mlds_field_name) = mlds_field_id.
-ml_gen_field_id(Type, Tag, ConsName, ConsArity, FieldName, Globals)
- = FieldId :-
+ml_gen_field_id(Target, Type, Tag, ConsName, ConsArity, FieldName) = FieldId :-
type_to_ctor_and_args_det(Type, TypeCtor, _),
ml_gen_type_name(TypeCtor, QualTypeName, TypeArity),
QualTypeName = qual(MLDS_Module, QualKind, TypeName),
- TypeQualifier = mlds_append_class_qualifier(
- MLDS_Module, QualKind, Globals, TypeName, TypeArity),
+ TypeQualifier = mlds_append_class_qualifier(Target, MLDS_Module, QualKind,
+ TypeName, TypeArity),
( ml_tag_uses_base_class(Tag) ->
% In this case, there's only one functor for the type (other than
@@ -2070,8 +2080,8 @@
QualConsName = qual(TypeQualifier, type_qual, ConsName),
ClassPtrType = mlds_ptr_type(mlds_class_type(QualConsName,
ConsArity, mlds_class)),
- FieldQualifier = mlds_append_class_qualifier(TypeQualifier,
- type_qual, Globals, ConsName, ConsArity),
+ FieldQualifier = mlds_append_class_qualifier(Target, TypeQualifier,
+ type_qual, ConsName, ConsArity),
QualifiedFieldName = qual(FieldQualifier, type_qual, FieldName)
),
FieldId = ml_field_named(QualifiedFieldName, ClassPtrType).
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.171
diff -u -b -r1.171 mlds.m
--- compiler/mlds.m 17 Jun 2009 07:48:14 -0000 1.171
+++ compiler/mlds.m 18 Aug 2009 10:14:35 -0000
@@ -464,8 +463,8 @@
% The qual_kind argument specifies the qualifier kind of the module_name
% argument.
%
-:- func mlds_append_class_qualifier(mlds_module_name, mlds_qual_kind,
- globals, mlds_class_name, arity) = mlds_module_name.
+:- func mlds_append_class_qualifier(compilation_target, mlds_module_name,
+ mlds_qual_kind, mlds_class_name, arity) = mlds_module_name.
% Append a wrapper class qualifier to the module name and leave the
% package name unchanged.
@@ -1929,53 +1928,51 @@
% :- type mlds_module_name == prim_data.module_name.
:- type mlds_module_name
- ---> name(
- package_name :: prim_data.module_name,
- module_name :: prim_data.module_name
+ ---> mlds_module_name(
+ mmn_package_name :: prim_data.module_name,
+ mmn_module_name :: prim_data.module_name
).
mercury_module_and_package_name_to_mlds(MLDS_Package, MercuryModule)
- = name(MLDS_Package, MercuryModule).
+ = mlds_module_name(MLDS_Package, MercuryModule).
-mercury_module_name_to_mlds(MercuryModule)
- = name(MLDS_Package, MLDS_Package) :-
- (
- mercury_std_library_module_name(MercuryModule)
- ->
+mercury_module_name_to_mlds(MercuryModule) = Name :-
+ ( mercury_std_library_module_name(MercuryModule) ->
MLDS_Package = add_outermost_qualifier("mercury", MercuryModule)
;
MLDS_Package = MercuryModule
- ).
+ ),
+ Name = mlds_module_name(MLDS_Package, MLDS_Package).
is_std_lib_module(Module, Name) :-
- Name0 = Module ^ module_name,
+ Name0 = Module ^ mmn_module_name,
strip_outermost_qualifier(Name0, "mercury", Name),
mercury_std_library_module_name(Name).
-mlds_module_name_to_sym_name(Module) = Module ^ module_name.
+mlds_module_name_to_sym_name(Module) = Module ^ mmn_module_name.
-mlds_module_name_to_package_name(Module) = Module ^ package_name.
+mlds_module_name_to_package_name(Module) = Module ^ mmn_package_name.
-mlds_append_class_qualifier(name(Package, Module), QualKind, Globals,
- ClassName, ClassArity) =
- name(Package, qualified(AdjustedModule, ClassQualifier)) :-
+mlds_append_class_qualifier(Target, mlds_module_name(Package, Module),
+ QualKind, ClassName, ClassArity) = Name :-
% For the Java back-end, we flip the initial case of an type qualifiers,
% in order to match the usual Java conventions.
(
- globals.get_target(Globals, CompilationTarget),
- CompilationTarget = target_java,
+ Target = target_java,
QualKind = type_qual
->
AdjustedModule = flip_initial_case_of_final_part(Module)
;
AdjustedModule = Module
),
- string.format("%s_%d", [s(ClassName), i(ClassArity)], ClassQualifier).
+ string.format("%s_%d", [s(ClassName), i(ClassArity)], ClassQualifier),
+ Name = mlds_module_name(Package,
+ qualified(AdjustedModule, ClassQualifier)).
mlds_append_wrapper_class(Name) = mlds_append_name(Name, wrapper_class_name).
-mlds_append_name(name(Package, Module), Name)
- = name(Package, qualified(Module, Name)).
+mlds_append_name(mlds_module_name(Package, Module), Name)
+ = mlds_module_name(Package, qualified(Module, Name)).
wrapper_class_name = "mercury_code".
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.237
diff -u -b -r1.237 mlds_to_c.m
--- compiler/mlds_to_c.m 19 Aug 2009 07:44:55 -0000 1.237
+++ compiler/mlds_to_c.m 19 Aug 2009 07:47:07 -0000
@@ -1535,8 +1535,9 @@
(
UnqualName = entity_type(ClassName, ClassArity),
globals.io_get_globals(Globals, !IO),
- ClassModuleName = mlds_append_class_qualifier(ModuleName,
- QualKind, Globals, ClassName, ClassArity)
+ globals.get_target(Globals, Target),
+ ClassModuleName = mlds_append_class_qualifier(Target, ModuleName,
+ QualKind, ClassName, ClassArity)
;
( UnqualName = entity_data(_)
; UnqualName = entity_function(_, _, _, _)
Index: compiler/mlds_to_gcc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_gcc.m,v
retrieving revision 1.143
diff -u -b -r1.143 mlds_to_gcc.m
--- compiler/mlds_to_gcc.m 10 Jun 2009 06:26:21 -0000 1.143
+++ compiler/mlds_to_gcc.m 18 Aug 2009 10:14:35 -0000
@@ -1294,8 +1294,9 @@
{ Name = qual(ModuleName, QualKind, UnqualName) },
globals__io_get_globals(Globals),
{ UnqualName = entity_type(ClassName, ClassArity) ->
- ClassModuleName = mlds_append_class_qualifier(ModuleName,
- QualKind, Globals, ClassName, ClassArity)
+ globals.get_target(Globals, Target),
+ ClassModuleName = mlds_append_class_qualifier(Target, ModuleName,
+ QualKind, ClassName, ClassArity)
;
unexpected(this_file, "mlds_output_enum_constants")
},
cvs diff: Diffing compiler/notes
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/base64
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/fixed
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_allegro
cvs diff: Diffing extras/graphics/mercury_allegro/examples
cvs diff: Diffing extras/graphics/mercury_allegro/samples
cvs diff: Diffing extras/graphics/mercury_allegro/samples/demo
cvs diff: Diffing extras/graphics/mercury_allegro/samples/mandel
cvs diff: Diffing extras/graphics/mercury_allegro/samples/pendulum2
cvs diff: Diffing extras/graphics/mercury_allegro/samples/speed
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/log4m
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/mopenssl
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/net
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/posix/samples
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/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
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
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/c_interface/standalone_c
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/solver_types
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 ssdb
cvs diff: Diffing tests
cvs diff: Diffing tests/analysis
cvs diff: Diffing tests/analysis/ctgc
cvs diff: Diffing tests/analysis/excp
cvs diff: Diffing tests/analysis/ext
cvs diff: Diffing tests/analysis/sharing
cvs diff: Diffing tests/analysis/table
cvs diff: Diffing tests/analysis/trail
cvs diff: Diffing tests/analysis/unused_args
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/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/stm
cvs diff: Diffing tests/stm/orig
cvs diff: Diffing tests/stm/orig/stm-compiler
cvs diff: Diffing tests/stm/orig/stm-compiler/test1
cvs diff: Diffing tests/stm/orig/stm-compiler/test10
cvs diff: Diffing tests/stm/orig/stm-compiler/test2
cvs diff: Diffing tests/stm/orig/stm-compiler/test3
cvs diff: Diffing tests/stm/orig/stm-compiler/test4
cvs diff: Diffing tests/stm/orig/stm-compiler/test5
cvs diff: Diffing tests/stm/orig/stm-compiler/test6
cvs diff: Diffing tests/stm/orig/stm-compiler/test7
cvs diff: Diffing tests/stm/orig/stm-compiler/test8
cvs diff: Diffing tests/stm/orig/stm-compiler/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/stmqueue
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test10
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test11
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test9
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
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 messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list