[m-dev.] diff: update NEWS file for MLDS trailing, etc.

[Fergus Henderson]

On 15-Dec-2000, Fergus Henderson <fjh at cs.mu.OZ.AU> wrote:
> Thanks for pointing that out.  I plan to document that it works except
> for argument types `float' and `char', and to change the code to (in
> MLDS grades) check for those argument types and if they're found,
> throw an exception.  I'll post a diff shortly.

Estimated hours taken: 2

Fix some problems with dynamic linking for the MLDS back-end.

extras/dynamic_linking/name_mangle.m:
browser/name_mangle.m:
	Fix a bug with the name mangling of the arity for functions;
	the mangling algorithm here didn't match what the compiler
	actually outputs.
	Clarify the documentation about the meaning of the `arity'
	field.

extras/dynamic_linking/dl.m:
	Fix a bug with the arity checks for functions;
	they were always failing.

	For the MLDS back-end, check that the argument type
	isn't `char' or `float'; those are not supported.
	Document that restriction.

extras/dynamic_linking/dl_test.m:
extras/dynamic_linking/dl_test.exp:
extras/dynamic_linking/hello.m:
	Add a test of dynamically linking functions and
	passing and returning floating-point arguments.

NEWS:
	Document the restriction that dl__mercury_sym doesn't support
	argument types `float' or `char' for the MLDS back-end.

Workspace: /home/pgrad/fjh/ws/hg
Index: extras/dynamic_linking/dl.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/dynamic_linking/dl.m,v
retrieving revision 1.2
diff -u -d -r1.2 dl.m
--- extras/dynamic_linking/dl.m	2000/11/21 07:38:53	1.2
+++ extras/dynamic_linking/dl.m	2000/12/18 13:52:31
@@ -40,11 +40,16 @@
 % it; see dl_test.m for an example of this.
 %
 % The type `T' below must be a higher-order type whose arity and
-% argument types match that of the specified procedure.
+% argument types exactly match that of the specified procedure.
 % The implementation may check this at runtime, but is not required
 % to do so.  (The current implementation checks that the type is a
 % higher-order type with the appropriate arity, but it does not
 % check the argument types.)
+%
+% WARNING: for the `--high-level-code' back-end (the `hl*' grades),
+% calling dl__mercury_sym for procedures with argument types `float'
+% or `char' is not supported.
+
 :- pred dl__mercury_sym(handle::in, mercury_proc::in, dl__result(T)::out,
 	io__state::di, io__state::uo) is det.
 
@@ -53,7 +58,7 @@
 	io__state::di, io__state::uo) is det.
 
 :- implementation.
