[m-rev.] for review: Construct partially instantiated direct arg functor values.
Peter Wang
novalazy at gmail.com
Tue Feb 12 17:40:26 AEDT 2013
Branches: main, release
---
Construct partially instantiated direct arg functor values.
Construction unifications of partially instantiated values involving direct
argument functors (where the single argument is free) did not generate any code
in both low-level and high-level backends. Incorrect behaviour could result if
the program tried to deconstruct the value at run-time.
Also, in the LLDS backend, such a construction unification did not enter the
variable into the var_state_map, leading to a compiler abort when the variable
is looked up.
compiler/ml_unify_gen.m:
Generate code for constructions of a direct arg functor with free
argument. This amounts to assigning a variable to a tagged null
pointer.
compiler/llds.m:
Add an rval option `mkword_hole', which is like `mkword' but the
pointer to be tagged is unspecified.
compiler/unify_gen.m:
Assign a variable to an `mkword_hole' rval, for a construction
unification of a direct arg functor with a free argument.
Reassign the variable to an `mkword' rval when the argument becomes
bound in a later unification.
compiler/code_info.m:
compiler/var_locn.m:
Add a predicate to reassign a variable from a `mkword_hole' expression
to a `mkword' expression.
compiler/llds_out_data.m:
Write out `mkword_hole' values as a tagged null pointer in C code.
compiler/call_gen.m:
compiler/code_util.m:
compiler/dupelim.m:
compiler/dupproc.m:
compiler/exprn_aux.m:
compiler/global_data.m:
compiler/jumpopt.m:
compiler/livemap.m:
compiler/llds_to_x86_64.m:
compiler/middle_rec.m:
compiler/opt_debug.m:
compiler/opt_util.m:
compiler/peephole.m:
compiler/stack_layout.m:
Conform to addition of `mkword_hole'.
tests/hard_coded/Mmakefile:
tests/hard_coded/direct_arg_partial_inst.exp:
tests/hard_coded/direct_arg_partial_inst.m:
tests/hard_coded/direct_arg_partial_inst2.exp:
tests/hard_coded/direct_arg_partial_inst2.m:
Add test cases.
diff --git a/compiler/call_gen.m b/compiler/call_gen.m
index 8f5b4b5..2455d93 100644
--- a/compiler/call_gen.m
+++ b/compiler/call_gen.m
@@ -766,6 +766,7 @@ generate_builtin_arg(Rval0, Rval, Code, !CI) :-
; Rval0 = unop(_, _)
; Rval0 = binop(_, _, _)
; Rval0 = mkword(_, _)
+ ; Rval0 = mkword_hole(_)
; Rval0 = mem_addr(_)
; Rval0 = lval(_)
),
diff --git a/compiler/code_info.m b/compiler/code_info.m
index 2fe987f..2f1e64d 100644
--- a/compiler/code_info.m
+++ b/compiler/code_info.m
@@ -3764,6 +3764,9 @@ should_add_region_ops(CodeInfo, _GoalInfo) = AddRegionOps :-
:- pred assign_expr_to_var(prog_var::in, rval::in, llds_code::out,
code_info::in, code_info::out) is det.
+:- pred reassign_mkword_hole_var(prog_var::in, tag::in, rval::in,
+ llds_code::out, code_info::in, code_info::out) is det.
+
:- pred assign_field_lval_expr_to_var(prog_var::in, list(lval)::in, rval::in,
llds_code::out, code_info::in, code_info::out) is det.
@@ -3916,6 +3919,20 @@ assign_expr_to_var(Var, Rval, Code, !CI) :-
),
set_var_locn_info(VarLocnInfo, !CI).
+reassign_mkword_hole_var(Var, Ptag, Rval, Code, !CI) :-
+ get_var_locn_info(!.CI, VarLocnInfo0),
+ Lvals = lvals_in_rval(Rval),
+ (
+ Lvals = [],
+ get_module_info(!.CI, ModuleInfo),
+ var_locn_reassign_mkword_hole_var(ModuleInfo, Var, Ptag, Rval, Code,
+ VarLocnInfo0, VarLocnInfo)
+ ;
+ Lvals = [_ | _],
+ unexpected($module, $pred, "non-var lvals")
+ ),
+ set_var_locn_info(VarLocnInfo, !CI).
+
assign_field_lval_expr_to_var(Var, FieldLvals, Rval, Code, !CI) :-
(
FieldLvals = [field(MaybeTag, var(BaseVar), _) | RestFieldLvals],
diff --git a/compiler/code_util.m b/compiler/code_util.m
index 0d0d382..f59c5b6 100644
--- a/compiler/code_util.m
+++ b/compiler/code_util.m
@@ -382,6 +382,7 @@ lvals_in_lvals([First | Rest]) = FirstLvals ++ RestLvals :-
lvals_in_rval(lval(Lval)) = [Lval | lvals_in_lval(Lval)].
lvals_in_rval(var(_)) = [].
lvals_in_rval(mkword(_, Rval)) = lvals_in_rval(Rval).
+lvals_in_rval(mkword_hole(_)) = [].
lvals_in_rval(const(_)) = [].
lvals_in_rval(unop(_, Rval)) = lvals_in_rval(Rval).
lvals_in_rval(binop(_, Rval1, Rval2)) =
diff --git a/compiler/dupelim.m b/compiler/dupelim.m
index f05b5b3..3afe74a 100644
--- a/compiler/dupelim.m
+++ b/compiler/dupelim.m
@@ -530,6 +530,7 @@ standardize_rval(Rval0, Rval) :-
Rval = lval(Lval)
;
( Rval0 = mkword(_, _)
+ ; Rval0 = mkword_hole(_)
; Rval0 = const(_)
; Rval0 = mem_addr(_)
),
diff --git a/compiler/dupproc.m b/compiler/dupproc.m
index b513d3f..5c09caa 100644
--- a/compiler/dupproc.m
+++ b/compiler/dupproc.m
@@ -411,6 +411,9 @@ standardize_rval(Rval, StdRval, DupProcMap) :-
Rval = mkword(_, _),
StdRval = Rval
;
+ Rval = mkword_hole(_),
+ StdRval = Rval
+ ;
Rval = const(Const),
standardize_rval_const(Const, StdConst, DupProcMap),
StdRval = const(StdConst)
diff --git a/compiler/exprn_aux.m b/compiler/exprn_aux.m
index 3bbf98d..8c1fff6 100644
--- a/compiler/exprn_aux.m
+++ b/compiler/exprn_aux.m
@@ -199,6 +199,7 @@ vars_in_rval(lval(Lval), Vars) :-
vars_in_rval(var(Var), [Var]).
vars_in_rval(mkword(_, Rval), Vars) :-
vars_in_rval(Rval, Vars).
+vars_in_rval(mkword_hole(_Tag), []).
vars_in_rval(const(_Conts), []).
vars_in_rval(unop(_Unop, Rval), Vars) :-
vars_in_rval(Rval, Vars).
@@ -520,6 +521,9 @@ transform_lval_in_rval(Transform, Rval0, Rval, !Acc) :-
transform_lval_in_rval(Transform, Rval1, Rval2, !Acc),
Rval = mkword(Tag, Rval2)
;
+ Rval0 = mkword_hole(_Tag),
+ Rval = Rval0
+ ;
Rval0 = const(_Const),
Rval = Rval0
;
@@ -650,6 +654,9 @@ substitute_rval_in_rval(OldRval, NewRval, Rval0, Rval) :-
substitute_rval_in_rval(OldRval, NewRval, Rval1, Rval2),
Rval = mkword(Tag, Rval2)
;
+ Rval0 = mkword_hole(_),
+ Rval = Rval0
+ ;
Rval0 = const(_Const),
Rval = Rval0
;
@@ -834,6 +841,7 @@ rval_addrs(lval(Lval), CodeAddrs, DataIds) :-
rval_addrs(var(_Var), [], []).
rval_addrs(mkword(_Tag, Rval), CodeAddrs, DataIds) :-
rval_addrs(Rval, CodeAddrs, DataIds).
+rval_addrs(mkword_hole(_Tag), [], []).
rval_addrs(const(Const), CodeAddrs, DataIds) :-
( Const = llconst_code_addr(CodeAddress) ->
CodeAddrs = [CodeAddress],
diff --git a/compiler/global_data.m b/compiler/global_data.m
index 2d20842..6519d58 100644
--- a/compiler/global_data.m
+++ b/compiler/global_data.m
@@ -1288,6 +1288,9 @@ remap_rval(Remap, Rval0, Rval) :-
remap_rval(Remap, Ptr0, Ptr),
Rval = mkword(Tag, Ptr)
;
+ Rval0 = mkword_hole(_Tag),
+ Rval = Rval0
+ ;
Rval0 = const(Const0),
remap_rval_const(Remap, Const0, Const),
Rval = const(Const)
diff --git a/compiler/jumpopt.m b/compiler/jumpopt.m
index 708b1d8..660161e 100644
--- a/compiler/jumpopt.m
+++ b/compiler/jumpopt.m
@@ -1123,6 +1123,7 @@ short_labels_rval(_, var(_), _) :-
unexpected($module, $pred, "var").
short_labels_rval(InstrMap, mkword(Tag, Rval0), mkword(Tag, Rval)) :-
short_labels_rval(InstrMap, Rval0, Rval).
+short_labels_rval(_, mkword_hole(Tag), mkword_hole(Tag)).
short_labels_rval(InstrMap, const(Const0), const(Const)) :-
short_labels_const(InstrMap, Const0, Const).
short_labels_rval(InstrMap, unop(Op, Rval0), unop(Op, Rval)) :-
diff --git a/compiler/livemap.m b/compiler/livemap.m
index 417bcaf..1e82749 100644
--- a/compiler/livemap.m
+++ b/compiler/livemap.m
@@ -537,6 +537,7 @@ make_live_in_rval(lval(Lval), !Live) :-
make_live_in_rvals(AccessRvals, !Live).
make_live_in_rval(mkword(_, Rval), !Live) :-
make_live_in_rval(Rval, !Live).
+make_live_in_rval(mkword_hole(_), !Live).
make_live_in_rval(const(_), !Live).
make_live_in_rval(unop(_, Rval), !Live) :-
make_live_in_rval(Rval, !Live).
diff --git a/compiler/llds.m b/compiler/llds.m
index 780dd5d..6026600 100644
--- a/compiler/llds.m
+++ b/compiler/llds.m
@@ -1179,6 +1179,9 @@
; mkword(tag, rval)
% Given a pointer and a tag, mkword returns a tagged pointer.
+ ; mkword_hole(tag)
+ % Make a tagged pointer to an address which is not yet known.
+
; const(rval_const)
; unop(unary_op, rval)
@@ -1666,6 +1669,7 @@ rval_type(var(_), _) :-
% it is only the reverse direction we need to avoid.
%
rval_type(mkword(_, _), lt_data_ptr).
+rval_type(mkword_hole(_), lt_data_ptr).
rval_type(const(Const), Type) :-
const_type(Const, Type).
rval_type(unop(UnOp, _), Type) :-
diff --git a/compiler/llds_out_data.m b/compiler/llds_out_data.m
index fd2fbef..07b31c3 100644
--- a/compiler/llds_out_data.m
+++ b/compiler/llds_out_data.m
@@ -686,6 +686,8 @@ output_record_rval_decls_format(Info, Rval, FirstIndent, LaterIndent,
output_record_rval_decls_format(Info, SubRval,
FirstIndent, LaterIndent, !N, !DeclSet, !IO)
;
+ Rval = mkword_hole(_)
+ ;
Rval = const(Const),
( Const = llconst_code_addr(CodeAddress) ->
output_record_code_addr_decls_format(Info, CodeAddress,
@@ -1021,6 +1023,11 @@ output_rval(Info, Rval, !IO) :-
io.write_string(")", !IO)
)
;
+ Rval = mkword_hole(Tag),
+ io.write_string("MR_tmkword(", !IO),
+ io.write_int(Tag, !IO),
+ io.write_string(", 0)", !IO)
+ ;
Rval = lval(Lval),
% If a field is used as an rval, then we need to use the
% MR_const_field() macro or its variants, not the MR_field() macro
diff --git a/compiler/llds_to_x86_64.m b/compiler/llds_to_x86_64.m
index b3371bf..f1ceb87 100644
--- a/compiler/llds_to_x86_64.m
+++ b/compiler/llds_to_x86_64.m
@@ -654,6 +654,8 @@ transform_rval(!RegMap, mkword(Tag, Rval), no, Instrs) :-
LoadAddr = x86_64_instr(lea(MemRef, TempReg)),
SetTag = x86_64_instr(add(operand_imm(imm32(int32(Tag))), TempReg)),
Instrs = yes(Instr0 ++ [LoadAddr] ++ [SetTag]).
+transform_rval(!RegMap, mkword_hole(_), _, _) :-
+ sorry($module, $pred, "mkword_hole").
transform_rval(!RegMap, const(llconst_true), Op, no) :-
Op = yes(operand_label("<<llconst_true>>")).
transform_rval(!RegMap, const(llconst_false), Op, no) :-
diff --git a/compiler/middle_rec.m b/compiler/middle_rec.m
index a692520..81bfd7b 100644
--- a/compiler/middle_rec.m
+++ b/compiler/middle_rec.m
@@ -673,6 +673,8 @@ find_used_registers_rval(Rval, !Used) :-
Rval = mkword(_, Rval1),
find_used_registers_rval(Rval1, !Used)
;
+ Rval = mkword_hole(_)
+ ;
Rval = const(_)
;
Rval = unop(_, Rval1),
diff --git a/compiler/ml_unify_gen.m b/compiler/ml_unify_gen.m
index 31188c4..bcd5c47 100644
--- a/compiler/ml_unify_gen.m
+++ b/compiler/ml_unify_gen.m
@@ -2108,11 +2108,18 @@ ml_gen_direct_arg_construct(ModuleInfo, Mode, Ptag,
Statement = ml_gen_assign(VarLval, CastRval, Context),
Statements = [Statement]
;
- % Unused - unused: the unification has no effect.
+ % Unused - unused: it is a partial assignment to the LHS
+ % where the tag is known but the argument isn't.
LeftMode = top_unused,
RightMode = top_unused
->
- Statements = []
+ MLDS_ArgType = mercury_type_to_mlds_type(ModuleInfo, ArgType),
+ ml_gen_box_or_unbox_rval(ModuleInfo, ArgType, VarType,
+ native_if_possible, ml_const(mlconst_null(MLDS_ArgType)), ArgRval),
+ MLDS_Type = mercury_type_to_mlds_type(ModuleInfo, VarType),
+ CastRval = ml_unop(cast(MLDS_Type), ml_mkword(Ptag, ArgRval)),
+ Statement = ml_gen_assign(VarLval, CastRval, Context),
+ Statements = [Statement]
;
unexpected($module, $pred, "some strange unify")
).
diff --git a/compiler/opt_debug.m b/compiler/opt_debug.m
index d99ca11..fffda73 100644
--- a/compiler/opt_debug.m
+++ b/compiler/opt_debug.m
@@ -338,6 +338,8 @@ dump_rval(_, var(Var)) =
dump_rval(MaybeProcLabel, mkword(T, N)) =
"mkword(" ++ int_to_string(T) ++ ", " ++
dump_rval(MaybeProcLabel, N) ++ ")".
+dump_rval(_, mkword_hole(T)) =
+ "mkword_hole(" ++ int_to_string(T) ++ ")".
dump_rval(MaybeProcLabel, const(C)) =
dump_const(MaybeProcLabel, C).
dump_rval(MaybeProcLabel, unop(O, N)) =
diff --git a/compiler/opt_util.m b/compiler/opt_util.m
index 6a53278..713a3db 100644
--- a/compiler/opt_util.m
+++ b/compiler/opt_util.m
@@ -743,6 +743,7 @@ rval_refers_stackvars(var(_)) = _ :-
unexpected($module, $pred, "var").
rval_refers_stackvars(mkword(_, Rval)) =
rval_refers_stackvars(Rval).
+rval_refers_stackvars(mkword_hole(_)) = no.
rval_refers_stackvars(const(_)) = no.
rval_refers_stackvars(unop(_, Rval)) =
rval_refers_stackvars(Rval).
@@ -1742,6 +1743,8 @@ count_temps_rval(Rval, !R, !F) :-
Rval = mkword(_Tag, SubRval),
count_temps_rval(SubRval, !R, !F)
;
+ Rval = mkword_hole(_Tag)
+ ;
Rval = const(_Const)
;
Rval = unop(_Unop, SubRvalA),
@@ -1953,6 +1956,7 @@ touches_nondet_ctrl_rval(lval(Lval)) =
touches_nondet_ctrl_rval(var(_)) = no.
touches_nondet_ctrl_rval(mkword(_, Rval)) =
touches_nondet_ctrl_rval(Rval).
+touches_nondet_ctrl_rval(mkword_hole(_)) = no.
touches_nondet_ctrl_rval(const(_)) = no.
touches_nondet_ctrl_rval(unop(_, Rval)) =
touches_nondet_ctrl_rval(Rval).
@@ -2595,6 +2599,9 @@ replace_labels_rval(Rval0, Rval, ReplMap) :-
replace_labels_rval(SubRval0, SubRval, ReplMap),
Rval = mkword(Tag, SubRval)
;
+ Rval0 = mkword_hole(Tag),
+ Rval = mkword_hole(Tag)
+ ;
Rval0 = const(Const0),
replace_labels_rval_const(Const0, Const, ReplMap),
Rval = const(Const)
diff --git a/compiler/peephole.m b/compiler/peephole.m
index 7613376..40f08a4 100644
--- a/compiler/peephole.m
+++ b/compiler/peephole.m
@@ -692,6 +692,7 @@ replace_tagged_ptr_components_in_rval(OldLval, OldTag, OldBase, Rval0, Rval) :-
;
( Rval0 = lval(_)
; Rval0 = var(_)
+ ; Rval0 = mkword_hole(_)
; Rval0 = const(_)
; Rval0 = mem_addr(_)
),
diff --git a/compiler/stack_layout.m b/compiler/stack_layout.m
index 1117c8c..ea36927 100644
--- a/compiler/stack_layout.m
+++ b/compiler/stack_layout.m
@@ -2208,6 +2208,7 @@ represent_locn_or_const_as_int_rval(Params, LvalOrConst, Rval, Type,
; LvalOrConst = unop(_, _)
; LvalOrConst = mem_addr(_)
; LvalOrConst = var(_)
+ ; LvalOrConst = mkword_hole(_)
),
unexpected($module, $pred, "bad rval")
).
diff --git a/compiler/unify_gen.m b/compiler/unify_gen.m
index aebc73e..8e7982a 100644
--- a/compiler/unify_gen.m
+++ b/compiler/unify_gen.m
@@ -1599,9 +1599,10 @@ generate_direct_arg_construct(Var, Arg, Ptag, Mode, Type, Code, !CI) :-
LeftMode = top_unused,
RightMode = top_unused
->
- Code = empty
- % free-free - ignore
% XXX I think this will have to change if we start to support aliasing.
+ % Construct a tagged pointer to a pointer value which is unknown yet.
+ assign_const_to_var(Var, mkword_hole(Ptag), !CI),
+ Code = empty
;
unexpected($module, $pred, "some strange unify")
).
@@ -1644,7 +1645,7 @@ generate_direct_arg_deconstruct(Var, Arg, Ptag, Mode, Type, Code, !CI) :-
LeftMode = top_out,
RightMode = top_in
->
- assign_expr_to_var(Var, mkword(Ptag, var(Arg)), Code, !CI)
+ reassign_mkword_hole_var(Var, Ptag, var(Arg), Code, !CI)
;
LeftMode = top_unused,
RightMode = top_unused
diff --git a/compiler/var_locn.m b/compiler/var_locn.m
index e7718f3..c495036 100644
--- a/compiler/var_locn.m
+++ b/compiler/var_locn.m
@@ -177,6 +177,16 @@
:- pred var_locn_assign_expr_to_var(prog_var::in, rval::in, llds_code::out,
var_locn_info::in, var_locn_info::out) is det.
+ % var_locn_reassign_mkword_hole_var(Var, Ptag, Rval, Code, !VarLocnInfo):
+ %
+ % Generates code to execute the assignment Var := mkword(Ptag, Rval), and
+ % updates the state of !VarLocnInfo accordingly. Var must previously have
+ % been assigned the constant expression mkword_hole(Ptag).
+ %
+:- pred var_locn_reassign_mkword_hole_var(module_info::in, prog_var::in,
+ tag::in, rval::in, llds_code::out, var_locn_info::in, var_locn_info::out)
+ is det.
+
% var_locn_assign_cell_to_var(ModuleInfo, ExprnOpts, Var,
% ReserveWordAtStart, Ptag, MaybeRvals, MaybeSize, FieldAddrs, TypeMsg,
% MayUseAtomic, Label, Code, !StaticCellInfo, !VarLocnInfo):
@@ -842,6 +852,41 @@ add_use_ref(ContainedVar, UsingVar, !VarStateMap) :-
DeadOrAlive),
map.det_update(ContainedVar, State, !VarStateMap).
+%-----------------------------------------------------------------------------%
+
+var_locn_reassign_mkword_hole_var(ModuleInfo, Var, Ptag, Rval, Code, !VLI) :-
+ var_locn_get_var_state_map(!.VLI, VarStateMap0),
+ map.lookup(VarStateMap0, Var, State0),
+ (
+ State0 = var_state(Lvals, MaybeConstRval, MaybeExprRval, Using0,
+ DeadOrAlive0),
+ (
+ MaybeConstRval = yes(mkword_hole(Ptag))
+ ;
+ MaybeConstRval = no
+ % Already stored value.
+ ),
+ MaybeExprRval = no,
+ set_of_var.is_empty(Using0),
+ DeadOrAlive0 = doa_alive
+ ->
+ set.fold(clobber_old_lval(ModuleInfo, Var), Lvals, !VLI),
+
+ var_locn_get_var_state_map(!.VLI, VarStateMap1),
+ map.det_remove(Var, _State1, VarStateMap1, VarStateMap),
+ var_locn_set_var_state_map(VarStateMap, !VLI),
+
+ var_locn_assign_expr_to_var(Var, Rval, Code, !VLI)
+ ;
+ unexpected($module, $pred, "unexpected var_state")
+ ).
+
+:- pred clobber_old_lval(module_info::in, prog_var::in, lval::in,
+ var_locn_info::in, var_locn_info::out) is det.
+
+clobber_old_lval(ModuleInfo, Var, Lval, !VLI) :-
+ record_clobbering(Lval, [Var], !VLI).
+
%----------------------------------------------------------------------------%
var_locn_assign_cell_to_var(ModuleInfo, ExprnOpts, Var, ReserveWordAtStart,
@@ -1181,6 +1226,9 @@ assign_cell_arg(ModuleInfo, Rval0, Ptag, Base, Offset, Code, !VLI) :-
EvalCode = empty,
AssignCode = singleton(llds_instr(assign(Target, Rval0), Comment))
;
+ Rval0 = mkword_hole(_),
+ unexpected($module, $pred, "mkword_hole")
+ ;
Rval0 = mem_addr(_),
unexpected($module, $pred, "unknown rval")
),
@@ -1204,6 +1252,7 @@ materialize_if_var(ModuleInfo, Rval0, EvalCode, Rval, !VLI) :-
;
( Rval0 = const(_)
; Rval0 = mkword(_, _)
+ ; Rval0 = mkword_hole(_)
; Rval0 = unop(_, _)
; Rval0 = binop(_, _, _)
; Rval0 = lval(_)
@@ -2293,6 +2342,7 @@ expr_is_constant(VarStateMap, ExprnOpts,
expr_is_constant(VarStateMap, ExprnOpts,
mkword(Tag, Expr0), mkword(Tag, Expr)) :-
expr_is_constant(VarStateMap, ExprnOpts, Expr0, Expr).
+expr_is_constant(_, _ExprnOpts, mkword_hole(Tag), mkword_hole(Tag)).
expr_is_constant(VarStateMap, ExprnOpts, var(Var), Rval) :-
map.search(VarStateMap, Var, State),
State = var_state(_, yes(Rval), _, _, _),
@@ -2392,6 +2442,10 @@ var_locn_materialize_vars_in_rval_avoid(ModuleInfo, Rval0, MaybePrefer, Avoid,
Avoid, SubRval, Code, !VLI),
Rval = mkword(Tag, SubRval)
;
+ Rval0 = mkword_hole(_Tag),
+ Rval = Rval0,
+ Code = empty
+ ;
Rval0 = unop(Unop, SubRval0),
var_locn_materialize_vars_in_rval_avoid(ModuleInfo, SubRval0, no,
Avoid, SubRval, Code, !VLI),
@@ -2435,11 +2489,9 @@ var_locn_materialize_vars_in_rval_avoid(ModuleInfo, Rval0, MaybePrefer, Avoid,
var_locn_materialize_vars_in_mem_ref_avoid(ModuleInfo, MemRef0, MemRef, Avoid,
Code, !VLI) :-
(
- MemRef0 = stackvar_ref(_),
- MemRef = MemRef0,
- Code = empty
- ;
- MemRef0 = framevar_ref(_),
+ ( MemRef0 = stackvar_ref(_)
+ ; MemRef0 = framevar_ref(_)
+ ),
MemRef = MemRef0,
Code = empty
;
@@ -2486,8 +2538,8 @@ materialize_var(ModuleInfo, Var, MaybePrefer, StoreIfReq, Avoid, Rval, Code,
!VLI) :-
var_locn_get_var_state_map(!.VLI, VarStateMap),
map.lookup(VarStateMap, Var, State),
- State = var_state(_Lvals, _MaybeConstRval, MaybeExprRval, UsingVars,
- _DeadOrAlive),
+ State = var_state(_Lvals, _MaybeConstRval, MaybeExprRval,
+ UsingVars, _DeadOrAlive),
(
MaybeExprRval = yes(ExprRval)
;
diff --git a/tests/hard_coded/Mmakefile b/tests/hard_coded/Mmakefile
index fa65c46..1399883 100644
--- a/tests/hard_coded/Mmakefile
+++ b/tests/hard_coded/Mmakefile
@@ -69,6 +69,8 @@ ORDINARY_PROGS= \
direct_arg_cyclic1 \
direct_arg_intermod1 \
direct_arg_parent \
+ direct_arg_partial_inst \
+ direct_arg_partial_inst2 \
direct_arg_tags \
disjs_in_switch \
division_test \
diff --git a/tests/hard_coded/direct_arg_partial_inst.exp b/tests/hard_coded/direct_arg_partial_inst.exp
new file mode 100644
index 0000000..9294038
--- /dev/null
+++ b/tests/hard_coded/direct_arg_partial_inst.exp
@@ -0,0 +1,2 @@
+found
+not found
diff --git a/tests/hard_coded/direct_arg_partial_inst.m b/tests/hard_coded/direct_arg_partial_inst.m
new file mode 100644
index 0000000..84b85a9
--- /dev/null
+++ b/tests/hard_coded/direct_arg_partial_inst.m
@@ -0,0 +1,53 @@
+% A construction of a direct argument functor with a free argument was
+% completely ignored. This test case caused a compiler abort during LLDS
+% code generation.
+
+:- module direct_arg_partial_inst.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module list.
+
+:- type fruit
+ ---> lemon(struct) % direct arg functor
+ ; apple(struct) % direct arg functor
+ ; orange(string).
+
+:- type struct
+ ---> struct(int, int, int, int, int).
+
+:- pred foo(list(fruit)::in, string::out) is det.
+
+foo(Xs, R) :-
+ (
+ % X was not recorded in the var_state_map.
+ X = apple(_),
+ % Compiler tries to flush X to the stack.
+ member(X, Xs)
+ ->
+ R = "found"
+ ;
+ R = "not found"
+ ).
+
+main(!IO) :-
+ ListA = [apple(struct(1, 2, 3, 4, 5))],
+ foo(ListA, ResultA),
+ io.write_string(ResultA, !IO),
+ io.nl(!IO),
+
+ ListB = [lemon(struct(1, 2, 3, 4, 5))],
+ foo(ListB, ResultB),
+ io.write_string(ResultB, !IO),
+ io.nl(!IO).
+
+%-----------------------------------------------------------------------------%
+% vim: set sts=4 sw=4 et:
diff --git a/tests/hard_coded/direct_arg_partial_inst2.exp b/tests/hard_coded/direct_arg_partial_inst2.exp
new file mode 100644
index 0000000..7c1ae9c
--- /dev/null
+++ b/tests/hard_coded/direct_arg_partial_inst2.exp
@@ -0,0 +1,2 @@
+apple(struct(1, 2, 3, 4, 5))
+orange(struct(1, 2, 3, 4, 5))
diff --git a/tests/hard_coded/direct_arg_partial_inst2.m b/tests/hard_coded/direct_arg_partial_inst2.m
new file mode 100644
index 0000000..92c4ba4
--- /dev/null
+++ b/tests/hard_coded/direct_arg_partial_inst2.m
@@ -0,0 +1,56 @@
+% Construction of a partially instantiated value involving a direct argument
+% functor did not produce any code, causing incorrectly behaviour at run-time
+% if the value was deconstructed.
+
+:- module direct_arg_partial_inst2.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- type struct
+ ---> struct(int, int, int, int, int).
+
+:- type fruit
+ ---> apple(struct) % direct arg functor
+ ; orange(struct). % direct arg functor
+
+:- inst fruit
+ ---> apple(free)
+ ; orange(free).
+
+:- pred mk_apple(fruit::out(fruit)) is det.
+:- pragma no_inline(mk_apple/1).
+
+mk_apple(apple(_)).
+
+:- pred mk_orange(fruit::out(fruit)) is det.
+:- pragma no_inline(mk_orange/1).
+
+mk_orange(orange(_)).
+
+:- pred fill(struct::in, fruit::in(fruit), fruit::out) is det.
+:- pragma no_inline(fill/3).
+
+fill(Struct, apple(_), apple(Struct)).
+fill(Struct, orange(_), orange(Struct)).
+
+main(!IO) :-
+ mk_apple(X0),
+ fill(struct(1, 2, 3, 4, 5), X0, X),
+ io.write(X, !IO),
+ io.nl(!IO),
+
+ mk_orange(Y0),
+ fill(struct(1, 2, 3, 4, 5), Y0, Y),
+ io.write(Y, !IO),
+ io.nl(!IO).
+
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sts=4 sw=4 et
More information about the reviews
mailing list