[m-rev.] for review: Allow duplicate field names in the same module.

Peter Wang novalazy at gmail.com
Tue Apr 27 17:31:03 AEST 2021


Allow the same field name to be used in different types in the same
module. The main motivation is that when defining a subtype it often
makes sense to use the same field names as in the base/super type,
rather than trying to invent unique field names.

compiler/add_type.m:
    Check for duplicate field names within a type only,
    not across the module.

compiler/check_parse_tree_type_defns.m:
    Only report duplicate field names within the same type.

compiler/typecheck.m:
    Make user-supplied declarations for field access functions only
    override automatically generated declarations for the same type
    constructor, e.g. a user declaration ':- func foo ^ f1 = int'
    should not affect 'X ^ f1' for X of type 'bar'.

doc/reference_manual.texi:
    Allow duplicate field names in a module, but not within a type.

    Describe how user-supplied declarations interact with duplicate
    field names.

NEWS:
    Announce change.

tests/invalid/repeated_field_name.err_exp:
    Update expected error messages.

tests/invalid/Mmakefile:
tests/invalid/user_field_access_decl_conflict.err_exp:
tests/invalid/user_field_access_decl_conflict.m:
tests/invalid/user_field_access_decl_override.err_exp:
tests/invalid/user_field_access_decl_override.m:
tests/invalid/user_field_access_decl_override2.err_exp:
tests/invalid/user_field_access_decl_override2.m:
    Add test cases.

diff --git a/NEWS b/NEWS
index 0d2a312c8..87bbebf63 100644
--- a/NEWS
+++ b/NEWS
@@ -404,6 +404,8 @@ Changes to the Mercury language
   data representation with their base types so the type conversions do not
   cost anything at runtime.
 
+* Field names no longer need to be unique within a module.
+
 * The compiler can implement tabling only when generating C code.
   When compiling a predicate that has a `pragma memo` specified for it
   in a non-C grade, it necessarily ignores the pragma, but normally
diff --git a/compiler/add_type.m b/compiler/add_type.m
index 28cb75517..8232c8c88 100644
--- a/compiler/add_type.m
+++ b/compiler/add_type.m
@@ -1135,17 +1135,13 @@ add_ctor_field_name(FieldName, FieldDefn, NeedQual, PartialQuals,
         FieldName = unqualified(_),
         unexpected($pred, "unqualified field name")
     ),
