[m-rev.] Minor change to solver types.

[Ralph Becket]

Following Zoltan's suggestion:

Estimated hours taken: 1
Branches: main

Change things so that the compiler generates two solver type -> representation
type conversion predicates (one for the `ground' case, one for the `any' case)
making things symmetrical with the conversions in the other direction.

compiler/make_hlds.m:
	Implement the change.

doc/reference_manual.texi:
	Update the reference manual.

Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.479
diff -u -r1.479 make_hlds.m
--- compiler/make_hlds.m	5 Sep 2004 23:52:15 -0000	1.479
+++ compiler/make_hlds.m	6 Sep 2004 05:18:46 -0000
@@ -463,20 +463,16 @@
 	%
 	% causes the following to be introduced:
 	%
-	% :- impure func 'representation of st'(st)      = rt.
-	% :-        mode 'representation of st'(in)      = out(gi) is det.
-	% :-        mode 'representation of st'(in(any)) = out(ai) is det.
+	% :- impure func 'representation of ground st'(st::in) =
+	% 			(rt::out(gi)) is det.
+	% :- impure func 'representation of any st'(st::in(any)) =
+	% 			(rt::out(ai)) is det.
 	%
 	% :- impure func 'representation to ground st'(rt::in(gi)) =
 	% 			(st::out) is det.
 	% :- impure func 'representation to any st'(rt::in(ai)) =
 	% 			(st::out(any)) is det.
 	%
-	% We need two 'representation to ...' functions because
-	% having a single, two-moded conversion function would
-	% lead to the compiler issuing a `duplicate mode declaration'
-	% error in the case that gi = ai.
-	%
 :- pred add_solver_type_decl_items(
 		tvarset::in, sym_name::in, list(type_param)::in,
 		solver_type_details::in, prog_context::in,
@@ -506,47 +502,28 @@
 
 	% Insert the conversion function declarations.
 
-		% The `:- impure func 'representation of st'(st) = rt'
-		% declaration.
+		% The `:- impure
+		%	func 'representation of ground st'(st::in(gi)) =
+		% 			(rt::out) is det' declaration.
 		%
-	ToRepnSymName     = solver_to_repn_symname(TypeSymName, Arity),
-	ToRepnArgTypes    = [type_only(SolverType), type_only(RepnType)],
-	ToRepnTypeSigItem =
+	ToGroundRepnSymName     =
+		solver_to_ground_repn_symname(TypeSymName, Arity),
+	ToGroundRepnArgTypes    =
+		[type_and_mode(SolverType, in_mode      ),
+		 type_and_mode(RepnType,   OutGroundMode)],
+	ToGroundRepnTypeSigItem =
 		pred_or_func(TVarSet, InstVarSet, ExistQTVars,
 			function,
-			ToRepnSymName,
-			ToRepnArgTypes,
+			ToGroundRepnSymName,
+			ToGroundRepnArgTypes,
 			no,	/* no `with_type` ... */
 			no,	/* no `with_inst` ... */
-			no,	/* no determinism */
+			yes(det),
 			true,	/* no `where ...' */
 			(impure), 
 			constraints([], []) /* no type class constraints */
 		),
