mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-17 06:47:17 +00:00
94d9c1abb9
mercury_builtin.nl: Use det_pred(...), semidet_pred(...), nondet_pred(...) rather than call_pred(...) for the higher-order predicate modes. prog_io.nl, io.nl, varset.nl, etc. Add determinism annotations. hlds.nl, make_hlds.nl, LOTS of other files: Reorganize the way the predicate table works. Make hlds.nl a bit more modular. Change call/4 to call/5. Remove all/2 from the hlds. Changed pred_id to an integer. Added pred_call_id which is similar to the old pred_id. Makefile: Add a rule for creating *.hlds_dump. array.nl: Fix determinism error. det_analysis.nl: Fix a bug in printing determinism warnings. fix_errors.sed: Modify this so it allows all the `inferred nondet' determinism errors but none of the `inferred semidet' ones. llds.nl: Rename llds__pred_mode_id as llds__proc_id. mode_errors.nl: Finally got around to implementing Zoltan's suggestions about the error messages from the mode analysis. If an error occurs in a conjunction, only one error message is printed out - the first error which doesn't relate to a head unification. modes.nl: Handle X = f(X) properly. NB: determinism analysis and code generation still get it wrong! undef_modes, undef_insts: I've broken the error message code, since it's not easy to print pred_ids. I just changed it so that it didn't print the pred_ids out. Should fix this properly at some stage...
280 lines
11 KiB
Mathematica
280 lines
11 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module prog_util.
|
|
:- interface.
|
|
:- import_module prog_io, list.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% XXX change the `goedel_' prefixes
|
|
|
|
% The following predicate goedel_expand_eqv_types traverses
|
|
% through the list of items. Each time it finds an eqv_type
|
|
% definition, it replaces all occurrences of the type (both
|
|
% before and after it in the list of items) with type that it
|
|
% is equivalent to. This has the effect of eliminating all the
|
|
% equivalence types from the source code. Circular equivalence
|
|
% types in the input will cause references to undefined types
|
|
% in the output.
|
|
|
|
:- pred goedel_expand_eqv_types(list(item_and_context), list(item_and_context)).
|
|
:- mode goedel_expand_eqv_types(in, out).
|
|
|
|
% The following predicate goedel_replace_eqv_type_list
|
|
% performs substititution of a single type on a list
|
|
% of items. It is used in mercury_to_goedel to rename
|
|
% type `int' as `integer'.
|
|
|
|
:- pred goedel_replace_eqv_type_list(list(item_and_context), varset, string,
|
|
list(type_param), type, list(item_and_context)).
|
|
:- mode goedel_replace_eqv_type_list(in, in, in, in, in, out).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Convert a (possibly module-qualified) sym_name into a string.
|
|
|
|
:- pred unqualify_name(sym_name, string).
|
|
:- mode unqualify_name(in, out) is det.
|
|
|
|
:- pred sym_name_get_module_name(sym_name, module_name, module_name).
|
|
:- mode sym_name_get_module_name(in, in, out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% A pred declaration may contains just types, as in
|
|
% :- pred list__append(list(T), list(T), list(T)).
|
|
% or it may contain both types and modes, as in
|
|
% :- pred list__append(list(T)::in, list(T)::in,
|
|
% list(T)::output).
|
|
%
|
|
% This predicate takes the argument list of a pred declaration,
|
|
% splits it into two separate lists for the types and (if present)
|
|
% the modes.
|
|
|
|
:- type maybe_modes ---> yes(list(mode)) ; no.
|
|
|
|
:- pred split_types_and_modes(list(type_and_mode), list(type), maybe_modes).
|
|
:- mode split_types_and_modes(in, out, out).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
:- import_module std_util, varset, term.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
goedel_expand_eqv_types(Items0, Items) :-
|
|
goedel_replace_all_eqv_types(Items0, [], Items1),
|
|
list__reverse(Items1, Items).
|
|
|
|
:- pred goedel_replace_all_eqv_types(list(item_and_context),
|
|
list(item_and_context), list(item_and_context)).
|
|
:- mode goedel_replace_all_eqv_types(in, in, out).
|
|
|
|
goedel_replace_all_eqv_types([], Items, Items).
|
|
goedel_replace_all_eqv_types([Item - Context | Items0], ItemList0, ItemList) :-
|
|
( Item = type_defn(VarSet, eqv_type(Name, Args, Body), _Cond) ->
|
|
unqualify_name(Name, Name2),
|
|
goedel_replace_eqv_type_list(ItemList0, VarSet, Name2, Args,
|
|
Body, ItemList1),
|
|
goedel_replace_eqv_type_list(Items0, VarSet, Name2, Args, Body, Items1)
|
|
;
|
|
Items1 = Items0,
|
|
ItemList1 = [Item - Context | ItemList0]
|
|
),
|
|
goedel_replace_all_eqv_types(Items1, ItemList1, ItemList).
|
|
|
|
goedel_replace_eqv_type_list([], _, _, _, _, []).
|
|
goedel_replace_eqv_type_list([Item0 - Context| Items0], VarSet, Name, Args,
|
|
Body, [Item - Context| Items]) :-
|
|
% Attempting to replace an equivalence type can cause
|
|
% quite a bit of memory allocation. If it turns out that
|
|
% we don't need to replace anything, then we fail so that
|
|
% we can quickly reclaim this memory.
|
|
(
|
|
%some [Item1]
|
|
goedel_replace_eqv_type(Item0, VarSet, Name, Args, Body, Item1)
|
|
->
|
|
Item = Item1
|
|
;
|
|
Item = Item0
|
|
),
|
|
goedel_replace_eqv_type_list(Items0, VarSet, Name, Args, Body, Items).
|
|
|
|
:- pred goedel_replace_eqv_type(item, varset, string, list(type_param), type,
|
|
item).
|
|
:- mode goedel_replace_eqv_type(in, in, in, in, in, out).
|
|
|
|
goedel_replace_eqv_type(type_defn(VarSet0, TypeDefn0, Cond),
|
|
TVarSet, Name, Args0, Body0,
|
|
type_defn(VarSet0, TypeDefn, Cond)) :-
|
|
varset__merge(VarSet0, TVarSet, [Body0 | Args0], _, [Body | Args]),
|
|
goedel_replace_eqv_type_defn(TypeDefn0, Name, Args, Body, TypeDefn).
|
|
|
|
goedel_replace_eqv_type(pred(VarSet0, PredName, TypesAndModes0, Det, Cond),
|
|
TVarSet, Name, Args0, Body0,
|
|
pred(VarSet0, PredName, TypesAndModes, Det, Cond)) :-
|
|
varset__merge(VarSet0, TVarSet, [Body0 | Args0], _, [Body | Args]),
|
|
goedel_replace_eqv_type_pred(TypesAndModes0, Name, Args, Body,
|
|
no, TypesAndModes, yes).
|
|
|
|
:- pred goedel_replace_eqv_type_defn(type_defn, string, list(type_param),
|
|
type, type_defn).
|
|
:- mode goedel_replace_eqv_type_defn(in, in, in, in, out).
|
|
|
|
goedel_replace_eqv_type_defn(eqv_type(TName, TArgs, TBody0),
|
|
Name, Args, Body,
|
|
eqv_type(TName, TArgs, TBody)) :-
|
|
goedel_replace_eqv_type_type(TBody0, Name, Args, Body, no, TBody, yes).
|
|
goedel_replace_eqv_type_defn(uu_type(TName, TArgs, TBody0),
|
|
Name, Args, Body,
|
|
uu_type(TName, TArgs, TBody)) :-
|
|
goedel_replace_eqv_type_uu(TBody0, Name, Args, Body, no, TBody, yes).
|
|
goedel_replace_eqv_type_defn(du_type(TName, TArgs, TBody0),
|
|
Name, Args, Body,
|
|
du_type(TName, TArgs, TBody)) :-
|
|
goedel_replace_eqv_type_du(TBody0, Name, Args, Body, no, TBody, yes).
|
|
|
|
|
|
:- pred goedel_replace_eqv_type_uu(list(type), string, list(type_param),
|
|
type, bool, list(type), bool).
|
|
:- mode goedel_replace_eqv_type_uu(in, in, in, in, in,
|
|
out, out).
|
|
|
|
goedel_replace_eqv_type_uu([], _Name, _Args, _Body, Found, [], Found).
|
|
goedel_replace_eqv_type_uu([T0|Ts0], Name, Args, Body, Found0, [T|Ts], Found) :-
|
|
goedel_replace_eqv_type_type(T0, Name, Args, Body, Found0, T, Found1),
|
|
goedel_replace_eqv_type_uu(Ts0, Name, Args, Body, Found1, Ts, Found).
|
|
|
|
:- pred goedel_replace_eqv_type_du(list(constructor), string, list(type_param),
|
|
type, bool, list(constructor), bool).
|
|
:- mode goedel_replace_eqv_type_du(in, in, in, in, in,
|
|
out, out).
|
|
|
|
goedel_replace_eqv_type_du([], _Name, _Args, _Body, Found, [], Found).
|
|
goedel_replace_eqv_type_du([T0|Ts0], Name, Args, Body, Found0, [T|Ts], Found) :-
|
|
goedel_replace_eqv_type_ctor(T0, Name, Args, Body, Found0, T, Found1),
|
|
goedel_replace_eqv_type_du(Ts0, Name, Args, Body, Found1, Ts, Found).
|
|
|
|
:- pred goedel_replace_eqv_type_ctor(constructor, string, list(type_param),
|
|
type, bool, constructor, bool).
|
|
:- mode goedel_replace_eqv_type_ctor(in, in, in, in, in,
|
|
out, out).
|
|
|
|
goedel_replace_eqv_type_ctor(TName - Targs0, Name, Args, Body, Found0,
|
|
TName - Targs, Found) :-
|
|
goedel_replace_eqv_type_uu(Targs0, Name, Args, Body, Found0,
|
|
Targs, Found).
|
|
|
|
:- pred goedel_replace_eqv_type_type(type, string, list(type_param),
|
|
type, bool, type, bool).
|
|
:- mode goedel_replace_eqv_type_type(in, in, in, in, in,
|
|
out, out).
|
|
|
|
goedel_replace_eqv_type_type(term__variable(V), _Name, _Args, _Body, Found,
|
|
term__variable(V), Found).
|
|
goedel_replace_eqv_type_type(term__functor(F, TArgs0, Context), Name, Args,
|
|
Body, Found0, Type, Found) :-
|
|
goedel_replace_eqv_type_uu(TArgs0, Name, Args, Body, Found0,
|
|
TArgs1, Found1),
|
|
(
|
|
F = term__atom(Name),
|
|
list__same_length(TArgs1, Args)
|
|
->
|
|
type_param_to_var_list(Args, Args2),
|
|
term__substitute_corresponding(Args2, TArgs1, Body, Type),
|
|
Found = yes
|
|
;
|
|
% XXX could we improve efficiency here by reclaiming
|
|
% garbage (or avoiding allocating it in the first place)?
|
|
Found = Found1,
|
|
Type = term__functor(F, TArgs1, Context)
|
|
).
|
|
|
|
:- pred type_param_to_var_list(list(type_param), list(var)).
|
|
:- mode type_param_to_var_list(in, out).
|
|
|
|
type_param_to_var_list([], []).
|
|
type_param_to_var_list([T | Ts], [V | Vs]) :-
|
|
type_param_to_var(T, V),
|
|
type_param_to_var_list(Ts, Vs).
|
|
|
|
:- pred type_param_to_var(type_param, var).
|
|
:- mode type_param_to_var(in, out).
|
|
|
|
type_param_to_var(term__variable(V), V).
|
|
|
|
:- pred goedel_replace_eqv_type_pred(list(type_and_mode), string,
|
|
list(type_param), type, bool, list(type_and_mode), bool).
|
|
:- mode goedel_replace_eqv_type_pred(in, in, in, in, in,
|
|
out, out).
|
|
|
|
goedel_replace_eqv_type_pred([], _Name, _Args, _Body, Found, [], Found).
|
|
goedel_replace_eqv_type_pred([TM0|TMs0], Name, Args, Body, Found0,
|
|
[TM|TMs], Found) :-
|
|
goedel_replace_eqv_type_tm(TM0, Name, Args, Body, Found0, TM, Found1),
|
|
goedel_replace_eqv_type_pred(TMs0, Name, Args, Body, Found1,
|
|
TMs, Found).
|
|
:- pred goedel_replace_eqv_type_tm(type_and_mode, string, list(type_param),
|
|
type, bool, type_and_mode, bool).
|
|
:- mode goedel_replace_eqv_type_tm(in, in, in, in, in,
|
|
out, out).
|
|
|
|
goedel_replace_eqv_type_tm(type_only(Type0), Name, Args, Body, Found0,
|
|
type_only(Type), Found) :-
|
|
goedel_replace_eqv_type_type(Type0, Name, Args, Body, Found0, Type,
|
|
Found).
|
|
goedel_replace_eqv_type_tm(type_and_mode(Type0, Mode), Name, Args, Body, Found0,
|
|
type_and_mode(Type, Mode), Found) :-
|
|
goedel_replace_eqv_type_type(Type0, Name, Args, Body, Found0, Type,
|
|
Found).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
unqualify_name(unqualified(PredName), PredName).
|
|
unqualify_name(qualified(_ModuleName, PredName), PredName).
|
|
|
|
sym_name_get_module_name(unqualified(_), ModuleName, ModuleName).
|
|
sym_name_get_module_name(qualified(ModuleName, _PredName), _, ModuleName).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
split_types_and_modes(TypesAndModes, Types, MaybeModes) :-
|
|
split_types_and_modes_2(TypesAndModes, yes, Types, Modes, Result),
|
|
(
|
|
Result = yes
|
|
->
|
|
MaybeModes = yes(Modes)
|
|
;
|
|
MaybeModes = no
|
|
).
|
|
|
|
:- type maybe ---> yes ; no.
|
|
:- pred split_types_and_modes_2(list(type_and_mode), maybe,
|
|
list(type), list(mode), maybe).
|
|
:- mode split_types_and_modes_2(in, in, out, out, out).
|
|
|
|
% T = type, M = mode, TM = combined type and mode
|
|
split_types_and_modes_2([], Result, [], [], Result).
|
|
split_types_and_modes_2([TM|TMs], Result0, [T|Ts], [M|Ms], Result) :-
|
|
split_type_and_mode(TM, Result0, T, M, Result1),
|
|
split_types_and_modes_2(TMs, Result1, Ts, Ms, Result).
|
|
|
|
% if a pred declaration specifies modes for some but
|
|
% not all of the arguments, then the modes are ignored
|
|
% - should this be an error instead?
|
|
|
|
:- pred split_type_and_mode(type_and_mode, maybe, type, mode, maybe).
|
|
:- mode split_type_and_mode(in, in, out, out, out).
|
|
|
|
split_type_and_mode(type_only(T), _, T, (free -> free), no).
|
|
split_type_and_mode(type_and_mode(T,M), R, T, M, R).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|