[m-dev.] for review: record syntax [2]
Simon Taylor
stayl at cs.mu.OZ.AU
Fri Jan 7 15:20:33 AEDT 2000
This reply is for both parts of David's review.
David Jeffery wrote:
> On 04-Jan-2000, Simon Taylor <stayl at cs.mu.OZ.AU> wrote:
> >
> >
> > Estimated hours taken: 60
> >
> > Add syntax for getting and setting fields of constructors.
>
> You might like to make this a little clearer; when I first read the above
> sentence, I thought this change was only adding the syntax for fields, but
> not actually implementing anything.
s/Add/Implement/
> The order that you explain things in the log message could also be more
> helpful.
Fixed.
> > Index: compiler/make_hlds.m
> > ===================================================================
> > :- pred add_item_decl_pass_2(item, prog_context, item_status,
> > - module_info, item_status, module_info,
> > + module_info, item_status, module_info,
>
> That isn't much of a change...
Fixed.
> > + ( { MaybeFieldName = yes(FieldName) } ->
> > + { FieldDefn = hlds_ctor_field_defn(Context, ImportStatus,
> > + TypeId, ConsId, FieldNumber) },
> > + add_ctor_field_name(FieldName, FieldDefn, NeedQual,
> > + PartialQuals, FieldNameTable0, FieldNameTable2)
> > + ;
> > + { FieldNameTable2 = FieldNameTable0 }
> > + ),
> This might be nicer as a switch rather than an ite.
Done.
> I think we're trying to use error_util to compose error messages now.
Done.
> > + ( Functor = cons(FuncName0, FuncArity0) ->
> > + FuncName = FuncName0,
> > + FuncArity = FuncArity0
> > + ;
> > + error("transform_dcg_record_syntax_2")
> > + ),
>
> Indentation.
Fixed.
> > + % Wrap the list of goals for a record syntax expression
> > + % so that mode analysis treats them as an atomic goal.
> > +:- pred wrap_field_access_goals(prog_context, list(hlds_goal), hlds_goal).
> > +:- mode wrap_field_access_goals(in, in, out) is det.
> > +
> > +wrap_field_access_goals(Context, Goals, Goal) :-
> > + ( Goals = [Goal0] ->
> > + Goal = Goal0
> > + ;
> > + goal_info_init(Context, GoalInfo),
> > + Conj = conj(Goals) - GoalInfo,
> > + Goal = some([], can_remove, Conj) - GoalInfo
> > + ).
>
> I'm confused as to why this is necessary. Could you expand that comment a
> little?
%
% Wrap the list of goals for a record syntax expression
% so that mode analysis treats them as an atomic goal -- if
% the user writes an atomic goal which is expanded into multiple
% goals by the compiler, the mode correctness of the goal should
% not depend on the ability of mode analysis to interleave the
% expanded parts with other goals.
%
It probably isn't necessary.
> > %
> > + % Is it call to a field access function for
>
> s/it call/it a call/
Fixed.
> > Index: compiler/typecheck.m
> > ===================================================================
> > RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
> > retrieving revision 1.268
> > diff -u -u -r1.268 typecheck.m
> > --- typecheck.m 1999/12/08 09:44:56 1.268
> > +++ typecheck.m 1999/12/20 04:00:07
>
> > + %
> > + % For a field access function for which the user has supplied
> > + % a declaration but no clauses, add a clause
> > + % 'foo:='(X, Y) = 'builtin foo:='(X, Y).
> > + %
> > +:- pred maybe_add_default_field_access_clauses(module_info,
> > + pred_info, pred_info).
> > +:- mode maybe_add_default_field_access_clauses(in, in, out) is det.
>
> It seems a bit weird to be doing this as part of typecheck. Couldn't it be
> done earlier?
Possibly. It needs to be done after the clauses are added, and it
seems a little wasteful to add an extra pass over all pred_ids just
for that.
> > +:- pred write_comma_separated_error_list(pred(T, io__state, io__state),
> > + list(T), io__state, io__state).
> > +:- mode write_comma_separated_error_list(pred(in, di, uo) is det, in,
> > + di, uo) is det.
> > +
> > +write_comma_separated_error_list(_, []) --> [].
> > +write_comma_separated_error_list(Pred, [Error | Errors]) -->
> > + Pred(Error),
> > + write_comma_separated_error_list_2(Pred, Errors).
>
> This is just io__write_list
Fixed.
> > Index: doc/reference_manual.texi
> > ===================================================================
> > RCS file: /home/mercury1/repository/mercury/doc/reference_manual.texi,v
> > retrieving revision 1.162
> > diff -u -u -r1.162 reference_manual.texi
> > --- reference_manual.texi 1999/12/13 13:30:47 1.162
> > +++ reference_manual.texi 2000/01/04 05:27:34
>
> > + at item @var{Term} := ^ @var{Field1} ^ ... ^ @var{FieldN}
> > +Unifies @var{Term} with the field of the implicit DCG argument
> > +labelled by @var{Field}.
> > + at var{Term} must be a valid data-term.
> > + at var{Field1} @dots{} @var{FieldN} must be valid field names.
> > + at xref{Record syntax}.
>
> You talk here about "valid field names", but you haven't defined that yet.
> (This may or may not be a problem).
I've changed that to be more explicit about what is allowed - see
my reply to Peter's mail.
> > + at menu
> > +* Builtin types::
> > +* User-defined types::
> > +* Predicate and function types::
> > +* Field access functions::
> > + at end menu
>
> Is this part of the change related to the record syntax additions? If not, it
> should really be a separate change.
Done.
> > +By default, this function has no modes --- the modes are inferred at
> > +each call to the function.
>
> I don't think "no modes" is the right thing to say. It is really
> polymorphically moded (although that is probably a concept that is unfamiliar
> to most of the readers of the document).
I've changed that to "no declared modes".
> You have not supplied the .m files for the test cases. I would like to see
> those before you commit.
Oops.
Estimated hours taken: 60
Implement syntax for getting and setting fields of constructors.
compiler/make_hlds.m:
Add information about field definitions to the module_info.
Check that user-defined field access functions for exported
fields are also exported, otherwise predicates in other modules
could use a different method to access a field than predicates
in module defining the field.
Add a `predicate preds_add_implicit_report_error' to allow that check
to be performed for functions which are added to the module_info
by some means other than a `:- func' declaration.
Parse field access goals and expressions.
Add predicates `insert_arg_unifications_with_supplied_contexts',
and `append_arg_unification', which allow more control over
the contexts given to the added unifications. These are
useful because the field value for an update is really an
argument of the inner-most update function call, while the
input term is an argument of the outer-most function call.
compiler/prog_io_dcg.m:
Allow DCG goals of the form `:=(DCGArg)', which unifies `DCGArg'
with the output DCG argument, ignoring the input DCG argument.
The rationale for this change is that if we have convenient syntax
for updating parts of a DCG argument, we should also have convenient
syntax for updating the whole DCG argument.
compiler/typecheck.m:
Add a default clause for field access functions for which
the user has supplied type and mode declarations but no
clauses.
Typecheck field access function calls.
Use higher-order code to remove some duplication of code
to write out comma separated lists of error descriptions.
compiler/post_typecheck.m:
Expand field accessor goals into the equivalent unifications.
They are expanded inline rather than generating new get and set
predicates for field name to avoid having to work out how to mode
the generated predicates.
Remove an unnecessary goal traversal to qualify function
calls and constructors. That code is now called from purity.m.
compiler/prog_data.m:
compiler/prog_io.m:
compiler/mercury_to_goedel.m:
compiler/mercury_to_mercury.m:
Store field names as `sym_name's rather than strings.
Use a `maybe' type rather than an empty string to designate
an unlabelled field.
compiler/hlds_data.m:
Define data structures to hold information about
the field names visible in a module.
compiler/hlds_module.m:
Add a field to type module_info to hold information
about the fields visible in a module.
compiler/hlds_pred.m:
Add predicates to identify field access function names,
and to handle the arguments of field access functions.
compiler/make_hlds.m:
compiler/hlds_goal.m:
compiler/modecheck_call.m:
compiler/higher_order.m:
compiler/purity.m:
compiler/polymorphism.m:
compiler/dnf.m:
compiler/cse_detection.m:
compiler/lambda.m:
Move `create_atomic_unification' from make_hlds.m to hlds_goal.m
because it is used by several other modules.
compiler/hlds_goal.m:
Add a version of goal_info_init which takes the context of
the goal, for use by make_hlds.m.
compiler/type_util.m:
Add a predicate `type_util__get_type_and_cons_defn' to
get the hlds_type_defn and hlds_cons_defn for a user-defined
constructor.
compiler/prog_util.m:
Add predicates to add and remove prefixes or suffixes
from the unqualified part of a sym_name.
compiler/prog_out.m:
Add a predicate to convert a `sym_name/arity' to a string.
compiler/hlds_out.m:
Add `hlds_out__simple_call_id_to_string' to convert a
`pred_or_func - sym_name/arity' to a string for use in
error messages.
compiler/purity.m:
Thread through the pred_info so that the expansion of field accessor
goals can add new variables.
compiler/mercury_to_mercury.m:
library/ops.m:
Reduce precedence of `^/2' for use as a field name separator.
Add operator `^'/1 to designate which side of the `:=' is
the field name in a DCG field access goal.
Add operator `:=/2' for field update expressions.
doc/reference_manual.texi:
Document the new syntax.
doc/transition_guide.texi:
Document the new operators.
tests/hard_coded/Mmakefile:
tests/hard_coded/record_syntax.m:
tests/hard_coded/record_syntax.exp:
tests/invalid/Mmakefile:
tests/invalid/record_syntax_errors.m:
tests/invalid/record_syntax_errors.err_exp:
Test cases.
--- hlds_out.m 1999/12/20 02:59:32 1.1
+++ hlds_out.m 2000/01/05 06:31:57
@@ -83,6 +83,9 @@
io__state, io__state).
:- mode hlds_out__write_simple_call_id(in, in, in, di, uo) is det.
+:- pred hlds_out__simple_call_id_to_string(simple_call_id, string).
+:- mode hlds_out__simple_call_id_to_string(in, out) is det.
+
% Write "argument %i of call to pred_or_func `foo/n'".
:- pred hlds_out__write_call_arg_id(call_id, int, io__state, io__state).
:- mode hlds_out__write_call_arg_id(in, in, di, uo) is det.
@@ -365,6 +368,15 @@
hlds_out__simple_call_id_to_sym_name_and_arity(PredOrFunc - SymName/Arity,
SymName/OrigArity) :-
adjust_func_arity(PredOrFunc, OrigArity, Arity).
+
+hlds_out__simple_call_id_to_string(CallId, String) :-
+ hlds_out__simple_call_id_to_sym_name_and_arity(CallId, NameArity),
+ CallId = PredOrFunc - _,
+ ( PredOrFunc = predicate, PorFString = "predicate"
+ ; PredOrFunc = function, PorFString = "function"
+ ),
+ prog_out__sym_name_and_arity_to_string(NameArity, NameArityString),
+ string__append_list([PorFString, " `", NameArityString, "'"], String).
hlds_out__write_call_id(call(PredCallId)) -->
hlds_out__write_simple_call_id(PredCallId).
--- make_hlds.m 2000/01/05 05:42:26 1.3
+++ make_hlds.m 2000/01/05 06:57:40
@@ -315,7 +315,7 @@
% dispatch on the different types of items
:- pred add_item_decl_pass_2(item, prog_context, item_status,
- module_info, item_status, module_info,
+ module_info, item_status, module_info,
io__state, io__state).
:- mode add_item_decl_pass_2(in, in, in, in, out, out, di, uo) is det.
@@ -2070,12 +2070,14 @@
add_ctor_field_names([MaybeFieldName | FieldNames], NeedQual,
PartialQuals, TypeId, ConsId, Context, ImportStatus,
FieldNumber, FieldNameTable0, FieldNameTable) -->
- ( { MaybeFieldName = yes(FieldName) } ->
+ (
+ { MaybeFieldName = yes(FieldName) },
{ FieldDefn = hlds_ctor_field_defn(Context, ImportStatus,
TypeId, ConsId, FieldNumber) },
add_ctor_field_name(FieldName, FieldDefn, NeedQual,
PartialQuals, FieldNameTable0, FieldNameTable2)
;
+ { MaybeFieldName = no },
{ FieldNameTable2 = FieldNameTable0 }
),
add_ctor_field_names(FieldNames, NeedQual, PartialQuals, TypeId,
@@ -2116,15 +2118,21 @@
{ FieldDefn = hlds_ctor_field_defn(Context, _, _, _, _) },
io__stderr_stream(StdErr),
io__set_output_stream(StdErr, OldStream),
- prog_out__write_context(Context),
- io__write_string("Error: field `"),
- prog_out__write_sym_name(FieldName),
- io__write_string("' multiply defined.\n"),
+ { prog_out__sym_name_to_string(FieldName, FieldString) },
+ { ErrorPieces = [
+ words("Error: field"),
+ fixed(string__append_list(["`", FieldString, "'"])),
+ words("multiply defined.")
+ ] },
+ error_util__write_error_pieces(Context, 0, ErrorPieces),
+
+ % This type of error doesn't fit well with
+ % how error_util does things -- error_util.m
+ % wants to write everything with a single context.
prog_out__write_context(OrigContext),
io__write_string(
- " Here is the previous definition of "),
- io__write_string("field `"),
- prog_out__write_sym_name(FieldName),
+ " Here is the previous definition of field `"),
+ io__write_string(FieldString),
io__write_string("'.\n"),
io__set_exit_status(1),
io__set_output_stream(OldStream, _),
@@ -2674,14 +2682,15 @@
:- mode report_field_status_mismatch(in, in, di, uo) is det.
report_field_status_mismatch(Context, CallId) -->
- prog_out__write_context(Context),
- io__write_string("In declaration of "),
- hlds_out__write_simple_call_id(CallId),
- io__write_string(":\n"),
- prog_out__write_context(Context),
- io__write_string(" error: a field access function for an\n"),
- prog_out__write_context(Context),
- io__write_string(" exported field must also be exported.\n"),
+ { hlds_out__simple_call_id_to_string(CallId, CallIdString) },
+ { ErrorPieces = [
+ words("In declaration of"),
+ fixed(string__append(CallIdString, ":")),
+ nl,
+ words("error: a field access function for an"),
+ words("exported field must also be exported.")
+ ]},
+ error_util__write_error_pieces(Context, 0, ErrorPieces),
io__set_exit_status(1).
:- pred report_error_redefine_builtin_field_access_function(prog_context,
@@ -2690,11 +2699,13 @@
in, di, uo) is det.
report_error_redefine_builtin_field_access_function(Context, CallId) -->
- prog_out__write_context(Context),
- io__write_string(
- "Error: redefinition of builtin field access "),
- hlds_out__write_simple_call_id(CallId),
- io__write_string(".\n"),
+ { hlds_out__simple_call_id_to_string(CallId, CallIdString) },
+ { ErrorPieces = [
+ words("Error: redefinition of builtin field access"),
+ fixed(CallIdString),
+ words(".")
+ ] },
+ error_util__write_error_pieces(Context, 0, ErrorPieces),
io__set_exit_status(1).
%-----------------------------------------------------------------------------%
@@ -5167,7 +5178,7 @@
InnermostSubContext),
InputTermArgNumber = 1,
InputTermArgContext = functor(Functor, explicit, []),
- ( Functor = cons(FuncName0, FuncArity0) ->
+ ( Functor = cons(FuncName0, FuncArity0) ->
FuncName = FuncName0,
FuncArity = FuncArity0
;
@@ -5410,7 +5421,11 @@
Context, MainContext, SubContext, Goal).
% Wrap the list of goals for a record syntax expression
- % so that mode analysis treats them as an atomic goal.
+ % so that mode analysis treats them as an atomic goal -- if
+ % the user writes an atomic goal which is expanded into multiple
+ % goals by the compiler, the mode correctness of the goal should
+ % not depend on the ability of mode analysis to interleave the
+ % expanded parts with other goals.
:- pred wrap_field_access_goals(prog_context, list(hlds_goal), hlds_goal).
:- mode wrap_field_access_goals(in, in, out) is det.
--- post_typecheck.m 2000/01/05 07:09:32 1.2
+++ post_typecheck.m 2000/01/05 07:09:39
@@ -846,7 +846,7 @@
Goal = FuncCall - GoalInfo0
;
%
- % Is it call to a field access function for
+ % Is it a call to a field access function for
% which the user has not provided a definition.
% This test must be after conversion of function
% calls into predicate calls above.
--- prog_out.m 1999/12/20 02:59:32 1.1
+++ prog_out.m 2000/01/05 06:24:22
@@ -62,6 +62,14 @@
:- pred prog_out__sym_name_to_string(sym_name, string).
:- mode prog_out__sym_name_to_string(in, out) is det.
+ % sym_name_to_string(SymName, String):
+ % convert a symbol name and arity to a "<Name>/<Arity>" string,
+ % with module qualifiers separated by
+ % the standard Mercury module qualifier operator
+ % (currently ":", but may eventually change to ".")
+:- pred prog_out__sym_name_and_arity_to_string(sym_name_and_arity, string).
+:- mode prog_out__sym_name_and_arity_to_string(in, out) is det.
+
% sym_name_to_string(SymName, Separator, String):
% convert a symbol name to a string,
% with module qualifiers separated by Separator.
@@ -230,6 +238,11 @@
[Separator, Name].
prog_out__sym_name_to_string_2(unqualified(Name), _) -->
[Name].
+
+prog_out__sym_name_and_arity_to_string(SymName/Arity, String) :-
+ prog_out__sym_name_to_string(SymName, SymNameString),
+ string__int_to_string(Arity, ArityString),
+ string__append_list([SymNameString, "/", ArityString], String).
% write out a module specifier
--- typecheck.m 1999/12/21 01:45:04 1.2
+++ typecheck.m 2000/01/05 07:14:25
@@ -5259,7 +5259,7 @@
:- mode write_type_stuff_list(in, di, uo) is det.
write_type_stuff_list(Ts) -->
- write_comma_separated_error_list(write_type_stuff, Ts).
+ io__write_list(Ts, ", ", write_type_stuff).
:- pred write_type_stuff(type_stuff, io__state, io__state).
:- mode write_type_stuff(in, di, uo) is det.
@@ -5271,7 +5271,7 @@
:- mode write_var_type_stuff_list(in, in, di, uo) is det.
write_var_type_stuff_list(Ts, T) -->
- write_comma_separated_error_list(write_var_type_stuff(T), Ts).
+ io__write_list(Ts, ", ", write_var_type_stuff(T)).
:- pred write_var_type_stuff(type, type_stuff, io__state, io__state).
:- mode write_var_type_stuff(in, in, di, uo) is det.
@@ -5285,7 +5285,7 @@
:- mode write_arg_type_stuff_list(in, di, uo) is det.
write_arg_type_stuff_list(Ts) -->
- write_comma_separated_error_list(write_arg_type_stuff, Ts).
+ io__write_list(Ts, ", ", write_arg_type_stuff).
:- pred write_arg_type_stuff(arg_type_stuff, io__state, io__state).
:- mode write_arg_type_stuff(in, di, uo) is det.
@@ -5299,29 +5299,6 @@
%-----------------------------------------------------------------------------%
-:- pred write_comma_separated_error_list(pred(T, io__state, io__state),
- list(T), io__state, io__state).
-:- mode write_comma_separated_error_list(pred(in, di, uo) is det, in,
- di, uo) is det.
-
-write_comma_separated_error_list(_, []) --> [].
-write_comma_separated_error_list(Pred, [Error | Errors]) -->
- Pred(Error),
- write_comma_separated_error_list_2(Pred, Errors).
-
-:- pred write_comma_separated_error_list_2(pred(T, io__state, io__state),
- list(T), io__state, io__state).
-:- mode write_comma_separated_error_list_2(pred(in, di, uo) is det, in,
- di, uo) is det.
-
-write_comma_separated_error_list_2(_, []) --> [].
-write_comma_separated_error_list_2(Pred, [Error | Errors]) -->
- io__write_string(", "),
- Pred(Error),
- write_comma_separated_error_list_2(Pred, Errors).
-
-%-----------------------------------------------------------------------------%
-
:- pred report_error_undef_pred(typecheck_info, simple_call_id,
io__state, io__state).
:- mode report_error_undef_pred(typecheck_info_no_io, in, di, uo) is det.
@@ -5659,7 +5636,7 @@
:- mode report_invalid_field_updates(in, di, uo) is det.
report_invalid_field_updates(Updates) -->
- write_comma_separated_error_list(report_invalid_field_update, Updates).
+ io__write_list(Updates, ", ", report_invalid_field_update).
:- pred report_invalid_field_update(invalid_field_update,
io__state, io__state).
Index: hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.73
diff -u -u -r1.73 Mmakefile
--- Mmakefile 1999/11/17 02:13:56 1.73
+++ Mmakefile 1999/12/21 03:33:34
@@ -86,6 +86,7 @@
quantifier2 \
quoting_bug_test \
rational_test \
+ record_syntax \
redoip_clobber \
relation_test \
remove_file \
Index: hard_coded/record_syntax.exp
===================================================================
RCS file: record_syntax.exp
diff -N record_syntax.exp
--- /dev/null Fri Jan 7 15:06:29 2000
+++ record_syntax.exp Wed Jan 5 11:50:51 2000
@@ -0,0 +1,19 @@
+X ^ arg1 = 1
+X ^ arg2 = 2
+X ^ arg3 = foo2(3, 4)
+X ^ arg3 ^ arg4 = 3
+updated arg1 = foo(5, 2, foo2(3, 4))
+updated arg2 = foo(1, 6, foo2(3, 4))
+updated arg3 ^ arg4 = foo(1, 2, foo2(7, 4))
+List1 = cons(1, cons(2, cons(4, nil)))
+List2 ^ e_next ^ e_data = 'b'
+List3 = e_cons(1, e_cons("new value", e_nil))
+List3 ^ e_next ^ e_data = "new value"
+size(List3 ^ e_next ^ e_data) = 9
+Pair0 ^ fst = 1
+Pair = "new first elem" - 2
+'fst:=' [4,5,6] = [4 - 2, 5 - 2, 6 - 2]
+DCG ^ arg1 = 1
+DCG ^ arg3 ^ arg4 = 3
+updated DCG arg1 = foo(8, 2, foo2(3, 4))
+updated DCG arg3 ^ arg4 = foo(8, 2, foo2(9, 4))
Index: hard_coded/record_syntax.m
===================================================================
RCS file: record_syntax.m
diff -N record_syntax.m
--- /dev/null Fri Jan 7 15:06:29 2000
+++ record_syntax.m Thu Dec 23 10:29:28 1999
@@ -0,0 +1,140 @@
+:- module record_syntax.
+
+:- interface.
+
+:- import_module char, io, string.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- type foo
+ ---> foo(
+ arg1 :: int,
+ arg2 :: int,
+ arg3 :: foo2
+ ).
+
+:- type foo2
+ ---> foo2(
+ arg4 :: int,
+ arg5 :: int
+ ).
+
+:- type my_list(T)
+ ---> cons(data :: T, next :: my_list(T))
+ ; nil
+ .
+
+:- type e_list
+ ---> some [T] e_cons(e_data :: T, e_next :: e_list)
+ => has_size(T)
+ ; e_nil
+ .
+
+:- typeclass has_size(T) where [
+ func size(T) = int
+ ].
+
+:- instance has_size(int).
+:- instance has_size(string).
+:- instance has_size(char).
+
+:- type my_pair(T, U).
+
+:- func fst(my_pair(T, U)) = T.
+:- func snd(my_pair(T, U)) = U.
+:- func 'fst:='(my_pair(T, U), V) = my_pair(V, U).
+:- func 'snd:='(my_pair(T, U), V) = my_pair(T, V).
+
+:- implementation.
+
+:- import_module list.
+
+:- type my_pair(T, U) ---> (fst::T) - (snd::U).
+
+main -->
+ { X = foo(1, 2, foo2(3, 4)) },
+ write_arg("X ^ arg1", X ^ arg1),
+ write_arg("X ^ arg2", X ^ arg2),
+ write_arg("X ^ arg3", X ^ arg3),
+ write_arg("X ^ arg3 ^ arg4", X ^ arg3 ^ arg4),
+
+ write_arg("updated arg1", X ^ arg1 := 5),
+ write_arg("updated arg2", X ^ arg2 := 6),
+ write_arg("updated arg3 ^ arg4", X ^ arg3 ^ arg4 := 7),
+
+ { List0 = cons(1, cons(2, cons(3, nil))) },
+ { List1 = List0 ^ next ^ next ^ data := 4 },
+ write_arg("List1", List1),
+
+ % Test updates of existentially typed fields.
+ { List2 = 'new e_cons'(1, 'new e_cons'('b', e_nil)) },
+ write_arg("List2 ^ e_next ^ e_data", List2 ^ e_next ^ e_data),
+
+ { List3 = List2 ^ e_next ^ e_data := "new value" },
+ write_arg("List3", List3),
+ { NewValue = List3 ^ e_next ^ e_data },
+ write_arg("List3 ^ e_next ^ e_data", NewValue),
+ write_arg("size(List3 ^ e_next ^ e_data)",
+ size(NewValue)),
+
+ % Test updates that return a term of a different type to the input.
+ { Pair0 = 1 - 2 },
+ write_arg("Pair0 ^ fst", Pair0 ^ fst),
+ { Pair = Pair0 ^ fst := "new first elem" },
+ write_arg("Pair", Pair),
+
+
+ % Test taking the address of an update function
+ % for which a mode declaration has been supplied.
+ { Pairs = list__map('fst:='(Pair), [4, 5, 6]) },
+ write_arg("'fst:=' [4,5,6]", Pairs),
+
+ =(IO0),
+ { dcg_syntax(IO0, IO, X, _) },
+ :=(IO).
+
+
+:- instance has_size(int) where [
+ func(size/1) is id
+ ].
+
+:- instance has_size(string) where [
+ func(size/1) is length_of_string
+ ].
+
+:- instance has_size(char) where [
+ func(size/1) is char__to_int
+ ].
+
+:- func id(T) = T.
+id(T) = T.
+
+ % XXX this should be in the library.
+:- func length_of_string(string) = int.
+length_of_string(String) = Length :-
+ string__length(String, Length).
+
+:- pred dcg_syntax(io__state::di, io__state::uo, foo::in, foo::out) is det.
+
+dcg_syntax(IO0, IO) -->
+ Arg1 := ^ arg1,
+ { write_arg("DCG ^ arg1", Arg1, IO0, IO1) },
+ Arg4 := ^ arg3 ^ arg4,
+ { write_arg("DCG ^ arg3 ^ arg4", Arg4, IO1, IO2) },
+
+ ^ arg1 := 8,
+ =(DCG1),
+ { write_arg("updated DCG arg1", DCG1, IO2, IO3) },
+
+ ^ arg3 ^ arg4 := 9,
+ =(DCG2),
+ { write_arg("updated DCG arg3 ^ arg4", DCG2, IO3, IO) }.
+
+:- pred write_arg(string::in, T::in, io__state::di, io__state::uo) is det.
+
+write_arg(Descr, Arg) -->
+ io__write_string(Descr),
+ io__write_string(" = "),
+ io__write(Arg),
+ io__nl.
+
Index: invalid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.56
diff -u -u -r1.56 Mmakefile
--- Mmakefile 1999/12/27 11:07:33 1.56
+++ Mmakefile 2000/01/04 03:41:55
@@ -52,6 +52,7 @@
prog_io_erroneous.m \
qual_basic_test2.m \
qualified_cons_id2.m \
+ record_syntax_errors.m \
some.m \
spurious_mode_error.m \
test_nested.m \
Index: invalid/record_syntax_errors.err_exp
===================================================================
RCS file: record_syntax_errors.err_exp
diff -N record_syntax_errors.err_exp
--- /dev/null Fri Jan 7 15:06:29 2000
+++ record_syntax_errors.err_exp Wed Jan 5 18:17:35 2000
@@ -0,0 +1,40 @@
+record_syntax_errors.m:028: In DCG field update goal:
+record_syntax_errors.m:028: error: expected field name at term `Field'.
+record_syntax_errors.m:031: Error: expected `Field := ^ field1 ^ ... ^ fieldN'
+record_syntax_errors.m:031: or `^ field1 ^ ... ^ fieldN := Field'.
+record_syntax_errors.m:031: in DCG field access goal.
+record_syntax_errors.m:048: Error: clause for predicate `record_syntax_errors:term_type_error/1'
+record_syntax_errors.m:048: without preceding `pred' declaration.
+record_syntax_errors.m:054: In declaration of
+record_syntax_errors.m:054: function `record_syntax_errors:field4/1':
+record_syntax_errors.m:054: error: a field access function for an exported
+record_syntax_errors.m:054: field must also be exported.
+record_syntax_errors.m:056: Error: redefinition of builtin field access
+record_syntax_errors.m:056: function `record_syntax_errors:builtin field4/1'
+record_syntax_errors.m:056: .
+record_syntax_errors.m:056: In declaration of
+record_syntax_errors.m:056: function `record_syntax_errors:builtin field4/1':
+record_syntax_errors.m:056: error: a field access function for an exported
+record_syntax_errors.m:056: field must also be exported.
+record_syntax_errors.m:014: Error: no clauses for predicate `record_syntax_errors:dcg_syntax/2'.
+record_syntax_errors.m:016: Error: no clauses for predicate `record_syntax_errors:dcg_syntax_2/2'.
+record_syntax_errors.m:042: In clause for predicate `record_syntax_errors:construct_exist_cons/1':
+record_syntax_errors.m:042: error: invalid field update `field2:=/2':
+record_syntax_errors.m:005: existentially quantified type variable `T' occurs
+record_syntax_errors.m:005: in the types of field `field2' and some other field
+record_syntax_errors.m:005: in definition of constructor `record_syntax_errors:exist_cons/3 '.
+record_syntax_errors.m:046: In clause for predicate `record_syntax_errors:arg_type_error/1':
+record_syntax_errors.m:046: in argument 2 of functor `field6:=/2':
+record_syntax_errors.m:046: in argument 2 of functor `field7:=/2':
+record_syntax_errors.m:046: type error in unification of argument
+record_syntax_errors.m:046: and constant `"invalid value"'.
+record_syntax_errors.m:046: argument has type `int',
+record_syntax_errors.m:046: constant `"invalid value"' has type `string'.
+record_syntax_errors.m:050: In clause for predicate `record_syntax_errors:term_type_error/1':
+record_syntax_errors.m:050: in argument 2 of functor `field6:=/2':
+record_syntax_errors.m:050: in unification of argument
+record_syntax_errors.m:050: and term `'field4:='(V_5, V_4)':
+record_syntax_errors.m:050: type error in argument(s) of functor `field4:=/2'.
+record_syntax_errors.m:050: Argument 1 has type `(record_syntax_errors:cons2)',
+record_syntax_errors.m:050: expected type was `(record_syntax_errors:cons)'.
+For more information, try recompiling with `-E'.
Index: invalid/record_syntax_errors.m
===================================================================
RCS file: record_syntax_errors.m
diff -N record_syntax_errors.m
--- /dev/null Fri Jan 7 15:06:29 2000
+++ record_syntax_errors.m Wed Jan 5 18:05:38 2000
@@ -0,0 +1,58 @@
+:- module record_syntax_errors.
+
+:- interface.
+
+:- type exist_cons
+ ---> some [T] exist_cons(field1::int, field2::T, field3::T).
+
+:- type cons
+ ---> cons(field4::int, field5::int, field6::cons2).
+
+:- type cons2
+ ---> cons2(field7::int, field8::int).
+
+:- pred dcg_syntax(cons::in, cons::out) is det.
+
+:- pred dcg_syntax_2(cons::in, cons::out) is det.
+
+:- pred dcg_type_error(cons::in, cons::out) is det.
+
+:- pred construct_exist_cons(exist_cons::out) is det.
+
+:- pred arg_type_error(cons::out) is det.
+
+:- implementation.
+
+dcg_syntax -->
+ { Field = field4 },
+ ^ Field := 1.
+
+dcg_syntax_2 -->
+ X := Y.
+
+dcg_type_error -->
+ ^ field4 := 2.
+
+construct_exist_cons(ExistCons) :-
+ ExistCons0 = 'new exist_cons'(1, 'b', 'c'),
+ % This field cannot be updated because it shares
+ % an existentially quantified type variable
+ % with another field - updating the field changes
+ % the type of the field.
+ ExistCons = ExistCons0 ^ field2 := 1.
+
+arg_type_error(Cons) :-
+ Cons0 = cons(1, 2, cons2(3, 4)),
+ Cons = Cons0 ^ field6 ^ field7 := "invalid value".
+
+term_type_error(Cons) :-
+ Cons0 = cons(1, 2, cons2(3, 4)),
+ Cons = Cons0 ^ field6 ^ field4 := 1.
+
+% Check error message for local declarations for access functions
+% for exported fields.
+:- func field4(cons) = int.
+
+:- func 'builtin field4'(cons) = int.
+'builtin field4'(cons(_, _, _)) = 1.
+
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list