mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-19 11:23:46 +00:00
Code Issues Projects Releases Wiki Activity
Files
083d376e6598628362ee91c2da170febd83590f4
mercury/tests/hard_coded/gh72.m
Zoltan Somogyi 8355718b16 Allow pred pragmas to specify pred_or_func. 
Pragmas that apply to a pred_info have traditionally specified that
pred_info by a symname/arity pair. However, this can be ambiguous
if there is both a predicate and a function with that symname/arity pair.
This diff therefore allows pragmas that previously took "symname/arity"
to also take "pred(symname/arity)" and "func(symname/arity").
If e.g. there is both a pred foo/2 and a func foo/2 accessible from
the current module, the old form applied to both, while the new forms
apply to just one.

Later, we could change the behavior of the old form to insist on a
unique match, but before we do, we should have a mechanism that allows
programmers to resolve the ambiguity. (They could rename either the
pred or the func, but it is less intrusive for the compiler not to
insist on that.) This is that mechanism.

In the process of implementing this change, I had to update lots of code
that dealt with arities, since one main difference between predicates
and functions is that for the latter, the user visible arity and
the internal compiler arity are different, in that the former does not
count the return value, and the latter does. The existing "arity" type
is an equivalence to int, and thus does not indicate which notion is meant.
I therefore added two notag types, user_arity and pred_form_arity,
for the two notions above respectively, and made a start on using them,
though for now, only in the code sections affected by the main change above.

compiler/prog_item.m:
    Change the types that represent the specifications of predicates
    (in the sense of pred_infos) and functions to allow the representation
    of not just "symname/arity," but also "pred(symname/arity)" and
    "func(symname/arity"). There is one exception: for the oisu (order
    independent state update) pragma, require the presence of either
    a pred() vs func() wrapper. This is not a breaking change, since oisu
    pragmas are neither publicly documented or really implemented.

    Pragmas that allow the representation of argument modes implicitly
    specify pred vs func by taking the mode list either as
    (m1, m2, ... mn) or as (m1, m2, ...) = mn. Encode this invariant
    in the representation type. Make this type also include an arity
    only in the absence of a mode list, to make unrepresentable
    any inconsistent state in which the stated arity and the length
    of the mode list disagree.

    Give the new types used for these updated representations names
    that state whether they specify a pred_info or a proc_info
    (or in one case that we should later fix, that they can specify either).

    Put the pred or func indication before the symname and arity
    both in these new types, and in some old types. Do this both because
    the pred or func indication comes before the name in Mercury declarations,
    and to help the compiler find all the places where code using the old
    forms had to be revisited and checked for any needed updates.

    Provide utility operations on the new types involved in the
    updated representations.

compiler/prog_data.m:
    Add the user_arity and pred_form_arity types, as mentioned above.

    Add a type that is mostly used in item representations, but is also
    useful elsewhere.

compiler/parse_pragma.m:
compiler/parse_pragma_analysis.m:
compiler/parse_pragma_foreign.m:
compiler/parse_pragma_tabling.m:
compiler/parse_util.m:
    Accept the pred() or func() wrappers mentioned above, and generate
    the updated representations when parsing terms containing pragmas.

compiler/parse_tree_out_pragma.m:
    Accept the updated representations of pragmas when printing them out.

compiler/add_pragma.m:
compiler/add_pragma_tabling.m:
compiler/add_pragma_type_spec.m:
    Use the updated representations when adding pragmas to the HLDS.

compiler/error_util.m:
    Provide mechanisms for use above when printing references to pred_infos
    using user arities, to complement the existing mechanisms which use
    arities that they treat as pred form arities. The latter is what
    you want when generating error messages about pred_infos that
    already included functions' return types in the argument list;
    the former is what you want when generating error messages
    about user input that has not yet been subject to that treatment,
    such as a pragma that has just been read in. (The difference is
    only in what form of arity these mechanisms take as *input*;
    the output is always user arity, which after all is what users
    are interested in.)

