making cfloat__init/1 implicit

[Fergus Henderson]

Currently you cannot pass a variable with inst `free' to a
procedure that expects an argument of inst `any'; instead
you must explicitly initialize it with a call to cfloat__init/1
or the like.

The patch below would fix this.  However, it turns out to
cause more problems than it solves.  The reason is that
mode analsis ends up picking the wrong modes -- it prefers
the semidet ones above the det ones.  This causes determinism
errors...

We should fix mode analysis to use a more sane algorithm for
picking which mode to call.  Then this change can be committed.
For now I will leave it uncommitted.

--------------------

Extend the support for `any' insts.

compiler/inst_match.m:
compiler/modes.m:
	Allow `free' insts to be passed where `any' insts are expected.
	This is basically a special case of implied modes.
	We insert code to initialize the variable to inst `any' by
	calling `<mod>:<type>_init_any'/1, where `<mod>:<type>' is
	the type of the variable.

extras/clpr/cfloat.m:
	Add `cfloat__cfloat_init_any/1'.

Index: inst_match.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/inst_match.m,v
retrieving revision 1.36
diff -u -u -r1.36 inst_match.m
--- 1.36	1997/09/15 20:09:54
+++ inst_match.m	1997/09/15 18:52:01
@@ -12,13 +12,15 @@
 
 /*
 The handling of `any' insts is not complete.  (See also inst_util.m)
-It would be nice to allow `free' to match `any', but right now we don't.
+It would be nice to allow `free' to match `any', but right now we
+only allow a few special cases of that.
 The reason is that although the mode analysis would be pretty
 straight-forward, generating the correct code is quite a bit trickier.
 modes.m would have to be changed to handle the implicit
 conversions from `free'/`bound'/`ground' to `any' at
 
 	(1) procedure calls (this is just an extension of implied modes)
+		currently we support only the easy cases of this
 	(2) the end of branched goals
 	(3) the end of predicates.
 
@@ -284,15 +286,11 @@
 inst_matches_initial_3(any(UniqA), any(UniqB), _, _) :-
 	unique_matches_initial(UniqA, UniqB).
 inst_matches_initial_3(any(_), free, _, _).
-/* not yet:
 inst_matches_initial_3(free, any(_), _, _).
-*/
 inst_matches_initial_3(free, free, _, _).
 inst_matches_initial_3(bound(UniqA, ListA), any(UniqB), ModuleInfo, _) :-
 	unique_matches_initial(UniqA, UniqB),
-	bound_inst_list_matches_uniq(ListA, UniqB, ModuleInfo),
-	/* we do not yet allow `free' to match `any' */
-	bound_inst_list_is_ground_or_any(ListA, ModuleInfo).
+	bound_inst_list_matches_uniq(ListA, UniqB, ModuleInfo).
 inst_matches_initial_3(bound(_Uniq, _List), free, _, _).
 inst_matches_initial_3(bound(UniqA, ListA), bound(UniqB, ListB), ModuleInfo,
 		Expansions) :-
Index: modes.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modes.m,v
retrieving revision 1.204
diff -u -u -r1.204 modes.m
--- 1.204	1997/09/01 14:04:09
+++ modes.m	1997/09/15 19:12:25
@@ -1274,15 +1274,17 @@
 :- mode handle_implied_mode(in, in, in, in, in, in, out, out,
 				mode_info_di, mode_info_uo) is det.
 
