[m-rev.] EDCG diff 2
Peter Nicholas MALKIN
pnmalk at students.cs.mu.oz.au
Thu Mar 15 19:24:11 AEDT 2001
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.93
diff -u -r1.93 hlds_pred.m
--- compiler/hlds_pred.m 2001/03/05 10:31:02 1.93
+++ compiler/hlds_pred.m 2001/03/14 06:02:21
@@ -88,6 +88,16 @@
:- type proc_table == map(proc_id, proc_info).
+:- type pred_edcg_info
+ ---> pred_edcg_info(
+ edcg_forms, % declared edcg forms
+ edcg_forms, % inferred edcg forms
+ bool % does the predicate need to be
+ % transformed for EDCGs i.e. does it
+ % have declared or inferred edcgs or
+ % does it contain EDCG goals.
+ ).
+
:- type call_id
---> call(simple_call_id)
; generic_call(generic_call_id)
@@ -220,6 +230,7 @@
% it applies to all
% clauses)
hlds_goal, % Body
+ maybe_edcg, % If this an EDCG clause
prog_context
).
@@ -527,6 +538,7 @@
% Various predicates for accessing the information stored in the
% pred_id and pred_info data structures.
+ % Initialise without edcg arguments
:- pred pred_info_init(module_name, sym_name, arity, tvarset, existq_tvars,
list(type), condition, prog_context, clauses_info, import_status,
pred_markers, goal_type, pred_or_func, class_constraints,
@@ -534,6 +546,15 @@
:- mode pred_info_init(in, in, in, in, in, in, in, in, in, in, in, in, in,
in, in, in, out) is det.
+ % Initialise with edcg arguments
+:- pred pred_info_init(module_name, sym_name, arity, arity, tvarset,
+ existq_tvars, list(type), edcg_forms, condition, prog_context,
+ clauses_info, import_status, pred_markers, goal_type, pred_or_func,
+ class_constraints, constraint_proof_map, aditi_owner, pred_info).
+:- mode pred_info_init(in, in, in, in, in, in, in, in, in, in, in, in, in,
+ in, in, in, in, in, out) is det.
+
+ % Create without edcg arguments
:- pred pred_info_create(module_name, sym_name, tvarset, existq_tvars,
list(type), condition, prog_context, import_status, pred_markers,
pred_or_func, class_constraints, aditi_owner, set(assert_id),
@@ -541,17 +562,33 @@
:- mode pred_info_create(in, in, in, in, in, in, in, in, in, in, in, in, in,
in, out, out) is det.
+ % Create with edcg arguments
+:- pred pred_info_create(module_name, sym_name, tvarset, existq_tvars,
+ list(type), edcg_forms, condition, prog_context, import_status,
+ pred_markers, pred_or_func, class_constraints, aditi_owner,
+ set(assert_id), proc_info, proc_id, pred_info).
+:- mode pred_info_create(in, in, in, in, in, in, in, in, in, in, in, in, in,
+ in, in, out, out) is det.
+
:- pred pred_info_module(pred_info, module_name).
:- mode pred_info_module(in, out) is det.
:- pred pred_info_name(pred_info, string).
:- mode pred_info_name(in, out) is det.
- % pred_info_arity returns the arity of the predicate
+ % pred_info_arity returns the total arity of the predicate
% *not* counting inserted type_info arguments for polymorphic preds.
:- pred pred_info_arity(pred_info, arity).
:- mode pred_info_arity(in, out) is det.
+:- pred pred_info_set_arity(pred_info, arity, pred_info).
+:- mode pred_info_set_arity(in, in, out) is det.
+
+ % pred_info_visual_arity returns the visual arity of the predicate
+ % *not* counting inserted type_info arguments for polymorphic preds.
+:- pred pred_info_visual_arity(pred_info, arity).
+:- mode pred_info_visual_arity(in, out) is det.
+
% Return a list of all the proc_ids for the valid modes
% of this predicate. This does not include candidate modes
% that were generated during mode inference but which mode
@@ -596,6 +633,12 @@
:- pred pred_info_get_univ_quant_tvars(pred_info, existq_tvars).
:- mode pred_info_get_univ_quant_tvars(in, out) is det.
+:- pred pred_info_edcg_args(pred_info, pred_edcg_info).
+:- mode pred_info_edcg_args(in, out) is det.
+
+:- pred pred_info_set_edcg_args(pred_info, pred_edcg_info, pred_info).
+:- mode pred_info_set_edcg_args(in, in, out) is det.
+
:- type head_type_params == list(tvar).
:- pred pred_info_get_head_type_params(pred_info, head_type_params).
@@ -773,6 +816,30 @@
:- pred marker_list_to_markers(list(marker), pred_markers).
:- mode marker_list_to_markers(in, out) is det.
+ % Set the pred_info pred_hidden_info flag to yes indicating that this
+ % predicate needs an EDGC transform.
+:- pred pred_info_set_needs_edcg_transform(pred_info, pred_info).
+:- mode pred_info_set_needs_edcg_transform(in, out) is det.
+
+ % Set the pred_info pred_hidden_info flag to yes indicating that this
+ % predicate needs an EDGC transform if it has declared edcg arguments.
+:- pred pred_info_needs_edcg_transform(pred_info, pred_info).
+:- mode pred_info_needs_edcg_transform(in, out) is det.
+
+ % Set the pred_info pred_hidden_info flag to yes indicating that this
+ % predicate needs an EDGC transform if it has a clause with functor
+ % `-->>'
+:- pred pred_info_needs_edcg_transform(pred_info, maybe_edcg, pred_info).
+:- mode pred_info_needs_edcg_transform(in, in, out) is det.
+
+ % Used for predicate calls. Set the pred_info pred_hidden_info flag to
+ % yes indicating that this predicate needs an EDGC transform if the
+ % called predicate has declared edcg arguments or the call has explicit
+ % edcg arguments.
+:- pred pred_info_needs_edcg_transform(pred_info, pred_info, pred_info,
+ edcgs).
+:- mode pred_info_needs_edcg_transform(in, out, in, in) is det.
+
%-----------------------------------------------------------------------------%
:- implementation.
@@ -837,6 +904,7 @@
% names of type vars
% in the predicate's type decl
arg_types :: list(type),
+ edcg_info :: pred_edcg_info,
% argument types
condition :: condition,
% formal specification
@@ -855,9 +923,11 @@
name :: string,
% predicate name
arity :: arity,
- % the arity of the pred
+ % the total arity of the pred
% (*not* counting any inserted
% type_info arguments)
+ visual_arity ::arity,
+ % the visual arity of the pred
import_status :: import_status,
typevarset :: tvarset,
% names of type vars
@@ -932,6 +1002,16 @@
pred_info_init(ModuleName, SymName, Arity, TypeVarSet, ExistQVars, Types,
Cond, Context, ClausesInfo, Status, Markers, GoalType,
PredOrFunc, ClassContext, ClassProofs, User, PredInfo) :-
+ EDCGForms = [],
+ pred_info_init(ModuleName, SymName, Arity, Arity, TypeVarSet,
+ ExistQVars, Types, EDCGForms, Cond, Context, ClausesInfo,
+ Status, Markers, GoalType, PredOrFunc, ClassContext,
+ ClassProofs, User, PredInfo).
+
+pred_info_init(ModuleName, SymName, TotalArity, VisualArity, TypeVarSet,
+ ExistQVars, Types, EDCGForms, Cond, Context, ClausesInfo,
+ Status, Markers, GoalType, PredOrFunc, ClassContext,
+ ClassProofs, User, PredInfo) :-
map__init(Procs),
unqualify_name(SymName, PredName),
sym_name_get_module_name(SymName, ModuleName, PredModuleName),
@@ -941,15 +1021,25 @@
Indexes = [],
set__init(Assertions),
MaybeInstanceConstraints = no,
- PredInfo = predicate(TypeVarSet, Types, Cond, ClausesInfo, Procs,
- Context, PredModuleName, PredName, Arity, Status, TypeVarSet,
- GoalType, Markers, PredOrFunc, ClassContext, ClassProofs,
- ExistQVars, HeadTypeParams, UnprovenBodyConstraints, User,
- Indexes, Assertions, MaybeInstanceConstraints).
+ PredEDCGInfo = pred_edcg_info(EDCGForms, [], no),
+ PredInfo = predicate(TypeVarSet, Types, PredEDCGInfo, Cond, ClausesInfo,
+ Procs, Context, PredModuleName, PredName, TotalArity,
+ VisualArity, Status, TypeVarSet, GoalType, Markers, PredOrFunc,
+ ClassContext, ClassProofs, ExistQVars, HeadTypeParams,
+ UnprovenBodyConstraints, User, Indexes, Assertions,
+ MaybeInstanceConstraints).
pred_info_create(ModuleName, SymName, TypeVarSet, ExistQVars, Types, Cond,
Context, Status, Markers, PredOrFunc, ClassContext, User,
Assertions, ProcInfo, ProcId, PredInfo) :-
+ EDCGForms = [],
+ pred_info_create(ModuleName, SymName, TypeVarSet, ExistQVars, Types,
+ EDCGForms, Cond, Context, Status, Markers, PredOrFunc,
+ ClassContext, User, Assertions, ProcInfo, ProcId, PredInfo).
+
+pred_info_create(ModuleName, SymName, TypeVarSet, ExistQVars, Types,
+ EDCGForms, Cond, Context, Status, Markers, PredOrFunc,
+ ClassContext, User, Assertions, ProcInfo, ProcId, PredInfo) :-
map__init(Procs0),
proc_info_declared_determinism(ProcInfo, MaybeDetism),
next_mode_id(Procs0, MaybeDetism, ProcId),
@@ -972,8 +1062,9 @@
UnprovenBodyConstraints = [],
Indexes = [],
MaybeInstanceConstraints = no,
- PredInfo = predicate(TypeVarSet, Types, Cond, ClausesInfo, Procs,
- Context, ModuleName, PredName, Arity, Status, TypeVarSet,
+ EDCGs = pred_edcg_info(EDCGForms, [], no),
+ PredInfo = predicate(TypeVarSet, Types, EDCGs, Cond, ClausesInfo, Procs,
+ Context, ModuleName, PredName, Arity, Arity, Status, TypeVarSet,
clauses, Markers, PredOrFunc, ClassContext, ClassProofs,
ExistQVars, HeadTypeParams, UnprovenBodyConstraints, User,
Indexes, Assertions, MaybeInstanceConstraints).
@@ -1053,6 +1144,11 @@
^exist_quant_tvars := ExistQVars)
^arg_types := ArgTypes.
+pred_info_edcg_args(PredInfo, PredInfo^edcg_info).
+
+pred_info_set_edcg_args(PredInfo, EDCGArgs,
+ PredInfo^edcg_info := EDCGArgs).
+
pred_info_procedures(PredInfo, PredInfo^procedures).
pred_info_set_procedures(PredInfo, X, PredInfo^procedures := X).
@@ -1065,6 +1161,10 @@
pred_info_arity(PredInfo, PredInfo^arity).
+pred_info_set_arity(PredInfo, Arity, PredInfo^arity := Arity).
+
+pred_info_visual_arity(PredInfo, PredInfo^visual_arity).
+
pred_info_import_status(PredInfo, PredInfo^import_status).
pred_info_is_imported(PredInfo) :-
@@ -1242,6 +1342,42 @@
%-----------------------------------------------------------------------------%
+pred_info_set_needs_edcg_transform(PredInfo0, PredInfo) :-
+ pred_info_edcg_args(PredInfo0,
+ pred_edcg_info(Declared, Inferred, _)),
+ pred_info_set_edcg_args(PredInfo0,
+ pred_edcg_info(Declared, Inferred, yes), PredInfo).
+
+pred_info_needs_edcg_transform(PredInfo0, PredInfo) :-
+ pred_info_edcg_args(PredInfo0,
+ pred_edcg_info(DeclaredForms, _, _)),
+ (
+ DeclaredForms = [],
+ PredInfo = PredInfo0
+ ;
+ DeclaredForms = [_|_],
+ pred_info_set_needs_edcg_transform(PredInfo0, PredInfo)
+ ).
+
+pred_info_needs_edcg_transform(PredInfo, edcg_no, PredInfo).
+pred_info_needs_edcg_transform(PredInfo, edcg_fact, PredInfo).
+pred_info_needs_edcg_transform(PredInfo0, edcg_yes, PredInfo) :-
+ pred_info_set_needs_edcg_transform(PredInfo0, PredInfo).
+
+pred_info_needs_edcg_transform(PredInfo0, PredInfo, CalleePredInfo, EDCGArgs) :-
+ pred_info_edcg_args(CalleePredInfo,
+ pred_edcg_info(CalleeDeclared, _, _)),
+ % Perform an edcg transformation on this predicate if this call
+ % either has explicit edcg arguments or it has declared edcg
+ % arguments
+ ( ( EDCGArgs = [_|_] ; CalleeDeclared = [_|_] ) ->
+ pred_info_set_needs_edcg_transform(PredInfo0, PredInfo)
+ ;
+ PredInfo = PredInfo0
+ ).
+
+%-----------------------------------------------------------------------------%
+
clauses_info_varset(CI, CI^varset).
clauses_info_explicit_vartypes(CI, CI^explicit_vartypes).
clauses_info_vartypes(CI, CI^vartypes).
@@ -1332,7 +1468,7 @@
module_info_set_predicate_table(ModuleInfo0, PredTable,
ModuleInfo),
- GoalExpr = call(PredId, ProcId, ArgVars, not_builtin, no, SymName),
+ GoalExpr = call(PredId, ProcId, ArgVars, [], not_builtin, no, SymName),
Goal = GoalExpr - GoalInfo,
PredProcId = proc(PredId, ProcId).
@@ -2213,6 +2349,13 @@
:- pred make_n_fresh_vars(string, int, varset(T), list(var(T)), varset(T)).
:- mode make_n_fresh_vars(in, in, in, out, out) is det.
+ % make_n_fresh_vars(Name, N, M, VarSet0, Vars, VarSet):
+ % This is similar to make_n_fresh_vars/5 except that
+ % It make M - N vars with suffixes (N+1) to M.
+:- pred make_n_fresh_vars(string, int, int, varset(T), list(var(T)),
+ varset(T)).
+:- mode make_n_fresh_vars(in, in, in, in, out, out) is det.
+
% given the list of predicate arguments for a predicate that
% is really a function, split that list into the function arguments
% and the function return type.
@@ -2241,13 +2384,9 @@
:- implementation.
make_n_fresh_vars(BaseName, N, VarSet0, Vars, VarSet) :-
- make_n_fresh_vars_2(BaseName, 0, N, VarSet0, Vars, VarSet).
-
-:- pred make_n_fresh_vars_2(string, int, int, varset(T), list(var(T)),
- varset(T)).
-:- mode make_n_fresh_vars_2(in, in, in, in, out, out) is det.
+ make_n_fresh_vars(BaseName, 0, N, VarSet0, Vars, VarSet).
-make_n_fresh_vars_2(BaseName, N, Max, VarSet0, Vars, VarSet) :-
+make_n_fresh_vars(BaseName, N, Max, VarSet0, Vars, VarSet) :-
(N = Max ->
VarSet = VarSet0,
Vars = []
@@ -2258,7 +2397,7 @@
string__append(BaseName, Num, VarName),
varset__name_var(VarSet1, Var, VarName, VarSet2),
Vars = [Var | Vars1],
- make_n_fresh_vars_2(BaseName, N1, Max, VarSet2, Vars1, VarSet)
+ make_n_fresh_vars(BaseName, N1, Max, VarSet2, Vars1, VarSet)
).
pred_args_to_func_args(PredArgs, FuncArgs, FuncReturn) :-
Index: compiler/inlining.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/inlining.m,v
retrieving revision 1.97
diff -u -r1.97 inlining.m
--- compiler/inlining.m 2001/01/11 07:37:12 1.97
+++ compiler/inlining.m 2001/03/12 15:35:46
@@ -303,7 +303,7 @@
(
Size < SimpleThreshold
;
- Clauses = [clause(_, Goal, _)],
+ Clauses = [clause(_, Goal, _, _)],
Size < SimpleThreshold * 3,
%
% For flat goals, we are more likely to be able to
@@ -337,7 +337,7 @@
inlining__is_flat_simple_goal(Goal).
inlining__is_flat_simple_goal(some(_, _, Goal) - _) :-
inlining__is_flat_simple_goal(Goal).
-inlining__is_flat_simple_goal(call(_, _, _, BuiltinState, _, _) - _) :-
+inlining__is_flat_simple_goal(call(_, _, _, _, BuiltinState, _, _) - _) :-
BuiltinState = inline_builtin.
inlining__is_flat_simple_goal(unify(_, _, _, _, _) - _).
@@ -521,7 +521,7 @@
some(Vars, CanRemove, Goal) - GoalInfo) -->
inlining__inlining_in_goal(Goal0, Goal).
-inlining__inlining_in_goal(call(PredId, ProcId, ArgVars, Builtin, Context,
+inlining__inlining_in_goal(call(PredId, ProcId, ArgVars, D, Builtin, Context,
Sym) - GoalInfo0, Goal - GoalInfo, InlineInfo0, InlineInfo) :-
InlineInfo0 = inline_info(VarThresh, HighLevelCode,
@@ -576,7 +576,7 @@
DetChanged = yes
)
;
- Goal = call(PredId, ProcId, ArgVars, Builtin, Context, Sym),
+ Goal = call(PredId, ProcId, ArgVars, D, Builtin, Context, Sym),
GoalInfo = GoalInfo0,
VarSet = VarSet0,
VarTypes = VarTypes0,
@@ -604,6 +604,10 @@
inlining__inlining_in_goal(bi_implication(_, _) - _, _) -->
% these should have been expanded out by now
{ error("inlining__inlining_in_goal: unexpected bi_implication") }.
+
+inlining__inlining_in_goal(edcg_goal(_, _, _) - _, _) -->
+ % these should have been expanded out by now
+ { error("inlining__inlining_in_goal: unexpected edcg_goal") }.
%-----------------------------------------------------------------------------%
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.94
diff -u -r1.94 intermod.m
--- compiler/intermod.m 2001/03/07 02:46:50 1.94
+++ compiler/intermod.m 2001/03/12 15:35:47
@@ -358,8 +358,8 @@
bool::out, intermod_info::in, intermod_info::out) is det.
intermod__traverse_clauses([], [], yes) --> [].
-intermod__traverse_clauses([clause(P, Goal0, C) | Clauses0],
- [clause(P, Goal, C) | Clauses], DoWrite) -->
+intermod__traverse_clauses([clause(P, Goal0, C, D) | Clauses0],
+ [clause(P, Goal, C, D) | Clauses], DoWrite) -->
intermod__traverse_goal(Goal0, Goal, DoWrite1),
( { DoWrite1 = yes } ->
intermod__traverse_clauses(Clauses0, Clauses, DoWrite)
@@ -397,14 +397,14 @@
clause_list_is_deforestable(PredId, Clauses) :-
some [Clause1] (
list__member(Clause1, Clauses),
- Clause1 = clause(_, Goal1, _),
+ Clause1 = clause(_, Goal1, _, _),
goal_calls_pred_id(Goal1, PredId)
),
(
Clauses = [_, _ | _]
;
Clauses = [Clause2],
- Clause2 = clause(_, Goal2, _),
+ Clause2 = clause(_, Goal2, _, _),
goal_to_conj_list(Goal2, GoalList),
goal_contains_one_branched_goal(GoalList)
).
@@ -447,8 +447,8 @@
intermod__traverse_list_of_goals(Goals0, Goals, DoWrite).
intermod__traverse_goal(
- call(PredId0, B, Args, D, MaybeUnifyContext, PredName0) - Info,
- call(PredId, B, Args, D, MaybeUnifyContext, PredName) - Info, DoWrite)
+ call(PredId0, B, Args, D, E, MaybeUnifyContext, PredName0) - Info,
+ call(PredId, B, Args, D, E, MaybeUnifyContext, PredName) - Info, DoWrite)
-->
%
% Fully module-qualify the pred name
@@ -510,6 +510,10 @@
% these should have been expanded out by now
{ error("intermod__traverse_goal: unexpected bi_implication") }.
+intermod__traverse_goal(edcg_goal(_, _, _) - _, _, _) -->
+ % these should have been expanded out by now
+ { error("intermod__traverse_goal: unexpected edcg_goal") }.
+
:- pred intermod__traverse_list_of_goals(hlds_goals::in, hlds_goals::out,
bool::out, intermod_info::in, intermod_info::out) is det.
@@ -822,6 +826,12 @@
{ DoWrite = yes }
).
+intermod__module_qualify_unify_rhs(_, edcg_op(_, _), _, _) -->
+ % these should have been expanded out by now
+ { error("intermod__module_qualify_unify_rhs: unexpected edcg_op") }.
+
+
+
%-----------------------------------------------------------------------------%
:- pred intermod__gather_instances(intermod_info::in,
@@ -1541,8 +1551,8 @@
:- pred strip_headvar_unifications(list(prog_var)::in,
clause::in, list(prog_term)::out, clause::out) is det.
-strip_headvar_unifications(HeadVars, clause(ProcIds, Goal0, Context),
- HeadTerms, clause(ProcIds, Goal, Context)) :-
+strip_headvar_unifications(HeadVars, clause(ProcIds, Goal0, MaybeEDCG, Context),
+ HeadTerms, clause(ProcIds, Goal, MaybeEDCG, Context)) :-
Goal0 = _ - GoalInfo0,
goal_to_conj_list(Goal0, Goals0),
map__init(HeadVarMap0),
@@ -1713,7 +1723,7 @@
intermod__write_foreign_code(_, _, _, _, [], _) --> [].
intermod__write_foreign_code(SymName, PredOrFunc, HeadVars, Varset,
[Clause | Clauses], Procs) -->
- { Clause = clause(ProcIds, Goal, _) },
+ { Clause = clause(ProcIds, Goal, _, _) },
(
(
% Pull the foreign code out of the goal.
Index: compiler/lambda.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/lambda.m,v
retrieving revision 1.71
diff -u -r1.71 lambda.m
--- compiler/lambda.m 2001/02/01 06:43:40 1.71
+++ compiler/lambda.m 2001/03/12 15:35:47
@@ -273,8 +273,8 @@
lambda__process_goal_2(generic_call(A,B,C,D), GoalInfo,
generic_call(A,B,C,D) - GoalInfo) -->
[].
-lambda__process_goal_2(call(A,B,C,D,E,F), GoalInfo,
- call(A,B,C,D,E,F) - GoalInfo) -->
+lambda__process_goal_2(call(A,B,C,D,E,F,G), GoalInfo,
+ call(A,B,C,D,E,F,G) - GoalInfo) -->
[].
lambda__process_goal_2(pragma_foreign_code(A,B,C,D,E,F,G), GoalInfo,
pragma_foreign_code(A,B,C,D,E,F,G) - GoalInfo) -->
@@ -282,6 +282,9 @@
lambda__process_goal_2(bi_implication(_, _), _, _) -->
% these should have been expanded out by now
{ error("lambda__process_goal_2: unexpected bi_implication") }.
+lambda__process_goal_2(edcg_goal(_, _, _), _, _) -->
+ % these should have been expanded out by now
+ { error("lambda__process_goal_2: unexpected edcg_goal") }.
:- pred lambda__process_goal_list(list(hlds_goal), list(hlds_goal),
lambda_info, lambda_info).
@@ -378,7 +381,7 @@
% outputs. It's also not valid if any of the Xi are in the Yi.
LambdaGoal = call(PredId0, ProcId0, CallVars,
- _, _, PredName0) - _,
+ _, _, _, PredName0) - _,
module_info_pred_proc_info(ModuleInfo0, PredId0, ProcId0,
Call_PredInfo, Call_ProcInfo),
Index: compiler/lco.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/lco.m,v
retrieving revision 1.15
diff -u -r1.15 lco.m
--- compiler/lco.m 2000/11/17 17:47:32 1.15
+++ compiler/lco.m 2001/03/12 15:35:47
@@ -87,7 +87,7 @@
lco_in_goal_2(generic_call(A,B,C,D), _ModuleInfo, generic_call(A,B,C,D)).
-lco_in_goal_2(call(A,B,C,D,E,F), _ModuleInfo, call(A,B,C,D,E,F)).
+lco_in_goal_2(call(A,B,C,D,E,F,G), _ModuleInfo, call(A,B,C,D,E,F,G)).
lco_in_goal_2(unify(A,B,C,D,E), _ModuleInfo, unify(A,B,C,D,E)).
@@ -98,6 +98,10 @@
% these should have been expanded out by now
error("lco_in_goal_2: unexpected bi_implication").
+lco_in_goal_2(edcg_goal(_, _, _), _, _) :-
+ % these should have been expanded out by now
+ error("lco_in_goal_2: unexpected edcg_goal").
+
%-----------------------------------------------------------------------------%
:- pred lco_in_disj(list(hlds_goal), module_info, list(hlds_goal)).
@@ -153,7 +157,7 @@
Unifies1 = [Goal0 | Unifies0],
lco_in_conj(Goals0, Unifies1, ModuleInfo, Goals)
;
- GoalExpr0 = call(_, _, _, _, _, _)
+ GoalExpr0 = call(_, _, _, _, _, _, _)
->
list__append(Unifies0, [Goal0], LaterGoals),
list__reverse(Goals0, FrontGoals),
Index: compiler/live_vars.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/live_vars.m,v
retrieving revision 1.96
diff -u -r1.96 live_vars.m
--- compiler/live_vars.m 2000/12/06 06:05:06 1.96
+++ compiler/live_vars.m 2001/03/12 15:35:47
@@ -325,7 +325,7 @@
LiveSets0, OutVars, GoalInfo, AllocData, NondetLiveness,
LiveSets).
-build_live_sets_in_goal_2(call(PredId, ProcId, ArgVars, Builtin, _, _),
+build_live_sets_in_goal_2(call(PredId, ProcId, ArgVars, _, Builtin, _, _),
Liveness, NondetLiveness0, ResumeVars0, LiveSets0,
GoalInfo, AllocData, Liveness, NondetLiveness, LiveSets) :-
( Builtin = inline_builtin ->
@@ -385,6 +385,11 @@
:-
% these should have been expanded out by now
error("build_live_sets_in_goal_2: unexpected bi_implication").
+
+build_live_sets_in_goal_2(edcg_goal(_, _, _), _, _, _, _, _, _, _, _, _)
+ :-
+ % these should have been expanded out by now
+ error("build_live_sets_in_goal_2: unexpected edcg_goal").
%-----------------------------------------------------------------------------%
Index: compiler/liveness.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/liveness.m,v
retrieving revision 1.116
diff -u -r1.116 liveness.m
--- compiler/liveness.m 2001/03/02 02:05:55 1.116
+++ compiler/liveness.m 2001/03/12 15:35:47
@@ -390,7 +390,7 @@
detect_liveness_in_goal_2(generic_call(_,_,_,_), _, _, _, _, _) :-
error("higher-order-call in detect_liveness_in_goal_2").
-detect_liveness_in_goal_2(call(_,_,_,_,_,_), _, _, _, _, _) :-
+detect_liveness_in_goal_2(call(_,_,_,_,_,_,_), _, _, _, _, _) :-
error("call in detect_liveness_in_goal_2").
detect_liveness_in_goal_2(unify(_,_,_,_,_), _, _, _, _, _) :-
@@ -403,6 +403,9 @@
detect_liveness_in_goal_2(bi_implication(_, _), _, _, _, _, _) :-
error("bi_implication in detect_liveness_in_goal_2").
+detect_liveness_in_goal_2(edcg_goal(_, _, _), _, _, _, _, _) :-
+ error("edcg_goal in detect_liveness_in_goal_2").
+
%-----------------------------------------------------------------------------%
:- pred detect_liveness_in_conj(list(hlds_goal)::in, set(prog_var)::in,
@@ -628,7 +631,7 @@
detect_deadness_in_goal_2(generic_call(_,_,_,_), _, _, _, _, _, _) :-
error("higher-order-call in detect_deadness_in_goal_2").
-detect_deadness_in_goal_2(call(_,_,_,_,_,_), _, _, _, _, _, _) :-
+detect_deadness_in_goal_2(call(_,_,_,_,_,_,_), _, _, _, _, _, _) :-
error("call in detect_deadness_in_goal_2").
detect_deadness_in_goal_2(unify(_,_,_,_,_), _, _, _, _, _, _) :-
@@ -641,6 +644,9 @@
detect_deadness_in_goal_2(bi_implication(_, _), _, _, _, _, _, _) :-
error("bi_implication in detect_deadness_in_goal_2").
+detect_deadness_in_goal_2(edcg_goal(_, _, _), _, _, _, _, _, _) :-
+ error("edcg_goal in detect_deadness_in_goal_2").
+
%-----------------------------------------------------------------------------%
:- pred detect_deadness_in_conj(list(hlds_goal)::in,
@@ -837,7 +843,7 @@
:- pred update_liveness_expr(hlds_goal_expr::in, hlds_goal_info::in,
live_info::in, set(prog_var)::in, set(prog_var)::out) is det.
-update_liveness_expr(call(_, _, _, _, _, _), _, _, Liveness, Liveness).
+update_liveness_expr(call(_, _, _, _, _, _, _), _, _, Liveness, Liveness).
update_liveness_expr(generic_call(_, _, _, _), _, _, Liveness, Liveness).
update_liveness_expr(unify(_, _, _, _, _), _, _, Liveness, Liveness).
update_liveness_expr(pragma_foreign_code(_, _, _, _, _, _, _), _, _,
@@ -888,6 +894,8 @@
update_liveness_goal(Goal, LiveInfo, Liveness0, Liveness).
update_liveness_expr(bi_implication(_, _), _, _, _, _) :-
error("update_liveness_expr: bi_implication").
+update_liveness_expr(edcg_goal(_, _, _), _, _, _, _) :-
+ error("update_liveness_expr: unexpected edcg_goal").
:- pred update_liveness_conj(list(hlds_goal)::in, live_info::in,
set(prog_var)::in, set(prog_var)::out) is det.
@@ -995,7 +1003,7 @@
delay_death_goal_expr(GoalExpr0, GoalInfo0, BornVars0, DelayedDead0, VarSet,
GoalExpr, GoalInfo, BornVars, DelayedDead) :-
(
- GoalExpr0 = call(_, _, _, _, _, _),
+ GoalExpr0 = call(_, _, _, _, _, _, _),
GoalExpr = GoalExpr0,
GoalInfo = GoalInfo0,
BornVars = BornVars0,
@@ -1097,7 +1105,10 @@
BornVars = BornVars0
;
GoalExpr0 = bi_implication(_, _),
- error("delay_death_goal_expr: bi_implication")
+ error("delay_death_goal_expr: unexpected bi_implication")
+ ;
+ GoalExpr0 = edcg_goal(_, _, _),
+ error("delay_death_goal_expr: unexpected edcg_goal")
).
:- pred delay_death_conj(list(hlds_goal)::in,
@@ -1335,8 +1346,8 @@
detect_resume_points_in_goal_2(generic_call(A,B,C,D), _, Liveness,
_, _, generic_call(A,B,C,D), Liveness).
-detect_resume_points_in_goal_2(call(A,B,C,D,E,F), _, Liveness, _, _,
- call(A,B,C,D,E,F), Liveness).
+detect_resume_points_in_goal_2(call(A,B,C,D,E,F,G), _, Liveness, _, _,
+ call(A,B,C,D,E,F,G), Liveness).
detect_resume_points_in_goal_2(unify(A,B,C,D,E), _, Liveness, _, _,
unify(A,B,C,D,E), Liveness).
@@ -1347,6 +1358,11 @@
detect_resume_points_in_goal_2(bi_implication(_, _), _, _, _, _, _, _) :-
% these should have been expanded out by now
error("detect_resume_points_in_goal_2: unexpected bi_implication").
+
+detect_resume_points_in_goal_2(edcg_goal(_, _, _), _, _, _, _, _, _) :-
+ % these should have been expanded out by now
+ error("detect_resume_points_in_goal_2: unexpected edcg_goal").
+
:- pred detect_resume_points_in_conj(list(hlds_goal)::in, set(prog_var)::in,
live_info::in, set(prog_var)::in,
Index: compiler/magic.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/magic.m,v
retrieving revision 1.25
diff -u -r1.25 magic.m
--- compiler/magic.m 2000/11/17 17:47:42 1.25
+++ compiler/magic.m 2001/03/13 00:20:57
@@ -1106,7 +1106,7 @@
module_info_pred_info(ModuleInfo1, AditiPredId, AditiPredInfo),
pred_info_module(AditiPredInfo, PredModule),
pred_info_name(AditiPredInfo, PredName),
- CallGoal = call(AditiPredId, AditiProcId, CallArgs, not_builtin,
+ CallGoal = call(AditiPredId, AditiProcId, CallArgs, [], not_builtin,
no, qualified(PredModule, PredName)) - CallGoalInfo,
instmap_delta_from_mode_list(OutputArgs, OutputArgModes,
@@ -1517,7 +1517,7 @@
HOMap0, HOMap) -->
magic__preprocess_conj(Goals0, [], Goals, HOMap0, HOMap).
magic__preprocess_goal_2(Goal0, Goals, HOMap, HOMap) -->
- { Goal0 = call(PredId, B, Args, C, D, E) - GoalInfo },
+ { Goal0 = call(PredId, B, Args, D, E, F, G) - GoalInfo },
magic_info_get_module_info(ModuleInfo),
( { hlds_pred__is_aditi_aggregate(ModuleInfo, PredId) } ->
% Put the closures and the aggregate call in a sub-conjunction
@@ -1538,7 +1538,7 @@
{ set__insert_list(NonLocals, IntroducedArgs, NewNonLocals) },
{ goal_info_set_nonlocals(GoalInfo,
NewNonLocals, NewGoalInfo) },
- { NewCall = call(PredId, B, NewArgs, C, D, E) - NewGoalInfo },
+ { NewCall = call(PredId, B, NewArgs, D, E, F, G) - NewGoalInfo },
{ list__append(ExtraGoals, [NewCall], Goals) }
;
{ Goals = [Goal0] }
@@ -1613,6 +1613,10 @@
% these should have been expanded out by now
{ error("magic__preprocess_goal_2: unexpected bi_implication") }.
+magic__preprocess_goal_2(edcg_goal(_, _, _) - _, _, _, _) -->
+ % these should have been expanded out by now
+ { error("magic__preprocess_goal_2: unexpected edcg_goal") }.
+
% Introduce new variables and assignments to them for any
% duplicates in the list.
:- pred magic__preprocess_call_args(list(prog_var)::in, list(prog_var)::out,
@@ -1682,7 +1686,7 @@
;
Goal = conj(_) - _
;
- Goal = call(_, _, _, _, _, _) - _,
+ Goal = call(_, _, _, _, _, _, _) - _,
magic_util__goal_is_aditi_call(ModuleInfo, PredMap,
Goal, _, _)
;
@@ -1956,7 +1960,7 @@
ModuleInfo, InstMapDelta) },
{ goal_info_init(NonLocals, InstMapDelta, nondet, GoalInfo) },
- { MagicCall = call(MagicPredId, MagicProcId, MagicArgs,
+ { MagicCall = call(MagicPredId, MagicProcId, MagicArgs, [],
not_builtin, no, PredName) - GoalInfo }.
%-----------------------------------------------------------------------------%
Index: compiler/magic_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/magic_util.m,v
retrieving revision 1.12
diff -u -r1.12 magic_util.m
--- compiler/magic_util.m 2000/10/13 13:55:33 1.12
+++ compiler/magic_util.m 2001/03/12 15:35:48
@@ -212,7 +212,7 @@
% should have placed the closures next to the aggregate call.
Goals = [Closure1a, Closure2a, Closure3a,
CallGoal | AfterGoals0],
- CallGoal = call(PredId, ProcId, Args, _,_,_) - _,
+ CallGoal = call(PredId, ProcId, Args, _, _,_,_) - _,
hlds_pred__is_aditi_aggregate(ModuleInfo, PredId),
magic_util__check_aggregate_closure(Closure1a, Closure1),
magic_util__check_aggregate_closure(Closure2a, Closure2),
@@ -224,7 +224,7 @@
;
% Is the goal an ordinary database call.
Goals = [Goal0 | AfterGoals],
- Goal0 = call(PredId, ProcId, Args, _, _, _) - _,
+ Goal0 = call(PredId, ProcId, Args, _, _, _, _) - _,
(
% The original predicate may have been stripped of its
% aditi marker by magic__interface_to_c, so check
@@ -389,7 +389,7 @@
CallNonLocals),
{ goal_info_set_nonlocals(CallGoalInfo1, CallNonLocals,
CallGoalInfo) },
- { CallGoal = call(PredId, ProcId, NewArgs,
+ { CallGoal = call(PredId, ProcId, NewArgs, [],
not_builtin, no, Name) - CallGoalInfo }
;
% Transform away the input arguments.
@@ -561,7 +561,7 @@
{ module_info_pred_info(ModuleInfo, PredId, PredInfo) },
{ pred_info_module(PredInfo, PredModule) },
{ pred_info_name(PredInfo, PredName) },
- { CallGoal = call(PredId, ProcId, AllArgs, not_builtin, no,
+ { CallGoal = call(PredId, ProcId, AllArgs, [], not_builtin, no,
qualified(PredModule, PredName)) - GoalInfo }.
magic_util__create_input_test_unifications(_, [], _, [_|_],
@@ -754,7 +754,7 @@
% unless the arguments match so no projection is needed.
%
(
- { LambdaGoal = call(_, _, CallArgs, _, _, _) - _ },
+ { LambdaGoal = call(_, _, CallArgs, _, _, _, _) - _ },
{ list__append(LambdaInputs, LambdaVars, CallArgs) }
->
% No projection is needed.
@@ -806,7 +806,7 @@
magic_info_get_module_info(ModuleInfo),
(
- { SuppCall = call(SuppPredId, SuppProcId, _, _, _, _) - _ },
+ { SuppCall = call(SuppPredId, SuppProcId, _, _, _, _, _) - _ },
{ mode_get_insts(ModuleInfo, InputMode, Inst, _) },
{ Inst = ground(_, higher_order(PredInstInfo)) }
->
@@ -861,7 +861,7 @@
ProcInfo0, ProcInfo, SuppInputArgs, LambdaVars, LambdaGoal) -->
(
{ SuppCall = call(SuppPredId1, SuppProcId1,
- SuppArgs1, _, _, _) - _ }
+ SuppArgs1, _, _, _, _) - _ }
->
{ SuppArgs = SuppArgs1 },
magic_info_get_module_info(ModuleInfo),
@@ -990,7 +990,7 @@
Context, SuppCall) -->
(
{ PrevGoals = [PrevGoal] },
- { PrevGoal = call(_, _, _, _, _, _) - _ }
+ { PrevGoal = call(_, _, _, _, _, _, _) - _ }
->
{ SuppCall = PrevGoal }
;
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.364
diff -u -r1.364 make_hlds.m
--- compiler/make_hlds.m 2001/01/17 01:41:58 1.364
+++ compiler/make_hlds.m 2001/03/14 13:31:46
@@ -90,7 +90,7 @@
:- implementation.
-:- import_module hlds_goal.
+:- import_module hlds_goal, edcg.
:- import_module prog_io, prog_io_goal, prog_io_dcg, prog_io_util, prog_out.
:- import_module modules, module_qual, prog_util, options, hlds_out, typecheck.
:- import_module make_tags, quantification, (inst), globals.
@@ -211,14 +211,22 @@
:- mode add_item_decl_pass_1(in, in, in, in, out, out, di, uo) is det.
% skip clauses
-add_item_decl_pass_1(pred_clause(_, _, _, _), _, Status, Module, Status, Module)
- --> [].
+add_item_decl_pass_1(pred_clause(_, _, _, _, _), _, Status, Module, Status,
+ Module) --> [].
add_item_decl_pass_1(func_clause(_, _, _, _, _), _, Status, Module, Status,
Module) --> [].
add_item_decl_pass_1(type_defn(_, _, _), _, Status, Module, Status, Module)
--> [].
+add_item_decl_pass_1(etype_defn(_VarSet, Name, Htype), Context, Status,
+ Module0, Status, Module) -->
+ module_add_etype_defn(Module0, Name, Htype, Context, Module).
+
+add_item_decl_pass_1(emode_defn(_VarSet, Name, Hmode), Context, Status,
+ Module0, Status, Module) -->
+ module_add_emode_defn(Module0, Name, Hmode, Context, Module).
+
add_item_decl_pass_1(inst_defn(VarSet, InstDefn, Cond), Context,
Status, Module0, Status, Module) -->
module_add_inst_defn(Module0, VarSet, InstDefn, Cond, Context,
@@ -230,12 +238,12 @@
Status, Module).
add_item_decl_pass_1(pred(TypeVarSet, InstVarSet, ExistQVars, PredName,
- TypesAndModes, MaybeDet, Cond, Purity, ClassContext),
+ TypesAndModes, EDCGForms, MaybeDet, Cond, Purity, ClassContext),
Context, Status, Module0, Status, Module) -->
{ init_markers(Markers) },
module_add_pred(Module0, TypeVarSet, InstVarSet, ExistQVars, PredName,
- TypesAndModes, MaybeDet, Cond, Purity, ClassContext, Markers,
- Context, Status, _, Module).
+ TypesAndModes, EDCGForms, MaybeDet, Cond, Purity, ClassContext,
+ Markers, Context, Status, _, Module).
add_item_decl_pass_1(func(TypeVarSet, InstVarSet, ExistQVars, FuncName,
TypesAndModes, RetTypeAndMode, MaybeDet, Cond, Purity,
@@ -563,18 +571,22 @@
add_item_decl_pass_2(assertion(_, _), _, Status, Module, Status, Module) --> [].
add_item_decl_pass_2(func_clause(_, _, _, _, _), _, Status, Module, Status,
Module) --> [].
-add_item_decl_pass_2(pred_clause(_, _, _, _), _, Status, Module, Status, Module)
- --> [].
+add_item_decl_pass_2(pred_clause(_, _, _, _, _), _, Status, Module, Status,
+ Module) --> [].
add_item_decl_pass_2(inst_defn(_, _, _), _, Status, Module, Status, Module)
--> [].
add_item_decl_pass_2(mode_defn(_, _, _), _, Status, Module, Status, Module)
--> [].
-add_item_decl_pass_2(pred(_, _, _, _, _, _, _, _, _),
+add_item_decl_pass_2(pred(_, _, _, _, _, _, _, _, _, _),
_, Status, Module, Status, Module) --> [].
add_item_decl_pass_2(pred_mode(_, _, _, _, _), _, Status, Module, Status,
Module) --> [].
add_item_decl_pass_2(func_mode(_, _, _, _, _, _), _, Status, Module, Status,
Module) --> [].
+add_item_decl_pass_2(etype_defn(_, _, _), _, Status, Module, Status,
+ Module) --> [].
+add_item_decl_pass_2(emode_defn(_, _, _), _, Status, Module, Status,
+ Module) --> [].
add_item_decl_pass_2(nothing, _, Status, Module, Status, Module) --> [].
add_item_decl_pass_2(typeclass(_, _, _, _, _)
, _, Status, Module, Status, Module) --> [].
@@ -650,19 +662,19 @@
{ IsAssertion = no },
module_add_func_clause(Module0, VarSet, PredName, Args, Result, Body,
Status, Context, IsAssertion, Module, Info0, Info).
-add_item_clause(pred_clause(VarSet, PredName, Args, Body), Status, Status,
- Context, Module0, Module, Info0, Info) -->
+add_item_clause(pred_clause(VarSet, PredName, Args, Body, MaybeEdcg),
+ Status, Status, Context, Module0, Module, Info0, Info) -->
check_not_exported(Status, Context, "clause"),
{ IsAssertion = no },
- module_add_pred_clause(Module0, VarSet, PredName, Args, Body, Status,
- Context, IsAssertion, Module, Info0, Info).
+ module_add_pred_clause(Module0, VarSet, PredName, Args, Body, MaybeEdcg,
+ Status, Context, IsAssertion, Module, Info0, Info).
add_item_clause(type_defn(_, _, _), Status, Status, _,
Module, Module, Info, Info) --> [].
add_item_clause(inst_defn(_, _, _), Status, Status, _,
Module, Module, Info, Info) --> [].
add_item_clause(mode_defn(_, _, _), Status, Status, _,
Module, Module, Info, Info) --> [].
-add_item_clause(pred(_, _, _, _, _, _, _, _, _), Status, Status, _,
+add_item_clause(pred(_, _, _, _, _, _, _, _, _, _), Status, Status, _,
Module, Module, Info, Info) --> [].
add_item_clause(func(_, _, _, FuncName, TypesAndModes, _, _, _, _, _),
Status, Status, Context, Module, Module, Info, Info) -->
@@ -674,6 +686,10 @@
Module, Module, Info, Info) --> [].
add_item_clause(func_mode(_, _, _, _, _, _), Status, Status, _,
Module, Module, Info, Info) --> [].
+add_item_clause(etype_defn(_, _, _), Status, Status, _,
+ Module, Module, Info, Info) --> [].
+add_item_clause(emode_defn(_, _, _), Status, Status, _,
+ Module, Module, Info, Info) --> [].
add_item_clause(module_defn(_, Defn), Status0, Status, _,
Module, Module, Info0, Info) -->
{ module_defn_update_import_status(Defn, ItemStatus1) ->
@@ -774,8 +790,8 @@
%
{ IsAssertion = yes },
module_add_pred_clause(Module0, VarSet, unqualified(Name),
- HeadVars, Goal, Status, Context, IsAssertion, Module,
- Info0, Info).
+ HeadVars, Goal, edcg_no, Status, Context, IsAssertion,
+ Module, Info0, Info).
add_item_clause(nothing, Status, Status, _, Module, Module, Info, Info) --> [].
add_item_clause(typeclass(_, _, _, _, _),
@@ -953,7 +969,7 @@
construct_pred_or_func_call(PredId, PredOrFunc, SymName, Args,
GoalInfo, Goal),
- Clause = clause(ProcIds, Goal, Context),
+ Clause = clause(ProcIds, Goal, edcg_no, Context),
map__init(TI_VarMap),
map__init(TCI_VarMap),
map__init(TVarNameMap),
@@ -2183,17 +2199,17 @@
%-----------------------------------------------------------------------------%
:- pred module_add_pred(module_info, tvarset, inst_varset, existq_tvars,
- sym_name, list(type_and_mode), maybe(determinism), condition,
- purity, class_constraints, pred_markers, prog_context,
- item_status, maybe(pair(pred_id, proc_id)), module_info,
- io__state, io__state).
-:- mode module_add_pred(in, in, in, in, in, in, in, in, in, in, in, in, in,
+ sym_name, list(type_and_mode), edcg_forms, maybe(determinism),
+ condition, purity, class_constraints, pred_markers,
+ prog_context, item_status, maybe(pair(pred_id, proc_id)),
+ module_info, io__state, io__state).
+:- mode module_add_pred(in, in, in, in, in, in, in, in, in, in, in, in, in, in,
out, out, di, uo) is det.
module_add_pred(Module0, TypeVarSet, InstVarSet, ExistQVars, PredName,
- TypesAndModes, MaybeDet, Cond, Purity, ClassContext, Markers,
- Context, item_status(Status, NeedQual), MaybePredProcId,
- Module) -->
+ TypesAndModes, EDCGForms, MaybeDet, Cond, Purity, ClassContext,
+ Markers, Context, item_status(Status, NeedQual),
+ MaybePredProcId, Module) -->
% Only preds with opt_imported clauses are tagged as opt_imported, so
% that the compiler doesn't look for clauses for other preds read in
% from optimization interfaces.
@@ -2203,9 +2219,9 @@
DeclStatus = Status
},
{ split_types_and_modes(TypesAndModes, Types, MaybeModes) },
- add_new_pred(Module0, TypeVarSet, ExistQVars, PredName, Types, Cond,
- Purity, ClassContext, Markers, Context, DeclStatus, NeedQual,
- predicate, Module1),
+ add_new_pred(Module0, TypeVarSet, ExistQVars, PredName, Types,
+ EDCGForms, Cond, Purity, ClassContext, Markers, Context,
+ DeclStatus, NeedQual, predicate, Module1),
(
{ MaybeModes = yes(Modes) },
@@ -2255,9 +2271,10 @@
{ split_types_and_modes(TypesAndModes, Types, MaybeModes0) },
{ split_type_and_mode(RetTypeAndMode, RetType, MaybeRetMode0) },
{ list__append(Types, [RetType], Types1) },
- add_new_pred(Module0, TypeVarSet, ExistQVars, FuncName, Types1, Cond,
- Purity, ClassContext, Markers, Context, DeclStatus, NeedQual,
- function, Module1),
+ { EDCGForms = [] },
+ add_new_pred(Module0, TypeVarSet, ExistQVars, FuncName, Types1,
+ EDCGForms, Cond, Purity, ClassContext, Markers, Context,
+ DeclStatus, NeedQual, function, Module1),
{
% If there are no modes, but there is a determinism
% declared, assume the function has the default modes.
@@ -2412,9 +2429,10 @@
{ NewClassContext = constraints(NewUnivCnstrs, ExistCnstrs) },
{ init_markers(Markers0) },
{ add_marker(Markers0, class_method, Markers) },
+ { EDCGForms = [] },
module_add_pred(Module0, TypeVarSet, InstVarSet, ExistQVars,
- PredName, TypesAndModes, MaybeDet, Cond, Purity,
- NewClassContext, Markers, Context, Status,
+ PredName, TypesAndModes, EDCGForms, MaybeDet, Cond,
+ Purity, NewClassContext, Markers, Context, Status,
MaybePredIdProcId, Module)
;
{ Method = func(TypeVarSet, InstVarSet, ExistQVars, FuncName,
@@ -2579,34 +2597,36 @@
%-----------------------------------------------------------------------------%
:- pred add_new_pred(module_info, tvarset, existq_tvars, sym_name, list(type),
- condition, purity, class_constraints, pred_markers,
- prog_context, import_status, need_qualifier,
+ edcg_forms, condition, purity, class_constraints, pred_markers,
+ prog_context, import_status, need_qualifier,
pred_or_func, module_info, io__state, io__state).
-:- mode add_new_pred(in, in, in, in, in, in, in, in, in, in, in, in, in, out,
- di, uo) is det.
+:- mode add_new_pred(in, in, in, in, in, in, in, in, in, in, in, in, in, in,
+ out, di, uo) is det.
% NB. Predicates are also added in lambda.m, which converts
% lambda expressions into separate predicates, so any changes may need
% to be reflected there too.
-add_new_pred(Module0, TVarSet, ExistQVars, PredName, Types, Cond, Purity,
- ClassContext, Markers0, Context, Status, NeedQual,
+add_new_pred(Module0, TVarSet, ExistQVars, PredName, Types, EDCGForms,
+ Cond, Purity, ClassContext, Markers0, Context, Status, NeedQual,
PredOrFunc, Module) -->
check_tvars_in_constraints(ClassContext, Types, TVarSet,
PredOrFunc, PredName, Context, Module0, Module1),
{ module_info_name(Module1, ModuleName) },
- { list__length(Types, Arity) },
+ { list__length(Types, VisualArity) },
+ { edcg_forms_to_arity(EDCGForms, EDCGArity) },
+ { TotalArity is VisualArity + EDCGArity },
(
{ PredName = unqualified(_PName) },
{ module_info_incr_errors(Module1, Module) },
- unqualified_pred_error(PredName, Arity, Context)
+ unqualified_pred_error(PredName, VisualArity, Context)
% All predicate names passed into this predicate should have
% been qualified by prog_io.m, when they were first read.
;
{ PredName = qualified(MNameOfPred, PName) },
{ module_info_get_predicate_table(Module1, PredicateTable0) },
- { clauses_info_init(Arity, ClausesInfo) },
+ { clauses_info_init(VisualArity, ClausesInfo) },
{ map__init(Proofs) },
{ purity_to_markers(Purity, PurityMarkers) },
{ markers_to_marker_list(PurityMarkers, MarkersList) },
@@ -2617,15 +2637,24 @@
)) },
{ list__foldl(AddMarker, MarkersList, Markers0, Markers) },
globals__io_lookup_string_option(aditi_user, Owner),
- { pred_info_init(ModuleName, PredName, Arity, TVarSet,
- ExistQVars, Types,
- Cond, Context, ClausesInfo, Status, Markers,
- none, PredOrFunc, ClassContext, Proofs,
- Owner, PredInfo0) },
+ { pred_info_init(ModuleName, PredName, TotalArity, VisualArity,
+ TVarSet, ExistQVars, Types, EDCGForms, Cond, Context,
+ ClausesInfo, Status, Markers, none, PredOrFunc,
+ ClassContext, Proofs, Owner, PredInfo0) },
(
- { predicate_table_search_pf_m_n_a(PredicateTable0,
- PredOrFunc, MNameOfPred, PName, Arity,
- [OrigPred|_]) }
+ (
+ { predicate_table_search_pf_m_n_a(
+ PredicateTable0, PredOrFunc,
+ MNameOfPred, PName, VisualArity,
+ [OrigPred0|_]) }
+ ->
+ { OrigPred = OrigPred0 }
+ ;
+ { predicate_table_search_pf_m_n_a(
+ PredicateTable0, PredOrFunc,
+ MNameOfPred, PName, TotalArity,
+ [OrigPred|_]) }
+ )
->
( { Status \= opt_imported } ->
{ module_info_incr_errors(Module1, Module) },
@@ -2636,7 +2665,7 @@
{ hlds_out__pred_or_func_to_str(PredOrFunc,
DeclString) },
{ adjust_func_arity(PredOrFunc,
- OrigArity, Arity) },
+ OrigArity, VisualArity) },
multiple_def_error(PredName, OrigArity,
DeclString, Context, OrigContext)
;
@@ -2667,6 +2696,28 @@
)
).
+:- pred edcg_forms_to_arity(edcg_forms, arity).
+:- mode edcg_forms_to_arity(in, out) is det.
+
+edcg_forms_to_arity(EDCGForms, Arity) :-
+ edcg_forms_to_arity(EDCGForms, 0, Arity).
+
+:- pred edcg_forms_to_arity(edcg_forms, arity, arity).
+:- mode edcg_forms_to_arity(in, in, out) is det.
+
+edcg_forms_to_arity([], Arity, Arity).
+edcg_forms_to_arity([_ - changed | Rest], Arity0, Arity) :-
+ Arity1 is Arity0 + 2,
+ edcg_forms_to_arity(Rest, Arity1, Arity).
+edcg_forms_to_arity([_ - passed | Rest], Arity0, Arity) :-
+ Arity1 is Arity0 + 1,
+ edcg_forms_to_arity(Rest, Arity1, Arity).
+edcg_forms_to_arity([_ - produced | Rest], Arity0, Arity) :-
+ Arity1 is Arity0 + 1,
+ edcg_forms_to_arity(Rest, Arity1, Arity).
+edcg_forms_to_arity([_ - nothing | Rest], Arity0, Arity) :-
+ edcg_forms_to_arity(Rest, Arity0, Arity).
+
%-----------------------------------------------------------------------------%
%
@@ -2857,8 +2908,8 @@
SymName = qualified(Module, Name),
invalid_proc_id(ModeId), % mode checking will figure it out
MaybeUnifyContext = no,
- Call = call(PredId, ModeId, HeadVars, inline_builtin, MaybeUnifyContext,
- SymName),
+ Call = call(PredId, ModeId, HeadVars, [], inline_builtin,
+ MaybeUnifyContext, SymName),
%
% construct a clause containing that pseudo-recursive call
@@ -2867,7 +2918,7 @@
set__list_to_set(HeadVars, NonLocals),
goal_info_set_nonlocals(GoalInfo0, NonLocals, GoalInfo),
Goal = Call - GoalInfo,
- Clause = clause([], Goal, Context),
+ Clause = clause([], Goal, edcg_no, Context),
%
% put the clause we just built into the pred_info,
@@ -3421,13 +3472,13 @@
%-----------------------------------------------------------------------------%
:- pred module_add_pred_clause(module_info, prog_varset, sym_name,
- list(prog_term), goal, import_status, prog_context,
+ list(prog_term), goal, maybe_edcg, import_status, prog_context,
bool, module_info, qual_info, qual_info, io__state, io__state).
-:- mode module_add_pred_clause(in, in, in, in, in, in, in, in, out,
+:- mode module_add_pred_clause(in, in, in, in, in, in, in, in, in, out,
in, out, di, uo) is det.
module_add_pred_clause(ModuleInfo0, ClauseVarSet, PredName, Args, Body,
- Status, Context, IsAssertion, ModuleInfo,
+ MaybeEdcg, Status, Context, IsAssertion, ModuleInfo,
Info0, Info) -->
% print out a progress message
globals__io_lookup_bool_option(very_verbose, VeryVerbose),
@@ -3440,17 +3491,18 @@
[]
),
module_add_clause(ModuleInfo0, ClauseVarSet, PredName, Args, Body,
- Status, Context, predicate, IsAssertion, ModuleInfo,
+ MaybeEdcg, Status, Context, predicate, IsAssertion, ModuleInfo,
Info0, Info).
:- pred module_add_func_clause(module_info, prog_varset, sym_name,
- list(prog_term), prog_term, goal, import_status, prog_context,
- bool, module_info, qual_info, qual_info, io__state, io__state).
+ list(prog_term), prog_term, goal, import_status,
+ prog_context, bool, module_info, qual_info, qual_info,
+ io__state, io__state).
:- mode module_add_func_clause(in, in, in, in, in,
in, in, in, in, out, in, out, di, uo) is det.
module_add_func_clause(ModuleInfo0, ClauseVarSet, FuncName, Args0, Result, Body,
- Status, Context, IsAssertion, ModuleInfo,
+ Status, Context, IsAssertion, ModuleInfo,
Info0, Info) -->
% print out a progress message
globals__io_lookup_bool_option(very_verbose, VeryVerbose),
@@ -3464,17 +3516,17 @@
),
{ list__append(Args0, [Result], Args) },
module_add_clause(ModuleInfo0, ClauseVarSet, FuncName, Args, Body,
- Status, Context, function, IsAssertion, ModuleInfo,
+ edcg_no, Status, Context, function, IsAssertion, ModuleInfo,
Info0, Info).
:- pred module_add_clause(module_info, prog_varset, sym_name, list(prog_term),
- goal, import_status, prog_context, pred_or_func, bool,
- module_info, qual_info, qual_info, io__state, io__state).
-:- mode module_add_clause(in, in, in, in, in, in, in, in, in,
+ goal, maybe_edcg, import_status, prog_context, pred_or_func,
+ bool, module_info, qual_info, qual_info, io__state, io__state).
+:- mode module_add_clause(in, in, in, in, in, in, in, in, in, in,
out, in, out, di, uo) is det.
-module_add_clause(ModuleInfo0, ClauseVarSet, PredName, Args, Body, Status,
- Context, PredOrFunc, IsAssertion, ModuleInfo,
+module_add_clause(ModuleInfo0, ClauseVarSet, PredName, Args, Body, MaybeEdcg,
+ Status, Context, PredOrFunc, IsAssertion, ModuleInfo,
Info0, Info) -->
% Lookup the pred declaration in the predicate table.
% (If it's not there, call maybe_undefined_pred_error
@@ -3609,7 +3661,7 @@
{ maybe_add_default_func_mode(PredInfo1, PredInfo2, _) },
{ pred_info_all_procids(PredInfo2, ProcIds) },
clauses_info_add_clause(Clauses0, ProcIds,
- ClauseVarSet, TVarSet0, Args, Body, Context,
+ ClauseVarSet, TVarSet0, Args, Body, MaybeEdcg, Context,
PredOrFunc, Arity, IsAssertion, Goal,
VarSet, TVarSet, Clauses, Warnings,
ModuleInfo1, ModuleInfo2, Info0, Info),
@@ -3693,7 +3745,7 @@
invalid_pred_id(InvalidPredId),
construct_pred_or_func_call(InvalidPredId, PredOrFunc,
InstancePredName, HeadVars, GoalInfo, IntroducedGoal),
- IntroducedClause = clause([], IntroducedGoal, Context),
+ IntroducedClause = clause([], IntroducedGoal, edcg_no, Context),
map__from_corresponding_lists(HeadVars, ArgTypes, VarTypes),
map__init(TVarNameMap),
@@ -3723,14 +3775,15 @@
{
PredOrFunc = predicate,
InstanceClause = pred_clause(CVarSet, PredName,
- HeadTerms, Body),
+ HeadTerms, Body, MaybeEdcg),
Arity = list__length(HeadTerms)
;
PredOrFunc = function,
InstanceClause = func_clause(CVarSet, PredName,
ArgTerms, ResultTerm, Body),
HeadTerms = list__append(ArgTerms, [ResultTerm]),
- Arity = list__length(ArgTerms)
+ Arity = list__length(ArgTerms),
+ MaybeEdcg = edcg_no
}
->
% The tvarset argument is only used for explicit type
@@ -3742,7 +3795,7 @@
% mode of the procedure
{ IsAssertion = no },
clauses_info_add_clause(ClausesInfo0, ProcIds,
- CVarSet, TVarSet0, HeadTerms, Body, Context,
+ CVarSet, TVarSet0, HeadTerms, Body, MaybeEdcg, Context,
PredOrFunc, Arity, IsAssertion, Goal,
VarSet, _TVarSet, ClausesInfo, Warnings,
ModuleInfo0, ModuleInfo, QualInfo0, QualInfo),
@@ -3759,6 +3812,60 @@
).
%-----------------------------------------------------------------------------%
+
+:- pred module_add_etype_defn(module_info, sym_name, etype_defn, term__context,
+ module_info, io__state, io__state).
+:- mode module_add_etype_defn(in, in, in, in, out, di, uo) is det.
+
+module_add_etype_defn(Module0, EDCGArg, HtypeDefn, Context, Module) -->
+ { module_info_edcgs(Module0, EDCGTable0) },
+ (
+ % Checks to see if declaration is duplicated.
+ { edcg_table_fetch_context(EDCGTable0, EDCGArg, edcg_type,
+ OriginalContext) }
+ ->
+ % Mutiple etype declarations.
+ { module_info_incr_errors(Module0, Module) },
+ multiply_defined_edcg_error(EDCGArg, edcg_type, Context,
+ OriginalContext)
+ ;
+ { edcg_table_add_etype(EDCGTable0, EDCGArg, HtypeDefn,
+ Context, EDCGTable) },
+ { module_info_set_edcgs(Module0, EDCGTable, Module) }
+ ).
+
+:- pred module_add_emode_defn(module_info, sym_name, emode_defn, term__context,
+ module_info, io__state, io__state).
+:- mode module_add_emode_defn(in, in, in, in, out, di, uo) is det.
+
+module_add_emode_defn(Module0, EDCGArg, HmodeDefn, Context, Module) -->
+ { module_info_edcgs(Module0, EDCGTable0) },
+ (
+ % Checks to see if declaration is duplicated.
+ { edcg_table_fetch_context(EDCGTable0, EDCGArg, edcg_mode,
+ OriginalContext) }
+ ->
+ % Mutiple emode declarations.
+ { module_info_incr_errors(Module0, Module) },
+ multiply_defined_edcg_error(EDCGArg, edcg_mode, Context,
+ OriginalContext)
+ ;
+ { edcg_table_add_emode(EDCGTable0, EDCGArg, HmodeDefn,
+ Context, EDCGTable) },
+ { module_info_set_edcgs(Module0, EDCGTable, Module) }
+ ).
+
+:- pred multiply_defined_edcg_error(sym_name, etype_or_emode,
+ term__context, term__context, io__state, io__state).
+:- mode multiply_defined_edcg_error(in, in, in, in, di, uo) is det.
+
+multiply_defined_edcg_error(EDCGName, HtypeOrHmode, Context,
+ OriginalContext) -->
+ { etype_or_emode_to_string(HtypeOrHmode, DeclString) },
+ multiple_def_error(EDCGName, 0, DeclString, Context,
+ OriginalContext).
+
+%-----------------------------------------------------------------------------%
%
% module_add_pragma_import:
% Handles `pragma import' declarations, by figuring out which predicate
@@ -4546,10 +4653,13 @@
warn_singletons_in_goal(Then, QuantVars1, VarSet, PredCallId, MI),
warn_singletons_in_goal(Else, QuantVars, VarSet, PredCallId, MI).
-warn_singletons_in_goal_2(call(_, _, Args, _, _, _),
+warn_singletons_in_goal_2(call(_, _, Args0, EDCGArgs0, _, _, _),
GoalInfo, QuantVars, VarSet, PredCallId, _) -->
{ goal_info_get_nonlocals(GoalInfo, NonLocals) },
{ goal_info_get_context(GoalInfo, Context) },
+ { assoc_list__values(EDCGArgs0, EDCGArgs1) },
+ { list__condense(EDCGArgs1, EDCGArgs) },
+ { list__append(Args0, EDCGArgs, Args) },
warn_singletons(Args, NonLocals, QuantVars, VarSet, Context,
PredCallId).
@@ -4579,6 +4689,14 @@
warn_singletons_in_goal_list([LHS, RHS], QuantVars, VarSet,
PredCallId, MI).
+warn_singletons_in_goal_2(edcg_goal(EDCGGoalInfo, _, Goal), GoalInfo,
+ QuantVars, VarSet, PredCallId, MI) -->
+ { goal_util__edcg_goal_head_vars(EDCGGoalInfo, EDCGVars) },
+ { goal_info_get_nonlocals(GoalInfo, NonLocals) },
+ { goal_info_get_context(GoalInfo, Context) },
+ warn_singletons(EDCGVars, NonLocals, QuantVars, VarSet, Context,
+ PredCallId),
+ warn_singletons_in_goal(Goal, QuantVars, VarSet, PredCallId, MI).
:- pred warn_singletons_in_goal_list(list(hlds_goal), set(prog_var),
prog_varset, simple_call_id, module_info,
@@ -4620,6 +4738,13 @@
warn_singletons([X | Vars], NonLocals, QuantVars, VarSet,
Context, CallPredId).
+warn_singletons_in_unify(X, edcg_op(_,_), GoalInfo, QuantVars, VarSet,
+ CallPredId, _) -->
+ { goal_info_get_nonlocals(GoalInfo, NonLocals) },
+ { goal_info_get_context(GoalInfo, Context) },
+ warn_singletons([X], NonLocals, QuantVars, VarSet,
+ Context, CallPredId).
+
warn_singletons_in_unify(X, lambda_goal(_PredOrFunc, _Eval, _Fix, _NonLocals,
LambdaVars, _Modes, _Det, LambdaGoal),
GoalInfo, QuantVars, VarSet, CallPredId, MI) -->
@@ -4972,11 +5097,11 @@
:- pred clauses_info_init(int::in, clauses_info::out) is det.
-clauses_info_init(Arity, ClausesInfo) :-
+clauses_info_init(VisualArity, ClausesInfo) :-
map__init(VarTypes),
map__init(TVarNameMap),
varset__init(VarSet0),
- make_n_fresh_vars("HeadVar__", Arity, VarSet0, HeadVars, VarSet),
+ make_n_fresh_vars("HeadVar__", VisualArity, VarSet0, HeadVars, VarSet),
map__init(TI_VarMap),
map__init(TCI_VarMap),
ClausesInfo = clauses_info(VarSet, VarTypes, TVarNameMap,
@@ -4984,7 +5109,7 @@
:- pred clauses_info_add_clause(clauses_info::in,
list(proc_id)::in, prog_varset::in, tvarset::in,
- list(prog_term)::in, goal::in, prog_context::in,
+ list(prog_term)::in, goal::in, maybe_edcg::in, prog_context::in,
pred_or_func::in, arity::in, bool::in,
hlds_goal::out, prog_varset::out, tvarset::out,
clauses_info::out, list(quant_warning)::out,
@@ -4992,8 +5117,8 @@
qual_info::out, io__state::di, io__state::uo) is det.
clauses_info_add_clause(ClausesInfo0, ModeIds, CVarSet, TVarSet0,
- Args, Body, Context, PredOrFunc, Arity, IsAssertion, Goal,
- VarSet, TVarSet, ClausesInfo, Warnings, Module0, Module,
+ Args, Body, MaybeEdcg, Context, PredOrFunc, Arity, IsAssertion,
+ Goal, VarSet, TVarSet, ClausesInfo, Warnings, Module0, Module,
Info0, Info) -->
{ ClausesInfo0 = clauses_info(VarSet0, ExplicitVarTypes0, TVarNameMap0,
InferredVarTypes, HeadVars, ClauseList0,
@@ -5013,10 +5138,11 @@
{ update_qual_info(Info0, TVarNameMap, TVarSet0,
ExplicitVarTypes0, Info1) },
{ varset__merge_subst(VarSet0, CVarSet, VarSet1, Subst) },
+ { init_atomic_goal_id(AtomicGoalId) },
transform(Subst, HeadVars, Args, Body, VarSet1, Context, PredOrFunc,
Arity, IsAssertion, Goal0, VarSet, Warnings,
- transform_info(Module0, Info1),
- transform_info(Module, Info2)),
+ transform_info(Module0, Info1, AtomicGoalId),
+ transform_info(Module, Info2, _)),
{ TVarSet = Info2 ^ tvarset },
{ qual_info_get_found_syntax_error(Info2, FoundError) },
{ qual_info_set_found_syntax_error(no, Info2, Info) },
@@ -5034,7 +5160,7 @@
{ Goal = Goal0 },
% XXX we should avoid append - this gives O(N*N)
- { list__append(ClauseList0, [clause(ModeIds, Goal, Context)],
+ { list__append(ClauseList0, [clause(ModeIds, Goal, MaybeEdcg, Context)],
ClauseList) },
{ qual_info_get_var_types(Info, ExplicitVarTypes) },
{ ClausesInfo = clauses_info(VarSet, ExplicitVarTypes,
@@ -5143,16 +5269,17 @@
% pragma foreign code are disjoint, the
% unifications can be implemented as
% substitutions, and they will be.
+ { init_atomic_goal_id(GoalId) },
insert_arg_unifications(HeadVars, TermArgs, Context,
head(PredOrFunc, Arity), yes, HldsGoal0, VarSet1,
- HldsGoal1, VarSet2, transform_info(ModuleInfo1, Info0),
- transform_info(ModuleInfo, Info)),
+ HldsGoal1, VarSet2, transform_info(ModuleInfo1, Info0,
+ GoalId), transform_info(ModuleInfo, Info, _)),
{
map__init(EmptyVarTypes),
implicitly_quantify_clause_body(HeadVars,
HldsGoal1, VarSet2, EmptyVarTypes,
HldsGoal, VarSet, _, _Warnings),
- NewClause = clause([ModeId], HldsGoal, Context),
+ NewClause = clause([ModeId], HldsGoal, edcg_no, Context),
ClausesInfo = clauses_info(VarSet, VarTypes, TVarNameMap,
VarTypes1, HeadVars, [NewClause|ClauseList],
TI_VarMap, TCI_VarMap)
@@ -5174,9 +5301,19 @@
:- type transform_info --->
transform_info(
module_info :: module_info,
- qual_info :: qual_info
+ qual_info :: qual_info,
+ atomic_goal_id :: atomic_goal_id
+ % Each atomic goals needs a unique identifier for
+ % EDCG expansion.
).
+:- pred transform_info_new_atomic_goal_id(transform_info, transform_info).
+:- mode transform_info_new_atomic_goal_id(in, out) is det.
+
+transform_info_new_atomic_goal_id(Info0, Info) :-
+ new_atomic_goal_id(Info0 ^ atomic_goal_id, Id),
+ Info = Info0 ^ atomic_goal_id := Id.
+
:- pred transform(prog_substitution, list(prog_var), list(prog_term), goal,
prog_varset, prog_context, pred_or_func, arity, bool,
hlds_goal, prog_varset, list(quant_warning),
@@ -5222,11 +5359,14 @@
io__state, io__state).
:- mode transform_goal(in, in, in, out, out, in, out, di, uo) is det.
-transform_goal(Goal0 - Context, VarSet0, Subst, Goal1 - GoalInfo1, VarSet,
+transform_goal(Goal0 - Context, VarSet0, Subst, Goal1 - GoalInfo, VarSet,
Info0, Info) -->
+ { transform_info_new_atomic_goal_id(Info0, Info1) },
transform_goal_2(Goal0, Context, VarSet0, Subst, Goal1 - GoalInfo0,
- VarSet, Info0, Info),
- { goal_info_set_context(GoalInfo0, Context, GoalInfo1) }.
+ VarSet, Info1, Info),
+ { goal_info_set_context(GoalInfo0, Context, GoalInfo1) },
+ { goal_info_set_atomic_goal_id(GoalInfo1, Info1 ^ atomic_goal_id,
+ GoalInfo) }.
:- pred transform_goal_2(goal_expr, prog_context, prog_varset,
prog_substitution, hlds_goal, prog_varset,
@@ -5316,11 +5456,12 @@
transform_goal(Q0, VarSet1, Subst, Q, VarSet, Info1, Info),
{ Goal = bi_implication(P, Q) - GoalInfo }.
-transform_goal_2(call(Name, Args0, Purity), Context, VarSet0, Subst, Goal,
- VarSet, Info0, Info) -->
+transform_goal_2(call(Name, VisualArgs0, EDCGs0, Purity), Context,
+ VarSet0, Subst, Goal, VarSet, Info0, Info) -->
(
{ Name = unqualified("\\=") },
- { Args0 = [LHS, RHS] }
+ { VisualArgs0 = [LHS, RHS] },
+ { EDCGs0 = [] }
->
% `LHS \= RHS' is defined as `not (LHS = RHS)'
transform_goal_2(not(unify(LHS, RHS, Purity) - Context),
@@ -5330,16 +5471,19 @@
% get: Field =^ field
% set: ^ field := Field
{ Name = unqualified(Operator) },
+ { EDCGs0 = [] },
( { Operator = "=^" }
; { Operator = ":=" }
)
->
- { term__apply_substitution_to_list(Args0, Subst, Args1) },
- transform_dcg_record_syntax(Operator, Args1, Context,
+ { term__apply_substitution_to_list(VisualArgs0, Subst,
+ VisualArgs1) },
+ transform_dcg_record_syntax(Operator, VisualArgs1, Context,
VarSet0, Goal, VarSet, Info0, Info)
;
% check for an Aditi builtin
{ Purity = pure },
+ { EDCGs0 = [] },
{ Name = unqualified(Name1) },
{ Name1 = "aditi_insert"
; Name1 = "aditi_delete"
@@ -5352,20 +5496,29 @@
%; Name1 = "aditi_modify"
}
->
- { term__apply_substitution_to_list(Args0, Subst, Args1) },
- transform_aditi_builtin(Name1, Args1, Context, VarSet0,
+ { term__apply_substitution_to_list(VisualArgs0, Subst,
+ VisualArgs) },
+ transform_aditi_builtin(Name1, VisualArgs, Context, VarSet0,
Goal, VarSet, Info0, Info)
;
- { term__apply_substitution_to_list(Args0, Subst, Args) },
- { make_fresh_arg_vars(Args, VarSet0, HeadVars, VarSet1) },
- { list__length(Args, Arity) },
+ { term__apply_substitution_to_list(VisualArgs0, Subst,
+ VisualArgs) },
+ { make_fresh_arg_vars(VisualArgs, VarSet0, VisualHeadVars,
+ VarSet1) },
+ { list__length(VisualArgs, VisualArity) },
+ transform_explicit_edcg_args(EDCGs0, EDCGs, Name,
+ VisualArity, Context, Subst, VarSet1, VarSet2,
+ EDCGVars, EDCGArgs, Info0, Info1),
+ { list__append(VisualHeadVars, EDCGVars, HeadVars) },
+ { list__append(VisualArgs, EDCGArgs, Args) },
(
% check for a higher-order call,
% i.e. a call to either call/N or ''/N.
{ Name = unqualified("call")
; Name = unqualified("")
},
- { HeadVars = [PredVar | RealHeadVars] }
+ { EDCGs = [] },
+ { VisualHeadVars = [PredVar | RealHeadVars] }
->
{
% initialize some fields to junk
@@ -5373,7 +5526,7 @@
Det = erroneous,
GenericCall = higher_order(PredVar,
- predicate, Arity),
+ predicate, VisualArity),
Call = generic_call(GenericCall,
RealHeadVars, Modes, Det),
@@ -5399,9 +5552,9 @@
invalid_proc_id(ModeId),
MaybeUnifyContext = no,
- Call = call(PredId, ModeId, HeadVars, not_builtin,
- MaybeUnifyContext, Name),
- CallId = call(predicate - Name/Arity),
+ Call = call(PredId, ModeId, VisualHeadVars, EDCGs,
+ not_builtin, MaybeUnifyContext, Name),
+ CallId = call(predicate - Name/VisualArity),
Purity1 = Purity
}
),
@@ -5410,10 +5563,15 @@
Purity1, GoalInfo) },
{ Goal0 = Call - GoalInfo },
- insert_arg_unifications(HeadVars, Args,
- Context, call(CallId), no,
- Goal0, VarSet1, Goal, VarSet, Info0, Info)
- ).
+ % NB: EDCGs depend on the arg unifications to be inserted before
+ % the call goal. This is because edcg operators as arguments
+ % to the predicate call must be processed before the predicate
+ % call itself, which may use a edcg argument used by
+ % the operator.
+ insert_arg_unifications(HeadVars, Args,
+ Context, call(CallId), no, Goal0, VarSet2, Goal, VarSet,
+ Info1, Info)
+ ).
transform_goal_2(unify(A0, B0, Purity), Context, VarSet0, Subst, Goal, VarSet,
Info0, Info) -->
@@ -5422,6 +5580,12 @@
unravel_unification(A, B, Context, explicit, [],
VarSet0, Purity, Goal, VarSet, Info0, Info).
+transform_goal_2(edcg_goal(Head0, Body0), Context, VarSet0, Subst, Goal,
+ VarSet, Info0, Info) -->
+ transform_goal(Body0, VarSet0, Subst, Body, VarSet1, Info0, Info1),
+ { term__apply_substitution(Head0, Subst, Head) },
+ transform_edcg_goal(Head, Body, Context, Goal,
+ VarSet1, VarSet, Info1, Info).
:- inst dcg_record_syntax_op = bound("=^"; ":=").
@@ -5702,7 +5866,8 @@
Goal, Info0, Info) -->
% unify the DCG input and output variables
{ create_atomic_unification(TermOutputVar, var(TermInputVar),
- Context, MainContext, SubContext, UnifyDCG) },
+ Context, MainContext, SubContext,
+ Info0 ^ atomic_goal_id, UnifyDCG) },
% process the access function as a get function on
% the output DCG variable
@@ -6108,7 +6273,8 @@
lambda_goal(LambdaPredOrFunc, EvalMethod,
FixModes, LambdaNonLocals,
HeadArgs, LambdaModes, Detism, PredGoal),
- Context, MainContext, [], LambdaConstruct) },
+ Context, MainContext, [], Info2 ^ atomic_goal_id,
+ LambdaConstruct) },
{ make_fresh_arg_var(AditiState0Term, AditiState0Var, [],
VarSet5, VarSet6) },
@@ -6367,11 +6533,180 @@
invalid_proc_id(ProcId),
make_fresh_arg_vars(Args0, VarSet0, HeadVars, VarSet),
MaybeUnifyContext = no,
- Goal = call(PredId, ProcId, HeadVars, not_builtin,
+ EDCGArgs = [],
+ Goal = call(PredId, ProcId, HeadVars, EDCGArgs, not_builtin,
MaybeUnifyContext, unqualified(UpdateStr)) - GoalInfo.
%-----------------------------------------------------------------------------
+
+:- pred transform_edcg_goal(prog_term, hlds_goal, term__context, hlds_goal,
+ prog_varset, prog_varset,
+ transform_info, transform_info, io__state, io__state).
+:- mode transform_edcg_goal(in, in, in, out, in, out, in, out,
+ di, uo) is det.
+
+transform_edcg_goal(Head, Body, Context, Goal,
+ VarSet0, VarSet, Info0, Info) -->
+ transform_edcg_goal_2(Head, Context, [], EdcgGoalInfo, [], Vars, [],
+ Args, VarSet0, VarSet1, Info0, Info1),
+ { goal_info_init(Context, GoalInfo) },
+ { Goal0 = edcg_goal(EdcgGoalInfo, [], Body) - GoalInfo },
+ { ArgContext = edcg_goal },
+ insert_arg_unifications(Vars, Args, Context, ArgContext, no,
+ Goal0, VarSet1, Goal, VarSet, Info1, Info).
+
+:- pred transform_edcg_goal_2(prog_term, term__context,
+ edcg_goal_info, edcg_goal_info, list(prog_var), list(prog_var),
+ list(prog_term), list(prog_term), prog_varset, prog_varset,
+ transform_info, transform_info, io__state, io__state).
+:- mode transform_edcg_goal_2(in, in, in, out, in, out, in, out, in, out,
+ in, out, di, uo) is det.
+transform_edcg_goal_2(Term, Context, EdcgGoalInfo0, EdcgGoalInfo,
+ Vars0, Vars, Args0, Args,
+ VarSet0, VarSet, Info0, Info) -->
+ (
+ { Term = term__functor(term__atom(","), [Term1, Term2],
+ _Context) }
+ ->
+ transform_edcg_goal_2(Term1, Context,
+ EdcgGoalInfo0, EdcgGoalInfo1,
+ Vars0, Vars1, Args0, Args1, VarSet0, VarSet1,
+ Info0, Info1),
+ transform_edcg_goal_2(Term2, Context,
+ EdcgGoalInfo1, EdcgGoalInfo,
+ Vars1, Vars, Args1, Args, VarSet1, VarSet,
+ Info1, Info)
+ ;
+ { Term = term__functor(term__atom("is"), [Term1, Term2],
+ _Context) },
+ { sym_name_and_args(Term1, EDCGArg0, []) },
+ { sym_name_and_args(Term2, Form, FormArgs) }
+ ->
+ { MqInfo0 = Info0 ^ qual_info ^ mq_info },
+ module_qual__qualify_edcg_arg(EDCGArg0, EDCGArg,
+ Context, MqInfo0, MqInfo),
+ { Info = Info0 ^ qual_info ^ mq_info := MqInfo },
+ (
+ { Form = unqualified("passed") },
+ { FormArgs = [Arg] },
+ { make_fresh_arg_vars(FormArgs, VarSet0, [Var],
+ VarSet1) }
+ ->
+ { EdcgGoalInfo = [EDCGArg - passed(Var)
+ | EdcgGoalInfo0] },
+ { Args = [Arg | Args0] },
+ { Vars = [Var | Vars0] },
+ { VarSet = VarSet1 }
+ ;
+ { Form = unqualified("changed") },
+ { FormArgs = [Arg1, Arg2] },
+ { make_fresh_arg_vars(FormArgs, VarSet0, [Var1, Var2],
+ VarSet1) }
+ ->
+ { EdcgGoalInfo = [EDCGArg - changed(Var1, Var2)
+ | EdcgGoalInfo0] },
+ { Args = [Arg1, Arg2 | Args0] },
+ { Vars = [Var1, Var2 | Vars0] },
+ { VarSet = VarSet1 }
+ ;
+ { Form = unqualified("produced") },
+ { FormArgs = [Arg] },
+ { make_fresh_arg_vars(FormArgs, VarSet0, [Var],
+ VarSet1) }
+ ->
+ { EdcgGoalInfo = [EDCGArg - produced(Var)
+ | EdcgGoalInfo0] },
+ { Args = [Arg | Args0] },
+ { Vars = [Var | Vars0] },
+ { VarSet = VarSet1 }
+ ;
+ { Args = Args0 },
+ { Vars = Vars0 },
+ { VarSet = VarSet0 },
+ { EdcgGoalInfo = EdcgGoalInfo0 },
+ { list__length(FormArgs, Arity) },
+ edcg_goal_form_error(Context, EDCGArg, Form, Arity)
+ )
+ ;
+ { EdcgGoalInfo = EdcgGoalInfo0 },
+ { Args = Args0 },
+ { Vars = Vars0 },
+ { VarSet0 = VarSet },
+ { Info = Info0 },
+ edcg_goal_syntax_error(Context)
+ ).
+
+:- pred edcg_goal_syntax_error(prog_context, io__state, io__state).
+:- mode edcg_goal_syntax_error(in, di, uo) is det.
+
+edcg_goal_syntax_error(Context) -->
+ io__set_exit_status(1),
+ prog_out__write_context(Context),
+ io__write_string("Error: "),
+ io__write_string(" unrecognised edcg goal head."),
+ io__write_string("\n").
+
+:- pred edcg_goal_form_error(prog_context, edcg_arg, sym_name, arity,
+ io__state, io__state).
+:- mode edcg_goal_form_error(in, in, in, in, di, uo) is det.
+
+edcg_goal_form_error(Context, EDCGArg, Form, Arity) -->
+ io__set_exit_status(1),
+ prog_out__write_context(Context),
+ io__write_string("Error in EDCG goal head:\n"),
+ prog_out__write_context(Context),
+ io__write_string(" Unrecognised form and arity"),
+ prog_out__write_sym_name_and_arity(Form/Arity),
+ io__write_string("\n"),
+ prog_out__write_context(Context),
+ io__write_string(" for edcg argument "),
+ prog_out__write_sym_name(EDCGArg),
+ io__write_string(".\n").
+
+:- pred transform_explicit_edcg_args(assoc_list(edcg_arg, list(prog_term)),
+ edcgs, sym_name, arity, term__context, prog_substitution,
+ prog_varset, prog_varset, list(prog_var), list(prog_term),
+ transform_info, transform_info, io__state, io__state).
+:- mode transform_explicit_edcg_args(in, out, in, in, in, in, in, out, out,
+ out, in, out, di, uo) is det.
+
+transform_explicit_edcg_args(EDCGs0, EDCGs, PredName, VisualArity,
+ Context, Subst, VarSet0, VarSet, EDCGVars, EDCGArgs,
+ Info0, Info) -->
+ { assoc_list__keys(EDCGs0, EDCGNames1) },
+ { assoc_list__values(EDCGs0, EDCGArgs0) },
+ { MqInfo0 = Info0 ^ qual_info ^ mq_info },
+ module_qual__qualify_edcg_arg_list(EDCGNames1, EDCGNames,
+ PredName, VisualArity, Context, MqInfo0, MqInfo),
+ { Info = Info0 ^ qual_info ^ mq_info := MqInfo },
+ { make_fresh_edcg_arg_vars(EDCGNames, EDCGArgs0, EDCGs,
+ Subst, VarSet0, VarSet, EDCGVars, EDCGArgs) }.
+
+:- pred make_fresh_edcg_arg_vars(list(sym_name), list(list(prog_term)),
+ edcgs, prog_substitution, prog_varset,
+ prog_varset, list(prog_var), list(prog_term)).
+:- mode make_fresh_edcg_arg_vars(in, in, out, in, in, out, out, out) is det.
+
+make_fresh_edcg_arg_vars([], [], [], _, VarSet, VarSet, [], []).
+make_fresh_edcg_arg_vars([_|_], [], _, _, _, _, _, _) :-
+ error("make_fresh_edcg_arg_vars: List length mismatch.").
+make_fresh_edcg_arg_vars([], [_|_], _, _, _, _, _, _) :-
+ error("make_fresh_edcg_arg_vars: List length mismatch.").
+make_fresh_edcg_arg_vars([EDCG | EDCGList], [Args0 | ArgsList],
+ [EDCG - Vars | EDCGs], Subst, VarSet0, VarSet,
+ HeadVars, HeadArgs) :-
+ term__apply_substitution_to_list(Args0, Subst,
+ Args),
+ make_fresh_arg_vars(Args, VarSet0, Vars, VarSet1),
+ make_fresh_edcg_arg_vars(EDCGList, ArgsList, EDCGs, Subst,
+ VarSet1, VarSet, HeadVars0, HeadArgs0),
+ list__append(Vars, HeadVars0, HeadVars),
+ list__append(Args, HeadArgs0, HeadArgs).
+
+
+%-----------------------------------------------------------------------------
+
% `insert_arg_unifications' takes a list of variables,
% a list of terms to unify them with, and a goal, and
% inserts the appropriate unifications onto the front of
@@ -6404,7 +6739,10 @@
cons_id,
unify_main_context,
unify_sub_contexts
- ).
+ )
+ ;
+ edcg_goal
+ .
:- pred insert_arg_unifications(list(prog_var), list(prog_term),
prog_context, arg_context, bool, hlds_goal, prog_varset,
@@ -6646,6 +6984,7 @@
arg_context_to_unify_context(call(PredId), ArgNum, call(PredId, ArgNum), []).
arg_context_to_unify_context(functor(ConsId, MainContext, SubContexts), ArgNum,
MainContext, [ConsId - ArgNum | SubContexts]).
+arg_context_to_unify_context(edcg_goal, _ArgNum, edcg_goal, []).
%-----------------------------------------------------------------------------%
@@ -6709,7 +7048,7 @@
MainContext, SubContext, VarSet0, Purity, Goal, VarSet, Info0, Info)
-->
{ create_atomic_unification(X, var(Y), Context, MainContext,
- SubContext, Goal) },
+ SubContext, Info0 ^ atomic_goal_id, Goal) },
check_expr_purity(Purity, Context, Info0, Info),
{ VarSet0 = VarSet }.
@@ -6905,6 +7244,22 @@
GoalList) },
{ conj_list_to_goal(GoalList, GoalInfo0, Goal) }
;
+ % handle edcg operators
+ { F = term__atom(AtomString) },
+ { edcg_operator_to_string(EDCGOp, AtomString) },
+ { Args = [EDCGTerm] },
+ { sym_name_and_args(EDCGTerm, EDCGArg0, []) }
+ ->
+ { Info0 ^ qual_info ^ mq_info = MqInfo0 },
+ module_qual__qualify_edcg_arg(EDCGArg0, EDCGArg,
+ FunctorContext, MqInfo0, MqInfo),
+ { Info = Info0 ^ qual_info ^ mq_info := MqInfo },
+ { create_atomic_unification(X,
+ edcg_op(EDCGArg, EDCGOp),
+ Context, MainContext, SubContext, Info ^ atomic_goal_id,
+ Goal) },
+ { VarSet0 = VarSet }
+ ;
{ parse_qualified_term(RHS, RHS, "", MaybeFunctor) },
(
{ MaybeFunctor = ok(FunctorName, FunctorArgs) },
@@ -6920,7 +7275,8 @@
),
( { FunctorArgs = [] } ->
{ create_atomic_unification(X, functor(ConsId, []),
- Context, MainContext, SubContext, Goal0) },
+ Context, MainContext, SubContext,
+ Info0 ^ atomic_goal_id, Goal0) },
{ Goal0 = GoalExpr - GoalInfo0 },
{ add_goal_info_purity_feature(GoalInfo0, Purity,
GoalInfo) },
@@ -6932,7 +7288,8 @@
HeadVars, VarSet1) },
{ create_atomic_unification(X,
functor(ConsId, HeadVars), Context,
- MainContext, SubContext, Goal0) },
+ MainContext, SubContext, Info0 ^ atomic_goal_id,
+ Goal0) },
{ ArgContext = functor(ConsId,
MainContext, SubContext) },
% Should this be insert_... rather than append_...?
@@ -7115,7 +7472,7 @@
{ create_atomic_unification(X,
lambda_goal(PredOrFunc, EvalMethod, modes_are_ok,
LambdaNonLocals, LambdaVars, Modes, Det, HLDS_Goal),
- Context, MainContext, SubContext, Goal) }.
+ Context, MainContext, SubContext, Info ^ atomic_goal_id, Goal) }.
%-----------------------------------------------------------------------------%
@@ -7128,7 +7485,8 @@
(
PredOrFunc = predicate,
invalid_proc_id(DummyProcId),
- Goal = call(PredId, DummyProcId, Args,
+ EDCGArgs = [],
+ Goal = call(PredId, DummyProcId, Args, EDCGArgs,
not_builtin, no, SymName) - GoalInfo
;
PredOrFunc = function,
Index: compiler/mark_static_terms.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mark_static_terms.m,v
retrieving revision 1.5
diff -u -r1.5 mark_static_terms.m
--- compiler/mark_static_terms.m 2000/11/17 17:47:49 1.5
+++ compiler/mark_static_terms.m 2001/03/12 15:35:49
@@ -93,7 +93,7 @@
goal_mark_static_terms(Then0, Then, SI_Cond, _SI_Then),
goal_mark_static_terms(Else0, Else, SI0, _SI_Else).
-goal_expr_mark_static_terms(call(A,B,C,D,E,F), call(A,B,C,D,E,F), SI, SI).
+goal_expr_mark_static_terms(call(A,B,C,D,E,F,G), call(A,B,C,D,E,F,G), SI, SI).
goal_expr_mark_static_terms(generic_call(A,B,C,D), generic_call(A,B,C,D),
SI, SI).
@@ -109,6 +109,10 @@
goal_expr_mark_static_terms(bi_implication(_, _), _, _, _) :-
% these should have been expanded out by now
error("fill_expr_slots: unexpected bi_implication").
+
+goal_expr_mark_static_terms(edcg_goal(_, _, _), _, _, _) :-
+ % these should have been expanded out by now
+ error("fill_expr_slots: unexpected edcg_goal").
:- pred conj_mark_static_terms(hlds_goals::in, hlds_goals::out,
static_info::in, static_info::out) is det.
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.197
diff -u -r1.197 mercury_compile.m
--- compiler/mercury_compile.m 2001/03/02 02:05:56 1.197
+++ compiler/mercury_compile.m 2001/03/13 05:03:42
@@ -35,9 +35,9 @@
:- import_module stratify, simplify.
% high-level HLDS transformations
-:- import_module check_typeclass, intermod, trans_opt, table_gen, (lambda).
-:- import_module type_ctor_info, termination, higher_order, accumulator.
-:- import_module inlining, deforest, dnf, magic, dead_proc_elim.
+:- import_module edcg, check_typeclass, intermod, trans_opt, table_gen.
+:- import_module (lambda), type_ctor_info, termination, higher_order.
+:- import_module accumulator, inlining, deforest, dnf, magic, dead_proc_elim.
:- import_module unused_args, unneeded_code, lco.
% the LLDS back-end
@@ -850,16 +850,22 @@
mercury_compile__maybe_dump_hlds(HLDS4, "04", "puritycheck"),
%
+ % Run EDCG expansion
+ %
+ mercury_compile__expand_edcgs(Stats, Verbose,
+ HLDS4, HLDS5, FoundEDCGError),
+
+ %
% Stop here if `--typecheck-only' was specified.
%
globals__io_lookup_bool_option(typecheck_only, TypecheckOnly),
( { TypecheckOnly = yes } ->
- { HLDS = HLDS4 },
+ { HLDS = HLDS5 },
{ bool__or(FoundTypeError, FoundTypeclassError,
FoundError) }
;
{ FoundTypeError = yes ; FoundPostTypecheckError = yes
- ; FoundTypeclassError = yes }
+ ; FoundTypeclassError = yes ; FoundEDCGError = yes }
->
%
% XXX it would be nice if we could go on and mode-check
@@ -868,21 +874,21 @@
% analysis, and currently polymorphism may get internal
% errors if any of the predicates are not type-correct.
%
- { HLDS = HLDS4 },
+ { HLDS = HLDS5 },
{ FoundError = yes }
;
% only write out the `.opt' file if there are no type errors
% or undefined modes
( { FoundTypeError = no, FoundUndefModeError = no } ->
mercury_compile__maybe_write_optfile(MakeOptInt,
- HLDS4, HLDS5)
+ HLDS5, HLDS6)
;
- { HLDS5 = HLDS4 }
+ { HLDS6 = HLDS5 }
),
% if our job was to write out the `.opt' file,
% then we're done
( { MakeOptInt = yes } ->
- { HLDS = HLDS5 },
+ { HLDS = HLDS6 },
{ bool__or(FoundTypeError, FoundTypeclassError,
FoundError) }
;
@@ -890,7 +896,7 @@
% Now go ahead and do the rest of mode checking and
% determinism analysis
%
- mercury_compile__frontend_pass_2_by_phases(HLDS5,
+ mercury_compile__frontend_pass_2_by_phases(HLDS6,
HLDS, FoundModeOrDetError),
{ bool__or(FoundTypeError, FoundModeOrDetError,
FoundError0) },
@@ -1506,6 +1512,26 @@
;
maybe_write_string(Verbose,
"% Program is purity-correct.\n")
+ ),
+ maybe_report_stats(Stats).
+
+:- pred mercury_compile__expand_edcgs(bool, bool, module_info, module_info,
+ bool, io__state, io__state).
+:- mode mercury_compile__expand_edcgs(in, in, in, out, out, di, uo) is det.
+
+mercury_compile__expand_edcgs(Stats, Verbose, HLDS0, HLDS, FoundError) -->
+ { module_info_num_errors(HLDS0, NumErrors0) },
+ edcg__expand_edcgs(HLDS0, HLDS),
+ { module_info_num_errors(HLDS, NumErrors) },
+ ( { NumErrors \= NumErrors0 } ->
+ maybe_write_string(Verbose,
+ "% Program contains EDCG error(s).\n"),
+ { FoundError = yes },
+ io__set_exit_status(1)
+ ;
+ maybe_write_string(Verbose,
+ "% Program is EDCG correct.\n"),
+ { FoundError = no }
),
maybe_report_stats(Stats).
Index: compiler/mercury_to_goedel.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_goedel.m,v
retrieving revision 1.71
diff -u -r1.71 mercury_to_goedel.m
--- compiler/mercury_to_goedel.m 2000/11/01 05:12:02 1.71
+++ compiler/mercury_to_goedel.m 2001/03/12 15:35:49
@@ -143,10 +143,17 @@
goedel_output_item(mode_defn(VarSet, ModeDefn, _Cond), Context) -->
goedel_output_mode_defn(VarSet, ModeDefn, Context).
- % XXX Should we ignore ClassContext and ExistQVars,
+goedel_output_item(etype_defn(_, _, _), _) -->
+ { error("goedel_output_item: unexpected etype_defn") }.
+
+goedel_output_item(emode_defn(_, _, _), _) -->
+ { error("goedel_output_item: unexpected emode_defn") }.
+
+ % XXX Should we ignore ClassContext, ExistQVars and EDCGs,
% or give an error if they're non-empty?
goedel_output_item(pred(TypeVarSet, InstVarSet, _ExistQVars, PredName,
- TypesAndModes, _Det, _Cond, Purity, _ClassContext), Context) -->
+ TypesAndModes, _EDCGs, _Det, _Cond, Purity, _ClassContext),
+ Context) -->
io__write_string("\n"),
maybe_write_line_number(Context),
( { Purity = pure } ->
@@ -186,7 +193,8 @@
% io__write_string("warning: module declarations not yet supported.\n").
[].
-goedel_output_item(pred_clause(VarSet, PredName, Args, Body), Context) -->
+goedel_output_item(pred_clause(VarSet, PredName, Args, Body, _MaybeEDCG),
+ Context) -->
maybe_write_line_number(Context),
goedel_output_pred_clause(VarSet, PredName, Args, Body, Context).
@@ -655,7 +663,7 @@
io__write_string(")").
% XXX should preserve some of the qualification information?
-goedel_output_goal_2(call(Name, Term, Purity), VarSet, Indent) -->
+goedel_output_goal_2(call(Name, Term, _EDCGTerm, Purity), VarSet, Indent) -->
( { Purity = pure } ->
[]
;
@@ -680,6 +688,8 @@
io__write_string(" = "),
goedel_output_term(B, VarSet).
+goedel_output_goal_2(edcg_goal(_, _), _, _) -->
+ { error("goedel_output_goal_2: unexpected edcg_goal") }.
:- pred goedel_output_call(prog_term, prog_varset, int, io__state, io__state).
:- mode goedel_output_call(in, in, in, di, uo) is det.
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list