[m-dev.] diff: MLDS back-end: optimize static ground terms
Fergus Henderson
fjh at cs.mu.OZ.AU
Tue May 23 01:59:10 AEST 2000
Estimated hours taken: 16
Implement static allocation of grounds terms for the
MLDS back-end.
compiler/hlds_goal.m:
Change the `maybe(cell_to_reuse)' field of `construct'
unifications from a `maybe(cell_to_reuse)' into a
`how_to_construct' type with three alternatives,
`reuse_cell(cell_to_reuse)', `construct_dynamically',
and the new alternative `construct_statically(static_cons)'.
`static_cons' is a new type that provides information on
how to construct a static ground term.
compiler/goal_util.m:
compiler/lambda.m:
compiler/magic.m:
compiler/magic_util.m:
compiler/modecheck_unify.m:
compiler/polymorphism.m:
compiler/quantification.m:
Trivial changes to handle the change to the `maybe(cell_to_reuse)'
field of `construct' unifications.
compiler/mark_static_terms.m:
New module. This traverses the HLDS and marks terms which can
be construction unifications which can be allocated statically
with the `construct_statically' flag.
compiler/mercury_compile.m:
For the MLDS back-end, if the static_ground_terms option is set,
invoke the mark_static_terms pass.
compiler/ml_unify_gen.m:
When generating code for construction unifications, pass down
the `how_to_reuse' field. If this is `construct_statically',
then generate a local initialized static constant, rather than
using `new_object' to allocate the memory dynamically.
(This required some fairly substantial reorganization.
I changed ml_gen_construct so that no_tag types and compound
terms, including closures, are handled separately from
constants. I moved some of the code from ml_gen_construct_rep
into ml_gen_construct, and the remainder, which deals with
constants, was simplified and renamed ml_get_constant. The
code for constructing closures was moved into a separate
predicate ml_gen_closure, and was simplified by elimination of
some code duplication. I also added a bunch of new procedures
for generating static constants.)
compiler/mlds.m:
Add a new alternative `mlds__array_type' to the mlds__type type.
This is needed by ml_unify_gen.m for static constants.
compiler/mlds_to_c.m:
Handle `mlds__array_type'. This required splitting
mlds_output_type into mlds_output_type_prefix and
mlds_output_type_suffix.
compiler/ml_code_util.m:
Reorder the code slightly, to improve readability.
Workspace: /home/pgrad/fjh/ws/hg2
Index: compiler/goal_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/goal_util.m,v
retrieving revision 1.61
diff -u -d -r1.61 goal_util.m
--- compiler/goal_util.m 2000/02/10 04:47:40 1.61
+++ compiler/goal_util.m 2000/05/21 08:14:37
@@ -431,16 +431,21 @@
:- mode goal_util__rename_unify(in, in, in, out) is det.
goal_util__rename_unify(
- construct(Var0, ConsId, Vars0, Modes, Reuse0, Uniq, Aditi),
+ construct(Var0, ConsId, Vars0, Modes, How0, Uniq, Aditi),
Must, Subn,
- construct(Var, ConsId, Vars, Modes, Reuse, Uniq, Aditi)) :-
+ construct(Var, ConsId, Vars, Modes, How, Uniq, Aditi)) :-
goal_util__rename_var(Var0, Must, Subn, Var),
goal_util__rename_var_list(Vars0, Must, Subn, Vars),
- ( Reuse0 = yes(cell_to_reuse(ReuseVar0, B, C)) ->
+ (
+ How0 = reuse_cell(cell_to_reuse(ReuseVar0, B, C)),
goal_util__rename_var(ReuseVar0, Must, Subn, ReuseVar),
- Reuse = yes(cell_to_reuse(ReuseVar, B, C))
+ How = reuse_cell(cell_to_reuse(ReuseVar, B, C))
;
- Reuse = no
+ How0 = construct_dynamically,
+ How = How0
+ ;
+ How0 = construct_statically(_),
+ How = How0
).
goal_util__rename_unify(deconstruct(Var0, ConsId, Vars0, Modes, Cat),
Must, Subn, deconstruct(Var, ConsId, Vars, Modes, Cat)) :-
@@ -556,7 +561,7 @@
goal_util__goal_vars_2(unify(Var, RHS, _, Unif, _), Set0, Set) :-
set__insert(Set0, Var, Set1),
( Unif = construct(_, _, _, _, CellToReuse, _, _) ->
- ( CellToReuse = yes(cell_to_reuse(Var, _, _)) ->
+ ( CellToReuse = reuse_cell(cell_to_reuse(Var, _, _)) ->
set__insert(Set1, Var, Set2)
;
Set2 = Set1
@@ -898,8 +903,8 @@
goal_expr_contains_reconstruction(some(_, _, Goal)) :-
goal_contains_reconstruction(Goal).
goal_expr_contains_reconstruction(unify(_, _, _, Unify, _)) :-
- Unify = construct(_, _, _, _, Reuse, _, _),
- Reuse = yes(_).
+ Unify = construct(_, _, _, _, HowToConstruct, _, _),
+ HowToConstruct = reuse_cell(_).
:- pred goals_contain_reconstruction(list(hlds_goal)).
:- mode goals_contain_reconstruction(in) is semidet.
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.70
diff -u -d -r1.70 hlds_goal.m
--- compiler/hlds_goal.m 2000/05/05 06:07:44 1.70
+++ compiler/hlds_goal.m 2000/05/22 07:47:38
@@ -423,11 +423,14 @@
% expression, this is the list of
% modes of the non-local variables
% of the lambda expression.
- maybe(cell_to_reuse),
- % Cell to destructively update.
+ 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 `yes(_)' are described
- % as "reconstructions".
+ % field is `reuse_cell(_)' are
+ % described as "reconstructions".
cell_is_unique, % Can the cell be allocated
% in shared data.
maybe(rl_exprn_id)
@@ -571,6 +574,36 @@
unify_context % the context of the unification
).
+ % Information on how to construct the cell for a
+ % construction unification. The `construct_statically'
+ % alternative is set by the `mark_static_terms.m' pass,
+ % and is currently only used for the MLDS back-end
+ % (for the LLDS back-end, the same optimization is
+ % handled by code_exprn.m).
+ % The `reuse_cell' alternative is not yet used.
+:- type how_to_construct
+ ---> construct_statically( % Use a statically initialized
+ % constant
+ args :: list(static_cons)
+ )
+ ; construct_dynamically % Allocate a new term on the
+ % heap
+ ; reuse_cell(cell_to_reuse) % Reuse an existing heap cell
+ .
+
+ % Information on how to construct an argument for
+ % a static construction unification. Each such
+ % argument must itself have been constructed
+ % statically; we store here a subset of the fields
+ % of the original `construct' unification for the arg.
+ % This is used by the MLDS back-end.
+:- type static_cons
+ ---> static_cons(
+ cons_id, % the cons_id of the functor
+ list(prog_var), % the list of arg variables
+ list(static_cons) % how to construct the args
+ ).
+
% Information used to perform structure reuse on a cell.
:- type cell_to_reuse
---> cell_to_reuse(
@@ -1528,10 +1561,9 @@
RHS = functor(ConsId, []),
Inst = bound(unique, [functor(ConsId, [])]),
Mode = (free -> Inst) - (Inst -> Inst),
- VarToReuse = no,
RLExprnId = no,
Unification = construct(Var, ConsId, [], [],
- VarToReuse, cell_is_unique, RLExprnId),
+ construct_dynamically, cell_is_unique, RLExprnId),
Context = unify_context(explicit, []),
Goal = unify(Var, RHS, Mode, Unification, Context),
set__singleton_set(NonLocals, Var),
Index: compiler/lambda.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/lambda.m,v
retrieving revision 1.61
diff -u -d -r1.61 lambda.m
--- compiler/lambda.m 2000/05/11 06:04:01 1.61
+++ compiler/lambda.m 2000/05/18 04:50:12
@@ -549,10 +549,9 @@
Functor = functor(cons(PredName, NumArgVars), ArgVars),
ConsId = pred_const(PredId, ProcId, EvalMethod),
- VarToReuse = no,
RLExprnId = no,
Unification = construct(Var, ConsId, ArgVars, UniModes,
- VarToReuse, cell_is_unique, RLExprnId),
+ construct_dynamically, cell_is_unique, RLExprnId),
LambdaInfo = lambda_info(VarSet, VarTypes, Constraints, TVarSet,
TVarMap, TCVarMap, Markers, POF, OrigPredName, Owner,
ModuleInfo, MustRecomputeNonLocals).
Index: compiler/magic.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/magic.m,v
retrieving revision 1.17
diff -u -d -r1.17 magic.m
--- compiler/magic.m 2000/05/05 02:42:10 1.17
+++ compiler/magic.m 2000/05/18 04:54:02
@@ -1202,10 +1202,9 @@
instmap_delta_init_reachable(Delta0),
instmap_delta_insert(Delta0, Var, Inst, Delta),
UnifyMode = (free -> Inst) - (Inst -> Inst),
- ReuseVar = no,
RLExprnId = no,
Uni = construct(Var, ConsId, [], [],
- ReuseVar, cell_is_unique, RLExprnId),
+ construct_dynamically, cell_is_unique, RLExprnId),
Context = unify_context(explicit, []),
goal_info_init(NonLocals, Delta, det, GoalInfo),
Goal = unify(Var, functor(ConsId, []), UnifyMode, Uni, Context) -
Index: compiler/magic_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/magic_util.m,v
retrieving revision 1.9
diff -u -d -r1.9 magic_util.m
--- compiler/magic_util.m 2000/05/08 06:20:57 1.9
+++ compiler/magic_util.m 2000/05/18 04:56:41
@@ -489,10 +489,9 @@
{ Rhs = functor(cons(qualified(PredModule, PredName),
Arity), InputVars) },
- { VarToReuse = no },
{ RLExprnId = no },
{ Uni = construct(Var, ConsId, InputVars, Modes,
- VarToReuse, cell_is_unique, RLExprnId) },
+ construct_dynamically, cell_is_unique, RLExprnId) },
{ Goal1 = unify(Var, Rhs, UniMode, Uni, Context) - Info },
{ list__append(InputGoals, [Goal1], InputAndClosure) }
@@ -828,11 +827,10 @@
{ Rhs = functor(cons(qualified(SuppModule, SuppName),
SuppArity), LambdaInputs) },
- { VarToReuse = no },
{ RLExprnId = no },
{ Unify = construct(InputVar,
pred_const(SuppPredId, SuppProcId, (aditi_bottom_up)),
- LambdaInputs, UniModes, VarToReuse,
+ LambdaInputs, UniModes, construct_dynamically,
cell_is_unique, RLExprnId) },
{ UnifyContext = unify_context(explicit, []) },
cvs diff: compiler/mark_static_terms.m is a new entry, no comparison available
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.163
diff -u -d -r1.163 mercury_compile.m
--- compiler/mercury_compile.m 2000/05/16 21:23:26 1.163
+++ compiler/mercury_compile.m 2000/05/22 07:28:17
@@ -60,10 +60,11 @@
:- import_module bytecode_gen, bytecode.
% the MLDS back-end
-:- import_module mlds.
-:- import_module ml_code_gen, ml_elim_nested, ml_tailcall.
-:- import_module rtti_to_mlds.
-:- import_module mlds_to_c.
+:- import_module mark_static_terms. % HLDS -> HLDS
+:- import_module mlds. % MLDS data structure
+:- import_module ml_code_gen, rtti_to_mlds. % HLDS/RTTI -> MLDS
+:- import_module ml_elim_nested, ml_tailcall. % MLDS -> MLDS
+:- import_module mlds_to_c. % MLDS -> C
% miscellaneous compiler modules
:- import_module prog_data, hlds_module, hlds_pred, hlds_out, llds, rl.
@@ -1496,6 +1497,27 @@
%-----------------------------------------------------------------------------%
+:- pred mercury_compile__maybe_mark_static_terms(module_info, bool, bool,
+ module_info, io__state, io__state).
+:- mode mercury_compile__maybe_mark_static_terms(in, in, in, out, di, uo)
+ is det.
+
+mercury_compile__maybe_mark_static_terms(HLDS0, Verbose, Stats, HLDS) -->
+ globals__io_lookup_bool_option(static_ground_terms, StaticGroundTerms),
+ ( { StaticGroundTerms = yes } ->
+ maybe_write_string(Verbose,
+ "% Marking static ground terms...\n"),
+ maybe_flush_output(Verbose),
+ process_all_nonimported_procs(update_proc(mark_static_terms),
+ HLDS0, HLDS),
+ maybe_write_string(Verbose, "% done.\n"),
+ maybe_report_stats(Stats)
+ ;
+ { HLDS = HLDS0 }
+ ).
+
+%-----------------------------------------------------------------------------%
+
:- pred mercury_compile__maybe_write_dependency_graph(module_info, bool, bool,
module_info, io__state, io__state).
:- mode mercury_compile__maybe_write_dependency_graph(in, in, in, out, di, uo)
@@ -2253,7 +2275,11 @@
process_all_nonimported_nonaditi_procs, HLDS53),
mercury_compile__maybe_dump_hlds(HLDS53, "53", "simplify2"),
- { HLDS = HLDS53 },
+ mercury_compile__maybe_mark_static_terms(HLDS53, Verbose, Stats,
+ HLDS60),
+ mercury_compile__maybe_dump_hlds(HLDS60, "60", "mark_static"),
+
+ { HLDS = HLDS60 },
mercury_compile__maybe_dump_hlds(HLDS, "99", "final"),
maybe_write_string(Verbose, "% Converting HLDS to MLDS...\n"),
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.13
diff -u -d -r1.13 ml_code_util.m
--- compiler/ml_code_util.m 2000/05/17 18:02:15 1.13
+++ compiler/ml_code_util.m 2000/05/18 07:14:02
@@ -962,13 +962,15 @@
{ Lval = var(qual(MLDS_Module, "dummy_var")) }
;
=(MLDSGenInfo),
- { ml_gen_info_get_output_vars(MLDSGenInfo, OutputVars) },
{ ml_gen_info_get_varset(MLDSGenInfo, VarSet) },
{ VarName = ml_gen_var_name(VarSet, Var) },
ml_qualify_var(VarName, VarLval),
- { MLDS_Type = mercury_type_to_mlds_type(Type) },
+ %
% output variables are passed by reference...
+ %
+ { ml_gen_info_get_output_vars(MLDSGenInfo, OutputVars) },
{ list__member(Var, OutputVars) ->
+ MLDS_Type = mercury_type_to_mlds_type(Type),
Lval = mem_ref(lval(VarLval), MLDS_Type)
;
Lval = VarLval
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.23
diff -u -d -r1.23 mlds.m
--- compiler/mlds.m 2000/05/10 18:06:55 1.23
+++ compiler/mlds.m 2000/05/22 06:14:16
@@ -482,6 +482,15 @@
% MLDS types defined using mlds__class_defn
; mlds__class_type(mlds__class, arity) % name, arity
+ % MLDS array types.
+ % These are single-dimensional, and can be indexed
+ % using the `field' lval with an `offset' field_id;
+ % indices start at zero.
+ % Currently these are used for static constants
+ % that would otherwise be allocated with a `new_object'
+ % statement.
+ ; mlds__array_type(mlds__type)
+
% Pointer types.
% Currently these are used for handling output arguments.
; mlds__ptr_type(mlds__type)
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.31
diff -u -d -r1.31 mlds_to_c.m
--- compiler/mlds_to_c.m 2000/05/11 21:10:31 1.31
+++ compiler/mlds_to_c.m 2000/05/22 06:48:55
@@ -433,9 +433,10 @@
:- mode mlds_output_data_decl(in, in, di, uo) is det.
mlds_output_data_decl(Name, Type) -->
- mlds_output_type(Type),
+ mlds_output_type_prefix(Type),
io__write_char(' '),
- mlds_output_fully_qualified_name(Name).
+ mlds_output_fully_qualified_name(Name),
+ mlds_output_type_suffix(Type).
:- pred mlds_output_data_defn(mlds__qualified_entity_name, mlds__type,
mlds__initializer, io__state, io__state).
@@ -590,13 +591,18 @@
( { RetTypes = [] } ->
io__write_string("void")
; { RetTypes = [RetType] } ->
- mlds_output_type(RetType)
+ mlds_output_type_prefix(RetType)
;
{ error("mlds_output_func: multiple return types") }
),
io__write_char(' '),
mlds_output_fully_qualified_name(Name),
- mlds_output_params(Indent, Name, Parameters).
+ mlds_output_params(Indent, Name, Parameters),
+ ( { RetTypes = [RetType2] } ->
+ mlds_output_type_suffix(RetType2)
+ ;
+ []
+ ).
:- pred mlds_output_params(indent, qualified_entity_name, mlds__arguments,
io__state, io__state).
@@ -617,23 +623,31 @@
:- mode mlds_output_param(in, in, in, di, uo) is det.
mlds_output_param(_Indent, qual(ModuleName, _FuncName), Name - Type) -->
- mlds_output_type(Type),
- io__write_char(' '),
- mlds_output_fully_qualified_name(qual(ModuleName, Name)).
+ mlds_output_data_decl(qual(ModuleName, Name), Type).
-:- pred mlds_output_func_type(func_params, io__state, io__state).
-:- mode mlds_output_func_type(in, di, uo) is det.
+:- pred mlds_output_func_type_prefix(func_params, io__state, io__state).
+:- mode mlds_output_func_type_prefix(in, di, uo) is det.
-mlds_output_func_type(Params) -->
- { Params = mlds__func_params(Parameters, RetTypes) },
+mlds_output_func_type_prefix(Params) -->
+ { Params = mlds__func_params(_Parameters, RetTypes) },
( { RetTypes = [] } ->
io__write_string("void")
; { RetTypes = [RetType] } ->
mlds_output_type(RetType)
;
- { error("mlds_output_func_type: multiple return types") }
+ { error("mlds_output_func_type_prefix: multiple return types") }
),
- io__write_string(" (*)"),
+ % Note that mlds__func_type actually corresponds to a
+ % function _pointer_ type in C. This is necessary because
+ % function types in C are not first class.
+ io__write_string(" (*").
+
+:- pred mlds_output_func_type_suffix(func_params, io__state, io__state).
+:- mode mlds_output_func_type_suffix(in, di, uo) is det.
+
+mlds_output_func_type_suffix(Params) -->
+ { Params = mlds__func_params(Parameters, _RetTypes) },
+ io__write_string(")"),
mlds_output_param_types(Parameters).
:- pred mlds_output_param_types(mlds__arguments, io__state, io__state).
@@ -811,10 +825,26 @@
% Code to output types
%
+%
+% Because of the joys of C syntax, the code for outputting
+% types needs to be split into two parts; first the prefix,
+% i.e. the part of the type name that goes before the variable
+% name in a variable declaration, and then the suffix, i.e.
+% the part which goes after the variable name, e.g. the "[]"
+% for array types.
+%
+
:- pred mlds_output_type(mlds__type, io__state, io__state).
:- mode mlds_output_type(in, di, uo) is det.
-mlds_output_type(mercury_type(Type)) -->
+mlds_output_type(Type) -->
+ mlds_output_type_prefix(Type),
+ mlds_output_type_suffix(Type).
+
+:- pred mlds_output_type_prefix(mlds__type, io__state, io__state).
+:- mode mlds_output_type_prefix(in, di, uo) is det.
+
+mlds_output_type_prefix(mercury_type(Type)) -->
( { Type = term__functor(term__atom("character"), [], _) } ->
io__write_string("Char")
; { Type = term__functor(term__atom("int"), [], _) } ->
@@ -830,46 +860,67 @@
% so that distinct Mercury types map to distinct C types
io__write_string("MR_Word")
).
-mlds_output_type(mlds__native_int_type) --> io__write_string("int").
-mlds_output_type(mlds__native_float_type) --> io__write_string("float").
-mlds_output_type(mlds__native_bool_type) --> io__write_string("bool").
-mlds_output_type(mlds__native_char_type) --> io__write_string("char").
-mlds_output_type(mlds__class_type(Name, Arity)) -->
+mlds_output_type_prefix(mlds__native_int_type) --> io__write_string("int").
+mlds_output_type_prefix(mlds__native_float_type) --> io__write_string("float").
+mlds_output_type_prefix(mlds__native_bool_type) --> io__write_string("bool").
+mlds_output_type_prefix(mlds__native_char_type) --> io__write_string("char").
+mlds_output_type_prefix(mlds__class_type(Name, Arity)) -->
io__write_string("struct "),
mlds_output_fully_qualified(Name, io__write_string),
io__format("_%d", [i(Arity)]).
-mlds_output_type(mlds__ptr_type(Type)) -->
+mlds_output_type_prefix(mlds__ptr_type(Type)) -->
mlds_output_type(Type),
io__write_string(" *").
-mlds_output_type(mlds__func_type(FuncParams)) -->
- % XXX C syntax sucks, there's no easy way of
- % writing these types that will work in all
- % situations. Currently we rely on the MLDS code
- % generator only using function types in certain situations.
- mlds_output_func_type(FuncParams).
-mlds_output_type(mlds__generic_type) -->
+mlds_output_type_prefix(mlds__array_type(Type)) -->
+ % Here we just output the element type.
+ % The "[]" goes in the type suffix.
+ mlds_output_type(Type).
+mlds_output_type_prefix(mlds__func_type(FuncParams)) -->
+ mlds_output_func_type_prefix(FuncParams).
+mlds_output_type_prefix(mlds__generic_type) -->
io__write_string("MR_Box").
-mlds_output_type(mlds__generic_env_ptr_type) -->
+mlds_output_type_prefix(mlds__generic_env_ptr_type) -->
io__write_string("void *").
-mlds_output_type(mlds__pseudo_type_info_type) -->
+mlds_output_type_prefix(mlds__pseudo_type_info_type) -->
io__write_string("MR_PseudoTypeInfo").
-mlds_output_type(mlds__cont_type) -->
+mlds_output_type_prefix(mlds__cont_type) -->
globals__io_lookup_bool_option(gcc_nested_functions, GCC_NestedFuncs),
( { GCC_NestedFuncs = yes } ->
io__write_string("MR_NestedCont")
;
io__write_string("MR_Cont")
).
-mlds_output_type(mlds__commit_type) -->
+mlds_output_type_prefix(mlds__commit_type) -->
globals__io_lookup_bool_option(gcc_local_labels, GCC_LocalLabels),
( { GCC_LocalLabels = yes } ->
io__write_string("__label__")
;
io__write_string("jmp_buf")
).
-mlds_output_type(mlds__rtti_type(RttiName)) -->
+mlds_output_type_prefix(mlds__rtti_type(RttiName)) -->
io__write_string("MR_"),
io__write_string(mlds_rtti_type_name(RttiName)).
+
+:- pred mlds_output_type_suffix(mlds__type, io__state, io__state).
+:- mode mlds_output_type_suffix(in, di, uo) is det.
+
+mlds_output_type_suffix(mercury_type(_)) --> [].
+mlds_output_type_suffix(mlds__native_int_type) --> [].
+mlds_output_type_suffix(mlds__native_float_type) --> [].
+mlds_output_type_suffix(mlds__native_bool_type) --> [].
+mlds_output_type_suffix(mlds__native_char_type) --> [].
+mlds_output_type_suffix(mlds__class_type(_, _)) --> [].
+mlds_output_type_suffix(mlds__ptr_type(_)) --> [].
+mlds_output_type_suffix(mlds__array_type(_)) -->
+ io__write_string("[]").
+mlds_output_type_suffix(mlds__func_type(FuncParams)) -->
+ mlds_output_func_type_suffix(FuncParams).
+mlds_output_type_suffix(mlds__generic_type) --> [].
+mlds_output_type_suffix(mlds__generic_env_ptr_type) --> [].
+mlds_output_type_suffix(mlds__pseudo_type_info_type) --> [].
+mlds_output_type_suffix(mlds__cont_type) --> [].
+mlds_output_type_suffix(mlds__commit_type) --> [].
+mlds_output_type_suffix(mlds__rtti_type(_)) --> [].
%-----------------------------------------------------------------------------%
%
Index: compiler/ml_unify_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_unify_gen.m,v
retrieving revision 1.9
diff -u -d -r1.9 ml_unify_gen.m
--- compiler/ml_unify_gen.m 2000/05/17 16:01:40 1.9
+++ compiler/ml_unify_gen.m 2000/05/22 15:32:04
@@ -79,7 +79,7 @@
:- import_module rtti.
:- import_module code_util. % XXX needed for `code_util__cons_id_to_tag'.
-:- import_module int, string, list, require, std_util, term, varset.
+:- import_module bool, int, string, list, require, std_util, term, varset.
%-----------------------------------------------------------------------------%
@@ -122,7 +122,7 @@
ml_gen_set_success(Test, Context, MLDS_Statement).
ml_gen_unification(construct(Var, ConsId, Args, ArgModes,
- MaybeCellToReuse, _CellIsUnique, MaybeAditiRLExprnID),
+ HowToConstruct, _CellIsUnique, MaybeAditiRLExprnID),
CodeModel, Context, MLDS_Decls, MLDS_Statements) -->
{ require(unify(CodeModel, model_det),
"ml_code_gen: construct not det") },
@@ -131,12 +131,12 @@
;
true
},
- { MaybeCellToReuse = yes(_) ->
+ { HowToConstruct = reuse_cell(_) ->
sorry("cell reuse")
;
true
},
- ml_gen_construct(Var, ConsId, Args, ArgModes, Context,
+ ml_gen_construct(Var, ConsId, Args, ArgModes, HowToConstruct, Context,
MLDS_Decls, MLDS_Statements).
ml_gen_unification(deconstruct(Var, ConsId, Args, ArgModes, CanFail),
CodeModel, Context, MLDS_Decls, MLDS_Statements) -->
@@ -157,107 +157,169 @@
ml_gen_unification(complicated_unify(_, _, _), _, _, [], []) -->
% simplify.m should convert these into procedure calls
{ error("ml_code_gen: complicated unify") }.
-
+ % ml_gen_construct generations code for a construction unification.
+ %
+ % Note that the code for ml_gen_static_const_arg is very similar to
+ % the code here, and any changes may need to be done in both places.
+ %
:- pred ml_gen_construct(prog_var, cons_id, prog_vars, list(uni_mode),
- prog_context, mlds__defns, mlds__statements,
+ how_to_construct, prog_context, mlds__defns, mlds__statements,
ml_gen_info, ml_gen_info).
-:- mode ml_gen_construct(in, in, in, in, in, out, out, in, out) is det.
+:- mode ml_gen_construct(in, in, in, in, in, in, out, out, in, out) is det.
-ml_gen_construct(Var, ConsId, Args, ArgModes, Context,
+ml_gen_construct(Var, ConsId, Args, ArgModes, HowToConstruct, Context,
MLDS_Decls, MLDS_Statements) -->
%
% figure out how this cons_id is represented
%
ml_variable_type(Var, Type),
ml_cons_id_to_tag(ConsId, Type, Tag),
- %
- % generate code to construct the specified representation
- %
- ml_gen_construct_rep(Tag, ConsId, Var, Args, ArgModes, Context,
- MLDS_Decls, MLDS_Statements).
-:- pred ml_gen_construct_rep(cons_tag, cons_id, prog_var, prog_vars,
- list(uni_mode), prog_context, mlds__defns, mlds__statements,
- ml_gen_info, ml_gen_info).
-:- mode ml_gen_construct_rep(in, in, in, in, in, in, out, out, in, out) is det.
-
-ml_gen_construct_rep(string_constant(String), _, Var, Args, _ArgModes, Context,
- [], [MLDS_Statement]) -->
- ( { Args = [] } ->
- []
+ (
+ %
+ % no_tag types
+ %
+ { Tag = no_tag }
+ ->
+ ( { Args = [Arg], ArgModes = [ArgMode] } ->
+ ml_variable_type(Arg, ArgType),
+ ml_variable_type(Var, VarType),
+ ml_gen_var(Arg, ArgLval),
+ ml_gen_var(Var, VarLval),
+ ml_gen_sub_unify(ArgMode, ArgLval, ArgType, VarLval,
+ VarType, Context, [], MLDS_Statements),
+ { MLDS_Decls = [] }
+ ;
+ { error("ml_code_gen: no_tag: arity != 1") }
+ )
;
- { error("ml_code_gen: string constant has args") }
- ),
- ml_gen_var(Var, VarLval),
- { MLDS_Statement = ml_gen_assign(VarLval, const(string_const(String)),
- Context) }.
-ml_gen_construct_rep(int_constant(Int), _, Var, Args, _ArgModes, Context,
- [], [MLDS_Statement]) -->
- ( { Args = [] } ->
- []
+ %
+ % lambda expressions
+ %
+ { Tag = pred_closure_tag(PredId, ProcId, EvalMethod) }
+ ->
+ ml_gen_closure(PredId, ProcId, EvalMethod, Var, Args,
+ ArgModes, HowToConstruct, Context,
+ MLDS_Decls, MLDS_Statements)
;
- { error("ml_code_gen: int constant has args") }
- ),
- ml_gen_var(Var, VarLval),
- { MLDS_Statement = ml_gen_assign(VarLval, const(int_const(Int)),
- Context) }.
-ml_gen_construct_rep(float_constant(Float), _, Var, Args, _ArgModes, Context,
- [], [MLDS_Statement]) -->
- ( { Args = [] } ->
- []
+ %
+ % ordinary compound terms
+ %
+ { Tag = unshared_tag(TagVal),
+ MaybeSecondaryTag = no
+ ; Tag = shared_remote_tag(TagVal, SecondaryTag),
+ MaybeSecondaryTag = yes(SecondaryTag)
+ }
+ ->
+ ml_gen_compound(TagVal, MaybeSecondaryTag, ConsId, Var, Args,
+ ArgModes, HowToConstruct, Context,
+ MLDS_Decls, MLDS_Statements)
;
- { error("ml_code_gen: float constant has args") }
- ),
- ml_gen_var(Var, VarLval),
- { MLDS_Statement = ml_gen_assign(VarLval, const(float_const(Float)),
- Context) }.
-
-ml_gen_construct_rep(no_tag, _ConsId, Var, Args, Modes, Context,
- MLDS_Decls, MLDS_Statements) -->
- ( { Args = [Arg], Modes = [Mode] } ->
- ml_variable_type(Arg, ArgType),
- ml_variable_type(Var, VarType),
- ml_gen_var(Arg, ArgLval),
+ %
+ % constants
+ %
+ { Args = [] }
+ ->
ml_gen_var(Var, VarLval),
- ml_gen_sub_unify(Mode, ArgLval, ArgType, VarLval, VarType,
- Context, [], MLDS_Statements),
- { MLDS_Decls = [] }
+ ml_gen_constant(Tag, Type, Rval),
+ { MLDS_Statement = ml_gen_assign(VarLval, Rval, Context) },
+ { MLDS_Decls = [] },
+ { MLDS_Statements = [MLDS_Statement] }
;
- { error("ml_code_gen: no_tag: arity != 1") }
+ { error("ml_gen_construct: unknown compound term") }
).
-ml_gen_construct_rep(unshared_tag(Tag), ConsId, Var, Args, ArgModes,
- Context, MLDS_Decls, MLDS_Statements) -->
- ml_gen_new_object(Tag, no, ConsId, Var, Args, ArgModes, Context,
- MLDS_Decls, MLDS_Statements).
-ml_gen_construct_rep(shared_remote_tag(Tag, SecondaryTag), ConsId, Var, Args,
- ArgModes, Context, MLDS_Decls, MLDS_Statements) -->
- ml_gen_new_object(Tag, yes(SecondaryTag), ConsId, Var, Args, ArgModes,
- Context, MLDS_Decls, MLDS_Statements).
+ % ml_gen_static_const_arg is similar to ml_gen_construct
+ % with HowToConstruct = construct_statically(_),
+ % except that for compound terms, rather than generating
+ % a new static constant, it just generates a reference
+ % to one that has already been defined.
+ %
+ % Note that any changes here may require similar changes to
+ % ml_gen_construct.
+ %
+:- pred ml_gen_static_const_arg(prog_var, static_cons, mlds__rval,
+ ml_gen_info, ml_gen_info).
+:- mode ml_gen_static_const_arg(in, in, out, in, out) is det.
-ml_gen_construct_rep(shared_local_tag(Bits1, Num1), _ConsId, Var, Args,
- _ArgModes, Context, [], [MLDS_Statement]) -->
- ( { Args = [] } ->
- []
- ;
- { error("ml_code_gen: shared_local_tag constant has args") }
- ),
- ml_gen_var(Var, VarLval),
- { MLDS_Statement = ml_gen_assign(VarLval,
- mkword(Bits1, unop(std_unop(mkbody), const(int_const(Num1)))),
- Context) }.
+ml_gen_static_const_arg(Var, static_cons(ConsId, ArgVars, StaticArgs), Rval) -->
+ %
+ % figure out how this argument is represented
+ %
+ ml_variable_type(Var, VarType),
+ ml_cons_id_to_tag(ConsId, VarType, Tag),
-ml_gen_construct_rep(type_ctor_info_constant(ModuleName0, TypeName, TypeArity),
- _ConsId, Var, Args, _ArgModes, Context,
- [], [MLDS_Statement]) -->
- ( { Args = [] } ->
- []
+ (
+ %
+ % no_tag types
+ %
+ { Tag = no_tag }
+ ->
+ ( { ArgVars = [Arg], StaticArgs = [StaticArg] } ->
+ % construct (statically) the argument,
+ % and then convert it to the appropriate type
+ ml_gen_static_const_arg(Arg, StaticArg, ArgRval),
+ ml_variable_type(Arg, ArgType),
+ { ml_gen_box_or_unbox_rval(ArgType, VarType,
+ ArgRval, Rval) }
+ ;
+ { error("ml_code_gen: no_tag: arity != 1") }
+ )
;
- { error("ml_code_gen: type-info constant has args") }
- ),
- ml_gen_var(Var, VarLval),
+ %
+ % compound terms, including lambda expressions
+ %
+ { Tag = pred_closure_tag(_, _, _), TagVal = 0
+ ; Tag = unshared_tag(TagVal)
+ ; Tag = shared_remote_tag(TagVal, _SecondaryTag)
+ }
+ ->
+ %
+ % If this argument is something that would normally be allocated
+ % on the heap, just generate a reference to the static constant
+ % that we must have already generated for it.
+ %
+ ml_gen_static_const_addr(Var, ConstAddrRval),
+ { TagVal = 0 ->
+ TaggedRval = ConstAddrRval
+ ;
+ TaggedRval = mkword(TagVal, ConstAddrRval)
+ },
+ { Rval = unop(cast(mercury_type(VarType)), TaggedRval) }
+ ;
+ %
+ % If this argument is just a constant,
+ % then generate the rval for the constant
+ %
+ { StaticArgs = [] }
+ ->
+ ml_gen_constant(Tag, VarType, Rval)
+ ;
+ { error("ml_gen_static_const_arg: unknown compound term") }
+ ).
+
+ %
+ % generate the rval for a given constant
%
+:- pred ml_gen_constant(cons_tag, prog_type, mlds__rval,
+ ml_gen_info, ml_gen_info).
+:- mode ml_gen_constant(in, in, out, in, out) is det.
+
+ml_gen_constant(string_constant(String), _, const(string_const(String)))
+ --> [].
+
+ml_gen_constant(int_constant(Int), _, const(int_const(Int))) --> [].
+
+ml_gen_constant(float_constant(Float), _, const(float_const(Float))) --> [].
+
+ml_gen_constant(shared_local_tag(Bits1, Num1), _, Rval) -->
+ { Rval = mkword(Bits1,
+ unop(std_unop(mkbody), const(int_const(Num1)))) }.
+
+ml_gen_constant(type_ctor_info_constant(ModuleName0, TypeName, TypeArity),
+ VarType, Rval) -->
+ %
% Although the builtin types `int', `float', etc. are treated as part
% of the `builtin' module, for historical reasons they don't have
% any qualifiers at this point, so we need to add the `builtin'
@@ -272,63 +334,52 @@
{ RttiTypeId = rtti_type_id(ModuleName, TypeName, TypeArity) },
{ DataAddr = data_addr(MLDS_Module,
rtti(RttiTypeId, type_ctor_info)) },
- ml_variable_type(Var, VarType),
- { MLDS_Statement = ml_gen_assign(VarLval,
- unop(cast(mercury_type(VarType)),
- const(data_addr_const(DataAddr))),
- Context) }.
-ml_gen_construct_rep(base_typeclass_info_constant(ModuleName, ClassId,
- Instance), _ConsId, Var, Args, _ArgModes, Context,
- [], [MLDS_Statement]) -->
- ( { Args = [] } ->
- []
- ;
- { error("ml_code_gen: typeclass-info constant has args") }
- ),
- ml_gen_var(Var, VarLval),
+ { Rval = unop(cast(mercury_type(VarType)),
+ const(data_addr_const(DataAddr))) }.
+
+ml_gen_constant(base_typeclass_info_constant(ModuleName, ClassId,
+ Instance), VarType, Rval) -->
{ MLDS_Module = mercury_module_name_to_mlds(ModuleName) },
{ DataAddr = data_addr(MLDS_Module,
base_typeclass_info(ClassId, Instance)) },
- ml_variable_type(Var, VarType),
- { MLDS_Statement = ml_gen_assign(VarLval,
- unop(cast(mercury_type(VarType)),
- const(data_addr_const(DataAddr))),
- Context) }.
+ { Rval = unop(cast(mercury_type(VarType)),
+ const(data_addr_const(DataAddr))) }.
-ml_gen_construct_rep(tabling_pointer_constant(PredId, ProcId), _ConsId,
- Var, Args, _ArgModes, Context, [], [MLDS_Statement]) -->
- ( { Args = [] } ->
- []
- ;
- { error("ml_code_gen: tabling pointer constant has args") }
- ),
- ml_gen_var(Var, VarLval),
+ml_gen_constant(tabling_pointer_constant(PredId, ProcId), VarType, Rval) -->
=(Info),
{ ml_gen_info_get_module_info(Info, ModuleInfo) },
{ ml_gen_pred_label(ModuleInfo, PredId, ProcId,
PredLabel, PredModule) },
{ DataAddr = data_addr(PredModule,
tabling_pointer(PredLabel - ProcId)) },
- ml_variable_type(Var, VarType),
- { MLDS_Statement = ml_gen_assign(VarLval,
- unop(cast(mercury_type(VarType)),
- const(data_addr_const(DataAddr))),
- Context) }.
+ { Rval = unop(cast(mercury_type(VarType)),
+ const(data_addr_const(DataAddr))) }.
-ml_gen_construct_rep(code_addr_constant(PredId, ProcId), _ConsId,
- Var, Args, _ArgModes, Context, [], [MLDS_Statement]) -->
- ( { Args = [] } ->
- []
- ;
- { error("ml_code_gen: address constant has args") }
- ),
- ml_gen_var(Var, VarLval),
- ml_gen_proc_addr_rval(PredId, ProcId, ProcAddrRval),
- { MLDS_Statement = ml_gen_assign(VarLval, ProcAddrRval, Context) }.
+ml_gen_constant(code_addr_constant(PredId, ProcId), _, ProcAddrRval) -->
+ ml_gen_proc_addr_rval(PredId, ProcId, ProcAddrRval).
-ml_gen_construct_rep(pred_closure_tag(PredId, ProcId, EvalMethod), _ConsId,
- Var, ArgVars, ArgModes, Context,
- MLDS_Decls, MLDS_Statements) -->
+% tags which are not (necessarily) constants are handled
+% in ml_gen_construct and ml_gen_static_const_arg,
+% so we don't need to handle them here.
+ml_gen_constant(no_tag, _, _) -->
+ { error("ml_gen_constant: no_tag") }.
+ml_gen_constant(unshared_tag(_), _, _) -->
+ { error("ml_gen_constant: unshared_tag") }.
+ml_gen_constant(shared_remote_tag(_, _), _, _) -->
+ { error("ml_gen_constant: shared_remote_tag") }.
+ml_gen_constant(pred_closure_tag(_, _, _), _, _) -->
+ { error("ml_gen_constant: pred_closure_tag") }.
+
+%-----------------------------------------------------------------------------%
+
+:- pred ml_gen_closure(pred_id, proc_id, lambda_eval_method, prog_var,
+ prog_vars, list(uni_mode), how_to_construct, prog_context,
+ mlds__defns, mlds__statements, ml_gen_info, ml_gen_info).
+:- mode ml_gen_closure(in, in, in, in, in, in, in, in, out, out, in, out)
+ is det.
+
+ml_gen_closure(PredId, ProcId, EvalMethod, Var, ArgVars, ArgModes,
+ HowToConstruct, Context, MLDS_Decls, MLDS_Statements) -->
% This constructs a closure.
% The representation of closures for the LLDS backend is defined in
% runtime/mercury_ho_call.h.
@@ -348,14 +399,6 @@
),
%
- % Compute the lval where we will put the final result,
- % and its type.
- %
- ml_gen_var(Var, VarLval),
- ml_variable_type(Var, Type),
- { MLDS_Type = mercury_type_to_mlds_type(Type) },
-
- %
% Generate a dummy value for the closure layout
% (we do this just to match the structure used
% by the LLDS closure representation)
@@ -383,17 +426,6 @@
Context, WrapperFuncRval, WrapperFuncType),
%
- % Generate rvals for the arguments
- %
- ml_gen_var_list(ArgVars, ArgLvals),
- ml_variable_types(ArgVars, ArgTypes),
- { MLDS_ArgTypes0 = list__map(mercury_type_to_mlds_type, ArgTypes) },
- =(Info),
- { ml_gen_info_get_module_info(Info, ModuleInfo) },
- { ml_gen_cons_args(ArgLvals, ArgTypes, ArgModes, ModuleInfo,
- ArgRvals0) },
-
- %
% Compute the rval which holds the number of arguments
%
{ NumArgsRval = const(int_const(NumArgs)) },
@@ -402,38 +434,22 @@
%
% the pointer will not be tagged (i.e. the tag will be zero)
%
- { MaybeTag = yes(0) },
+ { Tag = 0 },
{ CtorName = "<closure>" },
%
- % put all the arguments of the closure together
+ % put all the extra arguments of the closure together
%
- { ArgRvals = [ClosureLayoutRval, WrapperFuncRval, NumArgsRval
- | ArgRvals0] },
- { MLDS_ArgTypes = [ClosureLayoutType, WrapperFuncType, NumArgsType
- | MLDS_ArgTypes0] },
+ { ExtraArgRvals = [ClosureLayoutRval, WrapperFuncRval, NumArgsRval] },
+ { ExtraArgTypes = [ClosureLayoutType, WrapperFuncType, NumArgsType] },
- %
- % Compute the number of bytes to allocate
%
- { list__length(ArgRvals, TotalNumArgs) },
- { SizeInWordsRval = const(int_const(TotalNumArgs)) },
- { SizeOfWordRval = ml_sizeof_word_rval },
- { SizeInBytesRval = binop((*), SizeInWordsRval, SizeOfWordRval) },
-
- %
- % Now put it all together.
+ % generate a `new_object' statement (or static constant)
+ % for the closure
%
- { MLDS_Decls = [] },
- { MakeNewObject = new_object(VarLval, MaybeTag, MLDS_Type,
- yes(SizeInBytesRval), yes(CtorName), ArgRvals,
- MLDS_ArgTypes) },
- { MLDS_Stmt = atomic(MakeNewObject) },
- { MLDS_Statement = mlds__statement(MLDS_Stmt,
- mlds__make_context(Context)) },
- { MLDS_Statements = [MLDS_Statement] }.
-
-%-----------------------------------------------------------------------------%
+ ml_gen_new_object(Tag, CtorName, Var, ExtraArgRvals, ExtraArgTypes,
+ ArgVars, ArgModes, HowToConstruct, Context,
+ MLDS_Decls, MLDS_Statements).
%
% ml_gen_closure_wrapper:
@@ -730,6 +746,8 @@
NumClosureArgs, ClosureArgLvals0),
{ ClosureArgLvals = [FieldLval | ClosureArgLvals0] }
).
+
+%-----------------------------------------------------------------------------%
% convert a cons_id for a given type to a cons_tag
ml_cons_id_to_tag(ConsId, Type, Tag) -->
@@ -738,71 +756,280 @@
{ code_util__cons_id_to_tag(ConsId, Type, ModuleInfo, Tag) }.
% generate code to construct a new object
-:- pred ml_gen_new_object(mlds__tag, maybe(int), cons_id, prog_var, prog_vars,
- list(uni_mode), prog_context, mlds__defns, mlds__statements,
+:- pred ml_gen_compound(mlds__tag, maybe(int), cons_id, prog_var, prog_vars,
+ list(uni_mode), how_to_construct, prog_context,
+ mlds__defns, mlds__statements, ml_gen_info, ml_gen_info).
+:- mode ml_gen_compound(in, in, in, in, in, in, in, in, out, out, in, out)
+ is det.
+
+ml_gen_compound(Tag, MaybeSecondaryTag, ConsId, Var, ArgVars, ArgModes,
+ HowToConstruct, Context, MLDS_Decls, MLDS_Statements) -->
+ ml_cons_name(ConsId, CtorName),
+ %
+ % If there is a secondary tag, it goes in the first field
+ %
+ { MaybeSecondaryTag = yes(SecondaryTag) ->
+ SecondaryTagRval = const(int_const(SecondaryTag)),
+ SecondaryTagType = mlds__native_int_type,
+ ExtraRvals = [SecondaryTagRval],
+ ExtraArgTypes = [SecondaryTagType]
+ ;
+ ExtraRvals = [],
+ ExtraArgTypes = []
+ },
+ ml_gen_new_object(Tag, CtorName, Var, ExtraRvals, ExtraArgTypes,
+ ArgVars, ArgModes, HowToConstruct, Context,
+ MLDS_Decls, MLDS_Statements).
+
+ %
+ % 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.
+ %
+:- pred ml_gen_new_object(mlds__tag, ctor_name, prog_var, list(mlds__rval),
+ list(mlds__type), prog_vars, list(uni_mode), how_to_construct,
+ prog_context, mlds__defns, mlds__statements,
ml_gen_info, ml_gen_info).
-:- mode ml_gen_new_object(in, in, in, in, in, in, in, out, out, in, out)
+:- mode ml_gen_new_object(in, in, in, in, in, in, in, in, in, out, out, in, out)
is det.
-ml_gen_new_object(Tag, MaybeSecondaryTag, ConsId, Var, ArgVars, ArgModes,
- Context, MLDS_Decls, MLDS_Statements) -->
+ml_gen_new_object(Tag, CtorName, Var, ExtraRvals, ExtraTypes,
+ ArgVars, ArgModes, HowToConstruct, Context,
+ MLDS_Decls, MLDS_Statements) -->
%
% Determine the variable's type and lval,
- % and determine the constructor name and the tag to use.
+ % the tag to use, and the types of the argument vars.
%
ml_variable_type(Var, Type),
{ MLDS_Type = mercury_type_to_mlds_type(Type) },
- ml_gen_var(Var, Lval),
- ml_cons_name(ConsId, CtorName),
+ ml_gen_var(Var, VarLval),
{ Tag = 0 ->
MaybeTag = no
;
MaybeTag = yes(Tag)
},
-
- %
- % Generate rvals for the arguments
- %
- ml_gen_var_list(ArgVars, ArgLvals),
ml_variable_types(ArgVars, ArgTypes),
{ MLDS_ArgTypes0 = list__map(mercury_type_to_mlds_type, ArgTypes) },
- =(Info),
- { ml_gen_info_get_module_info(Info, ModuleInfo) },
- { ml_gen_cons_args(ArgLvals, ArgTypes, ArgModes, ModuleInfo,
- ArgRvals0) },
- %
- % If there is a secondary tag, it goes in the first field
- %
- { MaybeSecondaryTag = yes(SecondaryTag) ->
- SecondaryTagRval = const(int_const(SecondaryTag)),
- SecondaryTagType = mlds__native_int_type,
- ArgRvals = [SecondaryTagRval | ArgRvals0],
- MLDS_ArgTypes = [SecondaryTagType | MLDS_ArgTypes0]
+ (
+ { HowToConstruct = construct_dynamically },
+
+ %
+ % Generate rvals for the arguments
+ %
+ ml_gen_var_list(ArgVars, ArgLvals),
+ =(Info),
+ { ml_gen_info_get_module_info(Info, ModuleInfo) },
+ { ml_gen_cons_args(ArgLvals, ArgTypes, ArgModes, ModuleInfo,
+ ArgRvals0) },
+
+ %
+ % Insert the extra rvals at the start
+ %
+ { list__append(ExtraRvals, ArgRvals0, ArgRvals) },
+ { list__append(ExtraTypes, MLDS_ArgTypes0, MLDS_ArgTypes) },
+
+ %
+ % Compute the number of bytes to allocate
+ %
+ { list__length(ArgRvals, NumArgs) },
+ { SizeInWordsRval = const(int_const(NumArgs)) },
+ { SizeOfWordRval = ml_sizeof_word_rval },
+ { SizeInBytesRval = binop((*), SizeInWordsRval,
+ SizeOfWordRval) },
+
+ %
+ % Generate a `new_object' statement to dynamically allocate
+ % the memory for this term from the heap. The `new_object'
+ % statement will also initialize the fields of this term
+ % with boxed versions of the specified arguments.
+ %
+ { MakeNewObject = new_object(VarLval, MaybeTag, MLDS_Type,
+ yes(SizeInBytesRval), yes(CtorName), ArgRvals,
+ MLDS_ArgTypes) },
+ { MLDS_Stmt = atomic(MakeNewObject) },
+ { MLDS_Statement = mlds__statement(MLDS_Stmt,
+ mlds__make_context(Context)) },
+ { MLDS_Statements = [MLDS_Statement] },
+ { MLDS_Decls = [] }
;
- ArgRvals = ArgRvals0,
- MLDS_ArgTypes = MLDS_ArgTypes0
- },
+ { HowToConstruct = construct_statically(StaticArgs) },
+
+ %
+ % Generate rvals for the arguments
+ %
+ ml_gen_static_const_arg_list(ArgVars, StaticArgs, ArgRvals0),
+
+ %
+ % Insert the extra rvals at the start
+ %
+ { list__append(ExtraRvals, ArgRvals0, ArgRvals1) },
+ { list__append(ExtraTypes, MLDS_ArgTypes0, MLDS_ArgTypes) },
+
+ %
+ % Box all the arguments
+ %
+ ml_gen_box_const_rval_list(MLDS_ArgTypes, ArgRvals1,
+ Context, BoxConstDefns, ArgRvals),
+
+ %
+ % Generate a local static constant for this term.
+ %
+ ml_gen_static_const_name(Var, ConstName),
+ { ConstType = mlds__array_type(mlds__generic_type) },
+ { ArgInits = list__map(func(X) = init_obj(X), ArgRvals) },
+ { Initializer = init_array(ArgInits) },
+ { ConstDefn = ml_gen_static_const_defn(ConstName, ConstType,
+ Initializer, Context) },
+
+ %
+ % Assign the address of the local static constant to
+ % the variable.
+ %
+ ml_gen_static_const_addr(Var, ConstAddrRval),
+ { MaybeTag = no ->
+ TaggedRval = ConstAddrRval
+ ;
+ TaggedRval = mkword(Tag, ConstAddrRval)
+ },
+ { Rval = unop(cast(mercury_type(Type)), TaggedRval) },
+ { AssignStatement = ml_gen_assign(VarLval, Rval, Context) },
+ { MLDS_Decls = list__append(BoxConstDefns, [ConstDefn]) },
+ { MLDS_Statements = [AssignStatement] }
+ ;
+ { HowToConstruct = reuse_cell(_) },
+ { sorry("cell reuse") }
+ ).
+
+:- pred ml_gen_box_const_rval_list(list(mlds__type), list(mlds__rval),
+ prog_context, mlds__defns, list(mlds__rval),
+ ml_gen_info, ml_gen_info).
+:- mode ml_gen_box_const_rval_list(in, in, in, out, out, in, out) is det.
+
+ml_gen_box_const_rval_list([], [], _, [], []) --> [].
+ml_gen_box_const_rval_list([Type | Types], [Rval | Rvals], Context,
+ ConstDefns, [BoxedRval | BoxedRvals]) -->
+ ml_gen_box_const_rval(Type, Rval, Context, ConstDefns1, BoxedRval),
+ ml_gen_box_const_rval_list(Types, Rvals, Context, ConstDefns2,
+ BoxedRvals),
+ { ConstDefns = list__append(ConstDefns1, ConstDefns2) }.
+ml_gen_box_const_rval_list([], [_|_], _, _, _) -->
+ { error("ml_gen_box_const_rval_list: length mismatch") }.
+ml_gen_box_const_rval_list([_|_], [], _, _, _) -->
+ { error("ml_gen_box_const_rval_list: length mismatch") }.
+
+:- pred ml_gen_box_const_rval(mlds__type, mlds__rval, prog_context,
+ mlds__defns, mlds__rval, ml_gen_info, ml_gen_info).
+:- mode ml_gen_box_const_rval(in, in, in, out, out, in, out) is det.
+
+ml_gen_box_const_rval(Type, Rval, Context, ConstDefns, BoxedRval) -->
+ (
+ { Type = mercury_type(term__variable(_))
+ ; Type = mlds__generic_type
+ }
+ ->
+ { BoxedRval = Rval },
+ { ConstDefns = [] }
+ ;
+ %
+ % We need to handle floats specially,
+ % since boxed floats normally get heap allocated,
+ % whereas for other types boxing is just a cast
+ % (casts are OK in static initializers,
+ % but calls to malloc() are not).
+ %
+ { Type = mercury_type(term__functor(term__atom("float"),
+ [], _))
+ ; Type = mlds__native_float_type
+ }
+ ->
+ %
+ % Generate a local static constant for this float
+ %
+ ml_gen_info_new_conv_var(SequenceNum),
+ { string__format("float_%d", [i(SequenceNum)], ConstName) },
+ { Initializer = init_obj(Rval) },
+ { ConstDefn = ml_gen_static_const_defn(ConstName, Type,
+ Initializer, Context) },
+ { ConstDefns = [ConstDefn] },
+ %
+ % Return as the boxed rval the address of that constant,
+ % cast to mlds__generic_type
+ %
+ ml_qualify_var(ConstName, ConstLval),
+ { ConstAddrRval = mem_addr(ConstLval) },
+ { BoxedRval = unop(cast(mlds__generic_type), ConstAddrRval) }
+ ;
+ { BoxedRval = unop(box(Type), Rval) },
+ { ConstDefns = [] }
+ ).
+
+:- pred ml_gen_static_const_arg_list(list(prog_var), list(static_cons),
+ list(mlds__rval), ml_gen_info, ml_gen_info).
+:- mode ml_gen_static_const_arg_list(in, in, out, in, out) is det.
+ml_gen_static_const_arg_list([], [], []) --> [].
+ml_gen_static_const_arg_list([Var | Vars], [StaticCons | StaticConses],
+ [Rval | Rvals]) -->
+ ml_gen_static_const_arg(Var, StaticCons, Rval),
+ ml_gen_static_const_arg_list(Vars, StaticConses, Rvals).
+ml_gen_static_const_arg_list([_|_], [], _) -->
+ { error("ml_gen_static_const_arg_list: length mismatch") }.
+ml_gen_static_const_arg_list([], [_|_], _) -->
+ { error("ml_gen_static_const_arg_list: length mismatch") }.
+
+ % Generate the name of the local static constant
+ % for a given variable.
%
- % Compute the number of bytes to allocate
+:- pred ml_gen_static_const_name(prog_var, mlds__var_name,
+ ml_gen_info, ml_gen_info).
+:- mode ml_gen_static_const_name(in, out, in, out) is det.
+ml_gen_static_const_name(Var, ConstName) -->
+ =(MLDSGenInfo),
+ { ml_gen_info_get_varset(MLDSGenInfo, VarSet) },
+ { VarName = ml_gen_var_name(VarSet, Var) },
+ { string__format("const_%s", [s(VarName)], ConstName) }.
+
+ % Generate an rval containing the address of the local static constant
+ % for a given variable.
%
- { list__length(ArgRvals, NumArgs) },
- { SizeInWordsRval = const(int_const(NumArgs)) },
- { SizeOfWordRval = ml_sizeof_word_rval },
- { SizeInBytesRval = binop((*), SizeInWordsRval, SizeOfWordRval) },
-
+:- pred ml_gen_static_const_addr(prog_var, mlds__rval,
+ ml_gen_info, ml_gen_info).
+:- mode ml_gen_static_const_addr(in, out, in, out) is det.
+ml_gen_static_const_addr(Var, ConstAddrRval) -->
+ ml_gen_static_const_name(Var, ConstName),
+ ml_qualify_var(ConstName, ConstLval),
+ { ConstAddrRval = mem_addr(ConstLval) }.
+
+ % Generate a definition of a local static constant,
+ % given the constant's name, type, and initializer.
%
- % Now put it all together.
+:- func ml_gen_static_const_defn(mlds__var_name, mlds__type, mlds__initializer,
+ prog_context) = mlds__defn.
+ml_gen_static_const_defn(ConstName, ConstType, Initializer, Context) =
+ MLDS_Defn :-
+ Name = data(var(ConstName)),
+ Defn = data(ConstType, Initializer),
+ DeclFlags = ml_static_const_decl_flags,
+ MLDS_Context = mlds__make_context(Context),
+ MLDS_Defn = mlds__defn(Name, MLDS_Context, DeclFlags, Defn).
+
+ % Return the declaration flags appropriate for an
+ % initialized local static constant.
%
- { MakeNewObject = new_object(Lval, MaybeTag, MLDS_Type,
- yes(SizeInBytesRval), yes(CtorName), ArgRvals,
- MLDS_ArgTypes) },
- { MLDS_Stmt = atomic(MakeNewObject) },
- { MLDS_Statement = mlds__statement(MLDS_Stmt,
- mlds__make_context(Context)) },
- { MLDS_Statements = [MLDS_Statement] },
- { MLDS_Decls = [] }.
+:- func ml_static_const_decl_flags = mlds__decl_flags.
+ml_static_const_decl_flags = MLDS_DeclFlags :-
+ Access = private,
+ PerInstance = one_copy,
+ Virtuality = non_virtual,
+ Finality = overridable,
+ Constness = const,
+ Abstractness = concrete,
+ MLDS_DeclFlags = init_decl_flags(Access, PerInstance,
+ Virtuality, Finality, Constness, Abstractness).
:- pred ml_cons_name(cons_id, ctor_name, ml_gen_info, ml_gen_info).
:- mode ml_cons_name(in, out, in, out) is det.
Index: compiler/modecheck_unify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modecheck_unify.m,v
retrieving revision 1.41
diff -u -d -r1.41 modecheck_unify.m
--- compiler/modecheck_unify.m 1999/09/13 10:14:43 1.41
+++ compiler/modecheck_unify.m 2000/05/18 04:59:25
@@ -1038,7 +1038,7 @@
RHS = RHS0
),
Unification = construct(X, ConsId, ArgVars, ArgModes,
- no, cell_is_unique, AditiInfo),
+ construct_dynamically, cell_is_unique, AditiInfo),
ModeInfo = ModeInfo0
;
instmap__is_reachable(InstMap)
@@ -1093,10 +1093,9 @@
mode_is_output(ModuleInfo, ModeOfX)
->
% It's a construction.
- ReuseVar = no,
RLExprnId = no,
Unification = construct(X, ConsId, ArgVars, ArgModes,
- ReuseVar, cell_is_unique, RLExprnId),
+ construct_dynamically, cell_is_unique, RLExprnId),
% For existentially quantified data types,
% check that any type_info or type_class_info variables in the
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.185
diff -u -d -r1.185 polymorphism.m
--- compiler/polymorphism.m 2000/04/14 08:38:15 1.185
+++ compiler/polymorphism.m 2000/05/18 05:06:50
@@ -2196,10 +2196,9 @@
BaseTypeClassInfoTerm = functor(ConsId, []),
% create the construction unification to initialize the variable
- ReuseVar = no,
RLExprnId = no,
BaseUnification = construct(BaseVar, ConsId, [], [],
- ReuseVar, cell_is_shared, RLExprnId),
+ construct_dynamically, cell_is_shared, RLExprnId),
BaseUnifyMode = (free -> ground(shared, no)) -
(ground(shared, no) -> ground(shared, no)),
BaseUnifyContext = unify_context(explicit, []),
@@ -2233,7 +2232,7 @@
list__length(NewArgVars, NumArgVars),
list__duplicate(NumArgVars, UniMode, UniModes),
Unification = construct(NewVar, NewConsId, NewArgVars,
- UniModes, ReuseVar, cell_is_unique, RLExprnId),
+ UniModes, construct_dynamically, cell_is_unique, RLExprnId),
UnifyMode = (free -> ground(shared, no)) -
(ground(shared, no) -> ground(shared, no)),
UnifyContext = unify_context(explicit, []),
@@ -2523,10 +2522,9 @@
polymorphism__init_with_int_constant(CountVar, Num, CountUnifyGoal) :-
CountConsId = int_const(Num),
- ReuseVar = no,
RLExprnId = no,
CountUnification = construct(CountVar, CountConsId, [], [],
- ReuseVar, cell_is_shared, RLExprnId),
+ construct_dynamically, cell_is_shared, RLExprnId),
CountTerm = functor(CountConsId, []),
CountInst = bound(unique, [functor(int_const(Num), [])]),
@@ -2639,10 +2637,9 @@
ground(shared, no) - ground(shared, no)),
list__length(ArgVars, NumArgVars),
list__duplicate(NumArgVars, UniMode, UniModes),
- ReuseVar = no,
RLExprnId = no,
Unification = construct(TypeInfoVar, ConsId, ArgVars, UniModes,
- ReuseVar, cell_is_unique, RLExprnId),
+ construct_dynamically, cell_is_unique, RLExprnId),
UnifyMode = (free -> ground(shared, no)) -
(ground(shared, no) -> ground(shared, no)),
UnifyContext = unify_context(explicit, []),
@@ -2695,10 +2692,9 @@
VarSet0, VarTypes0, TypeCtorInfoVar, VarSet, VarTypes),
% create the construction unification to initialize the variable
- ReuseVar = no,
RLExprnId = no,
Unification = construct(TypeCtorInfoVar, ConsId, [], [],
- ReuseVar, cell_is_shared, RLExprnId),
+ construct_dynamically, cell_is_shared, RLExprnId),
UnifyMode = (free -> ground(shared, no)) -
(ground(shared, no) -> ground(shared, no)),
UnifyContext = unify_context(explicit, []),
Index: compiler/quantification.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/quantification.m,v
retrieving revision 1.72
diff -u -d -r1.72 quantification.m
--- compiler/quantification.m 2000/02/18 07:44:53 1.72
+++ compiler/quantification.m 2000/05/18 05:10:22
@@ -445,8 +445,11 @@
quantification__get_lambda_outside(LambdaOutsideVars),
{ quantification__get_unify_typeinfos(Unification0, TypeInfoVars) },
- { Unification0 = construct(_, _, _, _, CellToReuse0, _, _) ->
- CellToReuse = CellToReuse0
+ {
+ Unification0 = construct(_, _, _, _,
+ reuse_cell(CellToReuse0), _, _)
+ ->
+ CellToReuse = yes(CellToReuse0)
;
CellToReuse = no
},
@@ -692,13 +695,13 @@
%
{
Unification0 = construct(ConstructVar, ConsId, Args0,
- ArgModes0, Reuse, Uniq, AditiInfo)
+ ArgModes0, HowToConstruct, Uniq, AditiInfo)
->
map__from_corresponding_lists(Args0, ArgModes0, ArgModesMap),
set__to_sorted_list(NonLocals, Args),
map__apply_to_list(Args, ArgModesMap, ArgModes),
Unification = construct(ConstructVar, ConsId, Args,
- ArgModes, Reuse, Uniq, AditiInfo)
+ ArgModes, HowToConstruct, Uniq, AditiInfo)
;
% after mode analysis, unifications with lambda variables
% should always be construction unifications, but
@@ -891,8 +894,8 @@
unify(A, B, _, Unification, _), Set0, LambdaSet0,
Set, LambdaSet) :-
set__insert(Set0, A, Set1),
- ( Unification = construct(_, _, _, _, Reuse0, _, _) ->
- Reuse = Reuse0
+ ( Unification = construct(_, _, _, _, reuse_cell(Reuse0), _, _) ->
+ Reuse = yes(Reuse0)
;
Reuse = no
),
--
Fergus Henderson <fjh at cs.mu.oz.au> | "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh> | of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3 | -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list