-handle_implied_mode(Var0, VarInst0, VarInst, InitialInst, FinalInst, Det,
+handle_implied_mode(Var0, VarInst0, VarInst, InitialInst0, FinalInst, Det,
 		Var, Goals, ModeInfo0, ModeInfo) :-
 	mode_info_get_module_info(ModeInfo0, ModuleInfo0),
+	inst_expand(ModuleInfo0, InitialInst0, InitialInst),
+	inst_expand(ModuleInfo0, VarInst0, VarInst1),
 	(
 		% If the initial inst of the variable matches_final
 		% the initial inst specified in the pred's mode declaration,
 		% then it's not a call to an implied mode, it's an exact
 		% match with a genuine mode.
-		inst_matches_final(VarInst0, InitialInst, ModuleInfo0)
+		inst_matches_final(VarInst1, InitialInst, ModuleInfo0)
 	->
 		Var = Var0,
 		Goals = [] - [],
@@ -1293,7 +1295,61 @@
 		% instantiated vars, since that would require
 		% doing a partially instantiated deep copy, and we
 		% don't know how to do that yet.
-		( inst_is_bound(ModuleInfo0, InitialInst) ->
+		(
+			InitialInst = any(_),
+			inst_is_free(ModuleInfo0, VarInst1)
+		->
+			% This is the simple case of implied `any' modes,
+			% where the declared mode was `any -> ...'
+			% and the argument passed was `free'
+			
+			Var = Var0,
+
+			% Create code to initialize the variable to
+			% inst `any', by calling <mod>:<type>_init_any/1,
+			% where <mod>:<type> is the type of the variable.
+			% (XXX uniqueness of `any' insts ignore here)
+
+			mode_info_get_var_types(ModeInfo0, VarTypes0),
+			map__lookup(VarTypes0, Var, VarType),
+
+			mode_info_get_context(ModeInfo0, Context),
+			mode_info_get_mode_context(ModeInfo0, ModeContext),
+			mode_context_to_unify_context(ModeContext, ModeInfo0,
+				UnifyContext),
+			CallUnifyContext = yes(call_unify_context(
+						Var, var(Var), UnifyContext)),
+			( 
+				type_to_type_id(VarType, TypeId, _TypeArgs),
+				TypeId = qualified(TypeModule, TypeName) -
+						_TypeArity,
+				string__append(TypeName, "_init_any", PredName),
+				modes__build_call(TypeModule, PredName, [Var],
+					Context, CallUnifyContext, ModuleInfo0,
+					BeforeGoal - GoalInfo0)
+			->
+				InstmapDeltaAL = [Var - InitialInst],
+				instmap_delta_from_assoc_list(InstmapDeltaAL,
+					InstmapDelta),
+				goal_info_set_instmap_delta(GoalInfo0,
+					InstmapDelta, GoalInfo),
+				Goals = [BeforeGoal - GoalInfo] - [],
+				ModeInfo0 = ModeInfo
+			;
+				% If the type is a type variable,
+				% or there isn't any <mod>:<type>_init_any/1
+				% predicate, then give up.
+				Goals = [] - [],
+				set__singleton_set(WaitingVars, Var0),
+				mode_info_error(WaitingVars,
+					mode_error_implied_mode(Var0, VarInst0,
+					InitialInst),
+					ModeInfo0, ModeInfo
+				)
+			)
+		;
+			inst_is_bound(ModuleInfo0, InitialInst)
+		->
 			% This is the case we can't handle
 			Var = Var0,
 			Goals = [] - [],
@@ -1346,6 +1402,26 @@
 			Goals = [] - [AfterGoal - GoalInfo]
 		)
 	).
+
+:- pred modes__build_call(string, string, list(var),
+			term__context, maybe(call_unify_context), module_info,
+			hlds_goal).
+:- mode modes__build_call(in, in, in, in, in, in, out) is semidet.
+
+modes__build_call(Module, Name, ArgVars, Context, CallUnifyContext, ModuleInfo,
+		Goal) :-
+	module_info_get_predicate_table(ModuleInfo, PredicateTable),
+	list__length(ArgVars, Arity),
+	predicate_table_search_pred_m_n_a(PredicateTable, Module, Name, Arity,
+		[PredId]),
+	hlds_pred__proc_id_to_int(ModeId, 10000), % first mode, must be `det'
+	Call = call(PredId, ModeId, ArgVars, not_builtin, CallUnifyContext,
+		qualified(Module, Name)),
+	goal_info_init(GoalInfo0),
+	goal_info_set_context(GoalInfo0, Context, GoalInfo),
+	Goal = Call - GoalInfo.
+
+%-----------------------------------------------------------------------------%
 
 mode_context_to_unify_context(unify(UnifyContext, _), _, UnifyContext).
 mode_context_to_unify_context(call(PredId, Arg), ModeInfo,
Index: cfloat.m
===================================================================
RCS file: /home/mercury1/repository/clpr/cfloat.m,v
retrieving revision 1.13
diff -u -u -r1.13 cfloat.m
--- 1.13	1997/09/14 12:09:14
+++ cfloat.m	1997/09/15 18:59:54
@@ -343,6 +343,11 @@
 :- mode cfloat__le_float(ca, in) is semidet.
 :- mode cfloat__le_float(co, in) is det.
 
+	% The compiler automatically generates calls to this
+	% predicate to initialize variables to inst `any'.
+:- pred cfloat__cfloat_init_any(cfloat).
+:- mode cfloat__cfloat_init_any(co) is det.
+
 %----------------------------------------------------------------------------%
 %----------------------------------------------------------------------------%
 
@@ -358,6 +363,8 @@
 X - Y = Z :- cfloat__minus(X, Y, Z).
 X * Y = Z :- cfloat__mult(X, Y, Z).
 X / Y = Z :- Y \== 0.0, X = Y * Z.
+
+cfloat__cfloat_init_any(Svar) :- cfloat__init(Svar).
 
 %----------------------------------------------------------------------------%
 
-- 
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.