[m-dev.] for review: fix pragma import of polymorphic preds
Peter Ross
peter.ross at miscrit.be
Thu Jul 20 20:06:53 AEST 2000
Hi,
For DJ to review.
===================================================================
Estimated hours taken: 16
Fix a bug where pragma imports of polymorphic predicates where not
having typeinfos prepended to the call.
compiler/prog_data.m:
Add a the new functor import/4 to pragma_c_code impl.
The functor stores all the information needed to constuct a C code
fragment a pragma import.
compiler/make_hlds.m:
Rather then constructing the C code fragment immediately, construct
the sub-parts and store them in import/4.
compiler/polymorphism.m:
Prepend the typeinfos to the list of variables passed to the
imported C function.
compiler/ml_code_gen.m:
compiler/pragma_c_gen.m:
Construct the C code fragment then call the routine which handles
`ordinary' pragma c_code.
compiler/hlds_out.m:
compiler/mercury_to_mercury.m:
Add code to recognise the import/4 functor.
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.237
diff -u -r1.237 hlds_out.m
--- compiler/hlds_out.m 2000/04/14 08:37:51 1.237
+++ compiler/hlds_out.m 2000/07/20 09:49:55
@@ -1554,6 +1554,11 @@
),
io__write_string(Shared),
io__write_string(""")")
+ ;
+ { PragmaCode = import(Name, _, _, _Context) },
+ io__write_string(""""),
+ io__write_string(Name),
+ io__write_string("""")
),
io__write_string(")"),
io__write_string(Follow).
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.336
diff -u -r1.336 make_hlds.m
--- compiler/make_hlds.m 2000/06/06 05:45:08 1.336
+++ compiler/make_hlds.m 2000/07/20 09:50:32
@@ -3492,10 +3492,6 @@
% the `pragma import' declaration applies to, and adding a clause
% for that predicate containing an appropriate HLDS `pragma_c_code'
% instruction.
-% (Note: `pragma import' and `pragma c_code' are distinct at the
-% parse_tree stage, but make_hlds converts both `pragma import'
-% and `pragma c_code' into HLDS `pragma_c_code' instructions,
-% so from HLDS onwards they are indistinguishable.)
%
% NB. Any changes here might also require similar changes to the
% handling of `pragma export' declarations, in export.m.
@@ -3656,25 +3652,26 @@
PragmaVarsAndTypes) },
%
- % Construct the C_Code string for calling C_Function.
+ % Construct parts of the C_Code string for calling C_Function.
% This C code fragment invokes the specified C function
% with the appropriate arguments from the list constructed
% above, passed in the appropriate manner (by value, or by
% passing the address to simulate pass-by-reference), and
% assigns the return value (if any) to the appropriate place.
+ % As this phase occurs before polymorphism, we don't know about
+ % the type-infos yet. polymorphism.m is responsible for adding
+ % the type-info arguments to the list of variables.
%
{ handle_return_value(CodeModel, PredOrFunc, PragmaVarsAndTypes,
- ModuleInfo0, ArgPragmaVarsAndTypes, C_Code0) },
- { string__append_list([C_Code0, C_Function, "("], C_Code1) },
+ ModuleInfo0, ArgPragmaVarsAndTypes, Return) },
{ assoc_list__keys(ArgPragmaVarsAndTypes, ArgPragmaVars) },
{ create_pragma_import_c_code(ArgPragmaVars, ModuleInfo0,
- C_Code1, C_Code2) },
- { string__append(C_Code2, ");", C_Code) },
+ "", Variables) },
%
% Add the C_Code for this `pragma import' to the clauses_info
%
- { PragmaImpl = ordinary(C_Code, no) },
+ { PragmaImpl = import(C_Function, Return, Variables, yes(Context)) },
clauses_info_add_pragma_c_code(Clauses0, Purity, Attributes,
PredId, ProcId, VarSet, PragmaVars, ArgTypes, PragmaImpl,
Context, PredOrFunc, qualified(PredModule, PredName),
@@ -4656,6 +4653,8 @@
),
io__set_output_stream(OldStream4, _)
)
+ ;
+ { PragmaImpl = import(_, _, _, _) }
).
%-----------------------------------------------------------------------------%
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.169
diff -u -r1.169 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 2000/07/06 06:25:10 1.169
+++ compiler/mercury_to_mercury.m 2000/07/20 09:50:44
@@ -2116,7 +2116,13 @@
% Output the given pragma c_code declaration
mercury_output_pragma_c_code(Attributes, PredName, PredOrFunc, Vars0,
VarSet, PragmaCode) -->
- io__write_string(":- pragma c_code("),
+ (
+ { PragmaCode = import(_, _, _, _) }
+ ->
+ io__write_string(":- pragma import(")
+ ;
+ io__write_string(":- pragma c_code(")
+ ),
mercury_output_sym_name(PredName),
{
PredOrFunc = predicate,
@@ -2172,6 +2178,11 @@
),
mercury_output_c_code_string(Shared),
io__write_string(")")
+ ;
+ { PragmaCode = import(Name, _, _, _) },
+ io__write_string(""""),
+ io__write_string(Name),
+ io__write_string("""")
),
io__write_string(").\n").
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.53
diff -u -r1.53 ml_code_gen.m
--- compiler/ml_code_gen.m 2000/07/19 09:46:59 1.53
+++ compiler/ml_code_gen.m 2000/07/20 09:50:53
@@ -1497,6 +1497,13 @@
OuterContext, LocalVarsDecls, LocalVarsContext,
FirstCode, FirstContext, LaterCode, LaterContext,
SharedCode, SharedContext, MLDS_Decls, MLDS_Statements)
+ ;
+ { PragmaImpl = import(Name, HandleReturn, Vars, _Context) },
+ { C_Code = string__append_list([HandleReturn, " ",
+ Name, "(", Vars, ");"]) },
+ ml_gen_ordinary_pragma_c_code(CodeModel, Attributes,
+ PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
+ C_Code, OuterContext, MLDS_Decls, MLDS_Statements)
).
ml_gen_goal_expr(bi_implication(_, _), _, _, _, _) -->
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.189
diff -u -r1.189 polymorphism.m
--- compiler/polymorphism.m 2000/07/19 07:21:47 1.189
+++ compiler/polymorphism.m 2000/07/20 09:51:05
@@ -919,7 +919,7 @@
polymorphism__process_goal_expr(Goal0, GoalInfo, Goal) -->
{ Goal0 = pragma_c_code(IsRecursive, PredId, ProcId,
- ArgVars0, ArgInfo0, OrigArgTypes0, PragmaCode) },
+ ArgVars0, ArgInfo0, OrigArgTypes0, PragmaCode0) },
polymorphism__process_call(PredId, ArgVars0, GoalInfo,
ArgVars, ExtraVars, CallGoalInfo, ExtraGoals),
@@ -948,6 +948,30 @@
OrigArgTypes0, OrigArgTypes, ArgInfo0, ArgInfo) },
%
+ % Add the type info arguments to the list of variables
+ % to call for a pragma import.
+ %
+ (
+ { PragmaCode0 = import(Name, HandleReturn,
+ Variables0, MaybeContext) }
+ ->
+ (
+ { list__remove_suffix(ArgInfo, ArgInfo0,
+ TypeVarArgInfos) }
+ ->
+ { Variables = type_info_vars(ModuleInfo,
+ TypeVarArgInfos) `string__append`
+ Variables0 }
+ ;
+ { error("polymorphism__process_goal_expr") }
+ ),
+ { PragmaCode = import(Name, HandleReturn,
+ Variables, MaybeContext) }
+ ;
+ { PragmaCode = PragmaCode0 }
+ ),
+
+ %
% plug it all back together
%
{ Call = pragma_c_code(IsRecursive, PredId, ProcId, ArgVars,
@@ -988,6 +1012,26 @@
polymorphism__process_goal_expr(bi_implication(_, _), _, _) -->
% these should have been expanded out by now
{ error("polymorphism__process_goal_expr: unexpected bi_implication") }.
+
+
+ % type_info_vars construcs a comma seperated list of variables.
+ % It places an & at the start of the variable name if variable
+ % is an output variable.
+:- func type_info_vars(module_info, list(maybe(pair(string, mode)))) = string.
+
+type_info_vars(_ModuleInfo, []) = "".
+type_info_vars(ModuleInfo, [ArgInfo | ArgInfos]) = String :-
+ String0 = type_info_vars(ModuleInfo, ArgInfos),
+ ( ArgInfo = yes(ArgName0 - Mode) ->
+ ( mode_is_output(ModuleInfo, Mode) ->
+ string__append("&", ArgName0, ArgName)
+ ;
+ ArgName = ArgName0
+ ),
+ String = string__append_list([ArgName, ", ", String0])
+ ;
+ String = String0
+ ).
:- pred polymorphism__process_unify(prog_var, unify_rhs,
unify_mode, unification, unify_context, hlds_goal_info,
Index: compiler/pragma_c_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pragma_c_gen.m,v
retrieving revision 1.34
diff -u -r1.34 pragma_c_gen.m
--- compiler/pragma_c_gen.m 2000/04/26 05:40:33 1.34
+++ compiler/pragma_c_gen.m 2000/07/20 09:51:11
@@ -316,6 +316,12 @@
Fields, FieldsContext, First, FirstContext,
Later, LaterContext, Treat, Shared, SharedContext,
Code)
+ ; { PragmaImpl = import(Name, HandleReturn, Vars, Context) },
+ { C_Code = string__append_list([HandleReturn, " ",
+ Name, "(", Vars, ");"]) },
+ pragma_c_gen__ordinary_pragma_c_code(CodeModel, Attributes,
+ PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
+ C_Code, Context, Code)
).
%---------------------------------------------------------------------------%
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.55
diff -u -r1.55 prog_data.m
--- compiler/prog_data.m 2000/07/06 06:25:13 1.55
+++ compiler/prog_data.m 2000/07/20 09:51:13
@@ -385,6 +385,15 @@
% Shared code that is executed after
% both the previous code fragments.
% May not access the input variables.
+ )
+ ; import(
+ string, % Pragma imported C func name
+ string, % Code to handle return value
+ string, % Comma seperated variables which
+ % the import function is called
+ % with.
+
+ maybe(prog_context)
).
% The use of this type is explained in the comment at the top of
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------
More information about the developers
mailing list