[m-rev.] For review: solver-types

Ralph Becket rafe at cs.mu.OZ.AU
Thu Aug 19 15:55:12 AEST 2004


Here's the interdiff regarding the changes you requested:

diff -u equiv_type.m equiv_type.m
--- equiv_type.m	17 Aug 2004 23:47:45 -0000
+++ equiv_type.m	18 Aug 2004 07:18:45 -0000
@@ -407,14 +407,13 @@
 		solver_type(SolverTypeDetails0, MaybeUserEqComp),
 		solver_type(SolverTypeDetails,  MaybeUserEqComp),
 		ContainsCirc, !VarSet, !Info) :-
-	RepresentationType0 =
-		SolverTypeDetails0 ^ representation_type,
+	SolverTypeDetails0 = solver_type_details(RepresentationType0, InitPred,
+				GroundInst, AnyInst),
 	equiv_type__replace_in_type_2(EqvMap, [TypeCtor], 
-		RepresentationType0, RepresentationType,
-		_, ContainsCirc, !VarSet, !Info),
-	SolverTypeDetails =
-		SolverTypeDetails0 ^ representation_type :=
-			RepresentationType.
+				RepresentationType0, RepresentationType,
+				_, ContainsCirc, !VarSet, !Info),
+	SolverTypeDetails = solver_type_details(RepresentationType, InitPred,
+				GroundInst, AnyInst).
 
 %-----------------------------------------------------------------------------%
 
diff -u equiv_type_hlds.m equiv_type_hlds.m
--- equiv_type_hlds.m	17 Aug 2004 03:50:10 -0000
+++ equiv_type_hlds.m	18 Aug 2004 07:19:37 -0000
@@ -135,11 +135,12 @@
 		TVarSet = TVarSet0
 	;
 		Body0 = solver_type(SolverTypeDetails0, UserEq),
-		RepnType0 = SolverTypeDetails0 ^ representation_type,
+		SolverTypeDetails0 = solver_type_details(RepnType0, InitPred,
+					GroundInst, AnyInst),
 		equiv_type__replace_in_type(EqvMap, RepnType0, RepnType, _,
 			TVarSet0, TVarSet, EquivTypeInfo0, EquivTypeInfo),
-		SolverTypeDetails =
-			SolverTypeDetails0 ^ representation_type := RepnType,
+		SolverTypeDetails = solver_type_details(RepnType, InitPred,
+					GroundInst, AnyInst),
 		Body = solver_type(SolverTypeDetails, UserEq)
 	;
 		Body0 = abstract_type(_),
diff -u make_hlds.m make_hlds.m
--- make_hlds.m	18 Aug 2004 01:05:45 -0000
+++ make_hlds.m	19 Aug 2004 05:38:13 -0000
@@ -524,7 +524,14 @@
 			constraints([], []) /* no type class constraints */
 		),
 	add_item_decl_pass_1(ToRepnTypeSigItem, Context,
-		!Status, !Module, _, !IO),
+		!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.
@@ -540,7 +547,14 @@
 			true	/* no `where ...' */
 		),
 	add_item_decl_pass_1(ToGroundRepnModeItem, Context,
-		!Status, !Module, _, !IO),
+		!Status, !Module, InvalidToGroundRepnMode, !IO),
+
+	( InvalidToGroundRepnMode = yes ->
+		error("make_hlds.add_solver_type_decl_items: invalid mode " ++
+			"in ToGroundRepn item")
+	;
+		true
+	),
 
 		% The `:- mode 'representation of st'(in(any)) =
 		% 			out(ai) is det' declaration.
@@ -556,7 +570,14 @@
 			true	/* no `where ...' */
 		),
 	add_item_decl_pass_1(ToAnyRepnModeItem, Context,
-		!Status, !Module, _, !IO),
+		!Status, !Module, InvalidToAnyRepnMode, !IO),
+
+	( InvalidToAnyRepnMode = yes ->
+		error("make_hlds.add_solver_type_decl_items: invalid mode " ++
+			"in ToAnyRepn item")
+	;
+		true
+	),
 
 		% The `:- impure
 		%	func 'representation to ground st'(rt::in(gi)) =
@@ -580,7 +601,14 @@
 			constraints([], []) /* no type class constraints */
 		),
 	add_item_decl_pass_1(FromGroundRepnTypeSigItem, Context,
-		!Status, !Module, _, !IO),
+		!Status, !Module, InvalidFromGroundRepnMode, !IO),
+
+	( InvalidFromGroundRepnMode = yes ->
+		error("make_hlds.add_solver_type_decl_items: invalid mode " ++
+			"in FromGroundRepn item")
+	;
+		true
+	),
 
 		% The `:- impure
 		%	func 'representation to any st'(rt::in(ai)) =