-    % Field names must be unique within a module, not just within a type,
-    % because the function names for user-defined override functions
-    % for the builtin field access functions must be unique within a
-    % module.
-    ( if map.search(!.FieldNameTable, FieldName, ConflictingDefns) then
-        ( if ConflictingDefns = [ConflictingDefn] then
-            ConflictingDefn = hlds_ctor_field_defn(OrigContext, _, _, _, _)
-        else
-            unexpected($pred, "multiple conflicting fields")
-        ),
-
+    % Field names must be unique within a type.
+    ( if
+        map.search(!.FieldNameTable, FieldName, ExistingDefns),
+        list.find_first_match(is_conflicting_field_defn(FieldDefn),
+            ExistingDefns, ConflictingDefn)
+    then
+        ConflictingDefn = hlds_ctor_field_defn(OrigContext, _, _, _, _),
         FieldDefn = hlds_ctor_field_defn(Context, _, _, _, _),
         FieldString = sym_name_to_string(FieldName),
         Pieces = [words("Error: field"), quote(FieldString),
@@ -1175,6 +1171,15 @@ add_ctor_field_name(FieldName, FieldDefn, NeedQual, PartialQuals,
             [FieldModule | PartialQuals], !FieldNameTable)
     ).
 
+:- pred is_conflicting_field_defn(hlds_ctor_field_defn::in,
+    hlds_ctor_field_defn::in) is semidet.
+
+is_conflicting_field_defn(FieldDefnA, FieldDefnB) :-
+    FieldDefnA = hlds_ctor_field_defn(_ContextA, _TypeStatusA, TypeCtor,
+        _ConsIdA, _FieldNumberA),
+    FieldDefnB = hlds_ctor_field_defn(_ContextB, _TypeStatusB, TypeCtor,
+        _ConsIdB, _FieldNumberB).
+
 :- pred do_add_ctor_field(string::in, hlds_ctor_field_defn::in,
     module_name::in, ctor_field_table::in, ctor_field_table::out) is det.
 
diff --git a/compiler/check_parse_tree_type_defns.m b/compiler/check_parse_tree_type_defns.m
index 33cc4638b..4d28265e2 100644
--- a/compiler/check_parse_tree_type_defns.m
+++ b/compiler/check_parse_tree_type_defns.m
@@ -1563,12 +1563,18 @@ get_maybe_type_defn_contexts([MaybeTypeDefn | MaybeTypeDefns]) = Contexts :-
 
     % This type maps a field name to the locations where it occurs.
     %
-:- type field_name_map == map(string, one_or_more(field_name_locn)).
+:- type field_name_map ==
+    map(field_name_of_type_ctor, one_or_more(field_name_locn)).
+
+:- type field_name_of_type_ctor
+    --->    field_name_of_type_ctor(
+                string,
+                type_ctor
+            ).
 
     % The info we have about each location where a field name occurs:
     %
-    % - the context where it occurs,
-    % - the type constructor in which it occurs, and
+    % - the context where it occurs, and
     % - the data constructor in which it occurs.
     %
     % The context is first to make sorting easier. This is relevant
@@ -1577,7 +1583,7 @@ get_maybe_type_defn_contexts([MaybeTypeDefn | MaybeTypeDefns]) = Contexts :-
     % as the duplicates.
     %
 :- type field_name_locn
-    --->    field_name_locn(prog_context, type_ctor, string).
+    --->    field_name_locn(prog_context, string).
 
 :- pred add_type_ctor_to_field_name_map(
     type_ctor::in, type_ctor_checked_defn::in,
@@ -1633,22 +1639,23 @@ add_data_ctor_arg_to_field_name_map(TypeCtor, CtorName, CtorArg,
         MaybeCtorFieldName = yes(CtorFieldName),
         CtorFieldName = ctor_field_name(FieldSymName, FieldNameContext),
         FieldName = unqualify_name(FieldSymName),
-        FNLocn = field_name_locn(FieldNameContext, TypeCtor, CtorName),
-        ( if map.search(!.FieldNameMap, FieldName, OoMFNLocns0) then
+        FieldNameTypeCtor = field_name_of_type_ctor(FieldName, TypeCtor),
+        FNLocn = field_name_locn(FieldNameContext, CtorName),
+        ( if map.search(!.FieldNameMap, FieldNameTypeCtor, OoMFNLocns0) then
             OoMFNLocns0 = one_or_more(HeadFNLocn, TailFNLocns),
             OoMFNLocns = one_or_more(FNLocn, [HeadFNLocn | TailFNLocns]),
-            map.det_update(FieldName, OoMFNLocns, !FieldNameMap)
+            map.det_update(FieldNameTypeCtor, OoMFNLocns, !FieldNameMap)
         else
             OoMFNLocns = one_or_more(FNLocn, []),
-            map.det_insert(FieldName, OoMFNLocns, !FieldNameMap)
+            map.det_insert(FieldNameTypeCtor, OoMFNLocns, !FieldNameMap)
         )
     ).
 
-:- pred report_any_duplicate_field_names(string::in,
+:- pred report_any_duplicate_field_names(field_name_of_type_ctor::in,
     one_or_more(field_name_locn)::in,
     list(error_spec)::in, list(error_spec)::out) is det.
 
-report_any_duplicate_field_names(FieldName, OoMFNLocns, !Specs) :-
+report_any_duplicate_field_names(FieldNameTypeCtor, OoMFNLocns, !Specs) :-
     FNLocns = one_or_more_to_list(OoMFNLocns),
     list.sort(FNLocns, SortedFNLocns),
     (
@@ -1660,30 +1667,28 @@ report_any_duplicate_field_names(FieldName, OoMFNLocns, !Specs) :-
     ;
         SortedFNLocns = [HeadFNLocn | TailFNLocns],
         TailFNLocns = [_ | _],
-        % The case we are looking for; FieldName is defined *more* than once.
-        list.foldl(report_duplicate_field_name(FieldName, HeadFNLocn),
+        % The case we are looking for; FieldName is defined *more* than once
+        % in the same type.
+        list.foldl(report_duplicate_field_name(FieldNameTypeCtor, HeadFNLocn),
             TailFNLocns, !Specs)
     ).
 
-:- pred report_duplicate_field_name(string::in,
+:- pred report_duplicate_field_name(field_name_of_type_ctor::in,
     field_name_locn::in, field_name_locn::in,
     list(error_spec)::in, list(error_spec)::out) is det.
 
-report_duplicate_field_name(FieldName, FirstFNLocn, FNLocn, !Specs) :-
-    FirstFNLocn = field_name_locn(FirstContext, FirstTypeCtor, FirstCtorName),
-    FNLocn = field_name_locn(Context, TypeCtor, CtorName),
+report_duplicate_field_name(FieldNameTypeCtor, FirstFNLocn, FNLocn, !Specs) :-
+    FieldNameTypeCtor = field_name_of_type_ctor(FieldName, TypeCtor),
+    FirstFNLocn = field_name_locn(FirstContext, FirstCtorName),
+    FNLocn = field_name_locn(Context, CtorName),
     InitPieces = [words("Error: duplicate occurrence of the field name"),
         quote(FieldName)],
-    ( if TypeCtor = FirstTypeCtor then
-        ( if CtorName = FirstCtorName then
-            MainPieces = InitPieces ++ [words("in the function symbol"),
-                quote(CtorName), suffix("."), nl]
-        else
-            MainPieces = InitPieces ++ [words("in the definition of"),
-                unqual_type_ctor(TypeCtor), suffix("."), nl]
-        )
+    ( if CtorName = FirstCtorName then
+        MainPieces = InitPieces ++ [words("in the function symbol"),
+            quote(CtorName), suffix("."), nl]
     else
-        MainPieces = InitPieces ++ [suffix("."), nl]
+        MainPieces = InitPieces ++ [words("in the definition of"),
+            unqual_type_ctor(TypeCtor), suffix("."), nl]
     ),
     FirstPieces = [words("The first occurrence of this field name"),
         words("is here."), nl],
diff --git a/compiler/typecheck.m b/compiler/typecheck.m
index 6f1aecff1..bc982e3c7 100644
--- a/compiler/typecheck.m
+++ b/compiler/typecheck.m
@@ -3068,11 +3068,12 @@ get_field_access_constructor(Info, GoalId, FuncName, Arity, AccessType,
     FieldDefn = hlds_ctor_field_defn(_, _, TypeCtor, ConsId, _),
     TypeCtor = type_ctor(qualified(TypeModule, _), _),
 
-    % If the user has supplied a declaration, we use that instead
-    % of the automatically generated version, unless we are typechecking
-    % the clause introduced for the user-supplied declaration.
+    % If the user has supplied a declaration for a field access function
+    % of the same name and arity, operating on the same type constructor,
+    % we use that instead of the automatically generated version,
+    % unless we are typechecking the clause introduced for the
+    % user-supplied declaration itself.
     % The user-declared version will be picked up by builtin_pred_type.
-
     typecheck_info_get_module_info(Info, ModuleInfo),
     module_info_get_predicate_table(ModuleInfo, PredTable),
     UnqualFuncName = unqualify_name(FuncName),
@@ -3081,7 +3082,10 @@ get_field_access_constructor(Info, GoalId, FuncName, Arity, AccessType,
         IsFieldAccessFunc = no,
         predicate_table_lookup_func_m_n_a(PredTable, is_fully_qualified,
             TypeModule, UnqualFuncName, Arity, PredIds),
-        PredIds = []
+        list.all_false(
+            is_field_access_function_for_type_ctor(ModuleInfo, AccessType,
+                TypeCtor),
+            PredIds)
     ;
         IsFieldAccessFunc = yes(_)
     ),
@@ -3107,6 +3111,25 @@ get_field_access_constructor(Info, GoalId, FuncName, Arity, AccessType,
             FunctorConsTypeInfo)
     ).
 
+:- pred is_field_access_function_for_type_ctor(module_info::in,
+    field_access_type::in, type_ctor::in, pred_id::in) is semidet.
+
+is_field_access_function_for_type_ctor(ModuleInfo, AccessType, TypeCtor,
+        PredId) :-
+    module_info_pred_info(ModuleInfo, PredId, PredInfo),
+    pred_info_get_arg_types(PredInfo, ArgTypes),
+    require_complete_switch [AccessType]
+    (
+        AccessType = get,
+        ArgTypes = [ArgType, _ResultType],
+        type_to_ctor(ArgType, TypeCtor)
+    ;
+        AccessType = set,
+        ArgTypes = [ArgType, _FieldType, ResultType],
+        type_to_ctor(ArgType, TypeCtor),
+        type_to_ctor(ResultType, TypeCtor)
+    ).
+
 :- type maybe_cons_type_info
     --->    ok(cons_type_info)
     ;       error(cons_error).
diff --git a/doc/reference_manual.texi b/doc/reference_manual.texi
index 9070e119f..fc89e2342 100644
--- a/doc/reference_manual.texi
+++ b/doc/reference_manual.texi
@@ -2326,7 +2326,7 @@ which can be used to conveniently select and update fields of a term
 in a manner independent of the definition of the type
 (@pxref{Field access functions}).
 A labelled argument has the form @w{@code{@var{fieldname} :: @var{Type}}}.
-It is an error for two fields in the same module to have the same label.
+It is an error for two fields in the same type to have the same label.
 
 Here are some examples of discriminated union definitions:
 
@@ -2907,6 +2907,8 @@ by a single expression to avoid this problem.
 Type and mode declarations for compiler-generated field access functions
 for fields of constructors local to a module
 may be placed in the interface section of the module.
+The user-supplied declarations will be used instead of
+any automatically generated declarations.
 This allows the implementation of a type to be hidden
 while still allowing client modules to use record syntax
 to manipulate values of the type.
@@ -2917,6 +2919,12 @@ from a field access function without using explicit lambda expressions.
 Declarations for field access functions for fields occurring in the interface
 section of a module must also occur in the interface section.
 
+If there are multiple fields with the same label in the same module,
+only one of those fields can have user-supplied declarations
+for its selection function.
+Similarly, only one of those fields can have user-supplied declarations
+for its update function.
+
 Declarations and clauses for field access functions can also be supplied
 for fields which are not a part of any type.
 This is useful when the data structures of a program change
diff --git a/tests/invalid/Mmakefile b/tests/invalid/Mmakefile
index 999eaff11..7430dcc33 100644
--- a/tests/invalid/Mmakefile
+++ b/tests/invalid/Mmakefile
@@ -385,6 +385,9 @@ SINGLEMODULE= \
 	unsatisfiable_super \
 	unterminated_octal_escape \
 	user_eq_dummy \
+	user_field_access_decl_conflict \
+	user_field_access_decl_override \
+	user_field_access_decl_override2 \
 	uu_type \
 	var_as_class_name \
 	var_as_pred_name \
diff --git a/tests/invalid/repeated_field_name.err_exp b/tests/invalid/repeated_field_name.err_exp
index 3e65ecef3..d1e829048 100644
--- a/tests/invalid/repeated_field_name.err_exp
+++ b/tests/invalid/repeated_field_name.err_exp
@@ -10,15 +10,7 @@ repeated_field_name.m:015: Error: field `repeated_field_name.f1' multiply
 repeated_field_name.m:015:   defined.
 repeated_field_name.m:009:   Here is the previous definition of field
 repeated_field_name.m:009:   `repeated_field_name.f1'.
-repeated_field_name.m:020: Error: field `repeated_field_name.f1' multiply
-repeated_field_name.m:020:   defined.
-repeated_field_name.m:009:   Here is the previous definition of field
-repeated_field_name.m:009:   `repeated_field_name.f1'.
 repeated_field_name.m:021: Error: field `repeated_field_name.f1' multiply
 repeated_field_name.m:021:   defined.
-repeated_field_name.m:009:   Here is the previous definition of field
-repeated_field_name.m:009:   `repeated_field_name.f1'.
-repeated_field_name.m:022: Error: field `repeated_field_name.f2' multiply
-repeated_field_name.m:022:   defined.
-repeated_field_name.m:010:   Here is the previous definition of field
-repeated_field_name.m:010:   `repeated_field_name.f2'.
+repeated_field_name.m:020:   Here is the previous definition of field
+repeated_field_name.m:020:   `repeated_field_name.f1'.
diff --git a/tests/invalid/user_field_access_decl_conflict.err_exp b/tests/invalid/user_field_access_decl_conflict.err_exp
new file mode 100644
index 000000000..1df4987ba
--- /dev/null
+++ b/tests/invalid/user_field_access_decl_conflict.err_exp
@@ -0,0 +1,10 @@
+user_field_access_decl_conflict.m:023: Error: func
+user_field_access_decl_conflict.m:023:   `user_field_access_decl_conflict.f1'/1
+user_field_access_decl_conflict.m:023:   multiply defined.
+user_field_access_decl_conflict.m:022: Here is the previous definition of func
+user_field_access_decl_conflict.m:022:   `user_field_access_decl_conflict.f1'/1.
+user_field_access_decl_conflict.m:026: Error: func
+user_field_access_decl_conflict.m:026:   `user_field_access_decl_conflict.f1 :='/2
+user_field_access_decl_conflict.m:026:   multiply defined.
+user_field_access_decl_conflict.m:025: Here is the previous definition of func
+user_field_access_decl_conflict.m:025:   `user_field_access_decl_conflict.f1 :='/2.
diff --git a/tests/invalid/user_field_access_decl_conflict.m b/tests/invalid/user_field_access_decl_conflict.m
new file mode 100644
index 000000000..a127d43ae
--- /dev/null
+++ b/tests/invalid/user_field_access_decl_conflict.m
@@ -0,0 +1,26 @@
+% vim: ts=4 sw=4 ft=mercury
+
+:- module user_field_access_decl_conflict.
+
+:- interface.
+
+:- type foo
+    --->    foo(
+                f0 :: int,
+                f1 :: int
+            ).
+
+:- type bar
+    --->    bar(
+                f1 :: uint,
+                f2 :: int
+            ).
+
+:- func foo ^ f0 = int.
+:- func (foo ^ f0 := int) = foo.
+
+:- func foo ^ f1 = int.
+:- func bar ^ f1 = uint.            % conflict
+
+:- func (foo ^ f1 := int) = foo.
+:- func (bar ^ f1 := uint) = bar.   % conflict
diff --git a/tests/invalid/user_field_access_decl_override.err_exp b/tests/invalid/user_field_access_decl_override.err_exp
new file mode 100644
index 000000000..2178e1cbc
--- /dev/null
+++ b/tests/invalid/user_field_access_decl_override.err_exp
@@ -0,0 +1,26 @@
+user_field_access_decl_override.m:020: In `f1'(in) = out:
+user_field_access_decl_override.m:020:   warning: determinism declaration could
+user_field_access_decl_override.m:020:   be tighter.
+user_field_access_decl_override.m:020:   Declared `semidet', inferred `det'.
+user_field_access_decl_override.m:021: In `f1 :='(in, in) = out:
+user_field_access_decl_override.m:021:   warning: determinism declaration could
+user_field_access_decl_override.m:021:   be tighter.
+user_field_access_decl_override.m:021:   Declared `semidet', inferred `det'.
+user_field_access_decl_override.m:023: In `get_foo_f1'(in) = out:
+user_field_access_decl_override.m:023:   error: determinism declaration not
+user_field_access_decl_override.m:023:   satisfied.
+user_field_access_decl_override.m:023:   Declared `det', inferred `semidet'.
+user_field_access_decl_override.m:028:   Call to
+user_field_access_decl_override.m:028:   `user_field_access_decl_override.f1'(in)
+user_field_access_decl_override.m:028:   = out can fail.
+user_field_access_decl_override.m:028:   In unification of `X' and `f1(Foo)':
+user_field_access_decl_override.m:030: In `set_foo_f1'(in, in, out):
+user_field_access_decl_override.m:030:   error: determinism declaration not
+user_field_access_decl_override.m:030:   satisfied.
+user_field_access_decl_override.m:030:   Declared `det', inferred `semidet'.
+user_field_access_decl_override.m:035:   Call to
+user_field_access_decl_override.m:035:   `user_field_access_decl_override.f1
+user_field_access_decl_override.m:035:   :='(in, in) = out can fail.
+user_field_access_decl_override.m:035:   In unification of `STATE_VARIABLE_Foo'
+user_field_access_decl_override.m:035:   and `'f1 :='(STATE_VARIABLE_Foo_0,
+user_field_access_decl_override.m:035:   X)':
diff --git a/tests/invalid/user_field_access_decl_override.m b/tests/invalid/user_field_access_decl_override.m
new file mode 100644
index 000000000..143e71475
--- /dev/null
+++ b/tests/invalid/user_field_access_decl_override.m
@@ -0,0 +1,58 @@
+% vim: ts=4 sw=4 ft=mercury
+
+:- module user_field_access_decl_override.
+
+:- interface.
+
+:- type dummy ---> dummy.
+
+:- implementation.
+
+:- type foo(T)
+    --->    foo(
+                f1 :: int,
+                f2 :: int
+            ).
+
+    % These user-supplied declarations deliberately have looser determinisms
+    % than automatically generated declarations.
+    %
+:- func foo(T) ^ f1 = int is semidet.
+:- func (foo(T) ^ f1 := int) = foo(T) is semidet.
+
+:- func get_foo_f1(foo(T)) = int is det.
+
+get_foo_f1(Foo) = X :-
+    % The user-declared function declaration should be used instead of
+    % an automatically generated declaration, so this will be semidet.
+    X = Foo ^ f1.
+
+:- pred set_foo_f1(int::in, foo(T)::in, foo(T)::out) is det.
+
+set_foo_f1(X, !Foo) :-
+    % The user-declared function declaration should be used instead of
+    % an automatically generated declaration, so this will be semidet.
+    !Foo ^ f1 := X.
+
+%---------------------------------------------------------------------------%
+
+:- type bar
+    --->    bar(
+                f1 :: int,
+                f2 :: uint
+            ).
+
+:- func get_bar_f1(bar) = int.
+
+get_bar_f1(Bar) = X :-
+    % The user-supplied declaration of foo(T) ^ f1
+    % should not shadow any automatically generated declaration
+    % of the field access function for the f1 field of bar.
+    X = Bar ^ f1.
+
+:- pred set_bar_f1(int, bar, bar).
+:- mode set_bar_f1(in, in, out) is det.
+
+set_bar_f1(X, !Bar) :-
+    % Similarly for the field update function.
+    !Bar ^ f1 := X.
diff --git a/tests/invalid/user_field_access_decl_override2.err_exp b/tests/invalid/user_field_access_decl_override2.err_exp
new file mode 100644
index 000000000..1eb3a4283
--- /dev/null
+++ b/tests/invalid/user_field_access_decl_override2.err_exp
@@ -0,0 +1,22 @@
+user_field_access_decl_override2.m:028: In clause for function `get_foo_f1'/1:
+user_field_access_decl_override2.m:028:   in unification of variable `X'
+user_field_access_decl_override2.m:028:   and term `f1(Foo)':
+user_field_access_decl_override2.m:028:   type error in argument of functor
+user_field_access_decl_override2.m:028:   `f1'/1.
+user_field_access_decl_override2.m:028:   Argument 1 (Foo) has type `(some [T]
+user_field_access_decl_override2.m:028:   user_field_access_decl_override2.foo(T))',
+user_field_access_decl_override2.m:028:   expected type was
+user_field_access_decl_override2.m:028:   `user_field_access_decl_override2.foo(int)'.
+user_field_access_decl_override2.m:035: In clause for predicate `set_foo_f1'/3:
+user_field_access_decl_override2.m:035:   type error in unification of variable
+user_field_access_decl_override2.m:035:   `STATE_VARIABLE_Foo'
+user_field_access_decl_override2.m:035:   and functor `f1 :='/2.
+user_field_access_decl_override2.m:035:   variable `STATE_VARIABLE_Foo' has
+user_field_access_decl_override2.m:035:   type `(some [T]
+user_field_access_decl_override2.m:035:   user_field_access_decl_override2.foo(T))',
+user_field_access_decl_override2.m:035:   functor `f1 :='/2 has type
+user_field_access_decl_override2.m:035:   `'f1
+user_field_access_decl_override2.m:035:   :='(user_field_access_decl_override2.foo(int),
+user_field_access_decl_override2.m:035:   int):
+user_field_access_decl_override2.m:035:   user_field_access_decl_override2.foo(int)'.
+For more information, recompile with `-E'.
diff --git a/tests/invalid/user_field_access_decl_override2.m b/tests/invalid/user_field_access_decl_override2.m
new file mode 100644
index 000000000..e25e7d77c
--- /dev/null
+++ b/tests/invalid/user_field_access_decl_override2.m
@@ -0,0 +1,35 @@
+% vim: ts=4 sw=4 ft=mercury
+
+:- module user_field_access_decl_override2.
+
+:- interface.
+
+:- type dummy ---> dummy.
+
+:- implementation.
+
+:- type foo(T)
+    --->    foo(
+                f1 :: int,
+                f2 :: int
+            ).
+
+    % These user-supplied declarations have restrict the user
+    % of field access functions to foo(int) instead of foo(T).
+    %
+:- func foo(int) ^ f1 = int is semidet.
+:- func (foo(int) ^ f1 := int) = foo(int) is semidet.
+
+:- func get_foo_f1(foo(T)) = int is det.
+
+get_foo_f1(Foo) = X :-
+    % The user-declared function declaration should be used instead of
+    % an automatically generated declaration, so this will be a type error.
+    X = Foo ^ f1.
+
+:- pred set_foo_f1(int::in, foo(T)::in, foo(T)::out) is det.
+
+set_foo_f1(X, !Foo) :-
+    % The user-declared function declaration should be used instead of
+    % an automatically generated declaration, so this will be a type error.
+    !Foo ^ f1 := X.
-- 
2.30.0



More information about the reviews mailing list