[m-rev.] for review: foreign enumerations
Peter Wang
wangp at students.csse.unimelb.edu.au
Mon Aug 13 16:22:50 AEST 2007
On 2007-08-09, Julien Fischer <juliensf at csse.unimelb.edu.au> wrote:
>
> The changes to RTTI and tabling are for review by Zoltan.
> The rest is for review by anyone.
>
> Estimated hours taken: 50
> Branches: main
>
> Add support for foreign enumerations to Mercury. These allow the
> programmer to assign foreign language values as the representation of
> enumeration constructors.
>
> e.g.
> :- type status
> ---> optimal
> ; infeasible
> ; unbounded
> ; unknown.
>
> :- pragma foreign_enum("C", status/0, [
> optimal - "STATUS_OPTIMAL",
> infeasible - "STATUS_INFEASIBLE",
> unbounded - "STATUS_UNBOUNDED",
> unknown - "STATUS_UNKNOWN"
> ]).
Funny spacing there.
>
> The advantage of this is that when values of type status/0 are passed to
> foreign code (C in this case) no translation is necessary. This should
> simplify the task of writing bindings to foreign language libraries.
>
> Unification and comparison for foreign enumerations are the usual
> unification and comparison for enumeration types, except that the default
> ordering on them is determined by the foreign representation of the
> constructors. User-defined equality and comparison work also work.
> on foreign enumeration types.
... comparison work also work. on foreign ...
>
> Index: NEWS
> ===================================================================
> RCS file: /home/mercury/mercury1/repository/mercury/NEWS,v
> retrieving revision 1.474
> diff -u -r1.474 NEWS
> --- NEWS 3 Aug 2007 05:18:37 -0000 1.474
> +++ NEWS 9 Aug 2007 08:26:44 -0000
> @@ -3,8 +3,10 @@
>
> Changes to the Mercury language:
>
> +* A new pragma, foreign_enum, allows the constructors of Mercury +
> enumeration types to be assigned values from foreign language code.
> * A new pragma, foreign_export_enum, allows the constructors of Mercury
> - enumeration types, to be referred to in foreign language code.
> + enumeration types to be referred to in foreign language code.
> * Some of the restrictions on typeclass instances have been relaxed,
> allowing
> support for polymorphic instances with functional dependencies.
> * We now support trace goals, which can be used to print progress messages
> or
> @@ -243,6 +245,27 @@
>
> Changes to the Mercury language:
>
> +* The new pragma, foreign_enum, can be used to establish a + mapping
> between values in a foreign language and the constructors
> + of a Mercury enumeration type. This can be useful when writing
> + Mercury bindings to foreign code libraries.
> +
> + For example, +
> + :- type matrix_mode
> + ---> texture
> + ; modelview
> + ; projection.
> +
> + :- pragma foreign_enum("C", matrix_mode/0, [
> + texture - "GL_TEXTURE" + modelview - "GL_MODELVIEW"
> + projection - "GL_PROJECTION"
> + ]).
> + + When passed to C foreign clauses values of type matrix_mode/0 will have
> + the corresponding C value specified by the foreign_enum pragma.
Add a comma after "C foreign clauses".
> Index: compiler/add_pragma.m
> ===================================================================
> RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_pragma.m,v
> retrieving revision 1.68
> diff -u -r1.68 add_pragma.m
> --- compiler/add_pragma.m 1 Aug 2007 07:23:28 -0000 1.68
> +++ compiler/add_pragma.m 9 Aug 2007 08:26:44 -0000
...
> @@ -945,6 +952,325 @@
>
>
> %-----------------------------------------------------------------------------%
>
> +add_pragma_foreign_enum(Lang, TypeName, TypeArity, ForeignTagValues,
> + ImportStatus, Context, !ModuleInfo, !Specs) :-
> + TypeCtor = type_ctor(TypeName, TypeArity),
> + module_info_get_type_table(!.ModuleInfo, TypeTable0),
> + ContextPieces = [
> + words("In"), fixed("`pragma foreign_enum'"),
> + words("declaration for"),
> + sym_name_and_arity(TypeName / TypeArity), suffix(":"), nl
> + ],
> + ( + % Emit an error message for foreign_enum pragmas for the
> + % builtin atomic types.
> + TypeArity = 0,
> + ( TypeName = unqualified("character")
> + ; TypeName = unqualified("float")
> + ; TypeName = unqualified("int")
> + ; TypeName = unqualified("string")
> + )
> + ->
> + MaybeSeverity = yes(severity_error),
> + ErrorPieces = [
> + words("error: "),
> + sym_name_and_arity(TypeName / TypeArity),
> + words("is an atomic type"),
> + suffix(".")
> + ]
> + ; map.search(TypeTable0, TypeCtor, TypeDefn0) ->
> + get_type_defn_body(TypeDefn0, TypeBody0),
> + (
> + ( TypeBody0 = hlds_eqv_type(_)
> + ; TypeBody0 = hlds_abstract_type(_)
> + ; TypeBody0 = hlds_solver_type(_, _)
> + ; TypeBody0 = hlds_foreign_type(_)
> + ),
> + MaybeSeverity = yes(severity_error),
> + ErrorPieces = [
> + words("error: "),
> + sym_name_and_arity(TypeName / TypeArity),
> + words("is not an enumeration type"),
> + suffix(".")
> + ]
> + ;
> + TypeBody0 = hlds_du_type(Ctors, OldTagValues, IsEnumOrDummy0,
> + MaybeUserEq, ReservedTag, IsForeignType),
> + %
> + % Work out what language's foreign_enum pragma we should be
> + % looking at for the the current compilation target language.
> + %
> + module_info_get_globals(!.ModuleInfo, Globals),
> + globals.get_target(Globals, TargetLanguage),
> + LangForForeignEnums =
> + target_lang_to_foreign_enum_lang(TargetLanguage),
> + (
> + ( IsEnumOrDummy0 = is_dummy
> + ; IsEnumOrDummy0 = is_enum
> + ),
> + get_type_defn_status(TypeDefn0, TypeStatus),
> + % Either both the type and the pragma are defined in this
> + % module or they are both imported. Any other combination
> + % is illegal.
> + IsTypeLocal = status_defined_in_this_module(TypeStatus),
> + ( + (
> + IsTypeLocal = yes,
> + ( ImportStatus = status_local
> + ; ImportStatus = status_exported_to_submodules
> + )
> + ;
> + IsTypeLocal = no,
> + status_is_imported(ImportStatus) = yes
> + )
> + ->
> + % XXX We should also check that this type is not
> + % the subject of a reserved tag pragma.
> + IsEnumOrDummy = is_foreign_enum,
> + build_foreign_enum_tag_map(Context, ContextPieces,
> + TypeName, ForeignTagValues, MaybeForeignTagMap,
> + !Specs),
> + (
> + LangForForeignEnums = Lang,
> + MaybeForeignTagMap = yes(ForeignTagMap)
> + ->
> + map.foldl2(make_foreign_tag(ForeignTagMap),
> + OldTagValues, map.init, TagValues, [], +
> UnmappedCtors),
> + (
> + UnmappedCtors = [],
> + TypeBody = hlds_du_type(Ctors, TagValues,
> + IsEnumOrDummy, MaybeUserEq, ReservedTag,
> + IsForeignType),
> + set_type_defn_body(TypeBody, TypeDefn0,
> + TypeDefn),
> + svmap.set(TypeCtor, TypeDefn, TypeTable0,
> + TypeTable),
> + module_info_set_type_table(TypeTable,
> + !ModuleInfo)
> + ;
> + UnmappedCtors = [_ | _],
> + add_foreign_enum_unmapped_ctors_error(Context,
> + ContextPieces, UnmappedCtors, !Specs)
> + ) + ;
> + % If there are no matching foreign_enum pragmas for
> + % this target language then don't do anything.
> + true
> + ),
> + MaybeSeverity = no,
> + ErrorPieces = []
> + ;
> + ImportStatus = status_exported
> + ->
> + add_foreign_enum_pragma_in_interface_error(Context,
> + TypeName, TypeArity, !Specs),
> + MaybeSeverity = no,
> + ErrorPieces = []
> + ;
> + MaybeSeverity = yes(severity_error),
> + ErrorPieces = [
> + words("error: "),
> + sym_name_and_arity(TypeName / TypeArity),
> + words("is not defined in this module.")
> + ]
> + )
> + ;
> + IsEnumOrDummy0 = is_foreign_enum,
> + ( LangForForeignEnums \= Lang ->
> + MaybeSeverity = no,
> + ErrorPieces = []
> + ;
> + MaybeSeverity = yes(severity_error),
> + ErrorPieces = [
> + words("error: "),
> + sym_name_and_arity(TypeName / TypeArity),
> + words("has multiple foreign_enum pragmas.")
> + ]
> + )
> + ;
> + IsEnumOrDummy0 = not_enum_or_dummy,
> + MaybeSeverity = yes(severity_error),
> + ErrorPieces = [
> + words("error: "),
> + sym_name_and_arity(TypeName / TypeArity),
> + words("is not an enumeration type"),
> + suffix(".")
> + ]
> + )
> + )
> + ;
> + % This else-branch corresponds to an undefined type. We do not
> + % issue an error message for it here since module qualification
> + % will have already done so.
> + MaybeSeverity = no,
> + ErrorPieces = []
> + ), + (
> + ErrorPieces = []
> + ;
> + ErrorPieces = [_ | _],
> + (
> + MaybeSeverity = yes(Severity)
> + ;
> + MaybeSeverity = no,
> + unexpected(this_file, "add_foreign_enum: no severity")
> + ),
> + Msg = simple_msg(Context, [always(ContextPieces ++ ErrorPieces)]),
> + Spec = error_spec(Severity, phase_parse_tree_to_hlds, [Msg]),
> + !:Specs = [Spec | !.Specs]
> + ).
> +
> +:- pred build_foreign_enum_tag_map(prog_context::in, format_components::in,
> + sym_name::in, assoc_list(sym_name, string)::in,
> + maybe(map(sym_name, string))::out,
> + list(error_spec)::in, list(error_spec)::out) is det.
> +
> +build_foreign_enum_tag_map(Context, ContextPieces, TypeName,
> ForeignTagValues0,
> + MaybeForeignTagMap, !Specs) :-
> + ( sym_name_get_module_name(TypeName, TypeModuleName0) ->
> + TypeModuleName = TypeModuleName0
> + ;
> + unexpected(this_file,
> + "unqualified type name while processing foreign tags.")
> + ),
> + list.map_foldl(fixup_foreign_tag_val_qualification(TypeModuleName),
> + ForeignTagValues0, ForeignTagValues1, [], BadCtors),
> + (
> + BadCtors = [],
> + ( bimap.from_assoc_list(ForeignTagValues1, ForeignTagValues) ->
> + ForeignTagMap = ForeignTagValues ^ forward_map,
> + MaybeForeignTagMap = yes(ForeignTagMap)
> + ;
> + add_foreign_enum_bijection_error(Context, ContextPieces,
> !Specs),
> + MaybeForeignTagMap = no
> + )
> + ;
> + BadCtors = [_ | _],
> + MaybeForeignTagMap = no
> + ).
> +
> + % The construtor names we get from the parse tree may be unqualified
constructor
> + % but the ones we match against in the HLDS are not. Module qualify
> + % them. + %
> + % XXX module_qual.m should really be doing this rather than
> add_pragam.m.
add_pragma.m
> Index: compiler/hlds_data.m
> ===================================================================
> RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_data.m,v
> retrieving revision 1.114
> diff -u -r1.114 hlds_data.m
> --- compiler/hlds_data.m 9 Jul 2007 13:28:35 -0000 1.114
> +++ compiler/hlds_data.m 9 Aug 2007 08:26:44 -0000
...
> @@ -231,6 +236,12 @@
> % This means the constant is represented just as a word
> containing
> % the specified integer value. This is used for enumerations
> and
> % character constants as well as for int constants.
> + + ; foreign_tag(string)
> + % This means the constant is represented by the string which is
> + % embedded directly in the target language. This is used for
> + % foreign enumerations, i.e. those enumeration types that are
> the
> + % subject of a foreign_enum pramga.
pragma
> Index: compiler/mercury_to_mercury.m
> ===================================================================
> RCS file:
> /home/mercury/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
> retrieving revision 1.317
> diff -u -r1.317 mercury_to_mercury.m
> --- compiler/mercury_to_mercury.m 25 Jul 2007 06:12:20 -0000 1.317
> +++ compiler/mercury_to_mercury.m 9 Aug 2007 08:26:44 -0000
...
> @@ -3646,23 +3650,44 @@
> ),
> add_string("]", !U).
>
> -:- pred mercury_format_pragma_foreign_export_enum_overrides(
> + % Output an association list of sym_names and strings, as used
> + % by both foreign_enum and foreign_export_enum pragmas.
> + % In the output the strings will be quoted.
The strings will be quoted in the output.
> Index: compiler/type_ctor_info.m
> ===================================================================
> RCS file:
> /home/mercury/mercury1/repository/mercury/compiler/type_ctor_info.m,v
> retrieving revision 1.88
> diff -u -r1.88 type_ctor_info.m
> --- compiler/type_ctor_info.m 13 Feb 2007 01:58:51 -0000 1.88
> +++ compiler/type_ctor_info.m 9 Aug 2007 08:26:44 -0000
...
> @@ -629,6 +633,76 @@
> svmap.det_insert(FunctorName, EnumFunctor, !NameMap).
>
>
> %---------------------------------------------------------------------------%
> + + % Make the functor and layout tables for a foreign enum type.
> + %
> +:- pred make_foreign_enum_details(list(constructor)::in,
> cons_tag_values::in,
> + bool::in, equality_axioms::in, type_ctor_details::out) is det.
> +
> +make_foreign_enum_details(Ctors, ConsTagMap, ReserveTag, EqualityAxioms,
> + Details) :-
> + (
> + ReserveTag = yes,
> + unexpected(this_file, "foreign enum with reserved tag")
> + ;
> + ReserveTag = no
> + ),
> + make_foreign_enum_functors(Ctors, 0, ConsTagMap, ForeignEnumFunctors),
> + OrdinalMap0 = map.init,
> + NameMap0 = map.init,
> + list.foldl2(make_foreign_enum_maps, ForeignEnumFunctors,
> + OrdinalMap0, OrdinalMap, NameMap0, NameMap),
> + FunctorNumberMap = make_functor_number_map(Ctors),
> + Details = foreign_enum(EqualityAxioms, ForeignEnumFunctors,
> + OrdinalMap, NameMap, FunctorNumberMap).
> + + % Create a foreign_enum_functor structure for each functor in an enum
> type.
> + % The functors are given to us in ordinal order (since that's how the
> HLDS
> + % stored them), and that is how we return the list of rtti names of the
> + % foreign_enum_functor_desc structures; that way, it is directly usable
> in
> + % the type layout structure. We also return a structure that allows our
> + % caller to sort this list on functor name, which is how the type
> functors
> + % structure is constructed.
> + %
> +:- pred make_foreign_enum_functors(list(constructor)::in,
> + int::in, cons_tag_values::in, list(foreign_enum_functor)::out) is det.
> +
> +make_foreign_enum_functors([], _, _, []).
> +make_foreign_enum_functors([Functor | Functors], NextOrdinal0, ConsTagMap,
> + [ForeignEnumFunctor | ForeignEnumFunctors]) :-
> + Functor = ctor(ExistTvars, Constraints, SymName, FunctorArgs,
> _Context),
> + expect(unify(ExistTvars, []), this_file,
> + "existential arguments in functor in foreign enum"),
> + expect(unify(Constraints, []), this_file,
> + "class constraints on functor in foreign enum"),
> + list.length(FunctorArgs, Arity),
> + expect(unify(Arity, 0), this_file,
> + "functor in foreign enum has nonzero arity"),
> + ConsId = make_cons_id_from_qualified_sym_name(SymName, FunctorArgs),
> + map.lookup(ConsTagMap, ConsId, ConsTag),
> + ( ConsTag = foreign_tag(ForeignTagValue0) ->
> + ForeignTagValue = ForeignTagValue0
> + ;
> + unexpected(this_file, "non foreign tag for foreign enum functor")
> + ),
> + FunctorName = unqualify_name(SymName),
> + ForeignEnumFunctor = foreign_enum_functor(FunctorName, NextOrdinal0,
> + ForeignTagValue),
> + make_foreign_enum_functors(Functors, NextOrdinal0 + 1, ConsTagMap,
> + ForeignEnumFunctors).
Might as well name it NextOrdinal.
> Index: runtime/mercury_ml_expand_body.h
> ===================================================================
> RCS file:
> /home/mercury/mercury1/repository/mercury/runtime/mercury_ml_expand_body.h,v
> retrieving revision 1.40
> diff -u -r1.40 mercury_ml_expand_body.h
> --- runtime/mercury_ml_expand_body.h 13 Feb 2007 01:58:57 -0000 1.40
> +++ runtime/mercury_ml_expand_body.h 9 Aug 2007 08:26:44 -0000
> @@ -316,6 +316,61 @@
> handle_zero_arity_args();
> return;
>
> + case MR_TYPECTOR_REP_FOREIGN_ENUM_USEREQ:
> + if (noncanon == MR_NONCANON_ABORT) {
> + /* XXX should throw an exception */
> + MR_fatal_error(MR_STRINGIFY(EXPAND_FUNCTION_NAME)
> + ": attempt to deconstruct noncanonical term");
> + return;
> + } else if (noncanon == MR_NONCANON_ALLOW) {
> + handle_noncanonical_name(type_ctor_info);
> + handle_zero_arity_args();
> + return;
> + }
> + /* else fall through */
> + + case MR_TYPECTOR_REP_FOREIGN_ENUM:
> + {
> + /*
> + ** For foreign enumerations we cannot use the value as
> index
> + ** into the type layout, since we just have to do a linear
> + ** search.
> + */
s/since/so/
> Index: runtime/mercury_type_info.h
> ===================================================================
> RCS file:
> /home/mercury/mercury1/repository/mercury/runtime/mercury_type_info.h,v
> retrieving revision 1.127
> diff -u -r1.127 mercury_type_info.h
> --- runtime/mercury_type_info.h 31 Jul 2007 07:58:44 -0000 1.127
> +++ runtime/mercury_type_info.h 9 Aug 2007 08:26:44 -0000
...
> @@ -988,6 +1003,24 @@
>
> /*---------------------------------------------------------------------------*/
>
> /*
> +** This type describes the function symbols in a foreign enum type.
> +**
> +** An MR_ForeignEnumLayout points to an array of pointers to functor
> +** descriptors. There is one pointer for each of the function symbols, and
> +** thus the size of the array is given by the num_functors field of the
> +** type_ctor_info. The array is ordered by declaration order,
full stop?
> Index: tests/invalid/foreign_enum_invalid.m
> ===================================================================
> RCS file: tests/invalid/foreign_enum_invalid.m
> diff -N tests/invalid/foreign_enum_invalid.m
> --- /dev/null 1 Jan 1970 00:00:00 -0000
> +++ tests/invalid/foreign_enum_invalid.m 9 Aug 2007 08:26:44 -0000
> @@ -0,0 +1,41 @@
> +:- module foreign_enum_invalid.
> +:- interface.
> +
> +:- type incomplete + ---> foo
> + ; bar
> + ; baz.
> +
> +:- type incomplete2
> + ---> foo2
> + ; bar2
> + ; baz2.
> +
> +:- type not_a_bijection
> + ---> a
> + ; b
> + ; c.
> +
> +:- type in_int ---> in_int.
> +:- pragma foreign_enum("C", in_int/0, [in_int - "300"]).
> +
> +:- type dup_foreign_enum ---> dup_foreign_enum.
> +
> +:- implementation.
> +
> +:- pragma foreign_enum("C", incomplete/0, [
> + foo - "3",
> + bar - "4"
> +]).
> +
> +:- pragma foreign_enum("C", incomplete2/0, []).
> +
> +:- pragma foreign_enum("C", not_a_bijection/0, [
> + a - "30",
> + a - "40",
> + b - "50",
> + c - "60"
> +]).
Did you check the case where two constructors have the same foreign enum
value?
Otherwise looks fine.
Peter
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list