Files
mercury/compiler/prog_util.m
Zoltan Somogyi d69ba1a1f0 Include the type_ctor in cons_ids for user-defined types.
Estimated hours taken: 32
Branches: main

Include the type_ctor in cons_ids for user-defined types. The intention is
two-fold:

- It prepares for a future in which we allow more than one function symbol to
  with the same name to be defined in a module.

- It makes the HLDS code more self-contained. In many places, processing
  construction and deconstruction unifications required knowing which type
  the cons_id belongs to, but until now, code couldn't know that unless it
  kept track of the type of the variable unified with the cons_id.

With this diff, user-defined cons_ids are represented as

	cons(SymName, Arity, TypeCtor)

The last field is filled in during post-typecheck. After that time, any module
qualification in the SymName (which may initially be partial) is redundant,
since it is also available in the TypeCtor.

In the future, we could make all those SymNames be just unqualified(_) at that
time. We could also replace the current maps in HLDS type definitions with
full cons_id keys with just name/arity keys (since the module qualifier is a
given for any given type definition), we could also support partially
qualified cons_ids in source code using a map from name/arity pairs to a list
of all the type_ctors that have function symbols with that name/arity, instead
of our current practice of inserting all possible partially module qualified
version of every cons_id into a single giant table, and we could do the same
thing with the field names table.

