[m-rev.] EDCG diff 4
Peter Nicholas MALKIN
pnmalk at students.cs.mu.oz.au
Thu Mar 15 19:25:16 AEDT 2001
Index: compiler/rl_key.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl_key.m,v
retrieving revision 1.8
diff -u -r1.8 rl_key.m
--- compiler/rl_key.m 2000/10/06 10:18:33 1.8
+++ compiler/rl_key.m 2001/03/12 15:35:54
@@ -607,7 +607,7 @@
rl_key__extract_key_range(Goal) -->
( { Goal = unify(_, _, _, Unify, _) - _ } ->
rl_key__extract_key_range_unify(Unify)
- ; { Goal = call(PredId, ProcId, CallArgs, _, _, _) - _ } ->
+ ; { Goal = call(PredId, ProcId, CallArgs, _, _, _, _) - _ } ->
rl_key__extract_key_range_call(PredId, ProcId, CallArgs)
; { Goal = disj(Goals, _) - _ } ->
key_info_get_constraints(Cnstrs0),
Index: compiler/saved_vars.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/saved_vars.m,v
retrieving revision 1.29
diff -u -r1.29 saved_vars.m
--- compiler/saved_vars.m 2000/11/17 17:48:39 1.29
+++ compiler/saved_vars.m 2001/03/12 15:35:55
@@ -125,7 +125,7 @@
Goal = GoalExpr0 - GoalInfo0,
SlotInfo = SlotInfo0
;
- GoalExpr0 = call(_, _, _, _, _, _),
+ GoalExpr0 = call(_, _, _, _, _, _, _),
Goal = GoalExpr0 - GoalInfo0,
SlotInfo = SlotInfo0
;
@@ -140,6 +140,10 @@
GoalExpr0 = bi_implication(_, _),
% these should have been expanded out by now
error("saved_vars_in_goal: unexpected bi_implication")
+ ;
+ GoalExpr0 = edcg_goal(_, _, _),
+ % these should have been expanded out by now
+ error("saved_vars_in_goal: unexpected edcg_goal")
).
%-----------------------------------------------------------------------------%
@@ -274,7 +278,7 @@
IsNonLocal, SlotInfo1, Goals1, SlotInfo),
Goals = [NewConstruct, Goal1 | Goals1]
;
- Goal0Expr = call(_, _, _, _, _, _),
+ Goal0Expr = call(_, _, _, _, _, _, _),
rename_var(SlotInfo0, Var, _NewVar, Subst, SlotInfo1),
goal_util__rename_vars_in_goal(Construct, Subst,
NewConstruct),
@@ -379,6 +383,10 @@
Goal0Expr = bi_implication(_, _),
% these should have been expanded out by now
error("saved_vars_delay_goal: unexpected bi_implication")
+ ;
+ Goal0Expr = edcg_goal(_, _, _),
+ % these should have been expanded out by now
+ error("saved_vars_delay_goal: unexpected edcg_goal")
)
;
saved_vars_delay_goal(Goals0, Construct, Var, IsNonLocal,
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.93
diff -u -r1.93 simplify.m
--- compiler/simplify.m 2001/02/03 22:39:28 1.93
+++ compiler/simplify.m 2001/03/12 15:35:55
@@ -688,7 +688,7 @@
).
simplify__goal_2(Goal0, GoalInfo0, Goal, GoalInfo, Info0, Info) :-
- Goal0 = call(PredId, ProcId, Args, IsBuiltin, _, _),
+ Goal0 = call(PredId, ProcId, Args, _, IsBuiltin, _, _),
simplify_info_get_module_info(Info0, ModuleInfo),
module_info_pred_proc_info(ModuleInfo, PredId, ProcId, PredInfo,
ProcInfo),
@@ -807,7 +807,7 @@
simplify_info_get_instmap(Info3, Instmap0),
simplify_info_get_module_info(Info3, ModuleInfo2),
(
- Goal1 = call(_, _, _, _, _, _),
+ Goal1 = call(_, _, _, _, _, _, _),
evaluate_builtin(PredId, ProcId, Args, GoalInfo0,
Goal2, GoalInfo2, Instmap0,
ModuleInfo2, ModuleInfo3)
@@ -1158,6 +1158,10 @@
% these should have been expanded out by now
error("simplify__goal_2: unexpected bi_implication").
+simplify__goal_2(edcg_goal(_, _, _), _, _, _, _, _) :-
+ % these should have been expanded out by now
+ error("simplify__goal_2: unexpected edcg_goal").
+
%-----------------------------------------------------------------------------%
:- pred simplify__process_compl_unify(prog_var, prog_var,
@@ -1208,7 +1212,7 @@
},
{ hlds_pred__in_in_unification_proc_id(ProcId) },
{ CallContext = call_unify_context(XVar, var(YVar), Context) },
- { Call0 = call(PredId, ProcId, ArgVars, not_builtin,
+ { Call0 = call(PredId, ProcId, ArgVars, [], not_builtin,
yes(CallContext), SymName) },
simplify__goal_2(Call0, GoalInfo0, Call1, GoalInfo),
{ Call = Call1 - GoalInfo },
@@ -1301,7 +1305,7 @@
goal_info_get_nonlocals(GoalInfo0, NonLocals0),
set__insert(NonLocals0, TypeInfoVar, NonLocals),
goal_info_set_nonlocals(GoalInfo0, NonLocals, GoalInfo),
- Call = call(PredId, ProcId, ArgVars, BuiltinState, yes(CallContext),
+ Call = call(PredId, ProcId, ArgVars, [], BuiltinState, yes(CallContext),
SymName) - GoalInfo.
:- pred simplify__call_specific_unify(type_id::in, list(prog_var)::in,
@@ -1317,7 +1321,7 @@
map__lookup(SpecialPredMap, unify - TypeId, PredId),
SymName = unqualified("__Unify__"),
CallContext = call_unify_context(XVar, var(YVar), Context),
- CallExpr = call(PredId, ProcId, ArgVars, not_builtin,
+ CallExpr = call(PredId, ProcId, ArgVars, [], not_builtin,
yes(CallContext), SymName),
% add the extra type_info vars to the nonlocals for the call
@@ -2288,7 +2292,7 @@
;
BeforeAfter = before,
Goal = GoalExpr - _,
- GoalExpr \= call(_, _, _, _, _, _),
+ GoalExpr \= call(_, _, _, _, _, _, _),
GoalExpr \= generic_call(_, _, _, _),
GoalExpr \= pragma_foreign_code(_, _, _, _, _, _, _)
)
Index: compiler/store_alloc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/store_alloc.m,v
retrieving revision 1.75
diff -u -r1.75 store_alloc.m
--- compiler/store_alloc.m 2000/11/17 17:48:42 1.75
+++ compiler/store_alloc.m 2001/03/12 15:35:55
@@ -201,8 +201,8 @@
store_alloc_in_goal_2(generic_call(A, B, C, D), Liveness, _, _,
_, generic_call(A, B, C, D), Liveness).
-store_alloc_in_goal_2(call(A, B, C, D, E, F), Liveness, _, _,
- _, call(A, B, C, D, E, F), Liveness).
+store_alloc_in_goal_2(call(A, B, C, D, E, F, G), Liveness, _, _,
+ _, call(A, B, C, D, E, F, G), Liveness).
store_alloc_in_goal_2(unify(A,B,C,D,E), Liveness, _, _,
_, unify(A,B,C,D,E), Liveness).
@@ -213,6 +213,10 @@
store_alloc_in_goal_2(bi_implication(_, _), _, _, _, _, _, _) :-
% these should have been expanded out by now
error("store_alloc_in_goal_2: unexpected bi_implication").
+
+store_alloc_in_goal_2(edcg_goal(_, _, _), _, _, _, _, _, _) :-
+ % these should have been expanded out by now
+ error("store_alloc_in_goal_2: unexpected edcg_goal").
%-----------------------------------------------------------------------------%
Index: compiler/stratify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/stratify.m,v
retrieving revision 1.23
diff -u -r1.23 stratify.m
--- compiler/stratify.m 2000/11/17 17:48:43 1.23
+++ compiler/stratify.m 2001/03/14 06:19:16
@@ -195,8 +195,8 @@
).
first_order_check_goal(unify(_Var, _RHS, _Mode, _Uni, _Context), _GoalInfo,
_Negated, _WholeScc, _ThisPredProcId, _, Module, Module) --> [].
-first_order_check_goal(call(CPred, CProc, _Args, _BuiltinState, _Contex, _Sym),
- GInfo, Negated, WholeScc, ThisPredProcId,
+first_order_check_goal(call(CPred, CProc, _Args, _EDCGArgs, _BuiltinState,
+ _Contex, _Sym), GInfo, Negated, WholeScc, ThisPredProcId,
Error, Module0, Module) -->
{ Callee = proc(CPred, CProc) },
(
@@ -216,6 +216,9 @@
first_order_check_goal(bi_implication(_, _), _, _, _, _, _, _, _) -->
% these should have been expanded out by now
{ error("first_order_check_goal: unexpected bi_implication") }.
+first_order_check_goal(edcg_goal(_, _, _), _, _, _, _, _, _, _) -->
+ % these should have been expanded out by now
+ { error("first_order_check_goal: unexpected edcg_goal") }.
:- pred first_order_check_goal_list(list(hlds_goal), bool,
list(pred_proc_id), pred_proc_id, bool, module_info,
@@ -341,9 +344,9 @@
higher_order_check_goal(unify(_Var, _RHS, _Mode, _Uni, _Context), _GoalInfo,
_Negated, _WholeScc, _ThisPredProcId, _HighOrderLoops,
_Error, Module, Module) --> [].
-higher_order_check_goal((call(_CPred, _CProc, _Args, _Builtin, _Contex, Sym)),
- GoalInfo, _Negated, _WholeScc, ThisPredProcId, HighOrderLoops,
- Error, Module0, Module) -->
+higher_order_check_goal((call(_CPred, _CProc, _Args, _EDCGArgs, _Builtin,
+ _Contex, Sym)), GoalInfo, _Negated, _WholeScc, ThisPredProcId,
+ HighOrderLoops, Error, Module0, Module) -->
(
% XXX : is this good enough to detect all calls to solutions ?
{ HighOrderLoops = yes },
@@ -384,6 +387,9 @@
higher_order_check_goal(bi_implication(_, _), _, _, _, _, _, _, _, _) -->
% these should have been expanded out by now
{ error("higher_order_check_goal: unexpected bi_implication") }.
+higher_order_check_goal(edcg_goal(_, _, _), _, _, _, _, _, _, _, _) -->
+ % these should have been expanded out by now
+ { error("higher_order_check_goal: unexpected edcg_goal") }.
:- pred higher_order_check_goal_list(list(hlds_goal), bool, set(pred_proc_id),
pred_proc_id, bool, bool, module_info, module_info,
@@ -789,8 +795,8 @@
).
% add this call to the call list
-check_goal1(call(CPred, CProc, _Args, _Builtin, _Contex, _Sym), Calls0, Calls,
- HasAT, HasAT, CallsHO, CallsHO) :-
+check_goal1(call(CPred, CProc, _Args, _EDCGArgs, _Builtin, _Contex, _Sym),
+ Calls0, Calls, HasAT, HasAT, CallsHO, CallsHO) :-
set__insert(Calls0, proc(CPred, CProc), Calls).
% record that the higher order call was made
@@ -828,6 +834,10 @@
check_goal1(bi_implication(_, _), _, _, _, _, _, _) :-
% these should have been expanded out by now
error("check_goal1: unexpected bi_implication").
+
+check_goal1(edcg_goal(_, _, _), _, _, _, _, _, _) :-
+ % these should have been expanded out by now
+ error("check_goal1: unexpected edcg_goal").
:- pred check_goal_list(list(hlds_goal), set(pred_proc_id), set(pred_proc_id),
set(pred_proc_id), set(pred_proc_id), bool, bool).
@@ -890,8 +900,8 @@
).
% add this call to the call list
-get_called_procs(call(CPred, CProc, _Args, _Builtin, _Contex, _Sym), Calls0,
- Calls) :-
+get_called_procs(call(CPred, CProc, _Args, _EDCGArgs, _Builtin, _Contex, _Sym),
+ Calls0, Calls) :-
Calls = [proc(CPred, CProc) | Calls0].
get_called_procs(generic_call(_Var, _Vars, _Modes, _Det), Calls, Calls).
@@ -918,6 +928,9 @@
get_called_procs(bi_implication(_, _), _, _) :-
% these should have been expanded out by now
error("get_called_procs: unexpected bi_implication").
+get_called_procs(edcg_goal(_, _, _), _, _) :-
+ % these should have been expanded out by now
+ error("get_called_procs: unexpected edcg_goal").
:- pred check_goal_list(list(hlds_goal), list(pred_proc_id),
list(pred_proc_id)).
Index: compiler/switch_detection.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/switch_detection.m,v
retrieving revision 1.94
diff -u -r1.94 switch_detection.m
--- compiler/switch_detection.m 2000/12/08 06:50:17 1.94
+++ compiler/switch_detection.m 2001/03/12 15:35:55
@@ -189,8 +189,8 @@
detect_switches_in_goal_2(generic_call(A,B,C,D), _, _, _, _,
generic_call(A,B,C,D)).
-detect_switches_in_goal_2(call(A,B,C,D,E,F), _, _, _, _,
- call(A,B,C,D,E,F)).
+detect_switches_in_goal_2(call(A,B,C,D,E,F,G), _, _, _, _,
+ call(A,B,C,D,E,F,G)).
detect_switches_in_goal_2(unify(A,RHS0,C,D,E), __GoalInfo, InstMap0,
VarTypes, ModuleInfo, unify(A,RHS,C,D,E)) :-
@@ -219,6 +219,9 @@
detect_switches_in_goal_2(bi_implication(_, _), _, _, _, _, _) :-
% these should have been expanded out by now
error("detect_switches_in_goal_2: unexpected bi_implication").
+detect_switches_in_goal_2(edcg_goal(_, _, _), _, _, _, _, _) :-
+ % these should have been expanded out by now
+ error("detect_switches_in_goal_2: unexpected edcg_goal").
%-----------------------------------------------------------------------------%
Index: compiler/table_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/table_gen.m,v
retrieving revision 1.27
diff -u -r1.27 table_gen.m
--- compiler/table_gen.m 2000/12/06 06:05:19 1.27
+++ compiler/table_gen.m 2001/03/12 15:35:56
@@ -1490,7 +1490,7 @@
error(ErrorMessage)
),
- Call = call(PredId, ProcId, Args, not_builtin, no,
+ Call = call(PredId, ProcId, Args, [], not_builtin, no,
qualified(BuiltinModule, PredName)),
set__init(NonLocals0),
set__insert_list(NonLocals0, Args, NonLocals),
Index: compiler/term_traversal.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/term_traversal.m,v
retrieving revision 1.15
diff -u -r1.15 term_traversal.m
--- compiler/term_traversal.m 2000/11/17 17:48:45 1.15
+++ compiler/term_traversal.m 2001/03/12 15:35:56
@@ -213,7 +213,7 @@
goal_info_get_context(GoalInfo, Context),
add_error(Context, horder_call, Params, Info0, Info).
-traverse_goal_2(call(CallPredId, CallProcId, Args, _, _, _),
+traverse_goal_2(call(CallPredId, CallProcId, Args, _, _, _, _),
GoalInfo, Params, Info0, Info) :-
goal_info_get_context(GoalInfo, Context),
params_get_module_info(Params, Module),
@@ -291,6 +291,10 @@
traverse_goal_2(bi_implication(_, _), _, _, _, _) :-
% these should have been expanded out by now
error("traverse_goal_2traverse_goal_2: unexpected bi_implication").
+
+traverse_goal_2(edcg_goal(_, _, _), _, _, _, _) :-
+ % these should have been expanded out by now
+ error("traverse_goal_2traverse_goal_2: unexpected edcg_goal").
%-----------------------------------------------------------------------------%
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.298
diff -u -r1.298 typecheck.m
--- compiler/typecheck.m 2001/03/08 06:54:31 1.298
+++ compiler/typecheck.m 2001/03/14 06:20:49
@@ -158,7 +158,7 @@
:- implementation.
-:- import_module hlds_goal, prog_util, type_util, modules, code_util.
+:- import_module hlds_goal, prog_util, type_util, modules, code_util, edcg.
:- import_module prog_io, prog_io_util, prog_out, hlds_out, error_util.
:- import_module mercury_to_mercury, mode_util, options, getopt, globals.
:- import_module passes_aux, clause_to_proc, special_pred, inst_match.
@@ -829,7 +829,7 @@
goal_info_set_nonlocals(GoalInfo0, NonLocals, GoalInfo),
Goal = GoalExpr - GoalInfo,
ProcIds = [], % the clause applies to all procedures.
- Clause = clause(ProcIds, Goal, Context),
+ Clause = clause(ProcIds, Goal, edcg_no, Context),
clauses_info_set_clauses(ClausesInfo0, [Clause], ClausesInfo),
pred_info_set_clauses_info(PredInfo0, ClausesInfo, PredInfo)
;
@@ -880,14 +880,14 @@
typecheck_clause(Clause0, HeadVars, ArgTypes, Clause) -->
% XXX abstract clause/3
- { Clause0 = clause(Modes, Body0, Context) },
+ { Clause0 = clause(Modes, Body0, MaybeEdcg, Context) },
typecheck_info_set_context(Context),
% typecheck the clause - first the head unification, and
% then the body
typecheck_var_has_type_list(HeadVars, ArgTypes, 1),
typecheck_goal(Body0, Body),
checkpoint("end of clause"),
- { Clause = clause(Modes, Body, Context) },
+ { Clause = clause(Modes, Body, MaybeEdcg, Context) },
typecheck_info_set_context(Context),
typecheck_check_for_ambiguity(clause_only, HeadVars).
@@ -1041,10 +1041,11 @@
checkpoint("some"),
typecheck_goal(G0, G),
ensure_vars_have_a_type(Vs).
-typecheck_goal_2(call(_, Mode, Args, Builtin, Context, Name),
- call(PredId, Mode, Args, Builtin, Context, Name)) -->
+typecheck_goal_2(call(_, Mode, Args, EDCGArgs, Builtin, Context, Name),
+ call(PredId, Mode, Args, EDCGArgs, Builtin, Context, Name)) -->
checkpoint("call"),
{ list__length(Args, Arity) },
+ typecheck_call_pred_edcgs(EDCGArgs),
typecheck_info_set_called_predid(call(predicate - Name/Arity)),
typecheck_call_pred(predicate - Name/Arity, Args, PredId).
typecheck_goal_2(generic_call(GenericCall0, Args, C, D),
@@ -1091,6 +1092,10 @@
checkpoint("<=>"),
typecheck_goal(LHS0, LHS),
typecheck_goal(RHS0, RHS).
+typecheck_goal_2(edcg_goal(GoalInfo, Inferred, Goal0),
+ edcg_goal(GoalInfo, Inferred, Goal)) -->
+ typecheck_edcg_goal(GoalInfo),
+ typecheck_goal(Goal0, Goal).
%-----------------------------------------------------------------------------%
@@ -1314,6 +1319,23 @@
aditi_builtin_first_state_arg(aditi_insert_delete_modify(_, _, _), _) = 2 .
%-----------------------------------------------------------------------------%
+
+:- pred typecheck_edcg_goal(edcg_goal_info, typecheck_info, typecheck_info).
+:- mode typecheck_edcg_goal(in, typecheck_info_di, typecheck_info_uo) is det.
+
+typecheck_edcg_goal([]) --> [].
+typecheck_edcg_goal([EDCGArg - passed(Var) | EDCGForms]) -->
+ typecheck_unify_edcg_var(EDCGArg, Var),
+ typecheck_edcg_goal(EDCGForms).
+typecheck_edcg_goal([EDCGArg - produced(Var) | EDCGForms]) -->
+ typecheck_unify_edcg_var(EDCGArg, Var),
+ typecheck_edcg_goal(EDCGForms).
+typecheck_edcg_goal([EDCGArg - changed(Var1, Var2) | EDCGForms]) -->
+ typecheck_unify_edcg_var(EDCGArg, Var1),
+ typecheck_unify_edcg_var(EDCGArg, Var2),
+ typecheck_edcg_goal(EDCGForms).
+
+%-----------------------------------------------------------------------------%
:- pred typecheck_call_pred(simple_call_id, list(prog_var), pred_id,
typecheck_info, typecheck_info).
@@ -1418,7 +1440,20 @@
map__lookup(Preds, PredId, PredInfo),
pred_info_arg_types(PredInfo, PredTypeVarSet, PredExistQVars,
PredArgTypes0),
- AdjustArgTypes(PredArgTypes0, PredArgTypes),
+ pred_info_visual_arity(PredInfo, VisualArity),
+ list__length(Args, CallArity),
+ (
+ % Check to see if the predicate call is an edcg expanded
+ % predicate call
+ VisualArity = CallArity
+ ->
+ PredArgTypes1 = PredArgTypes0
+ ;
+ pred_info_edcg_args(PredInfo, pred_edcg_info(EDCGForms, _, _)),
+ get_edcg_pred_types(ModuleInfo, EDCGForms, EDCGTypes),
+ list__append(PredArgTypes0, EDCGTypes, PredArgTypes1)
+ ),
+ AdjustArgTypes(PredArgTypes1, PredArgTypes),
pred_info_get_class_context(PredInfo, PredClassContext),
%
% rename apart the type variables in
@@ -1507,8 +1542,10 @@
module_info_get_predicate_table(ModuleInfo, PredicateTable),
predicate_table_get_preds(PredicateTable, Preds),
typecheck_info_get_type_assign_set(TypeCheckInfo0, TypeAssignSet0),
- get_overloaded_pred_arg_types(PredIdList, Preds, AdjustArgTypes,
- TypeAssignSet0, [], ArgsTypeAssignSet),
+ list__length(Args, CallArity),
+ get_overloaded_pred_arg_types(PredIdList, Preds, ModuleInfo,
+ AdjustArgTypes, TypeAssignSet0, CallArity, [],
+ ArgsTypeAssignSet),
%
% then unify the types of the call arguments with the
% called predicates' arg types
@@ -1516,27 +1553,65 @@
typecheck_var_has_arg_type_list(Args, 1, ArgsTypeAssignSet,
TypeCheckInfo0, TypeCheckInfo).
-:- pred get_overloaded_pred_arg_types(list(pred_id), pred_table,
- adjust_arg_types, type_assign_set,
+:- pred get_overloaded_pred_arg_types(list(pred_id), pred_table, module_info,
+ adjust_arg_types, type_assign_set, arity,
args_type_assign_set, args_type_assign_set).
-:- mode get_overloaded_pred_arg_types(in, in, in(adjust_arg_types),
- in, in, out) is det.
+:- mode get_overloaded_pred_arg_types(in, in, in, in(adjust_arg_types),
+ in, in, in, out) is det.
-get_overloaded_pred_arg_types([], _Preds, _AdjustArgTypes, _TypeAssignSet0,
- ArgsTypeAssignSet, ArgsTypeAssignSet).
-get_overloaded_pred_arg_types([PredId | PredIds], Preds, AdjustArgTypes,
- TypeAssignSet0, ArgsTypeAssignSet0, ArgsTypeAssignSet) :-
+get_overloaded_pred_arg_types([], _Preds, _, _AdjustArgTypes, _TypeAssignSet0,
+ _, ArgsTypeAssignSet, ArgsTypeAssignSet).
+get_overloaded_pred_arg_types([PredId | PredIds], Preds, ModuleInfo,
+ AdjustArgTypes, TypeAssignSet0, CallArity,
+ ArgsTypeAssignSet0, ArgsTypeAssignSet) :-
map__lookup(Preds, PredId, PredInfo),
pred_info_arg_types(PredInfo, PredTypeVarSet, PredExistQVars,
PredArgTypes0),
- call(AdjustArgTypes, PredArgTypes0, PredArgTypes),
+ pred_info_visual_arity(PredInfo, VisualArity),
+ (
+ % Check to see if the predicate call is an EDCG expanded
+ % predicate call
+ VisualArity = CallArity
+ ->
+ PredArgTypes1 = PredArgTypes0
+ ;
+ pred_info_edcg_args(PredInfo,
+ pred_edcg_info(EDCGForms, _, _)),
+ get_edcg_pred_types(ModuleInfo, EDCGForms, EDCGTypes),
+ list__append(PredArgTypes0, EDCGTypes, PredArgTypes1)
+ ),
+ call(AdjustArgTypes, PredArgTypes1, PredArgTypes),
pred_info_get_class_context(PredInfo, PredClassContext),
rename_apart(TypeAssignSet0, PredTypeVarSet, PredExistQVars,
PredArgTypes, PredClassContext,
ArgsTypeAssignSet0, ArgsTypeAssignSet1),
- get_overloaded_pred_arg_types(PredIds, Preds, AdjustArgTypes,
- TypeAssignSet0, ArgsTypeAssignSet1, ArgsTypeAssignSet).
+ get_overloaded_pred_arg_types(PredIds, Preds, ModuleInfo,
+ AdjustArgTypes, TypeAssignSet0, CallArity, ArgsTypeAssignSet1,
+ ArgsTypeAssignSet).
+
+:- pred typecheck_call_pred_edcgs(edcgs, typecheck_info, typecheck_info).
+:- mode typecheck_call_pred_edcgs(in, typecheck_info_di,
+ typecheck_info_uo) is det.
+typecheck_call_pred_edcgs([], TypeCheckInfo, TypeCheckInfo).
+typecheck_call_pred_edcgs([EDCG - Vars | Rest], TypeCheckInfo0,
+ TypeCheckInfo) :-
+ typecheck_call_pred_edcgs_2(EDCG, Vars,
+ TypeCheckInfo0, TypeCheckInfo1),
+ typecheck_call_pred_edcgs(Rest, TypeCheckInfo1, TypeCheckInfo).
+
+:- pred typecheck_call_pred_edcgs_2(edcg_arg, list(prog_var),
+ typecheck_info, typecheck_info).
+:- mode typecheck_call_pred_edcgs_2(in, in, typecheck_info_di,
+ typecheck_info_uo) is det.
+
+typecheck_call_pred_edcgs_2(_EDCG, [], TypeCheckInfo, TypeCheckInfo).
+typecheck_call_pred_edcgs_2(EDCG, [Var | Vars], TypeCheckInfo0,
+ TypeCheckInfo) :-
+ typecheck_unify_edcg_var(EDCG, Var, TypeCheckInfo0, TypeCheckInfo1),
+ typecheck_call_pred_edcgs_2(EDCG, Vars, TypeCheckInfo1,
+ TypeCheckInfo).
+
%-----------------------------------------------------------------------------%
% Note: calls to preds declared in `.opt' files should always be
@@ -1584,9 +1659,24 @@
module_info_pred_info(ModuleInfo, PredId, PredInfo),
pred_info_arg_types(PredInfo, PredTVarSet, PredExistQVars0,
PredArgTypes0),
+ pred_info_visual_arity(PredInfo, VisualArity),
+ list__length(ArgTypes, CallArity),
+ (
+ % Check to see if the predicate call is an edcg expanded
+ % predicate call
+ VisualArity = CallArity
+ ->
+ PredArgTypes1 = PredArgTypes0
+ ;
+ pred_info_edcg_args(PredInfo,
+ pred_edcg_info(EDCGForms, _, _)),
+ get_edcg_pred_types(ModuleInfo, EDCGForms,
+ EDCGTypes),
+ list__append(PredArgTypes0, EDCGTypes, PredArgTypes1)
+ ),
arg_type_list_subsumes(TVarSet, ArgTypes,
- PredTVarSet, PredExistQVars0, PredArgTypes0)
+ PredTVarSet, PredExistQVars0, PredArgTypes1)
->
%
% we've found a matching predicate
@@ -2132,6 +2222,8 @@
OrigTypeAssignSet) },
typecheck_unify_var_functor(X, F, As),
perform_context_reduction(OrigTypeAssignSet).
+typecheck_unification(Var, edcg_op(A, B), edcg_op(A, B)) -->
+ typecheck_unify_edcg_var(A, Var).
typecheck_unification(X,
lambda_goal(PredOrFunc, EvalMethod, FixModes, NonLocals, Vars,
Modes, Det, Goal0),
@@ -2161,6 +2253,34 @@
TypeAssignSet, TypeCheckInfo)
).
+:- pred typecheck_unify_edcg_var(edcg_arg, prog_var,
+ typecheck_info, typecheck_info).
+:- mode typecheck_unify_edcg_var(in, in, typecheck_info_di, typecheck_info_uo)
+ is det.
+
+typecheck_unify_edcg_var(EDCG, VarId, TypeCheckInfo0, TypeCheckInfo) :-
+ typecheck_info_get_module_info(TypeCheckInfo0, ModuleInfo),
+ module_info_edcgs(ModuleInfo, EdcgTable),
+ edcg_table_fetch_edcg_type(EDCG, EdcgTable, Type),
+ typecheck_info_get_type_assign_set(TypeCheckInfo0, TypeAssignSet0),
+ typecheck_var_has_type_2(TypeAssignSet0, VarId, Type,
+ [], TypeAssignSet),
+ (
+ TypeAssignSet = [],
+ TypeAssignSet0 \= []
+ ->
+ typecheck_info_get_io_state(TypeCheckInfo0, IOState0),
+ report_error_unif_edcg_var(TypeCheckInfo0, VarId, EDCG,
+ TypeAssignSet0, IOState0, IOState),
+ typecheck_info_set_io_state(TypeCheckInfo0, IOState,
+ TypeCheckInfo1),
+ typecheck_info_set_found_error(TypeCheckInfo1, yes,
+ TypeCheckInfo)
+ ;
+ typecheck_info_set_type_assign_set(TypeCheckInfo0,
+ TypeAssignSet, TypeCheckInfo)
+ ).
+
:- pred typecheck_unify_var_functor(prog_var, cons_id, list(prog_var),
typecheck_info, typecheck_info).
:- mode typecheck_unify_var_functor(in, in, in, typecheck_info_di,
@@ -4671,6 +4791,49 @@
io__write_string(".\n"),
write_type_assign_set_msg(TypeAssignSet, VarSet).
+
+:- pred report_error_unif_edcg_var(typecheck_info, prog_var, edcg_arg,
+ type_assign_set, io__state, io__state).
+:- mode report_error_unif_edcg_var(typecheck_info_no_io, in, in, in, di, uo)
+ is det.
+
+report_error_unif_edcg_var(TypeCheckInfo, Var, EDCG, TypeAssignSet) -->
+
+ { typecheck_info_get_context(TypeCheckInfo, Context) },
+ { typecheck_info_get_varset(TypeCheckInfo, VarSet) },
+ { typecheck_info_get_unify_context(TypeCheckInfo, UnifyContext) },
+ { typecheck_info_get_module_info(TypeCheckInfo, ModuleInfo) },
+ { module_info_edcgs(ModuleInfo, EdcgTable) },
+ { edcg_table_fetch_edcg_type(EDCG, EdcgTable, Type) },
+
+ write_context_and_pred_id(TypeCheckInfo),
+ hlds_out__write_unify_context(UnifyContext, Context),
+
+ prog_out__write_context(Context),
+ io__write_string(" type error in unification of variable `"),
+ mercury_output_var(Var, VarSet, no),
+ io__write_string("'\n"),
+ prog_out__write_context(Context),
+ io__write_string(" and edcg variable `"),
+ mercury_output_sym_name(EDCG),
+ io__write_string("'.\n"),
+
+ prog_out__write_context(Context),
+ io__write_string(" `"),
+ mercury_output_var(Var, VarSet, no),
+ io__write_string("'"),
+ write_type_of_var(TypeCheckInfo, TypeAssignSet, Var),
+ io__write_string(",\n"),
+
+ prog_out__write_context(Context),
+ io__write_string(" `"),
+ mercury_output_sym_name(EDCG),
+ io__write_string("'"),
+ { varset__init(TVarSet) },
+ mercury_output_term(Type, TVarSet, no),
+ io__write_string(".\n"),
+
+ write_type_assign_set_msg(TypeAssignSet, VarSet).
:- pred report_error_functor_type(typecheck_info, prog_var,
list(cons_type_info), cons_id, int, type_assign_set,
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.91
diff -u -r1.91 unify_proc.m
--- compiler/unify_proc.m 2000/11/06 08:28:40 1.91
+++ compiler/unify_proc.m 2001/03/12 15:35:57
@@ -700,7 +700,7 @@
%
{ invalid_pred_id(PredId) },
{ invalid_proc_id(ModeId) },
- { Call = call(PredId, ModeId, [H1, H2], not_builtin,
+ { Call = call(PredId, ModeId, [H1, H2], [], not_builtin,
no, PredName) },
{ goal_info_init(GoalInfo0) },
{ goal_info_set_context(GoalInfo0, Context,
@@ -886,7 +886,7 @@
Body, Varset, Types, _Warnings) },
unify_proc__info_set_varset(Varset),
unify_proc__info_set_types(Types),
- { Clause = clause([], Body, Context) }.
+ { Clause = clause([], Body, edcg_no, Context) }.
%-----------------------------------------------------------------------------%
@@ -1505,7 +1505,7 @@
error(ErrorMessage)
},
{ hlds_pred__initial_proc_id(ProcId) },
- { Call = call(PredId, ProcId, ArgVars, not_builtin,
+ { Call = call(PredId, ProcId, ArgVars, [], not_builtin,
no, qualified(MercuryBuiltin, Name)) },
{ goal_info_init(GoalInfo0) },
{ goal_info_set_context(GoalInfo0, Context, GoalInfo) },
@@ -1523,7 +1523,7 @@
polymorphism__get_special_proc(Type, SpecialPredId, ModuleInfo,
PredName, PredId, ProcId)
->
- GoalExpr = call(PredId, ProcId, ArgVars, not_builtin, no,
+ GoalExpr = call(PredId, ProcId, ArgVars, [], not_builtin, no,
PredName),
set__list_to_set(ArgVars, NonLocals),
goal_info_init(NonLocals, InstmapDelta, Detism, GoalInfo0),
Index: compiler/unique_modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unique_modes.m,v
retrieving revision 1.70
diff -u -r1.70 unique_modes.m
--- compiler/unique_modes.m 2001/01/17 01:42:12 1.70
+++ compiler/unique_modes.m 2001/03/12 15:35:57
@@ -466,8 +466,8 @@
mode_info_unset_call_context,
mode_checkpoint(exit, "generic_call").
-unique_modes__check_goal_2(call(PredId, ProcId0, Args, Builtin, CallContext,
- PredName), _GoalInfo0, Goal) -->
+unique_modes__check_goal_2(call(PredId, ProcId0, Args, EDCGArgs, Builtin,
+ CallContext, PredName), _GoalInfo0, Goal) -->
{ prog_out__sym_name_to_string(PredName, PredNameString) },
{ string__append("call ", PredNameString, CallString) },
mode_checkpoint(enter, CallString),
@@ -477,7 +477,8 @@
mode_info_set_call_context(call(call(CallId))),
unique_modes__check_call(PredId, ProcId0, Args, ProcId),
- { Goal = call(PredId, ProcId, Args, Builtin, CallContext, PredName) },
+ { Goal = call(PredId, ProcId, Args, EDCGArgs, Builtin, CallContext,
+ PredName) },
mode_info_unset_call_context,
mode_checkpoint(exit, "call").
@@ -524,6 +525,10 @@
unique_modes__check_goal_2(bi_implication(_, _), _, _) -->
% these should have been expanded out by now
{ error("unique_modes__check_goal_2: unexpected bi_implication") }.
+
+unique_modes__check_goal_2(edcg_goal(_, _, _), _, _) -->
+ % these should have been expanded out by now
+ { error("unique_modes__check_goal_2: unexpected edcg_goal") }.
:- pred unique_modes__check_call(pred_id, proc_id, list(prog_var), proc_id,
mode_info, mode_info).
Index: compiler/unneeded_code.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unneeded_code.m,v
retrieving revision 1.7
diff -u -r1.7 unneeded_code.m
--- compiler/unneeded_code.m 2000/11/17 17:48:52 1.7
+++ compiler/unneeded_code.m 2001/03/12 15:35:57
@@ -602,7 +602,7 @@
RefinedGoals = RefinedGoals0,
Changed = Changed0
;
- GoalExpr0 = call(_, _, _, _, _, _),
+ GoalExpr0 = call(_, _, _, _, _, _, _),
Goal = Goal0,
unneeded_code__demand_inputs(Goal, ModuleInfo, InstMap0,
everywhere, WhereNeededMap0, WhereNeededMap),
@@ -709,6 +709,9 @@
;
GoalExpr0 = bi_implication(_, _),
error("bi-implication in unneeded_code__process_goal_internal")
+ ;
+ GoalExpr0 = edcg_goal(_, _, _),
+ error("edcg_goal in unneeded_code__process_goal_internal")
).
%---------------------------------------------------------------------------%
@@ -955,7 +958,7 @@
Goal = Goal0,
RefinedGoals = RefinedGoals0
;
- GoalExpr0 = call(_, _, _, _, _, _),
+ GoalExpr0 = call(_, _, _, _, _, _, _),
Goal = Goal0,
RefinedGoals = RefinedGoals0
;
@@ -1012,6 +1015,9 @@
;
GoalExpr0 = bi_implication(_, _),
error("bi-implication in unneeded_code__refine_goal")
+ ;
+ GoalExpr0 = edcg_goal(_, _, _),
+ error("edcg_goal in unneeded_code__refine_goal")
).
:- pred unneeded_code__refine_conj(list(hlds_goal)::in, refined_goal_map::in,
Index: compiler/unused_args.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unused_args.m,v
retrieving revision 1.71
diff -u -r1.71 unused_args.m
--- compiler/unused_args.m 2001/03/05 10:31:05 1.71
+++ compiler/unused_args.m 2001/03/12 15:35:57
@@ -407,7 +407,7 @@
traverse_list_of_goals(Info, Goals, UseInf1, UseInf).
% handle predicate call
-traverse_goal(Info, call(PredId, ProcId, Args, _, _, _),
+traverse_goal(Info, call(PredId, ProcId, Args, _, _, _, _),
UseInf0, UseInf) :-
module_info_pred_proc_info(Info^module_info, PredId, ProcId, _Pred,
Proc),
@@ -508,6 +508,10 @@
% these should have been expanded out by now
error("traverse_goal: unexpected bi_implication").
+traverse_goal(_, edcg_goal(_, _, _), _, _) :-
+ % these should have been expanded out by now
+ error("traverse_goal: unexpected edcg_goal").
+
% add PredProc - HeadVar as an alias for the same element of Args.
:- pred add_pred_call_arg_dep(pred_proc_id::in, list(prog_var)::in,
list(prog_var)::in, var_dep::in, var_dep::out) is det.
@@ -991,7 +995,7 @@
proc_info_varset(OldProc0, Varset0),
remove_listof_elements(HeadVars, 1, UnusedArgs, NewHeadVars),
GoalExpr = call(NewPredId, NewProcId, NewHeadVars,
- not_builtin, no, qualified(PredModule, PredName)),
+ [], not_builtin, no, qualified(PredModule, PredName)),
Goal1 = GoalExpr - GoalInfo0,
implicitly_quantify_goal(Goal1, Varset0, VarTypes1,
NonLocals, Goal, Varset, VarTypes, _),
@@ -1237,8 +1241,8 @@
Changed, SubGoal0, SubGoal).
fixup_goal_expr(_ModuleInfo, _UnusedVars, ProcCallInfo, Changed,
- call(PredId0, ProcId0, ArgVars0, B, C, Name0) - GoalInfo,
- call(PredId, ProcId, ArgVars, B, C, Name) - GoalInfo) :-
+ call(PredId0, ProcId0, ArgVars0, D, E, F, Name0) - GoalInfo,
+ call(PredId, ProcId, ArgVars, D, E, F, Name) - GoalInfo) :-
(
map__search(ProcCallInfo, proc(PredId0, ProcId0),
call_info(NewPredId, NewProcId, NewName, UnusedArgs))
@@ -1280,6 +1284,10 @@
fixup_goal_expr(_, _, _, _, bi_implication(_, _) - _, _) :-
% these should have been expanded out by now
error("fixup_goal_expr: unexpected bi_implication").
+
+fixup_goal_expr(_, _, _, _, edcg_goal(_, _, _) - _, _) :-
+ % these should have been expanded out by now
+ error("fixup_goal_expr: unexpected edcg_goal").
% Remove useless unifications from a list of conjuncts.
:- pred fixup_conjuncts(module_info::in, list(prog_var)::in, proc_call_info::in,
Index: library/list.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/list.m,v
retrieving revision 1.97
diff -u -r1.97 list.m
--- library/list.m 2001/01/17 04:35:19 1.97
+++ library/list.m 2001/03/12 15:37:30
@@ -133,6 +133,14 @@
:- func list__remove_dups(list(T)) = list(T).
+% list__remove_dups(L0, L1, L2) :
+% L1 is the result of deleting the second and subsequent
+% occurrences of every element that occurs twice in L0.
+% L2 is the list of all the elements that occurs twice or more
+% in L0.
+:- pred list__remove_dups(list(T), list(T), list(T)).
+:- mode list__remove_dups(in, out, out) is det.
+
% list__member(Elem, List) :
% True iff `List' contains `Elem'.
:- pred list__member(T, list(T)).
@@ -948,6 +956,27 @@
bintree_set__insert(SoFar0, X, SoFar),
list__remove_dups_2(Xs, SoFar, Ys),
Zs = [X|Ys]
+ ).
+
+list__remove_dups(Xs, Ys, Zs) :-
+ bintree_set__init(Ws0),
+ list__remove_dups_2(Xs, Ws0, Ys, Zs).
+
+:- pred list__remove_dups_2(list(T), bintree_set(T), list(T),
+list(T)).
+:- mode list__remove_dups_2(in, in, out, out) is det.
+
+list__remove_dups_2([], _SoFar, [], []).
+list__remove_dups_2([X|Xs], SoFar0, Ys, Zs) :-
+ (
+ bintree_set__member(X, SoFar0)
+ ->
+ list__remove_dups_2(Xs, SoFar0, Ys, Zs0),
+ Zs = [X|Zs0]
+ ;
+ bintree_set__insert(SoFar0, X, SoFar),
+ list__remove_dups_2(Xs, SoFar, Ys0, Zs),
+ Ys = [X|Ys0]
).
%-----------------------------------------------------------------------------%
Index: library/ops.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/ops.m,v
retrieving revision 1.32
diff -u -r1.32 ops.m
--- library/ops.m 2000/09/19 04:46:50 1.32
+++ library/ops.m 2001/03/15 07:31:45
@@ -132,6 +132,9 @@
ops__op_table("-", after, yfx, 500). % standard ISO Prolog
ops__op_table("--", after, yfx, 500). % Mercury extension
ops__op_table("-", before, fx, 200). % standard ISO Prolog
+ops__op_table("-->>", after, xfx, 1200). % EDCG clause functor
+ops__op_table("$", before, fy, 75). % EDCG operator
+ops__op_table("$=", before, fy, 75). % EDCG operator
ops__op_table("--->", after, xfy, 1179). % Mercury extension
ops__op_table("-->", after, xfx, 1200). % standard ISO Prolog
ops__op_table("->", after, xfy, 1050). % standard ISO Prolog
--------------------------------------------------------------------------
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