mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 01:13:30 +00:00
f74e2b70c6
compiler/prog_data.m:
As above. The main function symbol of the type was already named
bound_functor, and "bound inst", when spoken/typed in text,
usually refers to the bound/3 function symbol of the mer_inst type,
not to new-renamed type.
compiler/add_mutable_aux_preds.m:
compiler/comp_unit_interface.m:
compiler/cse_detection.m:
compiler/det_report.m:
compiler/direct_arg_in_out.m:
compiler/equiv_type_hlds.m:
compiler/error_msg_inst.m:
compiler/float_regs.m:
compiler/hlds_code_util.m:
compiler/hlds_out_goal.m:
compiler/hlds_out_mode.m:
compiler/hlds_statistics.m:
compiler/inst_abstract_unify.m:
compiler/inst_check.m:
compiler/inst_match.m:
compiler/inst_merge.m:
compiler/inst_mode_type_prop.m:
compiler/inst_test.m:
compiler/inst_user.m:
compiler/inst_util.m:
compiler/lco.m:
compiler/mode_constraints.m:
compiler/mode_errors.m:
compiler/mode_top_functor.m:
compiler/mode_util.m:
compiler/modecheck_coerce.m:
compiler/modecheck_util.m:
compiler/module_qual.qualify_items.m:
compiler/parse_inst_mode_name.m:
compiler/parse_tree_out_inst.m:
compiler/parse_tree_out_item.m:
compiler/parse_tree_to_term.m:
compiler/pd_util.m:
compiler/prog_mode.m:
compiler/recompilation.usage.m:
compiler/simplify_goal_switch.m:
compiler/switch_detection.m:
compiler/types_into_modes.m:
compiler/unused_imports.m:
compiler/xml_documentation.m:
Perform s/bound_inst/bound_functor/ and s/BoundInst/BoundFunctor/ where
appropriate, with some instances of s/bound_inst_list/bound_functors/.
1105 lines
43 KiB
Mathematica
1105 lines
43 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 2009-2012 The University of Melbourne.
|
|
% Copyright (C) 2015-2024 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: parse_tree_to_term.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.
|
|
|
|
:- func is_live_to_str(is_live) = string.
|
|
:- func unify_is_real_to_str(unify_is_real) = string.
|
|
:- func any_inst_uniqueness(uniqueness) = string.
|
|
:- func inst_uniqueness(uniqueness, string) = string.
|
|
|
|
% 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),
|
|
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(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(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(term::in, term::out) is det.
|
|
|
|
maybe_add_lambda_eval_method(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 = bound(Uniq, InstResults, BoundFunctors),
|
|
bound_functors_to_term(Lang, Context, BoundFunctors,
|
|
BoundFunctorsTerm),
|
|
(
|
|
Lang = output_mercury,
|
|
ArgTerms = [BoundFunctorsTerm]
|
|
;
|
|
Lang = output_debug,
|
|
ResultsTerm = inst_test_results_to_term(Context, InstResults),
|
|
ArgTerms = [ResultsTerm, BoundFunctorsTerm]
|
|
),
|
|
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 = 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 = bound(Uniq, InstResults, BoundFunctors),
|
|
bound_functors_to_limited_size_term(Lang, Context,
|
|
BoundFunctors, BoundFunctorsTerm, !SizeLeft),
|
|
(
|
|
Lang = output_mercury,
|
|
ArgTerms = [BoundFunctorsTerm]
|
|
;
|
|
Lang = output_debug,
|
|
ResultsTerm = inst_test_results_to_term(Context, InstResults),
|
|
!:SizeLeft = !.SizeLeft - 1,
|
|
ArgTerms = [ResultsTerm, BoundFunctorsTerm]
|
|
),
|
|
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 = 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).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
is_live_to_str(is_live) = "live".
|
|
is_live_to_str(is_dead) = "dead".
|
|
|
|
unify_is_real_to_str(real_unify) = "real".
|
|
unify_is_real_to_str(fake_unify) = "fake".
|
|
|
|
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".
|
|
|
|
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_functors_to_term(output_lang::in, prog_context::in,
|
|
list(bound_functor)::in, prog_term::out) is det.
|
|
|
|
bound_functors_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_functors_to_term(Lang, Context, [BoundFunctor | BoundFunctors], Term) :-
|
|
bound_functors_to_term_lag(Lang, Context, BoundFunctor,
|
|
BoundFunctors, Term).
|
|
|
|
:- pred bound_functors_to_term_lag(output_lang::in, prog_context::in,
|
|
bound_functor::in, list(bound_functor)::in, prog_term::out) is det.
|
|
|
|
bound_functors_to_term_lag(Lang, Context, BoundFunctor, BoundFunctors, Term) :-
|
|
BoundFunctor = 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),
|
|
(
|
|
BoundFunctors = [],
|
|
Term = FirstTerm
|
|
;
|
|
BoundFunctors = [HeadBoundFunctor | TailBoundFunctors],
|
|
bound_functors_to_term_lag(Lang, Context,
|
|
HeadBoundFunctor, TailBoundFunctors, SecondTerm),
|
|
construct_qualified_term_with_context(unqualified(";"),
|
|
[FirstTerm, SecondTerm], Context, Term)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pred bound_functors_to_limited_size_term(output_lang::in, prog_context::in,
|
|
list(bound_functor)::in, prog_term::out, int::in, int::out) is det.
|
|
|
|
bound_functors_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_functors_to_limited_size_term(Lang, Context,
|
|
[BoundFunctor | BoundFunctors], Term, !SizeLeft) :-
|
|
bound_functors_to_limited_size_term_lag(Lang, Context,
|
|
BoundFunctor, BoundFunctors, Term, !SizeLeft).
|
|
|
|
:- pred bound_functors_to_limited_size_term_lag(output_lang::in,
|
|
prog_context::in, bound_functor::in, list(bound_functor)::in,
|
|
prog_term::out, int::in, int::out) is det.
|
|
|
|
bound_functors_to_limited_size_term_lag(Lang, Context,
|
|
BoundFunctor, BoundFunctors, Term, !SizeLeft) :-
|
|
BoundFunctor = 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),
|
|
(
|
|
BoundFunctors = [],
|
|
Term = FirstTerm
|
|
;
|
|
BoundFunctors = [HeadBoundFunctor | TailBoundFunctors],
|
|
bound_functors_to_limited_size_term_lag(Lang, Context,
|
|
HeadBoundFunctor, TailBoundFunctors, 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 = du_data_ctor(du_ctor(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.
|
|
%---------------------------------------------------------------------------%
|