[m-dev.] for review: MLDS backend to do structure reuse and compile time gc
Peter Ross
Peter.Ross at cs.kuleuven.ac.be
Fri Oct 6 01:42:45 AEDT 2000
Hi,
Here is the first part of moving the reuse branch onto the main branch.
For Simon or Fergus to review.
Simon, is it possible for you to check you changes for generating LLDS
code which does reuse in?
===================================================================
Estimated hours taken: 16
Update the MLDS backend to handle structure reuse and compile time gc.
Note that currently no pass on the main branch currently generates this
information yet.
ml_unify_gen.m:
Handle the case where the HowToConstruct field of a construction
is reuse_cell(_).
mlds.m:
Update the assign instruction with a field that says whether or not
the LHS of the assigment needs to use a different tag to the RHS of
the assignment and what that tag is.
Add a new instruction compile_time_gc which is to be inserted
whenever a lval can be compile time garbage collected.
mlds_to_c.m:
Handle the new form of the assign instruction.
Throw an error if we encounter an compile_time_gc instruction.
ml_code_util.m:
Add ml_gen_assign_with_tag which generates an assign instruction
where the lval must use the supplied tag.
hlds_goal.m:
Add a new field, can_cgc, to deconstruction unifications. This
field is true if the deconstruction unification can be compile time
garbage collected.
hlds_out.m:
Output the can_cgc field.
ml_elim_nested.m:
ml_optimize.m:
Handle the new field maybe(mlds__tag) for assign operations in the
MLDS.
bytecode_gen.m:
code_aux.m:
common.m:
cse_detection.m:
dependency_graph.m:
det_analysis.m:
goal_util.m:
higher_order.m:
mark_static_terms.m:
mode_util.m:
modecheck_unify.m:
pd_cost.m:
pd_util.m:
prog_rep.m:
rl_exprn.m:
rl_key.m:
simplify.m:
switch_detection.m:
term_traversal.m:
unify_gen.m:
unused_args.m:
Handle the can compile time gc field in deconstruction unifications.
Index: bytecode_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/bytecode_gen.m,v
retrieving revision 1.50
diff -u -r1.50 bytecode_gen.m
--- bytecode_gen.m 2000/09/20 00:21:36 1.50
+++ bytecode_gen.m 2000/10/05 14:16:01
@@ -472,8 +472,8 @@
Pairs)])
)
).
-bytecode_gen__unify(deconstruct(Var, ConsId, Args, UniModes, _), _, _, ByteInfo,
- Code) :-
+bytecode_gen__unify(deconstruct(Var, ConsId, Args, UniModes, _, _), _, _,
+ ByteInfo, Code) :-
bytecode_gen__map_var(ByteInfo, Var, ByteVar),
bytecode_gen__map_vars(ByteInfo, Args, ByteArgs),
bytecode_gen__map_cons_id(ByteInfo, Var, ConsId, ByteConsId),
Index: code_aux.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_aux.m,v
retrieving revision 1.58
diff -u -r1.58 code_aux.m
--- code_aux.m 2000/08/09 07:46:18 1.58
+++ code_aux.m 2000/10/05 14:16:01
@@ -98,7 +98,7 @@
;
Uni = construct(_, _, _, _, _, _, _)
;
- Uni = deconstruct(_, _, _, _, _)
+ Uni = deconstruct(_, _, _, _, _, _)
).
% Complicated unifies are _non_builtin_
@@ -178,7 +178,7 @@
;
Uni = construct(_, _, _, _, _, _, _)
;
- Uni = deconstruct(_, _, _, _, _)
+ Uni = deconstruct(_, _, _, _, _, _)
).
% Complicated unifies are _non_builtin_
Index: common.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/common.m,v
retrieving revision 1.57
diff -u -r1.57 common.m
--- common.m 2000/08/07 07:23:51 1.57
+++ common.m 2000/10/05 14:16:01
@@ -162,7 +162,8 @@
common__record_cell(Var, ConsId, ArgVars, Info0, Info)
)
;
- Unification0 = deconstruct(Var, ConsId, ArgVars, UniModes, _),
+ Unification0 = deconstruct(Var, ConsId,
+ ArgVars, UniModes, _, _),
simplify_info_get_module_info(Info0, ModuleInfo),
(
% Don't optimise partially instantiated
Index: cse_detection.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/cse_detection.m,v
retrieving revision 1.63
diff -u -r1.63 cse_detection.m
--- cse_detection.m 2000/09/07 01:46:16 1.63
+++ cse_detection.m 2000/10/05 14:16:01
@@ -560,9 +560,10 @@
Typemap0, Typemap, Replacements) :-
(
GoalExpr0 = unify(_, Term, Umode, Unif0, Ucontext),
- Unif0 = deconstruct(_, Consid, Args, Submodes, CanFail)
+ Unif0 = deconstruct(_, Consid, Args, Submodes, CanFail, CanCGC)
->
- Unif = deconstruct(Var, Consid, Args, Submodes, CanFail),
+ Unif = deconstruct(Var, Consid, Args,
+ Submodes, CanFail, CanCGC),
( Term = functor(_, _) ->
GoalExpr1 = unify(Var, Term, Umode, Unif, Ucontext)
;
@@ -605,9 +606,9 @@
find_similar_deconstruct(OldUnifyGoal, NewUnifyGoal, Context, Replacements) :-
(
OldUnifyGoal = unify(_OT1, _OT2, _OM, OldUnifyInfo, OC) - _,
- OldUnifyInfo = deconstruct(_OV, OF, OFV, _OUM, _OCF),
+ OldUnifyInfo = deconstruct(_OV, OF, OFV, _OUM, _OCF, _OCGC),
NewUnifyGoal = unify(_NT1, _NT2, _NM, NewUnifyInfo, _NC) - _,
- NewUnifyInfo = deconstruct(_NV, NF, NFV, _NUM, _NCF)
+ NewUnifyInfo = deconstruct(_NV, NF, NFV, _NUM, _NCF, _NCGC)
->
OF = NF,
list__length(OFV, OFVC),
Index: dependency_graph.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dependency_graph.m,v
retrieving revision 1.48
diff -u -r1.48 dependency_graph.m
--- dependency_graph.m 2000/08/09 07:46:23 1.48
+++ dependency_graph.m 2000/10/05 14:16:02
@@ -267,7 +267,7 @@
; Unify = construct(_, Cons, _, _, _, _, _),
dependency_graph__add_arcs_in_cons(Cons, Caller,
DepGraph0, DepGraph)
- ; Unify = deconstruct(_, Cons, _, _, _),
+ ; Unify = deconstruct(_, Cons, _, _, _, _),
dependency_graph__add_arcs_in_cons(Cons, Caller,
DepGraph0, DepGraph)
; Unify = complicated_unify(_, _, _),
Index: det_analysis.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/det_analysis.m,v
retrieving revision 1.145
diff -u -r1.145 det_analysis.m
--- det_analysis.m 2000/08/09 07:46:24 1.145
+++ det_analysis.m 2000/10/05 14:16:02
@@ -900,7 +900,7 @@
:- pred det_infer_unify_examines_rep(unification::in, bool::out) is det.
det_infer_unify_examines_rep(assign(_, _), no).
det_infer_unify_examines_rep(construct(_, _, _, _, _, _, _), no).
-det_infer_unify_examines_rep(deconstruct(_, _, _, _, _), yes).
+det_infer_unify_examines_rep(deconstruct(_, _, _, _, _, _), yes).
det_infer_unify_examines_rep(simple_test(_, _), yes).
det_infer_unify_examines_rep(complicated_unify(_, _, _), no).
% Some complicated modes of complicated unifications _do_
@@ -922,7 +922,7 @@
:- pred det_infer_unify_canfail(unification, can_fail).
:- mode det_infer_unify_canfail(in, out) is det.
-det_infer_unify_canfail(deconstruct(_, _, _, _, CanFail), CanFail).
+det_infer_unify_canfail(deconstruct(_, _, _, _, CanFail, _), CanFail).
det_infer_unify_canfail(assign(_, _), cannot_fail).
det_infer_unify_canfail(construct(_, _, _, _, _, _, _), cannot_fail).
det_infer_unify_canfail(simple_test(_, _), can_fail).
Index: goal_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/goal_util.m,v
retrieving revision 1.64
diff -u -r1.64 goal_util.m
--- goal_util.m 2000/09/04 22:33:36 1.64
+++ goal_util.m 2000/10/05 14:16:02
@@ -447,8 +447,9 @@
How0 = construct_statically(_),
How = How0
).
-goal_util__rename_unify(deconstruct(Var0, ConsId, Vars0, Modes, Cat),
- Must, Subn, deconstruct(Var, ConsId, Vars, Modes, Cat)) :-
+goal_util__rename_unify(deconstruct(Var0, ConsId, Vars0, Modes, Cat, CanCGC),
+ Must, Subn,
+ deconstruct(Var, ConsId, Vars, Modes, Cat, CanCGC)) :-
goal_util__rename_var(Var0, Must, Subn, Var),
goal_util__rename_var_list(Vars0, Must, Subn, Vars).
goal_util__rename_unify(assign(L0, R0), Must, Subn, assign(L, R)) :-
@@ -984,7 +985,8 @@
list__map(InstToUniMode, ArgInsts, UniModes),
UniMode = (Inst0 -> Inst0) - (Inst0 -> Inst0),
UnifyContext = unify_context(explicit, []),
- Unification = deconstruct(Var, ConsId, ArgVars, UniModes, can_fail),
+ Unification = deconstruct(Var, ConsId, ArgVars, UniModes,
+ can_fail, no),
ExtraGoal = unify(Var, functor(ConsId, ArgVars),
UniMode, Unification, UnifyContext),
set__singleton_set(NonLocals, Var),
Index: higher_order.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.74
diff -u -r1.74 higher_order.m
--- higher_order.m 2000/09/25 04:22:33 1.74
+++ higher_order.m 2000/10/05 14:16:03
@@ -647,7 +647,7 @@
maybe_add_alias(Var1, Var2).
% deconstructing a higher order term is not allowed
-check_unify(deconstruct(_, _, _, _, _)) --> [].
+check_unify(deconstruct(_, _, _, _, _, _)) --> [].
check_unify(construct(LVar, ConsId, Args, _Modes, _, _, _), Info0, Info) :-
Info0 = info(PredVars0, Requests, NewPreds, PredProcId,
@@ -2056,7 +2056,7 @@
goal_info_init(NonLocals, InstMapDelta, det, GoalInfo),
Goal = unify(Arg, functor(ConsId, [UnwrappedArg]), In - Out,
deconstruct(Arg, ConsId, [UnwrappedArg], UniModes,
- cannot_fail),
+ cannot_fail, no),
unify_context(explicit, [])) - GoalInfo.
%-------------------------------------------------------------------------------
Index: hlds_goal.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.76
diff -u -r1.76 hlds_goal.m
--- hlds_goal.m 2000/09/07 01:46:21 1.76
+++ hlds_goal.m 2000/10/05 14:16:03
@@ -411,6 +411,9 @@
; modes_are_ok
.
+ % The cell is available for compile time garbage collected.
+:- type can_cgc == bool.
+
:- type unification
% A construction unification is a unification with a functor
% or lambda expression which binds the LHS variable,
@@ -477,8 +480,9 @@
% e.g. [X] in the above example.
list(uni_mode), % The lists of modes of the argument
% sub-unifications.
- can_fail % Whether or not the unification
+ can_fail, % Whether or not the unification
% could possibly fail.
+ can_cgc % Can compile time GC this cell
)
% Y = X where the top node of Y is output,
Index: hlds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.245
diff -u -r1.245 hlds_out.m
--- hlds_out.m 2000/09/25 04:22:34 1.245
+++ hlds_out.m 2000/10/05 14:16:03
@@ -1497,7 +1497,8 @@
hlds_out__write_unify_rhs_2(B, ModuleInfo, VarSet, InstVarSet,
AppendVarnums, Indent, Follow, VarType, TypeQual),
globals__io_lookup_string_option(dump_hlds_options, Verbose),
- ( { string__contains_char(Verbose, 'u') } ->
+ ( { string__contains_char(Verbose, 'u')
+ ; string__contains_char(Verbose, 'p') } ->
(
% don't output bogus info if we haven't been through
% mode analysis yet
@@ -1763,8 +1764,12 @@
ModuleInfo, ProgVarSet, InstVarSet, AppendVarnums, Indent).
hlds_out__write_unification(deconstruct(Var, ConsId, ArgVars, ArgModes,
- CanFail), ModuleInfo, ProgVarSet, InstVarSet, AppendVarnums,
- Indent) -->
+ CanFail, CanCGC),
+ ModuleInfo, ProgVarSet, InstVarSet, AppendVarnums, Indent) -->
+ hlds_out__write_indent(Indent),
+ io__write_string("% Compile time garbage collect: "),
+ io__write(CanCGC),
+ io__nl,
hlds_out__write_indent(Indent),
io__write_string("% "),
mercury_output_var(Var, ProgVarSet, AppendVarnums),
Index: mark_static_terms.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mark_static_terms.m,v
retrieving revision 1.2
diff -u -r1.2 mark_static_terms.m
--- mark_static_terms.m 2000/08/09 07:47:06 1.2
+++ mark_static_terms.m 2000/10/05 14:16:04
@@ -167,7 +167,7 @@
)
;
Unification0 = deconstruct(_Var, _ConsId, _ArgVars, _UniModes,
- _CanFail),
+ _CanFail, _CanCGC),
Unification = Unification0,
StaticVars = StaticVars0
/*****************
Index: ml_code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.22
diff -u -r1.22 ml_code_util.m
--- ml_code_util.m 2000/09/18 11:51:30 1.22
+++ ml_code_util.m 2000/10/05 14:16:04
@@ -32,6 +32,11 @@
% Generate an MLDS assignment statement.
:- func ml_gen_assign(mlds__lval, mlds__rval, prog_context) = mlds__statement.
+ % Generate an MLDS assignment statement where the lval must use
+ % the tag.
+:- func ml_gen_assign_with_tag(mlds__lval, mlds__rval,
+ mlds__tag, prog_context) = mlds__statement.
+
% Generate a block statement, i.e. `{ <Decls>; <Statements>; }'.
% But if the block consists only of a single statement with no
% declarations, then just return that statement.
@@ -593,8 +598,16 @@
%
% Generate an MLDS assignment statement.
-ml_gen_assign(Lval, Rval, Context) = MLDS_Statement :-
- Assign = assign(Lval, Rval),
+ml_gen_assign(Lval, Rval, Context) = ml_gen_assign(Lval, Rval, no, Context).
+
+ml_gen_assign_with_tag(Lval, Rval, Tag, Context)
+ = ml_gen_assign(Lval, Rval, yes(Tag), Context).
+
+:- func ml_gen_assign(mlds__lval, mlds__rval,
+ maybe(mlds__tag), prog_context) = mlds__statement.
+
+ml_gen_assign(Lval, Rval, MaybeTag, Context) = MLDS_Statement :-
+ Assign = assign(Lval, Rval, MaybeTag),
MLDS_Stmt = atomic(Assign),
MLDS_Statement = mlds__statement(MLDS_Stmt,
mlds__make_context(Context)).
@@ -1316,7 +1329,7 @@
%
ml_gen_set_success(Value, Context, MLDS_Statement) -->
ml_success_lval(Succeeded),
- { MLDS_Statement = ml_gen_assign(Succeeded, Value, Context) }.
+ { MLDS_Statement = ml_gen_assign(Succeeded, Value, no, Context) }.
%-----------------------------------------------------------------------------%
@@ -1339,7 +1352,7 @@
ml_gen_set_cond_var(CondVar, Value, Context, MLDS_Statement) -->
ml_cond_var_lval(CondVar, CondVarLval),
- { MLDS_Statement = ml_gen_assign(CondVarLval, Value, Context) }.
+ { MLDS_Statement = ml_gen_assign(CondVarLval, Value, no, Context) }.
%-----------------------------------------------------------------------------%
Index: ml_elim_nested.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.11
diff -u -r1.11 ml_elim_nested.m
--- ml_elim_nested.m 2000/08/02 14:13:04 1.11
+++ ml_elim_nested.m 2000/10/05 14:16:04
@@ -280,7 +280,7 @@
EnvArgLval = field(Tag, EnvPtr, FieldName, FieldType,
mlds__ptr_type(ClassType)),
ArgRval = lval(var(QualVarName)),
- AssignToEnv = assign(EnvArgLval, ArgRval),
+ AssignToEnv = assign(EnvArgLval, ArgRval, no),
CodeToCopyArg = mlds__statement(atomic(AssignToEnv), Context),
ArgsToCopy = [ArgToCopy | ArgsToCopy0],
@@ -415,7 +415,7 @@
%
EnvPtrVar = qual(ModuleName, "env_ptr"),
AssignEnvPtr = assign(var(EnvPtrVar), unop(cast(EnvPtrVarType),
- EnvPtrVal)),
+ EnvPtrVal), no),
InitEnvPtr = mlds__statement(atomic(AssignEnvPtr), Context).
% Given the declaration for a function parameter, produce a
@@ -745,9 +745,11 @@
:- mode fixup_atomic_stmt(in, out, in, out) is det.
fixup_atomic_stmt(comment(C), comment(C)) --> [].
-fixup_atomic_stmt(assign(Lval0, Rval0), assign(Lval, Rval)) -->
+fixup_atomic_stmt(assign(Lval0, Rval0, Tag), assign(Lval, Rval, Tag)) -->
fixup_lval(Lval0, Lval),
fixup_rval(Rval0, Rval).
+fixup_atomic_stmt(compile_time_gc(Lval0), compile_time_gc(Lval)) -->
+ fixup_lval(Lval0, Lval).
fixup_atomic_stmt(new_object(Target0, MaybeTag, Type, MaybeSize, MaybeCtorName,
Args0, ArgTypes),
new_object(Target, MaybeTag, Type, MaybeSize, MaybeCtorName,
@@ -1209,7 +1211,7 @@
:- mode atomic_stmt_contains_var(in, in) is semidet.
atomic_stmt_contains_var(comment(_), _Name) :- fail.
-atomic_stmt_contains_var(assign(Lval, Rval), Name) :-
+atomic_stmt_contains_var(assign(Lval, Rval, _MaybeTag), Name) :-
( lval_contains_var(Lval, Name)
; rval_contains_var(Rval, Name)
).
Index: ml_optimize.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_optimize.m,v
retrieving revision 1.2
diff -u -r1.2 ml_optimize.m
--- ml_optimize.m 2000/09/17 09:18:57 1.2
+++ ml_optimize.m 2000/10/05 14:16:04
@@ -248,7 +248,7 @@
Statement = statement(
atomic(assign(
var(QualVarName),
- lval(var(QualTempName)))),
+ lval(var(QualTempName)), no)),
OptInfo ^ context),
generate_assign_args(OptInfo, Rest, Args, Statements0,
TempDefns0),
Index: ml_unify_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_unify_gen.m,v
retrieving revision 1.17
diff -u -r1.17 ml_unify_gen.m
--- ml_unify_gen.m 2000/09/18 11:51:31 1.17
+++ ml_unify_gen.m 2000/10/05 14:16:05
@@ -85,25 +85,9 @@
%-----------------------------------------------------------------------------%
ml_gen_unification(assign(Var1, Var2), CodeModel, Context,
- [], MLDS_Statements) -->
- { require(unify(CodeModel, model_det),
- "ml_code_gen: assign not det") },
- (
- %
- % skip dummy argument types, since they will not have
- % been declared
- %
- ml_variable_type(Var1, Type),
- { type_util__is_dummy_argument_type(Type) }
- ->
- { MLDS_Statements = [] }
- ;
- ml_gen_var(Var1, Var1Lval),
- ml_gen_var(Var2, Var2Lval),
- { MLDS_Statement = ml_gen_assign(Var1Lval, lval(Var2Lval),
- Context) },
- { MLDS_Statements = [MLDS_Statement] }
- ).
+ MLDS_Defns, MLDS_Statements) -->
+ ml_gen_assign_unification(Var1, Var2, no, CodeModel, Context,
+ MLDS_Defns, MLDS_Statements).
ml_gen_unification(simple_test(Var1, Var2), CodeModel, Context,
[], [MLDS_Statement]) -->
@@ -132,33 +116,77 @@
;
true
},
- { HowToConstruct = reuse_cell(_) ->
- sorry("cell reuse")
- ;
- true
- },
ml_gen_construct(Var, ConsId, Args, ArgModes, HowToConstruct, Context,
MLDS_Decls, MLDS_Statements).
-ml_gen_unification(deconstruct(Var, ConsId, Args, ArgModes, CanFail),
+
+ml_gen_unification(deconstruct(Var, ConsId, Args, ArgModes, CanFail, CanCGC),
CodeModel, Context, MLDS_Decls, MLDS_Statements) -->
(
{ CanFail = can_fail },
{ require(unify(CodeModel, model_semi),
"ml_code_gen: can_fail deconstruct not semidet") },
ml_gen_semi_deconstruct(Var, ConsId, Args, ArgModes, Context,
- MLDS_Decls, MLDS_Statements)
+ MLDS_Decls, MLDS_Unif_Statements)
;
{ CanFail = cannot_fail },
{ require(unify(CodeModel, model_det),
"ml_code_gen: cannot_fail deconstruct not det") },
ml_gen_det_deconstruct(Var, ConsId, Args, ArgModes, Context,
- MLDS_Decls, MLDS_Statements)
- ).
+ MLDS_Decls, MLDS_Unif_Statements)
+ ),
+ (
+ { CanCGC = yes },
+ ml_gen_var(Var, VarLval),
+ { MLDS_Stmt = atomic(compile_time_gc(VarLval)) },
+ { MLDS_CGC_Statements = [mlds__statement(MLDS_Stmt,
+ mlds__make_context(Context)) ] }
+ ;
+ { CanCGC = no },
+ { MLDS_CGC_Statements = [] }
+ ),
+ { MLDS_Statements = MLDS_Unif_Statements `list__append`
+ MLDS_CGC_Statements }.
ml_gen_unification(complicated_unify(_, _, _), _, _, [], []) -->
% simplify.m should convert these into procedure calls
{ error("ml_code_gen: complicated unify") }.
+ % Generate MLDS code for an assignment unification where the
+ % LHS of the unification may need to use a different tag to the
+ % RHS.
+:- pred ml_gen_assign_unification(prog_var::in, prog_var::in,
+ maybe(mlds__tag)::in, code_model::in, prog_context::in,
+ mlds__defns::out, mlds__statements::out,
+ ml_gen_info::in, ml_gen_info::out) is det.
+
+ml_gen_assign_unification(Var1, Var2, MaybeTag, CodeModel, Context,
+ [], MLDS_Statements) -->
+ { require(unify(CodeModel, model_det),
+ "ml_code_gen: assign not det") },
+ (
+ %
+ % skip dummy argument types, since they will not have
+ % been declared
+ %
+ ml_variable_type(Var1, Type),
+ { type_util__is_dummy_argument_type(Type) }
+ ->
+ { MLDS_Statements = [] }
+ ;
+ ml_gen_var(Var1, Var1Lval),
+ ml_gen_var(Var2, Var2Lval),
+ (
+ { MaybeTag = no },
+ { MLDS_Statement = ml_gen_assign(Var1Lval,
+ lval(Var2Lval), Context) }
+ ;
+ { MaybeTag = yes(Tag) },
+ { MLDS_Statement = ml_gen_assign_with_tag(Var1Lval,
+ lval(Var2Lval), Tag, Context) }
+ ),
+ { MLDS_Statements = [MLDS_Statement] }
+ ).
+
% ml_gen_construct generations code for a construction unification.
%
% Note that the code for ml_gen_static_const_arg is very similar to
@@ -453,7 +481,7 @@
% generate a `new_object' statement (or static constant)
% for the closure
%
- ml_gen_new_object(Tag, CtorName, Var, ExtraArgRvals, ExtraArgTypes,
+ ml_gen_new_object(no, Tag, CtorName, Var, ExtraArgRvals, ExtraArgTypes,
ArgVars, ArgModes, HowToConstruct, Context,
MLDS_Decls, MLDS_Statements).
@@ -861,9 +889,9 @@
ExtraRvals = [],
ExtraArgTypes = []
},
- ml_gen_new_object(Tag, CtorName, Var, ExtraRvals, ExtraArgTypes,
- ArgVars, ArgModes, HowToConstruct, Context,
- MLDS_Decls, MLDS_Statements).
+ ml_gen_new_object(yes(ConsId), Tag, CtorName, Var,
+ ExtraRvals, ExtraArgTypes, ArgVars, ArgModes,
+ HowToConstruct, Context, MLDS_Decls, MLDS_Statements).
%
% ml_gen_new_object:
@@ -873,14 +901,15 @@
% 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,
+:- pred ml_gen_new_object(maybe(cons_id), 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, in, in, out, out, in, out)
- is det.
+:- mode ml_gen_new_object(in, in, in, in, in, in, in, in, in, in, out, out,
+ in, out) is det.
-ml_gen_new_object(Tag, CtorName, Var, ExtraRvals, ExtraTypes,
+ml_gen_new_object(MaybeConsId, Tag, CtorName, Var, ExtraRvals, ExtraTypes,
ArgVars, ArgModes, HowToConstruct, Context,
MLDS_Decls, MLDS_Statements) -->
%
@@ -984,8 +1013,46 @@
{ MLDS_Decls = list__append(BoxConstDefns, [ConstDefn]) },
{ MLDS_Statements = [AssignStatement] }
;
- { HowToConstruct = reuse_cell(_) },
- { sorry("cell reuse") }
+ { HowToConstruct = reuse_cell(CellToReuse) },
+ { CellToReuse = cell_to_reuse(ReuseVar, ReuseConsId, _) },
+
+ { MaybeConsId = yes(ConsId0) ->
+ ConsId = ConsId0
+ ;
+ error("ml_gen_new_object: unknown cons id")
+ },
+
+ ml_variable_type(ReuseVar, ReuseType),
+ ml_cons_id_to_tag(ReuseConsId, ReuseType, ReuseConsIdTag),
+ { ml_tag_offset_and_argnum(ReuseConsIdTag,
+ ReusePrimaryTag, _ReuseOffSet, _ReuseArgNum) },
+
+ ml_cons_id_to_tag(ConsId, Type, ConsIdTag),
+ ml_field_names_and_types(Type, ConsId, ArgTypes, Fields),
+ { ml_tag_offset_and_argnum(ConsIdTag,
+ PrimaryTag, OffSet, ArgNum) },
+
+ { ReusePrimaryTag = PrimaryTag ->
+ MaybeRetagLval = no
+ ;
+ MaybeRetagLval = yes(PrimaryTag)
+ },
+
+ ml_gen_assign_unification(Var, ReuseVar, MaybeRetagLval,
+ model_det, Context,
+ MLDS_Decls, MLDS_StatementsA),
+
+ %
+ % For each field in the construction unification we need
+ % to generate an rval.
+ % XXX we do more work then we need to here, as some of
+ % the cells may already contain the correct values.
+ %
+ ml_gen_unify_args(ConsId, ArgVars, ArgModes, ArgTypes,
+ Fields, Type, VarLval, OffSet,
+ ArgNum, PrimaryTag, Context, MLDS_StatementsB),
+
+ { MLDS_Statements = MLDS_StatementsA `append` MLDS_StatementsB }
).
:- pred ml_gen_box_const_rval_list(list(mlds__type), list(mlds__rval),
@@ -1230,19 +1297,75 @@
ml_gen_var(Var, VarLval),
ml_variable_types(Args, ArgTypes),
ml_field_names_and_types(Type, ConsId, ArgTypes, Fields),
+ { ml_tag_offset_and_argnum(Tag, _, OffSet, ArgNum) },
ml_gen_unify_args(ConsId, Args, Modes, ArgTypes, Fields, Type,
- VarLval, 0, 1, UnsharedTag, Context, MLDS_Statements)
+ VarLval, OffSet, ArgNum,
+ UnsharedTag, Context, MLDS_Statements)
;
{ Tag = shared_remote_tag(PrimaryTag, _SecondaryTag) },
ml_gen_var(Var, VarLval),
ml_variable_types(Args, ArgTypes),
ml_field_names_and_types(Type, ConsId, ArgTypes, Fields),
+ { ml_tag_offset_and_argnum(Tag, _, OffSet, ArgNum) },
ml_gen_unify_args(ConsId, Args, Modes, ArgTypes, Fields, Type,
- VarLval, 1, 1, PrimaryTag, Context, MLDS_Statements)
+ VarLval, OffSet, ArgNum,
+ PrimaryTag, Context, MLDS_Statements)
;
{ Tag = shared_local_tag(_Bits1, _Num1) },
{ MLDS_Statements = [] } % if this is det, then nothing happens
).
+
+ % Calculate the integer offset used to reference the first field
+ % of a structure for lowlevel data or the first argument number
+ % to access the field using the highlevel data representation.
+ % Abort if the tag indicates that the data doesn't have any
+ % fields.
+:- pred ml_tag_offset_and_argnum(cons_tag::in, tag_bits::out,
+ int::out, int::out) is det.
+
+ml_tag_offset_and_argnum(Tag, TagBits, OffSet, ArgNum) :-
+ (
+ Tag = unshared_tag(UnsharedTag),
+ TagBits = UnsharedTag,
+ OffSet = 0,
+ ArgNum = 1
+ ;
+ Tag = shared_remote_tag(PrimaryTag, _SecondaryTag),
+ TagBits = PrimaryTag,
+ OffSet = 1,
+ ArgNum = 1
+ ;
+ Tag = string_constant(_String),
+ error("ml_tag_offset_and_argnum")
+ ;
+ Tag = int_constant(_Int),
+ error("ml_tag_offset_and_argnum")
+ ;
+ Tag = float_constant(_Float),
+ error("ml_tag_offset_and_argnum")
+ ;
+ Tag = pred_closure_tag(_, _, _),
+ error("ml_tag_offset_and_argnum")
+ ;
+ Tag = code_addr_constant(_, _),
+ error("ml_tag_offset_and_argnum")
+ ;
+ Tag = type_ctor_info_constant(_, _, _),
+ error("ml_tag_offset_and_argnum")
+ ;
+ Tag = base_typeclass_info_constant(_, _, _),
+ error("ml_tag_offset_and_argnum")
+ ;
+ Tag = tabling_pointer_constant(_, _),
+ error("ml_tag_offset_and_argnum")
+ ;
+ Tag = no_tag,
+ error("ml_tag_offset_and_argnum")
+ ;
+ Tag = shared_local_tag(_Bits1, _Num1),
+ error("ml_tag_offset_and_argnum")
+ ).
+
% Given a type and a cons_id, and also the types of the actual
% arguments of that cons_id in some particular use of it,
Index: mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.34
diff -u -r1.34 mlds.m
--- mlds.m 2000/09/06 05:20:58 1.34
+++ mlds.m 2000/10/05 14:16:06
@@ -821,14 +821,19 @@
---> comment(string)
% Insert a comment into the output code.
- ; assign(mlds__lval, mlds__rval)
- % assign(Location, Value):
+ ; assign(mlds__lval, mlds__rval, maybe(mlds__tag))
+ % assign(Location, Value, MaybeTag):
% Assign the value specified by rval to the location
- % specified by lval.
+ % specified by lval. Possibly changing the tag
+ % on the lval, if required.
%
% heap management
%
+
+ ; compile_time_gc(mlds__lval)
+ % Compile time garbage collect the memory used
+ % by the lval.
% XXX the following is still quite tentative
% new_object(Target, Tag, Type,
Index: mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.57
diff -u -r1.57 mlds_to_c.m
--- mlds_to_c.m 2000/09/18 11:51:31 1.57
+++ mlds_to_c.m 2000/10/05 14:16:06
@@ -2179,16 +2179,31 @@
%
% assignment
%
-mlds_output_atomic_stmt(Indent, _FuncInfo, assign(Lval, Rval), _) -->
+mlds_output_atomic_stmt(Indent, _FuncInfo, assign(Lval, Rval, MaybeTag), _) -->
mlds_indent(Indent),
mlds_output_lval(Lval),
io__write_string(" = "),
mlds_output_rval(Rval),
- io__write_string(";\n").
+ io__write_string(";\n"),
+ (
+ { MaybeTag = yes(Tag) },
+ mlds_indent(Indent),
+ mlds_output_lval(Lval),
+ io__write_string(" = (MR_Word) MR_mkword(MR_strip_tag("),
+ mlds_output_lval(Lval),
+ io__write_string("), "),
+ mlds_output_tag(Tag),
+ io__write_string(");\n")
+ ;
+ { MaybeTag = no }
+ ).
%
% heap management
%
+mlds_output_atomic_stmt(_Indent, _FuncInfo, compile_time_gc(_Lval), _) -->
+ { error("mlds_to_c.m: sorry, compile time gc not implemented") }.
+
mlds_output_atomic_stmt(Indent, FuncInfo, NewObject, Context) -->
{ NewObject = new_object(Target, MaybeTag, Type, MaybeSize,
MaybeCtorName, Args, ArgTypes) },
Index: mode_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mode_util.m,v
retrieving revision 1.130
diff -u -r1.130 mode_util.m
--- mode_util.m 2000/09/20 12:12:03 1.130
+++ mode_util.m 2000/10/05 14:16:08
@@ -1426,7 +1426,7 @@
% that can require updating of the instmap_delta after simplify.m
% has been run.
(
- Uni = deconstruct(Var, _ConsId, Vars, UniModes, _)
+ Uni = deconstruct(Var, _ConsId, Vars, UniModes, _, _CanCGC)
->
% Get the final inst of the deconstructed var, which
% will be the same as in the old instmap.
Index: modecheck_unify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modecheck_unify.m,v
retrieving revision 1.42
diff -u -r1.42 modecheck_unify.m
--- modecheck_unify.m 2000/05/22 18:00:22 1.42
+++ modecheck_unify.m 2000/10/05 14:16:09
@@ -133,7 +133,8 @@
% fields created by polymorphism.m
Unification0 \= construct(_, code_addr_const(_, _),
_, _, _, _, _),
- Unification0 \= deconstruct(_, code_addr_const(_, _), _, _, _)
+ Unification0 \= deconstruct(_,
+ code_addr_const(_, _), _, _, _, _)
->
%
% convert the pred term to a lambda expression
@@ -623,7 +624,7 @@
Unification, ArgVars, ExtraGoals) -->
(
{ Unification0 = deconstruct(X, ConsId, ArgVars0, ArgModes0,
- Det) }
+ Det, CanCGC) }
->
(
split_complicated_subunifies_2(ArgVars0, ArgModes0,
@@ -632,7 +633,7 @@
{ ExtraGoals = ExtraGoals1 },
{ ArgVars = ArgVars1 },
{ Unification = deconstruct(X, ConsId, ArgVars,
- ArgModes0, Det) }
+ ArgModes0, Det, CanCGC) }
;
{ error("split_complicated_subunifies_2 failed") }
)
@@ -985,7 +986,7 @@
( Unification0 = construct(_, ConsId0, _, _, _, _, AditiInfo0) ->
AditiInfo = AditiInfo0,
ConsId = ConsId0
- ; Unification0 = deconstruct(_, ConsId1, _, _, _) ->
+ ; Unification0 = deconstruct(_, ConsId1, _, _, _, _) ->
AditiInfo = no,
ConsId = ConsId1
;
@@ -1082,7 +1083,7 @@
% if we are re-doing mode analysis, preserve the existing cons_id
( Unification0 = construct(_, ConsId0, _, _, _, _, _) ->
ConsId = ConsId0
- ; Unification0 = deconstruct(_, ConsId1, _, _, _) ->
+ ; Unification0 = deconstruct(_, ConsId1, _, _, _, _) ->
ConsId = ConsId1
;
ConsId = NewConsId
@@ -1148,7 +1149,8 @@
ModeInfo = ModeInfo0
)
),
- Unification = deconstruct(X, ConsId, ArgVars, ArgModes, CanFail)
+ Unification = deconstruct(X, ConsId, ArgVars,
+ ArgModes, CanFail, no)
).
% Check that any type_info or type_class_info variables
Index: pd_cost.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pd_cost.m,v
retrieving revision 1.8
diff -u -r1.8 pd_cost.m
--- pd_cost.m 2000/08/09 07:47:34 1.8
+++ pd_cost.m 2000/10/05 14:16:14
@@ -128,7 +128,7 @@
Cost = 0
).
-pd_cost__unify(NonLocals, deconstruct(_, _, Args, _, CanFail), Cost) :-
+pd_cost__unify(NonLocals, deconstruct(_, _, Args, _, CanFail, _), Cost) :-
( CanFail = can_fail ->
pd_cost__simple_test(Cost0)
;
Index: pd_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pd_util.m,v
retrieving revision 1.11
diff -u -r1.11 pd_util.m
--- pd_util.m 2000/09/07 01:46:44 1.11
+++ pd_util.m 2000/10/05 14:16:14
@@ -934,9 +934,9 @@
NewArgs = [NewVar | NewArgs1]
;
OldUnification = deconstruct(OldVar, ConsId,
- OldArgs1, _, _),
+ OldArgs1, _, _, _),
NewUnification = deconstruct(NewVar, ConsId,
- NewArgs1, _, _),
+ NewArgs1, _, _, _),
OldArgs = [OldVar | OldArgs1],
NewArgs = [NewVar | NewArgs1]
)
Index: prog_rep.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_rep.m,v
retrieving revision 1.1
diff -u -r1.1 prog_rep.m
--- prog_rep.m 2000/09/25 04:37:12 1.1
+++ prog_rep.m 2000/10/05 14:16:14
@@ -108,7 +108,7 @@
list__map(term__var_to_int, Args, ArgsRep),
AtomicGoalRep = unify_construct_rep(VarRep, ConsIdRep, ArgsRep)
;
- Uni = deconstruct(Var, ConsId, Args, _, _),
+ Uni = deconstruct(Var, ConsId, Args, _, _, _),
term__var_to_int(Var, VarRep),
prog_rep__represent_cons_id(ConsId, ConsIdRep),
list__map(term__var_to_int, Args, ArgsRep),
Index: rl_exprn.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl_exprn.m,v
retrieving revision 1.16
diff -u -r1.16 rl_exprn.m
--- rl_exprn.m 2000/08/09 07:47:46 1.16
+++ rl_exprn.m 2000/10/05 14:16:17
@@ -1150,7 +1150,7 @@
{ error("rl_exprn__unify: unsupported cons_id - tabling_pointer_const") }
).
-rl_exprn__unify(deconstruct(Var, ConsId, Args, UniModes, CanFail),
+rl_exprn__unify(deconstruct(Var, ConsId, Args, UniModes, CanFail, _CanCGC),
GoalInfo, Fail, Code) -->
rl_exprn_info_lookup_var(Var, VarLoc),
rl_exprn_info_lookup_var_type(Var, Type),
Index: rl_key.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl_key.m,v
retrieving revision 1.7
diff -u -r1.7 rl_key.m
--- rl_key.m 2000/09/18 11:51:43 1.7
+++ rl_key.m 2000/10/05 14:16:17
@@ -793,7 +793,7 @@
rl_key__extract_key_range_unify(construct(Var, ConsId, Args, _, _, _, _)) -->
rl_key__unify_functor(Var, ConsId, Args).
rl_key__extract_key_range_unify(
- deconstruct(Var, ConsId, Args, _, _)) -->
+ deconstruct(Var, ConsId, Args, _, _, _)) -->
rl_key__unify_functor(Var, ConsId, Args).
rl_key__extract_key_range_unify(complicated_unify(_, _, _)) -->
{ error("rl_key__extract_key_range_unify") }.
Index: simplify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.86
diff -u -r1.86 simplify.m
--- simplify.m 2000/09/18 08:57:26 1.86
+++ simplify.m 2000/10/05 14:16:21
@@ -1730,7 +1730,7 @@
UniMode = (Inst0 -> Inst0) - (Inst0 -> Inst0),
UnifyContext = unify_context(explicit, []),
Unification = deconstruct(Var, ConsId,
- ArgVars, UniModes, can_fail),
+ ArgVars, UniModes, can_fail, no),
ExtraGoal = unify(Var, functor(ConsId, ArgVars),
UniMode, Unification, UnifyContext),
set__singleton_set(NonLocals, Var),
Index: switch_detection.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/switch_detection.m,v
retrieving revision 1.90
diff -u -r1.90 switch_detection.m
--- switch_detection.m 2000/08/09 07:47:53 1.90
+++ switch_detection.m 2000/10/05 14:16:21
@@ -436,14 +436,14 @@
_Result0, Result, _, unit) :-
(
Goal0 = unify(A, B, C, UnifyInfo0, E) - GoalInfo,
- UnifyInfo0 = deconstruct(A, Functor, F, G, _)
+ UnifyInfo0 = deconstruct(A, Functor, F, G, _, I)
->
Result = yes(Functor),
% The deconstruction unification now becomes
% deterministic, since the test will get
% carried out in the switch.
UnifyInfo = deconstruct(A, Functor, F, G,
- cannot_fail),
+ cannot_fail, I),
Goals = [unify(A, B, C, UnifyInfo, E) - GoalInfo]
;
error("find_bind_var_for_switch_in_deconstruct")
@@ -479,7 +479,7 @@
(
% check whether the unification is a deconstruction
% unification on Var or a variable aliased to Var
- UnifyInfo0 = deconstruct(UnifyVar, _, _, _, _),
+ UnifyInfo0 = deconstruct(UnifyVar, _, _, _, _, _),
term__apply_rec_substitution(
term__variable(Var),
Substitution0, term__variable(Var1)),
Index: term_traversal.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/term_traversal.m,v
retrieving revision 1.13
diff -u -r1.13 term_traversal.m
--- term_traversal.m 2000/08/09 07:47:56 1.13
+++ term_traversal.m 2000/10/05 14:16:21
@@ -130,7 +130,7 @@
Info = Info0
)
;
- Unification = deconstruct(InVar, ConsId, Args, Modes, _),
+ Unification = deconstruct(InVar, ConsId, Args, Modes, _, _),
(
unify_change(InVar, ConsId, Args, Modes, Params,
Gamma0, InVars0, OutVars)
Index: unify_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_gen.m,v
retrieving revision 1.110
diff -u -r1.110 unify_gen.m
--- unify_gen.m 2000/09/25 04:24:16 1.110
+++ unify_gen.m 2000/10/05 14:16:22
@@ -70,7 +70,8 @@
{ Code = empty }
)
;
- { Uni = deconstruct(Var, ConsId, Args, Modes, _CanFail) },
+ { Uni = deconstruct(Var, ConsId, Args, Modes,
+ _CanFail, _CanCGC) },
( { CodeModel = model_det } ->
unify_gen__generate_det_deconstruction(Var, ConsId,
Args, Modes, Code)
Index: unused_args.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unused_args.m,v
retrieving revision 1.67
diff -u -r1.67 unused_args.m
--- unused_args.m 2000/09/07 01:47:00 1.67
+++ unused_args.m 2000/10/05 14:16:22
@@ -455,7 +455,8 @@
).
traverse_goal(ModuleInfo,
- unify(Var1, _, _, deconstruct(_, _, Args, Modes, CanFail), _),
+ unify(Var1, _, _,
+ deconstruct(_, _, Args, Modes, CanFail, _), _),
UseInf0, UseInf) :-
partition_deconstruct_args(ModuleInfo, Args,
Modes, InputVars, OutputVars),
@@ -1353,7 +1354,7 @@
\+ list__member(LVar, UnusedVars).
fixup_unify(ModuleInfo, UnusedVars, Changed, Unify, Unify) :-
- Unify = deconstruct(LVar, _, ArgVars, ArgModes, CanFail),
+ Unify = deconstruct(LVar, _, ArgVars, ArgModes, CanFail, _CanCGC),
\+ list__member(LVar, UnusedVars),
(
% are any of the args unused, if so we need to
--------------------------------------------------------------------------
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