[m-rev.] for review: add lang spec to pragma import

[Peter Ross]

Hi,

I haven't documented this new syntax yet, as we still accept the old
syntax and I want to see how it works on the .NET backend before
documenting it in the reference manual.

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


Estimated hours taken: 1
Branches: main

Change pragma_import so that it can optionally take a language specifier.
If the language specifier is not given we default to c.
The new form accepted is

    :- pragma import(p(in, out), c("foo")).

This is step one in the process to allow one to specify imports of .NET
functions.

compiler/make_hlds.m:
compiler/mercury_to_mercury.m:
compiler/prog_data.m:
compiler/prog_io_pragma.m:
    Recognise the new form of the declaration.

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 15:49:37 -0000
@@ -716,8 +716,9 @@
 			Status, Context, Module0, Module, Info0, Info)
 	;
 		{ Pragma = import(Name, PredOrFunc, Modes, Attributes,
-			C_Function) }
+			Import) }
 	->
+		{ Import = c(C_Function) },
 		module_add_pragma_import(Name, PredOrFunc, Modes,
 			Attributes, C_Function, Status, Context,
 			Module0, Module, Info0, Info)
@@ -8363,5 +8364,11 @@
 	;
 		PragmaVars0 = []
 	).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "make_hlds.m".
 
 %-----------------------------------------------------------------------------%
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 15:49:38 -0000
@@ -323,6 +323,7 @@
 :- import_module prog_out, prog_util, hlds_pred, hlds_out, instmap.
 :- import_module recompilation_version, purity, term_util.
 :- import_module globals, options, termination, foreign.
+:- import_module error_util.
 
 :- import_module assoc_list, char, int, string, set, lexer, ops, require.
 :- import_module term, term_io, varset.
@@ -481,9 +482,9 @@
 		io__write_string("\")).\n")
 	;
 		{ Pragma = import(Pred, PredOrFunc, ModeList, Attributes,
-			C_Function) },
+			ForeignImport) },
 		mercury_format_pragma_import(Pred, PredOrFunc, ModeList,
-			Attributes, C_Function)
+			Attributes, ForeignImport)
 	;
 		{ Pragma = export(Pred, PredOrFunc, ModeList, C_Function) },
 		mercury_format_pragma_export(Pred, PredOrFunc, ModeList,
@@ -2580,7 +2581,7 @@
 			Vars0) },
 
 		mercury_format_pragma_import(PredName, PredOrFunc,
-			ImportModes, Attributes, C_Function)
+			ImportModes, Attributes, c(C_Function))
 	;
 		{ PragmaCode = ordinary(_, _) },
 		mercury_format_pragma_foreign_code_2(Attributes, PredName,
@@ -2800,11 +2801,11 @@
 %-----------------------------------------------------------------------------%
 
 :- pred mercury_format_pragma_import(sym_name::in, pred_or_func::in,
-	list(mode)::in, pragma_foreign_proc_attributes::in, string::in,
+	list(mode)::in, pragma_foreign_proc_attributes::in, foreign_import::in,
 	U::di, U::uo) is det <= output(U).
 
 mercury_format_pragma_import(Name, PredOrFunc, ModeList, Attributes,
-		C_Function) -->
+		ForeignImport) -->
 	{ varset__init(Varset) }, % the varset isn't really used.
 	add_string(":- pragma import("),
 	mercury_format_sym_name(Name),
@@ -2823,9 +2824,11 @@
 	),
 	add_string(", "),
 	mercury_format_pragma_foreign_attributes(Attributes),
-	add_string(", """),
+	add_string(", "),
+	{ ForeignImport = c(C_Function) },
+	add_string("c("""),
 	add_string(C_Function),
-	add_string(""").\n").
+	add_string(""")).\n").
 
 :- pred mercury_format_pragma_export(sym_name::in, pred_or_func::in,
 	list(mode)::in, string::in,
@@ -3574,5 +3577,10 @@
 		output_string(Sep, Str1, Str2),
 		output_list(Items, Sep, Pred, Str2, Str)
 	).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+this_file = "mercury_to_mercury.m".
 
 %-----------------------------------------------------------------------------%
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	21 Nov 2001 15:50:33 -0000
@@ -174,12 +174,13 @@
 			% C function name.
 
 	;	import(sym_name, pred_or_func, list(mode),
-			pragma_foreign_proc_attributes, string)
+			pragma_foreign_proc_attributes, foreign_import)
 			% Predname, Predicate/function, Modes,
 			% Set of foreign proc attributes, eg.:
 			%    whether or not the foreign code may call Mercury,
 			%    whether or not the foreign code is thread-safe
-			% foreign function name.
+			% Information which represents the imported
+			% function.
 	
 	;	type_spec(sym_name, sym_name, arity, maybe(pred_or_func),
 			maybe(list(mode)), type_subst, tvarset, set(type_id))
@@ -291,6 +292,9 @@
 :- type backend
 			% The location of the il name.
 	--->	il(string).
+
+:- type foreign_import
+	--->	c(string).
 
 %
 % 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	21 Nov 2001 15:50:33 -0000
@@ -724,14 +724,13 @@
 			ErrorTerm)
 	).
 
-
 parse_pragma_type(ModuleName, "import", PragmaTerms,
 			ErrorTerm, _VarSet, Result) :-
-		% XXX we assume all imports are C
-	ForeignLanguage = c,
 	(
 	    (
 		PragmaTerms = [PredAndModesTerm, FlagsTerm, FunctionTerm],
+		parse_imported_function_term(FunctionTerm, ForeignLanguage,
+				FuncResult),
 		parse_pragma_foreign_proc_attributes_term(ForeignLanguage,
 				"import", FlagsTerm, MaybeFlags),
 		(
@@ -743,36 +742,36 @@
 	        )
 	    ;
 		PragmaTerms = [PredAndModesTerm, FunctionTerm],
+		parse_imported_function_term(FunctionTerm, ForeignLanguage,
+				FuncResult),
 		default_attributes(ForeignLanguage, Flags),
 		FlagsResult = ok(Flags)
 	    )	
  	-> 
+	    parse_pred_or_func_and_arg_modes(yes(ModuleName),
+		    PredAndModesTerm, ErrorTerm,
+		    "`:- pragma import' declaration",
+		    PredAndArgModesResult),
 	    (
-		FunctionTerm = term__functor(term__string(Function), [], _)
-	    ->
-		parse_pred_or_func_and_arg_modes(yes(ModuleName),
-			PredAndModesTerm, ErrorTerm,
-			"`:- pragma import' declaration",
-			PredAndArgModesResult),
+		PredAndArgModesResult = ok(PredName - PredOrFunc,
+			    ArgModes),
 		(
-		    PredAndArgModesResult = ok(PredName - PredOrFunc,
-				ArgModes),
+		    FlagsResult = ok(Attributes),
 		    (
-			FlagsResult = ok(Attributes),
+			FuncResult = ok(Function),
 			Result = ok(pragma(import(PredName, PredOrFunc,
 				ArgModes, Attributes, Function)))
 		    ;
-			FlagsResult = error(Msg, Term),
+		    	FuncResult = error(Msg, Term),
 			Result = error(Msg, Term)
 		    )
 		;
-			PredAndArgModesResult = error(Msg, Term),
-			Result = error(Msg, Term)
+		    FlagsResult = error(Msg, Term),
+		    Result = error(Msg, Term)
 		)
 	    ;
-	    	Result = error(
-	"expected pragma import(PredName(ModeList), Function)",
-		     PredAndModesTerm)
+		PredAndArgModesResult = error(Msg, Term),
+		Result = error(Msg, Term)
 	    )
 	;
 	    Result = 
@@ -1202,6 +1201,42 @@
 		string__append_list(["expected predname/arity for `pragma ",
 			PragmaType, "' declaration"], ErrorMsg),
 		Result = error(ErrorMsg, ErrorTerm)
+	).
+
+%-----------------------------------------------------------------------------%
+
+	% Note that this predicate returns an incorrect foreign_language
+	% when it identifies an error.
+:- pred parse_imported_function_term(term::in,
+		foreign_language::out, maybe1(foreign_import)::out) is det.
+
+parse_imported_function_term(Term, ForeignLanguage, Result) :-
+	(
+	    Term = term__functor(term__atom(Backend), Args, _)
+	->
+	    (
+	    	Backend = "c",
+		Args = [term__functor(term__string(FunctionName), [], _)]
+	    ->
+	    	ForeignLanguage = c,
+		Result = ok(c(FunctionName))
+	    ;
+	    	ForeignLanguage = c,
+	    	Result = error("incorrectly specifies a function to import",
+			Term)
+	    )
+	;
+	    % XXX Needed to bootstrap should just be an error.
+	    (
+		Term = term__functor(term__string(FunctionName), [], _)
+	    ->
+	    	ForeignLanguage = c,
+		Result = ok(c(FunctionName))
+	    ;
+	    	ForeignLanguage = c,
+	    	Result = error("incorrectly specifies a function to import",
+			Term)
+	    )
 	).
 
 %-----------------------------------------------------------------------------%

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