mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-17 02:13:54 +00:00
585c5f6165
The reason for this is that without such limits,
- the generation of a HLDS dump for the valid/inst_perf_bug_2 test case
takes almost forever, and
- generates a multi-gigabyte HLDS dump, which causes e.g. vim to take
forever to open.
Making the generation and use of HLDS dumps practical is worth the cost
of losing some information. (Information you can't afford to generate
or to use is lost anyway.)
compiler/options.m:
doc/user_guide.texi.m:
Add a new option to limit the size of the insts we output
in the inst tables part of HLDS dumps. This option should allow users
to select the tradeoff between the amount of information being preserved
and the cost of generating/using that information.
compiler/hlds_out_module.m:
Pass the value of the new option to hlds_out_inst_table.m.
compiler/hlds_out_inst_table.m:
Specify the size limit when writing out insts as either the keys or
the values in the various kinds of inst tables.
compiler/parse_tree_to_term.m:
To implement those limits, add inst_to_limited_size_term and
inst_name_to_limited_size_term, versions of the old inst_to_term
and inst_name_to_term functions that truncate the given inst or inst name
at the given "size" if necessary. The measure of "size" is just
function symbols in the resulting term in most cases, though
we treat things that in practice never get too big, such as types,
as "one", regardless of the number of function symbols they contain.
To make the parallel between the old non-size-limiting and the new
size-limiting versions of the relevant codes easier to see, transform
the functions in the old code to predicates. (The new versions have
to be predicates to allow the size to be passed along in a state var.)
compiler/hlds_out_goal.m:
When we print out the argument modes of a unification, limit the depth
to which we write out the various insts to three. This should be
more than enough, because any inst that we now replace with "..."
should be available in the mode information of the atomic goal that
generates it, whether that goal is a unification or a call.
1128 lines
44 KiB
Mathematica
1128 lines
44 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 2009-2012 The University of Melbourne.
|
|
% Copyright (C) 2015-2018 The Mercury team.
|
|
% This file may only be copied under the terms of the GNU General
|
|
% Public License - see the file COPYING in the Mercury distribution.
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% File: unparse.m.
|
|
% Main authors: conway, fjh.
|
|
%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- module parse_tree.parse_tree_to_term.
|
|
:- interface.
|
|
|
|
:- import_module parse_tree.parse_tree_out_info.
|
|
:- import_module parse_tree.prog_data.
|
|
|
|
:- import_module term.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% Convert a type to a term representation.
|
|
%
|
|
:- pred unparse_type(mer_type::in, term::out) is det.
|
|
|
|
% Convert a mode to a term representation.
|
|
%
|
|
:- func mode_to_term(output_lang, mer_mode) = prog_term.
|
|
:- func mode_to_term_with_context(output_lang, prog_context, mer_mode)
|
|
= prog_term.
|
|
|
|
% Convert an inst to a term representation.
|
|
%
|
|
:- func inst_to_term(output_lang, mer_inst) = prog_term.
|
|
:- func inst_to_limited_size_term(output_lang, int, mer_inst) = prog_term.
|
|
:- func inst_name_to_term(output_lang, inst_name) = prog_term.
|
|
:- func inst_name_to_limited_size_term(output_lang, int, inst_name)
|
|
= prog_term.
|
|
:- func inst_test_results_to_term(prog_context, inst_test_results) = prog_term.
|
|
|
|
% Convert an integer to a term representation.
|
|
%
|
|
:- func int_const_to_decimal_term(some_int_const, term.context) = term(T).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.prim_data.
|
|
:- import_module mdbcomp.sym_name.
|
|
:- import_module parse_tree.parse_tree_out_misc.
|
|
:- import_module parse_tree.prog_util.
|
|
|
|
:- import_module int.
|
|
:- import_module list.
|
|
:- import_module require.
|
|
:- import_module set.
|
|
:- import_module string.
|
|
:- import_module term_context.
|
|
:- import_module term_int.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- func make_atom(prog_context, string) = prog_term.
|
|
|
|
make_atom(Context, Name) =
|
|
term.functor(term.atom(Name), [], Context).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
unparse_type(Type, Term) :-
|
|
Context = dummy_context,
|
|
(
|
|
Type = type_variable(TVar, _),
|
|
Var = term.coerce_var(TVar),
|
|
Term = term.variable(Var, Context)
|
|
;
|
|
Type = defined_type(SymName, ArgTypes, _),
|
|
unparse_type_list(ArgTypes, ArgTerms),
|
|
unparse_qualified_term(SymName, ArgTerms, Term)
|
|
;
|
|
Type = builtin_type(BuiltinType),
|
|
builtin_type_name(BuiltinType, Name),
|
|
Term = term.functor(term.atom(Name), [], Context)
|
|
;
|
|
Type = higher_order_type(PorF, PredArgTypes, HOInstInfo, Purity,
|
|
EvalMethod),
|
|
unparse_type_list(PredArgTypes, PredArgTypeTerms),
|
|
(
|
|
HOInstInfo = higher_order(pred_inst_info(_, PredArgModes, _, _)),
|
|
unparse_mode_list(PredArgModes, PredArgModeTerms),
|
|
combine_type_and_mode_terms(PredArgTypeTerms, PredArgModeTerms,
|
|
PredArgTerms)
|
|
;
|
|
HOInstInfo = none_or_default_func,
|
|
PredArgTerms = PredArgTypeTerms
|
|
),
|
|
(
|
|
PorF = pf_predicate,
|
|
Term0 = term.functor(term.atom("pred"), PredArgTerms, Context),
|
|
maybe_add_lambda_eval_method(EvalMethod, Term0, Term2)
|
|
;
|
|
PorF = pf_function,
|
|
list.det_split_last(PredArgTerms, ArgTerms, RetTerm),
|
|
Term0 = term.functor(term.atom("func"), ArgTerms, Context),
|
|
maybe_add_lambda_eval_method(EvalMethod, Term0, Term1),
|
|
Term2 = term.functor(term.atom("="), [Term1, RetTerm], Context)
|
|
),
|
|
maybe_add_purity_annotation(Purity, Term2, Term3),
|
|
maybe_add_detism(HOInstInfo, Term3, Term)
|
|
;
|
|
Type = tuple_type(ArgTypes, _),
|
|
unparse_type_list(ArgTypes, ArgTerms),
|
|
Term = term.functor(term.atom("{}"), ArgTerms, Context)
|
|
;
|
|
Type = apply_n_type(TVar, ArgTypes, _),
|
|
Var = term.coerce_var(TVar),
|
|
unparse_type_list(ArgTypes, ArgTerms),
|
|
Term = term.functor(term.atom(""),
|
|
[term.variable(Var, Context) | ArgTerms], Context)
|
|
;
|
|
Type = kinded_type(_, _),
|
|
unexpected($pred, "kind annotation")
|
|
).
|
|
|
|
:- pred unparse_type_list(list(mer_type)::in, list(term)::out) is det.
|
|
|
|
unparse_type_list(Types, Terms) :-
|
|
list.map(unparse_type, Types, Terms).
|
|
|
|
:- pred unparse_qualified_term(sym_name::in, list(term)::in, term::out) is det.
|
|
|
|
unparse_qualified_term(unqualified(Name), Args, Term) :-
|
|
Term = term.functor(term.atom(Name), Args, dummy_context).
|
|
unparse_qualified_term(qualified(Qualifier, Name), Args, Term) :-
|
|
unparse_qualified_term(Qualifier, [], QualTerm),
|
|
Context = dummy_context,
|
|
Term0 = term.functor(term.atom(Name), Args, Context),
|
|
Term = term.functor(term.atom("."), [QualTerm, Term0], Context).
|
|
|
|
:- pred combine_type_and_mode_terms(list(term)::in, list(term)::in,
|
|
list(term)::out) is det.
|
|
|
|
combine_type_and_mode_terms([], [], []).
|
|
combine_type_and_mode_terms([], [_ | _], _) :-
|
|
unexpected($pred, "argument length mismatch").
|
|
combine_type_and_mode_terms([_ | _], [], _) :-
|
|
unexpected($pred, "argument length mismatch").
|
|
combine_type_and_mode_terms([Type | Types], [Mode | Modes], [Term | Terms]) :-
|
|
Term = term.functor(term.atom("::"), [Type, Mode], dummy_context),
|
|
combine_type_and_mode_terms(Types, Modes, Terms).
|
|
|
|
:- pred maybe_add_lambda_eval_method(lambda_eval_method::in, term::in,
|
|
term::out) is det.
|
|
|
|
maybe_add_lambda_eval_method(lambda_normal, Term, Term).
|
|
|
|
:- pred maybe_add_purity_annotation(purity::in, term::in, term::out) is det.
|
|
|
|
maybe_add_purity_annotation(purity_pure, Term, Term).
|
|
maybe_add_purity_annotation(purity_semipure, Term0, Term) :-
|
|
Term = term.functor(term.atom("semipure"), [Term0], dummy_context).
|
|
maybe_add_purity_annotation(purity_impure, Term0, Term) :-
|
|
Term = term.functor(term.atom("impure"), [Term0], dummy_context).
|
|
|
|
:- pred maybe_add_detism(ho_inst_info::in, term::in, term::out) is det.
|
|
|
|
maybe_add_detism(none_or_default_func, Term, Term).
|
|
maybe_add_detism(higher_order(pred_inst_info(_, _, _, Detism)), Term0, Term) :-
|
|
Context = dummy_context,
|
|
DetismTerm0 = det_to_term(Context, Detism),
|
|
term.coerce(DetismTerm0, DetismTerm),
|
|
Term = term.functor(term.atom("is"), [Term0, DetismTerm], Context).
|
|
|
|
:- pred unparse_mode_list(list(mer_mode)::in, list(term)::out) is det.
|
|
|
|
unparse_mode_list([], []).
|
|
unparse_mode_list([Mode | Modes], [Term | Terms]) :-
|
|
Term0 = mode_to_term(output_mercury, Mode),
|
|
term.coerce(Term0, Term),
|
|
unparse_mode_list(Modes, Terms).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
mode_to_term(Lang, Mode) =
|
|
mode_to_term_with_context(Lang, dummy_context, Mode).
|
|
|
|
mode_to_term_with_context(Lang, Context, Mode) = ModeTerm :-
|
|
(
|
|
Mode = from_to_mode(InstA, InstB),
|
|
( if
|
|
% Check for higher-order pred or func modes, and output them
|
|
% in a nice format.
|
|
InstA = ground(_Uniq, higher_order(_)),
|
|
InstB = InstA
|
|
then
|
|
inst_to_term_with_context(Lang, Context, InstA, ModeTerm)
|
|
else
|
|
inst_to_term_with_context(Lang, Context, InstA, InstTermA),
|
|
inst_to_term_with_context(Lang, Context, InstB, InstTermB),
|
|
construct_qualified_term_with_context(unqualified(">>"),
|
|
[InstTermA, InstTermB], Context, ModeTerm)
|
|
)
|
|
;
|
|
Mode = user_defined_mode(Name, ArgInsts),
|
|
list.map(inst_to_term_with_context(Lang, Context),
|
|
ArgInsts, ArgInstTerms),
|
|
construct_qualified_term_with_context(Name, ArgInstTerms,
|
|
Context, ModeTerm)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
inst_to_term(Lang, Inst) = InstTerm :-
|
|
inst_to_term_with_context(Lang, dummy_context, Inst, InstTerm).
|
|
|
|
:- pred inst_to_term_with_context(output_lang::in, prog_context::in,
|
|
mer_inst::in, prog_term::out) is det.
|
|
|
|
inst_to_term_with_context(Lang, Context, Inst, InstTerm) :-
|
|
(
|
|
Inst = any(Uniq, HOInstInfo),
|
|
(
|
|
HOInstInfo = higher_order(PredInstInfo),
|
|
any_pred_inst_info_to_term(Lang, Context, Uniq,
|
|
PredInstInfo, InstTerm)
|
|
;
|
|
HOInstInfo = none_or_default_func,
|
|
InstTerm = make_atom(Context, any_inst_uniqueness(Uniq))
|
|
)
|
|
;
|
|
Inst = free,
|
|
InstTerm = make_atom(Context, "free")
|
|
;
|
|
Inst = free(Type),
|
|
unparse_type(Type, TypeTerm),
|
|
InstTerm0 = term.coerce(TypeTerm),
|
|
InstTerm = term.functor(term.atom("free"), [InstTerm0], Context)
|
|
;
|
|
Inst = bound(Uniq, InstResults, BoundInsts),
|
|
bound_insts_to_term(Lang, Context, BoundInsts, BoundInstsTerm),
|
|
(
|
|
Lang = output_mercury,
|
|
ArgTerms = [BoundInstsTerm]
|
|
;
|
|
Lang = output_debug,
|
|
ResultsTerm = inst_test_results_to_term(Context, InstResults),
|
|
ArgTerms = [ResultsTerm, BoundInstsTerm]
|
|
),
|
|
construct_qualified_term_with_context(
|
|
unqualified(inst_uniqueness(Uniq, "bound")),
|
|
ArgTerms, Context, InstTerm)
|
|
;
|
|
Inst = ground(Uniq, HOInstInfo),
|
|
(
|
|
HOInstInfo = higher_order(PredInstInfo),
|
|
ground_pred_inst_info_to_term(Lang, Context, Uniq,
|
|
PredInstInfo, InstTerm)
|
|
;
|
|
HOInstInfo = none_or_default_func,
|
|
InstTerm = make_atom(Context, inst_uniqueness(Uniq, "ground"))
|
|
)
|
|
;
|
|
Inst = inst_var(Var),
|
|
InstTerm = term.coerce(term.variable(Var, dummy_context))
|
|
;
|
|
Inst = constrained_inst_vars(Vars, SubInst),
|
|
inst_to_term_with_context(Lang, Context, SubInst, SubInstTerm),
|
|
set.foldl(record_constrained_var(Context), Vars,
|
|
SubInstTerm, InstTerm)
|
|
;
|
|
Inst = abstract_inst(Name, Args),
|
|
inst_name_to_term_with_context(Lang, Context,
|
|
user_inst(Name, Args), InstTerm)
|
|
;
|
|
Inst = defined_inst(InstName),
|
|
inst_name_to_term_with_context(Lang, Context, InstName, InstTerm)
|
|
;
|
|
Inst = not_reached,
|
|
InstTerm = make_atom(Context, "not_reached")
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
inst_to_limited_size_term(Lang, SizeLeft, Inst) = InstTerm :-
|
|
inst_to_limited_size_term_with_context(Lang, dummy_context,
|
|
Inst, InstTerm, SizeLeft, _).
|
|
|
|
:- pred inst_to_limited_size_term_with_context(output_lang::in,
|
|
prog_context::in, mer_inst::in, prog_term::out, int::in, int::out) is det.
|
|
|
|
inst_to_limited_size_term_with_context(Lang, Context, Inst, InstTerm,
|
|
!SizeLeft) :-
|
|
(
|
|
Inst = any(Uniq, HOInstInfo),
|
|
(
|
|
HOInstInfo = higher_order(PredInstInfo),
|
|
any_pred_inst_info_to_term(Lang, Context, Uniq,
|
|
PredInstInfo, InstTerm)
|
|
;
|
|
HOInstInfo = none_or_default_func,
|
|
InstTerm = make_atom(Context, any_inst_uniqueness(Uniq))
|
|
),
|
|
!:SizeLeft = !.SizeLeft - 1
|
|
;
|
|
Inst = free,
|
|
InstTerm = make_atom(Context, "free"),
|
|
!:SizeLeft = !.SizeLeft - 1
|
|
;
|
|
Inst = free(Type),
|
|
unparse_type(Type, TypeTerm),
|
|
InstTerm0 = term.coerce(TypeTerm),
|
|
InstTerm = term.functor(term.atom("free"), [InstTerm0], Context),
|
|
!:SizeLeft = !.SizeLeft - 1
|
|
;
|
|
Inst = bound(Uniq, InstResults, BoundInsts),
|
|
bound_insts_to_limited_size_term(Lang, Context,
|
|
BoundInsts, BoundInstsTerm, !SizeLeft),
|
|
(
|
|
Lang = output_mercury,
|
|
ArgTerms = [BoundInstsTerm]
|
|
;
|
|
Lang = output_debug,
|
|
ResultsTerm = inst_test_results_to_term(Context, InstResults),
|
|
% ZZZ
|
|
!:SizeLeft = !.SizeLeft - 1,
|
|
ArgTerms = [ResultsTerm, BoundInstsTerm]
|
|
),
|
|
construct_qualified_term_with_context(
|
|
unqualified(inst_uniqueness(Uniq, "bound")),
|
|
ArgTerms, Context, InstTerm),
|
|
!:SizeLeft = !.SizeLeft - 1
|
|
;
|
|
Inst = ground(Uniq, HOInstInfo),
|
|
(
|
|
HOInstInfo = higher_order(PredInstInfo),
|
|
ground_pred_inst_info_to_term(Lang, Context, Uniq,
|
|
PredInstInfo, InstTerm)
|
|
;
|
|
HOInstInfo = none_or_default_func,
|
|
InstTerm = make_atom(Context, inst_uniqueness(Uniq, "ground"))
|
|
),
|
|
!:SizeLeft = !.SizeLeft - 1
|
|
;
|
|
Inst = inst_var(Var),
|
|
InstTerm = term.coerce(term.variable(Var, dummy_context)),
|
|
!:SizeLeft = !.SizeLeft - 1
|
|
;
|
|
Inst = constrained_inst_vars(Vars, SubInst),
|
|
inst_to_limited_size_term_with_context(Lang, Context,
|
|
SubInst, SubInstTerm, !SizeLeft),
|
|
set.foldl(record_constrained_var(Context), Vars,
|
|
SubInstTerm, InstTerm),
|
|
!:SizeLeft = !.SizeLeft - set.count(Vars)
|
|
;
|
|
Inst = abstract_inst(Name, Args),
|
|
inst_name_to_limited_size_term_with_context(Lang, Context,
|
|
user_inst(Name, Args), InstTerm, !SizeLeft)
|
|
;
|
|
Inst = defined_inst(InstName),
|
|
inst_name_to_limited_size_term_with_context(Lang, Context,
|
|
InstName, InstTerm, !SizeLeft)
|
|
;
|
|
Inst = not_reached,
|
|
InstTerm = make_atom(Context, "not_reached")
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred record_constrained_var(prog_context::in, inst_var::in,
|
|
prog_term::in, prog_term::out) is det.
|
|
|
|
record_constrained_var(Context, Var, SubInstTerm, InstTerm) :-
|
|
VarTerm = term.coerce(term.variable(Var, dummy_context)),
|
|
InstTerm = term.functor(term.atom("=<"), [VarTerm, SubInstTerm], Context).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
inst_name_to_term(Lang, InstName) = InstNameTerm :-
|
|
inst_name_to_term_with_context(Lang, dummy_context,
|
|
InstName, InstNameTerm).
|
|
|
|
:- pred inst_name_to_term_with_context(output_lang::in, prog_context::in,
|
|
inst_name::in, prog_term::out) is det.
|
|
|
|
inst_name_to_term_with_context(Lang, Context, InstName, Term) :-
|
|
(
|
|
InstName = user_inst(Name, ArgInsts),
|
|
list.map(inst_to_term_with_context(Lang, Context),
|
|
ArgInsts, ArgInstTerms),
|
|
construct_qualified_term_with_context(Name, ArgInstTerms,
|
|
Context, Term)
|
|
;
|
|
InstName = unify_inst(Liveness, Real, InstA, InstB),
|
|
(
|
|
Lang = output_mercury,
|
|
unexpected($pred, "unify_inst")
|
|
;
|
|
Lang = output_debug,
|
|
LiveTerm = make_atom(Context, is_live_to_str(Liveness)),
|
|
RealTerm = make_atom(Context, unify_is_real_to_str(Real)),
|
|
inst_to_term_with_context(Lang, Context, InstA, InstTermA),
|
|
inst_to_term_with_context(Lang, Context, InstB, InstTermB),
|
|
construct_qualified_term_with_context(unqualified("$unify"),
|
|
[LiveTerm, RealTerm, InstTermA, InstTermB], Context, Term)
|
|
)
|
|
;
|
|
InstName = merge_inst(InstA, InstB),
|
|
(
|
|
Lang = output_mercury,
|
|
unexpected($pred, "merge_inst")
|
|
;
|
|
Lang = output_debug,
|
|
inst_to_term_with_context(Lang, Context, InstA, InstTermA),
|
|
inst_to_term_with_context(Lang, Context, InstB, InstTermB),
|
|
construct_qualified_term_with_context(unqualified("$merge_inst"),
|
|
[InstTermA, InstTermB], Context, Term)
|
|
)
|
|
;
|
|
InstName = ground_inst(SubInstName, Uniq, IsLive, Real),
|
|
(
|
|
Lang = output_mercury,
|
|
unexpected($pred, "ground_inst")
|
|
;
|
|
Lang = output_debug,
|
|
inst_name_to_term_with_context(Lang, Context,
|
|
SubInstName, SubInstNameTerm),
|
|
UniqTerm = make_atom(Context, inst_uniqueness(Uniq, "shared")),
|
|
IsLiveTerm = make_atom(Context, is_live_to_str(IsLive)),
|
|
IsRealTerm = make_atom(Context, unify_is_real_to_str(Real)),
|
|
construct_qualified_term_with_context(unqualified("$ground"),
|
|
[SubInstNameTerm, UniqTerm, IsLiveTerm, IsRealTerm],
|
|
Context, Term)
|
|
)
|
|
;
|
|
InstName = any_inst(SubInstName, Uniq, IsLive, Real),
|
|
(
|
|
Lang = output_mercury,
|
|
unexpected($pred, "any_inst")
|
|
;
|
|
Lang = output_debug,
|
|
inst_name_to_term_with_context(Lang, Context,
|
|
SubInstName, SubInstNameTerm),
|
|
UniqTerm = make_atom(Context, inst_uniqueness(Uniq, "shared")),
|
|
IsLiveTerm = make_atom(Context, is_live_to_str(IsLive)),
|
|
IsRealTerm = make_atom(Context, unify_is_real_to_str(Real)),
|
|
construct_qualified_term_with_context(unqualified("$any"),
|
|
[SubInstNameTerm, UniqTerm, IsLiveTerm, IsRealTerm],
|
|
Context, Term)
|
|
)
|
|
;
|
|
InstName = shared_inst(SubInstName),
|
|
(
|
|
Lang = output_mercury,
|
|
unexpected($pred, "shared_inst")
|
|
;
|
|
Lang = output_debug,
|
|
inst_name_to_term_with_context(Lang, Context,
|
|
SubInstName, SubInstNameTerm),
|
|
construct_qualified_term_with_context(unqualified("$shared_inst"),
|
|
[SubInstNameTerm], Context, Term)
|
|
)
|
|
;
|
|
InstName = mostly_uniq_inst(SubInstName),
|
|
(
|
|
Lang = output_mercury,
|
|
unexpected($pred, "mostly_uniq_inst")
|
|
;
|
|
Lang = output_debug,
|
|
inst_name_to_term_with_context(Lang, Context,
|
|
SubInstName, SubInstNameTerm),
|
|
construct_qualified_term_with_context(
|
|
unqualified("$mostly_uniq_inst"),
|
|
[SubInstNameTerm], Context, Term)
|
|
)
|
|
;
|
|
InstName = typed_ground(Uniq, Type),
|
|
(
|
|
Lang = output_mercury,
|
|
unexpected($pred, "typed_ground")
|
|
;
|
|
Lang = output_debug,
|
|
UniqTerm = make_atom(Context, inst_uniqueness(Uniq, "shared")),
|
|
unparse_type(Type, TypeTerm0),
|
|
TypeTerm = term.coerce(TypeTerm0),
|
|
construct_qualified_term_with_context(unqualified("$typed_ground"),
|
|
[UniqTerm, TypeTerm], Context, Term)
|
|
)
|
|
;
|
|
InstName = typed_inst(Type, SubInstName),
|
|
(
|
|
Lang = output_mercury,
|
|
% Inst names in the inst tables can (and often do) have the types
|
|
% they apply pushed into them by inst_user.m. However, the typed
|
|
% nature of such inst names cannot (yet) be expressed in Mercury
|
|
% source code.
|
|
inst_name_to_term_with_context(Lang, Context, SubInstName, Term)
|
|
;
|
|
Lang = output_debug,
|
|
unparse_type(Type, TypeTerm0),
|
|
TypeTerm = term.coerce(TypeTerm0),
|
|
inst_name_to_term_with_context(Lang, Context,
|
|
SubInstName, SubInstNameTerm),
|
|
construct_qualified_term_with_context(unqualified("$typed_inst"),
|
|
[TypeTerm, SubInstNameTerm], Context, Term)
|
|
)
|
|
).
|
|
|
|
inst_name_to_limited_size_term(Lang, SizeLeft, InstName) = InstNameTerm :-
|
|
inst_name_to_limited_size_term_with_context(Lang, dummy_context,
|
|
InstName, InstNameTerm, SizeLeft, _).
|
|
|
|
:- pred inst_name_to_limited_size_term_with_context(output_lang::in,
|
|
prog_context::in, inst_name::in, prog_term::out, int::in, int::out) is det.
|
|
|
|
inst_name_to_limited_size_term_with_context(Lang, Context, InstName, Term,
|
|
!SizeLeft) :-
|
|
(
|
|
InstName = user_inst(Name, ArgInsts),
|
|
insts_to_limited_size_terms_with_context(Lang, Context,
|
|
ArgInsts, ArgInstTerms, !SizeLeft),
|
|
construct_qualified_term_with_context(Name, ArgInstTerms,
|
|
Context, Term),
|
|
!:SizeLeft = !.SizeLeft - 1
|
|
;
|
|
InstName = unify_inst(Liveness, Real, InstA, InstB),
|
|
(
|
|
Lang = output_mercury,
|
|
unexpected($pred, "unify_inst")
|
|
;
|
|
Lang = output_debug,
|
|
LiveTerm = make_atom(Context, is_live_to_str(Liveness)),
|
|
RealTerm = make_atom(Context, unify_is_real_to_str(Real)),
|
|
!:SizeLeft = !.SizeLeft - 2,
|
|
inst_to_limited_size_term_with_context(Lang, Context,
|
|
InstA, InstTermA, !SizeLeft),
|
|
inst_to_limited_size_term_with_context(Lang, Context,
|
|
InstB, InstTermB, !SizeLeft),
|
|
( if !.SizeLeft =< 0 then
|
|
construct_qualified_term_with_context(unqualified("$unify"),
|
|
[ellipsis_term(Context)], Context, Term)
|
|
else
|
|
construct_qualified_term_with_context(unqualified("$unify"),
|
|
[LiveTerm, RealTerm, InstTermA, InstTermB], Context, Term)
|
|
)
|
|
)
|
|
;
|
|
InstName = merge_inst(InstA, InstB),
|
|
(
|
|
Lang = output_mercury,
|
|
unexpected($pred, "merge_inst")
|
|
;
|
|
Lang = output_debug,
|
|
inst_to_limited_size_term_with_context(Lang, Context,
|
|
InstA, InstTermA, !SizeLeft),
|
|
inst_to_limited_size_term_with_context(Lang, Context,
|
|
InstB, InstTermB, !SizeLeft),
|
|
( if !.SizeLeft =< 0 then
|
|
construct_qualified_term_with_context(
|
|
unqualified("$merge_inst"),
|
|
[ellipsis_term(Context)], Context, Term)
|
|
else
|
|
construct_qualified_term_with_context(
|
|
unqualified("$merge_inst"),
|
|
[InstTermA, InstTermB], Context, Term)
|
|
)
|
|
)
|
|
;
|
|
InstName = ground_inst(SubInstName, Uniq, IsLive, Real),
|
|
(
|
|
Lang = output_mercury,
|
|
unexpected($pred, "ground_inst")
|
|
;
|
|
Lang = output_debug,
|
|
inst_name_to_limited_size_term_with_context(Lang, Context,
|
|
SubInstName, SubInstNameTerm, !SizeLeft),
|
|
UniqTerm = make_atom(Context, inst_uniqueness(Uniq, "shared")),
|
|
IsLiveTerm = make_atom(Context, is_live_to_str(IsLive)),
|
|
IsRealTerm = make_atom(Context, unify_is_real_to_str(Real)),
|
|
!:SizeLeft = !.SizeLeft - 3,
|
|
( if !.SizeLeft =< 0 then
|
|
construct_qualified_term_with_context(unqualified("$ground"),
|
|
[ellipsis_term(Context)], Context, Term)
|
|
else
|
|
construct_qualified_term_with_context(unqualified("$ground"),
|
|
[SubInstNameTerm, UniqTerm, IsLiveTerm, IsRealTerm],
|
|
Context, Term)
|
|
)
|
|
)
|
|
;
|
|
InstName = any_inst(SubInstName, Uniq, IsLive, Real),
|
|
(
|
|
Lang = output_mercury,
|
|
unexpected($pred, "any_inst")
|
|
;
|
|
Lang = output_debug,
|
|
inst_name_to_limited_size_term_with_context(Lang, Context,
|
|
SubInstName, SubInstNameTerm, !SizeLeft),
|
|
UniqTerm = make_atom(Context, inst_uniqueness(Uniq, "shared")),
|
|
IsLiveTerm = make_atom(Context, is_live_to_str(IsLive)),
|
|
IsRealTerm = make_atom(Context, unify_is_real_to_str(Real)),
|
|
!:SizeLeft = !.SizeLeft - 3,
|
|
( if !.SizeLeft =< 0 then
|
|
construct_qualified_term_with_context(unqualified("$any"),
|
|
[ellipsis_term(Context)], Context, Term)
|
|
else
|
|
construct_qualified_term_with_context(unqualified("$any"),
|
|
[SubInstNameTerm, UniqTerm, IsLiveTerm, IsRealTerm],
|
|
Context, Term)
|
|
)
|
|
)
|
|
;
|
|
InstName = shared_inst(SubInstName),
|
|
(
|
|
Lang = output_mercury,
|
|
unexpected($pred, "shared_inst")
|
|
;
|
|
Lang = output_debug,
|
|
inst_name_to_limited_size_term_with_context(Lang, Context,
|
|
SubInstName, SubInstNameTerm, !SizeLeft),
|
|
( if !.SizeLeft =< 0 then
|
|
construct_qualified_term_with_context(
|
|
unqualified("$shared_inst"),
|
|
[ellipsis_term(Context)], Context, Term)
|
|
else
|
|
construct_qualified_term_with_context(
|
|
unqualified("$shared_inst"),
|
|
[SubInstNameTerm], Context, Term)
|
|
)
|
|
)
|
|
;
|
|
InstName = mostly_uniq_inst(SubInstName),
|
|
(
|
|
Lang = output_mercury,
|
|
unexpected($pred, "mostly_uniq_inst")
|
|
;
|
|
Lang = output_debug,
|
|
inst_name_to_limited_size_term_with_context(Lang, Context,
|
|
SubInstName, SubInstNameTerm, !SizeLeft),
|
|
( if !.SizeLeft =< 0 then
|
|
construct_qualified_term_with_context(
|
|
unqualified("$mostly_uniq_inst"),
|
|
[ellipsis_term(Context)], Context, Term)
|
|
else
|
|
construct_qualified_term_with_context(
|
|
unqualified("$mostly_uniq_inst"),
|
|
[SubInstNameTerm], Context, Term)
|
|
)
|
|
)
|
|
;
|
|
InstName = typed_ground(Uniq, Type),
|
|
(
|
|
Lang = output_mercury,
|
|
unexpected($pred, "typed_ground")
|
|
;
|
|
Lang = output_debug,
|
|
UniqTerm = make_atom(Context, inst_uniqueness(Uniq, "shared")),
|
|
unparse_type(Type, TypeTerm0),
|
|
TypeTerm = term.coerce(TypeTerm0),
|
|
construct_qualified_term_with_context(unqualified("$typed_ground"),
|
|
[UniqTerm, TypeTerm], Context, Term),
|
|
!:SizeLeft = !.SizeLeft - 1
|
|
)
|
|
;
|
|
InstName = typed_inst(Type, SubInstName),
|
|
(
|
|
Lang = output_mercury,
|
|
% Inst names in the inst tables can (and often do) have the types
|
|
% they apply pushed into them by inst_user.m. However, the typed
|
|
% nature of such inst names cannot (yet) be expressed in Mercury
|
|
% source code.
|
|
inst_name_to_term_with_context(Lang, Context, SubInstName, Term)
|
|
;
|
|
Lang = output_debug,
|
|
unparse_type(Type, TypeTerm0),
|
|
TypeTerm = term.coerce(TypeTerm0),
|
|
!:SizeLeft = !.SizeLeft - 1,
|
|
inst_name_to_limited_size_term_with_context(Lang, Context,
|
|
SubInstName, SubInstNameTerm, !SizeLeft),
|
|
( if !.SizeLeft =< 0 then
|
|
construct_qualified_term_with_context(
|
|
unqualified("$typed_inst"),
|
|
[ellipsis_term(Context)], Context, Term)
|
|
else
|
|
construct_qualified_term_with_context(
|
|
unqualified("$typed_inst"),
|
|
[TypeTerm, SubInstNameTerm], Context, Term)
|
|
)
|
|
)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
inst_test_results_to_term(Context, InstResults) = Term :-
|
|
(
|
|
InstResults = inst_test_results(GroundnessResult, AnyResult,
|
|
InstNamesResult, InstVarsResult, TypeResult, PropagatedResult),
|
|
SubTerm1 = inst_result_groundness_to_term(Context, GroundnessResult),
|
|
SubTerm2 = inst_result_contains_any_to_term(Context, AnyResult),
|
|
SubTerm3 = inst_result_contains_inst_names_to_term(Context,
|
|
InstNamesResult),
|
|
SubTerm4 = inst_result_contains_inst_vars_to_term(Context,
|
|
InstVarsResult),
|
|
SubTerm5 = inst_result_contains_types_to_term(Context, TypeResult),
|
|
SubTerm6 = inst_result_type_ctor_propagated_to_term(Context,
|
|
PropagatedResult),
|
|
Term = term.functor(term.atom("results"),
|
|
[SubTerm1, SubTerm2, SubTerm3, SubTerm4, SubTerm5, SubTerm6],
|
|
Context)
|
|
;
|
|
InstResults = inst_test_no_results,
|
|
Term = term.functor(term.atom("no_results"), [], Context)
|
|
;
|
|
InstResults = inst_test_results_fgtc,
|
|
Term = term.functor(term.atom("fgtc"), [], Context)
|
|
).
|
|
|
|
:- func inst_result_groundness_to_term(prog_context, inst_result_groundness)
|
|
= prog_term.
|
|
|
|
inst_result_groundness_to_term(Context, Groundness) = Term :-
|
|
(
|
|
Groundness = inst_result_is_not_ground,
|
|
Term = term.functor(term.atom("is_not_ground"), [], Context)
|
|
;
|
|
Groundness = inst_result_is_ground,
|
|
Term = term.functor(term.atom("is_ground"), [], Context)
|
|
;
|
|
Groundness = inst_result_groundness_unknown,
|
|
Term = term.functor(term.atom("groundness_unknown"), [], Context)
|
|
).
|
|
|
|
:- func inst_result_contains_any_to_term(prog_context,
|
|
inst_result_contains_any) = prog_term.
|
|
|
|
inst_result_contains_any_to_term(Context, ContainsAny) = Term :-
|
|
(
|
|
ContainsAny = inst_result_does_not_contain_any,
|
|
Term = term.functor(term.atom("does_not_contain_any"), [], Context)
|
|
;
|
|
ContainsAny = inst_result_does_contain_any,
|
|
Term = term.functor(term.atom("does_contain_any"), [], Context)
|
|
;
|
|
ContainsAny = inst_result_contains_any_unknown,
|
|
Term = term.functor(term.atom("contains_any_unknown"), [], Context)
|
|
).
|
|
|
|
:- func inst_result_contains_inst_names_to_term(prog_context,
|
|
inst_result_contains_inst_names) = prog_term.
|
|
|
|
inst_result_contains_inst_names_to_term(Context, ContainsInstNames) = Term :-
|
|
(
|
|
ContainsInstNames = inst_result_contains_inst_names_unknown,
|
|
Term = term.functor(term.atom("contains_inst_names_unknown"),
|
|
[], Context)
|
|
;
|
|
ContainsInstNames = inst_result_contains_inst_names_known(InstNameSet),
|
|
% Inst names can be pretty big, so we print only a count.
|
|
% If necessary, we can later modify this code to actually print them.
|
|
set.count(InstNameSet, NumInstNames),
|
|
CountTerm = term_int.int_to_decimal_term(NumInstNames, Context),
|
|
Term = term.functor(term.atom("contains_inst_names_known"),
|
|
[CountTerm], Context)
|
|
).
|
|
|
|
:- func inst_result_contains_inst_vars_to_term(prog_context,
|
|
inst_result_contains_inst_vars) = prog_term.
|
|
|
|
inst_result_contains_inst_vars_to_term(Context, ContainsInstVars) = Term :-
|
|
(
|
|
ContainsInstVars = inst_result_contains_inst_vars_unknown,
|
|
Term = term.functor(term.atom("contains_inst_vars_unknown"),
|
|
[], Context)
|
|
;
|
|
ContainsInstVars = inst_result_contains_inst_vars_known(InstVarSet),
|
|
set.to_sorted_list(InstVarSet, InstVars),
|
|
InstVarTerms = list.map(inst_var_to_term(Context), InstVars),
|
|
Term = term.functor(term.atom("contains_inst_vars_known"),
|
|
InstVarTerms, Context)
|
|
).
|
|
|
|
:- func inst_var_to_term(prog_context, inst_var) = prog_term.
|
|
|
|
inst_var_to_term(Context, InstVar) = Term :-
|
|
InstVarNum = term.var_to_int(InstVar),
|
|
InstVarNumStr = string.int_to_string(InstVarNum),
|
|
Term = term.functor(string("inst_var_" ++ InstVarNumStr), [], Context).
|
|
|
|
:- func inst_result_contains_types_to_term(prog_context,
|
|
inst_result_contains_types) = prog_term.
|
|
|
|
inst_result_contains_types_to_term(Context, ContainsTypes) = Term :-
|
|
(
|
|
ContainsTypes = inst_result_contains_types_unknown,
|
|
Term = term.functor(term.atom("contains_types_unknown"), [], Context)
|
|
;
|
|
ContainsTypes = inst_result_contains_types_known(TypeCtorSet),
|
|
set.to_sorted_list(TypeCtorSet, TypeCtors),
|
|
TypeCtorTerms = list.map(type_ctor_to_term(Context), TypeCtors),
|
|
Term = term.functor(term.atom("contains_types_known"),
|
|
TypeCtorTerms, Context)
|
|
).
|
|
|
|
:- func inst_result_type_ctor_propagated_to_term(prog_context,
|
|
inst_result_type_ctor_propagated) = prog_term.
|
|
|
|
inst_result_type_ctor_propagated_to_term(Context, PropagatedResult) = Term :-
|
|
(
|
|
PropagatedResult = inst_result_no_type_ctor_propagated,
|
|
Term = term.functor(term.atom("no_type_ctor_propagated"), [], Context)
|
|
;
|
|
PropagatedResult = inst_result_type_ctor_propagated(TypeCtor),
|
|
Term = term.functor(term.atom("type_ctor_propagated"),
|
|
[type_ctor_to_term(Context, TypeCtor)], Context)
|
|
).
|
|
|
|
:- func type_ctor_to_term(prog_context, type_ctor) = prog_term.
|
|
|
|
type_ctor_to_term(Context, TypeCtor) = Term :-
|
|
TypeCtor = type_ctor(SymName, Arity),
|
|
string.format("%s/%d", [s(sym_name_to_string(SymName)), i(Arity)],
|
|
ConsName),
|
|
Term = term.functor(term.atom(ConsName), [], Context).
|
|
|
|
%---------------------%
|
|
|
|
:- pred ground_pred_inst_info_to_term(output_lang::in, prog_context::in,
|
|
uniqueness::in, pred_inst_info::in, prog_term::out) is det.
|
|
|
|
ground_pred_inst_info_to_term(Lang, Context, _Uniq, PredInstInfo, Term) :-
|
|
% XXX we ignore Uniq
|
|
PredInstInfo = pred_inst_info(PredOrFunc, Modes, _, Det),
|
|
(
|
|
PredOrFunc = pf_predicate,
|
|
construct_qualified_term_with_context(unqualified("pred"),
|
|
list.map(mode_to_term_with_context(Lang, Context), Modes),
|
|
Context, ModesTerm)
|
|
;
|
|
PredOrFunc = pf_function,
|
|
pred_args_to_func_args(Modes, ArgModes, RetMode),
|
|
construct_qualified_term_with_context(unqualified("func"),
|
|
list.map(mode_to_term_with_context(Lang, Context), ArgModes),
|
|
Context, ArgModesTerm),
|
|
construct_qualified_term_with_context(unqualified("="),
|
|
[ArgModesTerm, mode_to_term_with_context(Lang, Context, RetMode)],
|
|
Context, ModesTerm)
|
|
),
|
|
construct_qualified_term_with_context(unqualified("is"),
|
|
[ModesTerm, det_to_term(Context, Det)], Context, Term).
|
|
|
|
%---------------------%
|
|
|
|
:- pred any_pred_inst_info_to_term(output_lang::in, prog_context::in,
|
|
uniqueness::in, pred_inst_info::in, prog_term::out) is det.
|
|
|
|
any_pred_inst_info_to_term(Lang, Context, _Uniq, PredInstInfo, Term) :-
|
|
% XXX we ignore Uniq
|
|
PredInstInfo = pred_inst_info(PredOrFunc, Modes, _, Det),
|
|
(
|
|
PredOrFunc = pf_predicate,
|
|
construct_qualified_term_with_context(unqualified("any_pred"),
|
|
list.map(mode_to_term_with_context(Lang, Context), Modes),
|
|
Context, ModesTerm)
|
|
;
|
|
PredOrFunc = pf_function,
|
|
pred_args_to_func_args(Modes, ArgModes, RetMode),
|
|
construct_qualified_term_with_context(unqualified("any_func"),
|
|
list.map(mode_to_term_with_context(Lang, Context), ArgModes),
|
|
Context, ArgModesTerm),
|
|
construct_qualified_term_with_context(unqualified("="),
|
|
[ArgModesTerm, mode_to_term_with_context(Lang, Context, RetMode)],
|
|
Context, ModesTerm)
|
|
),
|
|
construct_qualified_term_with_context(unqualified("is"),
|
|
[ModesTerm, det_to_term(Context, Det)], Context, Term).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- func is_live_to_str(is_live) = string.
|
|
|
|
is_live_to_str(is_live) = "live".
|
|
is_live_to_str(is_dead) = "dead".
|
|
|
|
:- func unify_is_real_to_str(unify_is_real) = string.
|
|
|
|
unify_is_real_to_str(real_unify) = "real".
|
|
unify_is_real_to_str(fake_unify) = "fake".
|
|
|
|
:- func any_inst_uniqueness(uniqueness) = string.
|
|
|
|
any_inst_uniqueness(shared) = "any".
|
|
any_inst_uniqueness(unique) = "unique_any".
|
|
any_inst_uniqueness(mostly_unique) = "mostly_unique_any".
|
|
any_inst_uniqueness(clobbered) = "clobbered_any".
|
|
any_inst_uniqueness(mostly_clobbered) = "mostly_clobbered_any".
|
|
|
|
:- func inst_uniqueness(uniqueness, string) = string.
|
|
|
|
inst_uniqueness(shared, SharedName) = SharedName.
|
|
inst_uniqueness(unique, _) = "unique".
|
|
inst_uniqueness(mostly_unique, _) = "mostly_unique".
|
|
inst_uniqueness(clobbered, _) = "clobbered".
|
|
inst_uniqueness(mostly_clobbered, _) = "mostly_clobbered".
|
|
|
|
%---------------------%
|
|
|
|
:- pred bound_insts_to_term(output_lang::in, prog_context::in,
|
|
list(bound_inst)::in, prog_term::out) is det.
|
|
|
|
bound_insts_to_term(_, Context, [], Term) :-
|
|
% This shouldn't happen, but when it does, the problem is a LOT easier
|
|
% to debug if there is a HLDS dump you can read.
|
|
Term = term.functor(term.atom("EMPTY_BOUND_INSTS"), [], Context).
|
|
bound_insts_to_term(Lang, Context, [BoundInst | BoundInsts], Term) :-
|
|
bound_insts_to_term_lag(Lang, Context, BoundInst, BoundInsts, Term).
|
|
|
|
:- pred bound_insts_to_term_lag(output_lang::in, prog_context::in,
|
|
bound_inst::in, list(bound_inst)::in, prog_term::out) is det.
|
|
|
|
bound_insts_to_term_lag(Lang, Context, BoundInst, BoundInsts, Term) :-
|
|
BoundInst = bound_functor(ConsId, ArgInsts),
|
|
list.map(inst_to_term_with_context(Lang, Context), ArgInsts, ArgInstTerms),
|
|
cons_id_and_args_to_term_full(ConsId, ArgInstTerms, FirstTerm),
|
|
(
|
|
BoundInsts = [],
|
|
Term = FirstTerm
|
|
;
|
|
BoundInsts = [HeadBoundInst | TailBoundInsts],
|
|
bound_insts_to_term_lag(Lang, Context,
|
|
HeadBoundInst, TailBoundInsts, SecondTerm),
|
|
construct_qualified_term_with_context(unqualified(";"),
|
|
[FirstTerm, SecondTerm], Context, Term)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pred bound_insts_to_limited_size_term(output_lang::in, prog_context::in,
|
|
list(bound_inst)::in, prog_term::out, int::in, int::out) is det.
|
|
|
|
bound_insts_to_limited_size_term(_, Context, [], Term, !SizeLeft) :-
|
|
% This shouldn't happen, but when it does, the problem is a LOT easier
|
|
% to debug if there is a HLDS dump you can read.
|
|
Term = term.functor(term.atom("EMPTY_BOUND_INSTS"), [], Context).
|
|
bound_insts_to_limited_size_term(Lang, Context, [BoundInst | BoundInsts],
|
|
Term, !SizeLeft) :-
|
|
bound_insts_to_limited_size_term_lag(Lang, Context, BoundInst, BoundInsts,
|
|
Term, !SizeLeft).
|
|
|
|
:- pred bound_insts_to_limited_size_term_lag(output_lang::in, prog_context::in,
|
|
bound_inst::in, list(bound_inst)::in, prog_term::out,
|
|
int::in, int::out) is det.
|
|
|
|
bound_insts_to_limited_size_term_lag(Lang, Context, BoundInst, BoundInsts,
|
|
Term, !SizeLeft) :-
|
|
BoundInst = bound_functor(ConsId, ArgInsts),
|
|
insts_to_limited_size_terms_with_context(Lang, Context,
|
|
ArgInsts, ArgInstTerms, !SizeLeft),
|
|
cons_id_and_args_to_term_full(ConsId, ArgInstTerms, FirstTerm),
|
|
(
|
|
BoundInsts = [],
|
|
Term = FirstTerm
|
|
;
|
|
BoundInsts = [HeadBoundInst | TailBoundInsts],
|
|
bound_insts_to_limited_size_term_lag(Lang, Context,
|
|
HeadBoundInst, TailBoundInsts, SecondTerm, !SizeLeft),
|
|
construct_qualified_term_with_context(unqualified(";"),
|
|
[FirstTerm, SecondTerm], Context, Term)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred insts_to_limited_size_terms_with_context(output_lang::in,
|
|
prog_context::in, list(mer_inst)::in, list(prog_term)::out,
|
|
int::in, int::out) is det.
|
|
|
|
insts_to_limited_size_terms_with_context(_Lang, _Context, [], [], !SizeLeft).
|
|
insts_to_limited_size_terms_with_context(Lang, Context, [HeadInst | TailInsts],
|
|
InstTerms, !SizeLeft) :-
|
|
( if !.SizeLeft =< 0 then
|
|
InstTerms = [ellipsis_term(Context)]
|
|
else
|
|
inst_to_limited_size_term_with_context(Lang, Context,
|
|
HeadInst, HeadInstTerm, !SizeLeft),
|
|
insts_to_limited_size_terms_with_context(Lang, Context,
|
|
TailInsts, TailInstTerms, !SizeLeft),
|
|
InstTerms = [HeadInstTerm | TailInstTerms]
|
|
).
|
|
|
|
:- func ellipsis_term(prog_context) = prog_term.
|
|
|
|
ellipsis_term(Context) = term.functor(term.atom("..."), [], Context).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred cons_id_and_args_to_term_full(cons_id::in, list(prog_term)::in,
|
|
prog_term::out) is det.
|
|
|
|
cons_id_and_args_to_term_full(ConsId, ArgTerms, Term) :-
|
|
Context = dummy_context,
|
|
(
|
|
ConsId = cons(SymName, _Arity, _TypeCtor),
|
|
construct_qualified_term(SymName, ArgTerms, Term)
|
|
;
|
|
ConsId = tuple_cons(_Arity),
|
|
SymName = unqualified("{}"),
|
|
construct_qualified_term(SymName, ArgTerms, Term)
|
|
;
|
|
ConsId = closure_cons(_, _),
|
|
FunctorName = "closure_cons",
|
|
Term = term.functor(term.string(FunctorName), [], Context)
|
|
;
|
|
ConsId = some_int_const(IntConst),
|
|
Term = int_const_to_decimal_term(IntConst, Context)
|
|
;
|
|
ConsId = float_const(Float),
|
|
Term = term.functor(term.float(Float), [], Context)
|
|
;
|
|
ConsId = string_const(String),
|
|
Term = term.functor(term.string(String), [], Context)
|
|
;
|
|
ConsId = char_const(Char),
|
|
SymName = unqualified(string.from_char(Char)),
|
|
construct_qualified_term(SymName, [], Term)
|
|
;
|
|
ConsId = impl_defined_const(IDCKind),
|
|
FunctorName = "ImplDefinedConst: " ++
|
|
impl_defined_const_kind_to_str(IDCKind),
|
|
Term = term.functor(term.string(FunctorName), [], Context)
|
|
;
|
|
ConsId = type_ctor_info_const(ModuleName, TypeCtorName, Arity),
|
|
string.format("TypeCtorInfo for %s.%s/%d",
|
|
[s(sym_name_to_string(ModuleName)), s(TypeCtorName), i(Arity)],
|
|
FunctorName),
|
|
Term = term.functor(term.string(FunctorName), [], Context)
|
|
;
|
|
ConsId = base_typeclass_info_const(_, _, _, _),
|
|
FunctorName = "base_typeclass_info_const",
|
|
Term = term.functor(term.string(FunctorName), [], Context)
|
|
;
|
|
ConsId = type_info_cell_constructor(TypeCtor),
|
|
TypeCtor = type_ctor(TypeCtorName, Arity),
|
|
string.format("type_info_cell_constructor for %s/%d",
|
|
[s(sym_name_to_string(TypeCtorName)), i(Arity)], FunctorName),
|
|
Term = term.functor(term.string(FunctorName), [], Context)
|
|
;
|
|
ConsId = typeclass_info_cell_constructor,
|
|
FunctorName = "typeclass_info_cell_constructor",
|
|
Term = term.functor(term.string(FunctorName), [], Context)
|
|
;
|
|
ConsId = type_info_const(TIConstNum),
|
|
expect(unify(ArgTerms, []), $pred, "type_info_const arity != 0"),
|
|
FunctorName = "type_info_const",
|
|
Arg = term_int.int_to_decimal_term(TIConstNum, Context),
|
|
Term = term.functor(term.string(FunctorName), [Arg], Context)
|
|
;
|
|
ConsId = typeclass_info_const(TCIConstNum),
|
|
expect(unify(ArgTerms, []), $pred, "typeclass_info_const arity != 0"),
|
|
FunctorName = "typeclass_info_const",
|
|
Arg = term_int.int_to_decimal_term(TCIConstNum, Context),
|
|
Term = term.functor(term.string(FunctorName), [Arg], Context)
|
|
;
|
|
ConsId = ground_term_const(TCIConstNum, SubConsId),
|
|
expect(unify(ArgTerms, []), $pred, "ground_term_const arity != 0"),
|
|
cons_id_and_args_to_term_full(SubConsId, [], SubArg),
|
|
FunctorName = "ground_term_const",
|
|
NumArg = term_int.int_to_decimal_term(TCIConstNum, Context),
|
|
Term = term.functor(term.string(FunctorName), [NumArg, SubArg],
|
|
Context)
|
|
;
|
|
ConsId = tabling_info_const(_),
|
|
FunctorName = "tabling_info_const",
|
|
Term = term.functor(term.string(FunctorName), [], Context)
|
|
;
|
|
ConsId = table_io_entry_desc(_),
|
|
FunctorName = "table_io_entry_desc",
|
|
Term = term.functor(term.string(FunctorName), [], Context)
|
|
;
|
|
ConsId = deep_profiling_proc_layout(_),
|
|
FunctorName = "deep_profiling_proc_layout",
|
|
Term = term.functor(term.string(FunctorName), [], Context)
|
|
).
|
|
|
|
int_const_to_decimal_term(IntConst, Context) = Term :-
|
|
(
|
|
IntConst = int_const(Int),
|
|
Term = term_int.int_to_decimal_term(Int, Context)
|
|
;
|
|
IntConst = int8_const(Int8),
|
|
Term = term_int.int8_to_decimal_term(Int8, Context)
|
|
;
|
|
IntConst = int16_const(Int16),
|
|
Term = term_int.int16_to_decimal_term(Int16, Context)
|
|
;
|
|
IntConst = int32_const(Int32),
|
|
Term = term_int.int32_to_decimal_term(Int32, Context)
|
|
;
|
|
IntConst = int64_const(Int64),
|
|
Term = term_int.int64_to_decimal_term(Int64, Context)
|
|
;
|
|
IntConst = uint_const(UInt),
|
|
Term = term_int.uint_to_decimal_term(UInt, Context)
|
|
;
|
|
IntConst = uint8_const(UInt8),
|
|
Term = term_int.uint8_to_decimal_term(UInt8, Context)
|
|
;
|
|
IntConst = uint16_const(UInt16),
|
|
Term = term_int.uint16_to_decimal_term(UInt16, Context)
|
|
;
|
|
IntConst = uint32_const(UInt32),
|
|
Term = term_int.uint32_to_decimal_term(UInt32, Context)
|
|
;
|
|
IntConst = uint64_const(UInt64),
|
|
Term = term_int.uint64_to_decimal_term(UInt64, Context)
|
|
).
|
|
|
|
:- func det_to_term(prog_context, determinism) = prog_term.
|
|
|
|
det_to_term(Context, Det) = make_atom(Context, determinism_to_string(Det)).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module parse_tree.parse_tree_to_term.
|
|
%---------------------------------------------------------------------------%
|