[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