@@ -604,7 +632,14 @@
 			constraints([], []) /* no type class constraints */
 		),
 	add_item_decl_pass_1(FromAnyRepnTypeSigItem, Context,
-		!Status, !Module, _, !IO).
+		!Status, !Module, InvalidFromAnyRepnMode, !IO),
+
+	( InvalidFromAnyRepnMode = yes ->
+		error("make_hlds.add_solver_type_decl_items: invalid mode " ++
+			"in FromAnyRepn item")
+	;
+		true
+	).
 
 %-----------------------------------------------------------------------------%
 
@@ -4078,9 +4113,9 @@
 					TVarSet, Type, TypeCtor, TypeBody,
 					Context, Status0, !Module)
 			;
-				% rafe: XXX Should this be an error?
-				%
-				true
+				error("make_hlds.add_special_pred: " ++
+					"attempt to add initialise pred " ++
+					"for non-solver type")
 			)
 		)
 	).
reverted:
--- maybe_mlds_to_gcc.pp	14 Jul 2004 07:30:38 -0000
+++ maybe_mlds_to_gcc.pp	14 Jun 2004 04:16:16 -0000	1.8
@@ -58,7 +58,6 @@
 
 #else
 
-:- import_module hlds__passes_aux.
 :- import_module parse_tree__prog_out.
 :- import_module string.
 
diff -u mercury_to_mercury.m mercury_to_mercury.m
--- mercury_to_mercury.m	18 Aug 2004 00:28:21 -0000
+++ mercury_to_mercury.m	19 Aug 2004 05:49:12 -0000
@@ -1656,68 +1656,68 @@
 	io__write_string(":- type ").
 
 mercury_output_where_attributes(TVarSet,
-		MaybeSolverTypeDetails, MaybeUserEqComp) -->
+		MaybeSolverTypeDetails, MaybeUserEqComp, !IO) :-
 	(
-		{ MaybeSolverTypeDetails = no },
-		{ MaybeUserEqComp        = no }
+		MaybeSolverTypeDetails = no,
+		MaybeUserEqComp        = no
 	->
-		[]
+		true
 	;
-		{ if
+		(
 			MaybeUserEqComp = yes(unify_compare(MaybeUnifyPred0,
 							    MaybeComparePred0))
-		  then
+		->
 			MaybeUnifyPred   = MaybeUnifyPred0,
 			MaybeComparePred = MaybeComparePred0
-		  else
+		;
 			MaybeUnifyPred   = no,
 			MaybeComparePred = no
-		},
-		io__write_string("\n\twhere\t"),
+		),
+		io__write_string("\n\twhere\t", !IO),
 		(
-			{ MaybeUserEqComp =
-				yes(abstract_noncanonical_type(_)) }
+			MaybeUserEqComp =
+				yes(abstract_noncanonical_type(_))
 		->
-			io__write_string("type_is_abstract_noncanonical")
+			io__write_string("type_is_abstract_noncanonical", !IO)
 		;
-			{ MaybeSolverTypeDetails = yes(SolverTypeDetails) }
+			MaybeSolverTypeDetails = yes(SolverTypeDetails)
 		->
 			mercury_output_solver_type_details(TVarSet,
-				SolverTypeDetails),
+				SolverTypeDetails, !IO),
 			(
-				{	MaybeUnifyPred = yes(_)
+				(	MaybeUnifyPred = yes(_)
 				;	MaybeComparePred = yes(_)
-				}
+				)
 			->
-				io__write_string(",\n\t\t")
+				io__write_string(",\n\t\t", !IO)
 			;
-				[]
+				true
 			)
 		;
-			[]
+			true
 		),
 		(
-			{ MaybeUnifyPred = yes(UnifyPredName) }
+			MaybeUnifyPred = yes(UnifyPredName)
 		->
-			io__write_string("equality is "),
-			mercury_output_bracketed_sym_name(UnifyPredName),
+			io__write_string("equality is ", !IO),
+			mercury_output_bracketed_sym_name(UnifyPredName, !IO),
 			(
-				{ MaybeComparePred = yes(_) }
+				MaybeComparePred = yes(_)
 			->
-				io__write_string(",\n\t\t")
+				io__write_string(",\n\t\t", !IO)
 			;
-				[]
+				true
 			)
 		;
-			[]
+			true
 		),
 		(
-			{ MaybeComparePred = yes(ComparePredName) }
+			MaybeComparePred = yes(ComparePredName)
 		->
-			io__write_string("comparison is "),
-			mercury_output_bracketed_sym_name(ComparePredName)
+			io__write_string("comparison is ", !IO),
+			mercury_output_bracketed_sym_name(ComparePredName, !IO)
 		;
-			[]
+			true
 		)
 	).
 
