[m-dev.] for review: record syntax [1]
Simon Taylor
stayl at cs.mu.OZ.AU
Tue Jan 4 17:06:06 AEDT 2000
Hi,
I think Fergus is going away soon, so David Jeffery is probably the
best person to review this.
Thanks,
Simon.
Estimated hours taken: 60
Add syntax for getting and setting fields of constructors.
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:
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/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/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/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/purity.m:
Thread through the pred_info so that the expansion of field accessor
goals can add new variables.
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/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.
Split the `Types' chapter into sections.
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.
This update to the NEWS file will be committed after 0.9.1 is released:
Index: NEWS
===================================================================
+ NEWS since Mercury release 0.9:
+ -------------------------------
+
+ * We've added support for record syntax, so that fields of
+ constructors can be conveniently extracted and updated
+ without writing lots of trivial access predicates.
+ See the "Field access functions" section of the "Types" chapter
+ of the Mercury Language Reference Manual for details.
This update to the web pages will be committed after a stable rotd
containing record syntax is produced:
Index: w3/news/newsdb.inc
===================================================================
RCS file: /home/mercury1/repository/w3/news/newsdb.inc,v
retrieving revision 1.39
diff -u -u -r1.39 newsdb.inc
--- newsdb.inc 1999/12/22 23:38:38 1.39
+++ newsdb.inc 2000/01/04 05:43:24
@@ -17,6 +17,16 @@
*/
$newsdb = array(
+"6 Jan 2000" => array("Record syntax",
+"We've added support for record syntax, so that fields of
+constructors can be conveniently extracted and updated
+without writing lots of trivial access predicates.
+See the \"Field access functions\" section of the \"Types\" chapter
+of the Mercury Language Reference Manual for details.
+The syntax is available in our latest
+<A HREF=\"download/rotd.html\">release of the day</A>.
+"),
+
"18 Dec 1999" => array("Mercury 0.9 released",
"We've just released the long-awaited version 0.9.
Index: compiler/cse_detection.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/cse_detection.m,v
retrieving revision 1.58
diff -u -u -r1.58 cse_detection.m
--- cse_detection.m 1999/10/25 03:48:41 1.58
+++ cse_detection.m 1999/12/07 00:57:43
@@ -34,7 +34,7 @@
:- implementation.
:- import_module hlds_goal, hlds_data, options, globals, goal_util, hlds_out.
-:- import_module modes, mode_util, make_hlds, quantification, instmap.
+:- import_module modes, mode_util, quantification, instmap.
:- import_module prog_data, switch_detection, det_util, inst_match.
:- import_module switch_detection, term, varset.
Index: compiler/dnf.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dnf.m,v
retrieving revision 1.38
diff -u -u -r1.38 dnf.m
--- dnf.m 1999/10/25 03:48:46 1.38
+++ dnf.m 1999/12/07 00:58:58
@@ -61,7 +61,7 @@
:- implementation.
:- import_module code_aux, code_util, hlds_goal, hlds_data, prog_data, instmap.
-:- import_module dependency_graph, det_analysis, excess, make_hlds, mode_util.
+:- import_module dependency_graph, det_analysis, excess, mode_util.
:- import_module require, map, list, string, int, bool, std_util, term, varset.
% Traverse the module structure.
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.60
diff -u -u -r1.60 higher_order.m
--- higher_order.m 1999/12/03 12:54:56 1.60
+++ higher_order.m 1999/12/07 00:36:54
@@ -36,7 +36,7 @@
:- implementation.
:- import_module hlds_pred, hlds_goal, hlds_data, instmap, (inst).
-:- import_module code_util, globals, make_hlds, mode_util, goal_util.
+:- import_module code_util, globals, mode_util, goal_util.
:- import_module type_util, options, prog_data, prog_out, quantification.
:- import_module mercury_to_mercury, inlining, polymorphism, prog_util.
:- import_module special_pred, passes_aux.
Index: compiler/hlds_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_data.m,v
retrieving revision 1.42
diff -u -u -r1.42 hlds_data.m
--- hlds_data.m 1999/12/03 12:54:57 1.42
+++ hlds_data.m 1999/12/22 04:45:09
@@ -74,6 +74,53 @@
%-----------------------------------------------------------------------------%
+:- type ctor_field_table == map(ctor_field_name, list(hlds_ctor_field_defn)).
+
+:- type hlds_ctor_field_defn
+ ---> hlds_ctor_field_defn(
+ prog_context, % context of the field definition
+ import_status,
+ type_id, % type containing the field
+ cons_id, % constructor containing the field
+ int % argument number (counting from 1)
+ ).
+
+ %
+ % Field accesses are expanded into inline unifications by
+ % post_typecheck.m after typechecking has worked out which
+ % field is being referred to.
+ %
+ % Function declarations and clauses are not generated for these
+ % because it would be difficult to work out how to mode them.
+ %
+ % Users can override the automatically generated field access
+ % functions (for example to introduce sanity checking of the
+ % arguments) by defining functions
+ % :- func field(term_type) = field_type.
+ % and
+ % :- func 'field:='(term_type, field_type) = term_type.
+ %
+ % The automatically generated functions can be used within the
+ % module defining the type using the functions 'builtin field'
+ % and 'builtin field:=', which may not be overridden by the
+ % programmer.
+ %
+:- type field_access_type
+ ---> get
+ ; set
+ .
+
+:- type field_access_function_is_builtin
+ --->
+ % `builtin field/1' or `builtin field:=/2'
+ builtin_field_access
+ ;
+ % `field/1' or `field:=/2'
+ non_builtin_field_access
+ .
+
+%-----------------------------------------------------------------------------%
+
% Various predicates for accessing the cons_id type.
% Given a cons_id and a list of argument terms, convert it into a
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.66
diff -u -u -r1.66 hlds_goal.m
--- hlds_goal.m 1999/12/14 04:52:40 1.66
+++ hlds_goal.m 1999/12/21 01:35:30
@@ -733,6 +733,10 @@
:- pred goal_info_init(hlds_goal_info).
:- mode goal_info_init(out) is det.
+:- pred goal_info_init(prog_context, hlds_goal_info).
+:- mode goal_info_init(in, out) is det.
+
+
:- pred goal_info_init(set(prog_var), instmap_delta, determinism,
hlds_goal_info).
:- mode goal_info_init(in, in, in, out) is det.
@@ -948,6 +952,12 @@
:- pred set_goal_contexts(prog_context, hlds_goal, hlds_goal).
:- mode set_goal_contexts(in, in, out) is det.
+ % Create the hlds_goal for a unification, filling in all the as yet
+ % unknown slots with dummy values.
+:- pred create_atomic_unification(prog_var, unify_rhs, prog_context,
+ unify_main_context, unify_sub_contexts, hlds_goal).
+:- mode create_atomic_unification(in, in, in, in, in, out) is det.
+
%
% Produce a goal to construct a given constant.
% These predicates all fill in the non-locals, instmap_delta
@@ -1020,7 +1030,7 @@
:- implementation.
-:- import_module det_analysis, type_util.
+:- import_module det_analysis, prog_util, type_util.
:- import_module require, string, term, varset.
goal_info_init(GoalInfo) :-
@@ -1037,6 +1047,10 @@
Detism, InstMapDelta, Context, NonLocals, no, Features,
no_resume_point, []).
+goal_info_init(Context, GoalInfo) :-
+ goal_info_init(GoalInfo0),
+ goal_info_set_context(GoalInfo0, Context, GoalInfo).
+
goal_info_init(NonLocals, InstMapDelta, Detism, GoalInfo) :-
goal_info_init(GoalInfo0),
goal_info_set_nonlocals(GoalInfo0, NonLocals, GoalInfo1),
@@ -1406,6 +1420,17 @@
bi_implication(LHS, RHS)) :-
set_goal_contexts(Context, LHS0, LHS),
set_goal_contexts(Context, RHS0, RHS).
+
+%-----------------------------------------------------------------------------%
+
+create_atomic_unification(A, B, Context, UnifyMainContext, UnifySubContext,
+ Goal) :-
+ UMode = ((free - free) -> (free - free)),
+ Mode = ((free -> free) - (free -> free)),
+ UnifyInfo = complicated_unify(UMode, can_fail, []),
+ UnifyC = unify_context(UnifyMainContext, UnifySubContext),
+ goal_info_init(Context, GoalInfo),
+ Goal = unify(A, B, Mode, UnifyInfo, UnifyC) - GoalInfo.
%-----------------------------------------------------------------------------%
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_module.m,v
retrieving revision 1.49
diff -u -u -r1.49 hlds_module.m
--- hlds_module.m 1999/12/03 17:33:28 1.49
+++ hlds_module.m 1999/12/18 13:52:56
@@ -207,6 +207,13 @@
module_info).
:- mode module_info_set_assertion_table(in, in, out) is det.
+:- pred module_info_ctor_field_table(module_info, ctor_field_table).
+:- mode module_info_ctor_field_table(in, out) is det.
+
+:- pred module_info_set_ctor_field_table(module_info,
+ ctor_field_table, module_info).
+:- mode module_info_set_ctor_field_table(in, in, out) is det.
+
% The cell count is used as a unique cell number for
% constants in the generated C code.
:- pred module_info_get_cell_count(module_info, int).
@@ -565,6 +572,7 @@
instance_table,
superclass_table,
assertion_table,
+ ctor_field_table,
int % cell count, passed into code_info
% and used to generate unique label
% numbers for constant terms in the
@@ -637,13 +645,15 @@
set__list_to_set([PublicBuiltin, PrivateBuiltin], ImportedModules),
assertion_table_init(AssertionTable),
+ map__init(FieldNameTable),
ModuleSubInfo = module_sub(Name, Globals, [], [], no, 0, 0, [],
[], [], StratPreds, UnusedArgInfo, 0, ImportedModules,
no_aditi_compilation, TypeSpecInfo),
ModuleInfo = module(ModuleSubInfo, PredicateTable, Requests,
UnifyPredMap, QualifierInfo, Types, Insts, Modes, Ctors,
- ClassTable, SuperClassTable, InstanceTable, AssertionTable, 0).
+ ClassTable, SuperClassTable, InstanceTable, AssertionTable,
+ FieldNameTable, 0).
%-----------------------------------------------------------------------------%
@@ -815,7 +825,8 @@
% K instance_table,
% L superclass_table,
% M assertion_table
-% N int % cell count, passed into code_info
+% N ctor_field_table,
+% O int % cell count, passed into code_info
% % and used to generate unique label
% % numbers for constant terms in the
% % generated C code
@@ -826,106 +837,113 @@
% Various predicates which access the module_info data structure.
module_info_get_sub_info(MI0, A) :-
- MI0 = module(A, _, _, _, _, _, _, _, _, _, _, _, _, _).
+ MI0 = module(A, _, _, _, _, _, _, _, _, _, _, _, _, _, _).
module_info_get_predicate_table(MI0, B) :-
- MI0 = module(_, B, _, _, _, _, _, _, _, _, _, _, _, _).
+ MI0 = module(_, B, _, _, _, _, _, _, _, _, _, _, _, _, _).
module_info_get_proc_requests(MI0, C) :-
- MI0 = module(_, _, C, _, _, _, _, _, _, _, _, _, _, _).
+ MI0 = module(_, _, C, _, _, _, _, _, _, _, _, _, _, _, _).
module_info_get_special_pred_map(MI0, D) :-
- MI0 = module(_, _, _, D, _, _, _, _, _, _, _, _, _, _).
+ MI0 = module(_, _, _, D, _, _, _, _, _, _, _, _, _, _, _).
module_info_get_partial_qualifier_info(MI0, E) :-
- MI0 = module(_, _, _, _, E, _, _, _, _, _, _, _, _, _).
+ MI0 = module(_, _, _, _, E, _, _, _, _, _, _, _, _, _, _).
module_info_types(MI0, F) :-
- MI0 = module(_, _, _, _, _, F, _, _, _, _, _, _, _, _).
+ MI0 = module(_, _, _, _, _, F, _, _, _, _, _, _, _, _, _).
module_info_insts(MI0, G) :-
- MI0 = module(_, _, _, _, _, _, G, _, _, _, _, _, _, _).
+ MI0 = module(_, _, _, _, _, _, G, _, _, _, _, _, _, _, _).
module_info_modes(MI0, H) :-
- MI0 = module(_, _, _, _, _, _, _, H, _, _, _, _, _, _).
+ MI0 = module(_, _, _, _, _, _, _, H, _, _, _, _, _, _, _).
module_info_ctors(MI0, I) :-
- MI0 = module(_, _, _, _, _, _, _, _, I, _, _, _, _, _).
+ MI0 = module(_, _, _, _, _, _, _, _, I, _, _, _, _, _, _).
module_info_classes(MI0, J) :-
- MI0 = module(_, _, _, _, _, _, _, _, _, J, _, _, _, _).
+ MI0 = module(_, _, _, _, _, _, _, _, _, J, _, _, _, _, _).
module_info_instances(MI0, K) :-
- MI0 = module(_, _, _, _, _, _, _, _, _, _, K, _, _, _).
+ MI0 = module(_, _, _, _, _, _, _, _, _, _, K, _, _, _, _).
module_info_superclasses(MI0, L) :-
- MI0 = module(_, _, _, _, _, _, _, _, _, _, _, L, _, _).
+ MI0 = module(_, _, _, _, _, _, _, _, _, _, _, L, _, _, _).
module_info_assertion_table(MI0, M) :-
- MI0 = module(_, _, _, _, _, _, _, _, _, _, _, _, M, _).
+ MI0 = module(_, _, _, _, _, _, _, _, _, _, _, _, M, _, _).
+
+module_info_ctor_field_table(MI0, N) :-
+ MI0 = module(_, _, _, _, _, _, _, _, _, _, _, _, _, N, _).
-module_info_get_cell_count(MI0, N) :-
- MI0 = module(_, _, _, _, _, _, _, _, _, _, _, _, _, N).
+module_info_get_cell_count(MI0, O) :-
+ MI0 = module(_, _, _, _, _, _, _, _, _, _, _, _, _, _, O).
%-----------------------------------------------------------------------------%
% Various predicates which modify the module_info data structure.
module_info_set_sub_info(MI0, A, MI) :-
- MI0 = module(_, B, C, D, E, F, G, H, I, J, K, L, M, N),
- MI = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N).
+ MI0 = module(_, B, C, D, E, F, G, H, I, J, K, L, M, N, O),
+ MI = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O).
module_info_set_predicate_table(MI0, B, MI) :-
- MI0 = module(A, _, C, D, E, F, G, H, I, J, K, L, M, N),
- MI = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N).
+ MI0 = module(A, _, C, D, E, F, G, H, I, J, K, L, M, N, O),
+ MI = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O).
module_info_set_proc_requests(MI0, C, MI) :-
- MI0 = module(A, B, _, D, E, F, G, H, I, J, K, L, M, N),
- MI = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N).
+ MI0 = module(A, B, _, D, E, F, G, H, I, J, K, L, M, N, O),
+ MI = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O).
module_info_set_special_pred_map(MI0, D, MI) :-
- MI0 = module(A, B, C, _, E, F, G, H, I, J, K, L, M, N),
- MI = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N).
+ MI0 = module(A, B, C, _, E, F, G, H, I, J, K, L, M, N, O),
+ MI = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O).
module_info_set_partial_qualifier_info(MI0, E, MI) :-
- MI0 = module(A, B, C, D, _, F, G, H, I, J, K, L, M, N),
- MI = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N).
+ MI0 = module(A, B, C, D, _, F, G, H, I, J, K, L, M, N, O),
+ MI = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O).
module_info_set_types(MI0, F, MI) :-
- MI0 = module(A, B, C, D, E, _, G, H, I, J, K, L, M, N),
- MI = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N).
+ MI0 = module(A, B, C, D, E, _, G, H, I, J, K, L, M, N, O),
+ MI = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O).
module_info_set_insts(MI0, G, MI) :-
- MI0 = module(A, B, C, D, E, F, _, H, I, J, K, L, M, N),
- MI = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N).
+ MI0 = module(A, B, C, D, E, F, _, H, I, J, K, L, M, N, O),
+ MI = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O).
module_info_set_modes(MI0, H, MI) :-
- MI0 = module(A, B, C, D, E, F, G, _, I, J, K, L, M, N),
- MI = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N).
+ MI0 = module(A, B, C, D, E, F, G, _, I, J, K, L, M, N, O),
+ MI = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O).
module_info_set_ctors(MI0, I, MI) :-
- MI0 = module(A, B, C, D, E, F, G, H, _, J, K, L, M, N),
- MI = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N).
+ MI0 = module(A, B, C, D, E, F, G, H, _, J, K, L, M, N, O),
+ MI = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O).
module_info_set_classes(MI0, J, MI) :-
- MI0 = module(A, B, C, D, E, F, G, H, I, _, K, L, M, N),
- MI = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N).
+ MI0 = module(A, B, C, D, E, F, G, H, I, _, K, L, M, N, O),
+ MI = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O).
module_info_set_instances(MI0, K, MI) :-
- MI0 = module(A, B, C, D, E, F, G, H, I, J, _, L, M, N),
- MI = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N).
+ MI0 = module(A, B, C, D, E, F, G, H, I, J, _, L, M, N, O),
+ MI = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O).
module_info_set_superclasses(MI0, L, MI) :-
- MI0 = module(A, B, C, D, E, F, G, H, I, J, K, _, M, N),
- MI = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N).
+ MI0 = module(A, B, C, D, E, F, G, H, I, J, K, _, M, N, O),
+ MI = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O).
module_info_set_assertion_table(MI0, M, MI) :-
- MI0 = module(A, B, C, D, E, F, G, H, I, J, K, L, _, N),
- MI = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N).
+ MI0 = module(A, B, C, D, E, F, G, H, I, J, K, L, _, N, O),
+ MI = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O).
-module_info_set_cell_count(MI0, N, MI) :-
- MI0 = module(A, B, C, D, E, F, G, H, I, J, K, L, M, _),
- MI = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N).
+module_info_set_ctor_field_table(MI0, N, MI) :-
+ MI0 = module(A, B, C, D, E, F, G, H, I, J, K, L, M, _, O),
+ MI = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O).
+
+module_info_set_cell_count(MI0, O, MI) :-
+ MI0 = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N, _),
+ MI = module(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O).
%-----------------------------------------------------------------------------%
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.68
diff -u -u -r1.68 hlds_pred.m
--- hlds_pred.m 1999/12/03 12:55:00 1.68
+++ hlds_pred.m 1999/12/22 04:21:47
@@ -2165,6 +2165,94 @@
%-----------------------------------------------------------------------------%
+ % Predicates to deal with record syntax.
+
+:- interface.
+
+ % field_extraction_function_args(Args, InputTermArg).
+ % Work out which arguments of a field access correspond to the
+ % field being extracted/set, and which are the container arguments.
+:- pred field_extraction_function_args(list(prog_var), prog_var).
+:- mode field_extraction_function_args(in, out) is det.
+
+ % field_update_function_args(Args, InputTermArg, FieldArg).
+:- pred field_update_function_args(list(prog_var), prog_var, prog_var).
+:- mode field_update_function_args(in, out, out) is det.
+
+ % field_access_function_name(AccessType, FieldName,
+ % IsBuiltin, FuncName).
+ %
+ % From the access type and the name of the field,
+ % construct a function name.
+:- pred field_access_function_name(field_access_type, ctor_field_name,
+ field_access_function_is_builtin, sym_name).
+:- mode field_access_function_name(in, in, in, out) is det.
+
+ % is_field_access_function_name(ModuleInfo, FuncName, AccessType,
+ % IsBuiltin, FieldName).
+ %
+ % Inverse of the above.
+:- pred is_field_access_function_name(module_info, sym_name, arity,
+ field_access_type, field_access_function_is_builtin,
+ ctor_field_name).
+:- mode is_field_access_function_name(in, in, out, out, out, out) is semidet.
+
+:- implementation.
+
+field_extraction_function_args(Args, TermInputArg) :-
+ ( Args = [TermInputArg0] ->
+ TermInputArg = TermInputArg0
+ ;
+ error("field_extraction_function_args")
+ ).
+
+field_update_function_args(Args, TermInputArg, FieldArg) :-
+ ( Args = [TermInputArg0, FieldArg0] ->
+ FieldArg = FieldArg0,
+ TermInputArg = TermInputArg0
+ ;
+ error("field_update_function_args")
+ ).
+
+field_access_function_name(AccessType, FieldName, Builtin, FuncName) :-
+ (
+ AccessType = set,
+ add_sym_name_suffix(FieldName, ":=", FuncName0)
+ ;
+ AccessType = get,
+ FuncName0 = FieldName
+ ),
+ (
+ Builtin = builtin_field_access,
+ remove_sym_name_prefix(FuncName, "builtin ", FuncName0)
+ ;
+ Builtin = non_builtin_field_access,
+ FuncName = FuncName0
+ ).
+
+is_field_access_function_name(ModuleInfo, FuncName0, Arity,
+ AccessType, Builtin, FieldName) :-
+ ( remove_sym_name_prefix(FuncName0, "builtin ", FuncName1) ->
+ FuncName = FuncName1,
+ Builtin = builtin_field_access
+ ;
+ FuncName = FuncName0,
+ Builtin = non_builtin_field_access
+ ),
+ ( remove_sym_name_suffix(FuncName, ":=", FieldName0) ->
+ Arity = 2,
+ AccessType = set,
+ FieldName = FieldName0
+ ;
+ Arity = 1,
+ AccessType = get,
+ FieldName = FuncName
+ ),
+ module_info_ctor_field_table(ModuleInfo, CtorFieldTable),
+ map__contains(CtorFieldTable, FieldName).
+
+%-----------------------------------------------------------------------------%
+
% Predicates to check whether a given predicate
% is an Aditi query.
Index: compiler/lambda.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/lambda.m,v
retrieving revision 1.58
diff -u -u -r1.58 lambda.m
--- lambda.m 1999/10/25 03:49:03 1.58
+++ lambda.m 1999/12/07 01:03:05
@@ -83,7 +83,7 @@
:- implementation.
:- import_module hlds_goal, prog_data.
-:- import_module hlds_data, make_hlds, globals, options, type_util.
+:- import_module hlds_data, globals, options, type_util.
:- import_module goal_util, prog_util, mode_util, inst_match, llds, arg_info.
:- import_module list, map, set.
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.320
diff -u -u -r1.320 make_hlds.m
--- make_hlds.m 1999/12/10 02:17:57 1.320
+++ make_hlds.m 1999/12/23 00:51:48
@@ -22,7 +22,7 @@
:- module make_hlds.
:- interface.
-:- import_module prog_data, hlds_module, hlds_pred, hlds_goal.
+:- import_module prog_data, hlds_module, hlds_pred.
:- import_module equiv_type, module_qual.
:- import_module io, std_util, list, bool.
@@ -37,10 +37,6 @@
bool, bool, io__state, io__state).
:- mode parse_tree_to_hlds(in, in, in, out, out, out, di, uo) is det.
-:- pred create_atomic_unification(prog_var, unify_rhs, prog_context,
- unify_main_context, unify_sub_contexts, hlds_goal).
-:- mode create_atomic_unification(in, in, in, in, in, out) is det.
-
:- pred add_new_proc(pred_info, arity, list(mode), maybe(list(mode)),
maybe(list(is_live)), maybe(determinism),
prog_context, is_address_taken, pred_info, proc_id).
@@ -56,7 +52,7 @@
:- implementation.
-:- import_module hlds_data.
+:- import_module hlds_data, hlds_goal.
:- import_module prog_io, prog_io_goal, prog_io_dcg, prog_io_util, prog_out.
:- import_module modules, module_qual, prog_util, options, hlds_out.
:- import_module make_tags, quantification, (inst), globals.
@@ -150,8 +146,11 @@
add_item_list_decls_pass_2(Items, Status1, Module1, Module).
% pass 3:
- % add the clauses one by one to the module
+ % Add the clauses one by one to the module.
% (I supposed this could conceivably be folded into pass 2?)
+ %
+ % Check that the declarations for field extraction
+ % and update functions are sensible.
:- pred add_item_list_clauses(item_list, import_status, module_info,
module_info, qual_info, qual_info, io__state, io__state).
@@ -316,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.
@@ -529,7 +528,6 @@
--> [].
add_item_decl_pass_2(pred(_, _, _, _, _, _, _, _, _),
_, Status, Module, Status, Module) --> [].
-
add_item_decl_pass_2(pred_mode(_, _, _, _, _), _, Status, Module, Status,
Module) --> [].
add_item_decl_pass_2(func_mode(_, _, _, _, _, _), _, Status, Module, Status,
@@ -627,9 +625,13 @@
add_item_clause(mode_defn(_, _, _), Status, Status, _,
Module, Module, Info, Info) --> [].
add_item_clause(pred(_, _, _, _, _, _, _, _, _), Status, Status, _,
- Module, Module, Info, Info) --> [].
-add_item_clause(func(_, _, _, _, _, _, _, _, _, _), Status, Status, _,
Module, Module, Info, Info) --> [].
+add_item_clause(func(_, _, _, FuncName, TypesAndModes, _, _, _, _, _),
+ Status, Status, Context, Module, Module, Info, Info) -->
+ { list__length(TypesAndModes, FuncArity) },
+ maybe_check_field_access_function(FuncName, FuncArity,
+ Status, Context, Module).
+
add_item_clause(pred_mode(_, _, _, _, _), Status, Status, _,
Module, Module, Info, Info) --> [].
add_item_clause(func_mode(_, _, _, _, _, _), Status, Status, _,
@@ -1780,11 +1782,16 @@
{ module_info_ctors(Module0, Ctors0) },
{ module_info_get_partial_qualifier_info(Module0,
PQInfo) },
- ctors_add(ConsList, TypeId, NeedQual, PQInfo, Context,
+ { module_info_ctor_field_table(Module0,
+ CtorFields0) },
+ ctors_add(ConsList, TypeId, TVarSet, NeedQual, PQInfo,
+ Context, Status, CtorFields0, CtorFields,
Ctors0, Ctors),
- { module_info_set_ctors(Module0, Ctors, Module1) }
+ { module_info_set_ctors(Module0, Ctors, Module1) },
+ { module_info_set_ctor_field_table(Module1,
+ CtorFields, Module2) }
;
- { Module1 = Module0 }
+ { Module2 = Module0 }
),
{ construct_qualified_term(Name, Args, Type) },
(
@@ -1798,15 +1805,15 @@
->
{ special_pred_list(SpecialPredIds) },
{ add_special_pred_decl_list(SpecialPredIds,
- Module1, TVarSet, Type, TypeId,
- Context, Status, Module2) }
+ Module2, TVarSet, Type, TypeId,
+ Context, Status, Module3) }
;
{ special_pred_list(SpecialPredIds) },
{ add_special_pred_list(SpecialPredIds,
- Module1, TVarSet, Type, TypeId,
- Body, Context, Status, Module2) }
+ Module2, TVarSet, Type, TypeId,
+ Body, Context, Status, Module3) }
),
- { module_info_set_types(Module2, Types, Module) },
+ { module_info_set_types(Module3, Types, Module) },
( { Body = uu_type(_) } ->
io__stderr_stream(StdErr),
io__set_output_stream(StdErr, OldStream),
@@ -1960,14 +1967,18 @@
convert_type_defn(uu_type(Name, Args, Body), _, Name, Args, uu_type(Body)).
convert_type_defn(eqv_type(Name, Args, Body), _, Name, Args, eqv_type(Body)).
convert_type_defn(abstract_type(Name, Args), _, Name, Args, abstract_type).
-
-:- pred ctors_add(list(constructor), type_id, need_qualifier,
- partial_qualifier_info, prog_context, cons_table, cons_table,
- io__state, io__state).
-:- mode ctors_add(in, in, in, in, in, in, out, di, uo) is det.
-ctors_add([], _, _, _, _, Ctors, Ctors) --> [].
-ctors_add([Ctor | Rest], TypeId, NeedQual, PQInfo, Context, Ctors0, Ctors) -->
+:- pred ctors_add(list(constructor), type_id, tvarset, need_qualifier,
+ partial_qualifier_info, prog_context, import_status,
+ ctor_field_table, ctor_field_table,
+ cons_table, cons_table, io__state, io__state).
+:- mode ctors_add(in, in, in, in, in, in, in, in, out, in, out, di, uo) is det.
+
+ctors_add([], _, _, _, _, _, _, FieldNameTable, FieldNameTable,
+ Ctors, Ctors) --> [].
+ctors_add([Ctor | Rest], TypeId, TVarSet, NeedQual, PQInfo, Context,
+ ImportStatus, FieldNameTable0, FieldNameTable,
+ Ctors0, Ctors) -->
{ Ctor = ctor(ExistQVars, Constraints, Name, Args) },
{ make_cons_id(Name, Args, TypeId, QualifiedConsId) },
{ assoc_list__values(Args, Types) },
@@ -2007,10 +2018,10 @@
),
{ map__set(Ctors0, QualifiedConsId, QualifiedConsDefns, Ctors1) },
- { QualifiedConsId = cons(qualified(Module, ConsName), Arity) ->
+ ( { QualifiedConsId = cons(qualified(Module, ConsName), Arity) } ->
% Add unqualified version of the cons_id to the
% cons_table, if appropriate.
- (
+ {
NeedQual = may_be_unqualified
->
UnqualifiedConsId = cons(unqualified(ConsName), Arity),
@@ -2018,26 +2029,137 @@
Ctors2)
;
Ctors2 = Ctors1
- ),
+ },
% Add partially qualified versions of the cons_id
- get_partial_qualifiers(Module, PQInfo, PartialQuals),
- list__map_foldl(add_ctor(ConsName, Arity, ConsDefn),
+ { get_partial_qualifiers(Module, PQInfo, PartialQuals) },
+ { list__map_foldl(add_ctor(ConsName, Arity, ConsDefn),
PartialQuals, _PartiallyQualifiedConsIds,
- Ctors2, Ctors3)
+ Ctors2, Ctors3) },
+
+ { assoc_list__keys(Args, FieldNames) },
+ { FirstField = 1 },
+
+ add_ctor_field_names(FieldNames, NeedQual, PartialQuals,
+ TypeId, QualifiedConsId, Context, ImportStatus,
+ FirstField, FieldNameTable0, FieldNameTable1)
;
- error("ctors_add: cons_id not qualified")
- },
+ { error("ctors_add: cons_id not qualified") }
+ ),
- ctors_add(Rest, TypeId, NeedQual, PQInfo, Context, Ctors3, Ctors).
+ ctors_add(Rest, TypeId, TVarSet, NeedQual, PQInfo, Context,
+ ImportStatus, FieldNameTable1, FieldNameTable, Ctors3, Ctors).
-:- pred add_ctor(string::in, int::in, hlds_cons_defn::in, module_name::in,
- cons_id::out, cons_table::in, cons_table::out) is det.
+:- pred add_ctor(string, int, hlds_cons_defn, module_name,
+ cons_id, cons_table, cons_table).
+:- mode add_ctor(in, in, in, in, out, in, out) is det.
add_ctor(ConsName, Arity, ConsDefn, ModuleQual, ConsId, CtorsIn, CtorsOut) :-
ConsId = cons(qualified(ModuleQual, ConsName), Arity),
multi_map__set(CtorsIn, ConsId, ConsDefn, CtorsOut).
+:- pred add_ctor_field_names(list(maybe(ctor_field_name)),
+ need_qualifier, list(module_name), type_id, cons_id,
+ prog_context, import_status, int, ctor_field_table,
+ ctor_field_table, io__state, io__state).
+:- mode add_ctor_field_names(in, in, in, in, in, in, in, in,
+ in, out, di, uo) is det.
+
+add_ctor_field_names([], _, _, _, _, _, _, _,
+ FieldNameTable, FieldNameTable) --> [].
+add_ctor_field_names([MaybeFieldName | FieldNames], NeedQual,
+ PartialQuals, TypeId, ConsId, Context, ImportStatus,
+ FieldNumber, FieldNameTable0, FieldNameTable) -->
+ ( { 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 }
+ ),
+ add_ctor_field_names(FieldNames, NeedQual, PartialQuals, TypeId,
+ ConsId, Context, ImportStatus, FieldNumber + 1,
+ FieldNameTable2, FieldNameTable).
+
+:- pred add_ctor_field_name(ctor_field_name, hlds_ctor_field_defn,
+ need_qualifier, list(module_name), ctor_field_table,
+ ctor_field_table, io__state, io__state).
+:- mode add_ctor_field_name(in, in, in, in, in, out, di, uo) is det.
+
+add_ctor_field_name(FieldName, FieldDefn, NeedQual, PartialQuals,
+ FieldNameTable0, FieldNameTable) -->
+ { FieldName = qualified(FieldModule0, _) ->
+ FieldModule = FieldModule0
+ ;
+ error("add_ctor_field_name: 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.
+ %
+ { map__search(FieldNameTable0, FieldName, ConflictingDefns) }
+ ->
+ { ConflictingDefns = [ConflictingDefn] ->
+ ConflictingDefn =
+ hlds_ctor_field_defn(OrigContext, _, _, _, _)
+ ;
+ error(
+ "add_ctor_field_name: multiple conflicting fields")
+ },
+
+ % XXX we should record each error
+ % using module_info_incr_errors
+ { 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__write_context(OrigContext),
+ io__write_string(
+ " Here is the previous definition of "),
+ io__write_string("field `"),
+ prog_out__write_sym_name(FieldName),
+ io__write_string("'.\n"),
+ io__set_exit_status(1),
+ io__set_output_stream(OldStream, _),
+ { FieldNameTable = FieldNameTable0 }
+ ;
+ { unqualify_name(FieldName, UnqualFieldName) },
+
+ % Add an unqualified version of the field name to the
+ % table, if appropriate.
+ {
+ NeedQual = may_be_unqualified
+ ->
+ multi_map__set(FieldNameTable0,
+ unqualified(UnqualFieldName),
+ FieldDefn, FieldNameTable1)
+ ;
+ FieldNameTable1 = FieldNameTable0
+ },
+
+ % Add partially qualified versions of the cons_id
+ { list__foldl(
+ do_add_ctor_field(UnqualFieldName, FieldDefn),
+ [FieldModule | PartialQuals],
+ FieldNameTable1, FieldNameTable) }
+ ).
+
+:- pred do_add_ctor_field(string, hlds_ctor_field_defn, module_name,
+ ctor_field_table, ctor_field_table).
+:- mode do_add_ctor_field(in, in, in, in, out) is det.
+
+do_add_ctor_field(FieldName, FieldNameDefn, ModuleName,
+ FieldNameTable0, FieldNameTable) :-
+ multi_map__set(FieldNameTable0, qualified(ModuleName, FieldName),
+ FieldNameDefn, FieldNameTable).
+
%-----------------------------------------------------------------------------%
:- pred module_add_pred(module_info, tvarset, inst_varset, existq_tvars,
@@ -2458,8 +2580,10 @@
OrigContext) },
{ hlds_out__pred_or_func_to_str(PredOrFunc,
DeclString) },
- multiple_def_error(PredName, Arity, DeclString,
- Context, OrigContext)
+ { adjust_func_arity(PredOrFunc,
+ OrigArity, Arity) },
+ multiple_def_error(PredName, OrigArity,
+ DeclString, Context, OrigContext)
;
% This can happen for exported external preds.
{ Module = Module0 }
@@ -2469,7 +2593,7 @@
PQInfo) },
{ predicate_table_insert(PredicateTable0, PredInfo0,
NeedQual, PQInfo, PredId, PredicateTable1) },
- (
+ (
{ code_util__predinfo_is_builtin(PredInfo0) }
->
{ add_builtin(PredId, Types,
@@ -2483,11 +2607,96 @@
;
{ PredicateTable = PredicateTable1 }
),
- { module_info_set_predicate_table(Module1,
- PredicateTable, Module) }
+ { module_info_set_predicate_table(Module1,
+ PredicateTable, Module) }
)
).
+:- pred maybe_check_field_access_function(sym_name, arity, import_status,
+ prog_context, module_info, io__state, io__state).
+:- mode maybe_check_field_access_function(in, in, in, in, in, di, uo) is det.
+
+maybe_check_field_access_function(FuncName, FuncArity,
+ Status, Context, Module) -->
+ (
+ { is_field_access_function_name(Module, FuncName, FuncArity,
+ AccessType, IsBuiltin, FieldName) }
+ ->
+ check_field_access_function(AccessType, IsBuiltin,
+ FieldName, FuncName, FuncArity, Status,
+ Context, Module)
+ ;
+ []
+ ).
+
+:- pred check_field_access_function(field_access_type,
+ field_access_function_is_builtin, ctor_field_name, sym_name,
+ arity, import_status, prog_context, module_info,
+ io__state, io__state).
+:- mode check_field_access_function(in, in, in, in, in, in, in, in,
+ di, uo) is det.
+
+check_field_access_function(_AccessType, IsBuiltin, FieldName,
+ FuncName, FuncArity, FuncStatus, Context, Module, IO0, IO) :-
+ adjust_func_arity(function, FuncArity, PredArity),
+ FuncCallId = function - FuncName/PredArity,
+
+ (
+ IsBuiltin = builtin_field_access,
+ report_error_redefine_builtin_field_access_function(Context,
+ FuncCallId, IO0, IO1)
+ ;
+ IsBuiltin = non_builtin_field_access,
+ IO1 = IO0
+ ),
+
+ %
+ % Check that a function applied to an exported type
+ % is also exported.
+ %
+ module_info_ctor_field_table(Module, CtorFieldTable),
+ (
+ % Abstract types have status `abstract_exported',
+ % so errors won't be reported for local field
+ % access functions for them.
+ map__search(CtorFieldTable, FieldName, [FieldDefn]),
+ FieldDefn = hlds_ctor_field_defn(_, DefnStatus, _, _, _),
+ DefnStatus = exported, FuncStatus \= exported
+ ->
+ report_field_status_mismatch(Context,
+ FuncCallId, IO1, IO)
+ ;
+ IO = IO1
+ ).
+
+:- pred report_field_status_mismatch(prog_context, simple_call_id,
+ io__state, io__state).
+:- 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"),
+ io__set_exit_status(1).
+
+:- pred report_error_redefine_builtin_field_access_function(prog_context,
+ simple_call_id, io__state, io__state).
+:- mode report_error_redefine_builtin_field_access_function(in,
+ 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"),
+ io__set_exit_status(1).
+
%-----------------------------------------------------------------------------%
:- pred add_builtin(pred_id, list(type), pred_info, pred_info).
@@ -2526,10 +2735,9 @@
%
% construct a clause containing that pseudo-recursive call
%
- goal_info_init(GoalInfo0),
- goal_info_set_context(GoalInfo0, Context, GoalInfo1),
+ goal_info_init(Context, GoalInfo0),
set__list_to_set(HeadVars, NonLocals),
- goal_info_set_nonlocals(GoalInfo1, NonLocals, GoalInfo),
+ goal_info_set_nonlocals(GoalInfo0, NonLocals, GoalInfo),
Goal = Call - GoalInfo,
Clause = clause([], Goal, Context),
@@ -2717,18 +2925,16 @@
PredOrFunc, PredName, Arity,
[PredId0]) }
->
- { PredicateTable1 = PredicateTable0 },
+ { ModuleInfo1 = ModuleInfo0 },
{ PredId = PredId0 }
;
- maybe_undefined_pred_error(PredName, Arity, PredOrFunc,
- MContext, "mode declaration"),
- { preds_add_implicit(ModuleInfo0, PredicateTable0,
- ModuleName, PredName, Arity, Status,
- MContext, PredOrFunc,
- PredId, PredicateTable1) }
+ preds_add_implicit_report_error(ModuleName,
+ PredOrFunc, PredName, Arity, Status, MContext,
+ "mode declaration", PredId, ModuleInfo0, ModuleInfo1)
),
% Lookup the pred_info for this predicate
+ { module_info_get_predicate_table(ModuleInfo1, PredicateTable1) },
{ predicate_table_get_preds(PredicateTable1, Preds0) },
{ map__lookup(Preds0, PredId, PredInfo0) },
@@ -2784,6 +2990,33 @@
% for that predicate; the real types will be inferred by
% type inference.
+:- pred preds_add_implicit_report_error(module_name, pred_or_func, sym_name,
+ arity, import_status, prog_context, string,
+ pred_id, module_info, module_info, io__state, io__state).
+:- mode preds_add_implicit_report_error(in, in, in, in, in, in, in,
+ out, in, out, di, uo) is det.
+
+preds_add_implicit_report_error(ModuleName, PredOrFunc, PredName, Arity,
+ Status, Context, Description, PredId,
+ ModuleInfo0, ModuleInfo) -->
+ maybe_undefined_pred_error(PredName, Arity, PredOrFunc,
+ Context, Description),
+
+ ( { PredOrFunc = function } ->
+ { adjust_func_arity(function, FuncArity, Arity) },
+ maybe_check_field_access_function(PredName, FuncArity,
+ Status, Context, ModuleInfo0)
+ ;
+ []
+ ),
+
+ { module_info_get_predicate_table(ModuleInfo0, PredicateTable0) },
+ { preds_add_implicit(ModuleInfo0, PredicateTable0, ModuleName,
+ PredName, Arity, Status, Context, PredOrFunc,
+ PredId, PredicateTable) },
+ { module_info_set_predicate_table(ModuleInfo0,
+ PredicateTable, ModuleInfo) }.
+
:- pred preds_add_implicit(module_info, predicate_table, module_name,
sym_name, arity, import_status, prog_context,
pred_or_func, pred_id, predicate_table).
@@ -2931,7 +3164,7 @@
PredOrFunc, PredName, Arity, [PredId0]) }
->
{ PredId = PredId0 },
- { PredicateTable1 = PredicateTable0 },
+ { ModuleInfo1 = ModuleInfo0 },
(
{ IsAssertion = yes }
->
@@ -2955,22 +3188,23 @@
ModuleInfo0, PredicateTable0,
ModuleName, PredName, Arity, Status,
Context, PredOrFunc,
- PredId, PredicateTable1) }
+ PredId, PredicateTable1) },
+ { module_info_set_predicate_table(ModuleInfo0,
+ PredicateTable1, ModuleInfo1) }
;
{ IsAssertion = no },
- maybe_undefined_pred_error(PredName, Arity, PredOrFunc,
- Context, "clause"),
- { preds_add_implicit(ModuleInfo0, PredicateTable0,
- ModuleName, PredName, Arity, Status,
- Context, PredOrFunc,
- PredId, PredicateTable1) }
+
+ preds_add_implicit_report_error(ModuleName,
+ PredOrFunc, PredName, Arity, Status, Context,
+ "clause", PredId, ModuleInfo0, ModuleInfo1)
)
),
% Lookup the pred_info for this pred,
% add the clause to the clauses_info in the pred_info,
% if there are no modes add an `infer_modes' marker,
% and then save the pred_info.
- { predicate_table_get_preds(PredicateTable1, Preds0) },
+ { module_info_get_predicate_table(ModuleInfo1, PredicateTable2) },
+ { predicate_table_get_preds(PredicateTable2, Preds0) },
{ map__lookup(Preds0, PredId, PredInfo0) },
% opt_imported preds are initially tagged as imported and are
% tagged as opt_imported only if/when we see a clause for them
@@ -2982,7 +3216,7 @@
(
{ pred_info_get_goal_type(PredInfo1, pragmas) }
->
- { module_info_incr_errors(ModuleInfo0, ModuleInfo) },
+ { module_info_incr_errors(ModuleInfo1, ModuleInfo) },
prog_out__write_context(Context),
io__write_string("Error: clause for "),
hlds_out__write_simple_call_id(PredOrFunc, PredName/Arity),
@@ -2997,7 +3231,7 @@
->
prog_out__write_context(Context),
report_warning("Warning: clause for builtin.\n"),
- { ModuleInfo = ModuleInfo0 },
+ { ModuleInfo = ModuleInfo1 },
{ Info = Info0 }
;
{ pred_info_clauses_info(PredInfo1, Clauses0) },
@@ -3009,7 +3243,7 @@
ClauseVarSet, TVarSet0, Args, Body, Context,
PredOrFunc, Arity, IsAssertion, Goal,
VarSet, TVarSet, Clauses, Warnings,
- ModuleInfo0, ModuleInfo1, Info0, Info),
+ ModuleInfo1, ModuleInfo2, Info0, Info),
{
pred_info_set_clauses_info(PredInfo2, Clauses, PredInfo3),
(
@@ -3037,9 +3271,9 @@
PredInfo = PredInfo6
),
map__det_update(Preds0, PredId, PredInfo, Preds),
- predicate_table_set_preds(PredicateTable1, Preds,
+ predicate_table_set_preds(PredicateTable2, Preds,
PredicateTable),
- module_info_set_predicate_table(ModuleInfo1, PredicateTable,
+ module_info_set_predicate_table(ModuleInfo2, PredicateTable,
ModuleInfo)
},
( { Status \= opt_imported } ->
@@ -3129,19 +3363,19 @@
PredOrFunc, PredName, Arity, [PredId0]) }
->
{ PredId = PredId0 },
- { PredicateTable1 = PredicateTable0 }
+ { ModuleInfo1 = ModuleInfo0 }
;
- maybe_undefined_pred_error(PredName, Arity, PredOrFunc,
- Context, "`:- pragma import' declaration"),
- { preds_add_implicit(ModuleInfo0, PredicateTable0,
- ModuleName, PredName, Arity, Status, Context,
- PredOrFunc, PredId, PredicateTable1) }
+ preds_add_implicit_report_error(ModuleName,
+ PredOrFunc, PredName, Arity, Status, Context,
+ "`:- pragma import' declaration",
+ PredId, ModuleInfo0, ModuleInfo1)
),
%
% Lookup the pred_info for this pred,
% and check that it is valid.
%
- { predicate_table_get_preds(PredicateTable1, Preds0) },
+ { module_info_get_predicate_table(ModuleInfo1, PredicateTable2) },
+ { predicate_table_get_preds(PredicateTable2, Preds0) },
{ map__lookup(Preds0, PredId, PredInfo0) },
% opt_imported preds are initially tagged as imported and are
% tagged as opt_imported only if/when we see a clause (including
@@ -3154,7 +3388,7 @@
(
{ pred_info_is_imported(PredInfo1) }
->
- { module_info_incr_errors(ModuleInfo0, ModuleInfo) },
+ { module_info_incr_errors(ModuleInfo1, ModuleInfo) },
prog_out__write_context(Context),
io__write_string("Error: `:- pragma import' "),
io__write_string("declaration for imported "),
@@ -3164,7 +3398,7 @@
;
{ pred_info_get_goal_type(PredInfo1, clauses) }
->
- { module_info_incr_errors(ModuleInfo0, ModuleInfo) },
+ { module_info_incr_errors(ModuleInfo1, ModuleInfo) },
prog_out__write_context(Context),
io__write_string("Error: `:- pragma import' declaration "),
io__write_string("for "),
@@ -3182,18 +3416,18 @@
{ map__to_assoc_list(Procs, ExistingProcs) },
(
{ get_procedure_matching_argmodes(ExistingProcs, Modes,
- ModuleInfo0, ProcId) }
+ ModuleInfo1, ProcId) }
->
pred_add_pragma_import(PredInfo2, PredId, ProcId,
Attributes, C_Function, Context,
- ModuleInfo0, PredInfo, Info0, Info),
+ ModuleInfo1, PredInfo, Info0, Info),
{ map__det_update(Preds0, PredId, PredInfo, Preds) },
- { predicate_table_set_preds(PredicateTable1, Preds,
+ { predicate_table_set_preds(PredicateTable2, Preds,
PredicateTable) },
- { module_info_set_predicate_table(ModuleInfo0,
+ { module_info_set_predicate_table(ModuleInfo1,
PredicateTable, ModuleInfo) }
;
- { module_info_incr_errors(ModuleInfo0, ModuleInfo) },
+ { module_info_incr_errors(ModuleInfo1, ModuleInfo) },
io__stderr_stream(StdErr),
io__set_output_stream(StdErr, OldStream),
prog_out__write_context(Context),
@@ -3437,17 +3671,17 @@
PredOrFunc, PredName, Arity, [PredId0]) }
->
{ PredId = PredId0 },
- { PredicateTable1 = PredicateTable0 }
+ { ModuleInfo1 = ModuleInfo0 }
;
- maybe_undefined_pred_error(PredName, Arity, PredOrFunc,
- Context, "`:- pragma c_code' declaration"),
- { preds_add_implicit(ModuleInfo0, PredicateTable0,
- ModuleName, PredName, Arity, Status, Context,
- PredOrFunc, PredId, PredicateTable1) }
+ preds_add_implicit_report_error(ModuleName,
+ PredOrFunc, PredName, Arity, Status, Context,
+ "`:- pragma c_code' declaration",
+ PredId, ModuleInfo0, ModuleInfo1)
),
% Lookup the pred_info for this pred,
% add the pragma to the proc_info in the proc_table in the
% pred_info, and save the pred_info.
+ { module_info_get_predicate_table(ModuleInfo1, PredicateTable1) },
{ predicate_table_get_preds(PredicateTable1, Preds0) },
{ map__lookup(Preds0, PredId, PredInfo0) },
% opt_imported preds are initially tagged as imported and are
@@ -3461,7 +3695,7 @@
(
{ pred_info_is_imported(PredInfo1) }
->
- { module_info_incr_errors(ModuleInfo0, ModuleInfo) },
+ { module_info_incr_errors(ModuleInfo1, ModuleInfo) },
prog_out__write_context(Context),
io__write_string("Error: `:- pragma c_code' "),
io__write_string("declaration for imported "),
@@ -3471,7 +3705,7 @@
;
{ pred_info_get_goal_type(PredInfo1, clauses) }
->
- { module_info_incr_errors(ModuleInfo0, ModuleInfo) },
+ { module_info_incr_errors(ModuleInfo1, ModuleInfo) },
prog_out__write_context(Context),
io__write_string("Error: `:- pragma c_code' declaration "),
io__write_string("for "),
@@ -3487,7 +3721,7 @@
{ pragma_get_modes(PVars, Modes) },
(
{ get_procedure_matching_argmodes(ExistingProcs, Modes,
- ModuleInfo0, ProcId) }
+ ModuleInfo1, ProcId) }
->
{ pred_info_clauses_info(PredInfo1, Clauses0) },
{ pred_info_arg_types(PredInfo1, ArgTypes) },
@@ -3504,14 +3738,14 @@
{ map__det_update(Preds0, PredId, PredInfo, Preds) },
{ predicate_table_set_preds(PredicateTable1, Preds,
PredicateTable) },
- { module_info_set_predicate_table(ModuleInfo0,
+ { module_info_set_predicate_table(ModuleInfo1,
PredicateTable, ModuleInfo) },
{ pragma_get_var_infos(PVars, ArgInfo) },
maybe_warn_pragma_singletons(PragmaImpl, ArgInfo,
Context, PredOrFunc - PredName/Arity,
ModuleInfo)
;
- { module_info_incr_errors(ModuleInfo0, ModuleInfo) },
+ { module_info_incr_errors(ModuleInfo1, ModuleInfo) },
io__stderr_stream(StdErr),
io__set_output_stream(StdErr, OldStream),
prog_out__write_context(Context),
@@ -3559,13 +3793,10 @@
{ module_info_name(ModuleInfo0, ModuleName) },
{ string__format("`:- pragma %s' declaration",
[s(EvalMethodS)], Message1) },
- maybe_undefined_pred_error(PredName, Arity,
- PredOrFunc, Context, Message1),
- { preds_add_implicit(ModuleInfo0, PredicateTable0,
- ModuleName, PredName, Arity, Status, Context,
- PredOrFunc, PredId, PredicateTable1) },
- { module_info_set_predicate_table(ModuleInfo0,
- PredicateTable1, ModuleInfo1) },
+
+ preds_add_implicit_report_error(ModuleName,
+ PredOrFunc, PredName, Arity, Status, Context,
+ Message1, PredId, ModuleInfo0, ModuleInfo1),
{ PredIds = [PredId] }
)
;
@@ -3579,13 +3810,10 @@
{ module_info_name(ModuleInfo0, ModuleName) },
{ string__format("`:- pragma %s' declaration",
[s(EvalMethodS)], Message1) },
- maybe_undefined_pred_error(PredName, Arity,
- predicate, Context, Message1),
- { preds_add_implicit(ModuleInfo0, PredicateTable0,
- ModuleName, PredName, Arity, Status, Context,
- predicate, PredId, PredicateTable1) },
- { module_info_set_predicate_table(ModuleInfo0,
- PredicateTable1, ModuleInfo1) },
+
+ preds_add_implicit_report_error(ModuleName,
+ predicate, PredName, Arity, Status, Context,
+ Message1, PredId, ModuleInfo0, ModuleInfo1),
{ PredIds = [PredId] }
)
),
@@ -4458,7 +4686,7 @@
{ update_qual_info(Info0, TVarSet0, VarTypes0, PredId, Info1) },
{ varset__merge_subst(VarSet0, CVarSet, VarSet1, Subst) },
transform(Subst, HeadVars, Args, Body, VarSet1, Context, PredOrFunc,
- Arity, IsAssertion, Goal, VarSet, Warnings,
+ Arity, IsAssertion, Goal0, VarSet, Warnings,
Module0, Module, Info1, Info2),
{ qual_info_get_found_syntax_error(Info2, FoundError) },
{ qual_info_set_found_syntax_error(no, Info2, Info) },
@@ -4467,9 +4695,14 @@
% Don't insert clauses containing syntax errors into
% the clauses_info, because doing that would cause
% typecheck.m to report spurious type errors.
- { ClausesInfo = ClausesInfo0 }
+ { ClausesInfo = ClausesInfo0 },
+ % Don't report singleton variable warnings if there
+ % were syntax errors.
+ { true_goal(Goal) }
;
{ FoundError = no },
+ { Goal = Goal0 },
+
% XXX we should avoid append - this gives O(N*N)
{ list__append(ClauseList0, [clause(ModeIds, Goal, Context)],
ClauseList) },
@@ -4741,6 +4974,16 @@
transform_goal_2(not(unify(LHS, RHS) - Context), Context,
VarSet0, Subst, Goal, VarSet, Info0, Info)
;
+ % check for a DCG field access goal:
+ % get: Field := ^ field
+ % set: ^ field := Field
+ { Name = unqualified(":=") }
+ ->
+ { term__apply_substitution_to_list(Args0, Subst, Args1) },
+ transform_dcg_record_syntax(Args1, Context,
+ VarSet0, Goal, VarSet, Info0, Info)
+ ;
+ % check for an Aditi builtin
{ Purity = pure },
{ Name = unqualified(Name1) },
{ Name1 = "aditi_insert"
@@ -4803,9 +5046,9 @@
Purity1 = Purity
}
),
- { goal_info_init(GoalInfo0) },
- { goal_info_set_context(GoalInfo0, Context, GoalInfo1) },
- { add_goal_info_purity_feature(GoalInfo1, Purity1, GoalInfo) },
+ { goal_info_init(Context, GoalInfo0) },
+ { add_goal_info_purity_feature(GoalInfo0,
+ Purity1, GoalInfo) },
{ Goal0 = Call - GoalInfo },
insert_arg_unifications(HeadVars, Args,
@@ -4828,6 +5071,400 @@
; "aditi_modify"
).
+:- pred transform_dcg_record_syntax(list(prog_term), prog_context,
+ prog_varset, hlds_goal, prog_varset, qual_info, qual_info,
+ io__state, io__state).
+:- mode transform_dcg_record_syntax(in, in, in, out, out,
+ in, out, di, uo) is det.
+
+transform_dcg_record_syntax(ArgTerms0, Context, VarSet0,
+ Goal, VarSet, Info0, Info) -->
+ { goal_info_init(Context, GoalInfo) },
+ (
+ { ArgTerms0 = [LHSTerm, RHSTerm,
+ TermInputTerm, TermOutputTerm] },
+ {
+ LHSTerm = term__functor(term__atom("^"),
+ [FieldNameTerm0], _)
+ ->
+ FieldNameTerm = FieldNameTerm0,
+ FieldValueTerm = RHSTerm,
+ AccessType = set
+ ;
+ RHSTerm = term__functor(term__atom("^"),
+ [FieldNameTerm], _),
+ FieldValueTerm = LHSTerm,
+ AccessType = get
+ }
+ ->
+ { parse_field_name_list(FieldNameTerm, MaybeFieldNames) },
+ (
+ { MaybeFieldNames = ok(FieldNames) },
+ { ArgTerms = [FieldValueTerm, TermInputTerm,
+ TermOutputTerm] },
+
+ transform_dcg_record_syntax_2(AccessType,
+ FieldNames, ArgTerms, Context, VarSet0, Goal,
+ VarSet, Info0, Info)
+ ;
+ { MaybeFieldNames = error(Msg, ErrorTerm) },
+ { invalid_goal("^", ArgTerms0, GoalInfo,
+ Goal, VarSet0, VarSet) },
+ { qual_info_set_found_syntax_error(yes, Info0, Info) },
+ io__set_exit_status(1),
+ prog_out__write_context(Context),
+ io__write_string("In DCG field "),
+ (
+ { AccessType = set },
+ io__write_string("update")
+ ;
+ { AccessType = get },
+ io__write_string("extraction")
+ ),
+ io__write_string(" goal:\n"),
+ prog_out__write_context(Context),
+ io__write_string(" error: "),
+ io__write_string(Msg),
+ io__write_string(" at term `"),
+ term_io__write_term(VarSet, ErrorTerm),
+ io__write_string("'.\n")
+ )
+ ;
+ { invalid_goal("^", ArgTerms0, GoalInfo,
+ Goal, VarSet0, VarSet) },
+ { qual_info_set_found_syntax_error(yes, Info0, Info) },
+ io__set_exit_status(1),
+ prog_out__write_context(Context),
+ io__write_string(
+ "Error: expected `Field := ^ field1 ^ ... ^ fieldN'\n"),
+ prog_out__write_context(Context),
+ io__write_string(" or `^ field1 ^ ... ^ fieldN := Field'.\n"),
+ prog_out__write_context(Context),
+ io__write_string(" in DCG field access goal.\n")
+ ).
+
+:- pred transform_dcg_record_syntax_2(field_access_type,
+ list(ctor_field_name), list(prog_term), prog_context,
+ prog_varset, hlds_goal, prog_varset,
+ qual_info, qual_info, io__state, io__state).
+:- mode transform_dcg_record_syntax_2(in, in, in, in, in, out, out,
+ in, out, di, uo) is det.
+
+transform_dcg_record_syntax_2(AccessType, FieldNames, ArgTerms, Context,
+ VarSet0, Goal, VarSet, Info0, Info, IO0, IO) :-
+ make_fresh_arg_vars(ArgTerms, VarSet0, ArgVars, VarSet1),
+ ( ArgVars = [FieldValueVar, TermInputVar, TermOutputVar] ->
+ (
+ AccessType = set,
+ expand_set_field_function_call(Context, explicit, [],
+ FieldNames, FieldValueVar, TermInputVar,
+ TermOutputVar, VarSet1, VarSet2, Functor,
+ InnermostFunctor - InnermostSubContext, Goal0),
+
+
+ FieldArgNumber = 2,
+ FieldArgContext = functor(InnermostFunctor, explicit,
+ InnermostSubContext),
+ InputTermArgNumber = 1,
+ InputTermArgContext = functor(Functor, explicit, []),
+ ( Functor = cons(FuncName0, FuncArity0) ->
+ FuncName = FuncName0,
+ FuncArity = FuncArity0
+ ;
+ error("transform_dcg_record_syntax_2")
+ ),
+ % DCG arguments should always be distinct variables,
+ % so this context should never be used.
+ OutputTermArgNumber = 3,
+ OutputTermArgContext = call(
+ call(function - FuncName/FuncArity)),
+
+ ArgContexts = [
+ FieldArgNumber - FieldArgContext,
+ InputTermArgNumber - InputTermArgContext,
+ OutputTermArgNumber - OutputTermArgContext
+ ],
+ insert_arg_unifications_with_supplied_contexts(ArgVars,
+ ArgTerms, ArgContexts, Context, Goal0, VarSet2,
+ Goal, VarSet, Info0, Info, IO0, IO)
+ ;
+ AccessType = get,
+ expand_dcg_field_extraction_goal(Context, explicit,
+ [], FieldNames, FieldValueVar, TermInputVar,
+ TermOutputVar, VarSet1, VarSet2, Functor,
+ InnermostFunctor - _InnerSubContext, Goal0),
+ InputTermArgNumber = 1,
+ InputTermArgContext = functor(Functor, explicit, []),
+
+ ( InnermostFunctor = cons(FuncName0, FuncArity0) ->
+ FuncName = FuncName0,
+ FuncArity = FuncArity0
+ ;
+ error("transform_dcg_record_syntax_2")
+ ),
+ FieldArgNumber = 2,
+ FieldArgContext = call(
+ call(function - FuncName/FuncArity)),
+
+ % DCG arguments should always be distinct variables,
+ % so this context should never be used.
+ OutputTermArgNumber = 1,
+ OutputTermArgContext = functor(Functor, explicit, []),
+ ArgContexts = [
+ FieldArgNumber - FieldArgContext,
+ InputTermArgNumber - InputTermArgContext,
+ OutputTermArgNumber - OutputTermArgContext
+ ],
+ insert_arg_unifications_with_supplied_contexts(ArgVars,
+ ArgTerms, ArgContexts, Context, Goal0, VarSet2,
+ Goal, VarSet, Info0, Info, IO0, IO)
+ )
+ ;
+ error("make_hlds__do_transform_dcg_record_syntax")
+ ).
+
+ % Expand a field update goal into a list of goals which
+ % each get or set one level of the structure.
+ %
+ % A field update goal:
+ % Term = Term0 ^ module_info ^ ctors := Ctors
+ % is expanded into
+ % V_1 = Term0 ^ module_info,
+ % V_3 = V_2 ^ ctors := Ctors,
+ % Term = Term0 ^ module_info := V_3.
+ %
+:- pred expand_set_field_function_call(prog_context,
+ unify_main_context, unify_sub_contexts,
+ list(ctor_field_name), prog_var, prog_var,
+ prog_var, prog_varset, prog_varset, cons_id,
+ pair(cons_id, unify_sub_contexts), hlds_goal).
+:- mode expand_set_field_function_call(in, in, in, in, in, in,
+ in, in, out, out, out, out) is det.
+
+expand_set_field_function_call(Context, MainContext, SubContext0,
+ FieldNames, FieldValueVar, TermInputVar,
+ TermOutputVar, VarSet0, VarSet,
+ Functor, FieldSubContext, Goal) :-
+ expand_set_field_function_call_2(Context, MainContext,
+ SubContext0, FieldNames, FieldValueVar, TermInputVar,
+ TermOutputVar, VarSet0, VarSet,
+ Functor, FieldSubContext, Goals),
+ wrap_field_access_goals(Context, Goals, Goal).
+
+:- pred expand_set_field_function_call_2(prog_context,
+ unify_main_context, unify_sub_contexts,
+ list(ctor_field_name), prog_var, prog_var,
+ prog_var, prog_varset, prog_varset, cons_id,
+ pair(cons_id, unify_sub_contexts), list(hlds_goal)).
+:- mode expand_set_field_function_call_2(in, in, in, in, in, in,
+ in, in, out, out, out, out) is det.
+
+expand_set_field_function_call_2(_, _, _, [], _, _, _, _, _, _, _, _) :-
+ error("expand_set_field_function_call_2: empty list of field names").
+expand_set_field_function_call_2(Context, MainContext, SubContext0,
+ [FieldName | FieldNames], FieldValueVar, TermInputVar,
+ TermOutputVar, VarSet0, VarSet, Functor, FieldSubContext,
+ Goals) :-
+ ( FieldNames = [_|_] ->
+ varset__new_var(VarSet0, SubTermInputVar, VarSet1),
+ varset__new_var(VarSet1, SubTermOutputVar, VarSet2),
+
+ construct_field_access_function_call(set, Context,
+ MainContext, SubContext0, FieldName,
+ TermOutputVar, [TermInputVar, SubTermOutputVar],
+ Functor, UpdateGoal),
+
+ % extract the field containing the field to update.
+ construct_field_access_function_call(get, Context, MainContext,
+ SubContext0, FieldName, SubTermInputVar,
+ [TermInputVar], _, GetSubFieldGoal),
+
+ % recursively update the field.
+ SubTermInputArgNumber = 2,
+ TermInputContext = Functor - SubTermInputArgNumber,
+ SubContext = [TermInputContext | SubContext0],
+ expand_set_field_function_call_2(Context, MainContext,
+ SubContext, FieldNames, FieldValueVar, SubTermInputVar,
+ SubTermOutputVar, VarSet2, VarSet, _,
+ FieldSubContext, Goals0),
+
+ list__append([GetSubFieldGoal | Goals0], [UpdateGoal], Goals)
+ ;
+ VarSet = VarSet0,
+ construct_field_access_function_call(set, Context,
+ MainContext, SubContext0, FieldName,
+ TermOutputVar, [TermInputVar, FieldValueVar],
+ Functor, Goal),
+ FieldSubContext = Functor - SubContext0,
+ Goals = [Goal]
+ ).
+
+ % Expand a field extraction goal into a list of goals which
+ % each get one level of the structure.
+ %
+ % A field extraction goal:
+ % := (ModuleName, ^ module_info ^ sub_info ^ module_name,
+ % DCG_in, DCG_out).
+ % is expanded into
+ % DCG_out = DCG_in,
+ % V_1 = DCG_out ^ module_info
+ % V_2 = V_1 ^ sub_info,
+ % ModuleName = V_2 ^ module_name.
+ %
+:- pred expand_dcg_field_extraction_goal(prog_context, unify_main_context,
+ unify_sub_contexts, list(ctor_field_name), prog_var, prog_var,
+ prog_var, prog_varset, prog_varset, cons_id,
+ pair(cons_id, unify_sub_contexts), hlds_goal).
+:- mode expand_dcg_field_extraction_goal(in, in, in, in, in,
+ in, in, in, out, out, out, out) is det.
+
+expand_dcg_field_extraction_goal(Context, MainContext, SubContext,
+ FieldNames, FieldValueVar, TermInputVar, TermOutputVar,
+ VarSet0, VarSet, Functor, FieldSubContext, Goal) :-
+ % unify the DCG input and output variables
+ create_atomic_unification(TermOutputVar, var(TermInputVar),
+ Context, MainContext, SubContext, UnifyDCG),
+
+ % process the access function as a get function on
+ % the output DCG variable
+ expand_get_field_function_call_2(Context, MainContext, SubContext,
+ FieldNames, FieldValueVar, TermOutputVar,
+ VarSet0, VarSet, Functor, FieldSubContext, Goals1),
+ Goals = [UnifyDCG | Goals1],
+ wrap_field_access_goals(Context, Goals, Goal).
+
+ % Expand a field extraction function call into a list of goals which
+ % each get one level of the structure.
+ %
+ % A field extraction goal:
+ % ModuleName = Info ^ module_info ^ sub_info ^ module_name
+ % is expanded into
+ % V_1 = Info ^ module_info,
+ % V_2 = V_1 ^ sub_info,
+ % ModuleName = V_2 ^ module_name.
+ %
+:- pred expand_get_field_function_call(prog_context, unify_main_context,
+ unify_sub_contexts, list(ctor_field_name), prog_var,
+ prog_var, prog_varset, prog_varset, cons_id,
+ pair(cons_id, unify_sub_contexts), hlds_goal).
+:- mode expand_get_field_function_call(in, in, in, in, in,
+ in, in, out, out, out, out) is det.
+
+expand_get_field_function_call(Context, MainContext, SubContext0,
+ FieldNames, FieldValueVar, TermInputVar,
+ VarSet0, VarSet, Functor, FieldSubContext, Goal) :-
+ expand_get_field_function_call_2(Context, MainContext, SubContext0,
+ FieldNames, FieldValueVar, TermInputVar,
+ VarSet0, VarSet, Functor, FieldSubContext, Goals),
+ wrap_field_access_goals(Context, Goals, Goal).
+
+:- pred expand_get_field_function_call_2(prog_context, unify_main_context,
+ unify_sub_contexts, list(ctor_field_name), prog_var,
+ prog_var, prog_varset, prog_varset, cons_id,
+ pair(cons_id, unify_sub_contexts), list(hlds_goal)).
+:- mode expand_get_field_function_call_2(in, in, in, in, in,
+ in, in, out, out, out, out) is det.
+
+expand_get_field_function_call_2(_, _, _, [], _, _, _, _, _, _, _) :-
+ error("expand_get_field_function_call_2: empty list of field names").
+expand_get_field_function_call_2(Context, MainContext, SubContext0,
+ [FieldName | FieldNames], FieldValueVar, TermInputVar,
+ VarSet0, VarSet, Functor, FieldSubContext, Goals) :-
+ ( FieldNames = [_|_] ->
+ varset__new_var(VarSet0, SubTermInputVar, VarSet1),
+ construct_field_access_function_call(get, Context, MainContext,
+ SubContext0, FieldName, SubTermInputVar,
+ [TermInputVar], Functor, Goal),
+
+ % recursively extract until we run out of field names
+ TermInputArgNumber = 1,
+ TermInputContext = Functor - TermInputArgNumber,
+ SubContext = [TermInputContext | SubContext0],
+ expand_get_field_function_call_2(Context, MainContext,
+ SubContext, FieldNames, FieldValueVar, SubTermInputVar,
+ VarSet1, VarSet, _, FieldSubContext, Goals1),
+ Goals = [Goal | Goals1]
+ ;
+ VarSet = VarSet0,
+ FieldSubContext = Functor - SubContext0,
+ construct_field_access_function_call(get, Context, MainContext,
+ SubContext0, FieldName, FieldValueVar,
+ [TermInputVar], Functor, Goal),
+ Goals = [Goal]
+ ).
+
+:- pred construct_field_access_function_call(field_access_type, prog_context,
+ unify_main_context, unify_sub_contexts, ctor_field_name,
+ prog_var, list(prog_var), cons_id, hlds_goal).
+:- mode construct_field_access_function_call(in, in, in, in, in,
+ in, in, out, out) is det.
+
+construct_field_access_function_call(AccessType, Context,
+ MainContext, SubContext, FieldName, RetArg, Args,
+ Functor, Goal) :-
+ field_access_function_name(AccessType, FieldName,
+ non_builtin_field_access, FuncName),
+ list__length(Args, Arity),
+ Functor = cons(FuncName, Arity),
+ create_atomic_unification(RetArg, functor(Functor, Args),
+ Context, MainContext, SubContext, Goal).
+
+ % 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
+ ).
+
+:- pred parse_field_name_list(prog_term,
+ maybe1(list(ctor_field_name), prog_var_type)).
+:- mode parse_field_name_list(in, out) is det.
+
+parse_field_name_list(Term, MaybeFieldNames) :-
+ (
+ Term = term__functor(term__atom("^"),
+ [FieldNameTerm, OtherFieldNamesTerm], _)
+ ->
+ (
+ parse_qualified_term(FieldNameTerm, FieldNameTerm,
+ "field name", Result),
+ Result = ok(FieldName, [])
+ ->
+ parse_field_name_list(OtherFieldNamesTerm,
+ MaybeFieldNames1),
+ (
+ MaybeFieldNames1 = error(_, _),
+ MaybeFieldNames = MaybeFieldNames1
+ ;
+ MaybeFieldNames1 = ok(FieldNames1),
+ MaybeFieldNames =
+ ok([FieldName | FieldNames1])
+ )
+ ;
+ MaybeFieldNames = error("expected field name",
+ FieldNameTerm)
+ )
+ ;
+ (
+ parse_qualified_term(Term, Term, "field name", Result),
+ Result = ok(FieldName, [])
+ ->
+ MaybeFieldNames = ok([FieldName])
+ ;
+ MaybeFieldNames = error("expected field name",
+ Term)
+ )
+ ).
+
+%-----------------------------------------------------------------------------%
+
% See the "Aditi update syntax" section of the
% Mercury Language Reference Manual.
:- pred transform_aditi_builtin(string, list(prog_term), prog_context,
@@ -4839,9 +5476,7 @@
transform_aditi_builtin("aditi_insert", Args0, Context, VarSet0,
Goal, VarSet, Info0, Info) -->
% Build an empty goal_info.
- { goal_info_init(GoalInfo0) },
- { goal_info_set_context(GoalInfo0, Context, GoalInfo1) },
- { add_goal_info_purity_feature(GoalInfo1, pure, GoalInfo) },
+ { goal_info_init(Context, GoalInfo) },
%
% Syntax -
@@ -4881,20 +5516,16 @@
Goal0 = Call - GoalInfo,
CallId = generic_call(aditi_builtin(Builtin,
InsertCallId)),
- ArgContext = functor(cons(SymName, InsertArity),
- call(CallId, 1), [])
+ list__append(TupleArgTerms,
+ [AditiState0Term, AditiStateTerm],
+ AllArgTerms)
},
- insert_arg_unifications(TupleArgVars, TupleArgTerms,
- Context, ArgContext, no,
- Goal0, VarSet3, Goal1, VarSet4, Info0, Info1),
- insert_arg_unifications(
- [AditiState0Var, AditiStateVar],
- [AditiState0Term, AditiStateTerm],
+ insert_arg_unifications(AllArgs, AllArgTerms,
Context, call(CallId), no,
- Goal1, VarSet4, Goal, VarSet, Info1, Info)
+ Goal0, VarSet3, Goal, VarSet, Info0, Info)
;
- { invalid_aditi_update_goal("aditi_insert",
+ { invalid_goal("aditi_insert",
Args0, GoalInfo, Goal, VarSet0, VarSet) },
{ qual_info_set_found_syntax_error(yes, Info0, Info) },
io__set_exit_status(1),
@@ -4903,7 +5534,7 @@
"Error: expected tuple to insert in `aditi_insert'.\n")
)
;
- { invalid_aditi_update_goal("aditi_insert", Args0, GoalInfo,
+ { invalid_goal("aditi_insert", Args0, GoalInfo,
Goal, VarSet0, VarSet) },
{ qual_info_set_found_syntax_error(yes, Info0, Info) },
{ list__length(Args0, Arity) },
@@ -4937,15 +5568,13 @@
transform_delete_or_modify(DelOrMod, Args0, Context, VarSet0,
UpdateGoal, VarSet, Info0, Info) -->
- { goal_info_init(GoalInfo0) },
- { goal_info_set_context(GoalInfo0, Context, GoalInfo1) },
- { add_goal_info_purity_feature(GoalInfo1, pure, GoalInfo) },
+ { goal_info_init(Context, GoalInfo) },
(
{ list__length(Args0, Arity) },
{ Arity \= 3 },
{ Arity \= 4 }
->
- { invalid_aditi_update_goal(DelOrMod, Args0, GoalInfo,
+ { invalid_goal(DelOrMod, Args0, GoalInfo,
UpdateGoal, VarSet0, VarSet) },
{ qual_info_set_found_syntax_error(yes, Info0, Info) },
aditi_update_arity_error(Context, DelOrMod, Arity, [3, 4])
@@ -5132,7 +5761,7 @@
insert_arg_unifications(OtherArgs, OtherArgs0, Context, CallId,
no, Call, VarSet1, UpdateGoal, VarSet, Info0, Info)
;
- { invalid_aditi_update_goal(DelOrMod, Args0, GoalInfo,
+ { invalid_goal(DelOrMod, Args0, GoalInfo,
UpdateGoal, VarSet0, VarSet) },
{ qual_info_set_found_syntax_error(yes, Info0, Info) },
io__set_exit_status(1),
@@ -5173,9 +5802,7 @@
transform_bulk_update(UpdateStr, BulkOp, Args0, Context, VarSet0, Goal, VarSet,
Info0, Info) -->
- { goal_info_init(GoalInfo0) },
- { goal_info_set_context(GoalInfo0, Context, GoalInfo1) },
- { add_goal_info_purity_feature(GoalInfo1, pure, GoalInfo) },
+ { goal_info_init(Context, GoalInfo) },
(
{ Args0 = [PredCallIdTerm | OtherArgs0] },
% Higher-order term + threaded `aditi__state's
@@ -5208,7 +5835,7 @@
aditi_builtin(Builtin, ModifiedCallId))),
no, Call, VarSet1, Goal, VarSet, Info0, Info)
;
- { invalid_aditi_update_goal(UpdateStr,
+ { invalid_goal(UpdateStr,
Args0, GoalInfo, Goal, VarSet0, VarSet) },
{ qual_info_set_found_syntax_error(yes, Info0, Info) },
io__set_exit_status(1),
@@ -5219,7 +5846,7 @@
io__write_string("'.\n")
)
;
- { invalid_aditi_update_goal(UpdateStr, Args0, GoalInfo, Goal,
+ { invalid_goal(UpdateStr, Args0, GoalInfo, Goal,
VarSet0, VarSet) },
{ qual_info_set_found_syntax_error(yes, Info0, Info) },
{ list__length(Args0, Arity) },
@@ -5246,11 +5873,11 @@
io__write_string("'.\n").
% Produce an invalid goal when parsing of an Aditi update fails.
-:- pred invalid_aditi_update_goal(string, list(prog_term), hlds_goal_info,
+:- pred invalid_goal(string, list(prog_term), hlds_goal_info,
hlds_goal, prog_varset, prog_varset).
-:- mode invalid_aditi_update_goal(in, in, in, out, in, out) is det.
+:- mode invalid_goal(in, in, in, out, in, out) is det.
-invalid_aditi_update_goal(UpdateStr, Args0, GoalInfo, Goal, VarSet0, VarSet) :-
+invalid_goal(UpdateStr, Args0, GoalInfo, Goal, VarSet0, VarSet) :-
invalid_pred_id(PredId),
invalid_proc_id(ProcId),
make_fresh_arg_vars(Args0, VarSet0, HeadVars, VarSet),
@@ -5333,19 +5960,102 @@
insert_arg_unifications_2([Var|Vars], [Arg|Args], Context, ArgContext,
ForPragmaC, N0, List0, VarSet0, List, VarSet, Info0, Info) -->
{ N1 is N0 + 1 },
+ insert_arg_unification(Var, Arg, Context, ArgContext,
+ ForPragmaC, N1, List0, VarSet0, List1, VarSet1, ArgUnifyConj,
+ Info0, Info1),
(
+ { ArgUnifyConj = [] }
+ ->
+ insert_arg_unifications_2(Vars, Args, Context, ArgContext,
+ ForPragmaC, N1, List1, VarSet1, List, VarSet,
+ Info1, Info)
+ ;
+ insert_arg_unifications_2(Vars, Args, Context, ArgContext,
+ ForPragmaC, N1, List1, VarSet1, List2, VarSet,
+ Info1, Info),
+ { list__append(ArgUnifyConj, List2, List) }
+ ).
+
+:- pred insert_arg_unifications_with_supplied_contexts(list(prog_var),
+ list(prog_term), assoc_list(int, arg_context), prog_context,
+ hlds_goal, prog_varset, hlds_goal, prog_varset,
+ qual_info, qual_info, io__state, io__state).
+:- mode insert_arg_unifications_with_supplied_contexts(in, in, in, in, in, in,
+ out, out, in, out, di, uo) is det.
+
+insert_arg_unifications_with_supplied_contexts(ArgVars,
+ ArgTerms, ArgContexts, Context, Goal0, VarSet0,
+ Goal, VarSet, Info0, Info) -->
+ ( { ArgVars = [] } ->
+ { Goal = Goal0 },
+ { VarSet = VarSet0 },
+ { Info = Info0 }
+ ;
+ { Goal0 = _ - GoalInfo0 },
+ { goal_to_conj_list(Goal0, GoalList0) },
+ insert_arg_unifications_with_supplied_contexts_2(ArgVars,
+ ArgTerms, ArgContexts, Context, GoalList0,
+ VarSet0, GoalList, VarSet, Info0, Info),
+ { goal_info_set_context(GoalInfo0, Context, GoalInfo) },
+ { conj_list_to_goal(GoalList, GoalInfo, Goal) }
+ ).
+
+:- pred insert_arg_unifications_with_supplied_contexts_2(list(prog_var),
+ list(prog_term), assoc_list(int, arg_context), prog_context,
+ list(hlds_goal), prog_varset, list(hlds_goal), prog_varset,
+ qual_info, qual_info, io__state, io__state).
+:- mode insert_arg_unifications_with_supplied_contexts_2(in, in, in, in, in,
+ in, out, out, in, out, di, uo) is det.
+
+insert_arg_unifications_with_supplied_contexts_2(Vars, Terms, ArgContexts,
+ Context, List0, VarSet0, List, VarSet, Info0, Info) -->
+ (
+ { Vars = [], Terms = [], ArgContexts = [] }
+ ->
+ { List = List0 },
+ { VarSet = VarSet0 },
+ { Info = Info0 }
+ ;
+ { Vars = [Var | Vars1] },
+ { Terms = [Term | Terms1] },
+ { ArgContexts = [ArgNumber - ArgContext | ArgContexts1] }
+ ->
+ insert_arg_unification(Var, Term, Context, ArgContext, no,
+ ArgNumber, List0, VarSet0, List1, VarSet1,
+ UnifyConj, Info0, Info1),
+ insert_arg_unifications_with_supplied_contexts_2(Vars1, Terms1,
+ ArgContexts1, Context, List1, VarSet1, List2, VarSet,
+ Info1, Info),
+ { list__append(UnifyConj, List2, List) }
+ ;
+ { error("insert_arg_unifications_with_supplied_contexts") }
+ ).
+
+:- pred insert_arg_unification(prog_var, prog_term,
+ prog_context, arg_context, bool, int,
+ list(hlds_goal), prog_varset, list(hlds_goal), prog_varset,
+ list(hlds_goal), qual_info, qual_info, io__state, io__state).
+:- mode insert_arg_unification(in, in, in, in, in, in,
+ in, in, out, out, out, in, out, di, uo) is det.
+
+insert_arg_unification(Var, Arg, Context, ArgContext, ForPragmaC, N1,
+ List0, VarSet0, List1, VarSet1, ArgUnifyConj, Info0, Info) -->
+ (
{ Arg = term__variable(Var) }
->
% Skip unifications of the form `X = X'
- insert_arg_unifications_2(Vars, Args, Context,
- ArgContext, ForPragmaC, N1, List0, VarSet0, List,
- VarSet, Info0, Info)
+ { VarSet1 = VarSet0 },
+ { Info = Info0 },
+ { ArgUnifyConj = [] },
+ { List1 = List0 }
;
{ Arg = term__variable(ArgVar) },
{ ForPragmaC = yes }
->
% Handle unifications of the form `X = Y' by substitution
% if this is safe.
+ { Info = Info0 },
+ { ArgUnifyConj = [] },
{ map__init(Subst0) },
{ map__det_insert(Subst0, ArgVar, Var, Subst) },
{ goal_util__rename_vars_in_goals(List0, no, Subst,
@@ -5354,21 +6064,15 @@
varset__name_var(VarSet0, Var, ArgVarName, VarSet1)
;
VarSet1 = VarSet0
- },
- insert_arg_unifications_2(Vars, Args, Context, ArgContext,
- ForPragmaC, N1, List1, VarSet1, List, VarSet,
- Info0, Info)
+ }
;
{ arg_context_to_unify_context(ArgContext, N1,
UnifyMainContext, UnifySubContext) },
unravel_unification(term__variable(Var), Arg,
Context, UnifyMainContext, UnifySubContext,
- VarSet0, Goal, VarSet1, Info0, Info1),
- { goal_to_conj_list(Goal, ConjList) },
- { list__append(ConjList, List1, List) },
- insert_arg_unifications_2(Vars, Args, Context, ArgContext,
- ForPragmaC, N1, List0, VarSet1, List1, VarSet,
- Info1, Info)
+ VarSet0, Goal, VarSet1, Info0, Info),
+ { goal_to_conj_list(Goal, ArgUnifyConj) },
+ { List1 = List0 }
).
% append_arg_unifications is the same as insert_arg_unifications,
@@ -5411,20 +6115,32 @@
append_arg_unifications_2([Var|Vars], [Arg|Args], Context, ArgContext, N0,
List0, VarSet0, List, VarSet, Info0, Info) -->
{ N1 is N0 + 1 },
- % skip unifications of the form `X = X'
+ append_arg_unification(Var, Arg, Context, ArgContext,
+ N1, ConjList, VarSet0, VarSet1, Info0, Info1),
+ { list__append(List0, ConjList, List1) },
+ append_arg_unifications_2(Vars, Args, Context, ArgContext, N1,
+ List1, VarSet1, List, VarSet, Info1, Info).
+
+:- pred append_arg_unification(prog_var, prog_term, prog_context, arg_context,
+ int, list(hlds_goal), prog_varset, prog_varset,
+ qual_info, qual_info, io__state, io__state).
+:- mode append_arg_unification(in, in, in, in, in, out, in,
+ out, in, out, di, uo) is det.
+
+append_arg_unification(Var, Arg, Context, ArgContext,
+ N1, ConjList, VarSet0, VarSet, Info0, Info) -->
( { Arg = term__variable(Var) } ->
- append_arg_unifications_2(Vars, Args, Context, ArgContext, N1,
- List0, VarSet0, List, VarSet, Info0, Info)
+ % skip unifications of the form `X = X'
+ { Info = Info0 },
+ { VarSet = VarSet0 },
+ { ConjList = [] }
;
{ arg_context_to_unify_context(ArgContext, N1,
- UnifyMainContext, UnifySubContext) },
+ UnifyMainContext, UnifySubContext) },
unravel_unification(term__variable(Var), Arg,
Context, UnifyMainContext, UnifySubContext,
- VarSet0, Goal, VarSet1, Info0, Info1),
- { goal_to_conj_list(Goal, ConjList) },
- { list__append(List0, ConjList, List1) },
- append_arg_unifications_2(Vars, Args, Context, ArgContext, N1,
- List1, VarSet1, List, VarSet, Info1, Info)
+ VarSet0, Goal, VarSet, Info0, Info),
+ { goal_to_conj_list(Goal, ConjList) }
).
:- pred arg_context_to_unify_context(arg_context, int,
@@ -5489,6 +6205,10 @@
%-----------------------------------------------------------------------------%
+ %
+ % XXX We could do better on the error messages for
+ % lambda expressions and field extraction and update expressions.
+ %
:- pred unravel_unification(prog_term, prog_term, prog_context,
unify_main_context, unify_sub_contexts, prog_varset, hlds_goal,
prog_varset, qual_info, qual_info, io__state, io__state).
@@ -5629,10 +6349,63 @@
{ map__init(Empty) },
{ IfThenElse = if_then_else(Vars, IfGoal, ThenGoal, ElseGoal,
Empty) },
- { goal_info_init(GoalInfo0) },
- { goal_info_set_context(GoalInfo0, Context, GoalInfo) },
+ { goal_info_init(Context, GoalInfo) },
{ Goal = IfThenElse - GoalInfo }
;
+ % handle field extraction expressions
+ { F = term__atom("^") },
+ { Args = [InputTerm, FieldNameTerm] },
+ { parse_field_name_list(FieldNameTerm, FieldNameResult) },
+ { FieldNameResult = ok(FieldNames) }
+ ->
+ { make_fresh_arg_var(InputTerm, InputTermVar, [],
+ VarSet0, VarSet1) },
+ { expand_get_field_function_call(Context, MainContext,
+ SubContext, FieldNames, X, InputTermVar,
+ VarSet1, VarSet2, Functor, _, Goal0) },
+
+ { ArgContext = functor(Functor, MainContext, SubContext) },
+ append_arg_unifications([InputTermVar], [InputTerm],
+ FunctorContext, ArgContext, Goal0,
+ VarSet2, Goal, VarSet, Info0, Info)
+ ;
+ % handle field update expressions
+ { F = term__atom(":=") },
+ { Args = [FieldDescrTerm, FieldValueTerm] },
+ { FieldDescrTerm = term__functor(term__atom("^"),
+ [InputTerm, FieldNameTerm], _) },
+ { parse_field_name_list(FieldNameTerm, FieldNameResult) },
+ { FieldNameResult = ok(FieldNames) }
+ ->
+ { make_fresh_arg_var(InputTerm, InputTermVar, [],
+ VarSet0, VarSet1) },
+ { make_fresh_arg_var(FieldValueTerm, FieldValueVar,
+ [InputTermVar], VarSet1, VarSet2) },
+
+ { expand_set_field_function_call(Context, MainContext,
+ SubContext, FieldNames, FieldValueVar, InputTermVar, X,
+ VarSet2, VarSet3, Functor,
+ InnerFunctor - FieldSubContext, Goal0) },
+
+ { TermArgContext = functor(Functor, MainContext, SubContext) },
+ { TermArgNumber = 1 },
+ append_arg_unification(InputTermVar, InputTerm,
+ FunctorContext, TermArgContext, TermArgNumber,
+ TermUnifyConj, VarSet3, VarSet4, Info0, Info1),
+
+ { FieldArgContext = functor(InnerFunctor,
+ MainContext, FieldSubContext) },
+ { FieldArgNumber = 2 },
+ append_arg_unification(FieldValueVar, FieldValueTerm,
+ FunctorContext, FieldArgContext, FieldArgNumber,
+ FieldUnifyConj, VarSet4, VarSet, Info1, Info),
+
+ { Goal0 = _ - GoalInfo0 },
+ { goal_to_conj_list(Goal0, GoalList0) },
+ { list__condense([GoalList0, TermUnifyConj, FieldUnifyConj],
+ GoalList) },
+ { conj_list_to_goal(GoalList, GoalInfo0, Goal) }
+ ;
{ parse_qualified_term(RHS, RHS, "", MaybeFunctor) },
(
{ MaybeFunctor = ok(FunctorName, FunctorArgs) },
@@ -5793,8 +6566,7 @@
{ term__vars_list(QuantifiedArgs, QuantifiedVars0) },
{ list__sort_and_remove_dups(QuantifiedVars0, QuantifiedVars) },
- { goal_info_init(GoalInfo0) },
- { goal_info_set_context(GoalInfo0, Context, GoalInfo) },
+ { goal_info_init(Context, GoalInfo) },
{ HLDS_Goal = some(QuantifiedVars, can_remove, HLDS_Goal1)
- GoalInfo },
@@ -5812,20 +6584,6 @@
lambda_goal(PredOrFunc, EvalMethod, modes_are_ok,
LambdaNonLocals, LambdaVars, Modes, Det, HLDS_Goal),
Context, MainContext, SubContext, Goal) }.
-
- % create the hlds_goal for a unification which cannot be
- % further simplified, filling in all the as yet
- % unknown slots with dummy values
-
-create_atomic_unification(A, B, Context, UnifyMainContext, UnifySubContext,
- Goal) :-
- UMode = ((free - free) -> (free - free)),
- Mode = ((free -> free) - (free -> free)),
- UnifyInfo = complicated_unify(UMode, can_fail, []),
- UnifyC = unify_context(UnifyMainContext, UnifySubContext),
- goal_info_init(GoalInfo0),
- goal_info_set_context(GoalInfo0, Context, GoalInfo),
- Goal = unify(A, B, Mode, UnifyInfo, UnifyC) - GoalInfo.
%-----------------------------------------------------------------------------%
Index: compiler/mercury_to_goedel.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_goedel.m,v
retrieving revision 1.68
diff -u -u -r1.68 mercury_to_goedel.m
--- mercury_to_goedel.m 1999/11/12 09:08:36 1.68
+++ mercury_to_goedel.m 1999/12/22 04:29:36
@@ -469,7 +469,7 @@
:- mode goedel_output_func_type(in, in, in, in, in, di, uo) is det.
goedel_output_func_type(VarSet, FuncName, Types, RetType, _Context) -->
- { list__map(lambda([Type::in, Arg::out] is det, (Arg = "" - Type)),
+ { list__map((pred(Type::in, Arg::out) is det :- Arg = no - Type),
Types, Args) },
goedel_output_ctors([ctor([], [], FuncName, Args)], RetType, VarSet).
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.164
diff -u -u -r1.164 mercury_to_mercury.m
--- mercury_to_mercury.m 1999/11/16 07:51:12 1.164
+++ mercury_to_mercury.m 2000/01/04 05:04:35
@@ -1294,16 +1294,14 @@
mercury_output_term(T, Varset, no),
mercury_output_remaining_ctor_args(Varset, As).
-:- pred mercury_output_ctor_arg_name_prefix(string, io__state, io__state).
+:- pred mercury_output_ctor_arg_name_prefix(maybe(ctor_field_name),
+ io__state, io__state).
:- mode mercury_output_ctor_arg_name_prefix(in, di, uo) is det.
-mercury_output_ctor_arg_name_prefix(Name) -->
- ( { Name = "" } ->
- []
- ;
- mercury_quote_atom(Name, next_to_graphic_token),
- io__write_string(": ")
- ).
+mercury_output_ctor_arg_name_prefix(no) --> [].
+mercury_output_ctor_arg_name_prefix(yes(Name)) -->
+ mercury_output_bracketed_sym_name(Name),
+ io__write_string(" :: ").
%-----------------------------------------------------------------------------%
@@ -2869,6 +2867,7 @@
mercury_unary_prefix_op("useIf").
mercury_unary_prefix_op("wait").
mercury_unary_prefix_op("~").
+mercury_unary_prefix_op("^").
:- pred mercury_unary_postfix_op(string).
:- mode mercury_unary_postfix_op(in) is semidet.
Index: compiler/modecheck_call.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modecheck_call.m,v
retrieving revision 1.34
diff -u -u -r1.34 modecheck_call.m
--- modecheck_call.m 1999/08/31 05:25:35 1.34
+++ modecheck_call.m 1999/12/07 01:07:36
@@ -71,7 +71,7 @@
:- implementation.
:- import_module hlds_data, instmap, prog_data, (inst).
:- import_module mode_info, mode_debug, modes, mode_util, mode_errors.
-:- import_module clause_to_proc, inst_match, make_hlds.
+:- import_module clause_to_proc, inst_match.
:- import_module det_report, unify_proc.
:- import_module int, map, bool, set, require.
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.178
diff -u -u -r1.178 polymorphism.m
--- polymorphism.m 1999/12/03 13:38:48 1.178
+++ polymorphism.m 1999/12/07 00:39:27
@@ -434,7 +434,7 @@
:- import_module typecheck, llds, prog_io.
:- import_module type_util, mode_util, quantification, instmap, prog_out.
-:- import_module code_util, unify_proc, prog_util, make_hlds.
+:- import_module code_util, unify_proc, prog_util.
:- import_module (inst), hlds_out, base_typeclass_info, goal_util, passes_aux.
:- import_module clause_to_proc.
:- import_module globals, options.
--------------------------------------------------------------------------
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