This diff also separates tuples out from user-defined types, since in many
respects they are different (they don't have a single type_ctor, for starters).
It also separates out character constants, since they were alreay treated
specially in most places, though not in some places where they *ought* to
have been treated specially. Take the opportunity to give some other cons_ids
better names.

compiler/prog_data.m:
	Make the change described above, and document it.

	Put the implementations of the predicates declared in each part
	of this module next to the declarations, instead of keeping all the
	code until the very end (where it was usually far from their
	declarations).

	Remove three predicates with identical definitions from inst_match.m,
	inst_util.m and mode_constraints.m, and put the common definition
	in prog_data.m.

library/term_io.m:
	Add a new predicate that is basically a reversible version of
	the existing function espaced_char, since the definition of char_consts
	needs reversibilty.

compiler/post_typecheck.m:
	For functors of user-defined types, record their type_ctor. For tuples
	and char constants, record them as such.

compiler/builtin_lib_types.m:
compiler/parse_tree.m:
compiler/notes/compiler_design.html:
	New module to centralize knowledge about builtin types, specially
	handled library types, and their function symbols. Previously,
	the stuff now in this module used to be in several different places,
	including prog_type.m and stm_expand.m, and some of it was duplicated.

mdbcomp/prim_data.m:
	Add some predicates now needed by builtin_lib_types.m.

compiler/builtin_ops.m:
	Factor out some duplicated code.

compiler/add_type.m:
	Include the relevant type_ctors in the cons_ids generated in type
	definitions.

compiler/hlds_data.m:
	Document an existing type better.

	Rename a cons_tag in sync with its corresponding cons_id.

	Put some declarations into logical order.

compiler/hlds_out.m:
	Rename a misleadingly-named predicate.

compiler/prog_ctgc.m:
compiler/term_constr_build.m:
	Add XXXs for questionable existing code.

compiler/add_clause.m:
compiler/add_heap_ops.m:
compiler/add_pragma.m:
compiler/add_pred.m:
compiler/add_trail_ops.m:
compiler/assertion.m:
compiler/bytecode_gen.m:
compiler/closure_analysis.m:
compiler/code_info.m:
compiler/complexity.m:
compiler/ctgc_selector.m:
compiler/dead_proc_elim.m:
compiler/deep_profiling.m:
compiler/delay_partial_inst.m:
compiler/dependency_graph.m:
compiler/det_analysis.m:
compiler/det_report.m:
compiler/distance_granularity.m:
compiler/erl_rtti.m:
compiler/erl_unify_gen.m:
compiler/export.m:
compiler/field_access.m:
compiler/foreign.m:
compiler/format_call.m:
compiler/hhf.m:
compiler/higher_order.m:
compiler/hlds_code_util.m:
compiler/hlds_desc.m:
compiler/hlds_goal.m:
compiler/implementation_defined_literals.m:
compiler/inst_check.m:
compiler/inst_graph.m:
compiler/inst_match.m:
compiler/inst_util.m:
compiler/instmap.m:
compiler/intermod.m:
compiler/interval.m:
compiler/lambda.m:
compiler/lco.m:
compiler/make_tags.m:
compiler/mercury_compile.m:
compiler/mercury_to_mercury.m:
compiler/middle_rec.m:
compiler/ml_closure_gen.m:
compiler/ml_code_gen.m:
compiler/ml_code_util.m:
compiler/ml_switch_gen.m:
compiler/ml_type_gen.m:
compiler/ml_unify_gen.m:
compiler/ml_util.m:
compiler/mlds_to_c.m:
compiler/mlds_to_java.m:
compiler/mode_constraints.m:
compiler/mode_errors.m:
compiler/mode_ordering.m:
compiler/mode_util.m:
compiler/modecheck_unify.m:
compiler/modes.m:
compiler/module_qual.m:
compiler/polymorphism.m:
compiler/prog_ctgc.m:
compiler/prog_event.m:
compiler/prog_io_util.m:
compiler/prog_mode.m:
compiler/prog_mutable.m:
compiler/prog_out.m:
compiler/prog_type.m:
compiler/prog_util.m:
compiler/purity.m:
compiler/qual_info.m:
compiler/rbmm.add_rbmm_goal_infos.m:
compiler/rbmm.execution_path.m:
compiler/rbmm.points_to_analysis.m:
compiler/rbmm.region_transformation.m:
compiler/recompilation.usage.m:
compiler/rtti.m:
compiler/rtti_out.m:
compiler/rtti_to_mlds.m:
compiler/simplify.m:
compiler/simplify.m:
compiler/special_pred.m:
compiler/ssdebug.m:
compiler/stack_opt.m:
compiler/stm_expand.m:
compiler/stratify.m:
compiler/structure_reuse.direct.detect_garbagem:
compiler/superhomoegenous.m:
compiler/switch_detection.m:
compiler/switch_gen.m:
compiler/switch_util.m:
compiler/table_gen.m:
compiler/term_constr_build.m:
compiler/term_norm.m:
compiler/try_expand.m:
compiler/type_constraints.m:
compiler/type_ctor_info.m:
compiler/type_util.m:
compiler/typecheck.m:
compiler/typecheck_errors.m:
compiler/unify_gen.m:
compiler/unify_proc.m:
compiler/unify_modes.m:
compiler/untupling.m:
compiler/unused_imports.m:
compiler/xml_documentation.m:
	Minor changes, mostly to ignore the type_ctor in cons_ids in places
	where it is not needed, take the type_ctor from the cons_id in places
	where it is more convenient, conform to the new names of some cons_ids,
	conform to the changes in hlds_out.m, and/or add now-needed imports
	of builtin_lib_types.m.

	In some places, the handling previously applied to cons/2 (which
	included tuples and character constants as well as user-defined
	function symbols) is now applied only to user-defined function symbols
	or to user-defined function symbols and tuples, as appropriate,
	with character constants being handled more like the other kinds of
	constants.

	In inst_match.m, rename a whole bunch of predicates to avoid
	ambiguities.

	In prog_util.m, remove two predicates that did almost nothing yet were
	far too easy to misuse.
2009-06-11 07:00:38 +00:00

755 lines
28 KiB
Mathematica

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1994-2001, 2003-2009 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
% File: prog_util.
% Main author: fjh.
%
% Various utility predicates acting on the parse tree data structure defined
% in prog_data.m and prog_item.m
%
%-----------------------------------------------------------------------------%
:- module parse_tree.prog_util.
:- interface.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_item.
:- import_module list.
:- import_module maybe.
:- import_module term.
:- import_module varset.
%-----------------------------------------------------------------------------%
% Given a possible module qualified sym_name and a list of
% argument types and a context, construct a term. This is
% used to construct types.
%
:- pred construct_qualified_term(sym_name::in, list(term(T))::in,
term(T)::out) is det.
:- pred construct_qualified_term(sym_name::in, list(term(T))::in,
prog_context::in, term(T)::out) is det.
%-----------------------------------------------------------------------------%
% adjust_func_arity(PredOrFunc, FuncArity, PredArity).
%
% We internally store the arity as the length of the argument
% list including the return value, which is one more than the
% arity of the function reported in error messages.
%
:- pred adjust_func_arity(pred_or_func, int, int).
:- mode adjust_func_arity(in, in, out) is det.
:- mode adjust_func_arity(in, out, in) is det.
%-----------------------------------------------------------------------------%
% make_pred_name_with_context(ModuleName, Prefix, PredOrFunc, PredName,
% Line, Counter, SymName).
%
% Create a predicate name with context, e.g. for introduced
% lambda or deforestation predicates.
%
:- pred make_pred_name(module_name::in, string::in, maybe(pred_or_func)::in,
string::in, new_pred_id::in, sym_name::out) is det.
% make_pred_name_with_context(ModuleName, Prefix, PredOrFunc, PredName,
% Line, Counter, SymName).
%
% Create a predicate name with context, e.g. for introduced
% lambda or deforestation predicates.
%
:- pred make_pred_name_with_context(module_name::in, string::in,
pred_or_func::in, string::in, int::in, int::in, sym_name::out) is det.
:- type new_pred_id
---> newpred_counter(int, int) % Line number, Counter
; newpred_type_subst(tvarset, type_subst)
; newpred_unused_args(list(int))
; newpred_parallel_args(list(int))
; newpred_structure_reuse(int, list(int)) % Mode, no-clobber
% arguments.
; newpred_distance_granularity(int). % Distance
%-----------------------------------------------------------------------------%
% 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 == maybe(list(mer_mode)).
:- pred split_types_and_modes(list(type_and_mode)::in, list(mer_type)::out,
maybe_modes::out) is det.
:- pred split_type_and_mode(type_and_mode::in, mer_type::out,
maybe(mer_mode)::out) is det.
%-----------------------------------------------------------------------------%
% Perform a substitution on a goal.
%
:- pred rename_in_goal(prog_var::in, prog_var::in, goal::in, goal::out) is det.
%-----------------------------------------------------------------------------%
% Various predicates for accessing the cons_id type.
% Given a cons_id and a list of argument terms, convert it into a term.
% Works only on the cons_ids that can be expressed in source programs,
% so it fails e.g. on pred_consts and type_ctor_info_consts.
%
:- pred cons_id_and_args_to_term(cons_id::in, list(term(T))::in, term(T)::out)
is semidet.
% Get the arity of a cons_id, aborting on pred_const and
% type_ctor_info_const.
%
:- func cons_id_arity(cons_id) = arity.
% Get the arity of a cons_id. Return a `no' on those cons_ids
% where cons_id_arity/2 would normally abort.
%
:- func cons_id_maybe_arity(cons_id) = maybe(arity).
% The reverse conversion - make a cons_id for a functor.
% Given a const and an arity for the functor, create a cons_id.
%
:- func make_functor_cons_id(const, arity) = cons_id.
%-----------------------------------------------------------------------------%
% make_n_fresh_vars(Name, N, VarSet0, Vars, VarSet):
% `Vars' is a list of `N' fresh variables allocated from
% `VarSet0'. The variables will be named "<Name>1", "<Name>2",
% "<Name>3", and so on, where <Name> is the value of `Name'.
% `VarSet' is the resulting varset.
%
:- pred make_n_fresh_vars(string::in, int::in, list(var(T))::out,
varset(T)::in, varset(T)::out) is det.
% Given the list of predicate arguments for a predicate that
% is really a function, split that list into the function arguments
% and the function return type.
%
:- pred pred_args_to_func_args(list(T)::in, list(T)::out, T::out) is det.
% Get the last two arguments from the list, failing if there
% aren't at least two arguments.
%
:- pred get_state_args(list(T)::in, list(T)::out, T::out, T::out) is semidet.
% Get the last two arguments from the list, aborting if there
% aren't at least two arguments.
%
:- pred get_state_args_det(list(T)::in, list(T)::out, T::out, T::out) is det.
% Parse a term of the form `Head :- Body', treating a term not in that form
% as `Head :- true'.
%
:- pred parse_rule_term(term.context::in, term(T)::in, term(T)::out,
term(T)::out) is det.
%-----------------------------------------------------------------------------%
% Add new type variables for those introduced by a type qualification.
%
:- pred get_new_tvars(list(tvar)::in, tvarset::in, tvarset::in, tvarset::out,
tvar_name_map::in, tvar_name_map::out,
tvar_renaming::in, tvar_renaming::out) is det.
%-----------------------------------------------------------------------------%
% We need to "unparse" the sym_name to construct the properly
% module qualified term.
%
:- func sym_name_and_args_to_term(sym_name, list(term(T)), prog_context) =
term(T).
%-----------------------------------------------------------------------------%
% Convert a list of goals into a conjunction.
%
:- func goal_list_to_conj(prog_context, list(goal)) = goal.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module libs.compiler_util.
:- import_module parse_tree.mercury_to_mercury.
:- import_module parse_tree.prog_out.
:- import_module bool.
:- import_module int.
:- import_module map.
:- import_module pair.
:- import_module string.
:- import_module svmap.
:- import_module term_io.
:- import_module varset.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
construct_qualified_term(qualified(Module, Name), Args, Context, Term) :-
construct_qualified_term(Module, [], Context, ModuleTerm),
UnqualifiedTerm = term.functor(term.atom(Name), Args, Context),
Term = term.functor(term.atom("."),
[ModuleTerm, UnqualifiedTerm], Context).
construct_qualified_term(unqualified(Name), Args, Context, Term) :-
Term = term.functor(term.atom(Name), Args, Context).
construct_qualified_term(SymName, Args, Term) :-
term.context_init(Context),
construct_qualified_term(SymName, Args, Context, Term).
%-----------------------------------------------------------------------------%
adjust_func_arity(pf_predicate, Arity, Arity).
adjust_func_arity(pf_function, Arity - 1, Arity).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
split_types_and_modes(TypesAndModes, Types, MaybeModes) :-
split_types_and_modes_2(TypesAndModes, yes, Types, Modes, Result),
(
Result = yes,
MaybeModes = yes(Modes)
;
Result = no,
MaybeModes = no
).
:- pred split_types_and_modes_2(list(type_and_mode)::in, bool::in,
list(mer_type)::out, list(mer_mode)::out, bool::out) is det.
% 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?
% trd: this should never happen because prog_io.m will detect these cases.
%
:- pred split_type_and_mode(type_and_mode::in, bool::in,
mer_type::out, mer_mode::out, bool::out) is det.
split_type_and_mode(type_only(T), _, T, (free -> free), no).
split_type_and_mode(type_and_mode(T,M), R, T, M, R).
split_type_and_mode(type_only(T), T, no).
split_type_and_mode(type_and_mode(T,M), T, yes(M)).
%-----------------------------------------------------------------------------%
rename_in_goal(OldVar, NewVar, Goal0 - Context, Goal - Context) :-
rename_in_goal_expr(OldVar, NewVar, Goal0, Goal).
:- pred rename_in_goal_expr(prog_var::in, prog_var::in,
goal_expr::in, goal_expr::out) is det.
rename_in_goal_expr(OldVar, NewVar,
conj_expr(GoalA0, GoalB0),
conj_expr(GoalA, GoalB)) :-
rename_in_goal(OldVar, NewVar, GoalA0, GoalA),
rename_in_goal(OldVar, NewVar, GoalB0, GoalB).
rename_in_goal_expr(OldVar, NewVar,
par_conj_expr(GoalA0, GoalB0),
par_conj_expr(GoalA, GoalB)) :-
rename_in_goal(OldVar, NewVar, GoalA0, GoalA),
rename_in_goal(OldVar, NewVar, GoalB0, GoalB).
rename_in_goal_expr(_OldVar, _NewVar, true_expr, true_expr).
rename_in_goal_expr(OldVar, NewVar,
disj_expr(GoalA0, GoalB0),
disj_expr(GoalA, GoalB)) :-
rename_in_goal(OldVar, NewVar, GoalA0, GoalA),
rename_in_goal(OldVar, NewVar, GoalB0, GoalB).
rename_in_goal_expr(_Var, _NewVar, fail_expr, fail_expr).
rename_in_goal_expr(OldVar, NewVar, not_expr(Goal0), not_expr(Goal)) :-
rename_in_goal(OldVar, NewVar, Goal0, Goal).
rename_in_goal_expr(OldVar, NewVar,
some_expr(Vars0, Goal0),
some_expr(Vars, Goal)) :-
rename_in_vars(OldVar, NewVar, Vars0, Vars),
rename_in_goal(OldVar, NewVar, Goal0, Goal).
rename_in_goal_expr(OldVar, NewVar,
some_state_vars_expr(Vars0, Goal0),
some_state_vars_expr(Vars, Goal)) :-
rename_in_vars(OldVar, NewVar, Vars0, Vars),
rename_in_goal(OldVar, NewVar, Goal0, Goal).
rename_in_goal_expr(OldVar, NewVar,
all_expr(Vars0, Goal0),
all_expr(Vars, Goal)) :-
rename_in_vars(OldVar, NewVar, Vars0, Vars),
rename_in_goal(OldVar, NewVar, Goal0, Goal).
rename_in_goal_expr(OldVar, NewVar,
all_state_vars_expr(Vars0, Goal0),
all_state_vars_expr(Vars, Goal)) :-
rename_in_vars(OldVar, NewVar, Vars0, Vars),
rename_in_goal(OldVar, NewVar, Goal0, Goal).
rename_in_goal_expr(OldVar, NewVar,
promise_purity_expr(Purity, Goal0),
promise_purity_expr(Purity, Goal)) :-
rename_in_goal(OldVar, NewVar, Goal0, Goal).
rename_in_goal_expr(OldVar, NewVar,
promise_equivalent_solutions_expr(Vars0, DotSVars0, ColonSVars0,
Goal0),
promise_equivalent_solutions_expr(Vars, DotSVars, ColonSVars,
Goal)) :-
rename_in_vars(OldVar, NewVar, Vars0, Vars),
rename_in_vars(OldVar, NewVar, DotSVars0, DotSVars),
rename_in_vars(OldVar, NewVar, ColonSVars0, ColonSVars),
rename_in_goal(OldVar, NewVar, Goal0, Goal).
rename_in_goal_expr(OldVar, NewVar,
promise_equivalent_solution_sets_expr(Vars0, DotSVars0, ColonSVars0,
Goal0),
promise_equivalent_solution_sets_expr(Vars, DotSVars, ColonSVars,
Goal)) :-
rename_in_vars(OldVar, NewVar, Vars0, Vars),
rename_in_vars(OldVar, NewVar, DotSVars0, DotSVars),
rename_in_vars(OldVar, NewVar, ColonSVars0, ColonSVars),
rename_in_goal(OldVar, NewVar, Goal0, Goal).
rename_in_goal_expr(OldVar, NewVar,
promise_equivalent_solution_arbitrary_expr(Vars0,
DotSVars0, ColonSVars0, Goal0),
promise_equivalent_solution_arbitrary_expr(Vars,
DotSVars, ColonSVars, Goal)) :-
rename_in_vars(OldVar, NewVar, Vars0, Vars),
rename_in_vars(OldVar, NewVar, DotSVars0, DotSVars),
rename_in_vars(OldVar, NewVar, ColonSVars0, ColonSVars),
rename_in_goal(OldVar, NewVar, Goal0, Goal).
rename_in_goal_expr(OldVar, NewVar,
trace_expr(CompileTime, RunTime, MaybeIO0, Mutables0, Goal0),
trace_expr(CompileTime, RunTime, MaybeIO, Mutables, Goal)) :-
(
MaybeIO0 = no,
MaybeIO = no
;
MaybeIO0 = yes(IOStateVar0),
rename_in_var(OldVar, NewVar, IOStateVar0, IOStateVar),
MaybeIO = yes(IOStateVar)
),
list.map(rename_in_trace_mutable_var(OldVar, NewVar),
Mutables0, Mutables),
rename_in_goal(OldVar, NewVar, Goal0, Goal).
rename_in_goal_expr(OldVar, NewVar,
atomic_expr(InVars0, OutVars0, MaybeVars0, MainExpr0, OrElseExpr0),
atomic_expr(InVars, OutVars, MaybeVars, MainExpr, OrElseExpr)) :-
rename_in_atomic_varlist(OldVar, NewVar, InVars0, InVars),
rename_in_atomic_varlist(OldVar, NewVar, OutVars0, OutVars),
(
MaybeVars0 = no,
MaybeVars = no
;
MaybeVars0 = yes(TransVars0),
list.map(rename_in_var(OldVar, NewVar),
TransVars0, TransVars),
MaybeVars = yes(TransVars)
),
rename_in_goal(OldVar, NewVar, MainExpr0, MainExpr),
list.map(rename_in_goal(OldVar, NewVar), OrElseExpr0, OrElseExpr).
rename_in_goal_expr(OldVar, NewVar,
try_expr(MaybeIO0, SubGoal0, Then0, MaybeElse0, Catches0,
MaybeCatchAny0),
try_expr(MaybeIO, SubGoal, Then, MaybeElse, Catches, MaybeCatchAny)) :-
rename_in_maybe_var(OldVar, NewVar, MaybeIO0, MaybeIO),
rename_in_goal(OldVar, NewVar, SubGoal0, SubGoal),
rename_in_goal(OldVar, NewVar, Then0, Then),
(
MaybeElse0 = yes(Else0),
rename_in_goal(OldVar, NewVar, Else0, Else),
MaybeElse = yes(Else)
;
MaybeElse0 = no,
MaybeElse = no
),
list.map(rename_in_catch_expr(OldVar, NewVar), Catches0, Catches),
(
MaybeCatchAny0 = yes(catch_any_expr(CatchAnyVar0, CatchAnyGoal0)),
rename_in_var(OldVar, NewVar, CatchAnyVar0, CatchAnyVar),
rename_in_goal(OldVar, NewVar, CatchAnyGoal0, CatchAnyGoal),
MaybeCatchAny = yes(catch_any_expr(CatchAnyVar, CatchAnyGoal))
;
MaybeCatchAny0 = no,
MaybeCatchAny = no
).
rename_in_goal_expr(OldVar, NewVar,
implies_expr(GoalA0, GoalB0),
implies_expr(GoalA, GoalB)) :-
rename_in_goal(OldVar, NewVar, GoalA0, GoalA),
rename_in_goal(OldVar, NewVar, GoalB0, GoalB).
rename_in_goal_expr(OldVar, NewVar,
equivalent_expr(GoalA0, GoalB0),
equivalent_expr(GoalA, GoalB)) :-
rename_in_goal(OldVar, NewVar, GoalA0, GoalA),
rename_in_goal(OldVar, NewVar, GoalB0, GoalB).
rename_in_goal_expr(OldVar, NewVar,
if_then_else_expr(Vars0, StateVars0, Cond0, Then0, Else0),
if_then_else_expr(Vars, StateVars, Cond, Then, Else)) :-
rename_in_vars(OldVar, NewVar, Vars0, Vars),
rename_in_vars(OldVar, NewVar, StateVars0, StateVars),
rename_in_goal(OldVar, NewVar, Cond0, Cond),
rename_in_goal(OldVar, NewVar, Then0, Then),
rename_in_goal(OldVar, NewVar, Else0, Else).
rename_in_goal_expr(OldVar, NewVar,
event_expr(Name, Terms0),
event_expr(Name, Terms)) :-
term.substitute_list(Terms0, OldVar, variable(NewVar, context_init), Terms).
rename_in_goal_expr(OldVar, NewVar,
call_expr(SymName, Terms0, Purity),
call_expr(SymName, Terms, Purity)) :-
term.substitute_list(Terms0, OldVar, variable(NewVar, context_init), Terms).
rename_in_goal_expr(OldVar, NewVar,
unify_expr(TermA0, TermB0, Purity),
unify_expr(TermA, TermB, Purity)) :-
term.substitute(TermA0, OldVar, term.variable(NewVar, context_init), TermA),
term.substitute(TermB0, OldVar, term.variable(NewVar, context_init), TermB).
:- pred rename_in_atomic_varlist(prog_var::in, prog_var::in,
atomic_component_state::in, atomic_component_state::out) is det.
rename_in_atomic_varlist(OldVar, NewVar, Comp0, Comp) :-
(
Comp0 = atomic_state_var(SVar0),
rename_in_var(OldVar, NewVar, SVar0, SVar),
Comp = atomic_state_var(SVar)
;
Comp0 = atomic_var_pair(IVar0, OVar0),
rename_in_var(OldVar, NewVar, IVar0, IVar),
rename_in_var(OldVar, NewVar, OVar0, OVar),
Comp = atomic_var_pair(IVar, OVar)
).
:- pred rename_in_trace_mutable_var(prog_var::in, prog_var::in,
trace_mutable_var::in, trace_mutable_var::out) is det.
rename_in_trace_mutable_var(OldVar, NewVar, TMV0, TMV) :-
TMV0 = trace_mutable_var(MutableName, StateVar0),
rename_in_var(OldVar, NewVar, StateVar0, StateVar),
TMV = trace_mutable_var(MutableName, StateVar).
:- pred rename_in_vars(prog_var::in, prog_var::in,
list(prog_var)::in, list(prog_var)::out) is det.
rename_in_vars(_, _, [], []).
rename_in_vars(OldVar, NewVar, [Var0 | Vars0], [Var | Vars]) :-
rename_in_var(OldVar, NewVar, Var0, Var),
rename_in_vars(OldVar, NewVar, Vars0, Vars).
:- pred rename_in_var(prog_var::in, prog_var::in,
prog_var::in, prog_var::out) is det.
rename_in_var(OldVar, NewVar, Var0, Var) :-
( Var0 = OldVar ->
Var = NewVar
;
Var = Var0
).
:- pred rename_in_maybe_var(prog_var::in, prog_var::in,
maybe(prog_var)::in, maybe(prog_var)::out) is det.
rename_in_maybe_var(OldVar, NewVar, MaybeVar0, MaybeVar) :-
(
MaybeVar0 = yes(Var0),
rename_in_var(OldVar, NewVar, Var0, Var),
MaybeVar = yes(Var)
;
MaybeVar0 = no,
MaybeVar = no
).
:- pred rename_in_catch_expr(prog_var::in, prog_var::in,
catch_expr::in, catch_expr::out) is det.
rename_in_catch_expr(OldVar, NewVar, Catch0, Catch) :-
Catch0 = catch_expr(Term0, Goal0),
term.substitute(Term0, OldVar, term.variable(NewVar, context_init), Term),
rename_in_goal(OldVar, NewVar, Goal0, Goal),
Catch = catch_expr(Term, Goal).
%-----------------------------------------------------------------------------%
make_pred_name_with_context(ModuleName, Prefix,
PredOrFunc, PredName, Line, Counter, SymName) :-
make_pred_name(ModuleName, Prefix, yes(PredOrFunc), PredName,
newpred_counter(Line, Counter), SymName).
make_pred_name(ModuleName, Prefix, MaybePredOrFunc, PredName,
NewPredId, SymName) :-
(
MaybePredOrFunc = yes(PredOrFunc),
PFS = pred_or_func_to_str(PredOrFunc)
;
MaybePredOrFunc = no,
PFS = "pred_or_func"
),
(
NewPredId = newpred_counter(Line, Counter),
string.format("%d__%d", [i(Line), i(Counter)], PredIdStr)
;
NewPredId = newpred_type_subst(VarSet, TypeSubst),
SubstToString = (pred(SubstElem::in, SubstStr::out) is det :-
SubstElem = Var - Type,
varset.lookup_name(VarSet, Var, VarName),
TypeString = mercury_type_to_string(VarSet, no, Type),
string.append_list([VarName, " = ", TypeString], SubstStr)
),
list_to_string(SubstToString, TypeSubst, PredIdStr)
;
( NewPredId = newpred_unused_args(Args)
; NewPredId = newpred_parallel_args(Args)
),
list_to_string(int_to_string, Args, PredIdStr)
;
NewPredId = newpred_structure_reuse(ModeNum, Args),
int_to_string(ModeNum, ModeStr),
list_to_string(int_to_string, Args, ArgsStr),
PredIdStr = ModeStr ++ "__" ++ ArgsStr
;
NewPredId = newpred_distance_granularity(Distance),
int_to_string(Distance, PredIdStr)
),
string.format("%s__%s__%s__%s",
[s(Prefix), s(PFS), s(PredName), s(PredIdStr)], Name),
SymName = qualified(ModuleName, Name).
:- pred list_to_string(pred(T, string)::in(pred(in, out) is det),
list(T)::in, string::out) is det.
list_to_string(Pred, List, String) :-
list_to_string_2(Pred, List, ["]"], Strings),
string.append_list(["[" | Strings], String).
:- pred list_to_string_2(pred(T, string)::in(pred(in, out) is det),
list(T)::in, list(string)::in, list(string)::out) is det.
list_to_string_2(_, [], !Strings).
list_to_string_2(Pred, [T | Ts], !Strings) :-
(
Ts = []
;
Ts = [_ | _],
list_to_string_2(Pred, Ts, !Strings),
!:Strings = [", " | !.Strings]
),
call(Pred, T, String),
!:Strings = [String | !.Strings].
%-----------------------------------------------------------------------------%
cons_id_and_args_to_term(int_const(Int), [], Term) :-
term.context_init(Context),
Term = term.functor(term.integer(Int), [], Context).
cons_id_and_args_to_term(float_const(Float), [], Term) :-
term.context_init(Context),
Term = term.functor(term.float(Float), [], Context).
cons_id_and_args_to_term(char_const(Char), [], Term) :-
SymName = unqualified(term_io.escaped_char(Char)),
construct_qualified_term(SymName, [], Term).
cons_id_and_args_to_term(string_const(String), [], Term) :-
term.context_init(Context),
Term = term.functor(term.string(String), [], Context).
cons_id_and_args_to_term(tuple_cons(_Arity), Args, Term) :-
SymName = unqualified("{}"),
construct_qualified_term(SymName, Args, Term).
cons_id_and_args_to_term(cons(SymName, _Arity, _TypeCtor), Args, Term) :-
construct_qualified_term(SymName, Args, Term).
cons_id_arity(ConsId) = Arity :-
(
ConsId = cons(_, Arity, _)
;
ConsId = tuple_cons(Arity)
;
( ConsId = int_const(_)
; ConsId = float_const(_)
; ConsId = char_const(_)
; ConsId = string_const(_)
; ConsId = impl_defined_const(_)
),
Arity = 0
;
( ConsId = closure_cons(_, _)
; ConsId = type_ctor_info_const(_, _, _)
; ConsId = base_typeclass_info_const(_, _, _, _)
; ConsId = type_info_cell_constructor(_)
; ConsId = typeclass_info_cell_constructor
; ConsId = tabling_info_const(_)
; ConsId = deep_profiling_proc_layout(_)
; ConsId = table_io_decl(_)
),
unexpected(this_file, "cons_id_arity: unexpected cons_id")
).
cons_id_maybe_arity(cons(_, Arity, _)) = yes(Arity).
cons_id_maybe_arity(tuple_cons(Arity)) = yes(Arity).
cons_id_maybe_arity(int_const(_)) = yes(0).
cons_id_maybe_arity(float_const(_)) = yes(0).
cons_id_maybe_arity(char_const(_)) = yes(0).
cons_id_maybe_arity(string_const(_)) = yes(0).
cons_id_maybe_arity(impl_defined_const(_)) = yes(0).
cons_id_maybe_arity(closure_cons(_, _)) = no.
cons_id_maybe_arity(type_ctor_info_const(_, _, _)) = no.
cons_id_maybe_arity(base_typeclass_info_const(_, _, _, _)) = no.
cons_id_maybe_arity(type_info_cell_constructor(_)) = no.
cons_id_maybe_arity(typeclass_info_cell_constructor) = no.
cons_id_maybe_arity(tabling_info_const(_)) = no.
cons_id_maybe_arity(deep_profiling_proc_layout(_)) = no.
cons_id_maybe_arity(table_io_decl(_)) = no.
make_functor_cons_id(term.atom(Name), Arity) =
cons(unqualified(Name), Arity, cons_id_dummy_type_ctor).
make_functor_cons_id(term.integer(Int), _) = int_const(Int).
make_functor_cons_id(term.string(String), _) = string_const(String).
make_functor_cons_id(term.float(Float), _) = float_const(Float).
make_functor_cons_id(term.implementation_defined(Name), _) =
impl_defined_const(Name).
%-----------------------------------------------------------------------------%
make_n_fresh_vars(BaseName, N, Vars, VarSet0, VarSet) :-
make_n_fresh_vars_2(BaseName, 0, N, Vars, VarSet0, VarSet).
:- pred make_n_fresh_vars_2(string::in, int::in, int::in, list(var(T))::out,
varset(T)::in, varset(T)::out) is det.
make_n_fresh_vars_2(BaseName, N, Max, Vars, !VarSet) :-
( N = Max ->
Vars = []
;
N1 = N + 1,
varset.new_var(!.VarSet, Var, !:VarSet),
string.int_to_string(N1, Num),
string.append(BaseName, Num, VarName),
varset.name_var(!.VarSet, Var, VarName, !:VarSet),
Vars = [Var | Vars1],
make_n_fresh_vars_2(BaseName, N1, Max, Vars1, !VarSet)
).
pred_args_to_func_args(PredArgs, FuncArgs, FuncReturn) :-
list.length(PredArgs, NumPredArgs),
NumFuncArgs = NumPredArgs - 1,
( list.split_list(NumFuncArgs, PredArgs, FuncArgs0, [FuncReturn0]) ->
FuncArgs = FuncArgs0,
FuncReturn = FuncReturn0
;
unexpected(this_file,
"pred_args_to_func_args: function missing return value?")
).
get_state_args(Args0, Args, State0, State) :-
list.reverse(Args0, RevArgs0),
RevArgs0 = [State, State0 | RevArgs],
list.reverse(RevArgs, Args).
get_state_args_det(Args0, Args, State0, State) :-
( get_state_args(Args0, Args1, State0A, StateA) ->
Args = Args1,
State0 = State0A,
State = StateA
;
unexpected(this_file, "get_state_args_det")
).
%-----------------------------------------------------------------------------%
parse_rule_term(Context, RuleTerm, HeadTerm, GoalTerm) :-
( RuleTerm = term.functor(term.atom(":-"), [HeadTerm0, GoalTerm0], _) ->
HeadTerm = HeadTerm0,
GoalTerm = GoalTerm0
;
HeadTerm = RuleTerm,
GoalTerm = term.functor(term.atom("true"), [], Context)
).
get_new_tvars([], _, !TVarSet, !TVarNameMap, !TVarRenaming).
get_new_tvars([TVar | TVars], VarSet, !TVarSet, !TVarNameMap, !TVarRenaming) :-
( map.contains(!.TVarRenaming, TVar) ->
true
;
( varset.search_name(VarSet, TVar, TVarName) ->
( map.search(!.TVarNameMap, TVarName, TVarSetVar) ->
svmap.det_insert(TVar, TVarSetVar, !TVarRenaming)
;
varset.new_var(!.TVarSet, NewTVar, !:TVarSet),
varset.name_var(!.TVarSet, NewTVar, TVarName, !:TVarSet),
svmap.det_insert(TVarName, NewTVar, !TVarNameMap),
svmap.det_insert(TVar, NewTVar, !TVarRenaming)
)
;
varset.new_var(!.TVarSet, NewTVar, !:TVarSet),
svmap.det_insert(TVar, NewTVar, !TVarRenaming)
)
),
get_new_tvars(TVars, VarSet, !TVarSet, !TVarNameMap, !TVarRenaming).
%-----------------------------------------------------------------------------%
sym_name_and_args_to_term(unqualified(Name), Xs, Context) =
term.functor(term.atom(Name), Xs, Context).
sym_name_and_args_to_term(qualified(ModuleNames, Name), Xs, Context) =
sym_name_and_term_to_term(ModuleNames,
term.functor(term.atom(Name), Xs, Context), Context).
:- func sym_name_and_term_to_term(module_specifier, term(T), prog_context) =
term(T).
sym_name_and_term_to_term(unqualified(ModuleName), Term, Context) =
term.functor(
term.atom("."),
[term.functor(term.atom(ModuleName), [], Context), Term],
Context
).
sym_name_and_term_to_term(qualified(ModuleNames, ModuleName), Term, Context) =
term.functor(
term.atom("."),
[sym_name_and_term_to_term(
ModuleNames,
term.functor(term.atom(ModuleName), [], Context),
Context),
Term],
Context
).
%-----------------------------------------------------------------------------%
goal_list_to_conj(Context, []) = true_expr - Context.
goal_list_to_conj(Context, [Goal | Goals]) =
goal_list_to_conj_2(Context, Goal, Goals).
:- func goal_list_to_conj_2(prog_context, goal, list(goal)) = goal.
goal_list_to_conj_2(_, Goal, []) = Goal.
goal_list_to_conj_2(Context, Goal0, [Goal1 | Goals]) =
conj_expr(Goal0, goal_list_to_conj_2(Context, Goal1, Goals)) - Context.
%-----------------------------------------------------------------------------%
:- func this_file = string.
this_file = "prog_util.m".
%-----------------------------------------------------------------------------%
:- end_module prog_util.
%-----------------------------------------------------------------------------%