[m-rev.] diff: fix badly-typed solver equivalence initialisation predicates

[Julien Fischer]

Estimated hours taken: 1
Branches: main

Fix bug #21: the compiler was generating badly typed initialisation predicates
for equivalence types.  They were badly typed because equiv_type_casts were
being omitted from the clauses.

compiler/unify_proc.m:
 	Re-arrange an if-then-else so that correct clauses are generated for
 	the initialisation predicates of equivalence types.  The condition
 	on the first if goal previously meant that the else if branch
 	that would have generated the correct code for equivalence types
 	was never executed.

compiler/add_special_pred.m:
 	Fix a comment.

tests/valid/Mmakefile:
tests/valid/fz_conf.m:
 	Test case for the above bug.

tests/valid/Mercury.options:
 	Compile the new test case with `--solver-type-auto-init'.
 	Group all the test cases that require this flag together.

Julien.

Index: compiler/add_special_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_special_pred.m,v
retrieving revision 1.22
diff -u -r1.22 add_special_pred.m
--- compiler/add_special_pred.m	31 Oct 2007 03:58:26 -0000	1.22
+++ compiler/add_special_pred.m	31 Oct 2007 07:28:41 -0000
@@ -267,8 +267,8 @@
      map.lookup(SpecialPredMap1, SpecialPredId - TypeCtor, PredId),
      module_info_preds(!.ModuleInfo, Preds0),
      map.lookup(Preds0, PredId, PredInfo0),
-    % if the type was imported, then the special preds for that
-    % type should be imported too
+    % If the type was imported, then the special preds for that
+    % type should be imported too.
      (
          ( Status = status_imported(_)
          ; Status = status_pseudo_imported
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.194
diff -u -r1.194 unify_proc.m
--- compiler/unify_proc.m	31 Oct 2007 03:58:30 -0000	1.194
+++ compiler/unify_proc.m	31 Oct 2007 07:28:41 -0000
@@ -713,29 +713,6 @@
  generate_initialise_proc_body(_Type, TypeBody, X, Context, Clause, !Info) :-
      info_get_module_info(!.Info, ModuleInfo),
      (
-        type_body_has_solver_type_details(ModuleInfo, TypeBody,
-            SolverTypeDetails)
-    ->
-        % Just generate a call to the specified predicate, which is
-        % the user-defined equality pred for this type.
-        % (The pred_id and proc_id will be figured out by type checking
-        % and mode analysis.)
-        %
-        HowToInit = SolverTypeDetails ^ init_pred,
-        (
-            HowToInit = solver_init_automatic(InitPred)
-        ;
-            HowToInit = solver_init_explicit,
-            unexpected(this_file, "generating initialise pred. for " ++
-                "solver type that does not have automatic initialisation.")
-        ),
-        PredId = invalid_pred_id,
-        ModeId = invalid_proc_id,
-        Call = plain_call(PredId, ModeId, [X], not_builtin, no, InitPred),
-        goal_info_init(Context, GoalInfo),
-        Goal = hlds_goal(Call, GoalInfo),
-        quantify_clause_body([X], Goal, Context, Clause, !Info)
-    ;
          % If this is an equivalence type then we just generate a call
          % to the initialisation pred of the type on the RHS of the equivalence
          % and cast the result back to the type on the LHS of the equivalence.
@@ -760,6 +737,29 @@
              CastGoal),
          Goal = hlds_goal(conj(plain_conj, [InitGoal, CastGoal]), GoalInfo),
          quantify_clause_body([X], Goal, Context, Clause, !Info)
+    ; 
+        type_body_has_solver_type_details(ModuleInfo, TypeBody,
+            SolverTypeDetails)
+    ->
+        % Just generate a call to the specified predicate, which is
+        % the user-defined equality pred for this type.
+        % (The pred_id and proc_id will be figured out by type checking
+        % and mode analysis.)
+        %
+        HowToInit = SolverTypeDetails ^ init_pred,
+        (
+            HowToInit = solver_init_automatic(InitPred)
+        ;
+            HowToInit = solver_init_explicit,
+            unexpected(this_file, "generating initialise pred. for " ++
+                "solver type that does not have automatic initialisation.")
+        ),
+        PredId = invalid_pred_id,
+        ModeId = invalid_proc_id,
+        Call = plain_call(PredId, ModeId, [X], not_builtin, no, InitPred),
+        goal_info_init(Context, GoalInfo),
+        Goal = hlds_goal(Call, GoalInfo),
+        quantify_clause_body([X], Goal, Context, Clause, !Info)
      ;
          unexpected(this_file, "generate_initialise_proc_body: " ++
              "trying to create initialisation proc for type " ++
Index: tests/valid/Mercury.options
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/valid/Mercury.options,v
retrieving revision 1.40
diff -u -r1.40 Mercury.options
--- tests/valid/Mercury.options	31 Oct 2007 03:58:33 -0000	1.40
+++ tests/valid/Mercury.options	31 Oct 2007 07:28:41 -0000
@@ -22,6 +22,12 @@
  GRADEFLAGS-foreign_type_spec	=  --grade il
  GRADEFLAGS-foreign_type_spec.foreign_type = --grade il

+# The following test cases check for bugs that can only occur in the
+# presence of automatic solver type intialisation.
+MCFLAGS-fz_conf                 = --solver-type-auto-init
+MCFLAGS-solver_type_bug_2       = --solver-type-auto-init
+MCFLAGS-solver_type_mutable_bug = --solver-type-auto-init
+
  MCFLAGS-builtin_false		= --intermodule-optimization
  MCFLAGS-compl_unify_bug		= -O3
  MCFLAGS-constraint_prop_bug	= -O0 --common-struct --local-constraint-propagation
@@ -90,10 +96,6 @@
  MCFLAGS-simplify_bug2		= -O3
  MCFLAGS-simplify_bug		= -O-1
  MCFLAGS-solver_type_bug		= --halt-at-warn
-# The following two test cases check for bugs that can only occur in the
-# presence of automatic solver type intialisation.
-MCFLAGS-solver_type_bug_2       = --solver-type-auto-init
-MCFLAGS-solver_type_mutable_bug = --solver-type-auto-init
  MCFLAGS-solv			= --halt-at-warn
  MCFLAGS-spurious_purity_warning	= --halt-at-warn
  MCFLAGS-stack_opt_simplify	= --optimize-saved-vars
Index: tests/valid/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/valid/Mmakefile,v
retrieving revision 1.198
diff -u -r1.198 Mmakefile
--- tests/valid/Mmakefile	4 Oct 2007 05:23:00 -0000	1.198
+++ tests/valid/Mmakefile	31 Oct 2007 07:28:41 -0000
@@ -97,6 +97,7 @@
  	func_default_modes \
  	func_in_head \
  	func_int_bug_main \
+	fz_conf \
  	hawkins_switch_bug \
  	headvar_not_found \
  	higher_order \
Index: tests/valid/fz_conf.m
===================================================================
RCS file: tests/valid/fz_conf.m
diff -N tests/valid/fz_conf.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/valid/fz_conf.m	31 Oct 2007 07:28:41 -0000
@@ -0,0 +1,32 @@
+% This program causes the following error in rotd-2007-10-22:
+% (The code is derived from the G12 FlatZinc interpreter.)
+%
+% fz_conf.m:020: In clause for initialisation predicate for type
+% fz_conf.m:020:   `zinc_sat_literal':
+% fz_conf.m:020:   in argument 1 of call to predicate
+% fz_conf.m:020:   `fz_conf.new_msat_literal'/1:
+% fz_conf.m:020:   type error: variable `HeadVar__1' has type
+% fz_conf.m:020:   `(fz_conf.zinc_sat_literal)',
+% fz_conf.m:020:   expected type was `(fz_conf.msat_literal)'.
+%
+% Compile with `mmc -C fz_conf.m' to reproduce.
+%
+:- module fz_conf.
+:- interface.
+
+:- solver type msat_literal.
+
+:- pred new_msat_literal(msat_literal::oa) is det.
+
+:- type zinc_sat_literal == msat_literal.
+
+:- implementation.
+
+:- solver type msat_literal
+    where   representation  is int,
+            initialisation  is new_msat_literal.
+
+new_msat_literal(A) :-
+	promise_pure (
+		impure A = 'representation to any msat_literal/0'(1)
+	).


--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------