[m-dev.] for review: implement pragma export for MLDS backend

Peter Ross peter.ross at miscrit.be
Thu Jul 20 18:57:38 AEST 2000
Previous message: [m-dev.] for review: implement pragma export for MLDS backend
Next message: [m-dev.] for review: implement pragma export for MLDS backend
Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]
On Tue, Jul 18, 2000 at 01:33:41PM +1000, Fergus Henderson wrote:
> On 17-Jul-2000, Peter Ross <peter.ross at miscrit.be> wrote:
> > Index: library/io.m
> > ===================================================================
> > RCS file: /home/mercury1/repository/mercury/library/io.m,v
> > retrieving revision 1.198
> > diff -u -r1.198 io.m
> > --- library/io.m	2000/06/08 07:59:01	1.198
> > +++ library/io.m	2000/07/17 12:59:01
> > @@ -1809,6 +1809,27 @@
> >  
> >  :- pragma export(io__print(in, in, di, uo), "ML_io_print_to_stream").
> >  
> > +:- pragma c_code("
> > +/*
> > +** XXX this is a hack to work-around the current lack of
> > +** support for `pragma export'.
> > +*/
> > +#ifndef MR_BOOTSTRAPPED_PRAGMA_EXPORT
> > +  extern void mercury__io__print_3_p_0(MR_Word ti, MR_Box x);
> > +  extern void mercury__io__print_4_p_0(MR_Word ti, MR_Word stream, MR_Box x);
> > +
> > +  void
> > +  ML_io_print_to_cur_stream(MR_Word ti, MR_Word x) {
> > +	mercury__io__print_3_p_0(ti, (MR_Box) x);
> > +  }
> > +
> > +  void
> > +  ML_io_print_to_stream(MR_Word ti, MR_Word stream, MR_Word x) {
> > +	mercury__io__print_4_p_0(ti, stream, (MR_Box) x);
> > +  }
> > +#endif
> > +").
> 
> That should be inside `#ifdef MR_HIGHLEVEL_CODE'.
> 
> BTW, why move this from runtime/mercury.c to library/io.m?
> 
Otherwise you have to jump through more hoops to ensure that
MR_BOOTSTRAPPED_PRAGMA_EXPORT is defined for this block of code when
necessary.


> > Index: runtime/mercury_init.h
> > ===================================================================
> > RCS file: /home/mercury1/repository/mercury/runtime/mercury_init.h,v
> > retrieving revision 1.21
> > diff -u -r1.21 mercury_init.h
> > --- runtime/mercury_init.h	2000/05/08 16:11:06	1.21
> > +++ runtime/mercury_init.h	2000/07/17 12:59:06
> > @@ -115,9 +115,20 @@
> >  extern	void	ML_io_stderr_stream(Word *);
> >  extern	void	ML_io_stdout_stream(Word *);
> >  extern	void	ML_io_stdin_stream(Word *);
> > -extern	void	ML_io_print_to_cur_stream(Word, Word);
> > -extern	void	ML_io_print_to_stream(Word, Word, Word);
> >  
> > +#ifndef MR_HIGHLEVEL_CODE
> > +  extern void	ML_io_print_to_stream(Word, Word, Word);
> > +  extern void	ML_io_print_to_cur_stream(Word, Word);
> > +#else
> > +  #ifdef MR_BOOTSTRAPPED_PRAGMA_EXPORT
> > +    extern void	ML_io_print_to_stream(MR_Word, MR_Word, MR_Box);
> > +    extern void	ML_io_print_to_cur_stream(MR_Word, MR_Box);
> > +  #else
> > +    extern void	ML_io_print_to_stream(Word, Word, Word);
> > +    extern void	ML_io_print_to_cur_stream(Word, Word);
> > +  #endif
> > +#endif
> 
> The prototype should be the same regardless of whether
> MR_HIGHLEVEL_CODE is set or not.  Otherwise you haven't
> implemented `pragma export' correctly, i.e. in a way that matches
> the documentation in the Mercury language reference manual.
> 
Who the hell reads the reference manual! Hack baby hack until it works.
Don't worry about standards.  I mean haven't you learnt anything at MS. ;)