diff -u modes.m modes.m
--- modes.m	7 Jul 2004 06:48:46 -0000
+++ modes.m	19 Aug 2004 00:15:49 -0000
@@ -1001,7 +1001,7 @@
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
-% Modecheck a goal by abstractly interpreteting it, as explained
+% Modecheck a goal by abstractly interpreting it, as explained
 % at the top of this file.
 
 % Note: any changes here may need to be duplicated in unique_modes.m.
@@ -2129,7 +2129,6 @@
 			UnifyContext),
 		CallUnifyContext = yes(call_unify_context(Var, var(Var),
 						UnifyContext)),
-
 		(
 			type_util__type_is_solver_type(ModuleInfo0, VarType)
 		->
diff -u module_qual.m module_qual.m
--- module_qual.m	17 Aug 2004 05:08:08 -0000
+++ module_qual.m	19 Aug 2004 05:50:24 -0000
@@ -731,32 +731,28 @@
 
 qualify_type_defn(du_type(Ctors0, MaybeUserEqComp0),
 		du_type(Ctors, MaybeUserEqComp),
-		Info0, Info) -->
-	qualify_constructors(Ctors0, Ctors, Info0, Info),
+		Info0, Info, !IO) :-
+	qualify_constructors(Ctors0, Ctors, Info0, Info, !IO),
 
 	% User-defined equality pred names will be converted into
 	% predicate calls and then module-qualified after type analysis
 	% (during mode analysis).  That way they get full type overloading
 	% resolution, etc.  Thus we don't module-qualify them here.
-	{ MaybeUserEqComp = MaybeUserEqComp0 }.
-qualify_type_defn(eqv_type(Type0), eqv_type(Type), Info0, Info) -->
-	qualify_type(Type0, Type, Info0, Info).
-qualify_type_defn(abstract_type(_) @ Defn, Defn, Info, Info) --> [].
-qualify_type_defn(foreign_type(_, _, _) @ Defn, Defn, Info, Info) --> [].
+	MaybeUserEqComp = MaybeUserEqComp0.
+qualify_type_defn(eqv_type(Type0), eqv_type(Type), Info0, Info, !IO) :-
+	qualify_type(Type0, Type, Info0, Info, !IO).
+qualify_type_defn(abstract_type(_) @ Defn, Defn, Info, Info, !IO).
+qualify_type_defn(foreign_type(_, _, _) @ Defn, Defn, Info, Info, !IO).
 qualify_type_defn(solver_type(SolverTypeDetails0, MaybeUserEqComp),
 		solver_type(SolverTypeDetails, MaybeUserEqComp),
-		Info0, Info) -->
-	{ RepnType0   = SolverTypeDetails0 ^ representation_type },
-	{ GroundInst0 = SolverTypeDetails0 ^ ground_inst },
-	{ AnyInst0    = SolverTypeDetails0 ^ any_inst },
-	qualify_type(RepnType0, RepnType,     Info0, Info1),
-	qualify_inst(GroundInst0, GroundInst, Info1, Info2),
-	qualify_inst(AnyInst0, AnyInst,       Info2, Info ),
-	{ SolverTypeDetails =
-		(((SolverTypeDetails0
-			^ representation_type := RepnType   )
-			^ ground_inst         := GroundInst )
-			^ any_inst            := AnyInst    ) }.
+		Info0, Info, !IO) :-
+	SolverTypeDetails0 = solver_type_details(RepnType0, InitPred,
+					GroundInst0, AnyInst0),
+	qualify_type(RepnType0, RepnType,     Info0, Info1, !IO),
+	qualify_inst(GroundInst0, GroundInst, Info1, Info2, !IO),
+	qualify_inst(AnyInst0, AnyInst,       Info2, Info,  !IO),
+	SolverTypeDetails  = solver_type_details(RepnType, InitPred,
+					GroundInst, AnyInst).
 
 :- pred qualify_constructors(list(constructor)::in, list(constructor)::out,
 		mq_info::in, mq_info::out, io__state::di, io__state::uo) is det.
