[m-rev.] Re: for review: default modes for higher-order func insts

[David Overton]

On Wed, Oct 10, 2001 at 03:19:46PM +1000, Fergus Henderson wrote:
> On 10-Oct-2001, David Overton <dmo at cs.mu.OZ.AU> wrote:
> > +:- pred inst_contains_nonstandard_func_mode(inst, module_info).
> > +:- mode inst_contains_nonstandard_func_mode(in, in) is semidet.
> 
> I don't understand that part of the relative diff;
> why was that predicate added?
> I don't see any calls to it in the relative diff.
> 

Sorry, it seems I missed out a few files.  This predicate is used in
by normalise_inst in compiler/mode_utils.m.   The complete relative diff
is below.


diff -u compiler/inst_match.m compiler/inst_match.m
--- compiler/inst_match.m
+++ compiler/inst_match.m
@@ -145,12 +145,18 @@
         % succeed if the inst is fully ground (i.e. contains only
         % `ground', `bound', and `not_reached' insts, with no `free'
         % or `any' insts).
+	% This predicate succeeds for non-standard function insts so some care
+	% needs to be taken since these insts may not be replaced by a less
+	% precise inst that uses the higher-order mode information.
 :- pred inst_is_ground(module_info, inst).
 :- mode inst_is_ground(in, in) is semidet.
 
         % succeed if the inst is not partly free (i.e. contains only
         % `any', `ground', `bound', and `not_reached' insts, with no
         % `free' insts).
+	% This predicate succeeds for non-standard function insts so some care
+	% needs to be taken since these insts may not be replaced by a less
+	% precise inst that uses the higher-order mode information.
 :- pred inst_is_ground_or_any(module_info, inst).
 :- mode inst_is_ground_or_any(in, in) is semidet.
 
diff -u compiler/inst_util.m compiler/inst_util.m
--- compiler/inst_util.m
+++ compiler/inst_util.m
@@ -99,24 +99,33 @@
 
 %-----------------------------------------------------------------------------%
 
-	% Succeed iff the first argument is a function pred_inst_info
-	% with non-standard mode.
+:- pred inst_contains_nonstandard_func_mode(inst, module_info).
+:- mode inst_contains_nonstandard_func_mode(in, in) is semidet.
+
+	% inst_contains_nonstandard_func_mode(Inst, ModuleInfo) succeeds iff the
+	% inst contains a higher-order function inst that does not match the
+	% standard function mode `(in, ..., in) = out is det'.
+	% E.g. this predicate fails for "func(in) = uo" because that matches the
+	% standard func mode "func(in) = out", even though it isn't the same as
+	% the standard func mode.
 
 :- pred pred_inst_info_is_nonstandard_func_mode(pred_inst_info, module_info).
 :- mode pred_inst_info_is_nonstandard_func_mode(in, in) is semidet.
 
-	% Succeed iff the first argument is a function ground_inst_info
-	% with non-standard mode.
+	% Succeed iff the first argument is a function pred_inst_info
+	% whose mode does not match the standard func mode.
 
 :- pred ground_inst_info_is_nonstandard_func_mode(ground_inst_info,
 			module_info).
 :- mode ground_inst_info_is_nonstandard_func_mode(in, in) is semidet.
 
-
-	% Return the standard mode for a function of the given arity.
+	% Succeed iff the first argument is a function ground_inst_info
+	% whose mode does not match the standard func mode.
 
 :- func pred_inst_info_standard_func_mode(arity) = pred_inst_info.
 
+	% Return the standard mode for a function of the given arity.
+
 %-----------------------------------------------------------------------------%
 
 :- implementation.
@@ -1633,11 +1642,37 @@
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
+inst_contains_nonstandard_func_mode(Inst, ModuleInfo) :-
+	set__init(Expansions0),
+	inst_contains_nonstandard_func_mode_2(Inst, ModuleInfo, Expansions0).
+
+:- pred inst_contains_nonstandard_func_mode_2(inst, module_info, set(inst)).
+:- mode inst_contains_nonstandard_func_mode_2(in, in, in) is semidet.
+
+inst_contains_nonstandard_func_mode_2(ground(_, GroundInstInfo), ModuleInfo,
+		_Expansions) :-
+	ground_inst_info_is_nonstandard_func_mode(GroundInstInfo, ModuleInfo).
+inst_contains_nonstandard_func_mode_2(bound(_, BoundInsts), ModuleInfo,
+		Expansions) :-
+	list__member(functor(_, Insts), BoundInsts),
+	list__member(Inst, Insts),
+	inst_contains_nonstandard_func_mode_2(Inst, ModuleInfo, Expansions).
+inst_contains_nonstandard_func_mode_2(inst_var(_), _, _) :-
+	error("internal error: uninstantiated inst parameter").
+inst_contains_nonstandard_func_mode_2(Inst, ModuleInfo, Expansions0) :-
+	Inst = defined_inst(InstName),
+	\+ set__member(Inst, Expansions0),
+	set__insert(Expansions0, Inst, Expansions1),
+	inst_lookup(ModuleInfo, InstName, Inst2),
+	inst_contains_nonstandard_func_mode_2(Inst2, ModuleInfo, Expansions1).
+
+%-----------------------------------------------------------------------------%
+
 pred_inst_info_is_nonstandard_func_mode(PredInstInfo, ModuleInfo) :-
 	PredInstInfo = pred_inst_info(function, ArgModes, _),
 	Arity = list__length(ArgModes),
-	\+ pred_inst_matches(pred_inst_info_standard_func_mode(Arity),
-		PredInstInfo, ModuleInfo).
+	\+ pred_inst_matches(PredInstInfo,
+		pred_inst_info_standard_func_mode(Arity), ModuleInfo).
 
 ground_inst_info_is_nonstandard_func_mode(GroundInstInfo, ModuleInfo) :-
 	GroundInstInfo = higher_order(PredInstInfo),
diff -u tests/hard_coded/ho_func_default_inst.exp tests/hard_coded/ho_func_default_inst.exp
--- tests/hard_coded/ho_func_default_inst.exp
+++ tests/hard_coded/ho_func_default_inst.exp
@@ -1,2 +1,2 @@
-hello
-world
+1
+2
diff -u tests/hard_coded/ho_func_default_inst.m tests/hard_coded/ho_func_default_inst.m
--- tests/hard_coded/ho_func_default_inst.m
+++ tests/hard_coded/ho_func_default_inst.m
@@ -17,27 +17,44 @@
 	{ Map = map },
 	{ F1 = Map ^ det_elem(1) },
 	{ F2 = Map ^ det_elem(2) },
-	io__write_string(F1(1)),
+	io__write_int(F1(1)),
 	io__nl,
 	write_func(F2).
 
-:- type t == (func(int) = string).
+:- type t == (func(int) = int).
+
+:- inst one == bound(1).
 
 :- func map = map(int, t).
 
-map = (map__init ^ elem(1) := hello) ^ elem(2) := world.
+map = (((map__init
+		^ elem(1) := foo1)
+		^ elem(2) := foo2)
+		^ elem(3) := foo3)
+		^ elem(4) := foo4.
 
 :- pred write_func(t, io, io) is det.
 :- mode write_func(func(in) = out is det, di, uo) is det.
 
 write_func(F) -->
-	io__write_string(F(1)),
+	io__write_int(F(1)),
 	io__nl.
 
-:- func hello(int) = string.
+:- func foo1(int) = int.
 
-hello(_) = "hello".
+foo1(_) = 1.
 	
-:- func world(int) = string.
+:- func foo2(int) = int.
+:- mode foo2(in) = uo is det.
+
+foo2(_) = 2.
+
+:- func foo3(int) = int.
+:- mode foo3(in) = out(one) is det.
+
+foo3(_) = 1.
+
+:- func foo4(int) = int.
+:- mode foo4(in(one)) = out is det.
 
-world(_) = "world".
+foo4(1) = 4.
diff -u tests/invalid/Mmakefile tests/invalid/Mmakefile
--- tests/invalid/Mmakefile
+++ tests/invalid/Mmakefile
@@ -47,6 +47,7 @@
 	func_errors.m \
 	funcs_as_preds.m \
 	ho_default_func_1.m \
+	ho_default_func_3.m \
 	ho_type_mode_bug.m \
 	ho_unique_error.m \
 	impure_method_impl.m \
only in patch2:
--- tests/invalid/ho_default_func_3.m	1 Jan 1970 00:00:00 -0000
+++ tests/invalid/ho_default_func_3.m	9 Oct 2001 06:18:13 -0000
@@ -0,0 +1,34 @@
+% Compiling this module should generate an error message since
+% it tries to cast a non-standard func inst to ground.
+
+:- module ho_default_func_3.
+
+:- interface.
+:- import_module io.
+
+:- pred main(io__state, io__state).
+:- mode main(di, uo) is det.
+
+:- implementation.
+
+:- import_module int, std_util.
+
+main -->
+	{ baz(foo, F) },
+	io__write_int(F(42)), nl.
+
+:- func foo(int) = int.
+foo(X) = X + 1.
+
+:- func bar(int) = int.
+:- mode bar(di) = uo is det.
+bar(X) = X.
+
+:- pred baz(T::in, T::out) is det.
+baz(X, Y) :-
+	( univ_to_type(univ(bar), Y0) ->
+		Y = Y0
+	;
+		Y = X
+	).
+
only in patch2:
--- tests/invalid/ho_default_func_3.err_exp	1 Jan 1970 00:00:00 -0000
+++ tests/invalid/ho_default_func_3.err_exp	9 Oct 2001 06:19:43 -0000
@@ -0,0 +1,6 @@
+ho_default_func_3.m:029: In clause for `baz(in, out)':
+ho_default_func_3.m:029:   in call to function `std_util:univ/1':
+ho_default_func_3.m:029:   mode error: arguments `TypeInfo_13, V_7, V_6'
+ho_default_func_3.m:029:   have insts `unique(private_builtin:type_info(unique(<type_ctor_info for :func/0>), unique(2), unique(<type_ctor_info for :int/0>), unique(<type_ctor_info for :int/0>))), /* unique */(func((unique -> clobbered)) = (free -> unique) is det), free',
+ho_default_func_3.m:029:   which does not match any of the modes for function `std_util:univ/1'.
+For more information, try recompiling with `-E'.
only in patch2:
--- compiler/mode_util.m	13 Sep 2001 23:18:12 -0000	1.137
+++ compiler/mode_util.m	9 Oct 2001 02:33:58 -0000
@@ -1793,7 +1793,8 @@
 			% don't infer unique modes for introduced type_infos
 			% arguments, because that leads to an increase
 			% in the number of inferred modes without any benefit
-			\+ is_introduced_type_info_type(Type)
+			\+ is_introduced_type_info_type(Type),
+			\+ inst_contains_nonstandard_func_mode(Inst, ModuleInfo)
 		->
 			NormalisedInst = ground(unique, none)
 		;
@@ -1802,12 +1803,14 @@
 			% don't infer unique modes for introduced type_infos
 			% arguments, because that leads to an increase
 			% in the number of inferred modes without any benefit
-			\+ is_introduced_type_info_type(Type)
+			\+ is_introduced_type_info_type(Type),
+			\+ inst_contains_nonstandard_func_mode(Inst, ModuleInfo)
 		->
 			NormalisedInst = ground(mostly_unique, none)
 		;
 			inst_is_ground(ModuleInfo, Inst),
-			\+ inst_is_clobbered(ModuleInfo, Inst)
+			\+ inst_is_clobbered(ModuleInfo, Inst),
+			\+ inst_contains_nonstandard_func_mode(Inst, ModuleInfo)
 		->
 			NormalisedInst = ground(shared, none)
 		;

-- 
David Overton      Department of Computer Science & Software Engineering
PhD Student        The University of Melbourne, Victoria 3010, Australia
+61 3 8344 9159    http://www.cs.mu.oz.au/~dmo
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------