PS. These are now generated with the correct function prototypes.

I have fixed all the little things.  Here is a relative diff of my
changes to the compiler directory.


diff -u compiler.old/ml_code_gen.m compiler/ml_code_gen.m
--- compiler.old/ml_code_gen.m	Mon Jul 17 13:10:33 2000
+++ compiler/ml_code_gen.m	Thu Jul 20 10:26:37 2000
@@ -738,45 +738,37 @@
 	MLDS_Context = mlds__make_context(ProgContext),
 
 	(
-		is_forward_mode_det_function(ModuleInfo, PredId, ProcId)
+		is_output_det_function(ModuleInfo, PredId, ProcId)
 	->
-		IsFwdModeDetFunc = yes
+		IsOutDetFunc = yes
 	;
-		IsFwdModeDetFunc = no
+		IsOutDetFunc = no
 	),
 
 	ML_Defn = ml_pragma_export(C_Name, MLDS_Name, MLDS_FuncParams,
-			MLDS_Context, IsFwdModeDetFunc).
+			MLDS_Context, IsOutDetFunc).
 
 
 	%
 	% Test to see if the procedure is of the following form
-	%   :- func (T::in, U::in) = V::out is det.
+	%   :- func <name>(...) = V::out is det.
 	% as these need to handled specially.
 	%
-:- pred is_forward_mode_det_function(module_info, pred_id, proc_id).
-:- mode is_forward_mode_det_function(in, in, in) is semidet.
+:- pred is_output_det_function(module_info, pred_id, proc_id).
+:- mode is_output_det_function(in, in, in) is semidet.
 
-is_forward_mode_det_function(ModuleInfo, PredId, ProcId) :-
+is_output_det_function(ModuleInfo, PredId, ProcId) :-
 	module_info_pred_proc_info(ModuleInfo, PredId, ProcId, PredInfo,
 			ProcInfo),
 	
 	pred_info_get_is_pred_or_func(PredInfo, function),
-	proc_info_interface_code_model(ProcInfo, CodeModel),
-
-	CodeModel = model_det,
+	proc_info_interface_code_model(ProcInfo, model_det),
 
-		% XXX I am sure that there is a better way to do this,
-		% but this is how export.m figures it out!
- 	proc_info_argmodes(ProcInfo, ArgModes),
+ 	proc_info_argmodes(ProcInfo, Modes),
 	pred_info_arg_types(PredInfo, ArgTypes),
-	make_arg_infos(ArgTypes, ArgModes, CodeModel, ModuleInfo, ArgInfos),
-
-	assoc_list__from_corresponding_lists(ArgInfos, ArgTypes,
-			ArgInfoTypes),
-
-	pred_args_to_func_args(ArgInfoTypes, _InputArgInfoTypes,
-			arg_info(_RetArgLoc, RetArgMode) - RetType),
+	modes_to_arg_modes(ModuleInfo, Modes, ArgTypes, ArgModes),
+	pred_args_to_func_args(ArgModes, _InputArgModes, RetArgMode),
+	pred_args_to_func_args(ArgTypes, _InputArgTypes, RetArgType),
 
 	RetArgMode = top_out,
-	\+ type_util__is_dummy_argument_type(RetType).
+	\+ type_util__is_dummy_argument_type(RetArgType).

diff -u compiler.old/mlds.m compiler/mlds.m
--- compiler.old/mlds.m	Fri Jul 14 23:03:01 2000
+++ compiler/mlds.m	Thu Jul 20 10:24:30 2000
@@ -621,8 +621,8 @@
 		mlds__entity_name,	% MLDS name for exported entity
 		mlds__func_params,	% MLDS function parameters
 		mlds__context,
-		bool			% is a det function in the
-					% forward mode
+		bool			% is a det function with the
+					% final args mode top_out.
 	).
 
diff -u compiler.old/mlds_to_c.m compiler/mlds_to_c.m
--- compiler.old/mlds_to_c.m	Tue Jul 18 13:09:27 2000
+++ compiler/mlds_to_c.m	Thu Jul 20 10:30:41 2000
@@ -41,6 +41,7 @@
 :- import_module ml_code_util.	% for ml_gen_mlds_var_decl, which is used by
 				% the code that handles tail recursion.
 :- import_module ml_type_gen.	% for ml_gen_type_name