compiler/hlds_error_util.m:
    Provide a user_arity equivalent to a piece of existing pred_form_arity
    functionality, for use by the modules above.

    Provide utility functions used when generating error messages.

compiler/fact_table.m:
    Replace most uses of the "arity" type with the "user_arity" type.
    Done mostly in the process of figuring out which kind of arity
    the top predicates took as arguments.

    Put argument lists into a sensible order.

compiler/prog_out.m:
compiler/prog_util.m:
    Add utility functionality needed above.

compiler/add_mutable_aux_preds.m:
compiler/convert_parse_tree.m:
compiler/equiv_type.m:
compiler/get_dependencies.m:
compiler/intermod.m:
compiler/item_util.m:
compiler/make_hlds_passes.m:
compiler/module_qual.qualify_items.m:
compiler/recompilation.usage.m:
compiler/recompilation.version.m:
compiler/typecheck_errors.m:
compiler/unused_args.m:
    Conform to the changes above.

compiler/hlds_pred.m:
    Add an XXX.

compiler/notes/order_indep_state_update:
    Fix typos.

tests/hard_coded/bad_direct_reuse.m:
tests/hard_coded/bad_indirect_reuse.m:
tests/hard_coded/bitmap_simple.m:
tests/hard_coded/constraint_order.m:
tests/hard_coded/equality_pred_which_requires_boxing.m:
tests/hard_coded/fact_table_test_1.m:
tests/hard_coded/float_consistency.m:
tests/hard_coded/foreign_enum_rtti.m:
tests/hard_coded/foreign_enum_switch.m:
tests/hard_coded/foreign_import_module_2.m:
tests/hard_coded/gh72.m:
tests/hard_coded/gh72a.m:
tests/hard_coded/heap_ref_mask_tag.m:
tests/hard_coded/intermod_multimode.m:
tests/hard_coded/mode_check_clauses.m:
tests/hard_coded/multimode_addr.m:
tests/hard_coded/type_spec_ho_term.m:
tests/hard_coded/user_defined_equality2.m:
    Add pred() or func() wrappers to symname/arity pairs in pragmas,
    to test whether the parser accepts them.

    Fix deviations from our current coding standards.

tests/hard_coded/oisu_check_db.m:
tests/invalid/oisu_check_add_pragma_errors.{m,err_exp}:
tests/invalid/oisu_check_semantic_errors.m:
    Add the pred() wrappers now required in oisu pragmas.
    Expect the improved wording of an error message.
2021-05-06 07:19:25 +10:00

