Files
mercury/compiler/parse_tree_out_pred_decl.m
2015-12-12 12:45:59 +11:00

498 lines
19 KiB
Mathematica

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2015 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.
%---------------------------------------------------------------------------%
%
% This module converts the parse tree structure representations of
% predicate and function declarations back into Mercury source text.
%
% Many of the predicates in this module are have two slightly different
% versions. Either one is for functions and the other is for predicates,
% or one is for known functions and the other for predicates *and* for
% functions that are not known to be functions due to the use of a
% `with_type` annotation, which hides the return type.
%
%---------------------------------------------------------------------------%
:- module parse_tree.parse_tree_out_pred_decl.
:- interface.
:- import_module mdbcomp.
:- import_module mdbcomp.prim_data.
:- import_module mdbcomp.sym_name.
:- import_module parse_tree.parse_tree_out_info.
:- import_module parse_tree.prog_data.
:- import_module io.
:- import_module list.
:- import_module maybe.
%---------------------------------------------------------------------------%
% XXX Document me.
%
:- pred mercury_format_pred_or_func_decl(output_lang::in, tvarset::in,
inst_varset::in, pred_or_func::in, existq_tvars::in, sym_name::in,
list(type_and_mode)::in, maybe(mer_type)::in, maybe(mer_inst)::in,
maybe(determinism)::in, purity::in, prog_constraints::in,
string::in, string::in, string::in, U::di, U::uo) is det <= output(U).
% XXX Document me.
%
:- pred mercury_format_func_decl(output_lang::in, tvarset::in, inst_varset::in,
existq_tvars::in, sym_name::in, list(type_and_mode)::in,
type_and_mode::in, maybe(determinism)::in, purity::in,
prog_constraints::in, string::in, string::in, string::in, U::di, U::uo)
is det <= output(U).
%---------------------------------------------------------------------------%
% Output a `:- pred' declaration.
%
:- pred mercury_output_pred_type(tvarset::in, var_name_print::in,
existq_tvars::in, sym_name::in, list(mer_type)::in, maybe(determinism)::in,
purity::in, prog_constraints::in, io::di, io::uo) is det.
:- func mercury_pred_type_to_string(tvarset, var_name_print,
existq_tvars, sym_name, list(mer_type), maybe(determinism),
purity, prog_constraints) = string.
% Output a `:- func' declaration.
%
:- pred mercury_output_func_type(tvarset::in, var_name_print::in,
existq_tvars::in, sym_name::in, list(mer_type)::in, mer_type::in,
maybe(determinism)::in, purity::in, prog_constraints::in,
io::di, io::uo) is det.
:- func mercury_func_type_to_string(tvarset, var_name_print,
existq_tvars, sym_name, list(mer_type), mer_type, maybe(determinism),
purity, prog_constraints) = string.
%---------------------------------------------------------------------------%
% XXX Document me.
%
:- pred mercury_output_pred_mode_decl(output_lang::in, inst_varset::in,
sym_name::in, list(mer_mode)::in, maybe(mer_inst)::in,
maybe(determinism)::in, io::di, io::uo) is det.
:- func mercury_pred_mode_decl_to_string(output_lang, inst_varset, sym_name,
list(mer_mode), maybe(mer_inst), maybe(determinism)) = string.
:- pred mercury_format_pred_or_func_mode_decl(output_lang::in,
inst_varset::in, sym_name::in, list(mer_mode)::in, maybe(mer_inst)::in,
maybe(determinism)::in, string::in, string::in,
U::di, U::uo) is det <= output(U).
% XXX Document me.
%
:- pred mercury_output_func_mode_decl(output_lang::in, inst_varset::in,
sym_name::in, list(mer_mode)::in, mer_mode::in, maybe(determinism)::in,
io::di, io::uo) is det.
:- func mercury_func_mode_decl_to_string(output_lang, inst_varset, sym_name,
list(mer_mode), mer_mode, maybe(determinism)) = string.
:- pred mercury_format_func_mode_decl(output_lang::in, inst_varset::in,
sym_name::in, list(mer_mode)::in, mer_mode::in, maybe(determinism)::in,
string::in, string::in, U::di, U::uo) is det
<= output(U).
% XXX Document me.
%
:- pred mercury_output_mode_subdecl(output_lang::in, pred_or_func::in,
inst_varset::in, sym_name::in, list(mer_mode)::in, maybe(determinism)::in,
io::di, io::uo) is det.
:- func mercury_mode_subdecl_to_string(output_lang, pred_or_func, inst_varset,
sym_name, list(mer_mode), maybe(determinism)) = string.
% XXX Document me.
%
:- pred mercury_output_pred_mode_subdecl(output_lang::in, inst_varset::in,
sym_name::in, list(mer_mode)::in, maybe(determinism)::in,
io::di, io::uo) is det.
:- func mercury_pred_mode_subdecl_to_string(output_lang, inst_varset, sym_name,
list(mer_mode), maybe(determinism)) = string.
% XXX Document me.
%
:- pred mercury_output_func_mode_subdecl(output_lang::in, inst_varset::in,
sym_name::in, list(mer_mode)::in, mer_mode::in, maybe(determinism)::in,
io::di, io::uo) is det.
:- func mercury_func_mode_subdecl_to_string(output_lang, inst_varset, sym_name,
list(mer_mode), mer_mode, maybe(determinism)) = string.
%---------------------------------------------------------------------------%
:- implementation.
:- import_module parse_tree.mercury_to_mercury.
:- import_module parse_tree.parse_tree_out_inst.
:- import_module parse_tree.prog_out.
:- import_module parse_tree.prog_util.
:- import_module bool.
:- import_module char.
:- import_module ops.
:- import_module string.
:- import_module term.
:- import_module varset.
%---------------------------------------------------------------------------%
mercury_format_pred_or_func_decl(Lang, TypeVarSet, InstVarSet,
PredOrFunc, ExistQVars, PredName, TypesAndModes, WithType, WithInst,
MaybeDet, Purity, ClassContext, StartString,
Separator, Terminator, !IO) :-
split_types_and_modes(TypesAndModes, Types, MaybeModes),
( if
MaybeModes = yes(Modes),
( Modes = [_ | _]
; WithInst = yes(_)
)
then
mercury_format_pred_or_func_type_2(TypeVarSet, print_name_only,
PredOrFunc, ExistQVars, PredName, Types, WithType, no,
Purity, ClassContext, StartString, Separator, !IO),
mercury_format_pred_or_func_mode_decl(Lang, InstVarSet, PredName,
Modes, WithInst, MaybeDet, StartString, Terminator, !IO)
else
mercury_format_pred_or_func_type_2(TypeVarSet, print_name_only,
PredOrFunc, ExistQVars, PredName, Types, WithType, MaybeDet,
Purity, ClassContext, StartString, Terminator, !IO)
).
%---------------------%
mercury_format_func_decl(Lang, TypeVarSet, InstVarSet, ExistQVars, FuncName,
TypesAndModes, RetTypeAndMode, MaybeDet, Purity, ClassContext,
StartString, Separator, Terminator, !U) :-
split_types_and_modes(TypesAndModes, Types, MaybeModes),
split_type_and_mode(RetTypeAndMode, RetType, MaybeRetMode),
( if
MaybeModes = yes(Modes),
MaybeRetMode = yes(RetMode)
then
mercury_format_func_type_2(TypeVarSet, print_name_only,
ExistQVars, FuncName, Types, RetType, no, Purity,
ClassContext, StartString, Separator, !U),
mercury_format_func_mode_decl(Lang, InstVarSet, FuncName, Modes,
RetMode, MaybeDet, StartString, Terminator, !U)
else
mercury_format_func_type_2(TypeVarSet, print_name_only,
ExistQVars, FuncName, Types, RetType, MaybeDet, Purity,
ClassContext, StartString, Terminator, !U)
).
%---------------------------------------------------------------------------%
mercury_output_pred_type(TypeVarSet, VarNamePrint, ExistQVars, PredName,
Types, MaybeDet, Purity, ClassContext, !IO) :-
mercury_format_pred_type(TypeVarSet, VarNamePrint, ExistQVars, PredName,
Types, no, MaybeDet, Purity, ClassContext, !IO).
mercury_pred_type_to_string(TypeVarSet, VarNamePrint, ExistQVars, PredName,
Types, MaybeDet, Purity, ClassContext) = String :-
mercury_format_pred_type(TypeVarSet, VarNamePrint, ExistQVars, PredName,
Types, no, MaybeDet, Purity, ClassContext, "", String).
:- pred mercury_format_pred_type(tvarset::in, var_name_print::in,
existq_tvars::in, sym_name::in, list(mer_type)::in, maybe(mer_type)::in,
maybe(determinism)::in, purity::in, prog_constraints::in,
U::di, U::uo) is det <= output(U).
mercury_format_pred_type(TypeVarSet, VarNamePrint, ExistQVars, PredName,
Types, WithType, MaybeDet, Purity, ClassContext, !U) :-
mercury_format_pred_or_func_type_2(TypeVarSet, VarNamePrint,
pf_predicate, ExistQVars, PredName, Types, WithType, MaybeDet,
Purity, ClassContext, ":- ", ".\n", !U).
%---------------------%
mercury_output_func_type(VarSet, ExistQVars, FuncName, Types, RetType,
MaybeDet, Purity, ClassContext, VarNamePrint, !IO) :-
mercury_format_func_type(VarSet, ExistQVars, FuncName, Types, RetType,
MaybeDet, Purity, ClassContext, VarNamePrint, !IO).
mercury_func_type_to_string(TypeVarSet, VarNamePrint, ExistQVars,
FuncName, Types, RetType, MaybeDet, Purity, ClassContext) = String :-
mercury_format_func_type(TypeVarSet, VarNamePrint, ExistQVars,
FuncName, Types, RetType, MaybeDet, Purity, ClassContext,
"", String).
:- pred mercury_format_func_type(tvarset::in, var_name_print::in,
existq_tvars::in, sym_name::in, list(mer_type)::in, mer_type::in,
maybe(determinism)::in, purity::in, prog_constraints::in,
U::di, U::uo) is det <= output(U).
mercury_format_func_type(TypeVarSet, VarNamePrint, ExistQVars, FuncName,
Types, RetType, MaybeDet, Purity, ClassContext, !U) :-
mercury_format_func_type_2(TypeVarSet, VarNamePrint, ExistQVars, FuncName,
Types, RetType, MaybeDet, Purity, ClassContext, ":- ", ".\n", !U).
%---------------------------------------------------------------------------%
%
% Predicates used in the implementation of both
% mercury_format_pred_or_func_decl/mercury_format_func_decl
% and
% mercury_format_pred_type/mercury_format_func_type.
%
:- pred mercury_format_pred_or_func_type_2( tvarset::in, var_name_print::in,
pred_or_func::in, existq_tvars::in, sym_name::in, list(mer_type)::in,
maybe(mer_type)::in, maybe(determinism)::in, purity::in,
prog_constraints::in, string::in, string::in,
U::di, U::uo) is det <= output(U).
mercury_format_pred_or_func_type_2(TypeVarSet, VarNamePrint, PredOrFunc,
ExistQVars, PredName, Types, MaybeWithType, MaybeDet, Purity,
ClassContext, StartString, Separator, !U) :-
add_string(StartString, !U),
mercury_format_quantifier(TypeVarSet, VarNamePrint, ExistQVars, !U),
( if
ExistQVars = [],
ClassContext = constraints(_, [])
then
true
else
add_string("(", !U)
),
add_purity_prefix(Purity, !U),
PredOrFuncStr = pred_or_func_to_str(PredOrFunc),
add_string(PredOrFuncStr, !U),
add_string(" ", !U),
(
Types = [_ | _],
mercury_format_sym_name(PredName, !U),
add_string("(", !U),
add_list(Types, ", ", mercury_format_type(TypeVarSet, VarNamePrint),
!U),
add_string(")", !U)
;
Types = [],
mercury_format_bracketed_sym_name(PredName, !U)
),
(
MaybeWithType = yes(WithType),
add_string(" `with_type` (", !U),
mercury_format_type(TypeVarSet, VarNamePrint, WithType, !U),
add_string(")", !U)
;
MaybeWithType = no
),
% We need to handle is/2 specially, because it is used for determinism
% annotations (`... is det'), and so the compiler will misinterpret
% a bare `:- pred is(int, int_expr)' as % `:- pred int is int_expr'
% and then report some very confusing error message. Thus you _have_
% to give a determinism annotation in the pred declaration for is/2,
% e.g. `:- pred is(int, int_expr) is det.' (Yes, this made me puke too.)
%
% The alternative is a term traversal in compiler/prog_io.m
% get_determinism/3. The alternative is nicer, but less efficient.
( if
PredOrFunc = pf_predicate,
MaybeDet = no,
unqualify_name(PredName) = "is",
list.length(Types, 2)
then
% This determinism will be ignored.
mercury_format_det_annotation(yes(detism_det), !U)
else
mercury_format_det_annotation(MaybeDet, !U)
),
mercury_format_class_context(TypeVarSet, VarNamePrint,
ClassContext, ExistQVars, !U),
add_string(Separator, !U).
%---------------------%
:- pred mercury_format_func_type_2(tvarset::in, var_name_print::in,
existq_tvars::in, sym_name::in, list(mer_type)::in, mer_type::in,
maybe(determinism)::in, purity::in, prog_constraints::in,
string::in, string::in, U::di, U::uo) is det <= output(U).
mercury_format_func_type_2(VarSet, VarNamePrint, ExistQVars, FuncName, Types,
RetType, MaybeDet, Purity, ClassContext, StartString, Separator, !U) :-
add_string(StartString, !U),
mercury_format_quantifier(VarSet, VarNamePrint, ExistQVars, !U),
( if
ExistQVars = [],
ClassContext = constraints(_, [])
then
true
else
add_string("(", !U)
),
add_purity_prefix(Purity, !U),
add_string("func ", !U),
(
Types = [_ | _],
mercury_format_sym_name(FuncName, !U),
add_string("(", !U),
add_list(Types, ", ", mercury_format_type(VarSet, VarNamePrint), !U),
add_string(")", !U)
;
Types = [],
mercury_format_bracketed_sym_name(FuncName, !U)
),
add_string(" = ", !U),
mercury_format_type(VarSet, VarNamePrint, RetType, !U),
mercury_format_det_annotation(MaybeDet, !U),
mercury_format_class_context(VarSet, VarNamePrint,
ClassContext, ExistQVars, !U),
add_string(Separator, !U).
%---------------------------------------------------------------------------%
mercury_output_pred_mode_decl(Lang, VarSet, PredName, Modes, WithInst,
MaybeDet, !IO) :-
mercury_format_pred_or_func_mode_decl(Lang, VarSet, PredName, Modes,
WithInst, MaybeDet, ":- ", ".\n", !IO).
mercury_pred_mode_decl_to_string(Lang, VarSet, PredName, Modes, MaybeWithInst,
MaybeDet) = String :-
mercury_format_pred_or_func_mode_decl(Lang, VarSet, PredName, Modes,
MaybeWithInst, MaybeDet, ":- ", ".\n", "", String).
mercury_format_pred_or_func_mode_decl(Lang, VarSet, PredName, Modes,
WithInst, MaybeDet, StartString, Separator, !U) :-
add_string(StartString, !U),
add_string("mode ", !U),
mercury_format_pred_or_func_mode_subdecl(Lang, VarSet, PredName, Modes,
WithInst, MaybeDet, !U),
add_string(Separator, !U).
%---------------------%
mercury_output_func_mode_decl(Lang, VarSet, FuncName, Modes, RetMode, MaybeDet,
!IO) :-
mercury_format_func_mode_decl(Lang, VarSet, FuncName, Modes, RetMode,
MaybeDet, ":- ", ".\n", !IO).
mercury_func_mode_decl_to_string(Lang, VarSet, FuncName, Modes, RetMode,
MaybeDet) = String :-
mercury_format_func_mode_decl(Lang, VarSet, FuncName, Modes, RetMode,
MaybeDet, ":- ", ".\n", "", String).
mercury_format_func_mode_decl(Lang, VarSet, FuncName, Modes, RetMode,
MaybeDet, StartString, Separator, !U) :-
add_string(StartString, !U),
add_string("mode ", !U),
mercury_format_func_mode_subdecl(Lang, VarSet, FuncName, Modes, RetMode,
MaybeDet, !U),
add_string(Separator, !U).
%---------------------------------------------------------------------------%
mercury_output_mode_subdecl(Lang, PredOrFunc, InstVarSet, Name, Modes,
MaybeDet, !IO) :-
mercury_format_mode_subdecl(Lang, PredOrFunc, InstVarSet, Name, Modes,
MaybeDet, !IO).
mercury_mode_subdecl_to_string(Lang, PredOrFunc, InstVarSet, Name, Modes,
MaybeDet) = String :-
mercury_format_mode_subdecl(Lang, PredOrFunc, InstVarSet, Name, Modes,
MaybeDet, "", String).
:- pred mercury_format_mode_subdecl(output_lang::in, pred_or_func::in,
inst_varset::in, sym_name::in, list(mer_mode)::in, maybe(determinism)::in,
U::di, U::uo) is det <= output(U).
mercury_format_mode_subdecl(Lang, PredOrFunc, InstVarSet, Name, Modes,
MaybeDet, !U) :-
(
PredOrFunc = pf_predicate,
mercury_format_pred_or_func_mode_subdecl(Lang, InstVarSet, Name,
Modes, no, MaybeDet, !U)
;
PredOrFunc = pf_function,
pred_args_to_func_args(Modes, ArgModes, RetMode),
mercury_format_func_mode_subdecl(Lang, InstVarSet, Name, ArgModes,
RetMode, MaybeDet, !U)
).
%---------------------%
mercury_output_pred_mode_subdecl(Lang, VarSet, PredName, Modes, MaybeDet,
!IO) :-
mercury_format_pred_or_func_mode_subdecl(Lang, VarSet, PredName,
Modes, no, MaybeDet, !IO).
mercury_pred_mode_subdecl_to_string(Lang, VarSet, PredName, Modes, MaybeDet)
= String :-
mercury_format_pred_or_func_mode_subdecl(Lang, VarSet, PredName,
Modes, no, MaybeDet, "", String).
:- pred mercury_format_pred_or_func_mode_subdecl(output_lang::in,
inst_varset::in, sym_name::in, list(mer_mode)::in, maybe(mer_inst)::in,
maybe(determinism)::in, U::di, U::uo) is det <= output(U).
mercury_format_pred_or_func_mode_subdecl(Lang, InstVarSet, PredName, Modes,
MaybeWithInst, MaybeDet, !U) :-
(
Modes = [_ | _],
mercury_format_sym_name(PredName, !U),
add_string("(", !U),
mercury_format_mode_list(Lang, InstVarSet, Modes, !U),
add_string(")", !U)
;
Modes = [],
mercury_format_bracketed_sym_name(PredName, !U)
),
(
MaybeWithInst = yes(WithInst),
add_string(" `with_inst` (", !U),
mercury_format_inst(Lang, InstVarSet, WithInst, !U),
add_string(")", !U)
;
MaybeWithInst = no
),
mercury_format_det_annotation(MaybeDet, !U).
%---------------------%
mercury_output_func_mode_subdecl(Lang, VarSet, FuncName, Modes, RetMode,
MaybeDet, !IO) :-
mercury_format_func_mode_subdecl(Lang, VarSet, FuncName, Modes, RetMode,
MaybeDet, !IO).
mercury_func_mode_subdecl_to_string(Lang, VarSet, FuncName, Modes, RetMode,
MaybeDet) = String :-
mercury_format_func_mode_subdecl(Lang, VarSet, FuncName, Modes, RetMode,
MaybeDet, "", String).
:- pred mercury_format_func_mode_subdecl(output_lang::in, inst_varset::in,
sym_name::in, list(mer_mode)::in, mer_mode::in, maybe(determinism)::in,
U::di, U::uo) is det <= output(U).
mercury_format_func_mode_subdecl(Lang, InstVarSet, FuncName, Modes, RetMode,
MaybeDet, !U) :-
(
Modes = [_ | _],
mercury_format_sym_name(FuncName, !U),
add_string("(", !U),
mercury_format_mode_list(Lang, InstVarSet, Modes, !U),
add_string(")", !U)
;
Modes = [],
mercury_format_bracketed_sym_name(FuncName, !U)
),
add_string(" = ", !U),
mercury_format_mode(Lang, InstVarSet, RetMode, !U),
mercury_format_det_annotation(MaybeDet, !U).
%---------------------------------------------------------------------------%
:- pred mercury_format_det_annotation(maybe(determinism)::in, U::di, U::uo)
is det <= output(U).
mercury_format_det_annotation(MaybeDet, !U) :-
(
MaybeDet = no
;
MaybeDet = yes(Det),
add_string(" is ", !U),
add_string(mercury_det_to_string(Det), !U)
).
%---------------------------------------------------------------------------%
:- end_module parse_tree.parse_tree_out_pred_decl.
%---------------------------------------------------------------------------%