+:- import_module export.	% for export__type_to_type_string
 :- import_module globals, options, passes_aux.
 :- import_module builtin_ops, c_util, modules.
 :- import_module prog_data, prog_out, type_util.
@@ -362,38 +363,18 @@
 		mlds__pragma_export, io__state, io__state).
 :- mode mlds_output_pragma_export_decl(in, in, in, di, uo) is det.
 
-mlds_output_pragma_export_decl(ModuleName, Indent,
-		ml_pragma_export(C_name, _MLDS_Name, Signature0, Context,
-			IsFunc)) -->
-	(
-		{ IsFunc = yes }
-	->
-		{ Signature = det_func_signature(Signature0) }
-	;
-		{ Signature = Signature0 }
-	),
-	{ Name = qual(ModuleName, export(C_name)) },
-	mlds_indent(Context, Indent),
-	mlds_output_func_decl(Indent, Name, Context, Signature),
+mlds_output_pragma_export_decl(ModuleName, Indent, PragmaExport) -->
+	mlds_output_pragma_export_func_name(ModuleName, Indent, PragmaExport),
 	io__write_string(";").
 
 :- pred mlds_output_pragma_export_defn(mlds_module_name, indent,
 		mlds__pragma_export, io__state, io__state).
 :- mode mlds_output_pragma_export_defn(in, in, in, di, uo) is det.
 
-mlds_output_pragma_export_defn(ModuleName, Indent,
-		ml_pragma_export(C_name, MLDS_Name, MLDS_Signature, Context,
-			IsFunc)) -->
-	(
-		{ IsFunc = yes },
-		{ Signature = det_func_signature(MLDS_Signature) }
-	;
-		{ IsFunc = no },
-		{ Signature = MLDS_Signature }
-	),
-	{ Name = qual(ModuleName, export(C_name)) },
-	mlds_indent(Context, Indent),
-	mlds_output_func_decl(Indent, Name, Context, Signature),
+mlds_output_pragma_export_defn(ModuleName, Indent, PragmaExport) -->
+	{ PragmaExport = ml_pragma_export(_C_name, MLDS_Name, MLDS_Signature,
+			Context, IsFunc) },
+	mlds_output_pragma_export_func_name(ModuleName, Indent, PragmaExport),
 	io__write_string("{\n"),
 	mlds_indent(Context, Indent),
 	(
@@ -403,13 +384,72 @@
 	;
 		{ IsFunc = no },
 		mlds_output_pragma_export_defn_body(ModuleName, MLDS_Name,
-				Signature)
+				MLDS_Signature)
 	),
 	io__write_string("}\n").
 