425 lines
11 KiB
Mathematica
Raw Blame History

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
%
% This test exhibits many instances of the problem demonstrated by gh72[ab].
% The instances are designed to stress-test the compilation transformation
% that implements the fix (compiler/direct_arg_in_out.m).
%
:- module gh72.
:- interface.
:- import_module io.
:- pred main(io::di, io::uo) is det.
:- implementation.
:- import_module list.
:- import_module string.
:- import_module solutions.
%-----------------------------------------------------------------------------%
main(!IO) :-
conj_tests(!IO),
disj_test_init(!IO),
switch_test_init(10, !IO),
switch_test_init(11, !IO),
switch_test_init(12, !IO),
switch_test_init(13, !IO),
ite_test_init(10, !IO),
ite_test_init(11, !IO),
ite_test_init(12, !IO),
ite_test_init(13, !IO),
method_tests("string", "hij", !IO),
method_tests("int", 53, !IO).
%-----------------------------------------------------------------------------%
:- pred conj_tests(io::di, io::uo) is det.
conj_tests(!IO) :-
A = f1(_),
conj_test(A, !IO),
B = f2(_),
conj_test(B, !IO),
C = f3(_),
conj_test(C, !IO),
D = f4(package("start4", "d")),
conj_test(D, !IO).
:- pred conj_test(t, io, io).
:- mode conj_test(t4 >> ground, di, uo) is det.
conj_test(T, !IO) :-
fill3("c", T),
fill2("b", T),
fill1("a", T),
io.write_string(dump_t_nl(T), !IO).
%-----------------------------------------------------------------------------%
:- pred disj_test_init(io::di, io::uo) is det.
disj_test_init(!IO) :-
io.format("\ndisj_test_init(f1)\n", [], !IO),
solutions(disj_init_f1, SolnStrSet1),
list.foldl(io.write_string, SolnStrSet1, !IO),
io.format("disj_test_init(f2)\n", [], !IO),
solutions(disj_init_f2, SolnStrSet2),
list.foldl(io.write_string, SolnStrSet2, !IO),
io.format("disj_test_init(f3)\n", [], !IO),
solutions(disj_init_f3, SolnStrSet3),
list.foldl(io.write_string, SolnStrSet3, !IO),
io.write_string("end\n", !IO).
:- pred disj_init_f1(string).
:- mode disj_init_f1(out) is nondet.
:- pragma no_inline(disj_init_f1/1).
disj_init_f1(Str) :-
disj_init(N, f1(_), Str0),
Str = string.int_to_string(N) ++ ": " ++ Str0.
:- pred disj_init_f2(string).
:- mode disj_init_f2(out) is nondet.
:- pragma no_inline(disj_init_f2/1).
disj_init_f2(Str) :-
disj_init(N, f2(_), Str0),
Str = string.int_to_string(N) ++ ": " ++ Str0.
:- pred disj_init_f3(string).
:- mode disj_init_f3(out) is nondet.
:- pragma no_inline(disj_init_f3/1).
disj_init_f3(Str) :-
disj_init(N, f3(_), Str0),
Str = string.int_to_string(N) ++ ": " ++ Str0.
:- pred disj_init(int, t, string).
:- mode disj_init(out, t4 >> ground, out) is nondet.
:- pragma no_inline(disj_init/3).
:- pragma no_determinism_warning(pred(disj_init/3)).
disj_init(N, T, Str) :-
(
N = 10,
NStr = string.int_to_string(N),
fill1("1" ++ NStr, T),
fill2("2" ++ NStr, T),
fill3("3" ++ NStr, T),
(
StrA = NStr ++ ", " ++ dump_t(T)
;
StrA = NStr ++ "; " ++ dump_t(T)
)
;
N = 11,
NStr = string.int_to_string(N),
fill1("a" ++ NStr, T),
fill23("b" ++ NStr, T),
StrA = NStr ++ ", " ++ dump_t(T)
;
N = 12,
NStr = string.int_to_string(N),
fill23(NStr, T),
fill1(NStr, T),
StrA = NStr ++ ", no_t"
),
% Test that the most up-to-date version of T reaches the code
% after the disjunction.
StrB = dump_t_nl(T),
Str = StrA ++ " | " ++ StrB.
%-----------------------------------------------------------------------------%
:- pred switch_test_init(int::in, io::di, io::uo) is det.
switch_test_init(N, !IO) :-
io.format("\nswitch_test_init(%d, f1)\n", [i(N)], !IO),
solutions(switch_init_f1(N), SolnStrSet1),
list.foldl(io.write_string, SolnStrSet1, !IO),
io.format("switch_test_init(%d, f2)\n", [i(N)], !IO),
solutions(switch_init_f2(N), SolnStrSet2),
list.foldl(io.write_string, SolnStrSet2, !IO),
io.format("switch_test_init(%d, f3)\n", [i(N)], !IO),
solutions(switch_init_f3(N), SolnStrSet3),
list.foldl(io.write_string, SolnStrSet3, !IO),
io.write_string("end\n", !IO).
:- pred switch_init_f1(int, string).
:- mode switch_init_f1(in, out) is nondet.
:- pragma no_inline(switch_init_f1/2).
switch_init_f1(N, Str) :-
switch_init(N, f1(_), Str).
:- pred switch_init_f2(int, string).
:- mode switch_init_f2(in, out) is nondet.
:- pragma no_inline(switch_init_f2/2).
switch_init_f2(N, Str) :-
switch_init(N, f2(_), Str).
:- pred switch_init_f3(int, string).
:- mode switch_init_f3(in, out) is nondet.
:- pragma no_inline(switch_init_f3/2).
switch_init_f3(N, Str) :-
switch_init(N, f3(_), Str).
:- pred switch_init(int, t, string).
:- mode switch_init(in, t4 >> ground, out) is nondet.
:- pragma no_inline(switch_init/3).
switch_init(N, T, StrA ++ " | " ++ StrB) :-
NStr = string.int_to_string(N),
(
N = 10,
fill1("1" ++ NStr, T),
fill2("2" ++ NStr, T),
fill3("3" ++ NStr, T),
(
StrA = NStr ++ ", " ++ dump_t(T)
;
StrA = NStr ++ "; " ++ dump_t(T)
)
;
N = 11,
fill1("a" ++ NStr, T),
fill23("b" ++ NStr, T),
StrA = NStr ++ ", " ++ dump_t(T)
;
N = 12,
fill23(NStr, T),
fill1(NStr, T),
StrA = NStr ++ ", no_t"
),
% Test that the most up-to-date version of T reaches the code
% after the switch.
StrB = dump_t_nl(T).
%-----------------------------------------------------------------------------%
:- pred ite_test_init(int::in, io::di, io::uo) is det.
ite_test_init(N, !IO) :-
io.format("\nite_test_init(%d, f1)\n", [i(N)], !IO),
solutions(ite_init_f1(N), SolnStrSet1),
list.foldl(io.write_string, SolnStrSet1, !IO),
io.format("ite_test_init(%d, f2)\n", [i(N)], !IO),
solutions(ite_init_f2(N), SolnStrSet2),
list.foldl(io.write_string, SolnStrSet2, !IO),
io.format("ite_test_init(%d, f3)\n", [i(N)], !IO),
solutions(ite_init_f3(N), SolnStrSet3),
list.foldl(io.write_string, SolnStrSet3, !IO),
io.write_string("end\n", !IO).
:- pred ite_init_f1(int, string).
:- mode ite_init_f1(in, out) is nondet.
:- pragma no_inline(ite_init_f1/2).
ite_init_f1(N, Str) :-
ite_init(N, f1(_), Str).
:- pred ite_init_f2(int, string).
:- mode ite_init_f2(in, out) is nondet.
:- pragma no_inline(ite_init_f2/2).
ite_init_f2(N, Str) :-
ite_init(N, f2(_), Str).
:- pred ite_init_f3(int, string).
:- mode ite_init_f3(in, out) is nondet.
:- pragma no_inline(ite_init_f3/2).
ite_init_f3(N, Str) :-
ite_init(N, f3(_), Str).
:- pred ite_init(int, t, string).
:- mode ite_init(in, t4 >> ground, out) is nondet.
:- pragma no_inline(ite_init/3).
ite_init(N, T, StrA ++ " | " ++ StrB) :-
NStr = string.int_to_string(N),
% While direct_arg_in_out.m is prepared for situations in which
% a daio variable such as T is instantiated in both the condition
% and the then-part of an if-then-else, we can't test that here,
% because if e.g. we move the call to fill1 into the condition,
% mode analysis generates an error.
( if
N = 10
then
fill1("1" ++ NStr, T),
fill2("2" ++ NStr, T),
fill3("3" ++ NStr, T),
(
StrA = NStr ++ ", " ++ dump_t(T)
;
StrA = NStr ++ ", " ++ dump_t(T)
)
else if
N = 11
then
fill1("a" ++ NStr, T),
fill23("b" ++ NStr, T),
StrA = NStr ++ ", " ++ dump_t(T)
else if
N = 12
then
fill23(NStr, T),
fill1(NStr, T),
StrA = NStr ++ ", no_t"
else
fail
),
% Test that the most up-to-date version of T reaches the code
% after the if-then-else.
StrB = dump_t_nl(T).
%-----------------------------------------------------------------------------%
:- pred method_tests(string::in, S::in, io::di, io::uo) is det <= fxc(S).
method_tests(Msg, S, !IO) :-
io.format("\nmethod test %s\n", [s(Msg)], !IO),
fx(S, f1(_), "p1", S1),
fx(S, f2(package("test2", "test2")), "p2", S2),
fx(S, f3(package("test3", "test3")), "p3", S3),
fx(S, f4(package("test4", "test4")), "p4", S4),
io.write_string(S1, !IO),
io.write_string(S2, !IO),
io.write_string(S3, !IO),
io.write_string(S4, !IO).
:- typeclass fxc(S) where [
pred fx(S, t, string, string),
mode fx(in, t234 >> ground, in, out) is det
].
:- instance fxc(string) where [
pred(fx/4) is fx_string
].
:- instance fxc(int) where [
pred(fx/4) is fx_int
].
:- pred fx_string(string, t, string, string).
:- mode fx_string(in, t234 >> ground, in, out) is det.
fx_string(S0, T, Prefix, Str) :-
fill1(S0, T),
Str = Prefix ++ " " ++ dump_t_nl(T).
:- pred fx_int(int, t, string, string).
:- mode fx_int(in, t234 >> ground, in, out) is det.
fx_int(I0, T, Prefix, Str) :-
fill1(string.int_to_string(I0), T),
Str = Prefix ++ " " ++ dump_t_nl(T).
%-----------------------------------------------------------------------------%
:- type t
---> f1(package)
; f2(package)
; f3(package)
; f4(package).
:- inst t4 for t/0
---> f1(free)
; f2(free)
; f3(free)
; f4(ground).
:- inst t34 for t/0
---> f1(free)
; f2(free)
; f3(ground)
; f4(ground).
:- inst t234 for t/0
---> f1(free)
; f2(ground)
; f3(ground)
; f4(ground).
:- type package
---> package(string, string).
%-----------------------------------------------------------------------------%
:- func dump_t_nl(t) = string.
:- pragma no_inline(dump_t_nl/1).
dump_t_nl(T) = dump_t(T) ++ "\n".
:- func dump_t(t) = string.
:- pragma no_inline(dump_t/1).
dump_t(f1(Package)) = "f1(" ++ dump_package(Package) ++ ")".
dump_t(f2(Package)) = "f2(" ++ dump_package(Package) ++ ")".
dump_t(f3(Package)) = "f3(" ++ dump_package(Package) ++ ")".
dump_t(f4(Package)) = "f4(" ++ dump_package(Package) ++ ")".
:- func dump_package(package) = string.
:- pragma no_inline(dump_t/1).
dump_package(package(A, B)) = "package(" ++ A ++ ", " ++ B ++ ")".
%-----------------------------------------------------------------------------%
:- pred fill3(string, t).
:- mode fill3(in, t4 >> t34) is det.
:- pragma no_inline(fill3/2).
fill3(S, T0) :-
( T0 = f1(_)
; T0 = f2(_)
; T0 = f3(package("fill3", S))
; T0 = f4(_)
).
:- pred fill23(string, t).
:- mode fill23(in, t4 >> t234) is det.
:- pragma no_inline(fill3/2).
fill23(S, T0) :-
( T0 = f1(_)
; T0 = f2(package("fill2", S))
; T0 = f3(package("fill3", S))
; T0 = f4(_)
).
:- pred fill2(string, t).
:- mode fill2(in, t34 >> t234) is det.
:- pragma no_inline(fill2/2).
fill2(S, T0) :-
( T0 = f1(_)
; T0 = f2(package("fill2", S))
; T0 = f3(_)
; T0 = f4(_)
).
:- pred fill1(string, t).
:- mode fill1(in, t234 >> ground) is det.
:- pragma no_inline(fill1/2).
fill1(S, T0) :-
( T0 = f1(package("fill1", S))
; T0 = f2(_)
; T0 = f3(_)
; T0 = f4(_)
).
%-----------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink