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

Tyson Dowd trd at cs.mu.OZ.AU
Mon Oct 29 16:57:23 AEDT 2001


Hi,

Here's the syntax for foreign_type as discussed on mercury-developers.

Pete, this will involve changing the interface generator slightly, but
it shouldn't be a big problem.

Next diff will contain corresponding documentation.

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


Estimated hours taken: 6
Branches: main

Implement the syntax for pragma foreign_type.

We now accept:

:- pragma foreign_type(MercuryType, BackendSpecifier).

where BackendSpecifier must be of the form:

il("AssemblyName", class(ClassName))

compiler/prog_io_pragma.m:
	Implement the new syntax.

compiler/prog_data.m:
	Add the foreign type name to the backend information, instead of
	the foreign type pragma.  The way we specify foreign types is
	likely to become backend specific.
	Also, this makes the data structure organization mirror the
	syntax a bit more, which I find conceptually simpler.

compiler/make_hlds.m:
compiler/mercury_to_mercury.m:
compiler/module_qual.m:
compiler/modules.m:
compiler/recompilation_version.m:
	Handle the new foreign_type arity.



Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.388
diff -u -r1.388 make_hlds.m
--- compiler/make_hlds.m	24 Oct 2001 13:34:19 -0000	1.388
+++ compiler/make_hlds.m	26 Oct 2001 02:40:00 -0000
@@ -391,10 +391,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.195
diff -u -r1.195 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m	24 Oct 2001 13:34:23 -0000	1.195
+++ compiler/mercury_to_mercury.m	26 Oct 2001 02:42:58 -0000
@@ -460,18 +460,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.69
diff -u -r1.69 module_qual.m
--- compiler/module_qual.m	24 Oct 2001 13:34:32 -0000	1.69
+++ compiler/module_qual.m	26 Oct 2001 02:43:36 -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,8 +893,8 @@
 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, F),
-		foreign_type(Backend, Type, SymName, F), Info0, Info) -->
+qualify_pragma(foreign_type(Backend, Type0, SymName),
+		foreign_type(Backend, Type, SymName), Info0, Info) -->
 	qualify_type(Type0, Type, Info0, Info).
 qualify_pragma(
 	    foreign_proc(Rec, SymName, PredOrFunc, PragmaVars0, Varset, Code),
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.199
diff -u -r1.199 modules.m
--- compiler/modules.m	24 Oct 2001 13:34:33 -0000	1.199
+++ compiler/modules.m	26 Oct 2001 02:42:44 -0000
@@ -1141,7 +1141,7 @@
 pragma_allowed_in_interface(foreign_decl(_, _), 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.70
diff -u -r1.70 prog_data.m
--- compiler/prog_data.m	24 Oct 2001 13:34:35 -0000	1.70
+++ compiler/prog_data.m	26 Oct 2001 02:42:35 -0000
@@ -165,9 +165,8 @@
 			% names from the pred declaration), TVarSet,
 			% Equivalence types used
 
-	;	foreign_type(backend, (type), sym_name, sym_name)
-			% Backend, MercuryType, MercuryTypeName,
-			% ForeignType, ForeignTypeLocation
+	;	foreign_type(backend, (type), sym_name)
+			% Backend, MercuryType, MercuryTypeName
 
 	;	inline(sym_name, arity)
 			% Predname, Arity
@@ -282,8 +281,9 @@
 %
 
 :- type backend
-			% The location of the il name.
-	--->	il(string).
+			% 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.35
diff -u -r1.35 prog_io_pragma.m
--- compiler/prog_io_pragma.m	24 Oct 2001 13:34:36 -0000	1.35
+++ compiler/prog_io_pragma.m	29 Oct 2001 04:39:39 -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) :-
@@ -177,13 +162,35 @@
 parse_foreign_language(term__functor(term__string(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)).
+:- mode parse_backend(in, out) is det.
+
+parse_backend(InputTerm, Result) :-
+	( 
+		InputTerm = term__functor(term__atom("il"), Args, _),
+		Args = [term__functor(term__string(Module), [], _), ClassTerm],
+		ClassTerm = term__functor(term__atom("class"), [ForeignName],
+			_)
+	->
+		parse_qualified_term(ForeignName, InputTerm,
+			"`:- pragma foreign_type' declaration",
+			MaybeForeignType),
+		(
+			MaybeForeignType = ok(ForeignType, ForeignArgs),
+			( ForeignArgs = [] ->
+				Result = ok(il(Module, ForeignType))
+			;
+				Result = error("foreign type arity not 0",
+					InputTerm)
+			)
+		;
+			MaybeForeignType = error(String, Term),
+			Result = error(String, Term)
+		)
+	;
+		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).
 
 	% 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.5
diff -u -r1.5 recompilation_version.m
--- compiler/recompilation_version.m	24 Oct 2001 13:34:37 -0000	1.5
+++ compiler/recompilation_version.m	26 Oct 2001 02:40:30 -0000
@@ -452,7 +452,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)).


-- 
       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