+:- pred mlds_output_pragma_export_func_name(mlds_module_name, indent,
+		mlds__pragma_export, io__state, io__state).
+:- mode mlds_output_pragma_export_func_name(in, in, in, di, uo) is det.
+
+mlds_output_pragma_export_func_name(ModuleName, Indent,
+		ml_pragma_export(C_name, _MLDS_Name, Signature0, Context,
+			IsFunc)) -->
+	(
+		{ IsFunc = yes }
+	->
+		{ Signature = det_func_signature(Signature0) }
+	;
+		{ Signature = Signature0 }
+	),
+	{ Name = qual(ModuleName, export(C_name)) },
+	mlds_indent(Context, Indent),
+	mlds_output_func_decl_ho(Indent, Name, Context, Signature,
+			mlds_output_pragma_export_type(prefix),
+			mlds_output_pragma_export_type(suffix)).
+
+:- type locn ---> prefix ; suffix.
+:- pred mlds_output_pragma_export_type(locn, mlds__type, io__state, io__state).
+:- mode mlds_output_pragma_export_type(in, in, di, uo) is det.
+
+mlds_output_pragma_export_type(suffix, _Type) --> [].
+mlds_output_pragma_export_type(prefix, mercury_type(Type, _)) -->
+	{ export__type_to_type_string(Type, String) },
+	io__write_string(String).
+mlds_output_pragma_export_type(prefix, mlds__cont_type) -->
+	io__write_string("Word").
+mlds_output_pragma_export_type(prefix, mlds__commit_type) -->
+	io__write_string("Word").
+mlds_output_pragma_export_type(prefix, mlds__native_bool_type) -->
+	io__write_string("Word").
+mlds_output_pragma_export_type(prefix, mlds__native_int_type) -->
+	io__write_string("Integer").
+mlds_output_pragma_export_type(prefix, mlds__native_float_type) -->
+	io__write_string("Float").
+mlds_output_pragma_export_type(prefix, mlds__native_char_type) -->
+	io__write_string("Char").
+mlds_output_pragma_export_type(prefix, mlds__class_type(_, _, _)) -->
+	io__write_string("Word").
+mlds_output_pragma_export_type(prefix, mlds__array_type(_)) -->
+	io__write_string("Word").
+mlds_output_pragma_export_type(prefix, mlds__ptr_type(Type)) -->
+	mlds_output_pragma_export_type(prefix, Type),
+	io__write_string(" *").
+mlds_output_pragma_export_type(prefix, mlds__func_type(_)) -->
+	io__write_string("Word").
+mlds_output_pragma_export_type(prefix, mlds__generic_type) -->
+	io__write_string("Word").
+mlds_output_pragma_export_type(prefix, mlds__generic_env_ptr_type) -->
+	io__write_string("Word").
+mlds_output_pragma_export_type(prefix, mlds__pseudo_type_info_type) -->
+	io__write_string("Word").
+mlds_output_pragma_export_type(prefix, mlds__rtti_type(_)) -->
+	io__write_string("Word").
+	
+
 	%
 	% Output the definition body for a pragma export when it is
-	% *NOT* a det forward mode function.
+	% *NOT* a det function whose last arg is top_out.
 	%
 :- pred mlds_output_pragma_export_defn_body(mlds_module_name, mlds__entity_name,
 		func_params, io__state, io__state).
@@ -434,7 +474,7 @@
 
 	%
 	% Output the definition body for a pragma export when it is
-	% det forward mode function.
+	% det function whose last arg is top_out.
 	%
 :- pred mlds_output_pragma_export_func_defn_body(mlds_module_name,
 		mlds__entity_name, func_params, io__state, io__state).
@@ -471,7 +511,7 @@
 
 	%
 	% Write out the arguments to the MLDS function.  Note the last
