[m-rev.] for review: new foreign_type syntax

Tyson Dowd trd at cs.mu.OZ.AU
Wed Nov 28 12:27:15 AEDT 2001


Hi,

Finally I got around to finishing off this diff.

===================================================================

Estimated hours taken: 6
Branches: main

Fix and enable the new foreign_type syntax.  We now accept declarations
such as:

:- pragma foreign_type(xmldoc, il("class [System.Xml]System.Xml.XmlDocument")).

compiler/prog_data.m:
	Remove the foreign type location from the foreign_type pragma,
	it is better to make this part of the backend type.
	Rename backend as backend_type as it specifies a type in a
	particular backend.

compiler/prog_io_pragma.m:
	Uncomment the foreign_type parsing code, change the syntax.
	Write some simple code to parse CIL type names.

compiler/make_hlds.m:
compiler/mercury_to_mercury.m:
compiler/module_qual.m:
compiler/modules.m:
compiler/recompilation_version.m:
	Handle changes to backend_type and the foreign_type pragma.

doc/reference_manual.texi:
	Document the new syntax.

Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.391
diff -u -r1.391 make_hlds.m
--- compiler/make_hlds.m	12 Nov 2001 11:08:07 -0000	1.391
+++ compiler/make_hlds.m	21 Nov 2001 05:33:10 -0000
@@ -395,10 +395,9 @@
 		{ Pragma = foreign_proc(_, _, _, _, _, _) },
 		{ Module = Module0 }
 	;	
-		{ Pragma = foreign_type(Backend, _MercuryType, Name,
-				ForeignType) },
+		{ Pragma = foreign_type(Backend, _MercuryType, Name) },
 
-		{ Backend = il(ForeignTypeLocation) },
+		{ Backend = il(ForeignTypeLocation, ForeignType) },
 
 		{ varset__init(VarSet) },
 		{ Args = [] },
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.198
diff -u -r1.198 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m	8 Nov 2001 15:30:31 -0000	1.198
+++ compiler/mercury_to_mercury.m	21 Nov 2001 05:33:10 -0000
@@ -467,18 +467,18 @@
 			PredOrFunc, Vars, VarSet, PragmaCode)
 	;
 		{ Pragma = foreign_type(Backend, _MercuryType,
-				MercuryTypeSymName, ForeignType) },
+				MercuryTypeSymName) },
 		io__write_string(":- pragma foreign_type("),
 		% output_type(varset__init, no, MercuryType),
 		mercury_output_sym_name(MercuryTypeSymName),
 		io__write_string(", "),
-		mercury_output_sym_name(ForeignType),
-		io__write_string(", "),
 
-		{ Backend = il(ForeignLocStr) },
+		{ Backend = il(ForeignLocStr, ForeignType) },
 		io__write_string("il(\""),
 		io__write_string(ForeignLocStr),
-		io__write_string("\")).\n")
+		io__write_string("\", "),
+		mercury_output_sym_name(ForeignType),
+		io__write_string("\").\n")
 	;
 		{ Pragma = import(Pred, PredOrFunc, ModeList, Attributes,
 			C_Function) },
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.70
diff -u -r1.70 module_qual.m
--- compiler/module_qual.m	6 Nov 2001 15:21:05 -0000	1.70
+++ compiler/module_qual.m	21 Nov 2001 05:33:10 -0000
@@ -247,7 +247,7 @@
 collect_mq_info_2(pred_or_func(_,_,__,_,_,_,_,_,_,_), Info, Info).
 collect_mq_info_2(pred_or_func_mode(_,_,_,_,_,_), Info, Info).
 collect_mq_info_2(pragma(Pragma), Info0, Info) :-