diff -u modules.m modules.m
--- modules.m	18 Aug 2004 01:05:49 -0000
+++ modules.m	19 Aug 2004 00:20:52 -0000
@@ -7005,9 +7005,8 @@
 	;
 		TypeDefn0 = foreign_type(ForeignType, yes(_UserEqComp),
 				Assertions),
-		TypeDefn  = foreign_type(ForeignType,
-				yes(abstract_noncanonical_type(
-					non_solver_type)),
+		TypeDefn  = foreign_type(ForeignType, yes(
+				abstract_noncanonical_type(non_solver_type)),
 				Assertions)
 	;
 		TypeDefn0 = solver_type(SolverTypeDetails, yes(_UserEqComp)),
diff -u prog_io.m prog_io.m
--- prog_io.m	18 Aug 2004 00:58:55 -0000
+++ prog_io.m	19 Aug 2004 05:28:55 -0000
@@ -1545,6 +1545,14 @@
 				WhereResult = error(String, Term),
 				Result      = error(String, Term)
 			;
+					% The code to process `where'
+					% attributes will return an error
+					% result if solver attributes are
+					% given for a non-solver type. 
+					% Because this is a du type, if the
+					% unification with WhereResult
+					% succeeds then _NoSolverTypeDetails
+					% is guaranteed to be `no'.
 				WhereResult = ok(_NoSolverTypeDetails,
 						 MaybeUserEqComp),
 				process_du_type(ModuleName, H, Body, Ctors,
@@ -1750,6 +1758,10 @@
 	).
 
 
+	% The maybe2 wrapper allows us to return an error code or a pair
+	% of results.  Either result half may be empty, hence the maybe
+	% wrapper around each of those.
+	%
 :- func parse_type_decl_where_term(is_solver_type, module_name, maybe(term)) =
 		maybe2(maybe(solver_type_details), maybe(unify_compare)).
 
@@ -1853,13 +1865,13 @@
 		(
 			LHS = term__functor(term__atom(Name), [], _Context2)
 		->
-			Result0 = Parser(RHS),
+			RHSResult = Parser(RHS),
 			(
-				Result0 = ok(X),
-				Result  = ok(yes(X))
+				RHSResult = ok(ParsedRHS),
+				Result    = ok(yes(ParsedRHS))
 			;
-				Result0 = error(Msg, ProblemTerm),
-				Result  = error(Msg, ProblemTerm)
+				RHSResult = error(Msg, ProblemTerm),
+				Result    = error(Msg, ProblemTerm)
 			)
 		;
 			Result = ok(no)
@@ -1873,10 +1885,8 @@
 
 parse_where_type_is_abstract_noncanonical(Term) =
 	(
-		Term = term__functor(
-				term__atom("type_is_abstract_noncanonical"),
-				[],
-				_Context)
+		Term = term__functor(term__atom(
+				"type_is_abstract_noncanonical"), [], _Context)
 	->
 		ok(yes(unit))
 	;
@@ -1909,12 +1919,14 @@
 :- func parse_where_inst_is(module_name, term) = maybe1(inst).
 
 parse_where_inst_is(_ModuleName, Term) =
-	( if
+	( 
 		prog_io_util__convert_inst(no_allow_constrained_inst_var,
 			Term, Inst),
 		not inst_util__inst_contains_unconstrained_var(Inst)
-	  then ok(Inst)
-	  else error("expected a ground, unconstrained inst", Term)
+	->
+		ok(Inst)
+	;
+		error("expected a ground, unconstrained inst", Term)
 	).
 
 
@@ -2049,31 +2061,6 @@
 		func_error("prog_io__make_maybe_where_details: " ++
 			"shouldn't have reached this point!")
 	).
-
-
-:- func solver_inst_cast_sym_name(sym_name, arity) = sym_name.
-
-solver_inst_cast_sym_name(TypeSymName, TypeArity) =
-	unqualified_sym_name_with_prefix_suffix("inst cast ", TypeSymName,
-		"/" ++ int_to_string(TypeArity)).
-
-
-:- func solver_inst_sym_name(sym_name, arity) = sym_name.
-
-solver_inst_sym_name(TypeSymName, TypeArity) =
-	unqualified_sym_name_with_prefix_suffix("", TypeSymName,
-		"/" ++ int_to_string(TypeArity) ++ " inst").
-
-
-:- func unqualified_sym_name_with_prefix_suffix(string, sym_name, string) =
-		sym_name.
-
-unqualified_sym_name_with_prefix_suffix(Prefix, unqualified(Name), Suffix) =
-	unqualified(Prefix ++ Name ++ Suffix).
-
-unqualified_sym_name_with_prefix_suffix(Prefix, 
-		qualified(ModuleSpecifier, Name), Suffix) =
-	qualified(ModuleSpecifier, Prefix ++ Name ++ Suffix).
 
 
 	% get_determinism(Term0, Term, Determinism) binds Determinism
diff -u prog_io_pragma.m prog_io_pragma.m
--- prog_io_pragma.m	18 Aug 2004 01:05:50 -0000
+++ prog_io_pragma.m	19 Aug 2004 00:24:05 -0000
@@ -44,6 +44,13 @@
 				SinglePragmaTerm, VarSet, Result0)
 	->
 		(
+				% The code to process `where' attributes will
+				% return an error result if solver attributes
+				% are given for a non-solver type.  Because
+				% this is a non-solver type, if the
+				% unification with WhereResult succeeds then
+				% _NoSolverTypeDetails is guaranteed to be
+				% `no'.
 			WherePartResult =
 				ok(_NoSolverTypeDetails, MaybeUserEqComp),
 			(
diff -u special_pred.m special_pred.m
--- special_pred.m	17 Aug 2004 06:18:21 -0000
+++ special_pred.m	19 Aug 2004 00:57:24 -0000
@@ -198,11 +198,10 @@
 	).
 
 special_pred_is_generated_lazily(ModuleInfo, TypeCtor, Body, Status) :-
-	% rafe: XXX Is there a cleaner way of doing this?  I don't
-	% want special preds for solver types to be generated lazily
-	% because I have to insert calls to their initialisation preds
-	% during mode analysis and I therefore require the appropriate
-	% names to appear in the symbol table.
+	% We don't want special preds for solver types to be generated lazily
+	% because we have to insert calls to their initialisation preds during
+	% mode analysis and we therefore require the appropriate names to
+	% appear in the symbol table.
 	%
 	Body \= solver_type(_, _),
 	Body \= abstract_type(solver_type),
diff -u termination.m termination.m
--- termination.m	1 Jul 2004 02:48:24 -0000
+++ termination.m	19 Aug 2004 00:59:34 -0000
@@ -689,6 +689,9 @@
 	map__det_update(!.ProcTable, ProcId, ProcInfo, !:ProcTable),
 	set_generated_terminates(ProcIds, SpecialPredId, !ProcTable).
 
+	% XXX The ArgSize arguments for unify, compare and initialise
+	% are not necessarily correct since these may be user-defined.
+	%
 :- pred special_pred_id_to_termination(special_pred_id::in,
 	list(prog_var)::in, arg_size_info::out, termination_info::out) is det.
 
@@ -704,8 +707,6 @@
 	term_util__make_bool_list(HeadVars, [no, no], OutList),
 	ArgSize = finite(0, OutList),
 	Termination = cannot_loop.
-		% rafe: XXX I think the [yes] here is correct.
-		%
 special_pred_id_to_termination(initialise, HeadVars, ArgSize, Termination) :-
 	term_util__make_bool_list(HeadVars, [yes], OutList),
 	ArgSize = finite(0, OutList),
diff -u type_ctor_info.m type_ctor_info.m
--- type_ctor_info.m	18 Aug 2004 00:55:31 -0000
+++ type_ctor_info.m	19 Aug 2004 01:02:30 -0000
@@ -329,10 +329,9 @@
 		;
 				% We treat solver_types as being
 				% equivalent to their representation
-				% types for RTTI purposes.
-				%
-				% rafe: XXX Won't this cause trouble
-				% with construct etc?
+				% types for RTTI purposes.  Which may
+				% cause problems with construct,
+				% similar to those for abstract types.
 				%
 			TypeBody = solver_type(SolverTypeDetails,
 					_MaybeUserEqComp),
diff -u type_util.m type_util.m
--- type_util.m	18 Aug 2004 00:55:43 -0000
+++ type_util.m	19 Aug 2004 04:08:32 -0000
@@ -873,8 +873,8 @@
 		% type_to_type_defn_body will fail for builtin types such
 		% as `int/0'.  Such types are not solver types so
 		% type_util__is_solver_type fails too.
-	type_util__type_to_type_defn_body(ModuleInfo, Type, TypeBody),
-	type_util__type_body_is_solver_type(ModuleInfo, TypeBody).
+	type_to_type_defn_body(ModuleInfo, Type, TypeBody),
+	type_body_is_solver_type(ModuleInfo, TypeBody).
 
 
 	% Succeed if the type body is for a solver type.
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------



More information about the reviews mailing list