[m-dev.] diff: typeclasses

[Fergus Henderson]

David Glen JEFFERY <dgj at cs.mu.oz.au> wrote:

> +:- pred polymorphism__get_arg_superclass_vars(hlds_class_defn, list(type),
> +	map(class_constraint, constraint_proof), list(var), list(hlds_goal),
> +	poly_info, poly_info).
> +:- mode polymorphism__get_arg_superclass_vars(in, in, in, out, out, 
> +	in, out) is det.
> +
> +polymorphism__get_arg_superclass_vars(ClassDefn, InstanceTypes, 
> +		SuperClassProofs, NewVars, NewGoals, Info0, Info) :-
> +
> +	Info0 = poly_info(VarSet0, VarTypes0, TVarSet, TVarMap0, TCVarMap0, 
> +			Proofs, PredName, ModuleInfo),
> +
> +	ClassDefn = hlds_class_defn(SuperClasses, ClassVars, _, ClassVarSet),
> +
> +	map__from_corresponding_lists(ClassVars, InstanceTypes, TypeSubst),
> +	varset__merge_subst(VarSet0, ClassVarSet, VarSet1, Subst),
> +
> +		% XXX I think the SuperClassProofs need to have the 
> +		% substitutions applied since the code that uses them 
> +		% assumes that this has already been done. (?)

Do you mean the type substitutions?  If so, please say so.
                ^^^^

But if this XXX is correct, then it indicates a bug, which should be fixed.

> @@ -754,11 +1439,11 @@
>  		% To allow univ_to_type to check the type_infos
>  		% correctly, the actual arity of the pred is added to
>  		% the type_info of higher-order types.
> +		% XXX fix this when contexts are added to higher order types
>  		hlds_out__pred_or_func_to_str(PredOrFunc, PredOrFuncStr),

Do you mean class contexts?  If so, please say so.

Also s/fix this/we will need to fix this/

> +extract_type_info_2(Type, _TypeVar, TypeClassInfoVar, Index, ModuleInfo, Goals,
> +		TypeInfoVar, VarSet0, VarTypes0, TypeInfoLocns0,
> +		VarSet, VarTypes, TypeInfoLocns) :-
> +
> +		% We need a dummy tvarset to pass to get_pred_id_and_proc_id
> +	varset__init(TVarSet0),
> +	varset__new_var(TVarSet0, Dummy, TVarSet),

Hmmm?  This comment is confusing because the `Dummy' in the code is
a dummy variable, whereas the `dummy' in the comment is a dummy typevarset.

If get_pred_id_and_proc_id doesn't need a typevarset, wouldn't it
be better to change get_pred_id_and_proc, rather than to invent a dummy
typevarset?

> +	term__context_init(EmptyContext),
> +	ExtractTypeInfo = qualified("mercury_builtin",
> +				"type_info_from_typeclass_info"),
> +	TypeClassInfoTerm = term__functor(term__atom("typeclass_info"), [],
> +		EmptyContext),
> +	IntTerm = term__functor(term__atom("int"), [], EmptyContext),
> +	TypeInfoTerm = term__functor(term__atom("type_info"), 
> +		[term__variable(Dummy)], EmptyContext),

> +		% We have to put an extra type_info at the front, and pass it a
> +		% bogus value because this pred has a type parameter... even
> +		% though we are actually _extracting_ the type_info.
> +		% Existential types would fix this.

(As we discussed) it's not clear what this comment applies to.

> +:- pred polymorphism__expand_class_method_bodies(module_info, module_info).
> +:- mode polymorphism__expand_class_method_bodies(in, out) is det.

A comment explaining what this predicate does would be helpful.