-	( Pragma = foreign_type(_, Type, SymName, _ForeignType) ->
+	( Pragma = foreign_type(_, Type, SymName) ->
 		( type_to_type_id(Type, _ - Arity0, _) ->
 			Arity = Arity0
 		;
@@ -893,11 +893,11 @@
 qualify_pragma(source_file(File), source_file(File), Info, Info) --> [].
 qualify_pragma(foreign_decl(L, Code), foreign_decl(L, Code), Info, Info) --> [].
 qualify_pragma(foreign_code(L, C), foreign_code(L, C), Info, Info) --> [].
+qualify_pragma(foreign_type(Backend, Type0, SymName),
+		foreign_type(Backend, Type, SymName), Info0, Info) -->
+	qualify_type(Type0, Type, Info0, Info).
 qualify_pragma(foreign_import_module(L, M), foreign_import_module(L, M),
 		Info, Info) --> [].
-qualify_pragma(foreign_type(Backend, Type0, SymName, F),
-		foreign_type(Backend, Type, SymName, F), Info0, Info) -->
-	qualify_type(Type0, Type, Info0, Info).
 qualify_pragma(
 	    foreign_proc(Rec, SymName, PredOrFunc, PragmaVars0, Varset, Code),
 	    foreign_proc(Rec, SymName, PredOrFunc, PragmaVars, Varset, Code), 
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.208
diff -u -r1.208 modules.m
--- compiler/modules.m	24 Nov 2001 17:52:15 -0000	1.208
+++ compiler/modules.m	26 Nov 2001 03:36:27 -0000
@@ -1147,7 +1147,7 @@
 pragma_allowed_in_interface(foreign_import_module(_, _), no).
 pragma_allowed_in_interface(foreign_code(_, _), no).
 pragma_allowed_in_interface(foreign_proc(_, _, _, _, _, _), no).
-pragma_allowed_in_interface(foreign_type(_, _, _, _), yes).
+pragma_allowed_in_interface(foreign_type(_, _, _), yes).
 pragma_allowed_in_interface(inline(_, _), no).
 pragma_allowed_in_interface(no_inline(_, _), no).
 pragma_allowed_in_interface(obsolete(_, _), yes).
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.72
diff -u -r1.72 prog_data.m
--- compiler/prog_data.m	20 Nov 2001 13:53:19 -0000	1.72
+++ compiler/prog_data.m	22 Nov 2001 02:10:47 -0000
@@ -157,9 +157,8 @@
 			% PredName, Predicate or Function, Vars/Mode, 
 			% VarNames, Foreign Code Implementation Info
 
-	;	foreign_type(backend, (type), sym_name, sym_name)
-			% Backend, MercuryType, MercuryTypeName,
-			% ForeignType, ForeignTypeLocation
+	;	foreign_type(backend_type, (type), sym_name)
+			% BackendType, MercuryType, MercuryTypeName
 
 	;	foreign_import_module(foreign_language, module_name)
 			% Equivalent to
@@ -288,9 +287,10 @@
 % Stuff for the foreign interfacing pragmas.
 %
 
-:- type backend
-			% The location of the il name.
-	--->	il(string).
+:- type backend_type
+			% The location of the il name, and the .NET type name
+			% (represented as a sym_name)
+	--->	il(string, sym_name).
 
 %
 % Stuff for tabling pragmas
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.38
diff -u -r1.38 prog_io_pragma.m
--- compiler/prog_io_pragma.m	20 Nov 2001 13:53:20 -0000	1.38
+++ compiler/prog_io_pragma.m	26 Nov 2001 04:55:25 -0000
@@ -70,52 +70,37 @@
 			ErrorTerm)
 	).
 
-/*
 parse_pragma_type(ModuleName, "foreign_type", PragmaTerms,
             ErrorTerm, _VarSet, Result) :-
-    ( PragmaTerms = [MercuryName, ForeignName, Target] ->
+    ( PragmaTerms = [MercuryName, BackendTerm] ->
+	parse_backend(BackendTerm, MaybeBackend),
     	(
-	    parse_backend(Target, Backend)
-	->
+	    MaybeBackend = ok(Backend),
 	    parse_implicitly_qualified_term(ModuleName, MercuryName,
 		    ErrorTerm, "`:- pragma foreign_type' declaration",
 		    MaybeMercuryType),
 	    (
 		MaybeMercuryType = ok(MercuryTypeSymName, MercuryArgs),
 		( MercuryArgs = [] ->
-		    parse_qualified_term(ForeignName, ErrorTerm,
-			"`:- pragma foreign_type' declaration",
-			MaybeForeignType),
-		    (
-			MaybeForeignType = ok(ForeignType, ForeignArgs),
-			( ForeignArgs = [] ->
-			    term__coerce(MercuryName, MercuryType),
-			    Result = ok(pragma(foreign_type(Backend,
-				    MercuryType, MercuryTypeSymName,
-				    ForeignType)))
-			;
-			    Result = error("foreign type arity not 0", ErrorTerm)
-			)
-		    ;
-			MaybeForeignType = error(String, Term),
-			Result = error(String, Term)
-		    )
+		    term__coerce(MercuryName, MercuryType),
+		    Result = ok(pragma(foreign_type(Backend,
+			    MercuryType, MercuryTypeSymName)))
 		;
-		    Result = error("mercury type arity not 0", ErrorTerm)
+		    Result = error("foreign type arity not 0", ErrorTerm)
 		)
 	    ;
 		MaybeMercuryType = error(String, Term),
 		Result = error(String, Term)
 	    )
 	;
-	    Result = error("invalid backend parameter", Target)
+	    MaybeBackend = error(String, Term),
+	    Result = error(String, Term)
 	)
     ;
         Result = error(
     "wrong number of arguments in `:- pragma foreign_type' declaration",
             ErrorTerm)
     ).
-*/
 
 parse_pragma_type(ModuleName, "foreign_decl", PragmaTerms,
 			ErrorTerm, VarSet, Result) :-
@@ -214,13 +199,37 @@
 parse_foreign_language(term__functor(term__atom(String), _, _), Lang) :-
 	globals__convert_foreign_language(String, Lang).
 
-:- pred parse_backend(term, backend).
-:- mode parse_backend(in, out) is semidet.
+:- pred parse_backend(term, maybe1(backend_type)).
+:- mode parse_backend(in, out) is det.
+
+parse_backend(InputTerm, Result) :-
+	( 
+		InputTerm = term__functor(term__atom(Language),
+			[ILTypeTerm], _),
+		globals__convert_foreign_language(Language, il),
+		ILTypeTerm = term__functor(term__string(ILTypeName), [], _)
+	->
+		parse_il_type_name(ILTypeName, InputTerm, Result)
+	;
+		Result = error("invalid backend", InputTerm)
+	).
 
-parse_backend(term__functor(Functor, Args, _), Backend) :-
-	Functor = term__atom("il"),
-	Args = [term__functor(term__string(Module), [], _)],
-	Backend = il(Module).
+:- pred parse_il_type_name(string, term, maybe1(backend_type)).
+:- mode parse_il_type_name(in, in, out) is det.
+
+parse_il_type_name(String0, ErrorTerm, BackendType) :-
+	( 
+		string__append("class [", String1, String0),
+		string__sub_string_search(String1, "]", Index)
+	->
+		string__left(String1, Index, AssemblyName),
+		string__split(String1, Index + 1, _, TypeNameStr),
+		string_to_sym_name(TypeNameStr, ".", TypeSymName),
+		BackendType = ok(il(AssemblyName, TypeSymName))
+	;
+		BackendType = error("invalid backend type description", 
+			ErrorTerm)
+	).
 
 	% This predicate parses both c_header_code and foreign_decl pragmas.
 :- pred parse_pragma_foreign_decl_pragma(module_name, string,
Index: compiler/recompilation_version.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/recompilation_version.m,v
retrieving revision 1.9
diff -u -r1.9 recompilation_version.m
--- compiler/recompilation_version.m	6 Nov 2001 15:21:10 -0000	1.9
+++ compiler/recompilation_version.m	21 Nov 2001 05:33:10 -0000
@@ -454,7 +454,7 @@
 is_pred_pragma(foreign_proc(_, Name, PredOrFunc, Args, _, _),
 		yes(yes(PredOrFunc) - Name / Arity)) :-
 	adjust_func_arity(PredOrFunc, Arity, list__length(Args)).
-is_pred_pragma(foreign_type(_, _, _, _), no).
+is_pred_pragma(foreign_type(_, _, _), no).
 is_pred_pragma(type_spec(Name, _, Arity, MaybePredOrFunc, _, _, _, _),
 		yes(MaybePredOrFunc - Name / Arity)).
 is_pred_pragma(inline(Name, Arity), yes(no - Name / Arity)).
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.228
diff -u -r1.228 reference_manual.texi
--- doc/reference_manual.texi	22 Nov 2001 19:19:54 -0000	1.228
+++ doc/reference_manual.texi	26 Nov 2001 03:48:42 -0000
@@ -4815,6 +4815,9 @@
 				       or function as a call to code
 				       written in a different
 				       programming language.
+* Using foreign types from Mercury::   How to use a type defined in         
+				       a different programming language
+				       in Mercury code.                     
 * Adding foreign declarations::        How to add declarations of
   				       entities in other programming
 				       languages.
@@ -5004,6 +5007,31 @@
 
 @c -----------------------------------------------------------------------
 
+ at node Using foreign types from Mercury
+ at section Using foreign types from Mercury
+
+Types defined in foreign language can be declared in Mercury using 
+a declaration of the form
+
+ at example
+:- pragma foreign_type(@var{MercuryTypeName}, @var{ForeignTypeDescriptor}).
+ at end example
+
+This declaration introduces a new abstract type in Mercury which is a
+synonym for a type defined in a foreign language.
+
+ at var{ForeignTypeDescriptor} defines how the Mercury type is mapped for a
+particular compilation grade.  Specific syntax is given in the language
+specific information below.
+
+ at var{MercuryTypeName} is treated as an abstract type at all times in
+Mercury code.
+However, if @var{MercuryTypeName} is one of the parameters of a
+foreign_proc, it will be passed to that foreign_proc as specified by
+ at var{ForeignTypeDescriptor}.
+
+ at c -----------------------------------------------------------------------
+
 @node Adding foreign declarations
 @section Adding foreign declarations
 
@@ -5085,6 +5113,7 @@
 
 @menu
 * Interfacing with C 		:: How to write code to interface with C
+* Interfacing with .NET 	:: How to write code to interface with .NET
 * Interfacing with C# 		:: How to write code to interface with C#
 * Interfacing with IL 		:: How to write code to interface with IL
 * Interfacing with Managed C++ 	:: How to write code to interface with
@@ -5126,6 +5155,7 @@
 * Using pragma foreign_proc for C 	:: Calling C code from Mercury
 * Using pragma foreign_decl for C 	:: Including C declarations in Mercury
 * Using pragma foreign_code for C 	:: Including C code in Mercury
+* Using pragma foreign_type for C 	:: Declaring C types in Mercury
 @end menu
 
 @node Using pragma foreign_proc for C
@@ -5248,6 +5278,69 @@
 @end example
 
 Such code is copied verbatim into the generated C file.
+
+ at node Using pragma foreign_type for C
+ at subsubsection Using pragma foreign_type for C
+
+This pragma is currently not implemented for C backends.
+
+ at c ----------------------------------------------------------------------------
+
+ at node Interfacing with .NET
+ at subsection Interfacing with .NET
+
+ at c XXX
+Currently much of this section is still undocumented, sorry.
+
+ at menu
+* Using pragma foreign_type for .NET 	:: Declaring .NET types in Mercury
+ at end menu
+
+ at node Using pragma foreign_type for .NET
+ at subsubsection Using pragma foreign_type for .NET
+
+The .NET pragma foreign_type declaration is of the form:
+
+ at example
+:- pragma foreign_type(@var{MercuryTypeName}, il(@var{DotNetForeignType})).
+ at end example
+
+If the @var{MercuryTypeName} is a parameter of a procedure defined using
+ at samp{pragma foreign_proc}, it will be passed to user code as
+ at var{DotNetForeignType}.
+Futhermore, any externally visible Mercury
+procedure will use @var{DotNetForeignType} as the parameter type for
+parameters whose Mercury type is @var{MercuryTypeName}.
+
+The CIL assembler syntax is used to specify type names for the .NET
+backend (this syntax is documented in the ECMA specifications for .NET).
+Currently on the .NET backend only reference classes are supported using
+ at samp{pragma foreign_type}, and hence the only supported syntax for
+DotNetForeignType is @samp{"class [AssemblyName]ClassName"}.
+Note that extra whitespace is not handled, there should only be a single
+space between the class keyword and they assembly specifier.
+
+For example:
+
+ at example
+:- pragma foreign_type(xmldoc, il("class [System.Xml]System.Xml.XmlDocument")).
+ at end example
+
+ensures that on the .NET backend the mercury type @samp{xmldoc} is
+represented marhsalled by the backend as @samp{System.Xml.XmlDocument}
+from assembly System.Xml.
+The following example shows how one can use the marshalled data from C#. 
+
+ at example
+:- pred loadxml(string::in, xmldoc::di, xmldoc::uo) is det.
+
+:- pragma foreign_proc("C#", load(String::in, XML0::di, XML::uo),
+        [will_not_call_mercury],
+"
+    XML0.LoadXml(String);
+    XML = XML0;
+").
+ at end example
 
 @c ----------------------------------------------------------------------------
 


-- 
       Tyson Dowd           # 
                            #  Surreal humour isn't everyone's cup of fur.
     trd at cs.mu.oz.au        # 
http://www.cs.mu.oz.au/~trd #
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------



More information about the reviews mailing list