mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 09:23:44 +00:00
291879c8bb
This allows to perform those checks for *all* foreign_procs,
not just the ones that get added to the HLDS.
compiler/add_foreign_proc.m:
Move the code that checks the bodies of foreign_procs for the
presence of type_info variables for existentially quantified
type variables here from typecheck.m and typecheck_errors.m.
Change the diagnostic's wording to match our new phraseology.
Record identifiers in a set, not a list, for faster membership tests,
since we now do even more of them.
compiler/foreign.m:
Provide a mechanism to return the identifiers not just in the
non-comment parts of foreign_procs, but the comment parts as well,
since add_foreign_proc.m now needs this functionality.
compiler/make_hlds_warn.m:
Conform to the change in foreign.m.
compiler/typecheck.m:
compiler/typecheck_errors.m:
Delete the code that was moved (in a modified form)
to add_foreign_proc.m.
compiler/ml_foreign_proc_gen.m:
Update a reference in a comment.
tests/invalid/exist_foreign_error.err_exp:
Expect the updated wording of the affected diagnostics,
and expect diagnostics for *all* the foreign_procs in the test,
regardless of which language they are for.
tests/invalid/exist_foreign_error.err_exp2:
tests/invalid/exist_foreign_error.err_exp3:
Delete these files, since the output they expect is now
in the .err_exp file.
tests/invalid/fp_dup_bug.err_exp2:
tests/invalid/fp_dup_bug.err_exp3:
tests/invalid/gh72_errors.err_exp2:
tests/invalid/gh72_errors.err_exp3:
Expect the updated wording of diagnostics affected by previous
changes (which updated the .err_exp files for C, not these for
Java and C#).
713 lines
25 KiB
Mathematica
713 lines
25 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 2000-2011 The University of Melbourne.
|
|
% Copyright (C) 2013-2026 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: foreign.m.
|
|
% Main authors: trd, dgj.
|
|
%
|
|
% This module defines predicates for interfacing with foreign languages.
|
|
% In particular, this module supports interfacing with languages
|
|
% other than the target of compilation.
|
|
%
|
|
% Parts of this code were originally written by dgj, and have since been moved
|
|
% here.
|
|
%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- module backend_libs.foreign.
|
|
:- interface.
|
|
|
|
:- import_module hlds.
|
|
:- import_module hlds.hlds_data.
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module libs.
|
|
:- import_module libs.globals.
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.sym_name.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.prog_foreign.
|
|
|
|
:- import_module bool.
|
|
:- import_module list.
|
|
:- import_module maybe.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- type foreign_type_and_assertions
|
|
---> foreign_type_and_assertions(sym_name, foreign_type_assertions).
|
|
% A type defined by a pragma foreign_type, and the assertions
|
|
% on that foreign_type.
|
|
|
|
% Given an arbitrary mercury type, get the exported_type representation
|
|
% of that type on the current backend.
|
|
%
|
|
:- func is_this_a_foreign_type(module_info, mer_type)
|
|
= maybe(foreign_type_and_assertions).
|
|
|
|
% Given a type, determine the string which corresponds to that type
|
|
% in the specified foreign language, for use with foreign language
|
|
% interfacing (`pragma export' or `pragma foreign_proc').
|
|
%
|
|
:- func exported_type_to_string(module_info, foreign_language, mer_type)
|
|
= string.
|
|
:- func exported_type_to_c_string(module_info, mer_type) = string.
|
|
|
|
:- func maybe_foreign_type_to_string(foreign_language, mer_type,
|
|
maybe(foreign_type_and_assertions)) = string.
|
|
:- func maybe_foreign_type_to_c_string(mer_type,
|
|
maybe(foreign_type_and_assertions)) = string.
|
|
:- func foreign_type_to_c_string(foreign_type_and_assertions) = string.
|
|
:- func maybe_foreign_type_to_csharp_string(mer_type,
|
|
maybe(foreign_type_and_assertions)) = string.
|
|
:- func maybe_foreign_type_to_java_string(mer_type,
|
|
maybe(foreign_type_and_assertions)) = string.
|
|
|
|
:- func exported_builtin_type_to_c_string(builtin_type) = string.
|
|
:- func exported_builtin_type_to_csharp_string(builtin_type) = string.
|
|
:- func exported_builtin_type_to_java_string(builtin_type) = string.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% Find the current target backend from the module_info, and given
|
|
% a foreign_type_body, return the name of the foreign language type
|
|
% the identity of any user-defined unify/compare predicates, and the
|
|
% assertions applicable to that backend.
|
|
%
|
|
:- pred foreign_type_body_to_exported_type(module_info::in,
|
|
foreign_type_body::in, sym_name::out, maybe_canonical::out,
|
|
foreign_type_assertions::out) is det.
|
|
|
|
% Does the foreign_type_body contain a definition usable
|
|
% when compiling to the given target.
|
|
%
|
|
:- pred have_foreign_type_for_backend(compilation_target::in,
|
|
foreign_type_body::in, bool::out) is det.
|
|
|
|
% Does the implementation of the given foreign type body on
|
|
% the current backend use a user-defined comparison predicate.
|
|
%
|
|
:- pred foreign_type_body_has_user_defined_eq_comp_pred(module_info::in,
|
|
foreign_type_body::in, noncanonical::out) is semidet.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% Filter the decls for the given foreign language.
|
|
% The first return value is the list of matches, the second is
|
|
% the list of mis-matches.
|
|
%
|
|
:- pred filter_decls(foreign_language::in, list(foreign_decl_code)::in,
|
|
list(foreign_decl_code)::out, list(foreign_decl_code)::out) is det.
|
|
|
|
% Filter the bodys for the given foreign language.
|
|
% The first return value is the list of matches, the second is
|
|
% the list of mis-matches.
|
|
%
|
|
:- pred filter_bodys(foreign_language::in, list(foreign_body_code)::in,
|
|
list(foreign_body_code)::out, list(foreign_body_code)::out) is det.
|
|
|
|
% Filter the foreign exports for the given foreign language.
|
|
% The first return value is the list of matches, the second is
|
|
% the list of mis-matches.
|
|
%
|
|
:- pred filter_exports(foreign_language::in,
|
|
list(pragma_exported_proc)::in,
|
|
list(pragma_exported_proc)::out, list(pragma_exported_proc)::out)
|
|
is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% foreign_code_to_identifiers(Lang, Code, Identifiers, Comments):
|
|
%
|
|
% Break up Code into words that meet the rules for identifiers.
|
|
% Some of these may actually be language keywords.
|
|
%
|
|
:- pred foreign_code_to_identifiers(foreign_language::in, string::in,
|
|
list(string)::out, list(string)::out) is det.
|
|
|
|
% comments_to_identifiers(Comments, Identifiers):
|
|
%
|
|
% Given a list of comment strings, break them up into words
|
|
% that meet the rules for identifiers.
|
|
%
|
|
:- pred comments_to_identifiers(list(string)::in, list(string)::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% The name of the #define which can be used to guard declarations with
|
|
% to prevent entities being declared twice.
|
|
%
|
|
:- func decl_guard(sym_name) = string.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module mdbcomp.prim_data.
|
|
:- import_module parse_tree.prog_data_foreign.
|
|
:- import_module parse_tree.prog_type.
|
|
|
|
:- import_module char.
|
|
:- import_module cord.
|
|
:- import_module require.
|
|
:- import_module string.
|
|
:- import_module term.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
is_this_a_foreign_type(ModuleInfo, Type) = MaybeForeignTypeAssertions :-
|
|
module_info_get_type_table(ModuleInfo, TypeTable),
|
|
( if
|
|
type_to_ctor(Type, TypeCtor),
|
|
search_type_ctor_defn(TypeTable, TypeCtor, TypeDefn)
|
|
then
|
|
hlds_data.get_type_defn_body(TypeDefn, TypeBody),
|
|
(
|
|
TypeBody = hlds_foreign_type(ForeignTypeBody),
|
|
foreign_type_body_to_exported_type(ModuleInfo, ForeignTypeBody,
|
|
ForeignTypeName, _, Assertions),
|
|
MaybeForeignTypeAssertions =
|
|
yes(foreign_type_and_assertions(ForeignTypeName, Assertions))
|
|
;
|
|
( TypeBody = hlds_du_type(_)
|
|
; TypeBody = hlds_eqv_type(_)
|
|
; TypeBody = hlds_solver_type(_)
|
|
; TypeBody = hlds_abstract_type(_)
|
|
),
|
|
MaybeForeignTypeAssertions = no
|
|
)
|
|
else
|
|
MaybeForeignTypeAssertions = no
|
|
).
|
|
|
|
exported_type_to_string(ModuleInfo, Lang, Type) = String :-
|
|
MaybeForeignType = is_this_a_foreign_type(ModuleInfo, Type),
|
|
String = maybe_foreign_type_to_string(Lang, Type, MaybeForeignType).
|
|
|
|
exported_type_to_c_string(ModuleInfo, Type) = String :-
|
|
MaybeForeignType = is_this_a_foreign_type(ModuleInfo, Type),
|
|
String = maybe_foreign_type_to_c_string(Type, MaybeForeignType).
|
|
|
|
maybe_foreign_type_to_string(Lang, Type, MaybeForeignType) = String :-
|
|
(
|
|
Lang = lang_c,
|
|
String = maybe_foreign_type_to_c_string(Type, MaybeForeignType)
|
|
;
|
|
Lang = lang_csharp,
|
|
String = maybe_foreign_type_to_csharp_string(Type, MaybeForeignType)
|
|
;
|
|
Lang = lang_java,
|
|
String = maybe_foreign_type_to_java_string(Type, MaybeForeignType)
|
|
).
|
|
|
|
maybe_foreign_type_to_c_string(Type, MaybeForeignType) = String :-
|
|
(
|
|
MaybeForeignType = yes(ForeignTypeAndAssertions),
|
|
String = foreign_type_to_c_string(ForeignTypeAndAssertions)
|
|
;
|
|
MaybeForeignType = no,
|
|
% With --high-level-code, the value we return here should agree
|
|
% with what happens is generated (indirectly) through
|
|
% mercury_type_to_mlds_type.
|
|
%
|
|
% XXX I don't think this is yet true in all cases. -zs
|
|
%
|
|
% It is possible that in some cases, the right type name may depend
|
|
% on whether --high-level-code is set.
|
|
(
|
|
Type = builtin_type(BuiltinType),
|
|
String = exported_builtin_type_to_c_string(BuiltinType)
|
|
;
|
|
Type = tuple_type(_, _),
|
|
String = "MR_Tuple"
|
|
;
|
|
% XXX Is MR_Word the right thing for any of these kinds of
|
|
% types for high level code, with or without high level data?
|
|
( Type = defined_type(_, _, _)
|
|
; Type = higher_order_type(_, _, _, _)
|
|
; Type = apply_n_type(_, _, _)
|
|
),
|
|
String = "MR_Word"
|
|
;
|
|
Type = type_variable(_, _),
|
|
String = "MR_Word"
|
|
;
|
|
Type = kinded_type(_, _),
|
|
unexpected($pred, "kinded type")
|
|
)
|
|
).
|
|
|
|
foreign_type_to_c_string(ForeignTypeAndAssertions) = String :-
|
|
ForeignTypeAndAssertions = foreign_type_and_assertions(ForeignType, _),
|
|
(
|
|
ForeignType = unqualified(String)
|
|
;
|
|
ForeignType = qualified(_, _),
|
|
unexpected($pred, "qualified C type")
|
|
).
|
|
|
|
maybe_foreign_type_to_csharp_string(Type, MaybeForeignType) = String :-
|
|
(
|
|
MaybeForeignType = yes(foreign_type_and_assertions(ForeignType, _)),
|
|
String = sym_name_to_string(ForeignType)
|
|
;
|
|
MaybeForeignType = no,
|
|
(
|
|
Type = builtin_type(BuiltinType),
|
|
String = exported_builtin_type_to_csharp_string(BuiltinType)
|
|
;
|
|
( Type = tuple_type(_, _)
|
|
; Type = defined_type(_, _, _)
|
|
; Type = higher_order_type(_, _, _, _)
|
|
; Type = apply_n_type(_, _, _)
|
|
; Type = type_variable(_, _)
|
|
; Type = kinded_type(_, _)
|
|
),
|
|
% This is here so we can share some code between C/C#/Java
|
|
% backends. This is not the correct type to use in general.
|
|
String = "object"
|
|
)
|
|
).
|
|
|
|
maybe_foreign_type_to_java_string(Type, MaybeForeignType) = String :-
|
|
(
|
|
MaybeForeignType = yes(foreign_type_and_assertions(ForeignType, _)),
|
|
String = sym_name_to_string(ForeignType)
|
|
;
|
|
MaybeForeignType = no,
|
|
(
|
|
Type = builtin_type(BuiltinType),
|
|
String = exported_builtin_type_to_java_string(BuiltinType)
|
|
;
|
|
( Type = tuple_type(_, _)
|
|
; Type = defined_type(_, _, _)
|
|
; Type = higher_order_type(_, _, _, _)
|
|
; Type = apply_n_type(_, _, _)
|
|
; Type = type_variable(_, _)
|
|
; Type = kinded_type(_, _)
|
|
),
|
|
% This is here so we can share some code between C/C#/Java
|
|
% backends. This is not the correct type to use in general.
|
|
String = "java.lang.Object"
|
|
)
|
|
).
|
|
|
|
exported_builtin_type_to_c_string(BuiltinType) = CTypeName :-
|
|
(
|
|
BuiltinType = builtin_type_int(IntType),
|
|
(
|
|
IntType = int_type_int,
|
|
CTypeName = "MR_Integer"
|
|
;
|
|
IntType = int_type_uint,
|
|
CTypeName = "MR_Unsigned"
|
|
;
|
|
IntType = int_type_int8,
|
|
CTypeName = "int8_t"
|
|
;
|
|
IntType = int_type_uint8,
|
|
CTypeName = "uint8_t"
|
|
;
|
|
IntType = int_type_int16,
|
|
CTypeName = "int16_t"
|
|
;
|
|
IntType = int_type_uint16,
|
|
CTypeName = "uint16_t"
|
|
;
|
|
IntType = int_type_int32,
|
|
CTypeName = "int32_t"
|
|
;
|
|
IntType = int_type_uint32,
|
|
CTypeName = "uint32_t"
|
|
;
|
|
IntType = int_type_int64,
|
|
CTypeName = "int64_t"
|
|
;
|
|
IntType = int_type_uint64,
|
|
CTypeName = "uint64_t"
|
|
)
|
|
;
|
|
BuiltinType = builtin_type_float,
|
|
CTypeName = "MR_Float"
|
|
;
|
|
BuiltinType = builtin_type_string,
|
|
CTypeName = "MR_String"
|
|
;
|
|
BuiltinType = builtin_type_char,
|
|
CTypeName = "MR_Char"
|
|
).
|
|
|
|
exported_builtin_type_to_csharp_string(BuiltinType) = CsharpTypeName :-
|
|
(
|
|
BuiltinType = builtin_type_int(IntType),
|
|
(
|
|
IntType = int_type_int,
|
|
CsharpTypeName = "int"
|
|
;
|
|
IntType = int_type_uint,
|
|
CsharpTypeName = "uint"
|
|
;
|
|
IntType = int_type_int8,
|
|
CsharpTypeName = "sbyte"
|
|
;
|
|
IntType = int_type_uint8,
|
|
CsharpTypeName = "byte"
|
|
;
|
|
IntType = int_type_int16,
|
|
CsharpTypeName = "short"
|
|
;
|
|
IntType = int_type_uint16,
|
|
CsharpTypeName = "ushort"
|
|
;
|
|
IntType = int_type_int32,
|
|
CsharpTypeName = "int"
|
|
;
|
|
IntType = int_type_uint32,
|
|
CsharpTypeName = "uint"
|
|
;
|
|
IntType = int_type_int64,
|
|
CsharpTypeName = "long"
|
|
;
|
|
IntType = int_type_uint64,
|
|
CsharpTypeName = "ulong"
|
|
)
|
|
;
|
|
BuiltinType = builtin_type_float,
|
|
CsharpTypeName = "double"
|
|
;
|
|
BuiltinType = builtin_type_string,
|
|
CsharpTypeName = "string"
|
|
;
|
|
BuiltinType = builtin_type_char,
|
|
CsharpTypeName = "char"
|
|
).
|
|
|
|
exported_builtin_type_to_java_string(BuiltinType) = JavaTypeName :-
|
|
(
|
|
BuiltinType = builtin_type_int(IntType),
|
|
(
|
|
IntType = int_type_int,
|
|
JavaTypeName = "int"
|
|
;
|
|
IntType = int_type_uint,
|
|
JavaTypeName = "int"
|
|
;
|
|
IntType= int_type_int8,
|
|
JavaTypeName = "byte"
|
|
;
|
|
IntType = int_type_uint8,
|
|
JavaTypeName = "byte"
|
|
;
|
|
IntType = int_type_int16,
|
|
JavaTypeName = "short"
|
|
;
|
|
IntType = int_type_uint16,
|
|
JavaTypeName = "short"
|
|
;
|
|
IntType = int_type_int32,
|
|
JavaTypeName = "int"
|
|
;
|
|
IntType = int_type_uint32,
|
|
JavaTypeName = "int"
|
|
;
|
|
IntType = int_type_int64,
|
|
JavaTypeName = "long"
|
|
;
|
|
IntType = int_type_uint64,
|
|
JavaTypeName = "long"
|
|
)
|
|
;
|
|
BuiltinType = builtin_type_float,
|
|
JavaTypeName = "double"
|
|
;
|
|
BuiltinType = builtin_type_string,
|
|
JavaTypeName = "java.lang.String"
|
|
;
|
|
BuiltinType = builtin_type_char,
|
|
JavaTypeName = "char"
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
foreign_type_body_to_exported_type(ModuleInfo, ForeignTypeBody, Name,
|
|
MaybeUserEqComp, Assertions) :-
|
|
% The body of this function is very similar to the function
|
|
% foreign_type_to_mlds_type in mlds.m.
|
|
% Any changes here may require changes there as well.
|
|
|
|
ForeignTypeBody = foreign_type_body(MaybeC, MaybeJava, MaybeCSharp),
|
|
module_info_get_globals(ModuleInfo, Globals),
|
|
globals.get_target(Globals, Target),
|
|
(
|
|
Target = target_c,
|
|
(
|
|
MaybeC = yes(Data),
|
|
Data = type_details_foreign(c_type(NameStr), MaybeUserEqComp,
|
|
Assertions),
|
|
Name = unqualified(NameStr)
|
|
;
|
|
MaybeC = no,
|
|
unexpected($pred, "no C type")
|
|
)
|
|
;
|
|
Target = target_csharp,
|
|
(
|
|
MaybeCSharp = yes(Data),
|
|
Data = type_details_foreign(csharp_type(NameStr),
|
|
MaybeUserEqComp, Assertions),
|
|
Name = unqualified(NameStr)
|
|
;
|
|
MaybeCSharp = no,
|
|
unexpected($pred, "no C# type")
|
|
)
|
|
;
|
|
Target = target_java,
|
|
(
|
|
MaybeJava = yes(Data),
|
|
Data = type_details_foreign(java_type(NameStr), MaybeUserEqComp,
|
|
Assertions),
|
|
Name = unqualified(NameStr)
|
|
;
|
|
MaybeJava = no,
|
|
unexpected($pred, "no Java type")
|
|
)
|
|
).
|
|
|
|
have_foreign_type_for_backend(Target, ForeignTypeBody, Have) :-
|
|
(
|
|
Target = target_c,
|
|
Have = ( if ForeignTypeBody ^ c = yes(_) then yes else no )
|
|
;
|
|
Target = target_java,
|
|
Have = ( if ForeignTypeBody ^ java = yes(_) then yes else no )
|
|
;
|
|
Target = target_csharp,
|
|
Have = ( if ForeignTypeBody ^ csharp = yes(_) then yes else no )
|
|
).
|
|
|
|
foreign_type_body_has_user_defined_eq_comp_pred(ModuleInfo, Body,
|
|
NonCanonical) :-
|
|
foreign_type_body_to_exported_type(ModuleInfo, Body, _,
|
|
MaybeCanonical, _),
|
|
MaybeCanonical = noncanon(NonCanonical).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
filter_decls(WantedLang, Decls0, LangDecls, NotLangDecls) :-
|
|
IsWanted =
|
|
( pred(foreign_decl_code(Lang, _, _, _)::in) is semidet :-
|
|
WantedLang = Lang
|
|
),
|
|
list.filter(IsWanted, Decls0, LangDecls, NotLangDecls).
|
|
|
|
filter_bodys(WantedLang, Bodys0, LangBodys, NotLangBodys) :-
|
|
IsWanted =
|
|
( pred(foreign_body_code(Lang, _, _)::in) is semidet :-
|
|
WantedLang = Lang
|
|
),
|
|
list.filter(IsWanted, Bodys0, LangBodys, NotLangBodys).
|
|
|
|
filter_exports(WantedLang, Exports0, LangExports, NotLangExports) :-
|
|
IsWanted =
|
|
( pred(pragma_exported_proc(Lang, _, _, _, _)::in) is semidet :-
|
|
WantedLang = Lang
|
|
),
|
|
list.filter(IsWanted, Exports0, LangExports, NotLangExports).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
foreign_code_to_identifiers(Lang, Code, Identifiers, CommentStrs) :-
|
|
string.to_char_list(Code, Chars),
|
|
% This one arm switch ensures that we will get a warning
|
|
% if and when we add another target language (which may have
|
|
% different rules for what is a comment).
|
|
(
|
|
( Lang = lang_c
|
|
; Lang = lang_java
|
|
; Lang = lang_csharp
|
|
),
|
|
% We use cords to ensure tail recursion in the loop over Code,
|
|
% because it may be big. We do not do try to ensure tail recursion
|
|
% for loops over identifiers, since (for cultural reasons)
|
|
% they will effectively never be long enough for this to be a problem.
|
|
foreign_code_to_c_j_cs_identifiers_loop(Chars,
|
|
cord.init, IdentifierCord, cord.init, CommentStrCord),
|
|
Identifiers = cord.list(IdentifierCord),
|
|
CommentStrs = cord.list(CommentStrCord)
|
|
).
|
|
|
|
:- pred foreign_code_to_c_j_cs_identifiers_loop(list(char)::in,
|
|
cord(string)::in, cord(string)::out,
|
|
cord(string)::in, cord(string)::out) is det.
|
|
|
|
foreign_code_to_c_j_cs_identifiers_loop(Chars0,
|
|
!IdentifierCord, !CommentStrCord) :-
|
|
get_next_c_j_cs_identifier(Chars0, IdentifierChars, Chars1,
|
|
!CommentStrCord),
|
|
(
|
|
IdentifierChars = []
|
|
% There are no identifiers left.
|
|
;
|
|
IdentifierChars = [_ | _],
|
|
string.from_char_list(IdentifierChars, Identifier),
|
|
cord.snoc(Identifier, !IdentifierCord),
|
|
foreign_code_to_c_j_cs_identifiers_loop(Chars1,
|
|
!IdentifierCord, !CommentStrCord)
|
|
).
|
|
|
|
:- pred get_next_c_j_cs_identifier(list(char)::in,
|
|
list(char)::out, list(char)::out,
|
|
cord(string)::in, cord(string)::out) is det.
|
|
|
|
get_next_c_j_cs_identifier([], [], [], !CommentStrCord).
|
|
get_next_c_j_cs_identifier([Char0 | Chars0], IdentifierChars, LeftOverChars,
|
|
!CommentStrCord) :-
|
|
( if char.is_alnum_or_underscore(Char0) then
|
|
get_rest_of_identifier(Chars0, TailIdentifierChars, LeftOverChars),
|
|
IdentifierChars = [Char0 | TailIdentifierChars]
|
|
else if Char0 = ('/') then
|
|
(
|
|
Chars0 = [],
|
|
IdentifierChars = [],
|
|
LeftOverChars = []
|
|
;
|
|
Chars0 = [Char1 | Chars1],
|
|
( if
|
|
(
|
|
Char1 = ('/'),
|
|
ignore_rest_of_line(Chars1, Chars2,
|
|
cord.init, CommentCharCord)
|
|
;
|
|
Char1 = ('*'),
|
|
ignore_rest_of_slash_star_comment(Chars1, Chars2,
|
|
cord.init, CommentCharCord)
|
|
)
|
|
then
|
|
CommentChars = cord.list(CommentCharCord),
|
|
CommentStr = string.from_char_list(CommentChars),
|
|
cord.snoc(CommentStr, !CommentStrCord),
|
|
get_next_c_j_cs_identifier(Chars2,
|
|
IdentifierChars, LeftOverChars, !CommentStrCord)
|
|
else
|
|
% Ignore Char0, since it does not start a comment, and
|
|
% cannot be part of an identifier.
|
|
get_next_c_j_cs_identifier(Chars0,
|
|
IdentifierChars, LeftOverChars, !CommentStrCord)
|
|
)
|
|
)
|
|
else
|
|
% Ignore Char0, since it does not start a comment, and
|
|
% cannot be part of an identifier.
|
|
get_next_c_j_cs_identifier(Chars0, IdentifierChars, LeftOverChars,
|
|
!CommentStrCord)
|
|
).
|
|
|
|
:- pred ignore_rest_of_slash_star_comment(list(char)::in,
|
|
list(char)::out, cord(char)::in, cord(char)::out) is det.
|
|
|
|
ignore_rest_of_slash_star_comment([], [], !CommentCharCord).
|
|
ignore_rest_of_slash_star_comment([Char0 | Chars0], LeftOverChars,
|
|
!CommentCharCord) :-
|
|
( if
|
|
Char0 = ('*'),
|
|
Chars0 = [Char1 | Chars1],
|
|
Char1 = ('/')
|
|
then
|
|
LeftOverChars = Chars1
|
|
else
|
|
cord.snoc(Char0, !CommentCharCord),
|
|
ignore_rest_of_slash_star_comment(Chars0, LeftOverChars,
|
|
!CommentCharCord)
|
|
).
|
|
|
|
:- pred ignore_rest_of_line(list(char)::in,
|
|
list(char)::out, cord(char)::in, cord(char)::out) is det.
|
|
|
|
ignore_rest_of_line([], [], !CommentCharCord).
|
|
ignore_rest_of_line([Char0 | Chars0], LeftOverChars, !CommentCharCord) :-
|
|
( if Char0 = ('\n') then
|
|
LeftOverChars = Chars0
|
|
else
|
|
cord.snoc(Char0, !CommentCharCord),
|
|
ignore_rest_of_line(Chars0, LeftOverChars, !CommentCharCord)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
comments_to_identifiers(Comments, Identifiers) :-
|
|
list.foldl(acc_identifiers_in_comment, Comments,
|
|
cord.init, IdentifierCord),
|
|
Identifiers = cord.list(IdentifierCord).
|
|
|
|
:- pred acc_identifiers_in_comment(string::in,
|
|
cord(string)::in, cord(string)::out) is det.
|
|
|
|
acc_identifiers_in_comment(Comment, !IdentifierCord) :-
|
|
string.to_char_list(Comment, Chars),
|
|
% We use cords to ensure tail recursion in the loop over Code,
|
|
% because it may be big. We do not do try to ensure tail recursion
|
|
% for loops over identifiers, since (for cultural reasons)
|
|
% they will effectively never be long enough for this to be a problem.
|
|
comment_to_identifiers_loop(Chars, !IdentifierCord).
|
|
|
|
:- pred comment_to_identifiers_loop(list(char)::in,
|
|
cord(string)::in, cord(string)::out) is det.
|
|
|
|
comment_to_identifiers_loop(Chars0, !IdentifierCord) :-
|
|
get_next_identifier(Chars0, IdentifierChars, Chars1),
|
|
(
|
|
IdentifierChars = []
|
|
% There are no identifiers left.
|
|
;
|
|
IdentifierChars = [_ | _],
|
|
string.from_char_list(IdentifierChars, Identifier),
|
|
cord.snoc(Identifier, !IdentifierCord),
|
|
comment_to_identifiers_loop(Chars1, !IdentifierCord)
|
|
).
|
|
|
|
:- pred get_next_identifier(list(char)::in,
|
|
list(char)::out, list(char)::out) is det.
|
|
|
|
get_next_identifier([], [], []).
|
|
get_next_identifier([Char0 | Chars0], IdentifierChars, LeftOverChars) :-
|
|
( if char.is_alnum_or_underscore(Char0) then
|
|
get_rest_of_identifier(Chars0, TailIdentifierChars, LeftOverChars),
|
|
IdentifierChars = [Char0 | TailIdentifierChars]
|
|
else
|
|
% Ignore Char0, since it cannot be part of an identifier.
|
|
get_next_identifier(Chars0, IdentifierChars, LeftOverChars)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pred get_rest_of_identifier(list(char)::in, list(char)::out,
|
|
list(char)::out) is det.
|
|
|
|
get_rest_of_identifier([], [], []).
|
|
get_rest_of_identifier([Char0 | Chars0], IdentifierChars, LeftOverChars) :-
|
|
( if char.is_alnum_or_underscore(Char0) then
|
|
% There may be more characters in the identifier.
|
|
get_rest_of_identifier(Chars0, TailIdentifierChars, LeftOverChars),
|
|
IdentifierChars = [Char0 | TailIdentifierChars]
|
|
else
|
|
% The word is finished.
|
|
IdentifierChars = [],
|
|
LeftOverChars = Chars0
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
decl_guard(ModuleName) = UppercaseModuleName ++ "_DECL_GUARD" :-
|
|
MangledModuleName = sym_name_mangle(ModuleName),
|
|
string.to_upper(MangledModuleName, UppercaseModuleName).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module backend_libs.foreign.
|
|
%---------------------------------------------------------------------------%
|