-:- import_module std_util, require, string, list.
+:- import_module std_util, require, string, list, int.
 
 :- pragma c_header_code("
 	#include <stdio.h>
@@ -123,7 +128,8 @@
 
 mercury_sym(Handle, MercuryProc0, Result) -->
 	{ check_proc_spec_matches_result_type(Result, _,
-		MercuryProc0, MercuryProc) },
+		MercuryProc0, MercuryProc1) },
+	{ check_type_is_supported(Result, _, MercuryProc1, MercuryProc) },
 	{ MangledName = proc_name_mangle(MercuryProc) },
 	sym(Handle, MangledName, Result0),
 	{
@@ -152,6 +158,11 @@
 	Proc0 = mercury_proc(IsPredOrFunc, _Module, _Name, ProcArity, _Mode),
 	type_ctor_name_and_arity(type_ctor(type_of(Value)),
 		TypeModule, TypeName, TypeArity),
+	( TypeName = "func" ->
+		TypeProcArity = TypeArity - 1
+	;
+		TypeProcArity = TypeArity
+	),
 	(
 		( TypeModule \= "builtin"
 		; TypeName \= "pred", TypeName \= "func"
@@ -176,10 +187,10 @@
 			Msg),
 		error(Msg)
 	;
-		ProcArity \= TypeArity
+		ProcArity \= TypeProcArity
 	->
 		string__int_to_string(ProcArity, ProcArityString),
-		string__int_to_string(TypeArity, TypeArityString),
+		string__int_to_string(TypeProcArity, TypeArityString),
 		string__append_list([
 			"dl__mercury_sym: arity mismatch: ",
 			"argument has ", ProcArityString, " argument(s), ",
@@ -190,6 +201,46 @@
 		Proc = Proc0
 	).
 
+%
+% Check that the given higher-order type is supported.
+%
+% For the MLDS back-end, we normally need wrapper functions
+% for closures; the wrapper functions convert from type MR_Box
+% to the appropriate argument type, and then call the function
+% with the unboxed argument types.  Generating those on-the-fly
+% here would be tricky!  Instead, we only try to handle the cases
+% where wrappers are normally not needed, i.e. arguments with
+% types other than `char' or `float'.  All other argument types
+% are word-sized, and will hopefully be passed in the same way
+% by the C compiler.
+%
+% This procedure checks, for the MLDS back-end, that you're
+% not using it on a procedure with argument types `char' or
+% `float'.
+%
+% XXX this doesn't catch the case of no_tag types that
+% end up being equivalent to `float' or `char'.
+%
+:- pred check_type_is_supported(dl__result(T)::unused, T::unused,
+		mercury_proc::in, mercury_proc::out) is det.
+check_type_is_supported(_Result, Value, Proc0, Proc) :-
+	(
+		high_level_code,
+		list__member(ArgType, type_args(type_of(Value))),
+		% The following line might be more efficient,
+		% but is not yet supported by the MLDS back-end
+		% ArgType = type_of(_ `with_type` float))
+		ArgTypeCtor = type_ctor(ArgType),
+		( type_ctor_name(ArgTypeCtor) = "float"
+		; type_ctor_name(ArgTypeCtor) = "char"
+		),
+		type_ctor_module_name(ArgTypeCtor) = "builtin"
+	->
+		error("sorry, not implemented: dl__mercury_sym for procedure with argument type `float' or `char'")
+	;
+		Proc = Proc0
+	).
+
 sym(handle(Handle), Name, Result) -->
 	dlsym(Handle, Name, Pointer),
 	( { is_null(Pointer) } ->
@@ -244,3 +295,16 @@
 	dlclose((void *)Handle)
 #endif
 ").
+
+%-----------------------------------------------------------------------------%
+
+:- pred high_level_code is semidet.
+:- pragma c_code(high_level_code, [will_not_call_mercury, thread_safe], "
+#ifdef MR_HIGHLEVEL_CODE
+	SUCCESS_INDICATOR = TRUE;
+#else
+	SUCCESS_INDICATOR = FALSE;
+#endif
+").
+
+%-----------------------------------------------------------------------------%
Index: extras/dynamic_linking/dl_test.exp
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/dynamic_linking/dl_test.exp,v
retrieving revision 1.1
diff -u -d -r1.1 dl_test.exp
--- extras/dynamic_linking/dl_test.exp	1998/12/06 06:15:16	1.1
+++ extras/dynamic_linking/dl_test.exp	2000/12/15 09:00:37
@@ -1 +1,2 @@
 Hello, world
+1.0 + 2.0 + 3.0 = 6.000000
Index: extras/dynamic_linking/dl_test.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/dynamic_linking/dl_test.m,v
retrieving revision 1.1
diff -u -d -r1.1 dl_test.m
--- extras/dynamic_linking/dl_test.m	1998/12/06 06:15:16	1.1
+++ extras/dynamic_linking/dl_test.m	2000/12/18 14:07:33
@@ -12,7 +12,7 @@
 :- pred main(state::di, state::uo) is det.
 
 :- implementation.
-:- import_module dl, name_mangle.
+:- import_module dl, name_mangle, string, list.
 
 main -->
 	%
@@ -48,6 +48,32 @@
 			%
 			HelloPred
 		),
+
+		{ Add3Proc = mercury_proc(function, unqualified("hello"),
+					"add3", 3, 0) },
+		dl__mercury_sym(Handle, Add3Proc, MaybeAdd3),
+		(
+			{ MaybeAdd3 = error(Msg2) },
+			print("dlsym failed: "), print(Msg2), nl
+		;
+			{ MaybeAdd3 = ok(Add3Func0) },
+			%
+			% Cast the higher-order term that we obtained
+			% to the correct higher-order inst.
+			%
+			{ wrapper(Add3Func) =
+				inst_cast_add3(wrapper(Add3Func0)) },
+			%%% { CastWrapper = inst_cast_add3(wrapper(Add3Func0)) },
+			%%% { CastWrapper = wrapper(Add3Func) },
+			%
+			% Call the procedure whose address
+			% we just obtained.
+			%
+			{ Sum = Add3Func(1.0, 2.0, 3.0) },
+			io__format("1.0 + 2.0 + 3.0 = %f\n", [f(Sum)])
+		),
+
+
 		%
 		% unload the object code in the libhello.so file
 		%
@@ -62,9 +88,9 @@
 
 %
 % dl__mercury_sym returns a higher-order term with inst `ground'.
-% We need to cast it to the right higher-order inst, namely
-% `pred(di, uo) is det' before we can actually call it.
-% The function inst_cast/1 defined below does that.
+% We need to cast it to the right higher-order inst, which for the
+% `hello' procedure is `pred(di, uo) is det', before we can actually
+% call it.  The function inst_cast/1 defined below does that.
 %
 
 :- type io_pred == pred(io__state, io__state).
@@ -74,3 +100,18 @@
 :- mode inst_cast(in) = out(io_pred) is det.
 :- pragma c_code(inst_cast(X::in) = (Y::out(io_pred)),
 	[will_not_call_mercury, thread_safe], "Y = X").
+
+% Likewise for `add3'.
+% Note that for arguments of function type, the function type
+% normally gets automatically propagated into the inst.
+% We use a wrapper type to avoid that.
+
+:- type add3 == (func(float, float, float) = float).
+:- type add3_wrapper ---> wrapper(add3).
+:- inst add3_wrapper ---> wrapper(func(in, in, in) = out is det).
+
+:- func inst_cast_add3(add3_wrapper) = add3_wrapper.
+:- mode inst_cast_add3(in) = out(add3_wrapper) is det.
+:- pragma c_code(inst_cast_add3(X::in) = (Y::out(add3_wrapper)),
+	[will_not_call_mercury, thread_safe], "Y = X").
+
Index: extras/dynamic_linking/hello.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/dynamic_linking/hello.m,v
retrieving revision 1.1
diff -u -d -r1.1 hello.m
--- extras/dynamic_linking/hello.m	1998/12/06 06:15:17	1.1
+++ extras/dynamic_linking/hello.m	2000/12/15 08:38:41
@@ -1,15 +1,23 @@
 % Example module for use with dynamic linking.
 % The driver program dl_test.m dynamically loads the object code
-% for this module and then calls the predicate hello/2.
+% for this module and then calls the procedures defined here,
+% e.g. hello/2.
 
 % This source file is hereby placed in the public domain.  -fjh (the author).
 
 :- module hello.
 :- interface.
 :- import_module io.
+:- import_module float.
 
+% a very basic test: print "Hello world"
 :- pred hello(state::di, state::uo) is det.
 
+% test passing floating point arguments
+:- func add3(float, float, float) = float.
+
 :- implementation.
 
 hello --> print("Hello, world\n").
+
+add3(X, Y, Z) = X + Y + Z.
Index: extras/dynamic_linking/name_mangle.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/dynamic_linking/name_mangle.m,v
retrieving revision 1.2
diff -u -d -r1.2 name_mangle.m
--- extras/dynamic_linking/name_mangle.m	2000/12/15 03:14:11	1.2
+++ extras/dynamic_linking/name_mangle.m	2000/12/15 09:02:50
@@ -46,7 +46,9 @@
 
 :- type pred_name == string.
 
-:- type arity == int.
+:- type arity == int.		% note that for functions that arity here
+				% does *not* include the function result
+				% e.g. int:'*' has arity 2, not 3.
 
 :- type mode_num == int.	% mode numbers start from zero
 
@@ -88,12 +90,7 @@
 		qualify_name(ModuleName, Name0, LabelName0)
 	),
 	name_mangle(LabelName0, LabelName1),
-	( PredOrFunc = function ->
-		OrigArity is Arity - 1
-	;
-		OrigArity = Arity
-	),
-	string__int_to_string(OrigArity, ArityString),
+	string__int_to_string(Arity, ArityString),
 	string__int_to_string(ModeNum, ModeNumString),
 	string__append_list([LabelName1, "_", ArityString, "_", ModeNumString],
 		LabelName2),
@@ -129,17 +126,14 @@
 	name_mangle(LabelName0, LabelName1),
 	(
 		PredOrFunc = predicate,
-		PredOrFuncString = "p"
+		PredOrFuncString = "p",
+		ArityAsPred = Arity
 	;
 		PredOrFunc = function,
-		PredOrFuncString = "f"
-	),
-	( PredOrFunc = function ->
-		OrigArity is Arity - 1
-	;
-		OrigArity = Arity
+		PredOrFuncString = "f",
+		ArityAsPred = Arity + 1
 	),
-	string__int_to_string(OrigArity, ArityString),
+	string__int_to_string(ArityAsPred, ArityString),
 	string__int_to_string(ModeNum, ModeNumString),
 	string__append_list([LabelName1, "_", ArityString, "_",
 		PredOrFuncString, "_", ModeNumString],
Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.183
diff -u -d -r1.183 NEWS
--- NEWS	2000/12/14 12:16:53	1.183
+++ NEWS	2000/12/15 09:56:14
@@ -166,7 +166,9 @@
   sometimes it is better than the old back-end, sometimes it is worse.
   There are a few optimizations that we have not yet implemented for
   the new back-end that might make a significant difference for some
-  applications.  But we encourage those for whom performance is
+  applications.  But there are also some optimizations which we have
+  implemented for the new back-end that have not been implemented for
+  the old back-end.  We encourage those for whom performance is
   important to try their application with both the old and new
   back-ends and compare for themselves.
 
@@ -185,6 +187,9 @@
 	- the Aditi deductive database interface
   	- the `--split-c-files' option
   	- the `--introduce-accumulators' option
+	- dynamic linking (via the dl__mercury_sym procedure in
+	  extras/dynamic/dl.m in the mercury-extras distribution)
+	  for procedures with arguments of type `float' or `char'
 
 Changes to the development environment:
 
-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
                                    |  of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh>  |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------