mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 01:13:30 +00:00
525 lines
22 KiB
Mathematica
525 lines
22 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 2018, 2020-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.
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Output the declarations and definitions of classes.
|
|
%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- module ml_backend.mlds_to_c_class.
|
|
:- interface.
|
|
|
|
:- import_module libs.
|
|
:- import_module libs.indent.
|
|
:- import_module ml_backend.mlds.
|
|
:- import_module ml_backend.mlds_to_c_util.
|
|
|
|
:- import_module io.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred mlds_output_class_defn(mlds_to_c_opts::in, io.text_output_stream::in,
|
|
indent::in, mlds_module_name::in, mlds_class_defn::in,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pred mlds_output_env_defn(mlds_to_c_opts::in, io.text_output_stream::in,
|
|
indent::in, mlds_module_name::in, mlds_env_defn::in,
|
|
io::di, io::uo) is det.
|
|
|
|
:- pred mlds_output_struct_defn(mlds_to_c_opts::in, io.text_output_stream::in,
|
|
indent::in, mlds_module_name::in, mlds_struct_defn::in,
|
|
io::di, io::uo) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module libs.globals.
|
|
:- import_module ml_backend.ml_code_util.
|
|
:- import_module ml_backend.mlds_to_c_data.
|
|
:- import_module ml_backend.mlds_to_c_func.
|
|
:- import_module ml_backend.mlds_to_c_name.
|
|
:- import_module ml_backend.mlds_to_c_stmt.
|
|
:- import_module ml_backend.mlds_to_c_type.
|
|
:- import_module ml_backend.mlds_to_target_util.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.prog_data.
|
|
|
|
:- import_module bool.
|
|
:- import_module list.
|
|
:- import_module maybe.
|
|
:- import_module require.
|
|
:- import_module string.
|
|
:- import_module term.
|
|
:- import_module uint.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred mlds_output_class_defns(mlds_to_c_opts::in, io.text_output_stream::in,
|
|
indent::in, mlds_module_name::in, list(mlds_class_defn)::in,
|
|
io::di, io::uo) is det.
|
|
|
|
mlds_output_class_defns(_, _, _, _, [], !IO).
|
|
mlds_output_class_defns(Opts, Stream, Indent, ModuleName,
|
|
[ClassDefn | ClassDefns], !IO) :-
|
|
mlds_output_class_defn(Opts, Stream, Indent, ModuleName, ClassDefn, !IO),
|
|
mlds_output_class_defns(Opts, Stream, Indent, ModuleName, ClassDefns, !IO).
|
|
|
|
mlds_output_class_defn(Opts, Stream, Indent, ModuleName, ClassDefn, !IO) :-
|
|
ClassDefn = mlds_class_defn(ClassName, ClassArity, Context, _Flags,
|
|
_Imports, Inherits, _Interfaces, _TypeParams,
|
|
MemberFields, MemberClasses, _MemberMethods, Ctors),
|
|
% These calls to expect/3 are based on the code constructing environment
|
|
% structures in ml_elim_nested.m, which should be the *only* place
|
|
% in the MLDS code generator that generates MLDS classes when
|
|
% targeting C using low level data.
|
|
%
|
|
% However, we want to preserve the possibility of writing out MLDS dumps
|
|
% as C code even if targeting another language, so these calls
|
|
% are commented out. For this to be truly useful, we would have to extend
|
|
% this code to write out the fields ignored above in some form
|
|
% (not necessarily in C syntax).
|
|
%
|
|
% expect(unify(Kind, mlds_struct), $pred, "Kind != mlds_struct"),
|
|
% expect(unify(Imports, []), $pred, "Imports != []"),
|
|
% expect(unify(Inherits, inherits_nothing), $pred, "Inherits != nothing"),
|
|
% expect(unify(Interfaces, []), $pred, "Interfaces != []"),
|
|
% expect(unify(TypeParams, []), $pred, "TypeParams != []"),
|
|
% expect(unify(MemberClasses, []), $pred, "MemberClasses != []"),
|
|
% expect(unify(MemberMethods, []), $pred, "MemberMethods != []"),
|
|
% expect(unify(Ctors, []), $pred, "Ctors != []"),
|
|
|
|
IndentStr = indent2_string(Indent),
|
|
|
|
% To avoid name clashes, we need to qualify the names of the member
|
|
% constants with the class name. (In particular, this is needed for
|
|
% enumeration constants and for the nested classes that we generate for
|
|
% constructors of discriminated union types.) Here we compute the
|
|
% appropriate qualifier.
|
|
ClassModuleName = mlds_append_class_qualifier_module_qual(ModuleName,
|
|
ClassName, ClassArity),
|
|
|
|
% Hoist out static members, since plain old C does not support
|
|
% static members in structs (except for enumeration constants).
|
|
list.filter(function_defn_is_static_member, Ctors,
|
|
StaticCtors, NonStaticCtors),
|
|
list.filter(field_var_defn_is_static_member, MemberFields,
|
|
StaticMemberFields, NonStaticMemberFields),
|
|
StructCtors = NonStaticCtors,
|
|
StructMemberFields = NonStaticMemberFields,
|
|
|
|
% Convert the base classes into member variables,
|
|
% since plain old C does not support base classes.
|
|
(
|
|
Inherits = inherits_nothing,
|
|
BaseFieldVarDefns = []
|
|
;
|
|
Inherits = inherits_class(BaseClassId),
|
|
BaseVarName = fvn_base_class(1),
|
|
Type = mlds_class_type(BaseClassId),
|
|
% We only need GC tracing code for top-level variables,
|
|
% not for base classes.
|
|
GCStmt = gc_no_stmt,
|
|
BaseFieldVarDefns = [mlds_field_var_defn(BaseVarName, Context,
|
|
ml_gen_public_field_decl_flags, Type, no_initializer, GCStmt)]
|
|
),
|
|
|
|
% Output the class declaration.
|
|
io.nl(Stream, !IO),
|
|
io.format(Stream, "%s", [s(IndentStr)], !IO),
|
|
mlds_output_class_flags_qual_name(Opts, Stream, IndentStr,
|
|
ModuleName, ClassDefn, !IO),
|
|
|
|
% Output the class members.
|
|
%
|
|
% Note that standard ANSI/ISO C does not allow empty structs. We could
|
|
% handle empty structs here, by adding a dummy member, but that would
|
|
% waste a lot of space, and would also cause incompatibilities between
|
|
% the data layout for --high-level-data and --no-high-level-data.
|
|
% So instead, we make it is the responsibility of the MLDS code generator
|
|
% to not generate any. (E.g. ml_type_gen.m checks whether
|
|
% `target_uses_empty_base_classes' before generating empty structs.)
|
|
% Hence we do not need to check for empty structs here.
|
|
io.write_string(Stream, " {\n", !IO),
|
|
Indent1 = Indent + 1u,
|
|
% XXX Why don't we output all the field vars in one block?
|
|
list.foldl(
|
|
mlds_output_field_var_defn(Opts, Stream, Indent1, no, ClassModuleName),
|
|
BaseFieldVarDefns, !IO),
|
|
list.foldl(
|
|
mlds_output_function_defn(Opts, Stream, Indent1, ClassModuleName),
|
|
StructCtors, !IO),
|
|
list.foldl(
|
|
mlds_output_field_var_defn(Opts, Stream, Indent1, no, ClassModuleName),
|
|
StructMemberFields, !IO),
|
|
% XXX What is this context needed for? And why is it before a semicolon?
|
|
c_output_context(Stream, Opts ^ m2co_line_numbers, Context, !IO),
|
|
io.format(Stream, "%s};\n", [s(IndentStr)], !IO),
|
|
mlds_output_function_defns(Opts, blank_line_start, Stream, Indent,
|
|
ClassModuleName, StaticCtors, !IO),
|
|
mlds_output_field_var_defns(Opts, Stream, Indent, yes, ClassModuleName,
|
|
StaticMemberFields, !IO),
|
|
mlds_output_class_defns(Opts, Stream, Indent, ClassModuleName,
|
|
MemberClasses, !IO).
|
|
|
|
:- pred function_defn_is_static_member(mlds_function_defn::in) is semidet.
|
|
|
|
function_defn_is_static_member(FuncDefn) :-
|
|
FuncDefn ^ mfd_decl_flags ^ mfdf_per_instance = one_copy.
|
|
|
|
:- pred field_var_defn_is_static_member(mlds_field_var_defn::in) is semidet.
|
|
|
|
field_var_defn_is_static_member(FieldVarDefn) :-
|
|
FieldVarDefn ^ mfvd_decl_flags ^ mfvdf_per_instance = one_copy.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
mlds_output_env_defn(Opts, Stream, Indent, ModuleName, EnvDefn, !IO) :-
|
|
EnvDefn = mlds_env_defn(EnvName, Context, MemberFields),
|
|
|
|
IndentStr = indent2_string(Indent),
|
|
|
|
% To avoid name clashes, we need to qualify the names of the member
|
|
% constants with the class name. (In particular, this is needed for
|
|
% enumeration constants and for the nested classes that we generate for
|
|
% constructors of discriminated union types.) Here we compute the
|
|
% appropriate qualifier.
|
|
EnvModuleName = mlds_append_class_qualifier_module_qual(ModuleName,
|
|
EnvName, 0),
|
|
|
|
% Output the class declaration.
|
|
io.nl(Stream, !IO),
|
|
io.format(Stream, "%s", [s(IndentStr)], !IO),
|
|
c_output_context(Stream, Opts ^ m2co_line_numbers, Context, !IO),
|
|
FlagsPrefix = env_decl_flags_to_prefix_for_c(Opts),
|
|
Qualifier = qualifier_to_string_for_c(ModuleName),
|
|
EnvNameStr = class_name_arity_to_string_for_c(EnvName, 0),
|
|
io.format(Stream, "%s%sstruct %s__%s_s",
|
|
[s(IndentStr), s(FlagsPrefix), s(Qualifier), s(EnvNameStr)], !IO),
|
|
|
|
% Output the class fields.
|
|
%
|
|
% Note that standard ANSI/ISO C does not allow empty structs. We could
|
|
% handle empty structs here, by adding a dummy member, but that would
|
|
% waste a lot of space, and would also cause incompatibilities between
|
|
% the data layout for --high-level-data and --no-high-level-data.
|
|
% So instead, we make it is the responsibility of the MLDS code generator
|
|
% to not generate any. (E.g. ml_type_gen.m checks whether
|
|
% `target_uses_empty_base_classes' before generating empty structs.)
|
|
% Hence we do not need to check for empty structs here.
|
|
io.write_string(Stream, " {\n", !IO),
|
|
Indent1 = Indent + 1u,
|
|
list.foldl(
|
|
mlds_output_field_var_defn(Opts, Stream, Indent1, no, EnvModuleName),
|
|
MemberFields, !IO),
|
|
io.format(Stream, "%s};\n", [s(IndentStr)], !IO).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
mlds_output_struct_defn(Opts, Stream, Indent, ModuleName, StructDefn, !IO) :-
|
|
StructDefn = mlds_struct_defn(StructName, Context,
|
|
MemberFields, MaybeCtor),
|
|
expect(unify(MaybeCtor, no), $pred, "MaybeCtor != no"),
|
|
|
|
IndentStr = indent2_string(Indent),
|
|
|
|
% To avoid name clashes, we need to qualify the names of the member
|
|
% constants with the class name. (In particular, this is needed for
|
|
% enumeration constants and for the nested classes that we generate for
|
|
% constructors of discriminated union types.) Here we compute the
|
|
% appropriate qualifier.
|
|
ClassModuleName = mlds_append_class_qualifier_module_qual(ModuleName,
|
|
StructName, 0),
|
|
|
|
% Output the class declaration.
|
|
io.nl(Stream, !IO),
|
|
io.format(Stream, "%s", [s(IndentStr)], !IO),
|
|
c_output_context(Stream, Opts ^ m2co_line_numbers, Context, !IO),
|
|
FlagsPrefix = struct_decl_flags_to_prefix_for_c(Opts),
|
|
Qualifier = qualifier_to_string_for_c(ModuleName),
|
|
StructNameStr = class_name_arity_to_string_for_c(StructName, 0),
|
|
io.format(Stream, "%s%sstruct %s__%s_s",
|
|
[s(IndentStr), s(FlagsPrefix), s(Qualifier), s(StructNameStr)], !IO),
|
|
|
|
% Output the class members.
|
|
%
|
|
% Note that standard ANSI/ISO C does not allow empty structs. We could
|
|
% handle empty structs here, by adding a dummy member, but that would
|
|
% waste a lot of space, and would also cause incompatibilities between
|
|
% the data layout for --high-level-data and --no-high-level-data.
|
|
% So instead, we make it is the responsibility of the MLDS code generator
|
|
% to not generate any. (E.g. ml_type_gen.m checks whether
|
|
% `target_uses_empty_base_classes' before generating empty structs.)
|
|
% Hence we do not need to check for empty structs here.
|
|
io.write_string(Stream, " {\n", !IO),
|
|
Indent1 = Indent + 1u,
|
|
list.foldl(
|
|
mlds_output_field_var_defn(Opts, Stream, Indent1, no, ClassModuleName),
|
|
MemberFields, !IO),
|
|
io.format(Stream, "%s};\n", [s(IndentStr)], !IO).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred mlds_output_class_flags_qual_name(mlds_to_c_opts::in,
|
|
io.text_output_stream::in, string::in,
|
|
mlds_module_name::in, mlds_class_defn::in, io::di, io::uo) is det.
|
|
|
|
mlds_output_class_flags_qual_name(Opts, Stream, IndentStr,
|
|
ModuleName, ClassDefn, !IO) :-
|
|
ClassDefn = mlds_class_defn(ClassName, ClassArity, Context, Flags,
|
|
_Imports, _Inherits, _Implements, _TypeParams,
|
|
_MemberFields, _MemberClasses, _MemberMethods, _Ctors),
|
|
c_output_context(Stream, Opts ^ m2co_line_numbers, Context, !IO),
|
|
FlagsPrefix = class_decl_flags_to_prefix_for_c(Opts, Flags),
|
|
Qualifier = qualifier_to_string_for_c(ModuleName),
|
|
ClassNameStr = class_name_arity_to_string_for_c(ClassName, ClassArity),
|
|
io.format(Stream, "%s%sstruct %s__%s_s",
|
|
[s(IndentStr), s(FlagsPrefix), s(Qualifier), s(ClassNameStr)], !IO).
|
|
|
|
%---------------------%
|
|
|
|
:- pred mlds_output_class_forward_decl(mlds_to_c_opts::in,
|
|
io.text_output_stream::in, indent::in, mlds_module_name::in,
|
|
mlds_class_defn::in, io::di, io::uo) is det.
|
|
:- pragma consider_used(pred(mlds_output_class_forward_decl/7)).
|
|
|
|
mlds_output_class_forward_decl(Opts, Stream, Indent, ModuleName,
|
|
ClassDefn, !IO) :-
|
|
% ANSI C does not permit forward declarations of enumeration types.
|
|
% So we just skip those. Currently they are not needed since we do not
|
|
% actually create any mlds_enum classes when targeting C.
|
|
% We also never output forward declarations (this pred is never called).
|
|
IndentStr = indent2_string(Indent),
|
|
mlds_output_class_flags_qual_name(Opts, Stream, IndentStr, ModuleName,
|
|
ClassDefn, !IO),
|
|
io.write_string(Stream, ";\n", !IO).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred mlds_output_field_var_defns(mlds_to_c_opts::in,
|
|
io.text_output_stream::in, indent::in, bool::in,
|
|
mlds_module_name::in, list(mlds_field_var_defn)::in,
|
|
io::di, io::uo) is det.
|
|
|
|
mlds_output_field_var_defns(_, _, _, _, _, [], !IO).
|
|
mlds_output_field_var_defns(Opts, Stream, Indent, Separate, ModuleName,
|
|
[FieldVarDefn | FieldVarDefns], !IO) :-
|
|
mlds_output_field_var_defn(Opts, Stream, Indent, Separate, ModuleName,
|
|
FieldVarDefn, !IO),
|
|
mlds_output_field_var_defns(Opts, Stream, Indent, Separate, ModuleName,
|
|
FieldVarDefns, !IO).
|
|
|
|
:- pred mlds_output_field_var_defn(mlds_to_c_opts::in,
|
|
io.text_output_stream::in, indent::in, bool::in,
|
|
mlds_module_name::in, mlds_field_var_defn::in, io::di, io::uo) is det.
|
|
|
|
mlds_output_field_var_defn(Opts, Stream, Indent, Separate, ModuleName,
|
|
FieldVarDefn, !IO) :-
|
|
FieldVarDefn = mlds_field_var_defn(FieldVarName, Context, Flags,
|
|
Type, Initializer, GCStmt),
|
|
IndentStr = indent2_string(Indent),
|
|
FlagsPrefix =
|
|
field_var_decl_flags_to_prefix_for_c(Opts, definition, Flags),
|
|
QualFieldVarName =
|
|
qual_field_var_name(ModuleName, module_qual, FieldVarName),
|
|
InitSize = get_initializer_array_size(Initializer),
|
|
type_to_prefix_suffix_for_c(Opts, Type, InitSize, TypePrefix, TypeSuffix),
|
|
|
|
(
|
|
Separate = yes,
|
|
io.nl(Stream, !IO)
|
|
;
|
|
Separate = no
|
|
),
|
|
c_output_context(Stream, Opts ^ m2co_line_numbers, Context, !IO),
|
|
FieldVarNameStr = qual_field_var_name_to_string_for_c(QualFieldVarName),
|
|
io.format(Stream, "%s%s%s %s%s",
|
|
[s(IndentStr), s(FlagsPrefix),
|
|
s(TypePrefix), s(FieldVarNameStr), s(TypeSuffix)], !IO),
|
|
mlds_output_initializer(Opts, Stream, Type, Initializer, !IO),
|
|
io.write_string(Stream, ";\n", !IO),
|
|
mlds_output_gc_statement(Opts, Stream, Indent, GCStmt, "", !IO).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% Output the definitions of the enumeration constants
|
|
% for an enumeration type.
|
|
%
|
|
% XXX We used to use (the predecessor of) this code when we represented
|
|
% enums using mlds_class_defns. However, we don't need this code anymore,
|
|
% because
|
|
%
|
|
% - the MLDS backend, when it targets C, always uses the low-level data
|
|
% representation, which does not use classes of any kind to represent
|
|
% enums, and
|
|
%
|
|
% - since we added mlds_dump.m, we do not need to use mlds_to_C_*.m
|
|
% to dump MLDS code that was generated for other target languages.
|
|
%
|
|
:- pred mlds_output_enum_constants(mlds_to_c_opts::in,
|
|
io.text_output_stream::in, indent::in, mlds_module_name::in,
|
|
list(mlds_enum_const_defn)::in, io::di, io::uo) is det.
|
|
:- pragma consider_used(pred(mlds_output_enum_constants/7)).
|
|
|
|
mlds_output_enum_constants(Opts, Stream, Indent, EnumModuleName,
|
|
EnumConstDefns, !IO) :-
|
|
(
|
|
EnumConstDefns = [],
|
|
unexpected($pred, "EnumConstDefns = []")
|
|
;
|
|
EnumConstDefns = [HeadEnumConstDefn | TailEnumConstDefns],
|
|
mlds_output_enum_constants(Opts, Stream, Indent, EnumModuleName,
|
|
HeadEnumConstDefn, TailEnumConstDefns, !IO)
|
|
).
|
|
|
|
% Output the definitions of a list of enumeration constants.
|
|
%
|
|
:- pred mlds_output_enum_constants(mlds_to_c_opts::in,
|
|
io.text_output_stream::in, indent::in, mlds_module_name::in,
|
|
mlds_enum_const_defn::in, list(mlds_enum_const_defn)::in,
|
|
io::di, io::uo) is det.
|
|
|
|
mlds_output_enum_constants(Opts, Stream, Indent, EnumModuleName,
|
|
HeadDefn, TailDefns, !IO) :-
|
|
HeadDefn = mlds_enum_const_defn(FieldVarName, Context, EnumConst),
|
|
IndentStr = indent2_string(Indent),
|
|
QualFieldVarName =
|
|
qual_field_var_name(EnumModuleName, type_qual, FieldVarName),
|
|
QualFieldVarNameStr =
|
|
qual_field_var_name_to_string_for_c(QualFieldVarName),
|
|
c_output_context(Stream, Opts ^ m2co_line_numbers, Context, !IO),
|
|
(
|
|
EnumConst = mlds_enum_const_uint(EnumUInt),
|
|
io.format(Stream, "%s%s = (MR_Integer) %u",
|
|
[s(IndentStr), s(QualFieldVarNameStr), u(EnumUInt)], !IO)
|
|
;
|
|
EnumConst = mlds_enum_const_foreign(_Lang, EnumNameStr, _Type),
|
|
io.format(Stream, "%s%s = (int) %s",
|
|
[s(IndentStr), s(QualFieldVarNameStr), s(EnumNameStr)], !IO)
|
|
),
|
|
(
|
|
TailDefns = [],
|
|
io.write_string(Stream, "\n", !IO)
|
|
;
|
|
TailDefns = [HeadTailDefn | TailTailDefns],
|
|
io.write_string(Stream, ",\n", !IO),
|
|
mlds_output_enum_constants(Opts, Stream, Indent, EnumModuleName,
|
|
HeadTailDefn, TailTailDefns, !IO)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- func class_decl_flags_to_prefix_for_c(mlds_to_c_opts,
|
|
mlds_class_decl_flags) = string.
|
|
|
|
class_decl_flags_to_prefix_for_c(Opts, Flags) = FlagsPrefix :-
|
|
% DeclOrDefn does not affect what we output. Callers who pass us
|
|
% DeclOrDefn = forward_decl will put a semicolon after the declaration;
|
|
% callers who pass us DeclOrDefn = definition will put the definition
|
|
% itself there.
|
|
Flags = mlds_class_decl_flags(Access, Overridability, Constness),
|
|
ConstnessPrefix = constness_prefix_for_c(Constness),
|
|
Comments = Opts ^ m2co_auto_comments,
|
|
(
|
|
Comments = yes,
|
|
(
|
|
Access = class_public,
|
|
(
|
|
Overridability = overridable,
|
|
FlagsPrefix = "/* public one_copy */ " ++ ConstnessPrefix
|
|
;
|
|
Overridability = sealed,
|
|
FlagsPrefix = "/* public one_copy sealed */ " ++
|
|
ConstnessPrefix
|
|
)
|
|
;
|
|
Access = class_private,
|
|
(
|
|
Overridability = overridable,
|
|
FlagsPrefix = "/* private one_copy */ " ++ ConstnessPrefix
|
|
;
|
|
Overridability = sealed,
|
|
FlagsPrefix = "/* private one_copy sealed */ " ++
|
|
ConstnessPrefix
|
|
)
|
|
)
|
|
;
|
|
Comments = no,
|
|
FlagsPrefix = ConstnessPrefix
|
|
).
|
|
|
|
:- func env_decl_flags_to_prefix_for_c(mlds_to_c_opts) = string.
|
|
|
|
env_decl_flags_to_prefix_for_c(Opts) = FlagsPrefix :-
|
|
% DeclOrDefn does not affect what we output. Callers who pass us
|
|
% DeclOrDefn = forward_decl will put a semicolon after the declaration;
|
|
% callers who pass us DeclOrDefn = definition will put the definition
|
|
% itself there.
|
|
Comments = Opts ^ m2co_auto_comments,
|
|
(
|
|
Comments = yes,
|
|
FlagsPrefix = "/* private one_copy */ "
|
|
;
|
|
Comments = no,
|
|
FlagsPrefix = ""
|
|
).
|
|
|
|
:- func struct_decl_flags_to_prefix_for_c(mlds_to_c_opts) = string.
|
|
|
|
struct_decl_flags_to_prefix_for_c(Opts) = FlagsPrefix :-
|
|
% DeclOrDefn does not affect what we output. Callers who pass us
|
|
% DeclOrDefn = forward_decl will put a semicolon after the declaration;
|
|
% callers who pass us DeclOrDefn = definition will put the definition
|
|
% itself there.
|
|
Comments = Opts ^ m2co_auto_comments,
|
|
(
|
|
Comments = yes,
|
|
FlagsPrefix = "/* private one_copy sealed */ "
|
|
;
|
|
Comments = no,
|
|
FlagsPrefix = ""
|
|
).
|
|
|
|
:- func field_var_decl_flags_to_prefix_for_c(mlds_to_c_opts, decl_or_defn,
|
|
mlds_field_var_decl_flags) = string.
|
|
|
|
field_var_decl_flags_to_prefix_for_c(Opts, DeclOrDefn, Flags) = FlagsPrefix :-
|
|
Flags = mlds_field_var_decl_flags(PerInstance, Constness),
|
|
ConstnessPrefix = constness_prefix_for_c(Constness),
|
|
Comments = Opts ^ m2co_auto_comments,
|
|
(
|
|
DeclOrDefn = forward_decl,
|
|
FlagsPrefix0 = "extern " ++ ConstnessPrefix
|
|
;
|
|
DeclOrDefn = definition,
|
|
FlagsPrefix0 = ConstnessPrefix
|
|
),
|
|
(
|
|
Comments = yes,
|
|
(
|
|
PerInstance = per_instance,
|
|
FlagsPrefix = FlagsPrefix0
|
|
;
|
|
PerInstance = one_copy,
|
|
FlagsPrefix = "/* one_copy */ " ++ FlagsPrefix0
|
|
)
|
|
;
|
|
Comments = no,
|
|
FlagsPrefix = FlagsPrefix0
|
|
).
|
|
|
|
:- func constness_prefix_for_c(constness) = string.
|
|
:- pragma inline(func(constness_prefix_for_c/1)).
|
|
|
|
constness_prefix_for_c(const) = "const ".
|
|
constness_prefix_for_c(modifiable) = "".
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module ml_backend.mlds_to_c_class.
|
|
%---------------------------------------------------------------------------%
|