> +polymorphism__expand_class_method_bodies(ModuleInfo0, ModuleInfo) :-
> +	module_info_classes(ModuleInfo0, Classes),
> +	module_info_name(ModuleInfo0, Name),
> +	map__keys(Classes, ClassIds0),
> +
> +		% Don't expand classes from other modules
> +	FromThisModule = lambda([ClassId::in] is semidet,
> +		(
> +			ClassId = class_id(qualified(Name, _), _)

s/Name/ModuleName/

> +expand_one_body(hlds_class_proc(PredId, ProcId), ProcNum0, ProcNum, 
> +		ModuleInfo0, ModuleInfo) :-
> +	module_info_preds(ModuleInfo0, PredTable0),
> +	map__lookup(PredTable0, PredId, PredInfo0),
> +	pred_info_procedures(PredInfo0, ProcTable0),
> +	map__lookup(ProcTable0, ProcId, ProcInfo0),
> +
> +	pred_info_get_class_context(PredInfo0, ClassContext),
> +	(
> +		ClassContext = [Head|_]
> +	->
> +		InstanceDictContext = Head
> +	;
> +		error("expand_one_body: class method is not constrained")
> +	),

A comment here explaining what InstanceDictContext is would be helpful.

> +	proc_info_typeclass_info_varmap(ProcInfo0, VarMap),
> +	map__lookup(VarMap, InstanceDictContext, TypeClassInfoVar),
> +
> +	%proc_info_variables(ProcInfo0, VarSet0),
> +	%proc_info_vartypes(ProcInfo0, VarTypes0),

Why are those two lines there?

> +	(
> +		list__nth_member_search(HeadVars0, TypeClassInfoVar, N),
> +		delete_nth(HeadVars0, N, HeadVars1),
> +		delete_nth(Modes0, N, Modes1)
> +	->
> +		HeadVars = HeadVars1,
> +		map__apply_to_list(HeadVars1, Types0, Types),
> +		Modes = Modes1
> +	;
> +		error("expand_one_body: typeclass_info var not found")
> +	),

A brief comment explaining what this code fragment is doing would be
helpful.

> +	BodyGoalExpr = class_method_call(TypeClassInfoVar, ProcNum0,
> +		HeadVars, Types, Modes, Detism),
> +
> +		% Make the goal info for the call. Maybe we should re modecheck
> +		% the whole thing?

Why?

prog_data.m:
> +:- type class_constraint	---> constraint(classname, list(type)).
> +
> +:- type classname == sym_name.

I think s/classname/class_name/ would be more consistent.

prog_io.m:
>  :- import_module prog_data.
> -:- import_module list, io.
> +:- import_module list, io, prog_io_util.

Please keep the compiler modules and library modules in separate lists.

> +	% parse_item(ModuleName, VarSet, Term, MaybeItem)
> +	%
> +	% parse Term. If successful, MaybeItem is bound to the parsed item,
> +	% otherwise it is bound to an appropriate error message.
> +	% Qualify appropriate parts to come from ModuleName
> +:- pred parse_item(string, varset, term, maybe_item_and_context). 
> +:- mode parse_item(in, in, in, out) is det.

I don't understand the last sentence in the comment (and it is missing
a full stop).

> +	% We could probably get rid of some code duplication between here and
> +	% prog_io_typeclass.m
> +	% The last argument is `no' if no context was given, and yes(Result) if
> +	% there was. Result is either bound to the correctly parsed context, or
> +	% an appropriate error message (if a syntactically invalid error 
> +	% message was given.

Missing close parenthesis.

> Index: compiler/prog_out.m

> +:- pred prog_out__write_strings_with_context(term__context, list(string),
> +	io__state, io__state).
> +:- mode prog_out__write_strings_with_context(in, in, di, uo) is det.

Hmm... Zoltan recently added something similar to this in his
recent not-yet-commited change.

His procedure, called `write_error_pieces' and defined in a new file
error_util.m, had the same interface except that it also took
an extra "indentation level" argument.

When Zoltan's stuff is committed, you should change your code to use
his predicate (perhaps modifying it to incorporate whatever useful
functionality your version has that his doesn't).
For the time being just add an XXX comment.

> +++ simplify.m	1997/10/21 05:59:38
> @@ -420,6 +420,15 @@
>  		Info = Info0
>  	).
>  
> +	% XXX This is a little conservative, but will make no difference at
> +	% this stage. We could eliminate duplicate class_method_calls, but
> +	% since class_method_calls will only appear as the bodies of class
> +	% methods, there will never be duplicates. If we start inlining the
> +	% bodies of class methods (or other such optimisations), then adding
> +	% the simplification code for class_method_calls may be worth it.
> +simplify__goal_2(Goal, GoalInfo, Goal, GoalInfo, Info, Info) :-
> +	Goal = class_method_call(_, _, _, _, _, _).

The comment is wrong, because you do currently inline bodies of class methods.
Change it to something like "XXX we ought to do duplicate call elimination
for class method calls here".

> +	% XXX Is this right? Hmmmm. I need to talk to Tom.
> +higher_order_check_goal(class_method_call(_Var, _Num, _Vars, _Types, _Modes,
> +		_Det), GoalInfo, Negated, _WholeScc, ThisPredProcId,
> +		HighOrderLoops, Error, Module0, Module) -->
> +	(
> +		{ Negated = yes },
> +		{ HighOrderLoops = yes }
> +	->
> +		{ goal_info_get_context(GoalInfo, Context) },
> +		emit_message(ThisPredProcId, Context, 
> +			"higher order call may introduce a non-stratified loop", 
> +			Error, Module0, Module)		

s/higher order call/class method call/

> diff -u -r1.3 term_pass1.m
> --- term_pass1.m	1997/10/20 04:12:41	1.3
> +++ term_pass1.m	1997/10/20 07:16:46
> @@ -486,6 +486,11 @@
>  		GoalInfo, _Module, _, _PPId, Error, Offs, Offs) :-
>  	goal_info_get_context(GoalInfo, Context),
>  	Error = error(Context - horder_call).
> +	
> +proc_inequalities_goal(class_method_call(_, _, _, _, _, _), 
> +		GoalInfo, _Module, _, _PPId, Error, Offs, Offs) :-
> +	goal_info_get_context(GoalInfo, Context),
> +	Error = error(Context - horder_call).

Add an comment "it would be better to use a new alternative
`class_method_call' rather than than `horder_call' here".

> Index: compiler/type_util.m
...
> +	% type_list_matches_exactly(TypesA, TypesB) succeeds iff TypesA and
> +	% TypesB are exactly the same module variable renaming. 
> +:- pred type_list_matches_exactly(list(type), list(type)).
> +:- mode type_list_matches_exactly(in, in) is semidet.

s/module/modulo/

> @@ -662,16 +697,42 @@
>  	;
>  		NewVar = Var
>  	),
> +	(
> +		Locn = type_info(_),
> +		NewLocn = type_info(NewVar)
> +	;
> +		Locn = typeclass_info(_, Num),
> +		NewLocn = typeclass_info(NewVar, Num)
> +	),

