[m-dev.] for review: preliminary support for :- pragma foreign_code
Tyson Dowd
trd at cs.mu.OZ.AU
Tue Aug 1 14:04:20 AEST 2000
Hi,
This is only the start of this change. I haven't added test cases or
documentation because it isn't yet finished. This change seemed like a
sensible start.
The plan for the final syntax is:
:- pragma foreign_code(Language, ....) (replaces c_code)
:- pragma foreign_decl(Language, ....) (replaces c_header_code)
:- pragma foreign_export(Language, ....) (replaces export)
:- pragma foreign_import(Language, ....) (replaces import)
:- pragma foreign_type(Language, Type, ...)
(this is new, but will be a little like c_pointer)
Languages are specified using strings, e.g. "C" or "c++" or "Java".
Implementations decide which strings map to which languages.
Implementations will define a set of foreign languages they can interface
to. It is expected we will use separate files to implement foreign code
when the target language doesn't match the foreign language (The IL
backend already generates .cpp files containing C++ whenever it sees
"c_code"). For each supported target language and foreign language
pair, the implementation will have to provide a mechanism for generating
code in that foreign language and code to call that foreign language.
Of course this could be done using a third language (e.g. C) as an
intermediate stage, so long as the user doesn't have to see that.
Also I plan on making foreign_code impure by default (but you can easily
put an attribute on it promising that it is pure).
However, these are just the plans in case people are interested, the
diff below is what is up for review.
===================================================================
Estimated hours taken: 15
Add preliminary support for a new pragma:
:- pragma foreign_code(LanguageString, .... <same args as c_code>).
This is intended to be the eventual replacement of pragma c_code.
Presently the only valid language is "C".
The existing pragma c_code is simply turned into pragma foreign_code.
pragma foreign_code is not a supported pragma at the moment. There are
several other changes that are intended (for example, foreign_code will
be impure by default).
This change also changes the HLDS goal pragma_c_code/7 to
pragma_foreign_code/8 where the extra argument is the foreign language.
Any code currently generating output for pragma C code simply checks
that the foreign language is set to "c". Since this is the only
alternative of the type foreign_language, it will always succeed.
However when new alternatives are added it should be fairly easy to find
where the changes need to be made.
Some type names and predicate names have also been updated, however
there are many more that haven't yet been touched.
compiler/prog_io_pragma.m:
Accept the new syntax. Turn the old syntax into the new.
compiler/hlds_goal.m:
Change pragma_c_code/7 to pragma_foreign_code/8.
Define the foreign_language type.
compiler/llds.m:
Change user_c_code/2 to user_foreign_code/3.
compiler/*.m:
Update the rest of the compiler to handle these types.
Make a few small changes to update variable names, predicate
names and type names.
Index: compiler/assertion.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/assertion.m,v
retrieving revision 1.7
diff -u -r1.7 assertion.m
--- compiler/assertion.m 2000/04/12 09:48:16 1.7
+++ compiler/assertion.m 2000/07/18 08:02:40
@@ -548,9 +548,9 @@
equal_goals(IfA, IfB, Subst1, Subst2),
equal_goals(ThenA, ThenB, Subst2, Subst3),
equal_goals(ElseA, ElseB, Subst3, Subst).
-equal_goals(pragma_c_code(Attribs, PredId, _, VarsA, _, _, _) - _,
- pragma_c_code(Attribs, PredId, _, VarsB, _, _, _) - _,
- Subst0, Subst) :-
+equal_goals(pragma_foreign_code(Lang, Attribs, PredId, _, VarsA, _, _, _) - _,
+ pragma_foreign_code(Lang, Attribs, PredId, _, VarsB, _, _, _) -
+ _, Subst0, Subst) :-
equal_vars(VarsA, VarsB, Subst0, Subst).
equal_goals(par_conj(GoalAs, _) - _, par_conj(GoalBs, _) - _, Subst0, Subst) :-
equal_goals_list(GoalAs, GoalBs, Subst0, Subst).
@@ -652,8 +652,8 @@
assertion__normalise_goal(call(A,B,C,D,E,F) - GI, call(A,B,C,D,E,F) - GI).
assertion__normalise_goal(generic_call(A,B,C,D) - GI, generic_call(A,B,C,D)-GI).
assertion__normalise_goal(unify(A,B,C,D,E) - GI, unify(A,B,C,D,E) - GI).
-assertion__normalise_goal(pragma_c_code(A,B,C,D,E,F,G) - GI,
- pragma_c_code(A,B,C,D,E,F,G) - GI).
+assertion__normalise_goal(pragma_foreign_code(A,B,C,D,E,F,G,H) - GI,
+ pragma_foreign_code(A,B,C,D,E,F,G,H) - GI).
assertion__normalise_goal(conj(Goals0) - GI, conj(Goals) - GI) :-
assertion__normalise_conj(Goals0, Goals).
assertion__normalise_goal(switch(A,B,Case0s,D) - GI, switch(A,B,Cases,D)-GI) :-
@@ -728,8 +728,8 @@
{ goal_info_get_context(GoalInfo, Context) },
assertion__in_interface_check_unify_rhs(RHS, Var, Context,
PredInfo, Module0, Module).
-assertion__in_interface_check(pragma_c_code(_,PredId,_,_,_,_,_) - GoalInfo,
- _PredInfo, Module0, Module) -->
+assertion__in_interface_check(pragma_foreign_code(_,_,PredId,_,_,_,_,_) -
+ GoalInfo, _PredInfo, Module0, Module) -->
{ module_info_pred_info(Module0, PredId, PragmaPredInfo) },
{ pred_info_import_status(PragmaPredInfo, ImportStatus) },
(
Index: compiler/bytecode_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/bytecode_gen.m,v
retrieving revision 1.47
diff -u -r1.47 bytecode_gen.m
--- compiler/bytecode_gen.m 2000/03/15 08:30:51 1.47
+++ compiler/bytecode_gen.m 2000/07/18 08:02:40
@@ -266,7 +266,7 @@
tree(ElseCode,
EndofIfCode))))))
;
- GoalExpr = pragma_c_code(_, _, _, _, _, _, _),
+ GoalExpr = pragma_foreign_code(_, _, _, _, _, _, _, _),
Code = node([not_supported]),
ByteInfo = ByteInfo0
;
Index: compiler/code_aux.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_aux.m,v
retrieving revision 1.57
diff -u -r1.57 code_aux.m
--- compiler/code_aux.m 2000/07/25 09:27:19 1.57
+++ compiler/code_aux.m 2000/07/30 13:55:17
@@ -199,7 +199,7 @@
code_aux__goal_is_flat_2(generic_call(_, _, _, _)).
code_aux__goal_is_flat_2(call(_, _, _, _, _, _)).
code_aux__goal_is_flat_2(unify(_, _, _, _, _)).
-code_aux__goal_is_flat_2(pragma_c_code(_, _, _, _, _, _, _)).
+code_aux__goal_is_flat_2(pragma_foreign_code(_, _, _, _, _, _, _, _)).
%-----------------------------------------------------------------------------%
Index: compiler/code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_gen.m,v
retrieving revision 1.77
diff -u -r1.77 code_gen.m
--- compiler/code_gen.m 2000/04/26 05:40:04 1.77
+++ compiler/code_gen.m 2000/07/19 02:18:36
@@ -575,7 +575,8 @@
{ code_info__resume_point_stack_addr(OutsideResumePoint,
OutsideResumeAddress) },
(
- { Goal = pragma_c_code(_,_,_,_,_,_, PragmaCode) - _},
+ { Goal = pragma_foreign_code(_, _, _, _, _, _, _,
+ PragmaCode) - _},
{ PragmaCode = nondet(Fields, FieldsContext,
_,_,_,_,_,_,_) }
->
@@ -909,7 +910,7 @@
call_gen__generate_builtin(CodeModel, PredId, ProcId, Args,
Code)
).
-code_gen__generate_goal_2(pragma_c_code(Attributes,
+code_gen__generate_goal_2(pragma_foreign_code(c, Attributes,
PredId, ModeId, Args, ArgNames, OrigArgTypes, PragmaCode),
GoalInfo, CodeModel, Instr) -->
pragma_c_gen__generate_pragma_c_code(CodeModel, Attributes,
Index: compiler/code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_util.m,v
retrieving revision 1.121
diff -u -r1.121 code_util.m
--- compiler/code_util.m 2000/04/19 03:54:03 1.121
+++ compiler/code_util.m 2000/07/18 08:02:40
@@ -666,8 +666,8 @@
code_util__count_recursive_calls_2(unify(_, _, _, _, _), _, _, 0, 0).
code_util__count_recursive_calls_2(generic_call(_, _, _, _), _, _,
0, 0).
-code_util__count_recursive_calls_2(pragma_c_code(_,_,_, _, _, _, _), _, _,
- 0, 0).
+code_util__count_recursive_calls_2(pragma_foreign_code(_, _, _, _, _, _, _, _),
+ _, _, 0, 0).
code_util__count_recursive_calls_2(call(CallPredId, CallProcId, _, _, _, _),
PredId, ProcId, Count, Count) :-
(
Index: compiler/cse_detection.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/cse_detection.m,v
retrieving revision 1.59
diff -u -r1.59 cse_detection.m
--- compiler/cse_detection.m 2000/01/13 06:15:15 1.59
+++ compiler/cse_detection.m 2000/07/18 08:02:40
@@ -203,8 +203,8 @@
cse_info, cse_info, bool, hlds_goal_expr).
:- mode detect_cse_in_goal_2(in, in, in, in, out, out, out) is det.
-detect_cse_in_goal_2(pragma_c_code(A,B,C,D,E,F,G), _, _, CseInfo, CseInfo,
- no, pragma_c_code(A,B,C,D,E,F,G)).
+detect_cse_in_goal_2(pragma_foreign_code(A,B,C,D,E,F,G,H), _, _, CseInfo,
+ CseInfo, no, pragma_foreign_code(A,B,C,D,E,F,G,H)).
detect_cse_in_goal_2(generic_call(A,B,C,D), _, _, CseInfo, CseInfo,
no, generic_call(A,B,C,D)).
Index: compiler/dead_proc_elim.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dead_proc_elim.m,v
retrieving revision 1.58
diff -u -r1.58 dead_proc_elim.m
--- compiler/dead_proc_elim.m 2000/07/20 10:39:21 1.58
+++ compiler/dead_proc_elim.m 2000/07/21 02:55:24
@@ -485,8 +485,8 @@
NewNotation = yes(1),
map__set(Needed0, proc(PredId, ProcId), NewNotation, Needed)
).
-dead_proc_elim__examine_expr(pragma_c_code(_, PredId, ProcId, _, _, _, _),
- _CurrProc, Queue0, Queue, Needed0, Needed) :-
+dead_proc_elim__examine_expr(pragma_foreign_code(_, _, PredId, ProcId, _,
+ _, _, _), _CurrProc, Queue0, Queue, Needed0, Needed) :-
queue__put(Queue0, proc(PredId, ProcId), Queue),
map__set(Needed0, proc(PredId, ProcId), no, Needed).
dead_proc_elim__examine_expr(unify(_,_,_, Uni, _), _CurrProc, Queue0, Queue,
@@ -882,7 +882,8 @@
pre_modecheck_examine_goal(Goal).
pre_modecheck_examine_goal(call(_, _, _, _, _, PredName) - _) -->
dead_pred_info_add_pred_name(PredName).
-pre_modecheck_examine_goal(pragma_c_code(_, _, _, _, _, _, _) - _) --> [].
+pre_modecheck_examine_goal(pragma_foreign_code(_, _, _, _, _, _, _, _) - _) -->
+ [].
pre_modecheck_examine_goal(unify(_, Rhs, _, _, _) - _) -->
pre_modecheck_examine_unify_rhs(Rhs).
pre_modecheck_examine_goal(bi_implication(_, _) - _) -->
Index: compiler/deforest.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/deforest.m,v
retrieving revision 1.12
diff -u -r1.12 deforest.m
--- compiler/deforest.m 1999/10/25 03:48:42 1.12
+++ compiler/deforest.m 2000/07/18 08:02:40
@@ -200,7 +200,7 @@
deforest__cases(Var, Cases0, Cases).
deforest__goal(Goal, Goal) -->
- { Goal = pragma_c_code(_, _, _, _, _, _, _) - _ }.
+ { Goal = pragma_foreign_code(_, _, _, _, _, _, _, _) - _ }.
deforest__goal(Goal, Goal) -->
{ Goal = generic_call(_, _, _, _) - _ }.
Index: compiler/dependency_graph.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dependency_graph.m,v
retrieving revision 1.47
diff -u -r1.47 dependency_graph.m
--- compiler/dependency_graph.m 2000/03/13 04:04:50 1.47
+++ compiler/dependency_graph.m 2000/07/18 08:02:40
@@ -274,9 +274,9 @@
DepGraph0 = DepGraph
).
-% There can be no dependencies within a pragma_c_code
-dependency_graph__add_arcs_in_goal_2(pragma_c_code(_, _, _, _, _, _, _), _,
- DepGraph, DepGraph).
+% There can be no dependencies within a pragma_foreign_code
+dependency_graph__add_arcs_in_goal_2(
+ pragma_foreign_code(_, _, _, _, _, _, _, _), _, DepGraph, DepGraph).
dependency_graph__add_arcs_in_goal_2(bi_implication(LHS, RHS), Caller,
DepGraph0, DepGraph) :-
@@ -704,7 +704,7 @@
).
process_aditi_goal(_IsNeg, generic_call(_, _, _, _) - _,
Map, Map) --> [].
-process_aditi_goal(_IsNeg, pragma_c_code(_, _, _, _, _, _, _) - _,
+process_aditi_goal(_IsNeg, pragma_foreign_code(_, _, _, _, _, _, _, _) - _,
Map, Map) --> [].
process_aditi_goal(_, bi_implication(_, _) - _, _, _) -->
% these should have been expanded out by now
Index: compiler/det_analysis.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/det_analysis.m,v
retrieving revision 1.144
diff -u -r1.144 det_analysis.m
--- compiler/det_analysis.m 1999/10/25 03:48:43 1.144
+++ compiler/det_analysis.m 2000/07/18 08:02:40
@@ -640,11 +640,11 @@
det_infer_goal(Goal0, InstMap0, SolnContext, DetInfo,
Goal, Det, Msgs).
- % pragma c_codes are handled in the same way as predicate calls
-det_infer_goal_2(pragma_c_code(IsRecursive, PredId, ProcId, Args,
- ArgNameMap, OrigArgTypes, PragmaCode),
+ % pragma foregin_codes are handled in the same way as predicate calls
+det_infer_goal_2(pragma_foreign_code(Language, Attributes, PredId, ProcId,
+ Args, ArgNameMap, OrigArgTypes, PragmaCode),
GoalInfo, _, SolnContext, DetInfo, _, _,
- pragma_c_code(IsRecursive, PredId, ProcId, Args,
+ pragma_foreign_code(Language, Attributes, PredId, ProcId, Args,
ArgNameMap, OrigArgTypes, PragmaCode),
Detism, Msgs) :-
det_info_get_module_info(DetInfo, ModuleInfo),
Index: compiler/det_report.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/det_report.m,v
retrieving revision 1.59
diff -u -r1.59 det_report.m
--- compiler/det_report.m 2000/07/24 11:36:03 1.59
+++ compiler/det_report.m 2000/07/30 13:55:19
@@ -601,8 +601,8 @@
det_diagnose_goal(Goal, InternalDesired, SwitchContext, DetInfo,
Diagnosed).
-det_diagnose_goal_2(pragma_c_code(_, _, _, _, _, _, _), GoalInfo, Desired,
- _, _, _, yes) -->
+det_diagnose_goal_2(pragma_foreign_code(_, _, _, _, _, _, _, _), GoalInfo,
+ Desired, _, _, _, yes) -->
{ goal_info_get_context(GoalInfo, Context) },
prog_out__write_context(Context),
io__write_string(" Determinism declaration not satisfied. Desired \n"),
Index: compiler/dnf.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dnf.m,v
retrieving revision 1.39
diff -u -r1.39 dnf.m
--- compiler/dnf.m 2000/01/13 06:15:21 1.39
+++ compiler/dnf.m 2000/07/18 08:02:40
@@ -236,7 +236,7 @@
NewPredIds = NewPredIds0,
Goal = Goal0
;
- GoalExpr0 = pragma_c_code(_, _, _, _, _, _, _),
+ GoalExpr0 = pragma_foreign_code(_, _, _, _, _, _, _, _),
ModuleInfo = ModuleInfo0,
NewPredIds = NewPredIds0,
Goal = Goal0
@@ -471,7 +471,7 @@
IsAtomic = no
).
dnf__is_atomic_expr(_, _, _, if_then_else(_, _, _, _, _), no).
-dnf__is_atomic_expr(_, _, _, pragma_c_code(_, _, _, _, _, _, _), yes).
+dnf__is_atomic_expr(_, _, _, pragma_foreign_code(_, _, _, _, _, _, _, _), yes).
dnf__is_atomic_expr(_, _, _, bi_implication(_, _), no).
:- pred dnf__free_of_nonatomic(hlds_goal::in,
@@ -510,7 +510,8 @@
dnf__free_of_nonatomic(Cond, NonAtomic),
dnf__free_of_nonatomic(Then, NonAtomic),
dnf__free_of_nonatomic(Else, NonAtomic).
-dnf__free_of_nonatomic(pragma_c_code(_, _, _, _, _, _, _) - _, _NonAtomic).
+dnf__free_of_nonatomic(pragma_foreign_code(_, _, _, _, _, _, _, _) - _,
+ _NonAtomic).
:- pred dnf__goals_free_of_nonatomic(list(hlds_goal)::in,
set(pred_proc_id)::in) is semidet.
Index: compiler/excess.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/excess.m,v
retrieving revision 1.33
diff -u -r1.33 excess.m
--- compiler/excess.m 2000/03/28 03:40:20 1.33
+++ compiler/excess.m 2000/07/18 08:02:40
@@ -134,7 +134,7 @@
Goal = GoalExpr0 - GoalInfo0,
ElimVars = ElimVars0
;
- GoalExpr0 = pragma_c_code(_, _, _, _, _, _, _),
+ GoalExpr0 = pragma_foreign_code(_, _, _, _, _, _, _, _),
Goal = GoalExpr0 - GoalInfo0,
ElimVars = ElimVars0
;
Index: compiler/export.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/export.m,v
retrieving revision 1.33
diff -u -r1.33 export.m
--- compiler/export.m 2000/07/20 10:39:22 1.33
+++ compiler/export.m 2000/07/21 02:55:26
@@ -26,18 +26,18 @@
% of a C function named in a `pragma export' declaration,
% which is used to allow a call to be made to a Mercury
% procedure from C.
-:- pred export__get_c_export_decls(module_info, c_export_decls).
+:- pred export__get_c_export_decls(module_info, foreign_export_decls).
:- mode export__get_c_export_decls(in, out) is det.
% From the module_info, get a list of c_export_defns,
% each of which is a string containing the C code
% for defining a C function named in a `pragma export' decl.
-:- pred export__get_c_export_defns(module_info, c_export_defns).
+:- pred export__get_c_export_defns(module_info, foreign_export_defns).
:- mode export__get_c_export_defns(in, out) is det.
% Produce a header file containing prototypes for the exported C
% functions
-:- pred export__produce_header_file(c_export_decls, module_name,
+:- pred export__produce_header_file(foreign_export_decls, module_name,
io__state, io__state).
:- mode export__produce_header_file(in, in, di, uo) is det.
@@ -79,7 +79,7 @@
export__get_c_export_decls_2(Preds, ExportedProcs, C_ExportDecls).
:- pred export__get_c_export_decls_2(pred_table, list(pragma_exported_proc),
- list(c_export_decl)).
+ list(foreign_export_decl)).
:- mode export__get_c_export_decls_2(in, in, out) is det.
export__get_c_export_decls_2(_Preds, [], []).
@@ -89,7 +89,7 @@
_DeclareReturnVal, _FailureAction, _SuccessAction,
HeadArgInfoTypes),
get_argument_declarations(HeadArgInfoTypes, no, ArgDecls),
- C_ExportDecl = c_export_decl(C_RetType, C_Function, ArgDecls),
+ C_ExportDecl = foreign_export_decl(c, C_RetType, C_Function, ArgDecls),
export__get_c_export_decls_2(Preds, ExportedProcs, C_ExportDecls0),
C_ExportDecls = [C_ExportDecl | C_ExportDecls0].
@@ -516,11 +516,12 @@
io__set_exit_status(1)
).
-:- pred export__produce_header_file_2(c_export_decls, io__state, io__state).
+:- pred export__produce_header_file_2(foreign_export_decls,
+ io__state, io__state).
:- mode export__produce_header_file_2(in, di, uo) is det.
export__produce_header_file_2([]) --> [].
export__produce_header_file_2([E|ExportedProcs]) -->
- { E = c_export_decl(C_RetType, C_Function, ArgDecls) },
+ { E = foreign_export_decl(c, C_RetType, C_Function, ArgDecls) },
% output the function header
io__write_string(C_RetType),
Index: compiler/follow_code.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/follow_code.m,v
retrieving revision 1.54
diff -u -r1.54 follow_code.m
--- compiler/follow_code.m 1999/10/25 03:48:48 1.54
+++ compiler/follow_code.m 2000/07/18 08:02:40
@@ -122,8 +122,8 @@
move_follow_code_in_goal_2(unify(A,B,C,D,E), unify(A,B,C,D,E), _, R, R).
-move_follow_code_in_goal_2(pragma_c_code(A,B,C,D,E,F,G),
- pragma_c_code(A,B,C,D,E,F,G), _, R, R).
+move_follow_code_in_goal_2(pragma_foreign_code(A,B,C,D,E,F,G,H),
+ pragma_foreign_code(A,B,C,D,E,F,G,H), _, R, R).
move_follow_code_in_goal_2(bi_implication(_, _), _, _, _, _) :-
% these should have been expanded out by now
Index: compiler/follow_vars.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/follow_vars.m,v
retrieving revision 1.55
diff -u -r1.55 follow_vars.m
--- compiler/follow_vars.m 1999/10/25 03:48:48 1.55
+++ compiler/follow_vars.m 2000/07/18 08:02:40
@@ -198,9 +198,9 @@
FollowVars = FollowVars0
).
-find_follow_vars_in_goal_2(pragma_c_code(A,B,C,D,E,F,G),
+find_follow_vars_in_goal_2(pragma_foreign_code(A,B,C,D,E,F,G,H),
_, _ModuleInfo, FollowVars,
- pragma_c_code(A,B,C,D,E,F,G), FollowVars).
+ pragma_foreign_code(A,B,C,D,E,F,G,H), FollowVars).
find_follow_vars_in_goal_2(bi_implication(_,_), _, _, _, _, _) :-
% these should have been expanded out by now
Index: compiler/goal_path.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/goal_path.m,v
retrieving revision 1.8
diff -u -r1.8 goal_path.m
--- compiler/goal_path.m 2000/07/25 09:27:19 1.8
+++ compiler/goal_path.m 2000/07/31 02:43:15
@@ -78,8 +78,8 @@
fill_expr_slots(call(A,B,C,D,E,F), _Path0, _Slot, call(A,B,C,D,E,F)).
fill_expr_slots(generic_call(A,B,C,D), _Path0, _Slot, generic_call(A,B,C,D)).
fill_expr_slots(unify(A,B,C,D,E), _Path0, _Slot, unify(A,B,C,D,E)).
-fill_expr_slots(pragma_c_code(A,B,C,D,E,F,G), _Path0, _Slot,
- pragma_c_code(A,B,C,D,E,F,G)).
+fill_expr_slots(pragma_foreign_code(A,B,C,D,E,F,G,H), _Path0, _Slot,
+ pragma_foreign_code(A,B,C,D,E,F,G,H)).
fill_expr_slots(bi_implication(_, _), _, _, _) :-
% these should have been expanded out by now
error("fill_expr_slots: unexpected bi_implication").
Index: compiler/goal_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/goal_util.m,v
retrieving revision 1.62
diff -u -r1.62 goal_util.m
--- compiler/goal_util.m 2000/05/22 17:59:21 1.62
+++ compiler/goal_util.m 2000/07/18 08:02:40
@@ -373,8 +373,8 @@
goal_util__rename_unify_rhs(TermR0, Must, Subn, TermR),
goal_util__rename_unify(Unify0, Must, Subn, Unify).
-goal_util__name_apart_2(pragma_c_code(A,B,C,Vars0,E,F,G), Must, Subn,
- pragma_c_code(A,B,C,Vars,E,F,G)) :-
+goal_util__name_apart_2(pragma_foreign_code(A,B,C,D,Vars0,F,G,H), Must, Subn,
+ pragma_foreign_code(A,B,C,D,Vars,F,G,H)) :-
goal_util__rename_var_list(Vars0, Must, Subn, Vars).
goal_util__name_apart_2(bi_implication(LHS0, RHS0), Must, Subn,
@@ -606,7 +606,7 @@
goal_util__goal_vars_2(B, Set2, Set3),
goal_util__goal_vars_2(C, Set3, Set).
-goal_util__goal_vars_2(pragma_c_code(_, _, _, ArgVars, _, _, _),
+goal_util__goal_vars_2(pragma_foreign_code(_, _, _, _, ArgVars, _, _, _),
Set0, Set) :-
set__insert_list(Set0, ArgVars, Set).
@@ -750,7 +750,7 @@
goal_expr_size(call(_, _, _, _, _, _), 1).
goal_expr_size(generic_call(_, _, _, _), 1).
goal_expr_size(unify(_, _, _, _, _), 1).
-goal_expr_size(pragma_c_code(_, _, _, _, _, _, _), 1).
+goal_expr_size(pragma_foreign_code(_, _, _, _, _, _, _, _), 1).
goal_expr_size(bi_implication(LHS, RHS), Size) :-
goal_size(LHS, Size1),
goal_size(RHS, Size2),
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.64
diff -u -r1.64 higher_order.m
--- compiler/higher_order.m 2000/04/11 07:56:56 1.64
+++ compiler/higher_order.m 2000/07/18 08:02:40
@@ -472,7 +472,7 @@
traverse_goal_2(Goal0, Goal).
traverse_goal_2(Goal, Goal) -->
- { Goal = pragma_c_code(_, _, _, _, _, _, _) - _ }.
+ { Goal = pragma_foreign_code(_, _, _, _, _, _, _, _) - _ }.
traverse_goal_2(Goal, Goal) -->
{ Goal = unify(_, _, _, Unify, _) - _ },
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.72
diff -u -r1.72 hlds_goal.m
--- compiler/hlds_goal.m 2000/07/25 09:27:20 1.72
+++ compiler/hlds_goal.m 2000/07/30 13:55:23
@@ -155,10 +155,11 @@
% information.
)
- % C code from a pragma c_code(...) decl.
+ % Foreign code from a pragma foreign_code(...) decl.
- ; pragma_c_code(
- pragma_c_code_attributes,
+ ; pragma_foreign_code(
+ foreign_language, % the language we are using
+ pragma_foreign_code_attributes,
pred_id, % The called predicate
proc_id, % The mode of the predicate
list(prog_var), % The (Mercury) argument variables
@@ -174,9 +175,9 @@
list(type), % The original types of the arguments.
% (With inlining, the actual types may
% be instances of the original types.)
- pragma_c_code_impl
+ pragma_foreign_code_impl
% Extra information for model_non
- % pragma_c_codes; none for others.
+ % pragma_foreign_codes; none for others.
)
% parallel conjunction
@@ -671,10 +672,11 @@
:- type goal_path == list(goal_path_step).
- % Given the variable info field from a pragma c_code, get all the
+ % Given the variable info field from a pragma foreign_code, get all the
% variable names.
-:- pred get_pragma_c_var_names(list(maybe(pair(string, mode))), list(string)).
-:- mode get_pragma_c_var_names(in, out) is det.
+:- pred get_pragma_foreign_var_names(list(maybe(pair(string, mode))),
+ list(string)).
+:- mode get_pragma_foreign_var_names(in, out) is det.
% Get a description of a generic_call goal.
:- pred hlds_goal__generic_call_id(generic_call, call_id).
@@ -777,15 +779,15 @@
% reverse order.
).
-get_pragma_c_var_names(MaybeVarNames, VarNames) :-
- get_pragma_c_var_names_2(MaybeVarNames, [], VarNames0),
+get_pragma_foreign_var_names(MaybeVarNames, VarNames) :-
+ get_pragma_foreign_var_names_2(MaybeVarNames, [], VarNames0),
list__reverse(VarNames0, VarNames).
-:- pred get_pragma_c_var_names_2(list(maybe(pair(string, mode)))::in,
+:- pred get_pragma_foreign_var_names_2(list(maybe(pair(string, mode)))::in,
list(string)::in, list(string)::out) is det.
-get_pragma_c_var_names_2([], Names, Names).
-get_pragma_c_var_names_2([MaybeName | MaybeNames], Names0, Names) :-
+get_pragma_foreign_var_names_2([], Names, Names).
+get_pragma_foreign_var_names_2([MaybeName | MaybeNames], Names0, Names) :-
(
MaybeName = yes(Name - _),
Names1 = [Name | Names0]
@@ -793,7 +795,7 @@
MaybeName = no,
Names1 = Names0
),
- get_pragma_c_var_names_2(MaybeNames, Names1, Names).
+ get_pragma_foreign_var_names_2(MaybeNames, Names1, Names).
hlds_goal__generic_call_id(higher_order(_, PorF, Arity),
generic_call(higher_order(PorF, Arity))).
@@ -1386,7 +1388,7 @@
goal_is_atomic(generic_call(_,_,_,_)).
goal_is_atomic(call(_,_,_,_,_,_)).
goal_is_atomic(unify(_,_,_,_,_)).
-goal_is_atomic(pragma_c_code(_,_,_,_,_,_,_)).
+goal_is_atomic(pragma_foreign_code(_,_,_,_,_,_,_,_)).
%-----------------------------------------------------------------------------%
@@ -1481,7 +1483,7 @@
set_goal_contexts_2(_, Goal, Goal) :-
Goal = unify(_, _, _, _, _).
set_goal_contexts_2(_, Goal, Goal) :-
- Goal = pragma_c_code(_, _, _, _, _, _, _).
+ Goal = pragma_foreign_code(_, _, _, _, _, _, _, _).
set_goal_contexts_2(Context, bi_implication(LHS0, RHS0),
bi_implication(LHS, RHS)) :-
set_goal_contexts(Context, LHS0, LHS),
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_module.m,v
retrieving revision 1.57
diff -u -r1.57 hlds_module.m
--- compiler/hlds_module.m 2000/07/20 10:39:22 1.57
+++ compiler/hlds_module.m 2000/07/21 02:55:29
@@ -38,10 +38,10 @@
:- type module_info.
-:- type c_code_info
- ---> c_code_info(
- c_header_info,
- c_body_info
+:- type foreign_code_info
+ ---> foreign_code_info(
+ foreign_header_info,
+ foreign_body_info
).
:- type pragma_exported_proc
@@ -242,17 +242,18 @@
:- pred module_info_set_globals(module_info, globals, module_info).
:- mode module_info_set_globals(in, in, out) is det.
-:- pred module_info_get_c_header(module_info, c_header_info).
-:- mode module_info_get_c_header(in, out) is det.
+:- pred module_info_get_foreign_header(module_info, foreign_header_info).
+:- mode module_info_get_foreign_header(in, out) is det.
-:- pred module_info_set_c_header(module_info, c_header_info, module_info).
-:- mode module_info_set_c_header(in, in, out) is det.
+:- pred module_info_set_foreign_header(module_info,
+ foreign_header_info, module_info).
+:- mode module_info_set_foreign_header(in, in, out) is det.
-:- pred module_info_get_c_body_code(module_info, c_body_info).
-:- mode module_info_get_c_body_code(in, out) is det.
+:- pred module_info_get_foreign_body_code(module_info, foreign_body_info).
+:- mode module_info_get_foreign_body_code(in, out) is det.
-:- pred module_info_set_c_body_code(module_info, c_body_info, module_info).
-:- mode module_info_set_c_body_code(in, in, out) is det.
+:- pred module_info_set_foreign_body_code(module_info, foreign_body_info, module_info).
+:- mode module_info_set_foreign_body_code(in, in, out) is det.
:- pred module_info_get_maybe_dependency_info(module_info,
maybe(dependency_info)).
@@ -464,8 +465,8 @@
module_sub(
module_name :: module_name,
globals :: globals,
- c_header_info :: c_header_info,
- c_body_info :: c_body_info,
+ foreign_header_info :: foreign_header_info,
+ foreign_body_info :: foreign_body_info,
maybe_dependency_info :: maybe(dependency_info),
num_errors :: int,
last_lambda_number :: int,
@@ -586,8 +587,8 @@
module_info_name(MI, MI^sub_info^module_name).
module_info_globals(MI, MI^sub_info^globals).
-module_info_get_c_header(MI, MI^sub_info^c_header_info).
-module_info_get_c_body_code(MI, MI^sub_info^c_body_info).
+module_info_get_foreign_header(MI, MI^sub_info^foreign_header_info).
+module_info_get_foreign_body_code(MI, MI^sub_info^foreign_body_info).
module_info_get_maybe_dependency_info(MI,
MI^sub_info^maybe_dependency_info).
module_info_num_errors(MI, MI^sub_info^num_errors).
@@ -614,10 +615,10 @@
module_info_set_globals(MI, NewVal,
MI^sub_info^globals := NewVal).
-module_info_set_c_header(MI, NewVal,
- MI^sub_info^c_header_info := NewVal).
-module_info_set_c_body_code(MI, NewVal,
- MI^sub_info^c_body_info := NewVal).
+module_info_set_foreign_header(MI, NewVal,
+ MI^sub_info^foreign_header_info := NewVal).
+module_info_set_foreign_body_code(MI, NewVal,
+ MI^sub_info^foreign_body_info := NewVal).
module_info_set_maybe_dependency_info(MI, NewVal,
MI^sub_info^maybe_dependency_info := NewVal).
module_info_set_num_errors(MI, NewVal,
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.240
diff -u -r1.240 hlds_out.m
--- compiler/hlds_out.m 2000/07/27 08:53:55 1.240
+++ compiler/hlds_out.m 2000/07/30 13:55:23
@@ -1511,13 +1511,16 @@
[]
).
-hlds_out__write_goal_2(pragma_c_code(_, _, _, ArgVars, ArgNames, _,
- PragmaCode), _, _, _, Indent, Follow, _) -->
+hlds_out__write_goal_2(pragma_foreign_code(Language, _, _, _, ArgVars,
+ ArgNames, _, PragmaCode), _, _, _, Indent, Follow, _) -->
+ % XXX handle other languages
hlds_out__write_indent(Indent),
- io__write_string("$pragma_c_code(["),
+ io__write_string("$pragma_foreign_code( /* "),
+ io__write(Language),
+ io__write_string(" */ ["),
hlds_out__write_varnum_list(ArgVars),
io__write_string("], ["),
- { get_pragma_c_var_names(ArgNames, Names) },
+ { get_pragma_foreign_var_names(ArgNames, Names) },
hlds_out__write_string_list(Names),
io__write_string("], "),
(
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.77
diff -u -r1.77 hlds_pred.m
--- compiler/hlds_pred.m 2000/07/25 09:27:20 1.77
+++ compiler/hlds_pred.m 2000/07/30 13:55:24
@@ -204,7 +204,7 @@
% The type of goals that have been given for a pred.
-:- type goal_type ---> pragmas % pragma c_code(...)
+:- type goal_type ---> pragmas % pragma foreign_code(...)
; clauses
; (assertion)
; none.
@@ -388,7 +388,7 @@
; does_not_terminate
% States that this predicate does not
% terminate. This is useful for pragma
- % c_code, which the compiler assumes to be
+ % foreign_code, which the compiler assumes to be
% terminating.
; check_termination
% The user requires the compiler to guarantee
@@ -777,7 +777,7 @@
goal_type :: goal_type,
% whether the goals seen so far for
% this pred are clauses,
- % pragma c_code(...) decs, or none
+ % pragma foreign_code(...) decs, or none
markers :: pred_markers,
% various boolean flags
is_pred_or_func :: pred_or_func,
Index: compiler/inlining.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/inlining.m,v
retrieving revision 1.85
diff -u -r1.85 inlining.m
--- compiler/inlining.m 2000/05/17 07:18:17 1.85
+++ compiler/inlining.m 2000/07/18 08:02:40
@@ -75,8 +75,9 @@
% procedure with so many variables that the back end of the compiler
% gets bogged down (for example in the pseudoknot benchmark).
%
- % Due to the way in which we generate code for model_non pragma_c_code,
- % procedures whose body is such a pragma_c_code must NOT be inlined.
+ % Due to the way in which we generate code for model_non
+ % pragma_foreign_code, procedures whose body is such a
+ % pragma_foreign_code must NOT be inlined.
%-----------------------------------------------------------------------------%
@@ -548,8 +549,9 @@
inlining__inlining_in_goal(unify(A, B, C, D, E) - GoalInfo,
unify(A, B, C, D, E) - GoalInfo) --> [].
-inlining__inlining_in_goal(pragma_c_code(A, B, C, D, E, F, G) - GoalInfo,
- pragma_c_code(A, B, C, D, E, F, G) - GoalInfo) --> [].
+inlining__inlining_in_goal(
+ pragma_foreign_code(A, B, C, D, E, F, G, H) - GoalInfo,
+ pragma_foreign_code(A, B, C, D, E, F, G, H) - GoalInfo) --> [].
inlining__inlining_in_goal(bi_implication(_, _) - _, _) -->
% these should have been expanded out by now
@@ -780,7 +782,7 @@
proc_info_goal(ProcInfo, CalledGoal),
\+ (
HighLevelCode = no,
- CalledGoal = pragma_c_code(_,_,_,_,_,_,_) - _,
+ CalledGoal = pragma_foreign_code(_,_,_,_,_,_,_,_) - _,
proc_info_interface_code_model(ProcInfo, model_non)
),
@@ -794,7 +796,7 @@
% goals, which can result from inlining.
\+ (
HighLevelCode = yes,
- CalledGoal = pragma_c_code(_,_,_,_,_,_,_) - _
+ CalledGoal = pragma_foreign_code(_,_,_,_,_,_,_,_) - _
),
% Don't inline memoed Aditi predicates.
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.79
diff -u -r1.79 intermod.m
--- compiler/intermod.m 2000/07/06 06:25:09 1.79
+++ compiler/intermod.m 2000/07/19 07:36:26
@@ -460,8 +460,8 @@
% Inlineable exported pragma_c_code goals can't use any
% non-exported types, so we just write out the clauses.
-intermod__traverse_goal(pragma_c_code(A,B,C,D,E,F,G) - Info,
- pragma_c_code(A,B,C,D,E,F,G) - Info, yes) --> [].
+intermod__traverse_goal(pragma_foreign_code(A,B,C,D,E,F,G,H) - Info,
+ pragma_foreign_code(A,B,C,D,E,F,G,H) - Info, yes) --> [].
intermod__traverse_goal(bi_implication(_, _) - _, _, _) -->
% these should have been expanded out by now
@@ -1067,7 +1067,7 @@
globals__io_lookup_string_option(dump_hlds_options, VerboseDump),
globals__io_set_option(dump_hlds_options, string("")),
( { WriteHeader = yes } ->
- { module_info_get_c_header(ModuleInfo, CHeader) },
+ { module_info_get_foreign_header(ModuleInfo, CHeader) },
intermod__write_c_header(CHeader)
;
[]
@@ -1091,7 +1091,7 @@
intermod__write_modules(Rest)
).
-:- pred intermod__write_c_header(list(c_header_code)::in,
+:- pred intermod__write_c_header(list(foreign_header_code)::in,
io__state::di, io__state::uo) is det.
intermod__write_c_header([]) --> [].
@@ -1559,17 +1559,17 @@
{ Clause = clause(ProcIds, Goal, _) },
(
(
- % Pull the C code out of the goal.
+ % Pull the foreign code out of the goal.
{ Goal = conj(Goals) - _ },
{ list__filter(
lambda([X::in] is semidet, (
- X = pragma_c_code(_,_,_,_,_,_,_) - _
+ X = pragma_foreign_code(_,_,_,_,_,_,_,_) - _
)),
Goals, [CCodeGoal]) },
- { CCodeGoal = pragma_c_code(Attributes,
+ { CCodeGoal = pragma_foreign_code(c, Attributes,
_, _, Vars, Names, _, PragmaCode) - _ }
;
- { Goal = pragma_c_code(Attributes,
+ { Goal = pragma_foreign_code(c, Attributes,
_, _, Vars, Names, _, PragmaCode) - _ }
)
->
@@ -1583,8 +1583,8 @@
Clauses, Procs).
:- pred intermod__write_c_clauses(proc_table::in, list(proc_id)::in,
- pred_or_func::in, pragma_c_code_impl::in,
- pragma_c_code_attributes::in, list(prog_var)::in,
+ pred_or_func::in, pragma_foreign_code_impl::in,
+ pragma_foreign_code_attributes::in, list(prog_var)::in,
prog_varset::in, list(maybe(pair(string, mode)))::in,
sym_name::in, io__state::di, io__state::uo) is det.
Index: compiler/lambda.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/lambda.m,v
retrieving revision 1.62
diff -u -r1.62 lambda.m
--- compiler/lambda.m 2000/05/22 17:59:31 1.62
+++ compiler/lambda.m 2000/07/18 08:02:40
@@ -267,8 +267,8 @@
lambda__process_goal_2(call(A,B,C,D,E,F), GoalInfo,
call(A,B,C,D,E,F) - GoalInfo) -->
[].
-lambda__process_goal_2(pragma_c_code(A,B,C,D,E,F,G), GoalInfo,
- pragma_c_code(A,B,C,D,E,F,G) - GoalInfo) -->
+lambda__process_goal_2(pragma_foreign_code(A,B,C,D,E,F,G,H), GoalInfo,
+ pragma_foreign_code(A,B,C,D,E,F,G,H) - GoalInfo) -->
[].
lambda__process_goal_2(bi_implication(_, _), _, _) -->
% these should have been expanded out by now
Index: compiler/lco.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/lco.m,v
retrieving revision 1.13
diff -u -r1.13 lco.m
--- compiler/lco.m 1999/10/25 03:49:05 1.13
+++ compiler/lco.m 2000/07/18 08:02:40
@@ -91,8 +91,8 @@
lco_in_goal_2(unify(A,B,C,D,E), _ModuleInfo, unify(A,B,C,D,E)).
-lco_in_goal_2(pragma_c_code(A,B,C,D,E,F,G), _,
- pragma_c_code(A,B,C,D,E,F,G)).
+lco_in_goal_2(pragma_foreign_code(A,B,C,D,E,F,G,H), _,
+ pragma_foreign_code(A,B,C,D,E,F,G,H)).
lco_in_goal_2(bi_implication(_, _), _, _) :-
% these should have been expanded out by now
Index: compiler/live_vars.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/live_vars.m,v
retrieving revision 1.86
diff -u -r1.86 live_vars.m
--- compiler/live_vars.m 2000/02/10 04:47:42 1.86
+++ compiler/live_vars.m 2000/07/18 08:02:40
@@ -353,9 +353,9 @@
LiveSets = LiveSets0
).
-build_live_sets_in_goal_2(pragma_c_code(Attributes, PredId, ProcId,
- Args, _, _, _), Liveness, ResumeVars0, LiveSets0,
- GoalInfo, ModuleInfo, ProcInfo, TypeInfoLiveness,
+build_live_sets_in_goal_2(pragma_foreign_code(_Language, Attributes,
+ PredId, ProcId, Args, _, _, _), Liveness, ResumeVars0,
+ LiveSets0, GoalInfo, ModuleInfo, ProcInfo, TypeInfoLiveness,
Liveness, ResumeVars, LiveSets) :-
goal_info_get_code_model(GoalInfo, CodeModel),
Index: compiler/liveness.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/liveness.m,v
retrieving revision 1.104
diff -u -r1.104 liveness.m
--- compiler/liveness.m 2000/07/22 11:32:40 1.104
+++ compiler/liveness.m 2000/07/30 13:55:26
@@ -322,8 +322,9 @@
detect_liveness_in_goal_2(unify(_,_,_,_,_), _, _, _, _, _) :-
error("unify in detect_liveness_in_goal_2").
-detect_liveness_in_goal_2(pragma_c_code(_,_,_,_,_,_,_), _, _, _, _, _) :-
- error("pragma_c_code in detect_liveness_in_goal_2").
+detect_liveness_in_goal_2(pragma_foreign_code(_,_,_,_,_,_,_,_),
+ _, _, _, _, _) :-
+ error("pragma_foreign_code in detect_liveness_in_goal_2").
detect_liveness_in_goal_2(bi_implication(_, _), _, _, _, _, _) :-
error("bi_implication in detect_liveness_in_goal_2").
@@ -528,8 +529,9 @@
detect_deadness_in_goal_2(unify(_,_,_,_,_), _, _, _, _, _) :-
error("unify in detect_deadness_in_goal_2").
-detect_deadness_in_goal_2(pragma_c_code(_,_,_,_,_,_,_), _, _, _, _, _) :-
- error("pragma_c_code in detect_deadness_in_goal_2").
+detect_deadness_in_goal_2(pragma_foreign_code(_, _, _, _, _, _, _, _),
+ _, _, _, _, _) :-
+ error("pragma_foreign_code in detect_deadness_in_goal_2").
detect_deadness_in_goal_2(bi_implication(_, _), _, _, _, _, _) :-
error("bi_implication in detect_deadness_in_goal_2").
@@ -757,9 +759,8 @@
detect_resume_points_in_goal_2(unify(A,B,C,D,E), _, Liveness, _, _,
unify(A,B,C,D,E), Liveness).
-detect_resume_points_in_goal_2(pragma_c_code(A,B,C,D,E,F,G), _, Liveness,
- _, _,
- pragma_c_code(A,B,C,D,E,F,G), Liveness).
+detect_resume_points_in_goal_2(pragma_foreign_code(A,B,C,D,E,F,G,H), _,
+ Liveness, _, _, pragma_foreign_code(A,B,C,D,E,F,G,H), Liveness).
detect_resume_points_in_goal_2(bi_implication(_, _), _, _, _, _, _, _) :-
% these should have been expanded out by now
Index: compiler/llds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds.m,v
retrieving revision 1.261
diff -u -r1.261 llds.m
--- compiler/llds.m 2000/04/26 05:40:16 1.261
+++ compiler/llds.m 2000/07/19 06:50:59
@@ -30,30 +30,33 @@
%-----------------------------------------------------------------------------%
-% c_interface_info holds information used when generating
-% code that uses the C interface.
-:- type c_interface_info
- ---> c_interface_info(
+% foreign_interface_info holds information used when generating
+% code that uses the foreign language interface.
+:- type foreign_interface_info
+ ---> foreign_interface_info(
module_name,
% info about stuff imported from C:
- c_header_info,
- c_body_info,
+ foreign_header_info,
+ foreign_body_info,
% info about stuff exported to C:
- c_export_decls,
- c_export_defns
+ foreign_export_decls,
+ foreign_export_defns
).
-:- type c_header_info == list(c_header_code). % in reverse order
-:- type c_body_info == list(c_body_code). % in reverse order
-
-:- type c_header_code == pair(string, prog_context).
-:- type c_body_code == pair(string, prog_context).
-
-:- type c_export_defns == list(c_export).
-:- type c_export_decls == list(c_export_decl).
-
-:- type c_export_decl
- ---> c_export_decl(
+:- type foreign_header_info == list(foreign_header_code).
+ % in reverse order
+:- type foreign_body_info == list(foreign_body_code).
+ % in reverse order
+
+:- type foreign_header_code == pair(string, prog_context).
+:- type foreign_body_code == pair(string, prog_context).
+
+:- type foreign_export_defns == list(foreign_export).
+:- type foreign_export_decls == list(foreign_export_decl).
+
+:- type foreign_export_decl
+ ---> foreign_export_decl(
+ foreign_language, % language of the export
string, % return type
string, % function name
string % argument declarations
@@ -61,7 +64,7 @@
% the code for `pragma export' is generated directly as strings
% by export.m.
-:- type c_export == string.
+:- type foreign_export == string.
%-----------------------------------------------------------------------------%
@@ -106,19 +109,20 @@
:- type c_file
---> c_file(
module_name,
- c_header_info,
- list(user_c_code),
- list(c_export),
+ foreign_header_info,
+ list(user_foreign_code),
+ list(foreign_export),
list(comp_gen_c_var),
list(comp_gen_c_data),
list(comp_gen_c_module)
).
- % Some C code from a `pragma c_code' declaration that is not
+ % Some code from a `pragma foreign_code' declaration that is not
% associated with a given procedure.
-:- type user_c_code
- ---> user_c_code(
- string, % C code
+:- type user_foreign_code
+ ---> user_foreign_code(
+ foreign_language, % language of this code
+ string, % code
term__context % source code location
).
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.145
diff -u -r1.145 llds_out.m
--- compiler/llds_out.m 2000/06/14 14:54:05 1.145
+++ compiler/llds_out.m 2000/07/19 07:40:14
@@ -291,12 +291,12 @@
globals__io_lookup_bool_option(split_c_files, SplitFiles),
( { SplitFiles = yes } ->
{ C_File = c_file(ModuleName, C_HeaderInfo,
- UserCCodes, Exports, Vars, Datas, Modules) },
+ UserForeignCodes, Exports, Vars, Datas, Modules) },
module_name_to_file_name(ModuleName, ".dir", yes, ObjDirName),
make_directory(ObjDirName),
output_split_c_file_init(ModuleName, Modules, Datas,
StackLayoutLabels, MaybeRLFile),
- output_split_user_c_codes(UserCCodes, ModuleName,
+ output_split_user_foreign_codes(UserForeignCodes, ModuleName,
C_HeaderInfo, StackLayoutLabels, 1, Num1),
output_split_c_exports(Exports, ModuleName,
C_HeaderInfo, StackLayoutLabels, Num1, Num2),
@@ -311,22 +311,22 @@
StackLayoutLabels, MaybeRLFile)
).
-:- pred output_split_user_c_codes(list(user_c_code)::in,
- module_name::in, list(c_header_code)::in, set_bbbtree(label)::in,
+:- pred output_split_user_foreign_codes(list(user_foreign_code)::in,
+ module_name::in, list(foreign_header_code)::in, set_bbbtree(label)::in,
int::in, int::out, io__state::di, io__state::uo) is det.
-output_split_user_c_codes([], _, _, _, Num, Num) --> [].
-output_split_user_c_codes([UserCCode | UserCCodes], ModuleName, C_HeaderLines,
- StackLayoutLabels, Num0, Num) -->
+output_split_user_foreign_codes([], _, _, _, Num, Num) --> [].
+output_split_user_foreign_codes([UserForeignCode | UserForeignCodes],
+ ModuleName, C_HeaderLines, StackLayoutLabels, Num0, Num) -->
{ CFile = c_file(ModuleName, C_HeaderLines,
- [UserCCode], [], [], [], []) },
+ [UserForeignCode], [], [], [], []) },
output_single_c_file(CFile, yes(Num0), StackLayoutLabels, no),
{ Num1 is Num0 + 1 },
- output_split_user_c_codes(UserCCodes, ModuleName, C_HeaderLines,
- StackLayoutLabels, Num1, Num).
+ output_split_user_foreign_codes(UserForeignCodes, ModuleName,
+ C_HeaderLines, StackLayoutLabels, Num1, Num).
-:- pred output_split_c_exports(list(c_export)::in,
- module_name::in, list(c_header_code)::in, set_bbbtree(label)::in,
+:- pred output_split_c_exports(list(foreign_export)::in,
+ module_name::in, list(foreign_header_code)::in, set_bbbtree(label)::in,
int::in, int::out, io__state::di, io__state::uo) is det.
output_split_c_exports([], _, _, _, Num, Num) --> [].
@@ -340,7 +340,7 @@
StackLayoutLabels, Num1, Num).
:- pred output_split_comp_gen_c_vars(list(comp_gen_c_var)::in,
- module_name::in, list(c_header_code)::in, set_bbbtree(label)::in,
+ module_name::in, list(foreign_header_code)::in, set_bbbtree(label)::in,
int::in, int::out, io__state::di, io__state::uo) is det.
output_split_comp_gen_c_vars([], _, _, _, Num, Num) --> [].
@@ -353,7 +353,7 @@
StackLayoutLabels, Num1, Num).
:- pred output_split_comp_gen_c_datas(list(comp_gen_c_data)::in,
- module_name::in, list(c_header_code)::in, set_bbbtree(label)::in,
+ module_name::in, list(foreign_header_code)::in, set_bbbtree(label)::in,
int::in, int::out, io__state::di, io__state::uo) is det.
output_split_comp_gen_c_datas([], _, _, _, Num, Num) --> [].
@@ -366,7 +366,7 @@
StackLayoutLabels, Num1, Num).
:- pred output_split_comp_gen_c_modules(list(comp_gen_c_module)::in,
- module_name::in, list(c_header_code)::in, set_bbbtree(label)::in,
+ module_name::in, list(foreign_header_code)::in, set_bbbtree(label)::in,
int::in, int::out, io__state::di, io__state::uo) is det.
output_split_comp_gen_c_modules([], _, _, _, Num, Num) --> [].
@@ -460,7 +460,7 @@
output_single_c_file(CFile, SplitFiles, StackLayoutLabels, MaybeRLFile) -->
{ CFile = c_file(ModuleName, C_HeaderLines,
- UserCCode, Exports, Vars, Datas, Modules) },
+ UserForeignCode, Exports, Vars, Datas, Modules) },
( { SplitFiles = yes(Num) } ->
module_name_to_split_c_file_name(ModuleName, Num, ".c",
FileName)
@@ -481,7 +481,7 @@
),
output_c_file_mercury_headers,
- output_c_header_include_lines(C_HeaderLines),
+ output_foreign_header_include_lines(C_HeaderLines),
io__write_string("\n"),
{ gather_c_file_labels(Modules, Labels) },
@@ -493,7 +493,7 @@
output_comp_gen_c_data_list(Datas, DeclSet3, DeclSet4),
output_comp_gen_c_module_list(Modules, StackLayoutLabels,
DeclSet4, _DeclSet),
- output_user_c_code_list(UserCCode),
+ output_user_foreign_code_list(UserForeignCode),
output_exported_c_functions(Exports),
( { SplitFiles = yes(_) } ->
@@ -919,51 +919,52 @@
llds_out__trace_port_to_num(nondet_pragma_first, 13).
llds_out__trace_port_to_num(nondet_pragma_later, 14).
-:- pred output_user_c_code_list(list(user_c_code)::in,
+:- pred output_user_foreign_code_list(list(user_foreign_code)::in,
io__state::di, io__state::uo) is det.
-output_user_c_code_list([]) --> [].
-output_user_c_code_list([UserCCode | UserCCodes]) -->
- output_user_c_code(UserCCode),
- output_user_c_code_list(UserCCodes).
+output_user_foreign_code_list([]) --> [].
+output_user_foreign_code_list([UserForeignCode | UserCCodes]) -->
+ output_user_foreign_code(UserForeignCode),
+ output_user_foreign_code_list(UserCCodes).
-:- pred output_user_c_code(user_c_code::in, io__state::di, io__state::uo)
- is det.
+:- pred output_user_foreign_code(user_foreign_code::in,
+ io__state::di, io__state::uo) is det.
-output_user_c_code(user_c_code(C_Code, Context)) -->
+output_user_foreign_code(user_foreign_code(c, Foreign_Code, Context)) -->
globals__io_lookup_bool_option(auto_comments, PrintComments),
( { PrintComments = yes } ->
io__write_string("/* "),
prog_out__write_context(Context),
- io__write_string(" pragma c_code */\n")
+ io__write_string(" pragma foreign_code */\n")
;
[]
),
output_set_line_num(Context),
- io__write_string(C_Code),
+ io__write_string(Foreign_Code),
io__write_string("\n"),
output_reset_line_num.
- % output_c_header_include_lines reverses the list of c header lines
- % and passes them to output_c_header_include_lines_2 which outputs them.
- % The list must be reversed since they are inserted in reverse order.
-:- pred output_c_header_include_lines(list(c_header_code)::in,
+ % output_foreign_header_include_lines reverses the list of c
+ % header lines and passes them to
+ % output_c_header_include_lines_2 which outputs them. The list
+ % must be reversed since they are inserted in reverse order.
+:- pred output_foreign_header_include_lines(list(foreign_header_code)::in,
io__state::di, io__state::uo) is det.
-output_c_header_include_lines(Headers) -->
+output_foreign_header_include_lines(Headers) -->
{ list__reverse(Headers, RevHeaders) },
- output_c_header_include_lines_2(RevHeaders).
+ output_foreign_header_include_lines_2(RevHeaders).
-:- pred output_c_header_include_lines_2(list(c_header_code)::in,
+:- pred output_foreign_header_include_lines_2(list(foreign_header_code)::in,
io__state::di, io__state::uo) is det.
-output_c_header_include_lines_2([]) --> [].
-output_c_header_include_lines_2([Code - Context | Hs]) -->
+output_foreign_header_include_lines_2([]) --> [].
+output_foreign_header_include_lines_2([Code - Context | Hs]) -->
globals__io_lookup_bool_option(auto_comments, PrintComments),
( { PrintComments = yes } ->
io__write_string("/* "),
prog_out__write_context(Context),
- io__write_string(" pragma(c_header_code) */\n")
+ io__write_string(" pragma(foreign_header_code) */\n")
;
[]
),
@@ -971,7 +972,7 @@
io__write_string(Code),
io__write_string("\n"),
output_reset_line_num,
- output_c_header_include_lines_2(Hs).
+ output_foreign_header_include_lines_2(Hs).
:- pred output_exported_c_functions(list(string), io__state, io__state).
:- mode output_exported_c_functions(in, di, uo) is det.
@@ -1803,7 +1804,7 @@
output_pragma_c_component(pragma_c_noop) --> [].
% Output the local variable declarations at the top of the
- % pragma_c_code code.
+ % pragma_foreign code for C.
:- pred output_pragma_decls(list(pragma_c_decl), io__state, io__state).
:- mode output_pragma_decls(in, di, uo) is det.
@@ -1840,7 +1841,7 @@
output_pragma_input_rval_decls(Inputs, DeclSet1, DeclSet).
% Output the input variable assignments at the top of the
- % pragma_c_code code.
+ % pragma foreign_code code for C.
:- pred output_pragma_inputs(list(pragma_c_input), io__state, io__state).
:- mode output_pragma_inputs(in, di, uo) is det.
@@ -1877,7 +1878,7 @@
output_pragma_output_lval_decls(Outputs, DeclSet1, DeclSet).
% Output the output variable assignments at the bottom of the
- % pragma_c_code
+ % pragma foreign code for C
:- pred output_pragma_outputs(list(pragma_c_output), io__state, io__state).
:- mode output_pragma_outputs(in, di, uo) is det.
Index: compiler/magic.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/magic.m,v
retrieving revision 1.19
diff -u -r1.19 magic.m
--- compiler/magic.m 2000/05/26 08:14:42 1.19
+++ compiler/magic.m 2000/07/18 08:02:40
@@ -1507,9 +1507,9 @@
{ error("Sorry, not yet implemented: parallel conjunction in Aditi procedures") }.
magic__preprocess_goal_2(generic_call(_, _, _, _) - _, _, _, _) -->
{ error("Sorry, not yet implemented: higher-order or class-method calls in Aditi procedures") }.
-magic__preprocess_goal_2(pragma_c_code(_, _, _, _, _, _, _) - _, _, _, _) -->
- { error("Sorry, not yet implemented: pragma c_code calls in Aditi procedures") }.
-
+magic__preprocess_goal_2(pragma_foreign_code(_, _, _, _, _, _, _, _) -
+ _, _, _, _) -->
+ { error("Sorry, not yet implemented: pragma foreign_code calls in Aditi procedures") }.
magic__preprocess_goal_2(conj(Goals0) - GoalInfo, [conj(Goals) - GoalInfo],
HOMap0, HOMap) -->
magic__preprocess_conj(Goals0, [], Goals, HOMap0, HOMap).
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.338
diff -u -r1.338 make_hlds.m
--- compiler/make_hlds.m 2000/07/20 11:24:03 1.338
+++ compiler/make_hlds.m 2000/07/21 02:55:34
@@ -357,8 +357,8 @@
{ Pragma = source_file(_) },
{ Module = Module0 }
;
- { Pragma = c_code(C_Body_Code) },
- { module_add_c_body_code(C_Body_Code, Context,
+ { Pragma = foreign(_Lang, Body_Code) },
+ { module_add_c_body_code(Body_Code, Context,
Module0, Module) }
;
{ Pragma = c_header_code(C_Header) },
@@ -366,7 +366,7 @@
;
% Handle pragma c_code decls later on (when we process
% clauses).
- { Pragma = c_code(_, _, _, _, _, _) },
+ { Pragma = foreign(_, _, _, _, _, _, _) },
{ Module = Module0 }
;
% Handle pragma tabled decls later on (when we process
@@ -647,9 +647,10 @@
add_item_clause(pragma(Pragma), Status, Status, Context,
Module0, Module, Info0, Info) -->
(
- { Pragma = c_code(Attributes, Pred, PredOrFunc, Vars,
- VarSet, PragmaImpl) }
+ { Pragma = foreign(Language, Attributes, Pred, PredOrFunc,
+ Vars, VarSet, PragmaImpl) }
->
+ { Language = c },
module_add_pragma_c_code(Attributes, Pred, PredOrFunc,
Vars, VarSet, PragmaImpl, Status, Context,
Module0, Module, Info0, Info)
@@ -3469,21 +3470,21 @@
:- mode module_add_c_header(in, in, in, out) is det.
module_add_c_header(C_Header, Context, Module0, Module) :-
- module_info_get_c_header(Module0, C_HeaderIndex0),
+ module_info_get_foreign_header(Module0, C_HeaderIndex0),
% store the c headers in reverse order and reverse them later
% for efficiency
C_HeaderIndex1 = [C_Header - Context|C_HeaderIndex0],
- module_info_set_c_header(Module0, C_HeaderIndex1, Module).
+ module_info_set_foreign_header(Module0, C_HeaderIndex1, Module).
:- pred module_add_c_body_code(string, prog_context, module_info, module_info).
:- mode module_add_c_body_code(in, in, in, out) is det.
module_add_c_body_code(C_Body_Code, Context, Module0, Module) :-
- module_info_get_c_body_code(Module0, C_Body_List0),
+ module_info_get_foreign_body_code(Module0, C_Body_List0),
% store the c headers in reverse order and reverse them later
% for efficiency
C_Body_List = [C_Body_Code - Context | C_Body_List0],
- module_info_set_c_body_code(Module0, C_Body_List, Module).
+ module_info_set_foreign_body_code(Module0, C_Body_List, Module).
%-----------------------------------------------------------------------------%
%
@@ -3497,8 +3498,8 @@
% handling of `pragma export' declarations, in export.m.
:- pred module_add_pragma_import(sym_name, pred_or_func, list(mode),
- pragma_c_code_attributes, string, import_status, prog_context,
- module_info, module_info, qual_info, qual_info,
+ pragma_foreign_code_attributes, string, import_status,
+ prog_context, module_info, module_info, qual_info, qual_info,
io__state, io__state).
:- mode module_add_pragma_import(in, in, in, in, in, in, in, in, out,
in, out, di, uo) is det.
@@ -3619,7 +3620,7 @@
% the c_code for a `pragma import' declaration to a pred_info.
:- pred pred_add_pragma_import(pred_info, pred_id, proc_id,
- pragma_c_code_attributes, string, prog_context, pred_info,
+ pragma_foreign_code_attributes, string, prog_context, pred_info,
module_info, module_info, qual_info, qual_info,
io__state, io__state).
:- mode pred_add_pragma_import(in, in, in, in, in, in, out, in, out, in, out,
@@ -3812,8 +3813,8 @@
%-----------------------------------------------------------------------------%
-:- pred module_add_pragma_c_code(pragma_c_code_attributes, sym_name,
- pred_or_func, list(pragma_var), prog_varset, pragma_c_code_impl,
+:- pred module_add_pragma_c_code(pragma_foreign_code_attributes, sym_name,
+ pred_or_func, list(pragma_var), prog_varset, pragma_foreign_code_impl,
import_status, prog_context, module_info, module_info,
qual_info, qual_info, io__state, io__state).
:- mode module_add_pragma_c_code(in, in, in, in, in, in, in, in, in, out,
@@ -4433,9 +4434,10 @@
warn_singletons_in_unify(Var, RHS, GoalInfo, QuantVars, VarSet,
PredCallId, MI).
-warn_singletons_in_goal_2(pragma_c_code(_, _, _, _, ArgInfo, _, PragmaImpl),
- GoalInfo, _QuantVars, _VarSet, PredCallId, MI) -->
+warn_singletons_in_goal_2(pragma_foreign_code(_, _, _, _, _, ArgInfo, _,
+ PragmaImpl), GoalInfo, _QuantVars, _VarSet, PredCallId, MI) -->
{ goal_info_get_context(GoalInfo, Context) },
+ % XXX not just C code
warn_singletons_in_pragma_c_code(PragmaImpl, ArgInfo, Context,
PredCallId, MI).
@@ -4511,7 +4513,7 @@
%-----------------------------------------------------------------------------%
-:- pred maybe_warn_pragma_singletons(pragma_c_code_impl,
+:- pred maybe_warn_pragma_singletons(pragma_foreign_code_impl,
list(maybe(pair(string, mode))), prog_context, simple_call_id,
module_info, io__state, io__state).
:- mode maybe_warn_pragma_singletons(in, in, in, in, in, di, uo) is det.
@@ -4528,7 +4530,7 @@
% warn_singletons_in_pragma_c_code checks to see if each variable is
% mentioned at least once in the c code fragments that ought to
% mention it. If not, it gives a warning.
-:- pred warn_singletons_in_pragma_c_code(pragma_c_code_impl,
+:- pred warn_singletons_in_pragma_c_code(pragma_foreign_code_impl,
list(maybe(pair(string, mode))), prog_context, simple_call_id,
module_info, io__state, io__state).
:- mode warn_singletons_in_pragma_c_code(in, in, in, in, in, di, uo) is det.
@@ -4897,8 +4899,8 @@
% hlds_goal.
:- pred clauses_info_add_pragma_c_code(clauses_info, purity,
- pragma_c_code_attributes, pred_id, proc_id, prog_varset,
- list(pragma_var), list(type), pragma_c_code_impl, prog_context,
+ pragma_foreign_code_attributes, pred_id, proc_id, prog_varset,
+ list(pragma_var), list(type), pragma_foreign_code_impl, prog_context,
pred_or_func, sym_name, arity, clauses_info, module_info,
module_info, qual_info, qual_info, io__state, io__state) is det.
:- mode clauses_info_add_pragma_c_code(in, in, in, in, in, in, in, in, in, in,
@@ -4968,8 +4970,10 @@
% Put the purity in the goal_info in case
% this c code is inlined
add_goal_info_purity_feature(GoalInfo1, Purity, GoalInfo),
- HldsGoal0 = pragma_c_code(Attributes, PredId, ModeId, Args,
- ArgInfo, OrigArgTypes, PragmaImpl) - GoalInfo
+ % XXX we assume C code
+ HldsGoal0 = pragma_foreign_code(c, Attributes, PredId,
+ ModeId, Args, ArgInfo, OrigArgTypes, PragmaImpl)
+ - GoalInfo
},
% Apply unifications with the head args.
% Since the set of head vars and the set vars in the
@@ -4989,7 +4993,6 @@
TI_VarMap, TCI_VarMap)
}
).
-
:- pred allocate_vars_for_saved_vars(list(string), list(pair(prog_var, string)),
prog_varset, prog_varset).
Index: compiler/mark_static_terms.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mark_static_terms.m,v
retrieving revision 1.1
diff -u -r1.1 mark_static_terms.m
--- compiler/mark_static_terms.m 2000/05/22 17:59:44 1.1
+++ compiler/mark_static_terms.m 2000/07/18 08:02:40
@@ -103,8 +103,8 @@
unification_mark_static_terms(Unification0, Unification,
SI0, SI).
-goal_expr_mark_static_terms(pragma_c_code(A,B,C,D,E,F,G),
- pragma_c_code(A,B,C,D,E,F,G), SI, SI).
+goal_expr_mark_static_terms(pragma_foreign_code(A,B,C,D,E,F,G,H),
+ pragma_foreign_code(A,B,C,D,E,F,G,H), SI, SI).
goal_expr_mark_static_terms(bi_implication(_, _), _, _, _) :-
% these should have been expanded out by now
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.168
diff -u -r1.168 mercury_compile.m
--- compiler/mercury_compile.m 2000/07/25 09:27:22 1.168
+++ compiler/mercury_compile.m 2000/07/30 13:55:28
@@ -2118,16 +2118,16 @@
% generation of C code for `pragma export' declarations.
%
-:- pred get_c_interface_info(module_info, c_interface_info).
+:- pred get_c_interface_info(module_info, foreign_interface_info).
:- mode get_c_interface_info(in, out) is det.
get_c_interface_info(HLDS, C_InterfaceInfo) :-
module_info_name(HLDS, ModuleName),
- module_info_get_c_header(HLDS, C_HeaderCode),
- module_info_get_c_body_code(HLDS, C_BodyCode),
+ module_info_get_foreign_header(HLDS, C_HeaderCode),
+ module_info_get_foreign_body_code(HLDS, C_BodyCode),
export__get_c_export_decls(HLDS, C_ExportDecls),
export__get_c_export_defns(HLDS, C_ExportDefns),
- C_InterfaceInfo = c_interface_info(ModuleName,
+ C_InterfaceInfo = foreign_interface_info(ModuleName,
C_HeaderCode, C_BodyCode, C_ExportDecls, C_ExportDefns).
%-----------------------------------------------------------------------------%
@@ -2188,7 +2188,7 @@
mercury_compile__output_llds(ModuleName, CFile, LayoutLabels,
MaybeRLFile, Verbose, Stats),
- { C_InterfaceInfo = c_interface_info(_, _, _, C_ExportDecls, _) },
+ { C_InterfaceInfo = foreign_interface_info(_, _, _, C_ExportDecls, _) },
export__produce_header_file(C_ExportDecls, ModuleName),
%
@@ -2204,15 +2204,15 @@
% Split the code up into bite-size chunks for the C compiler.
-:- pred mercury_compile__construct_c_file(c_interface_info, list(c_procedure),
- list(comp_gen_c_var), list(comp_gen_c_data), c_file, int,
- io__state, io__state).
+:- pred mercury_compile__construct_c_file(foreign_interface_info,
+ list(c_procedure), list(comp_gen_c_var), list(comp_gen_c_data),
+ c_file, int, io__state, io__state).
:- mode mercury_compile__construct_c_file(in, in, in, in, out, out, di, uo)
is det.
mercury_compile__construct_c_file(C_InterfaceInfo, Procedures, GlobalVars,
AllData, CFile, ComponentCount) -->
- { C_InterfaceInfo = c_interface_info(ModuleSymName,
+ { C_InterfaceInfo = foreign_interface_info(ModuleSymName,
C_HeaderCode0, C_BodyCode0, C_ExportDecls, C_ExportDefns) },
{ llds_out__sym_name_mangle(ModuleSymName, MangledModuleName) },
{ string__append(MangledModuleName, "_module", ModuleName) },
@@ -2240,8 +2240,8 @@
{ ComponentCount is UserCCodeCount + ExportCount
+ CompGenVarCount + CompGenDataCount + CompGenCodeCount }.
-:- pred maybe_add_header_file_include(c_export_decls, module_name,
- c_header_info, c_header_info, io__state, io__state).
+:- pred maybe_add_header_file_include(foreign_export_decls, module_name,
+ foreign_header_info, foreign_header_info, io__state, io__state).
:- mode maybe_add_header_file_include(in, in, in, out, di, uo) is det.
maybe_add_header_file_include(C_ExportDecls, ModuleName,
@@ -2274,12 +2274,12 @@
{ list__append(C_HeaderCode0, [Include], C_HeaderCode) }
).
-:- pred get_c_body_code(c_body_info, list(user_c_code)).
+:- pred get_c_body_code(foreign_body_info, list(user_foreign_code)).
:- mode get_c_body_code(in, out) is det.
get_c_body_code([], []).
get_c_body_code([Code - Context | CodesAndContexts],
- [user_c_code(Code, Context) | C_Modules]) :-
+ [user_foreign_code(c, Code, Context) | C_Modules]) :-
get_c_body_code(CodesAndContexts, C_Modules).
:- pred mercury_compile__combine_chunks(list(list(c_procedure)), string,
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.170
diff -u -r1.170 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 2000/07/20 11:24:05 1.170
+++ compiler/mercury_to_mercury.m 2000/07/21 02:55:36
@@ -71,9 +71,9 @@
io__state, io__state).
:- mode mercury_output_pragma_decl(in, in, in, in, di, uo) is det.
-:- pred mercury_output_pragma_c_code(pragma_c_code_attributes, sym_name,
- pred_or_func, list(pragma_var), prog_varset, pragma_c_code_impl,
- io__state, io__state).
+:- pred mercury_output_pragma_c_code(pragma_foreign_code_attributes, sym_name,
+ pred_or_func, list(pragma_var), prog_varset,
+ pragma_foreign_code_impl, io__state, io__state).
:- mode mercury_output_pragma_c_code(in, in, in, in, in, in, di, uo) is det.
:- pred mercury_output_pragma_unused_args(pred_or_func, sym_name,
@@ -322,11 +322,13 @@
{ Pragma = c_header_code(C_HeaderString) },
mercury_output_pragma_c_header(C_HeaderString)
;
- { Pragma = c_code(Code) },
+ { Pragma = foreign(_Lang, Code) },
+ % XXX if it is C code only
mercury_output_pragma_c_body_code(Code)
;
- { Pragma = c_code(Attributes, Pred, PredOrFunc, Vars,
+ { Pragma = foreign(_Lang, Attributes, Pred, PredOrFunc, Vars,
VarSet, PragmaCode) },
+ % XXX if it is C code only
mercury_output_pragma_c_code(Attributes, Pred, PredOrFunc,
Vars, VarSet, PragmaCode)
;
@@ -2337,7 +2339,7 @@
%-----------------------------------------------------------------------------%
:- pred mercury_output_pragma_import(sym_name, pred_or_func, list(mode),
- pragma_c_code_attributes, string, io__state, io__state).
+ pragma_foreign_code_attributes, string, io__state, io__state).
:- mode mercury_output_pragma_import(in, in, in, in, in, di, uo) is det.
mercury_output_pragma_import(Name, PredOrFunc, ModeList, Attributes,
@@ -2461,7 +2463,7 @@
%-----------------------------------------------------------------------------%
-:- pred mercury_output_pragma_c_attributes(pragma_c_code_attributes,
+:- pred mercury_output_pragma_c_attributes(pragma_foreign_code_attributes,
io__state, io__state).
:- mode mercury_output_pragma_c_attributes(in, di, uo) is det.
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.55
diff -u -r1.55 ml_code_gen.m
--- compiler/ml_code_gen.m 2000/07/20 11:24:07 1.55
+++ compiler/ml_code_gen.m 2000/07/21 02:55:37
@@ -687,9 +687,10 @@
:- mode ml_gen_foreign_code(in, out, di, uo) is det.
ml_gen_foreign_code(ModuleInfo, MLDS_ForeignCode) -->
- { module_info_get_c_header(ModuleInfo, C_Header_Info) },
- { module_info_get_c_body_code(ModuleInfo, C_Body_Info) },
- { ConvBody = (func(S - C) = user_c_code(S, C)) },
+ { module_info_get_foreign_header(ModuleInfo, C_Header_Info) },
+ { module_info_get_foreign_body_code(ModuleInfo, C_Body_Info) },
+ % XXX This assumes the language is C.
+ { ConvBody = (func(S - C) = user_foreign_code(c, S, C)) },
{ User_C_Code = list__map(ConvBody, C_Body_Info) },
{ ml_gen_pragma_export(ModuleInfo, MLDS_PragmaExports) },
{ MLDS_ForeignCode = mlds__foreign_code(C_Header_Info, User_C_Code,
@@ -1538,7 +1539,7 @@
ml_gen_unification(Unification, CodeModel, Context,
MLDS_Decls, MLDS_Statements).
-ml_gen_goal_expr(pragma_c_code(Attributes,
+ml_gen_goal_expr(pragma_foreign_code(_Lang, Attributes,
PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes, PragmaImpl),
CodeModel, OuterContext, MLDS_Decls, MLDS_Statements) -->
(
@@ -1569,7 +1570,7 @@
% these should have been expanded out by now
{ error("ml_gen_goal_expr: unexpected bi_implication") }.
-:- pred ml_gen_nondet_pragma_c_code(code_model, pragma_c_code_attributes,
+:- pred ml_gen_nondet_pragma_c_code(code_model, pragma_foreign_code_attributes,
pred_id, proc_id, list(prog_var),
list(maybe(pair(string, mode))), list(prog_type), prog_context,
string, maybe(prog_context), string, maybe(prog_context),
@@ -1728,7 +1729,8 @@
]) },
{ MLDS_Decls = ConvDecls }.
-:- pred ml_gen_ordinary_pragma_c_code(code_model, pragma_c_code_attributes,
+:- pred ml_gen_ordinary_pragma_c_code(code_model,
+ pragma_foreign_code_attributes,
pred_id, proc_id, list(prog_var),
list(maybe(pair(string, mode))), list(prog_type),
string, prog_context,
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.28
diff -u -r1.28 mlds.m
--- compiler/mlds.m 2000/07/20 10:39:30 1.28
+++ compiler/mlds.m 2000/07/21 03:40:48
@@ -599,15 +599,15 @@
%-----------------------------------------------------------------------------%
%
- % C code required for the C interface.
- % When compiling to a language other than C,
- % this part still needs to be generated as C code
- % and compiled with a C compiler.
+ % Foreign code required for the foreign language interface.
+ % When compiling to a language other than the foreign language,
+ % this part still needs to be generated as C (or whatever) code
+ % and compiled with a C (or whatever) compiler.
%
:- type mlds__foreign_code
---> mlds__foreign_code(
- c_header_info,
- list(user_c_code),
+ foreign_header_info,
+ list(user_foreign_code),
list(mlds__pragma_export)
).
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.45
diff -u -r1.45 mlds_to_c.m
--- compiler/mlds_to_c.m 2000/07/25 09:46:11 1.45
+++ compiler/mlds_to_c.m 2000/07/30 13:55:30
@@ -315,7 +315,7 @@
%-----------------------------------------------------------------------------%
%
-% C interface stuff
+% Foreign language interface stuff
%
:- pred mlds_output_c_hdr_decls(mlds_module_name, indent, mlds__foreign_code,
@@ -331,14 +331,16 @@
io__write_list(ExportDefns, "\n",
mlds_output_pragma_export_decl(ModuleName, Indent)).
-:- pred mlds_output_c_hdr_decl(indent, c_header_code, io__state, io__state).
+:- pred mlds_output_c_hdr_decl(indent,
+ foreign_header_code, io__state, io__state).
:- mode mlds_output_c_hdr_decl(in, in, di, uo) is det.
mlds_output_c_hdr_decl(_Indent, Code - Context) -->
mlds_output_context(mlds__make_context(Context)),
io__write_string(Code).
-:- pred mlds_output_c_decls(indent, mlds__foreign_code, io__state, io__state).
+:- pred mlds_output_c_decls(indent, mlds__foreign_code,
+ io__state, io__state).
:- mode mlds_output_c_decls(in, in, di, uo) is det.
% all of the declarations go in the header file or as c_code
@@ -357,10 +359,11 @@
io__write_list(ExportDefns, "\n",
mlds_output_pragma_export_defn(ModuleName, Indent)).
-:- pred mlds_output_c_defn(indent, user_c_code, io__state, io__state).
+:- pred mlds_output_c_defn(indent, user_foreign_code,
+ io__state, io__state).
:- mode mlds_output_c_defn(in, in, di, uo) is det.
-mlds_output_c_defn(_Indent, user_c_code(Code, Context)) -->
+mlds_output_c_defn(_Indent, user_foreign_code(c, Code, Context)) -->
mlds_output_context(mlds__make_context(Context)),
io__write_string(Code).
Index: compiler/mode_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mode_util.m,v
retrieving revision 1.123
diff -u -r1.123 mode_util.m
--- compiler/mode_util.m 2000/05/05 06:07:47 1.123
+++ compiler/mode_util.m 2000/07/18 08:02:40
@@ -1243,9 +1243,10 @@
{ goal_info_get_instmap_delta(GoalInfo, InstMapDelta) }
).
-recompute_instmap_delta_2(_, pragma_c_code(A, PredId, ProcId, Args, E, F,
- G), _, pragma_c_code(A, PredId, ProcId, Args, E, F, G),
- _VarTypes, InstMap, InstMapDelta) -->
+recompute_instmap_delta_2(_,
+ pragma_foreign_code(A, B, PredId, ProcId, Args, F, G, H), _,
+ pragma_foreign_code(A, B, PredId, ProcId, Args, F, G, H), _,
+ InstMap, InstMapDelta) -->
recompute_instmap_delta_call(PredId, ProcId,
Args, InstMap, InstMapDelta).
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.242
diff -u -r1.242 modes.m
--- compiler/modes.m 2000/07/24 11:36:04 1.242
+++ compiler/modes.m 2000/07/30 13:55:31
@@ -1186,9 +1186,11 @@
% to modecheck a pragma_c_code, we just modecheck the proc for
% which it is the goal.
-modecheck_goal_expr(pragma_c_code(IsRecursive, PredId, ProcId0, Args0,
- ArgNameMap, OrigArgTypes, PragmaCode), GoalInfo, Goal) -->
- mode_checkpoint(enter, "pragma_c_code"),
+modecheck_goal_expr(pragma_foreign_code(Language, Attributes, PredId, ProcId0,
+ Args0, ArgNameMap, OrigArgTypes, PragmaCode),
+ GoalInfo, Goal) -->
+ mode_checkpoint(enter, "pragma_foreign_code"),
+
=(ModeInfo0),
{ mode_info_get_call_id(ModeInfo0, PredId, CallId) },
@@ -1198,13 +1200,13 @@
modecheck_call_pred(PredId, ProcId0, Args0, DeterminismKnown,
ProcId, Args, ExtraGoals),
- { Pragma = pragma_c_code(IsRecursive, PredId, ProcId, Args0,
- ArgNameMap, OrigArgTypes, PragmaCode) },
+ { Pragma = pragma_foreign_code(Language, Attributes, PredId, ProcId,
+ Args0, ArgNameMap, OrigArgTypes, PragmaCode) },
handle_extra_goals(Pragma, ExtraGoals, GoalInfo, Args0, Args,
InstMap0, Goal),
mode_info_unset_call_context,
- mode_checkpoint(exit, "pragma_c_code").
+ mode_checkpoint(exit, "pragma_foreign_code").
modecheck_goal_expr(bi_implication(_, _), _, _) -->
% these should have been expanded out by now
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.56
diff -u -r1.56 module_qual.m
--- compiler/module_qual.m 2000/07/06 06:25:12 1.56
+++ compiler/module_qual.m 2000/07/18 08:02:40
@@ -879,9 +879,10 @@
qualify_pragma(source_file(File), source_file(File), Info, Info) --> [].
qualify_pragma(c_header_code(Code), c_header_code(Code), Info, Info) --> [].
-qualify_pragma(c_code(Code), c_code(Code), Info, Info) --> [].
-qualify_pragma(c_code(Rec, SymName, PredOrFunc, PragmaVars0, Varset, CCode),
- c_code(Rec, SymName, PredOrFunc, PragmaVars, Varset, CCode),
+qualify_pragma(foreign(L, C), foreign(L, C), Info, Info) --> [].
+qualify_pragma(
+ foreign(Lang, Rec, SymName, PredOrFunc, PragmaVars0, Varset, Code),
+ foreign(Lang, Rec, SymName, PredOrFunc, PragmaVars, Varset, Code),
Info0, Info) -->
qualify_pragma_vars(PragmaVars0, PragmaVars, Info0, Info).
qualify_pragma(tabled(A, B, C, D, MModes0), tabled(A, B, C, D, MModes),
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.131
diff -u -r1.131 modules.m
--- compiler/modules.m 2000/07/27 10:32:40 1.131
+++ compiler/modules.m 2000/07/30 13:55:32
@@ -986,8 +986,8 @@
% header file, which currently we don't.
pragma_allowed_in_interface(c_header_code(_), no).
-pragma_allowed_in_interface(c_code(_), no).
-pragma_allowed_in_interface(c_code(_, _, _, _, _, _), no).
+pragma_allowed_in_interface(foreign(_, _), no).
+pragma_allowed_in_interface(foreign(_, _, _, _, _, _, _), no).
pragma_allowed_in_interface(inline(_, _), no).
pragma_allowed_in_interface(no_inline(_, _), no).
pragma_allowed_in_interface(obsolete(_, _), yes).
Index: compiler/pd_cost.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pd_cost.m,v
retrieving revision 1.7
diff -u -r1.7 pd_cost.m
--- compiler/pd_cost.m 1999/10/25 03:49:28 1.7
+++ compiler/pd_cost.m 2000/07/18 08:02:40
@@ -91,7 +91,8 @@
goal_info_get_nonlocals(GoalInfo, NonLocals),
pd_cost__unify(NonLocals, Unification, Cost).
-pd_cost__goal(pragma_c_code(Attributes, _, _, Args, _, _, _) - _, Cost) :-
+pd_cost__goal(pragma_foreign_code(_, Attributes, _, _, Args, _, _, _) - _,
+ Cost) :-
( may_call_mercury(Attributes, will_not_call_mercury) ->
Cost1 = 0
;
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.190
diff -u -r1.190 polymorphism.m
--- compiler/polymorphism.m 2000/07/20 11:24:08 1.190
+++ compiler/polymorphism.m 2000/07/21 03:39:36
@@ -918,7 +918,7 @@
{ conj_list_to_goal(GoalList, GoalInfo, Goal) }.
polymorphism__process_goal_expr(Goal0, GoalInfo, Goal) -->
- { Goal0 = pragma_c_code(IsRecursive, PredId, ProcId,
+ { Goal0 = pragma_foreign_code(Lang, IsRecursive, PredId, ProcId,
ArgVars0, ArgInfo0, OrigArgTypes0, PragmaCode0) },
polymorphism__process_call(PredId, ArgVars0, GoalInfo,
ArgVars, ExtraVars, CallGoalInfo, ExtraGoals),
@@ -973,8 +973,9 @@
%
% plug it all back together
%
- { Call = pragma_c_code(IsRecursive, PredId, ProcId, ArgVars,
- ArgInfo, OrigArgTypes, PragmaCode) - CallGoalInfo },
+ { Call = pragma_foreign_code(Lang, IsRecursive, PredId,
+ ProcId, ArgVars, ArgInfo, OrigArgTypes, PragmaCode) -
+ CallGoalInfo },
{ list__append(ExtraGoals, [Call], GoalList) },
{ conj_list_to_goal(GoalList, GoalInfo, Goal) }
).
Index: compiler/pragma_c_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pragma_c_gen.m,v
retrieving revision 1.35
diff -u -r1.35 pragma_c_gen.m
--- compiler/pragma_c_gen.m 2000/07/20 11:24:11 1.35
+++ compiler/pragma_c_gen.m 2000/07/21 02:55:44
@@ -26,9 +26,9 @@
:- import_module list, std_util.
:- pred pragma_c_gen__generate_pragma_c_code(code_model::in,
- pragma_c_code_attributes::in, pred_id::in, proc_id::in,
+ pragma_foreign_code_attributes::in, pred_id::in, proc_id::in,
list(prog_var)::in, list(maybe(pair(string, mode)))::in, list(type)::in,
- hlds_goal_info::in, pragma_c_code_impl::in, code_tree::out,
+ hlds_goal_info::in, pragma_foreign_code_impl::in, code_tree::out,
code_info::in, code_info::out) is det.
:- pred pragma_c_gen__struct_name(module_name::in, string::in, int::in,
@@ -327,7 +327,7 @@
%---------------------------------------------------------------------------%
:- pred pragma_c_gen__ordinary_pragma_c_code(code_model::in,
- pragma_c_code_attributes::in, pred_id::in, proc_id::in,
+ pragma_foreign_code_attributes::in, pred_id::in, proc_id::in,
list(prog_var)::in, list(maybe(pair(string, mode)))::in, list(type)::in,
string::in, maybe(prog_context)::in, code_tree::out,
code_info::in, code_info::out) is det.
@@ -555,7 +555,7 @@
%-----------------------------------------------------------------------------%
:- pred pragma_c_gen__nondet_pragma_c_code(code_model::in,
- pragma_c_code_attributes::in, pred_id::in, proc_id::in,
+ pragma_foreign_code_attributes::in, pred_id::in, proc_id::in,
list(prog_var)::in, list(maybe(pair(string, mode)))::in, list(type)::in,
string::in, maybe(prog_context)::in,
string::in, maybe(prog_context)::in,
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.56
diff -u -r1.56 prog_data.m
--- compiler/prog_data.m 2000/07/20 11:24:12 1.56
+++ compiler/prog_data.m 2000/07/21 02:55:44
@@ -104,6 +104,16 @@
---> type_only(type)
; type_and_mode(type, mode).
+ % We only support C right now.
+:- type foreign_language
+ ---> c
+% ; cplusplus
+% ; csharp
+% ; managedcplusplus
+% ; java
+% ; il
+ .
+
:- type pred_or_func
---> predicate
; function.
@@ -136,13 +146,14 @@
:- type pragma_type
---> c_header_code(string)
- ; c_code(string)
+ ; foreign(foreign_language, string)
- ; c_code(pragma_c_code_attributes, sym_name, pred_or_func,
- list(pragma_var), prog_varset, pragma_c_code_impl)
+ ; foreign(foreign_language, pragma_foreign_code_attributes,
+ sym_name, pred_or_func, list(pragma_var),
+ prog_varset, pragma_foreign_code_impl)
% Set of C code attributes, eg.:
- % whether or not the C code may call Mercury,
- % whether or not the C code is thread-safe
+ % whether or not the code may call Mercury,
+ % whether or not the code is thread-safe
% PredName, Predicate or Function, Vars/Mode,
% VarNames, C Code Implementation Info
@@ -168,12 +179,12 @@
% C function name.
; import(sym_name, pred_or_func, list(mode),
- pragma_c_code_attributes, string)
+ pragma_foreign_code_attributes, string)
% Predname, Predicate/function, Modes,
- % Set of C code attributes, eg.:
- % whether or not the C code may call Mercury,
- % whether or not the C code is thread-safe
- % C function name.
+ % Set of foreign code attributes, eg.:
+ % whether or not the foreign code may call Mercury,
+ % whether or not the foreign code is thread-safe
+ % foreign function name.
; source_file(string)
% Source file name.
@@ -333,35 +344,43 @@
:- type type_subst == assoc_list(tvar, type).
%
-% Stuff for `c_code' pragma.
+% Stuff for `foreign_code' pragma.
%
% This type holds information about the implementation details
- % of procedures defined via `pragma c_code'.
+ % of procedures defined via `pragma foreign_code'.
%
% All the strings in this type may be accompanied by the context
% of their appearance in the source code. These contexts are
- % used to tell the C compiler where the included C code comes from,
- % to allow it to generate error messages that refer to the original
- % appearance of the code in the Mercury program.
- % The context is missing if the C code was constructed by the compiler.
-:- type pragma_c_code_impl
- ---> ordinary( % This is a C definition of a model_det
- % or model_semi procedure. (We also
- % allow model_non, until everyone has
- % had time to adapt to the new way
+ % used to tell the foreign language compiler where the included
+ % code comes from, to allow it to generate error messages that
+ % refer to the original appearance of the code in the Mercury
+ % program.
+ % The context is missing if the foreign code was constructed by
+ % the compiler.
+ % Note that nondet pragma foreign definitions might not be
+ % possible in all foreign languages.
+:- type pragma_foreign_code_impl
+ ---> ordinary( % This is a foreign language
+ % definition of a model_det
+ % or model_semi procedure. (We
+ % also allow model_non, until
+ % everyone has had time to adapt
+ % to the new way
% of handling model_non pragmas.)
- string, % The C code of the procedure.
+ string, % The code of the procedure.
maybe(prog_context)
)
- ; nondet( % This is a C definition of a model_non
+ ; nondet( % This is a foreign language
+ % definition of a model_non
% procedure.
string,
maybe(prog_context),
% The info saved for the time when
% backtracking reenters this procedure
- % is stored in a C struct. This arg
- % contains the field declarations.
+ % is stored in a data structure.
+ % This arg contains the field
+ % declarations.
string,
maybe(prog_context),
@@ -486,23 +505,23 @@
% an abstract type for representing a set of
% `pragma_c_code_attribute's.
-:- type pragma_c_code_attributes.
+:- type pragma_foreign_code_attributes.
-:- pred default_attributes(pragma_c_code_attributes).
+:- pred default_attributes(pragma_foreign_code_attributes).
:- mode default_attributes(out) is det.
-:- pred may_call_mercury(pragma_c_code_attributes, may_call_mercury).
+:- pred may_call_mercury(pragma_foreign_code_attributes, may_call_mercury).
:- mode may_call_mercury(in, out) is det.
-:- pred set_may_call_mercury(pragma_c_code_attributes, may_call_mercury,
- pragma_c_code_attributes).
+:- pred set_may_call_mercury(pragma_foreign_code_attributes, may_call_mercury,
+ pragma_foreign_code_attributes).
:- mode set_may_call_mercury(in, in, out) is det.
-:- pred thread_safe(pragma_c_code_attributes, thread_safe).
+:- pred thread_safe(pragma_foreign_code_attributes, thread_safe).
:- mode thread_safe(in, out) is det.
-:- pred set_thread_safe(pragma_c_code_attributes, thread_safe,
- pragma_c_code_attributes).
+:- pred set_thread_safe(pragma_foreign_code_attributes, thread_safe,
+ pragma_foreign_code_attributes).
:- mode set_thread_safe(in, in, out) is det.
% For pragma c_code, there are two different calling conventions,
@@ -895,7 +914,7 @@
:- implementation.
-:- type pragma_c_code_attributes
+:- type pragma_foreign_code_attributes
---> attributes(
may_call_mercury,
thread_safe
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.21
diff -u -r1.21 prog_io_pragma.m
--- compiler/prog_io_pragma.m 1999/07/13 08:53:24 1.21
+++ compiler/prog_io_pragma.m 2000/07/19 01:55:57
@@ -88,69 +88,51 @@
ErrorTerm)
).
+parse_pragma_type(ModuleName, "foreign_code", PragmaTerms,
+ ErrorTerm, VarSet, Result) :-
+ parse_pragma_foreign_code_pragma(ModuleName, "foreign_code",
+ PragmaTerms, ErrorTerm, VarSet, Result).
+
+ % pragma c_code is almost as if we have written foreign_code
+ % with the language set to "C".
+ % There are a few differences (error messages, some deprecated
+ % syntax is still supported for c_code) so we pass the original
+ % pragma name to parse_pragma_foreign_code_pragma.
parse_pragma_type(ModuleName, "c_code", PragmaTerms,
ErrorTerm, VarSet, Result) :-
(
- PragmaTerms = [Just_C_Code_Term]
- ->
- (
- Just_C_Code_Term = term__functor(term__string(Just_C_Code), [],
- _)
- ->
- Result = ok(pragma(c_code(Just_C_Code)))
- ;
- Result = error("expected string for C code", Just_C_Code_Term)
- )
- ;
- PragmaTerms = [PredAndVarsTerm, C_CodeTerm]
+ PragmaTerms = [term__functor(_, _, Context) | _]
->
- % XXX we should issue a warning; this syntax is deprecated.
- % Result = error("pragma c_code doesn't say whether it can call mercury", PredAndVarsTerm)
- % may_call_mercury is a conservative default.
- default_attributes(Attributes),
- (
- C_CodeTerm = term__functor(term__string(C_Code), [], Context)
- ->
- parse_pragma_c_code(ModuleName, Attributes, PredAndVarsTerm,
- ordinary(C_Code, yes(Context)), VarSet, Result)
- ;
- Result = error("invalid `:- pragma c_code' declaration -- expecting either `may_call_mercury' or `will_not_call_mercury', and a string for C code",
- C_CodeTerm)
- )
- ;
- PragmaTerms = [PredAndVarsTerm, FlagsTerm, C_CodeTerm]
- ->
- (
- C_CodeTerm = term__functor(term__string(C_Code), [], Context)
- ->
- ( parse_pragma_c_code_attributes_term(FlagsTerm, Flags) ->
- parse_pragma_c_code(ModuleName, Flags, PredAndVarsTerm,
- ordinary(C_Code, yes(Context)), VarSet, Result)
- ; parse_pragma_c_code_attributes_term(PredAndVarsTerm, Flags) ->
- % XXX we should issue a warning; this syntax is deprecated
- parse_pragma_c_code(ModuleName, Flags, FlagsTerm,
- ordinary(C_Code, yes(Context)), VarSet, Result)
- ;
- Result = error("invalid second argument in `:- pragma c_code' declaration -- expecting a C code attribute or list of attributes'",
- FlagsTerm)
- )
- ;
- Result = error("invalid third argument in `:- pragma c_code' declaration -- expecting string for C code",
- C_CodeTerm)
- )
+ LangC = term__functor(term__string("C"), [], Context),
+ parse_pragma_foreign_code_pragma(ModuleName, "c_code",
+ [LangC | PragmaTerms], ErrorTerm, VarSet, Result)
;
- (
- PragmaTerms = [PredAndVarsTerm, FlagsTerm,
- FieldsTerm, FirstTerm, LaterTerm],
- term__context_init(DummyContext),
- SharedTerm = term__functor(term__atom("common_code"),
- [term__functor(term__string(""), [], DummyContext)],
- DummyContext)
- ;
- PragmaTerms = [PredAndVarsTerm, FlagsTerm,
- FieldsTerm, FirstTerm, LaterTerm, SharedTerm]
- )
- ->
+ Result = error("wrong number of arguments or unexpected variable in `:- pragma c_code' declaration",
+ ErrorTerm)
+ ).
+
+:- pred parse_foreign_language(term, foreign_language).
+:- mode parse_foreign_language(in, out) is semidet.
+
+parse_foreign_language(term__functor(term__string("C"), _, _), c).
+parse_foreign_language(term__functor(term__string("c"), _, _), c).
+%parse_foreign_language(term__functor(term__string("C++"), _, _), cplusplus).
+%parse_foreign_language(term__functor(term__string("c++"), _, _), cplusplus).
+
+
+ % This predicate parses both c_code and foreign_code pragmas.
+:- pred parse_pragma_foreign_code_pragma(module_name, string,
+ list(term), term, varset, maybe1(item)).
+:- mode parse_pragma_foreign_code_pragma(in, in, in, in, in, out) is det.
+
+parse_pragma_foreign_code_pragma(ModuleName, Pragma, PragmaTerms,
+ ErrorTerm, VarSet, Result) :-
+ string__format("invalid `:- pragma %s' declaration ", [s(Pragma)],
+ InvalidDeclStr),
+
+ Check6 = (func(PTerms6, ForeignLanguage) = Res is semidet :-
+ PTerms6 = [PredAndVarsTerm, FlagsTerm,
+ FieldsTerm, FirstTerm, LaterTerm, SharedTerm],
( parse_pragma_c_code_attributes_term(FlagsTerm, Flags) ->
( parse_pragma_keyword("local_vars", FieldsTerm, Fields,
FieldsContext) ->
@@ -160,57 +142,201 @@
LaterContext) ->
( parse_pragma_keyword("shared_code", SharedTerm,
Shared, SharedContext) ->
- parse_pragma_c_code(ModuleName, Flags,
- PredAndVarsTerm,
+ parse_pragma_foreign_code(ModuleName,
+ ForeignLanguage, Flags, PredAndVarsTerm,
nondet(Fields, yes(FieldsContext),
First, yes(FirstContext),
Later, yes(LaterContext),
share, Shared, yes(SharedContext)),
- VarSet, Result)
+ VarSet, Res)
; parse_pragma_keyword("duplicated_code",
SharedTerm, Shared, SharedContext) ->
- parse_pragma_c_code(ModuleName, Flags,
- PredAndVarsTerm,
+ parse_pragma_foreign_code(ModuleName,
+ ForeignLanguage, Flags, PredAndVarsTerm,
nondet(Fields, yes(FieldsContext),
First, yes(FirstContext),
Later, yes(LaterContext),
duplicate, Shared, yes(SharedContext)),
- VarSet, Result)
+ VarSet, Res)
; parse_pragma_keyword("common_code", SharedTerm,
Shared, SharedContext) ->
- parse_pragma_c_code(ModuleName, Flags,
- PredAndVarsTerm,
+ parse_pragma_foreign_code(ModuleName,
+ ForeignLanguage, Flags, PredAndVarsTerm,
nondet(Fields, yes(FieldsContext),
First, yes(FirstContext),
Later, yes(LaterContext),
automatic, Shared, yes(SharedContext)),
- VarSet, Result)
+ VarSet, Res)
;
- Result = error("invalid sixth argument in `:- pragma c_code' declaration -- expecting `common_code(<code>)'",
- LaterTerm)
+ ErrMsg = "-- invalid seventh argument, expecting `common_code(<code>)'",
+ Res = error(string__append(InvalidDeclStr,
+ ErrMsg), SharedTerm)
)
;
- Result = error("invalid fifth argument in `:- pragma c_code' declaration -- expecting `retry_code(<code>)'",
- LaterTerm)
+ ErrMsg = "-- invalid sixth argument, expecting `retry_code(<code>)'",
+ Res = error(string__append(InvalidDeclStr, ErrMsg),
+ LaterTerm)
)
;
- Result = error("invalid fourth argument in `:- pragma c_code' declaration -- expecting `first_code(<code>)'",
- FirstTerm)
+ ErrMsg = "-- invalid fifth argument, expecting `first_code(<code>)'",
+ Res = error(string__append(InvalidDeclStr, ErrMsg),
+ FirstTerm)
)
;
- Result = error("invalid third argument in `:- pragma c_code' declaration -- expecting `local_vars(<fields>)'",
- FieldsTerm)
+ ErrMsg = "-- invalid fourth argument, expecting `local_vars(<fields>)'",
+ Res = error(string__append(InvalidDeclStr, ErrMsg),
+ FieldsTerm)
+ )
+ ;
+ ErrMsg = "-- invalid third argument, expecting foreign code attribute or list of attributes",
+ Res = error(string__append(InvalidDeclStr, ErrMsg), FlagsTerm)
+ )
+ ),
+
+ Check5 = (func(PTerms5, ForeignLanguage) = Res is semidet :-
+ PTerms5 = [PredAndVarsTerm, FlagsTerm,
+ FieldsTerm, FirstTerm, LaterTerm],
+ term__context_init(DummyContext),
+ SharedTerm = term__functor(term__atom("common_code"),
+ [term__functor(term__string(""), [], DummyContext)],
+ DummyContext),
+ Res = Check6([PredAndVarsTerm, FlagsTerm, FieldsTerm, FirstTerm,
+ LaterTerm, SharedTerm], ForeignLanguage)
+ ),
+
+ Check3 = (func(PTerms3, ForeignLanguage) = Res is semidet :-
+ PTerms3 = [PredAndVarsTerm, FlagsTerm, CodeTerm],
+ (
+ CodeTerm = term__functor(term__string(Code), [], Context)
+ ->
+ ( parse_pragma_c_code_attributes_term(FlagsTerm, Flags) ->
+ parse_pragma_foreign_code(ModuleName, ForeignLanguage,
+ Flags, PredAndVarsTerm,
+ ordinary(Code, yes(Context)), VarSet, Res)
+ ; parse_pragma_c_code_attributes_term(PredAndVarsTerm, Flags) ->
+ % XXX we should issue a warning; this syntax is deprecated
+ % We will continue to accept this if c_code is used, but
+ % not with foreign_code
+ ( Pragma = "c_code" ->
+ parse_pragma_foreign_code(ModuleName, ForeignLanguage,
+ Flags, FlagsTerm, ordinary(Code, yes(Context)),
+ VarSet, Res)
+ ;
+ ErrMsg = "-- invalid second argument, expecting predicate or function mode",
+ Res = error(string__append(InvalidDeclStr, ErrMsg),
+ PredAndVarsTerm)
+ )
+ ;
+ ErrMsg = "-- invalid third argument, expecting a foreign code attribute or list of attributes",
+ Res = error(string__append(InvalidDeclStr, ErrMsg),
+ FlagsTerm)
)
;
- Result = error("invalid second argument in `:- pragma c_code' declaration -- expecting pragma c_code attribute or list of attributes'",
- FlagsTerm)
+ ErrMsg = "-- invalid fourth argument, expecting string containing foreign code",
+ Res = error(string__append(InvalidDeclStr, ErrMsg),
+ CodeTerm)
)
+ ),
+
+
+ Check2 = (func(PTerms2, ForeignLanguage) = Res is semidet :-
+ PTerms2 = [PredAndVarsTerm, CodeTerm],
+ % XXX we should issue a warning; this syntax is deprecated.
+ % We will continue to accept this if c_code is used, but
+ % not with foreign_code
+ (
+ Pragma = "c_code"
+ ->
+ % may_call_mercury is a conservative default.
+ default_attributes(Attributes),
+ (
+ CodeTerm = term__functor(term__string(Code), [],
+ Context)
+ ->
+ parse_pragma_foreign_code(ModuleName,
+ ForeignLanguage, Attributes,
+ PredAndVarsTerm, ordinary(Code,
+ yes(Context)), VarSet, Res)
+ ;
+ ErrMsg = "-- expecting either `may_call_mercury' or `will_not_call_mercury', and a string for C code",
+ Res = error(string__append(InvalidDeclStr, ErrMsg),
+ CodeTerm)
+ )
+ ;
+ ErrMsg = "-- doesn't say whether it can call mercury",
+ Res = error(string__append(InvalidDeclStr, ErrMsg),
+ ErrorTerm)
+ )
+ ),
+
+ Check1 = (func(PTerms1, ForeignLanguage) = Res is semidet :-
+ PTerms1 = [Just_Code_Term],
+ (
+ Just_Code_Term = term__functor(term__string(
+ Just_Code), [], _)
+ ->
+ Res = ok(pragma(foreign(ForeignLanguage,
+ Just_Code)))
+ ;
+ ErrMsg = "-- expected string for foreign code",
+ Res = error(string__append(InvalidDeclStr, ErrMsg),
+ ErrorTerm)
+ )
+ ),
+
+ CheckLength = (func(PTermsLen, ForeignLanguage) = Res :-
+ (
+ Res0 = Check1(PTermsLen, ForeignLanguage)
+ ->
+ Res = Res0
+ ;
+ Res0 = Check2(PTermsLen, ForeignLanguage)
+ ->
+ Res = Res0
+ ;
+ Res0 = Check3(PTermsLen, ForeignLanguage)
+ ->
+ Res = Res0
+ ;
+ Res0 = Check5(PTermsLen, ForeignLanguage)
+ ->
+ Res = Res0
+ ;
+ Res0 = Check6(PTermsLen, ForeignLanguage)
+ ->
+ Res = Res0
+ ;
+ ErrMsg = "-- wrong number of arguments",
+ Res = error(string__append(InvalidDeclStr, ErrMsg),
+ ErrorTerm)
+ )
+ ),
+
+
+ CheckLanguage = (func(PTermsLang) = Res is semidet :-
+ PTermsLang = [Lang | Rest],
+ (
+ parse_foreign_language(Lang, ForeignLanguage)
+ ->
+ Res = CheckLength(Rest, ForeignLanguage)
+ ;
+ ErrMsg = "-- invalid language parameter",
+ Res = error(string__append(InvalidDeclStr, ErrMsg),
+ Lang)
+ )
+ ),
+
+ (
+ Result0 = CheckLanguage(PragmaTerms)
+ ->
+ Result = Result0
;
- Result = error(
- "wrong number of arguments in `:- pragma c_code' declaration",
- ErrorTerm)
+ ErrMsg0 = "-- wrong number of arguments",
+ Result = error(string__append(InvalidDeclStr, ErrMsg0),
+ ErrorTerm)
).
+
parse_pragma_type(ModuleName, "import", PragmaTerms,
ErrorTerm, _VarSet, Result) :-
(
@@ -693,7 +819,8 @@
; thread_safe(thread_safe)
.
-:- pred parse_pragma_c_code_attributes_term(term, pragma_c_code_attributes).
+:- pred parse_pragma_c_code_attributes_term(term,
+ pragma_foreign_code_attributes).
:- mode parse_pragma_c_code_attributes_term(in, out) is semidet.
parse_pragma_c_code_attributes_term(Term, Attributes) :-
@@ -777,12 +904,13 @@
% parse a pragma c_code declaration
-:- pred parse_pragma_c_code(module_name, pragma_c_code_attributes, term,
- pragma_c_code_impl, varset, maybe1(item)).
-:- mode parse_pragma_c_code(in, in, in, in, in, out) is det.
+:- pred parse_pragma_foreign_code(module_name, foreign_language,
+ pragma_foreign_code_attributes, term, pragma_foreign_code_impl,
+ varset, maybe1(item)).
+:- mode parse_pragma_foreign_code(in, in, in, in, in, in, out) is det.
-parse_pragma_c_code(ModuleName, Flags, PredAndVarsTerm0, PragmaImpl,
- VarSet0, Result) :-
+parse_pragma_foreign_code(ModuleName, ForeignLanguage, Flags, PredAndVarsTerm0,
+ PragmaImpl, VarSet0, Result) :-
parse_pred_or_func_and_args(yes(ModuleName), PredAndVarsTerm0,
PredAndVarsTerm0, "`:- pragma c_code' declaration", PredAndArgsResult),
(
@@ -803,7 +931,7 @@
(
Error = no,
varset__coerce(VarSet0, VarSet),
- Result = ok(pragma(c_code(Flags, PredName,
+ Result = ok(pragma(foreign(ForeignLanguage, Flags, PredName,
PredOrFunc, PragmaVars, VarSet, PragmaImpl)))
;
Error = yes(ErrorMessage),
Index: compiler/purity.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/purity.m,v
retrieving revision 1.26
diff -u -r1.26 purity.m
--- compiler/purity.m 2000/05/05 06:07:50 1.26
+++ compiler/purity.m 2000/07/18 08:02:41
@@ -664,7 +664,7 @@
{ worst_purity(Purity12, Purity3, Purity) }.
compute_expr_purity(Ccode, Ccode, _, PredInfo, PredInfo, ModuleInfo, _, Purity,
NumErrors, NumErrors) -->
- { Ccode = pragma_c_code(_,PredId,_,_,_,_,_) },
+ { Ccode = pragma_foreign_code(_,_,PredId,_,_,_,_,_) },
{ module_info_preds(ModuleInfo, Preds) },
{ map__lookup(Preds, PredId, CalledPredInfo) },
{ pred_info_get_purity(CalledPredInfo, Purity) }.
Index: compiler/quantification.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/quantification.m,v
retrieving revision 1.73
diff -u -r1.73 quantification.m
--- compiler/quantification.m 2000/05/22 18:00:52 1.73
+++ compiler/quantification.m 2000/07/18 08:02:41
@@ -472,8 +472,8 @@
{ set__union(NonLocalVars1, NonLocalVars2, NonLocalVars) },
quantification__set_nonlocals(NonLocalVars).
-implicitly_quantify_goal_2(pragma_c_code(A,B,C,Vars,E,F,G), _,
- pragma_c_code(A,B,C,Vars,E,F,G)) -->
+implicitly_quantify_goal_2(pragma_foreign_code(A,B,C,D,Vars,E,F,G), _,
+ pragma_foreign_code(A,B,C,D,Vars,E,F,G)) -->
implicitly_quantify_atomic_goal(Vars).
implicitly_quantify_goal_2(bi_implication(LHS0, RHS0), Context, Goal) -->
@@ -976,7 +976,7 @@
set__union(Set5, Set6, Set),
set__union(LambdaSet5, LambdaSet6, LambdaSet).
-quantification__goal_vars_2(_, pragma_c_code(_, _, _, ArgVars, _, _, _),
+quantification__goal_vars_2(_, pragma_foreign_code(_,_,_,_, ArgVars, _, _, _),
Set0, LambdaSet, Set, LambdaSet) :-
set__insert_list(Set0, ArgVars, Set).
Index: compiler/rl_exprn.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl_exprn.m,v
retrieving revision 1.15
diff -u -r1.15 rl_exprn.m
--- compiler/rl_exprn.m 2000/04/14 08:38:22 1.15
+++ compiler/rl_exprn.m 2000/07/18 08:02:41
@@ -853,7 +853,7 @@
{ Code = tree(SwitchCode, node([rl_PROC_label(EndSwitch)])) }.
rl_exprn__goal(generic_call(_, _, _, _) - _, _, _) -->
{ error("rl_exprn__goal: higher-order and class-method calls not yet implemented") }.
-rl_exprn__goal(pragma_c_code(_, _, _, _, _, _, _) - _, _, _) -->
+rl_exprn__goal(pragma_foreign_code(_, _, _, _, _, _, _, _) - _, _, _) -->
{ error("rl_exprn__goal: pragma_c_code not yet implemented") }.
rl_exprn__goal(some(_, _, Goal) - _, Fail, Code) -->
rl_exprn__goal(Goal, Fail, Code).
Index: compiler/saved_vars.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/saved_vars.m,v
retrieving revision 1.23
diff -u -r1.23 saved_vars.m
--- compiler/saved_vars.m 2000/03/28 03:40:32 1.23
+++ compiler/saved_vars.m 2000/07/18 08:02:41
@@ -134,7 +134,7 @@
Goal = GoalExpr0 - GoalInfo0,
SlotInfo = SlotInfo0
;
- GoalExpr0 = pragma_c_code(_, _, _, _, _, _, _),
+ GoalExpr0 = pragma_foreign_code(_, _, _, _, _, _, _, _),
Goal = GoalExpr0 - GoalInfo0,
SlotInfo = SlotInfo0
;
@@ -293,7 +293,7 @@
IsNonLocal, SlotInfo1, Goals1, SlotInfo),
Goals = [NewConstruct, Goal1 | Goals1]
;
- Goal0Expr = pragma_c_code(_, _, _, _, _, _, _),
+ Goal0Expr = pragma_foreign_code(_, _, _, _, _, _, _, _),
rename_var(SlotInfo0, Var, _NewVar, Subst, SlotInfo1),
goal_util__rename_vars_in_goal(Construct, Subst,
NewConstruct),
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.77
diff -u -r1.77 simplify.m
--- compiler/simplify.m 2000/04/05 06:28:28 1.77
+++ compiler/simplify.m 2000/07/18 08:02:41
@@ -694,7 +694,7 @@
% Don't warn about directly recursive calls.
% (That would cause spurious warnings, particularly
% with builtin predicates, or preds defined using
- % pragma c_code.)
+ % pragma foreign.)
%
simplify_info_get_det_info(Info0, DetInfo0),
det_info_get_pred_id(DetInfo0, ThisPredId),
@@ -1095,7 +1095,7 @@
).
simplify__goal_2(Goal0, GoalInfo, Goal, GoalInfo, Info0, Info) :-
- Goal0 = pragma_c_code(_, PredId, ProcId, Args, _, _, _),
+ Goal0 = pragma_foreign_code(_, _, PredId, ProcId, Args, _, _, _),
(
simplify_do_calls(Info0),
goal_info_is_pure(GoalInfo)
@@ -2171,7 +2171,7 @@
Goal = GoalExpr - _,
GoalExpr \= call(_, _, _, _, _, _),
GoalExpr \= generic_call(_, _, _, _),
- GoalExpr \= pragma_c_code(_, _, _, _, _, _, _)
+ GoalExpr \= pragma_foreign_code(_, _, _, _, _, _, _, _)
)
->
simplify_info_get_common_info(Info0, CommonInfo0),
Index: compiler/store_alloc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/store_alloc.m,v
retrieving revision 1.70
diff -u -r1.70 store_alloc.m
--- compiler/store_alloc.m 1999/10/25 03:49:41 1.70
+++ compiler/store_alloc.m 2000/07/18 08:02:41
@@ -203,8 +203,8 @@
store_alloc_in_goal_2(unify(A,B,C,D,E), Liveness, _, _,
_, unify(A,B,C,D,E), Liveness).
-store_alloc_in_goal_2(pragma_c_code(A, B, C, D, E, F, G), Liveness, _, _,
- _, pragma_c_code(A, B, C, D, E, F, G), Liveness).
+store_alloc_in_goal_2(pragma_foreign_code(A, B, C, D, E, F, G, H), Liveness,
+ _, _, _, pragma_foreign_code(A, B, C, D, E, F, G, H), Liveness).
store_alloc_in_goal_2(bi_implication(_, _), _, _, _, _, _, _) :-
% these should have been expanded out by now
Index: compiler/stratify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/stratify.m,v
retrieving revision 1.21
diff -u -r1.21 stratify.m
--- compiler/stratify.m 1999/10/25 03:49:42 1.21
+++ compiler/stratify.m 2000/07/18 08:02:41
@@ -178,7 +178,8 @@
WholeScc, ThisPredProcId, Error, Module0, Module) -->
first_order_check_goal(Goal, GoalInfo, yes, WholeScc, ThisPredProcId,
Error, Module0, Module).
-first_order_check_goal(pragma_c_code(_IsRec, CPred, CProc, _, _, _, _),
+first_order_check_goal(pragma_foreign_code(_Language, _Attributes, CPred,
+ CProc, _, _, _, _),
GoalInfo, Negated, WholeScc, ThisPredProcId,
Error, Module0, Module) -->
(
@@ -334,8 +335,8 @@
ThisPredProcId, HighOrderLoops, Error, Module0, Module) -->
higher_order_check_goal(Goal, GoalInfo, yes, WholeScc, ThisPredProcId,
HighOrderLoops, Error, Module0, Module).
-higher_order_check_goal(pragma_c_code(_IsRec, _, _, _, _, _, _), _GoalInfo,
- _Negated, _WholeScc, _ThisPredProcId, _HighOrderLoops,
+higher_order_check_goal(pragma_foreign_code(_, _IsRec, _, _, _, _, _, _),
+ _GoalInfo, _Negated, _WholeScc, _ThisPredProcId, _HighOrderLoops,
_, Module, Module) --> [].
higher_order_check_goal(unify(_Var, _RHS, _Mode, _Uni, _Context), _GoalInfo,
_Negated, _WholeScc, _ThisPredProcId, _HighOrderLoops,
@@ -821,8 +822,8 @@
CallsHO) :-
check_goal1(Goal, Calls0, Calls, HasAT0, HasAT, CallsHO0, CallsHO).
-check_goal1(pragma_c_code(_IsRec, _CPred, _CProc, _, _, _, _), Calls, Calls,
- HasAT, HasAT, CallsHO, CallsHO).
+check_goal1(pragma_foreign_code(_Lang, _Attrib, _CPred, _CProc, _, _, _, _),
+ Calls, Calls, HasAT, HasAT, CallsHO, CallsHO).
check_goal1(bi_implication(_, _), _, _, _, _, _, _) :-
% these should have been expanded out by now
@@ -912,8 +913,8 @@
get_called_procs(Goal, Calls0, Calls).
get_called_procs(not(Goal - _GoalInfo), Calls0, Calls) :-
get_called_procs(Goal, Calls0, Calls).
-get_called_procs(pragma_c_code(_IsRec, _CPred, _CProc, _, _, _, _),
- Calls, Calls).
+get_called_procs(pragma_foreign_code(_Lang, _Attrib, _CPred, _CProc,
+ _, _, _, _), Calls, Calls).
get_called_procs(bi_implication(_, _), _, _) :-
% these should have been expanded out by now
error("get_called_procs: unexpected bi_implication").
Index: compiler/switch_detection.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/switch_detection.m,v
retrieving revision 1.89
diff -u -r1.89 switch_detection.m
--- compiler/switch_detection.m 2000/07/25 09:27:25 1.89
+++ compiler/switch_detection.m 2000/07/30 13:55:39
@@ -216,8 +216,8 @@
VarTypes, ModuleInfo, switch(Var, CanFail, Cases, SM)) :-
detect_switches_in_cases(Cases0, InstMap, VarTypes, ModuleInfo, Cases).
-detect_switches_in_goal_2(pragma_c_code(A,B,C,D,E,F,G), _, _, _, _,
- pragma_c_code(A,B,C,D,E,F,G)).
+detect_switches_in_goal_2(pragma_foreign_code(A,B,C,D,E,F,G,H), _, _, _, _,
+ pragma_foreign_code(A,B,C,D,E,F,G,H)).
detect_switches_in_goal_2(bi_implication(_, _), _, _, _, _, _) :-
% these should have been expanded out by now
error("detect_switches_in_goal_2: unexpected bi_implication").
Index: compiler/term_errors.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/term_errors.m,v
retrieving revision 1.15
diff -u -r1.15 term_errors.m
--- compiler/term_errors.m 1999/06/16 00:38:18 1.15
+++ compiler/term_errors.m 2000/07/18 08:02:41
@@ -21,10 +21,10 @@
:- import_module io, bag, std_util, list, assoc_list.
:- type termination_error
- ---> pragma_c_code
+ ---> pragma_foreign_code
% The analysis result depends on the change constant
- % of a piece of pragma C code, (which cannot be
- % obtained without analyzing the C code, which is
+ % of a piece of pragma foreign code, (which cannot be
+ % obtained without analyzing the foreign code, which is
% something we cannot do).
% Valid in both passes.
@@ -135,7 +135,7 @@
:- import_module bool, int, string, map, bag, require.
indirect_error(horder_call).
-indirect_error(pragma_c_code).
+indirect_error(pragma_foreign_code).
indirect_error(imported_pred).
indirect_error(can_loop_proc_called(_, _)).
indirect_error(horder_args(_, _)).
@@ -260,10 +260,12 @@
term_errors__description(horder_call, _, _, Pieces, no) :-
Pieces = [words("It contains a higher order call.")].
-term_errors__description(pragma_c_code, _, _, Pieces, no) :-
+term_errors__description(pragma_foreign_code, _, _, Pieces, no) :-
Pieces = [words("It depends on the properties of"),
words("foreign language code included via a"),
fixed("`:- pragma c_code'"),
+ words("or"),
+ fixed("`:- pragma foreign'"),
words("declaration.")].
term_errors__description(inf_call(CallerPPId, CalleePPId),
Index: compiler/term_traversal.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/term_traversal.m,v
retrieving revision 1.12
diff -u -r1.12 term_traversal.m
--- compiler/term_traversal.m 1999/10/25 03:49:44 1.12
+++ compiler/term_traversal.m 2000/07/18 08:02:41
@@ -183,7 +183,7 @@
traverse_goal(Else, Params, Info0, Info2),
combine_paths(Info1, Info2, Params, Info).
-traverse_goal_2(pragma_c_code(_, CallPredId, CallProcId, Args, _, _, _),
+traverse_goal_2(pragma_foreign_code(_,_, CallPredId, CallProcId, Args, _,_,_),
GoalInfo, Params, Info0, Info) :-
params_get_module_info(Params, Module),
module_info_pred_proc_info(Module, CallPredId, CallProcId, _,
@@ -191,7 +191,7 @@
proc_info_argmodes(CallProcInfo, CallArgModes),
partition_call_args(Module, CallArgModes, Args, _InVars, OutVars),
goal_info_get_context(GoalInfo, Context),
- error_if_intersect(OutVars, Context, pragma_c_code, Info0, Info).
+ error_if_intersect(OutVars, Context, pragma_foreign_code, Info0, Info).
traverse_goal_2(generic_call(_, _, _, _), GoalInfo, Params, Info0, Info) :-
%
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.277
diff -u -r1.277 typecheck.m
--- compiler/typecheck.m 2000/06/06 05:45:23 1.277
+++ compiler/typecheck.m 2000/07/18 08:02:41
@@ -1014,9 +1014,9 @@
typecheck_unification(A, B0, B).
typecheck_goal_2(switch(_, _, _, _), _) -->
{ error("unexpected switch") }.
-typecheck_goal_2(pragma_c_code(A, PredId, C, Args, E, F, G),
- pragma_c_code(A, PredId, C, Args, E, F, G)) -->
- % pragma_c_codes are automatically generated, so they
+typecheck_goal_2(pragma_foreign_code(A, B, PredId, D, Args, F, G, H),
+ pragma_foreign_code(A, B, PredId, D, Args, F, G, H)) -->
+ % pragma_foreign_codes are automatically generated, so they
% will always be type-correct, but we need to do
% the type analysis in order to correctly compute the
% HeadTypeParams that result from existentially typed pragma_c_codes.
Index: compiler/unique_modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unique_modes.m,v
retrieving revision 1.61
diff -u -r1.61 unique_modes.m
--- compiler/unique_modes.m 2000/04/14 08:38:32 1.61
+++ compiler/unique_modes.m 2000/07/18 08:02:41
@@ -508,15 +508,15 @@
% to modecheck a pragma_c_code, we just modecheck the proc for
% which it is the goal.
-unique_modes__check_goal_2(pragma_c_code(IsRecursive, PredId, ProcId0,
- Args, ArgNameMap, OrigArgTypes, PragmaCode),
+unique_modes__check_goal_2(pragma_foreign_code(Language, Attributes,
+ PredId, ProcId0, Args, ArgNameMap, OrigArgTypes, PragmaCode),
_GoalInfo, Goal) -->
mode_checkpoint(enter, "pragma_c_code"),
=(ModeInfo),
{ mode_info_get_call_id(ModeInfo, PredId, CallId) },
mode_info_set_call_context(call(call(CallId))),
unique_modes__check_call(PredId, ProcId0, Args, ProcId),
- { Goal = pragma_c_code(IsRecursive, PredId, ProcId, Args,
+ { Goal = pragma_foreign_code(Language, Attributes, PredId, ProcId, Args,
ArgNameMap, OrigArgTypes, PragmaCode) },
mode_info_unset_call_context,
mode_checkpoint(exit, "pragma_c_code").
Index: compiler/unneeded_code.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unneeded_code.m,v
retrieving revision 1.1
diff -u -r1.1 unneeded_code.m
--- compiler/unneeded_code.m 2000/07/25 09:27:28 1.1
+++ compiler/unneeded_code.m 2000/07/31 03:22:43
@@ -613,7 +613,7 @@
RefinedGoals = RefinedGoals0,
Changed = Changed0
;
- GoalExpr0 = pragma_c_code(_, _, _, _, _, _, _),
+ GoalExpr0 = pragma_foreign_code(_, _, _, _, _, _, _, _),
Goal = Goal0,
unneeded_code__demand_inputs(Goal, ModuleInfo, InstMap0,
everywhere, WhereNeededMap0, WhereNeededMap),
@@ -958,7 +958,7 @@
Goal = Goal0,
RefinedGoals = RefinedGoals0
;
- GoalExpr0 = pragma_c_code(_, _, _, _, _, _, _),
+ GoalExpr0 = pragma_foreign_code(_, _, _, _, _, _, _, _),
Goal = Goal0,
RefinedGoals = RefinedGoals0
;
Index: compiler/unused_args.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unused_args.m,v
retrieving revision 1.63
diff -u -r1.63 unused_args.m
--- compiler/unused_args.m 2000/07/25 09:27:28 1.63
+++ compiler/unused_args.m 2000/07/30 13:55:42
@@ -435,9 +435,10 @@
set_list_vars_used(UseInf0, CallArgs, UseInf1),
set_list_vars_used(UseInf1, Args, UseInf).
-% handle pragma c_code(...) -
+% handle pragma foreign(...) -
% only those arguments which have C names can be used in the C code.
-traverse_goal(_, pragma_c_code(_, _, _, Args, Names, _, _), UseInf0, UseInf) :-
+traverse_goal(_, pragma_foreign_code(_, _, _, _, Args, Names, _, _),
+ UseInf0, UseInf) :-
assoc_list__from_corresponding_lists(Args, Names, ArgsAndNames),
ArgIsUsed = lambda([ArgAndName::in, Arg::out] is semidet, (
ArgAndName = Arg - MaybeName,
@@ -1267,7 +1268,7 @@
fixup_goal_expr(_ModuleInfo, _UnusedVars, _ProcCallInfo, no,
GoalExpr - GoalInfo, GoalExpr - GoalInfo) :-
- GoalExpr = pragma_c_code(_, _, _, _, _, _, _).
+ GoalExpr = pragma_foreign_code(_, _, _, _, _, _, _, _).
fixup_goal_expr(_, _, _, _, bi_implication(_, _) - _, _) :-
% these should have been expanded out by now
--
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-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