-	add_item_decl_pass_1(ToRepnTypeSigItem, Context,
-		!Status, !Module, InvalidToRepnMode, !IO),
-
-	( InvalidToRepnMode = yes ->
-		error("make_hlds.add_solver_type_decl_items: invalid mode " ++
-			"in ToRepn item")
-	;
-		true
-	),
-
-		% The `:- mode 'representation of st'(in) = out(gi) is det'
-		% declaration.
-		%
-	ToGroundRepnArgModes  = [in_mode, OutGroundMode],
-	ToGroundRepnModeItem =
-		pred_or_func_mode(InstVarSet,
-			yes(function),
-			ToRepnSymName,
-			ToGroundRepnArgModes,
-			no,	/* no `with_inst` ... */
-			yes(det),
-			true	/* no `where ...' */
-		),
-	add_item_decl_pass_1(ToGroundRepnModeItem, Context,
+	add_item_decl_pass_1(ToGroundRepnTypeSigItem, Context,
 		!Status, !Module, InvalidToGroundRepnMode, !IO),
 
 	( InvalidToGroundRepnMode = yes ->
@@ -556,20 +533,28 @@
 		true
 	),
 
-		% The `:- mode 'representation of st'(in(any)) =
-		% 			out(ai) is det' declaration.
+		% The `:- impure
+		%	func 'representation of any st'(st::in(ai)) =
+		% 			(rt::out(any)) is det' declaration.
 		%
-	ToAnyRepnArgModes  = [in_any_mode, OutAnyMode],
-	ToAnyRepnModeItem =
-		pred_or_func_mode(InstVarSet,
-			yes(function),
-			ToRepnSymName,
-			ToAnyRepnArgModes,
+	ToAnyRepnSymName     =
+		solver_to_any_repn_symname(TypeSymName, Arity),
+	ToAnyRepnArgTypes    =
+		[type_and_mode(SolverType, in_any_mode ),
+		 type_and_mode(RepnType,   OutAnyMode)],
+	ToAnyRepnTypeSigItem =
+		pred_or_func(TVarSet, InstVarSet, ExistQTVars,
+			function,
+			ToAnyRepnSymName,
+			ToAnyRepnArgTypes,
+			no,	/* no `with_type` ... */
 			no,	/* no `with_inst` ... */
 			yes(det),
-			true	/* no `where ...' */
+			true,	/* no `where ...' */
+			(impure), 
+			constraints([], []) /* no type class constraints */
 		),
-	add_item_decl_pass_1(ToAnyRepnModeItem, Context,
+	add_item_decl_pass_1(ToAnyRepnTypeSigItem, Context,
 		!Status, !Module, InvalidToAnyRepnMode, !IO),
 
 	( InvalidToAnyRepnMode = yes ->
@@ -646,41 +631,35 @@
 	% Obtain the solver type conversion function sym_names from
 	% the solver type sym_name.
 	%
-:- func solver_to_repn_symname(sym_name, arity) = sym_name.
-
-solver_to_repn_symname(unqualified(Name), Arity) =
-	unqualified(
-		"representation of " ++ Name ++ "/" ++ int_to_string(Arity)
-	).
-solver_to_repn_symname(qualified(ModuleNames, Name), Arity) =
-	qualified(ModuleNames,
-		"representation of " ++ Name ++ "/" ++ int_to_string(Arity)
-	).
-
-
-:- func repn_to_any_solver_symname(sym_name, arity) = sym_name.
-
-repn_to_any_solver_symname(SymName, Arity) =
-	repn_to_solver_symname("any", SymName, Arity).
-
+:- func solver_to_ground_repn_symname(sym_name, arity) = sym_name.
+solver_to_ground_repn_symname(SymName, Arity) =
+	solver_conversion_fn_symname("representation of ground ",
+		SymName, Arity).
+
+:- func solver_to_any_repn_symname(sym_name, arity) = sym_name.
+solver_to_any_repn_symname(SymName, Arity) =
+	solver_conversion_fn_symname("representation of any ",
+		SymName, Arity).
 
 :- func repn_to_ground_solver_symname(sym_name, arity) = sym_name.
-
 repn_to_ground_solver_symname(SymName, Arity) =
-	repn_to_solver_symname("ground", SymName, Arity).
+	solver_conversion_fn_symname("representation to ground ",
+		SymName, Arity).
 
+:- func repn_to_any_solver_symname(sym_name, arity) = sym_name.
+repn_to_any_solver_symname(SymName, Arity) =
+	solver_conversion_fn_symname("representation to any ",
+		SymName, Arity).
 
-:- func repn_to_solver_symname(string, sym_name, arity) = sym_name.
 
-repn_to_solver_symname(AnyOrGround, unqualified(Name), Arity) =
+:- func solver_conversion_fn_symname(string, sym_name, arity) = sym_name.
+solver_conversion_fn_symname(Prefix, unqualified(Name), Arity) =
 	unqualified(
-		string.format("representation to %s %s/%d",
-			[s(AnyOrGround), s(Name), i(Arity)])
+		Prefix ++ Name ++ "/" ++ int_to_string(Arity)
 	).
-repn_to_solver_symname(AnyOrGround, qualified(ModuleNames, Name), Arity) =
+solver_conversion_fn_symname(Prefix, qualified(ModuleNames, Name), Arity) =
 	qualified(ModuleNames,
-		string.format("representation to %s %s/%d",
-			[s(AnyOrGround), s(Name), i(Arity)])
+		Prefix ++ Name ++ "/" ++ int_to_string(Arity)
 	).
 
 %-----------------------------------------------------------------------------%
@@ -1148,11 +1127,6 @@
 		!Status, Context, !Module, !Info, !IO) :-
 
 	Arity             = length(TypeParams),
-	ToRepnSymName     = solver_to_repn_symname(TypeSymName, Arity),
-	FromAnyRepnSymName =
-		repn_to_any_solver_symname(TypeSymName, Arity),
-	FromGroundRepnSymName =
-		repn_to_ground_solver_symname(TypeSymName, Arity),
 
 	AnyInst           = SolverTypeDetails ^ any_inst,
 	GroundInst        = SolverTypeDetails ^ ground_inst,
@@ -1176,12 +1150,14 @@
 
 		% The `func(in) = out(<i_ground>) is det' mode.
 		%
+	ToGroundRepnSymName =
+		solver_to_ground_repn_symname(TypeSymName, Arity),
 	ToGroundRepnArgs = [ pragma_var(X, "X", in_mode      ),
                              pragma_var(Y, "Y", OutGroundMode) ],
 	ToGroundRepnForeignProc =
 		foreign_proc(
 			Attrs,
-			ToRepnSymName,
+			ToGroundRepnSymName,
 			function,
 			ToGroundRepnArgs,
 			VarSet,
@@ -1193,12 +1169,14 @@
 
 		% The `func(in(any)) = out(<i_any>) is det' mode.
 		%
+	ToAnyRepnSymName =
+		solver_to_any_repn_symname(TypeSymName, Arity),
 	ToAnyRepnArgs = [ pragma_var(X, "X", in_any_mode),
                           pragma_var(Y, "Y", OutAnyMode ) ],
 	ToAnyRepnForeignProc =
 		foreign_proc(
 			Attrs,
-			ToRepnSymName,
+			ToAnyRepnSymName,
 			function,
 			ToAnyRepnArgs,
 			VarSet,
@@ -1209,6 +1187,8 @@
 
 		% The `func(in(<i_ground>)) = out is det' mode.
 		%
+	FromGroundRepnSymName =
+		repn_to_ground_solver_symname(TypeSymName, Arity),
 	FromGroundRepnArgs        = [ pragma_var(X, "X", InGroundMode),
 			              pragma_var(Y, "Y", out_mode) ],
 	FromGroundRepnForeignProc =
@@ -1226,6 +1206,8 @@
 
 		% The `func(in(<i_any>)) = out(any) is det' mode.
 		%
+	FromAnyRepnSymName =
+		repn_to_any_solver_symname(TypeSymName, Arity),
 	FromAnyRepnArgs        = [ pragma_var(X, "X", InAnyMode   ),
 			           pragma_var(Y, "Y", out_any_mode) ],
 	FromAnyRepnForeignProc =
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.296
diff -u -r1.296 reference_manual.texi
--- doc/reference_manual.texi	5 Sep 2004 23:52:53 -0000	1.296
+++ doc/reference_manual.texi	6 Sep 2004 06:19:31 -0000
@@ -2206,11 +2206,14 @@
 @samp{arity} is the number of type parameters it takes):
 
 @example
-:- impure func 'representation of name/arity'(solver_type) =
+:- impure func 'representation of ground name/arity'(solver_type) =
                         representation_type.
-:-        mode 'representation of name/arity'(in) =
+:-        mode 'representation of ground name/arity'(in) =
                         out(ground_inst) is det.
-:-        mode 'representation of name/arity'(in(any)) =
+
+:- impure func 'representation of any name/arity'(solver_type) =
+                        representation_type.
+:-        mode 'representation of any name/arity'(in(any)) =
                         out(any_inst) is det.
 
 :- impure func 'representation to ground name/arity'(representation_type) =
@@ -2226,10 +2229,6 @@
 
 These functions are impure because of the semantic gap issue mentioned
 above.
-
-Two @code{representation_type}-to- at code{solver_type} functions are
-needed to avoid mode ambiguity in the case where @code{any_inst} and
- at code{ground_inst} are equivalent.
 
 These functions are constructed in-line as part of a source-to-source
 transformation, hence it is an error to define a solver type in the
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------