This code fragment should be a subroutine.

> +		( list__member(request(class_method), Markers) ->

That will need to change when you merge in my changes to marker handling.

> +% XXX DGJ
> +% XXX This is wrong, and needs serious thought. It will do for now.
> +% XXX We need to add constraints to higher order thingies.

That comment is wrong, because currently in Mercury,
higher-order predicates are always monomorphic.
If/when we add support for polymorphic higher-order predicates
(i.e. support for nested universal type quantifiers)
then we will need to worry about that, but currently it is not
a problem.

> -				TypeCheckInfo)
> +				TypeCheckInfo2),
> +			    ( 
> +					% sanity check
> +			        PredClassContext \= []
> +			    ->
> +			        error("non-polymorphic pred has context")

s/context/class context/

> +			% Should we really do this now?
> +			perform_context_reduction(TypeCheckInfo2, TypeCheckInfo)

Hmm, difficult question.  Perhaps a pointer to the relevant paper on type
classes would be helpful here.

> +:- type args_type_assign --->	args(type_assign, list(type),
> +					list(class_constraint)).
> +					% Type assignment, types of callee,
> +					% constraints from callee

That's kinda ugly indentation.
I would prefer the style recommended in our coding guidelines:

:- type args_type_assign
	--->	args(
			type_assign,	% Type assignment
			list(type),	% types of callee,
			list(class_constraint)
					% constraints from callee
		).

> +	% typecheck_constraints(Inferring, TypeCheckInfo0, TypeCheckInfo)
> +	%
> +	% Produces TypeCheckInfo from TypeCheckInfo0 by rejecting any
> +	% type_assign in TypeCheckInfo0 whose calculated typeclass constraints
> +	% do not match the declared constraints.
> +	%
> +	% An appropriate error message is given if all type_assigns are 
> +	% rejected.
> +:- pred typecheck_constraints(bool, typecheck_info, typecheck_info).
> +:- mode typecheck_constraints(in, typecheck_info_di, typecheck_info_uo) is det.
> +
> +	% XXX if we're inferring, don't bother checking the constraints at this
> +	% XXX stage. Fix this up.
> +typecheck_constraints(yes, TypeCheckInfo, TypeCheckInfo).

Hmm.  It would be helpful if you could give some indication of what
would be necessary to "Fix this up".

> +typecheck_constraints(no, TypeCheckInfo0, TypeCheckInfo) :-
> +		%get the declared constraints
> +	typecheck_info_get_constraints(TypeCheckInfo0, DeclaredConstraints),
> +
> +	typecheck_info_get_type_assign_set(TypeCheckInfo0, TypeAssignSet0),
> +
> +	ConstraintsMatch = lambda([TypeAssign::in] is semidet,
> +		(
> +			type_assign_get_typeclass_constraints(TypeAssign,
> +				CalculatedConstraints0),
> +			type_assign_get_type_bindings(TypeAssign, Bindings),
> +			apply_rec_subst_to_constraints(Bindings,
> +				CalculatedConstraints0, CalculatedConstraints1),
> +			list__sort_and_remove_dups(CalculatedConstraints1, 
> +				CalculatedConstraints),
> +				% XXX. This needs thought. _When_ exactly
> +				% do two constraint sets match? This is
> +				% certainly too strict.
> +			CalculatedConstraints = DeclaredConstraints
> +		)),

You don't want to check equivalence; you want to check that the
CalculatedConstraints are implied by the DeclaredConstraints.
(It is OK for the user to declare types that are stricter than
necessary.)

It would probably be a good idea to move this check out into a
separate procedure (even if it is currently trivial).
This procedure should presumably return some kind of constraint_proof?

> +	% XXX do we need to do this to fixpoint?
> +:- pred reduce_type_assign_context(class_table, instance_table, 

Hmmm, difficult question...

> +	find_matching_instance_rule2(Instances, 1, ClassName, Types,
> +		TypeNames, NewTypeNames, Proofs0, Proofs, NewConstraints).

s/rule2/rule_2/g

> +	apply_class_rules2(Constraints0, Constraints0, ClassTable, Bindings,
> +		TypeNames, Proofs0, Proofs, Constraints).

s/rules2/rules_2/g

> +:- pred apply_class_rules2(list(class_constraint), list(class_constraint),
> +	class_table, tsubst, tvarset, map(class_constraint, constraint_proof),
> +	map(class_constraint, constraint_proof), list(class_constraint)).
> +:- mode apply_class_rules2(in, in, in, in, in, in, out, out) is det.
> +
> +	% The first argument is the list of constraints left to be checked.
> +	% The second argument is the list of constraints that have not been
> +	% rejected. If a redundant constraint is found, it is deleted from
> +	% both (if it is still in the first list).
> +apply_class_rules2([], Constraints, _, _, _, Proofs, Proofs, Constraints).
> +apply_class_rules2([C|Cs], AllConstraints, ClassTable, Bindings, TypeNames,
> +		Proofs0, Proofs, Constraints) :-

It would be clearer, IMHO, and more consistent with code elsewhere
if you used the name `TypeVarSet' or `TVarSet' instead of `TypeNames'.

> +	C = constraint(ClassName, Types0),
> +	list__length(Types0, Arity),
> +	ClassId = class_id(ClassName, Arity),
> +	map__lookup(ClassTable, ClassId, ClassDefn),
> +	term__apply_rec_substitution_to_list(Types0, Bindings, Types),
> +	ClassDefn = hlds_class_defn(ParentClassConstraints0, ClassVars,
> +		_ClassInterface, ClassVarset),
> +	term__var_list_to_term_list(ClassVars, ClassTypes),
> +		% XXX Can we really ignore _NewTypeNames?
> +	varset__merge_subst(TypeNames, ClassVarset, _NewTypeNames, RenameSubst),

To answer the XXX question: no, I don't think you can.

>  :- type type_assign	--->	type_assign(
>  					map(var, type),		% var types
>  					tvarset,		% type names
> -					tsubst			% type bindings
> +					tsubst,			% type bindings
> +					list(class_constraint),	% typeclass
> +								% constraints
> +					map(class_constraint,	% for each
> +					    constraint_proof)	% constraint
> +					    			% found to be
> +								% redundant,
> +								% why is it so?
>  				).

It would be better to change the layout so that you don't have to
write the comments in a 13-character column.

> +unique_modes__check_goal_2(class_method_call(TCVar, Num, Args, Types, Modes,
> +		Det), _GoalInfo0, Goal) -->
> +	mode_checkpoint(enter, "class method call"),
> +		% This is a little white lie. However, since there can't
> +		% really be a unique mode error in a class_method_call, this
> +		% lie will never be used. There can't be an error because the
> +		% class_method_call is introduced by the compiler as the body
> +		% of a class method.
> +	mode_info_set_call_context(higher_order_call(predicate)),

It's not quite clear what "this" refers to.
Start the comment with "Setting the context to `higher_order_call(...)' is
a little white lie. ...".

> diff -u -r1.35 unused_args.m
> --- unused_args.m	1997/09/01 14:05:44	1.35
> +++ unused_args.m	1997/10/23 00:54:37
> +	map__init(EmptyProofs),
>  		% *** This will need to be fixed when the condition
>  		%	field of the pred_info becomes used.
> +		% XXX
> +		% XXX The class context shouldn't be empty!!!
> +		% XXX
>  	pred_info_init(PredModule, qualified(PredModule, Name), Arity, Tvars,
>  		ArgTypes, true, Context, ClausesInfo, Status, MarkerList,
> -		GoalType, PredOrFunc, PredInfo1),
> +		GoalType, PredOrFunc, [], EmptyProofs, PredInfo1),
>  	pred_info_set_typevarset(PredInfo1, TypeVars, PredInfo).

You need to fix that XXX.

> --- compiler_design.html	1997/11/08 13:12:08	1.8

I think you need more documentation on type classes here;
for example, you should mention what polymorphism.m does with
regard to type classes.

library/mercury_builtin.m:
> +:- pred type_info_from_typeclass_info(typeclass_info, int, type_info(T)).
> +:- mode type_info_from_typeclass_info(in, in, out) is det.
> +
> +:- pred superclass_from_typeclass_info(typeclass_info, int, typeclass_info).
> +:- mode superclass_from_typeclass_info(in, in, out) is det.

You should document what these are used for.

>  	% the builtin < operator on ints, used in the code generated
>  	% for compare/3 preds
>  :- pred builtin_int_lt(int, int).
> @@ -252,6 +269,21 @@
>  
>  % Many of the predicates defined in this module are builtin -
>  % the compiler generates code for them inline.
> +
> +:- pragma c_code(will_not_call_mercury, 
> +	type_info_from_typeclass_info(TypeClassInfo::in, Index::in,
> +		TypeInfo::out),
> +" 
> +	TypeInfo = MR_typeclass_info_type_info(TypeClassInfo, Index);
> +").
> +
> +:- pragma c_code(will_not_call_mercury, 
> +	superclass_from_typeclass_info(TypeClassInfo0::in, Index::in,
> +		TypeClassInfo::out),
> +" 
> +	TypeClassInfo = 
> +		MR_typeclass_info_superclass_info(TypeClassInfo0, Index);
> +").

The order of the arguments to `pragma c_code' is wrong --
`will_not_call_mercury' should be the second argument, not the first.

> +	/* This is used as a return label both by do_call_det_closure and
> +	* do_call_det_class_method */
...
> +	/* This is used as a return label both by do_call_semidet_closure and
> +	* do_call_semidet_class_method */
...
> +	/* This is used as a return label both by do_call_nondet_closure and
> +	* do_call_nondet_class_method */

Non-standard comment layout.
Please use

	/*
	** comment goes here
	** and here
	*/

runtime/mercury_ho_call.c:
> +	/*
> +	 * r1: the typeclass_info
> +	 * r2: index of class method
> +	 * r3: number of immediate input arguments
> +	 * r4: number of output arguments
> +	 * r5+:input args
> +	 */

Ditto.

> +Define_entry(do_call_det_class_method);
> +{
> +	Code 	*destination;
> +	int	i, num_in_args, num_arg_typeclass_infos;
> +
> +	destination = MR_typeclass_info_class_method(r1, r2);
> +	num_arg_typeclass_infos = (int)MR_typeclass_info_instance_arity(r1);

s/(int)/(int) /

> +Define_entry(do_call_nondet_class_method);
> +{
> +	Code 	*destination;
> +	int	i, num_in_args, num_arg_typeclass_infos;
> +
> +	destination = MR_typeclass_info_class_method(r1, r2);
> +	num_arg_typeclass_infos = (int)MR_typeclass_info_instance_arity(r1);

Ditto.

> +#define	MR_typeclass_info_instance_arity(tci) \
> +	(Integer)(*(Word **)(tci))[0]
> +#define	MR_typeclass_info_class_method(tci, n) \
> +	(Code *)(*(Word **)tci)[(n)]
> +#define	MR_typeclass_info_arg_typeclass_info(tci, n) \
> +	((Word *)(tci))[(n)]

Hmm, you're missing an outer pair of parentheses here.
This can be dangerous.  For example, if someone where to write

	MR_typeclass_info_instance_arity(foo)++;

then after macro expansion it would be

	(Integer)(*(Word **)(foo))[0]++;

which would parse as

	(Integer) ((*(Word **)(foo))[0]++)

so it would do a `Word *' increment (which would increment the integer
value by sizeof(Word)) rather than an `Integer' increment.

How about the following instead:

	#define	MR_typeclass_info_instance_arity(tci) \
		((Integer) (*(Word **)(tci))[0])
	#define	MR_typeclass_info_class_method(tci, n) \
		((Code *) (*(Word **)tci)[(n)])
	#define	MR_typeclass_info_arg_typeclass_info(tci, n) \
		(((Word *)(tci))[(n)])

Maybe I'm being slightly paranoid here, but a little bit of paranoia
is not a bad thing ;-)


OK, that's it, at least for this round.
I'd like to see another diff relative to this version.

Thanks,
	Fergus.

-- 
Fergus Henderson <fjh at cs.mu.oz.au>   |  "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh>   |  of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3         |     -- the last words of T. S. Garp.