-	% in the list of the arguments in the return value, so it must
+	% in the list of the arguments is the return value, so it must
 	% be "&arg"
 	%
 :- pred write_func_args(list(mlds__qualified_entity_name)::in,
@@ -496,10 +536,8 @@
 
 argument_names(ModuleName, mlds__func_params(Parameters, _RetTypes))
 		= QualNames :-
-	list__map(fst, Parameters, Names),
-	list__map((pred(Name::in, QualName::out) is det :-
-			QualName = qual(ModuleName, Name)),
-			Names, QualNames).
+	Names = list__map(fst, Parameters),
+	QualNames = list__map((func(Name) = qual(ModuleName, Name)), Names).
 
 	%
 	% Generates the signature for det functions in the forward mode.
@@ -903,10 +941,20 @@
 :- mode mlds_output_data_decl(in, in, di, uo) is det.
 
 mlds_output_data_decl(Name, Type) -->
-	mlds_output_type_prefix(Type),
+	mlds_output_data_decl_ho(mlds_output_type_prefix,
+			mlds_output_type_suffix, Name, Type).
+
+:- pred mlds_output_data_decl_ho(pred(mlds__type, io__state, io__state),
+		pred(mlds__type, io__state, io__state),
+		mlds__qualified_entity_name, mlds__type, io__state, io__state).
+:- mode mlds_output_data_decl_ho(pred(in, di, uo) is det,
+		pred(in, di, uo) is det, in, in, di, uo) is det.
+
+mlds_output_data_decl_ho(OutputPrefix, OutputSuffix, Name, Type) -->
+	OutputPrefix(Type),
 	io__write_char(' '),
 	mlds_output_fully_qualified_name(Name),
-	mlds_output_type_suffix(Type).
+	OutputSuffix(Type).
 
 :- pred mlds_output_data_defn(mlds__qualified_entity_name, mlds__type,
 			mlds__initializer, io__state, io__state).
@@ -1076,6 +1124,17 @@
 :- mode mlds_output_func_decl(in, in, in, in, di, uo) is det.
 
 mlds_output_func_decl(Indent, QualifiedName, Context, Signature) -->
+	mlds_output_func_decl_ho(Indent, QualifiedName, Context, Signature,
+			mlds_output_type_prefix, mlds_output_type_suffix).
+
+:- pred mlds_output_func_decl_ho(indent, qualified_entity_name, mlds__context,
+		func_params, pred(mlds__type, io__state, io__state),
+		pred(mlds__type, io__state, io__state), io__state, io__state).
+:- mode mlds_output_func_decl_ho(in, in, in, in, pred(in, di, uo) is det,
+		pred(in, di, uo) is det, di, uo) is det.
+
+mlds_output_func_decl_ho(Indent, QualifiedName, Context, Signature,
+		OutputPrefix, OutputSuffix) -->
 	{ Signature = mlds__func_params(Parameters, RetTypes) },
 	( { RetTypes = [] } ->
 		io__write_string("void")
@@ -1087,35 +1146,47 @@
 	io__write_char(' '),
 	mlds_output_fully_qualified_name(QualifiedName),
 	{ QualifiedName = qual(ModuleName, _) },
-	mlds_output_params(Indent, ModuleName, Context, Parameters),
+	mlds_output_params(OutputPrefix, OutputSuffix,
+			Indent, ModuleName, Context, Parameters),
 	( { RetTypes = [RetType2] } ->
 		mlds_output_type_suffix(RetType2)
 	;
 		[]
 	).
 
-:- pred mlds_output_params(indent, mlds_module_name, mlds__context,
+:- pred mlds_output_params(pred(mlds__type, io__state, io__state),
+		pred(mlds__type, io__state, io__state),
+		indent, mlds_module_name, mlds__context,
 		mlds__arguments, io__state, io__state).
-:- mode mlds_output_params(in, in, in, in, di, uo) is det.
+:- mode mlds_output_params(pred(in, di, uo) is det,
+		pred(in, di, uo) is det, in, in, in, in, di, uo) is det.
 
-mlds_output_params(Indent, ModuleName, Context, Parameters) -->
+mlds_output_params(OutputPrefix, OutputSuffix, Indent, ModuleName,
+		Context, Parameters) -->
 	io__write_char('('),
 	( { Parameters = [] } ->
 		io__write_string("void")
 	;
 		io__nl,
 		io__write_list(Parameters, ",\n",
-			mlds_output_param(Indent + 1, ModuleName, Context))
+			mlds_output_param(OutputPrefix, OutputSuffix,
+				Indent + 1, ModuleName, Context))
 	),
 	io__write_char(')').
 
-:- pred mlds_output_param(indent, mlds_module_name, mlds__context,
+:- pred mlds_output_param(pred(mlds__type, io__state, io__state),
+		pred(mlds__type, io__state, io__state),
+		indent, mlds_module_name, mlds__context,
 		pair(mlds__entity_name, mlds__type), io__state, io__state).
-:- mode mlds_output_param(in, in, in, in, di, uo) is det.
+:- mode mlds_output_param(pred(in, di, uo) is det,
+		pred(in, di, uo) is det, in, in, in, in, di, uo) is det.
+
 
-mlds_output_param(Indent, ModuleName, Context, Name - Type) -->
+mlds_output_param(OutputPrefix, OutputSuffix, Indent,
+		ModuleName, Context, Name - Type) -->
 	mlds_indent(Context, Indent),
-	mlds_output_data_decl(qual(ModuleName, Name), Type).
+	mlds_output_data_decl_ho(OutputPrefix, OutputSuffix,
+			qual(ModuleName, Name), Type).
 
 :- pred mlds_output_func_type_prefix(func_params, io__state, io__state).
 :- mode mlds_output_func_type_prefix(in, di, uo) is det.
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------
Previous message: [m-dev.] for review: implement pragma export for MLDS backend
Next message: [m-dev.] for review: implement pragma export for MLDS backend
Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]
More information about the developers mailing list