mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-17 18:33:58 +00:00
59cf3a51e1
compiler/parse_item.m:
Don't accept `:- external' items.
compiler/prog_item.m:
Require the presence of a pred_or_func flag on external pragmas.
They are specified by `:- pragma external_{pred/func}' pragmas,
which are still supported.
compiler/parse_pragma.m:
When parsing external_{pred/func} pragmas, allow the predicate name
to contain a module qualifier; they were allowed on `:- external' items.
We do require the module qualifier to specify the expected (i.e. the
current) module.
compiler/add_pragma.m:
compiler/parse_tree_out_pragma.m:
compiler/recompilation.version.m:
Conform to the changes above.
tests/hard_coded/backend_external.m:
tests/hard_coded/constant_prop_2.m:
tests/invalid/external.err_exp:
tests/invalid/external.m:
tests/invalid/io_in_ite_cond.err_exp:
tests/invalid/io_in_ite_cond.m:
tests/invalid/overloading.m:
tests/invalid/tricky_assert1.m:
tests/invalid/type_spec.err_exp:
tests/invalid/type_spec.m:
tests/invalid/uniq_neg.err_exp:
tests/invalid/uniq_neg.m:
tests/valid/dcg_test.m:
tests/valid/inst_perf_bug_1.m:
tests/valid/lambda_recompute.m:
tests/valid/semidet_disj.m:
tests/valid/solv.m:
tests/valid/solver_type_bug.m:
tests/valid/stack_alloc.m:
tests/valid/tricky_assert2.m:
Replace `:- external' items with external_{pred/func} pragmas.
Modernize the code where needed, replacing DCGs with state variables.
138 lines
4.0 KiB
Mathematica
138 lines
4.0 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ts=4 sw=4 et ft=mercury
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% This test case is a regression test to check that we don't issue
|
|
% a spurious warning about infinite recursion in recursive procedures
|
|
% such as label/1 whose inputs initial inst contains `any'.
|
|
%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% This module is an example of how to write a finite domain solver.
|
|
|
|
:- module solv.
|
|
:- interface.
|
|
|
|
:- import_module io.
|
|
:- import_module list.
|
|
|
|
:- solver type fd_var.
|
|
|
|
% initialize an unconstrained fd_var
|
|
:- pred init_any(fd_var).
|
|
:- mode init_any(free >> any) is det.
|
|
|
|
% unify an fd_var with an int
|
|
:- pred fd_var == int.
|
|
:- mode in == out is det.
|
|
:- mode (any >> ground) == in is semidet.
|
|
|
|
% constrain an fd_var to be greater than the specified int
|
|
:- pred fd_var > int.
|
|
:- mode in(any) > in is semidet.
|
|
|
|
% constrain an fd_var to be less than the specified int
|
|
:- pred fd_var < int.
|
|
:- mode in(any) < in is semidet.
|
|
|
|
% Given a list of constrained fd_vars, nondeterminstically
|
|
% find bindings for the variables that meet those constraints.
|
|
% The output list here will be the same as the input list,
|
|
% but with ground values for all the variables.
|
|
:- pred labeling(list(fd_var), list(fd_var)).
|
|
:- mode labeling(in(list_skel(any)), out) is nondet.
|
|
|
|
% Given a list of constrained fd_vars,
|
|
% print out all possible bindings for the variables
|
|
% that meet those constraints. The order in which
|
|
% the solutions will be printed is unspecified.
|
|
:- pred print_labeling(list(fd_var), io__state, io__state).
|
|
:- mode print_labeling(in(list_skel(any)), di, uo) is cc_multi.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
:- import_module solutions.
|
|
|
|
:- solver type fd_var
|
|
where representation is c_pointer,
|
|
ground is ground,
|
|
any is ground.
|
|
|
|
print_labeling(Vars) -->
|
|
{ Labeling0 = (
|
|
impure pred(Labels::out) is nondet :-
|
|
labeling(Vars, Labels)
|
|
) },
|
|
{ Labeling = (
|
|
pred(Labels::out) is nondet :-
|
|
promise_pure ( impure Labeling0(Labels) )
|
|
) },
|
|
unsorted_aggregate(Labeling, print_solution).
|
|
|
|
:- pred print_solution(list(fd_var), io__state, io__state).
|
|
:- mode print_solution(in, di, uo) is det.
|
|
|
|
print_solution(Vars) -->
|
|
io__print("Here's a solution: "),
|
|
io__write_list(Vars, ", ", print_var),
|
|
io__nl.
|
|
|
|
:- pred print_var(fd_var, io__state, io__state).
|
|
:- mode print_var(in, di, uo) is det.
|
|
|
|
print_var(Var) -->
|
|
{ Var == Val }, % convert ground fd_var to int
|
|
io__write_int(Val).
|
|
|
|
labeling([], []).
|
|
labeling([V | Vs0], [V | Vs]) :-
|
|
label(V),
|
|
labeling(Vs0, Vs).
|
|
|
|
:- pred label(fd_var).
|
|
:- mode label(any >> ground) is nondet.
|
|
:- pragma promise_pure(label/1).
|
|
|
|
label(V) :-
|
|
impure solver_min_domain(V, Min),
|
|
impure solver_max_domain(V, Max),
|
|
( if Min = Max then
|
|
promise_ground(V)
|
|
else
|
|
(
|
|
V == Min
|
|
;
|
|
V > Min,
|
|
label(V)
|
|
)
|
|
).
|
|
|
|
:- pred promise_ground(fd_var).
|
|
:- mode promise_ground(any >> ground) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
promise_ground(X :: any >> ground),
|
|
[promise_pure, will_not_call_mercury, thread_safe],
|
|
"
|
|
/* assert(X->min == X->max); */
|
|
").
|
|
|
|
:- impure pred solver_min_domain(fd_var, int).
|
|
:- mode solver_min_domain(in(any), out) is det.
|
|
|
|
:- impure pred solver_max_domain(fd_var, int).
|
|
:- mode solver_max_domain(in(any), out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% Implementing the following is left as an exercise for the reader...
|
|
:- pragma external_pred(init_any/1).
|
|
:- pragma external_pred(solver_min_domain/2).
|
|
:- pragma external_pred(solver_max_domain/2).
|
|
:- pragma external_pred((==)/2).
|
|
:- pragma external_pred((>)/2).
|
|
:- pragma external_pred((<)/2).
|
|
|
|
%---------------------------------------------------------------------------%
|