[m-dev.] for review: type specialization and functions

[Simon Taylor]

Estimated hours taken: 1

Fix bugs in the code to construct the goal used to force specialization of
functions with `:- pragma type_spec' declarations.

compiler/make_hlds.m:
	Adjust the arity of functions - the specialization procedure
	had one too few arguments.

	Typechecking does not handle call goals which are actually
	calls to functions. The code now constructs a unification instead,
	which post_typecheck.m will convert into a call.

tests/hard_coded/type_spec.m:
tests/hard_coded/type_spec.err_exp:
	Test case.


Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.309
diff -u -u -r1.309 make_hlds.m
--- make_hlds.m	1999/10/12 01:55:35	1.309
+++ make_hlds.m	1999/10/12 05:07:50
@@ -899,8 +899,10 @@
 		% specified types to force the specialization. For imported
 		% predicates this forces the creation of the proper interface. 
 		%
+		pred_info_get_is_pred_or_func(PredInfo0, PredOrFunc),
+		adjust_func_arity(PredOrFunc, Arity, PredArity),
 		varset__init(ArgVarSet0),
-		make_n_fresh_vars("HeadVar__", Arity,
+		make_n_fresh_vars("HeadVar__", PredArity,
 			ArgVarSet0, Args, ArgVarSet),
 		% XXX We could use explicit type qualifications here
 		% for the argument types, but explicit type qualification
@@ -915,8 +917,18 @@
 		goal_info_set_nonlocals(GoalInfo0, NonLocals, GoalInfo1),
 		goal_info_set_context(GoalInfo1, Context, GoalInfo),
 		invalid_proc_id(DummyProcId),
-		Goal = call(PredId, DummyProcId, Args,
-			not_builtin, no, SymName) - GoalInfo,
+		(
+			PredOrFunc = predicate,
+			Goal = call(PredId, DummyProcId, Args,
+				not_builtin, no, SymName) - GoalInfo
+		;
+			PredOrFunc = function,
+			pred_args_to_func_args(Args, FuncArgs, RetArg),
+			ConsId = cons(SymName, Arity),
+			create_atomic_unification(RetArg,
+				functor(ConsId, FuncArgs), Context,
+				explicit, [], Goal)
+		),
 		Clause = clause(ProcIds, Goal, Context),
 		map__init(TI_VarMap),
 		map__init(TCI_VarMap),
@@ -932,8 +944,7 @@
 
 		pred_info_module(PredInfo0, ModuleName),
 		pred_info_get_aditi_owner(PredInfo0, Owner),
-		pred_info_get_is_pred_or_func(PredInfo0, PredOrFunc),
-		pred_info_init(ModuleName, SpecName, Arity, TVarSet,
+		pred_info_init(ModuleName, SpecName, PredArity, TVarSet,
 			ExistQVars, Types, true, Context, Clauses,
 			Status, Markers, none, PredOrFunc,
 			ClassContext, Proofs, Owner, NewPredInfo0),
Index: tests/hard_coded/type_spec.exp
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/type_spec.exp,v
retrieving revision 1.2
diff -u -u -r1.2 type_spec.exp
--- type_spec.exp	1999/10/03 04:17:25	1.2
+++ type_spec.exp	1999/10/14 01:32:55
@@ -6,3 +6,4 @@
 Failed
 Succeeded
 Failed
+Succeeded
Index: tests/hard_coded/type_spec.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/type_spec.m,v
retrieving revision 1.2
diff -u -u -r1.2 type_spec.m
--- type_spec.m	1999/10/03 04:17:25	1.2
+++ type_spec.m	1999/10/14 01:25:52
@@ -52,7 +52,9 @@
 
 	% Test specialization of unifications involving no tag types.
 :- pred unify_no_tag(no_tag::in, no_tag::in) is semidet.
-:- pragma no_inline(unify_no_tag/2).
+
+:- func id(T) = T.
+:- pragma type_spec(id/1, T = int).
 
 :- implementation.
 
@@ -92,8 +94,15 @@
 		io__write_string("Succeeded\n")
 	;
 		io__write_string("Failed\n")
+	),
+	( { id(1) = 1 } ->
+		io__write_string("Succeeded\n")
+	;
+		io__write_string("Failed\n")
 	).
 
+
+
 type_spec([], [], []).
 type_spec([_ | _], [], []).
 type_spec([], [_ | _], []).
@@ -140,4 +149,8 @@
 
 my_unify(X, X).
 
+:- pragma no_inline(unify_no_tag/2).
+
 unify_no_tag(X, X).
+
+id(X) = X.
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------