for review: make HLDS well-moded [part 2]

Simon Taylor stayl at cs.mu.OZ.AU
Mon Feb 9 16:32:50 AEDT 1998


Index: compiler/make_hlds.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/make_hlds.m,v
retrieving revision 1.260
diff -u -r1.260 make_hlds.m
--- make_hlds.m	1998/02/04 07:17:36	1.260
+++ make_hlds.m	1998/02/07 15:10:41
@@ -43,8 +43,8 @@
 
 :- pred add_new_proc(pred_info, arity, list(mode), maybe(list(mode)),
 		maybe(list(is_live)), maybe(determinism),
-		term__context, pred_info, proc_id).
-:- mode add_new_proc(in, in, in, in, in, in, in, out, out) is det.
+		term__context, args_method, pred_info, proc_id).
+:- mode add_new_proc(in, in, in, in, in, in, in, in, out, out) is det.
 
 :- pred clauses_info_init(int::in, clauses_info::out) is det.
 
@@ -408,7 +408,7 @@
 			FuncName, Arity, PredIds) }
 	->
 		{ predicate_table_get_preds(PredTable0, Preds0) },
-		{ maybe_add_default_modes(PredIds, Preds0, Preds) },
+		{ maybe_add_default_modes(Module0, PredIds, Preds0, Preds) },
 		{ predicate_table_set_preds(PredTable0, Preds, PredTable) },
 		{ module_info_set_predicate_table(Module0, PredTable, Module) }
 	;
@@ -1398,7 +1398,8 @@
 				Func, FuncArity, [PredId])
 		->
 			module_info_pred_info(Module0, PredId, PredInfo0),
-			maybe_add_default_mode(PredInfo0, PredInfo, MaybeProc),
+			maybe_add_default_mode(Module0, PredInfo0, 
+				PredInfo, MaybeProc),
 			(
 				MaybeProc = no,
 				PredProcIds1 = PredProcIds0,
@@ -1683,8 +1684,10 @@
 		Context, ClausesInfo0, Status, Markers, none, predicate, 
 		ClassContext, Proofs, PredInfo0),
 	ArgLives = no,
+	module_info_globals(Module0, Globals),
+	globals__get_args_method(Globals, ArgsMethod),
 	add_new_proc(PredInfo0, Arity, ArgModes, yes(ArgModes),
-		ArgLives, yes(Det), Context, PredInfo, _),
+		ArgLives, yes(Det), Context, ArgsMethod, PredInfo, _),
 
 	module_info_get_predicate_table(Module0, PredicateTable0),
 	predicate_table_insert(PredicateTable0, PredInfo, may_be_unqualified, 
@@ -1723,12 +1726,12 @@
 		Status = Status1
 	).
 
-add_new_proc(PredInfo0, Arity, ArgModes, MaybeDeclaredArgModes,
-		MaybeArgLives, MaybeDet, Context, PredInfo, ModeId) :-
+add_new_proc(PredInfo0, Arity, ArgModes, MaybeDeclaredArgModes, MaybeArgLives, 
+		MaybeDet, Context, ArgsMethod, PredInfo, ModeId) :-
 	pred_info_procedures(PredInfo0, Procs0),
 	next_mode_id(Procs0, MaybeDet, ModeId),
 	proc_info_init(Arity, ArgModes, MaybeDeclaredArgModes, MaybeArgLives,
-		MaybeDet, Context, NewProc),
+		MaybeDet, Context, ArgsMethod, NewProc),
 	map__det_insert(Procs0, ModeId, NewProc, Procs),
 	pred_info_set_procedures(PredInfo0, Procs, PredInfo).
 
@@ -1803,8 +1806,9 @@
 
 		% add the mode declaration to the pred_info for this procedure.
 	{ ArgLives = no },
+	globals__io_get_args_method(ArgsMethod),
 	{ add_new_proc(PredInfo0, Arity, Modes, yes(Modes), ArgLives,
-			MaybeDet, MContext, PredInfo, ProcId) },
+			MaybeDet, MContext, ArgsMethod, PredInfo, ProcId) },
 	{ map__det_update(Preds0, PredId, PredInfo, Preds) },
 	{ predicate_table_set_preds(PredicateTable1, Preds, PredicateTable) },
 	{ module_info_set_predicate_table(ModuleInfo0, PredicateTable,
@@ -1962,7 +1966,7 @@
 		{
 		pred_info_clauses_info(PredInfo1, Clauses0),
 		pred_info_typevarset(PredInfo1, TVarSet0),
-		maybe_add_default_mode(PredInfo1, PredInfo2, _),
+		maybe_add_default_mode(ModuleInfo0, PredInfo1, PredInfo2, _),
 		pred_info_procedures(PredInfo2, Procs),
 		map__keys(Procs, ModeIds)
 		},
@@ -2801,8 +2805,8 @@
 	warn_singletons([X | Vars], NonLocals, QuantVars, VarSet,
 			Context, CallPredId).
 
-warn_singletons_in_unify(X, lambda_goal(_PredOrFunc, LambdaVars, _Modes, _Det,
-				LambdaGoal),
+warn_singletons_in_unify(X, lambda_goal(_PredOrFunc, _NonLocals, LambdaVars, 
+				_Modes, _Det, LambdaGoal),
 			GoalInfo, QuantVars, VarSet, CallPredId, MI) -->
 	%
 	% warn if any lambda-quantified variables occur only in the quantifier
@@ -3695,8 +3699,16 @@
 				HLDS_Goal0, VarSet3, Info1, Info2),
 		insert_arg_unifications(Vars, Vars1, Context, head, no,
 			HLDS_Goal0, VarSet3, HLDS_Goal, VarSet, Info2, Info),
+
+			 % quantification will reduce this down to
+			 % the proper set of nonlocal arguments.
+		{ goal_util__goal_vars(HLDS_Goal, LambdaGoalVars0) }, 
+		{ set__delete_list(LambdaGoalVars0, Vars, LambdaGoalVars1) },
+		{ set__to_sorted_list(LambdaGoalVars1, LambdaNonLocals) },
+
 		{ create_atomic_unification(X,
-			lambda_goal(predicate, Vars, Modes, Det, HLDS_Goal),
+			lambda_goal(predicate, LambdaNonLocals, Vars, 
+				Modes, Det, HLDS_Goal),
 			Context, MainContext, SubContext, Goal) }
 	;
 	    {
@@ -3723,8 +3735,16 @@
 			HLDS_Goal0, VarSet3, Info1, Info2),
 		insert_arg_unifications(Vars, Vars1, Context, head, no,
 			HLDS_Goal0, VarSet3, HLDS_Goal, VarSet, Info2, Info),
+
+			 % quantification will reduce this down to
+			 % the proper set of nonlocal arguments.
+		{ goal_util__goal_vars(HLDS_Goal, LambdaGoalVars0) }, 
+		{ set__delete_list(LambdaGoalVars0, Vars, LambdaGoalVars1) },
+		{ set__to_sorted_list(LambdaGoalVars1, LambdaNonLocals) },
+
 		{ create_atomic_unification(X,
-		lambda_goal(predicate, Vars, Modes, Det, HLDS_Goal),
+			lambda_goal(predicate, LambdaNonLocals, Vars, 
+				Modes, Det, HLDS_Goal),
 			Context, MainContext, SubContext, Goal) }
 	;
 	    {
@@ -3754,8 +3774,16 @@
 				HLDS_Goal0, VarSet3, Info1, Info2),
 		insert_arg_unifications(Vars, Vars1, Context, head, no,
 			HLDS_Goal0, VarSet3, HLDS_Goal, VarSet, Info2, Info),
+
+			 % quantification will reduce this down to
+			 % the proper set of nonlocal arguments.
+		{ goal_util__goal_vars(HLDS_Goal, LambdaGoalVars0) }, 
+		{ set__delete_list(LambdaGoalVars0, Vars, LambdaGoalVars1) },
+		{ set__to_sorted_list(LambdaGoalVars1, LambdaNonLocals) },
+
 		{ create_atomic_unification(X,
-			lambda_goal(function, Vars, Modes, Det, HLDS_Goal),
+			lambda_goal(function, LambdaNonLocals, Vars, 
+				Modes, Det, HLDS_Goal),
 			Context, MainContext, SubContext, Goal) }
 	;
 	        % handle if-then-else expressions
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_compile.m,v
retrieving revision 1.74
diff -u -r1.74 mercury_compile.m
--- mercury_compile.m	1998/01/25 06:05:28	1.74
+++ mercury_compile.m	1998/02/08 04:26:57
@@ -1460,8 +1460,7 @@
 mercury_compile__map_args_to_regs(HLDS0, Verbose, Stats, HLDS) -->
 	maybe_write_string(Verbose, "% Mapping args to regs..."),
 	maybe_flush_output(Verbose),
-	globals__io_get_args_method(Args),
-	{ generate_arg_info(HLDS0, Args, HLDS) },
+	{ generate_arg_info(HLDS0, HLDS) },
 	maybe_write_string(Verbose, " done.\n"),
 	maybe_report_stats(Stats).
 
Index: compiler/mode_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mode_util.m,v
retrieving revision 1.104
diff -u -r1.104 mode_util.m
--- mode_util.m	1998/01/13 10:12:57	1.104
+++ mode_util.m	1998/02/06 01:22:16
@@ -1263,17 +1263,16 @@
 				ModuleInfo1)
 		->
 			ModuleInfo2 = ModuleInfo1,
-			Mode = (ArgInst0 -> UnifyInst),
-			recompute_instmap_delta_call_2(Args, InstMap,
-				Modes0, Modes, ModuleInfo2, ModuleInfo)
+			Mode = (ArgInst0 -> UnifyInst)
 		;
 			error("recompute_instmap_delta_call_2: unify_inst failed")
 		)
 	;
 		Mode = (not_reached -> not_reached),
-		Modes = [],
-		ModuleInfo = ModuleInfo0
-	).
+		ModuleInfo2 = ModuleInfo0
+	),
+	recompute_instmap_delta_call_2(Args, InstMap,
+		Modes0, Modes, ModuleInfo2, ModuleInfo).
 
 :- pred recompute_instmap_delta_unify(unification, unify_mode, unify_mode,
 	hlds_goal_info, instmap, instmap_delta, module_info, module_info).
Index: compiler/modecheck_call.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modecheck_call.m,v
retrieving revision 1.22
diff -u -r1.22 modecheck_call.m
--- modecheck_call.m	1998/02/03 07:03:10	1.22
+++ modecheck_call.m	1998/02/06 01:22:15
@@ -173,7 +173,7 @@
 	mode_info_get_preds(ModeInfo0, Preds),
 	mode_info_get_module_info(ModeInfo0, ModuleInfo),
 	map__lookup(Preds, PredId, PredInfo0),
-	maybe_add_default_mode(PredInfo0, PredInfo, _),
+	maybe_add_default_mode(ModuleInfo, PredInfo0, PredInfo, _),
 	pred_info_procedures(PredInfo, Procs),
 	map__keys(Procs, ProcIds),
 	pred_info_get_markers(PredInfo, Markers),
Index: compiler/modecheck_unify.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modecheck_unify.m,v
retrieving revision 1.27
diff -u -r1.27 modecheck_unify.m
--- modecheck_unify.m	1998/01/30 06:12:52	1.27
+++ modecheck_unify.m	1998/02/09 01:17:02
@@ -258,8 +258,20 @@
 		module_info_pred_info(ModuleInfo0, ThisPredId, ThisPredInfo),
 		pred_info_typevarset(ThisPredInfo, TVarSet),
 		map__apply_to_list(Args, VarTypes, ArgTypes),
-		get_pred_id_and_proc_id(PName, PredOrFunc, TVarSet, ArgTypes,
-			ModuleInfo0, PredId, ProcId),
+		(
+			% If we are redoing mode analysis, use the
+			% pred_id and proc_id found before, to avoid aborting
+			% in get_pred_id_and_proc_id if there are multiple
+			% matching procedures.
+			Unification0 = construct(_, 
+				pred_const(PredId0, ProcId0), _, _)
+		->
+			PredId = PredId0,
+			ProcId = ProcId0
+		;
+			get_pred_id_and_proc_id(PName, PredOrFunc, TVarSet, 
+				ArgTypes, ModuleInfo0, PredId, ProcId)
+		),
 		module_info_pred_proc_info(ModuleInfo0, PredId, ProcId,
 					PredInfo, ProcInfo),
 
@@ -310,8 +322,8 @@
 		% construct the lambda expression, and then go ahead
 		% and modecheck this unification in its new form
 		%
-		Functor0 = lambda_goal(PredOrFunc, LambdaVars, LambdaModes,
-					LambdaDet, LambdaGoal),
+		Functor0 = lambda_goal(PredOrFunc, ArgVars0, LambdaVars, 
+				LambdaModes, LambdaDet, LambdaGoal),
 		modecheck_unification( X0, Functor0, Unification0, UnifyContext,
 				GoalInfo0, HowToCheckGoal, Goal,
 				ModeInfo2, ModeInfo)
@@ -326,10 +338,11 @@
 			Goal, ModeInfo0, ModeInfo)
 	).
 
-modecheck_unification(X, lambda_goal(PredOrFunc, Vars, Modes0, Det, Goal0),
-			Unification0, UnifyContext, _GoalInfo, HowToCheckGoal,
-			unify(X, RHS, Mode, Unification, UnifyContext),
-			ModeInfo0, ModeInfo) :-
+modecheck_unification(X, 
+		lambda_goal(PredOrFunc, ArgVars, Vars, Modes0, Det, Goal0),
+		Unification0, UnifyContext, _GoalInfo, HowToCheckGoal,
+		unify(X, RHS, Mode, Unification, UnifyContext),
+		ModeInfo0, ModeInfo) :-
 	%
 	% First modecheck the lambda goal itself:
 	%
@@ -408,20 +421,20 @@
 	% Now modecheck the unification of X with the lambda-expression.
 	%
  
-	set__to_sorted_list(NonLocals, ArgVars),
+	RHS0 = lambda_goal(PredOrFunc, ArgVars, Vars, Modes, Det, Goal),
 	modecheck_unify_lambda(X, PredOrFunc, ArgVars, Modes,
-			Det, Unification0, Mode, Unification,
-			ModeInfo10, ModeInfo),
-	RHS = lambda_goal(PredOrFunc, Vars, Modes, Det, Goal).
+			Det, RHS0, Unification0, Mode, RHS, Unification,
+			ModeInfo10, ModeInfo).
 
 :- pred modecheck_unify_lambda(var, pred_or_func, list(var),
-			list(mode), determinism, unification,
-			pair(mode), unification, mode_info, mode_info).
-:- mode modecheck_unify_lambda(in, in, in, in, in, in,
-			out, out, mode_info_di, mode_info_uo) is det.
-
-modecheck_unify_lambda(X, PredOrFunc, ArgVars, LambdaModes, LambdaDet,
-		Unification0, Mode, Unification, ModeInfo0, ModeInfo) :-
+		list(mode), determinism, unify_rhs, unification,
+		pair(mode), unify_rhs, unification, mode_info, mode_info).
+:- mode modecheck_unify_lambda(in, in, in, in, in, in, in,
+			out, out, out, mode_info_di, mode_info_uo) is det.
+
+modecheck_unify_lambda(X, PredOrFunc, ArgVars, LambdaModes, 
+		LambdaDet, RHS0, Unification0, Mode, RHS, Unification, 
+		ModeInfo0, ModeInfo) :-
 	mode_info_get_module_info(ModeInfo0, ModuleInfo0),
 	mode_info_get_instmap(ModeInfo0, InstMap0),
 	instmap__lookup_var(InstMap0, X, InstOfX),
@@ -442,8 +455,8 @@
 		inst_lists_to_mode_list(ArgInsts, ArgInsts, ArgModes),
 		categorize_unify_var_lambda(ModeOfX, ArgModes,
 				X, ArgVars, PredOrFunc,
-				Unification0, ModeInfo1,
-				Unification, ModeInfo2),
+				RHS0, Unification0, ModeInfo1,
+				RHS, Unification, ModeInfo2),
 		modecheck_set_var_inst(X, Inst, ModeInfo2, ModeInfo)
 	;
 		set__list_to_set([X], WaitingVars),
@@ -462,7 +475,8 @@
 		ModeOfY = (InstOfY -> Inst),
 		Mode = ModeOfX - ModeOfY,
 			% return any old garbage
-		Unification = Unification0
+		Unification = Unification0,
+		RHS = RHS0
 	).
 
 :- pred modecheck_unify_functor(var, (type), cons_id, list(var), unification,
@@ -626,14 +640,16 @@
 		%
 		% modecheck_unification sometimes needs to introduce
 		% new goals to handle complicated sub-unifications
-		% in deconstructions.  But this should never happen
-		% during unique mode analysis.
-		% (If it did, the code would be wrong since it
+		% in deconstructions. The only time this can happen
+		% during unique mode analysis is if the instmap is 
+		% unreachable, since inst_is_bound succeeds for not_reached.
+		% (If it did in other cases, the code would be wrong since it
 		% wouldn't have the correct determinism annotations.)
 		%
 		(
 			HowToCheckGoal = check_unique_modes,
-			ExtraGoals \= no_extra_goals
+			ExtraGoals \= no_extra_goals,
+			instmap__is_reachable(InstMap0)
 		->
 			error("unique_modes.m: re-modecheck of unification encountered complicated sub-unifies")
 		;
@@ -826,22 +842,30 @@
 			determinism_components(Det, CanFail, _),
 			UniMode = ((IX - IY) -> (FX - FY)),
 			Unification = complicated_unify(UniMode, CanFail),
+			mode_info_get_instmap(ModeInfo0, InstMap0),
 			(
 				type_is_higher_order(Type, PredOrFunc, _)
 			->
-				% we do not want to report this as an error
+				% We do not want to report this as an error
 				% if it occurs in a compiler-generated
 				% predicate - instead, we delay the error
 				% until runtime so that it only occurs if
-				% the compiler-generated predicate gets called
+				% the compiler-generated predicate gets called.
+				% We don't report an error if the instmap is
+				% unreachable since not_reached counts
+				% as bound.
 				mode_info_get_predid(ModeInfo0, PredId),
 				module_info_pred_info(ModuleInfo0, PredId,
 						PredInfo),
-				( code_util__compiler_generated(PredInfo) ->
-					ModeInfo = ModeInfo0
+				( 
+				    ( code_util__compiler_generated(PredInfo) 
+				    ; instmap__is_unreachable(InstMap0)
+				    )
+				->
+				    ModeInfo = ModeInfo0
 				;
-					set__init(WaitingVars),
-					mode_info_error(WaitingVars,
+				    set__init(WaitingVars),
+				    mode_info_error(WaitingVars,
 			mode_error_unify_pred(X, error_at_var(Y), Type, PredOrFunc),
 						ModeInfo0, ModeInfo)
 				)
@@ -901,14 +925,16 @@
 % be deterministic or semideterministic.
 
 :- pred categorize_unify_var_lambda(mode, list(mode),
-			var, list(var), pred_or_func,
-			unification, mode_info, unification, mode_info).
-:- mode categorize_unify_var_lambda(in, in, in, in, in,
-			in, mode_info_di, out, mode_info_uo) is det.
-
-categorize_unify_var_lambda(ModeOfX, ArgModes0, X, ArgVars, PredOrFunc,
-		Unification0, ModeInfo0, Unification, ModeInfo) :-
+			var, list(var), pred_or_func, unify_rhs, unification, 
+			mode_info, unify_rhs, unification, mode_info).
+:- mode categorize_unify_var_lambda(in, in, in, in, in, in,
+			in, mode_info_di, out, out, mode_info_uo) is det.
+
+categorize_unify_var_lambda(ModeOfX, ArgModes0, X, ArgVars,
+		PredOrFunc, RHS0, Unification0, ModeInfo0, RHS, 
+		Unification, ModeInfo) :-
 	% if we are re-doing mode analysis, preserve the existing cons_id
+	list__length(ArgVars, Arity),
 	( Unification0 = construct(_, ConsId0, _, _) ->
 		ConsId = ConsId0
 	; Unification0 = deconstruct(_, ConsId1, _, _, _) ->
@@ -916,15 +942,47 @@
 	;
 		% the real cons_id will be computed by polymorphism.m;
 		% we just put in a dummy one for now
-		list__length(ArgVars, Arity),
 		ConsId = cons(unqualified("__LambdaGoal__"), Arity)
 	),
 	mode_info_get_module_info(ModeInfo0, ModuleInfo),
 	mode_util__modes_to_uni_modes(ArgModes0, ArgModes0,
 						ModuleInfo, ArgModes),
+	mode_info_get_instmap(ModeInfo0, InstMap),
+		% If the instmap is unreachable, the code will 
+		% get pruned away, so don't report an error.
 	(
+		instmap__is_unreachable(InstMap)
+	->
+		ModeInfo = ModeInfo0,
+		RHS = RHS0,
+		Unification = construct(X, ConsId, ArgVars, ArgModes)
+	;
 		mode_is_output(ModuleInfo, ModeOfX)
 	->
+		( 
+			% lambda expressions must already have been expanded
+			% if a pred_const is present.
+			ConsId = pred_const(PredId, ProcId)
+		->
+			( 
+				RHS0 = lambda_goal(_, _, _, _, _, Goal),
+				Goal = call(PredId, ProcId, _, _, _, _) - _
+			->
+				module_info_pred_info(ModuleInfo,
+					PredId, PredInfo),
+				pred_info_module(PredInfo, PredModule),
+				pred_info_name(PredInfo, PredName),
+				RHS = functor(
+					cons(qualified(PredModule, PredName),
+						Arity),
+					ArgVars)	
+			;
+				error("categorize_unify_var_lambda - \
+					reintroduced lambda goal")
+			)
+		;
+			RHS = RHS0
+		),
 		Unification = construct(X, ConsId, ArgVars, ArgModes),
 		ModeInfo = ModeInfo0
 	;
@@ -938,7 +996,8 @@
 					Type, PredOrFunc),
 				ModeInfo0, ModeInfo),
 		% return any old garbage
-		Unification = Unification0
+		Unification = Unification0,
+		RHS = RHS0
 	).
 
 % categorize_unify_var_functor works out which category a unification
@@ -1002,7 +1061,11 @@
 		;
 			% Otherwise, it can fail
 			CanFail = can_fail,
-			( type_is_higher_order(TypeOfX, PredOrFunc, _) ->
+			mode_info_get_instmap(ModeInfo0, InstMap0),
+			( 
+				type_is_higher_order(TypeOfX, PredOrFunc, _),
+				instmap__is_reachable(InstMap0)
+			->
 				set__init(WaitingVars),
 				mode_info_error(WaitingVars,
 			mode_error_unify_pred(X,
Index: compiler/modes.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modes.m,v
retrieving revision 1.218
diff -u -r1.218 modes.m
--- modes.m	1998/01/30 06:12:54	1.218
+++ modes.m	1998/02/06 01:22:16
@@ -1006,10 +1006,11 @@
 
 unify_rhs_vars(var(Var), [Var]).
 unify_rhs_vars(functor(_Functor, Vars), Vars).
-unify_rhs_vars(lambda_goal(_PredOrFunc, LambdaVars, _Modes, _Det,
-			_Goal - GoalInfo), Vars) :-
+unify_rhs_vars(lambda_goal(_PredOrFunc, LambdaNonLocals, LambdaVars, 
+			_Modes, _Det, _Goal - GoalInfo), Vars) :-
 	goal_info_get_nonlocals(GoalInfo, NonLocals0),
-	set__delete_list(NonLocals0, LambdaVars, NonLocals),
+	set__delete_list(NonLocals0, LambdaVars, NonLocals1),
+	set__insert_list(NonLocals1, LambdaNonLocals, NonLocals),
 	set__to_sorted_list(NonLocals, Vars).
 
 append_extra_goals(no_extra_goals, ExtraGoals, ExtraGoals).
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/polymorphism.m,v
retrieving revision 1.125
diff -u -r1.125 polymorphism.m
--- polymorphism.m	1998/02/04 03:21:34	1.125
+++ polymorphism.m	1998/02/06 01:22:16
@@ -704,16 +704,17 @@
 		;
 			{ error("polymorphism: type_to_type_id failed") }
 		)
-	; { Y = lambda_goal(PredOrFunc, Vars, Modes, Det, LambdaGoal0) } ->
+	; 
+		{ Y = lambda_goal(PredOrFunc, ArgVars, Vars,
+			Modes, Det, LambdaGoal0) }
+	->
 		% for lambda expressions, we must recursively traverse the
 		% lambda goal and then convert the lambda expression
 		% into a new predicate
-		{ LambdaGoal0 = _ - GoalInfo0 },
-		{ goal_info_get_nonlocals(GoalInfo0, OrigNonLocals) },
 		polymorphism__process_goal(LambdaGoal0, LambdaGoal1),
 		polymorphism__fixup_quantification(LambdaGoal1, LambdaGoal),
 		polymorphism__process_lambda(PredOrFunc, Vars, Modes,
-				Det, OrigNonLocals, LambdaGoal, Unification,
+				Det, ArgVars, LambdaGoal, Unification,
 				Y1, Unification1),
 		{ Goal = unify(XVar, Y1, Mode, Unification1, Context)
 				- GoalInfo }
@@ -956,7 +957,7 @@
 	).
 
 :- pred polymorphism__process_lambda(pred_or_func, list(var),
-		list(mode), determinism, set(var), hlds_goal, unification,
+		list(mode), determinism, list(var), hlds_goal, unification,
 		unify_rhs, unification, poly_info, poly_info).
 :- mode polymorphism__process_lambda(in, in, in, in, in, in, in, out, out,
 		in, out) is det.
Index: compiler/purity.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/purity.m,v
retrieving revision 1.7
diff -u -r1.7 purity.m
--- purity.m	1998/01/29 13:31:42	1.7
+++ purity.m	1998/02/06 01:22:16
@@ -569,8 +569,8 @@
 		pure, NumErrors0, NumErrors) -->
 	{ Unif0 = unify(A,RHS0,C,D,E) },
 	{ Unif  = unify(A,RHS,C,D,E) },
-	(   { RHS0 = lambda_goal(F, G, H, I, Goal0 - Info0) } ->
-		{ RHS = lambda_goal(F, G, H, I, Goal - Info0) },
+	(   { RHS0 = lambda_goal(F, G, H, I, J, Goal0 - Info0) } ->
+		{ RHS = lambda_goal(F, G, H, I, J, Goal - Info0) },
 		compute_expr_purity(Goal0, Goal, Info0, PredInfo, ModuleInfo,
 				    yes, Purity, NumErrors0, NumErrors1),
 		error_if_closure_impure(GoalInfo, Purity,
Index: compiler/quantification.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/quantification.m,v
retrieving revision 1.58
diff -u -r1.58 quantification.m
--- quantification.m	1998/01/22 07:29:40	1.58
+++ quantification.m	1998/02/06 01:22:13
@@ -352,10 +352,12 @@
 	{ set__list_to_set(ArgVars, Vars) },
 	quantification__set_nonlocals(Vars).
 implicitly_quantify_unify_rhs(
-		lambda_goal(PredOrFunc, LambdaVars0, Modes, Det, Goal0),
+		lambda_goal(PredOrFunc, LambdaNonLocals0,
+			LambdaVars0, Modes, Det, Goal0),
 		Unification0,
 		Context,
-		lambda_goal(PredOrFunc, LambdaVars, Modes, Det, Goal),
+		lambda_goal(PredOrFunc, LambdaNonLocals,
+			LambdaVars, Modes, Det, Goal),
 		Unification
 		) -->
 
@@ -400,6 +402,7 @@
 	{ set__init(LambdaOutsideVars) },
 	quantification__set_lambda_outside(LambdaOutsideVars),
 	implicitly_quantify_goal(Goal1, Goal),
+
 	quantification__get_nonlocals(NonLocals0),
 		% lambda-quantified variables are local
 	{ set__delete_list(NonLocals0, LambdaVars, NonLocals) },
@@ -409,6 +412,19 @@
 	quantification__set_nonlocals(NonLocals),
 
 	%
+	% Work out the list of non-local curried arguments to the lambda
+	% expression. This set must only ever decrease, since the first
+	% approximation that make_hlds uses includes all variables in the 
+	% lambda expression except the quantified variables.
+	%
+	{ Goal = _ - LambdaGoalInfo },
+	{ goal_info_get_nonlocals(LambdaGoalInfo, LambdaGoalNonLocals) },
+	{ IsNonLocal = lambda([V::in] is semidet, (
+			set__member(V, LambdaGoalNonLocals)
+		)) },
+	{ list__filter(IsNonLocal, LambdaNonLocals0, LambdaNonLocals) },
+
+	%
 	% For a unification that constructs a lambda expression,
 	% the argument variables of the construction are the non-local
 	% variables of the lambda expression.  So if we recompute the
@@ -660,8 +676,11 @@
 quantification__unify_rhs_vars(functor(_Functor, ArgVars), Set0, LambdaSet,
 		Set, LambdaSet) :-
 	set__insert_list(Set0, ArgVars, Set).
-quantification__unify_rhs_vars(lambda_goal(_PredOrFunc, LambdaVars, _Modes,
-		_Detism, Goal), Set, LambdaSet0, Set, LambdaSet) :-
+quantification__unify_rhs_vars(
+		lambda_goal(_POrF, _NonLocals, LambdaVars, _M, _D, Goal), 
+		Set, LambdaSet0, Set, LambdaSet) :-
+	% Note that the NonLocals list is not counted, since all the 
+	% variables in that list must occur in the goal.
 	quantification__goal_vars(Goal, GoalVars),
 	set__delete_list(GoalVars, LambdaVars, GoalVars1),
 	set__union(LambdaSet0, GoalVars1, LambdaSet).
Index: compiler/simplify.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/simplify.m,v
retrieving revision 1.52
diff -u -r1.52 simplify.m
--- simplify.m	1998/01/13 10:13:36	1.52
+++ simplify.m	1998/02/06 01:23:44
@@ -562,8 +562,8 @@
 simplify__goal_2(Goal0, GoalInfo0, Goal, GoalInfo, Info0, Info) :-
 	Goal0 = unify(LT0, RT0, M, U0, C),
 	(
-		RT0 = lambda_goal(PredOrFunc, Vars, Modes, LambdaDeclaredDet,
-			LambdaGoal0)
+		RT0 = lambda_goal(PredOrFunc, NonLocals, Vars, 
+			Modes, LambdaDeclaredDet, LambdaGoal0)
 	->
 		simplify_info_enter_lambda(Info0, Info1),
 		simplify_info_get_common_info(Info1, Common1),
@@ -583,8 +583,8 @@
 		simplify__goal(LambdaGoal0, LambdaGoal, Info3, Info4),
 		simplify_info_set_common_info(Info4, Common1, Info5),
 		simplify_info_set_instmap(Info5, InstMap1, Info6),
-		RT = lambda_goal(PredOrFunc, Vars, Modes, LambdaDeclaredDet,
-			LambdaGoal),
+		RT = lambda_goal(PredOrFunc, NonLocals, Vars, Modes, 
+			LambdaDeclaredDet, LambdaGoal),
 		simplify_info_leave_lambda(Info6, Info),
 		Goal = unify(LT0, RT, M, U0, C),
 		GoalInfo = GoalInfo0
Index: compiler/special_pred.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/special_pred.m,v
retrieving revision 1.19
diff -u -r1.19 special_pred.m
--- special_pred.m	1998/01/24 05:44:22	1.19
+++ special_pred.m	1998/02/08 02:59:54
@@ -76,11 +76,11 @@
 	out_mode(Out).
 
 special_pred_info(compare, Type,
-		 "__Compare__", [ResType, Type, Type], [Out, In, In], det) :-
+		 "__Compare__", [ResType, Type, Type], [Uo, In, In], det) :-
 	construct_type(qualified("mercury_builtin", "comparison_result") - 0,
 							[], ResType),
 	in_mode(In),
-	out_mode(Out).
+	uo_mode(Uo).
 
 :- pred in_mode((mode)::out) is det.
 
@@ -90,6 +90,9 @@
 
 out_mode(user_defined_mode(qualified("mercury_builtin", "out"), [])).
 
+:- pred uo_mode((mode)::out) is det.
+
+uo_mode(user_defined_mode(qualified("mercury_builtin", "uo"), [])).
 
 	% Given the mangled predicate name and the list of argument types,
 	% work out which type this special predicate is for.
Index: compiler/store_alloc.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/store_alloc.m,v
retrieving revision 1.58
diff -u -r1.58 store_alloc.m
--- store_alloc.m	1998/01/13 10:13:39	1.58
+++ store_alloc.m	1998/02/06 13:20:54
@@ -47,11 +47,10 @@
 	module_info_globals(ModuleInfo, Globals),
 	globals__lookup_bool_option(Globals, follow_vars, ApplyFollowVars),
 	( ApplyFollowVars = yes ->
-		globals__get_args_method(Globals, ArgsMethod),
 		proc_info_goal(ProcInfo0, Goal0),
 
 		find_final_follow_vars(ProcInfo0, FollowVars0),
-		find_follow_vars_in_goal(Goal0, ArgsMethod, ModuleInfo,
+		find_follow_vars_in_goal(Goal0, ModuleInfo,
 			FollowVars0, Goal1, FollowVars),
 		Goal1 = GoalExpr1 - GoalInfo1,
 		goal_info_set_follow_vars(GoalInfo1, yes(FollowVars),
Index: compiler/stratify.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/stratify.m,v
retrieving revision 1.14
diff -u -r1.14 stratify.m
--- stratify.m	1998/01/13 10:13:42	1.14
+++ stratify.m	1998/02/06 01:22:17
@@ -800,8 +800,8 @@
 		% lambda goal have addresses taken. this is not
 		% always to case, but should be a suitable approximation for
 		% the stratification analysis
-		RHS = lambda_goal(_PredOrFunc, _Vars, _Modes, _Determinism,
-		                                Goal - _GoalInfo)
+		RHS = lambda_goal(_PredOrFunc, _NonLocals, _Vars, 
+				_Modes, _Determinism, Goal - _GoalInfo)
 	->
 		get_called_procs(Goal, [], CalledProcs),
 		set__insert_list(HasAT0, CalledProcs, HasAT)
@@ -901,8 +901,8 @@
 		% lambda goal have addresses taken. this is not
 		% always to case, but should be a suitable approximation for
 		% the stratification analysis
-		RHS = lambda_goal(_PredOrFunc, _Vars, _Modes, _Determinism,
-		                                Goal - _GoalInfo)
+		RHS = lambda_goal(_PredOrFunc, _NonLocals, _Vars, 
+				_Modes, _Determinism, Goal - _GoalInfo)
 	->
 		get_called_procs(Goal, Calls0, Calls)
 	;
Index: compiler/switch_detection.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/switch_detection.m,v
retrieving revision 1.79
diff -u -r1.79 switch_detection.m
--- switch_detection.m	1998/01/13 10:13:44	1.79
+++ switch_detection.m	1998/02/06 01:22:13
@@ -174,14 +174,15 @@
 
 detect_switches_in_goal_2(unify(A,RHS0,C,D,E), __GoalInfo, InstMap0,
 		VarTypes, ModuleInfo, unify(A,RHS,C,D,E)) :-
-	( RHS0 = lambda_goal(PredOrFunc, Vars, Modes, Det, Goal0) ->
+	( RHS0 = lambda_goal(PredOrFunc, NonLocals, Vars, Modes, Det, Goal0) ->
 		% we need to insert the initial insts for the lambda
 		% variables in the instmap before processing the lambda goal
 		instmap__pre_lambda_update(ModuleInfo, 
 			Vars, Modes, InstMap0, InstMap1),
 		detect_switches_in_goal(Goal0, InstMap1, VarTypes, ModuleInfo,
 			Goal),
-		RHS = lambda_goal(PredOrFunc, Vars, Modes, Det, Goal)
+		RHS = lambda_goal(PredOrFunc, NonLocals, 
+			Vars, Modes, Det, Goal)
 	;
 		RHS = RHS0
 	).
Index: compiler/typecheck.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/typecheck.m,v
retrieving revision 1.230
diff -u -r1.230 typecheck.m
--- typecheck.m	1998/02/05 05:10:52	1.230
+++ typecheck.m	1998/02/06 01:22:17
@@ -333,7 +333,8 @@
 			% declarations are module qualified, unless undefined
 			% modes were found by an earlier pass.
 			% 
-			maybe_add_default_mode(PredInfo1, PredInfo2, _),
+			maybe_add_default_mode(ModuleInfo,
+				PredInfo1, PredInfo2, _),
 			copy_clauses_to_procs(PredInfo2, PredInfo3),
 			pred_info_arg_types(PredInfo3, _, ArgTypes),
 			pred_info_procedures(PredInfo3, Procs1),
@@ -1611,8 +1612,9 @@
 typecheck_unification(X, functor(F, As), functor(F, As)) -->
 	typecheck_unify_var_functor(X, F, As),
 	perform_context_reduction.
-typecheck_unification(X, lambda_goal(PredOrFunc, Vars, Modes, Det, Goal0),
-			 lambda_goal(PredOrFunc, Vars, Modes, Det, Goal)) -->
+typecheck_unification(X, 
+		lambda_goal(PredOrFunc, NonLocals, Vars, Modes, Det, Goal0),
+		lambda_goal(PredOrFunc, NonLocals, Vars, Modes, Det, Goal)) -->
  	typecheck_lambda_var_has_type(PredOrFunc, X, Vars),
 	typecheck_goal(Goal0, Goal).
 
Index: compiler/unify_gen.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/unify_gen.m,v
retrieving revision 1.88
diff -u -r1.88 unify_gen.m
--- unify_gen.m	1998/01/23 12:57:05	1.88
+++ unify_gen.m	1998/02/06 01:22:17
@@ -63,7 +63,7 @@
 :- implementation.
 
 :- import_module hlds_module, hlds_pred, prog_data, code_util.
-:- import_module mode_util, type_util, code_aux, hlds_out, tree.
+:- import_module mode_util, type_util, code_aux, hlds_out, tree, arg_info.
 :- import_module bool, string, int, map, term, require, std_util.
 
 :- type uni_val		--->	ref(var)
@@ -332,6 +332,15 @@
 	{ map__lookup(Preds, PredId, PredInfo) },
 	{ pred_info_procedures(PredInfo, Procs) },
 	{ map__lookup(Procs, ProcId, ProcInfo) },
+
+	% lambda.m should ensure that only predicates using the compact
+	% argument passing convention occur in closures.
+	{ arg_info__ho_callable_args_method(ArgsMethod) },
+	( { proc_info_args_method(ProcInfo, ArgsMethod) } ->
+		[]
+	;	
+		{ error("unify_gen__generate_construction_2: pred constant not callable") }
+	),
 %
 % We handle currying of a higher-order pred variable as a special case.
 % We recognize
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/unify_proc.m,v
retrieving revision 1.64
diff -u -r1.64 unify_proc.m
--- unify_proc.m	1998/01/12 13:28:51	1.64
+++ unify_proc.m	1998/02/06 01:22:17
@@ -258,8 +258,10 @@
 	map__lookup(Preds0, PredId, PredInfo0),
 	list__length(ArgModes, Arity),
 	DeclaredArgModes = no,
+	module_info_globals(ModuleInfo0, Globals),
+	globals__get_args_method(Globals, ArgsMethod),
 	add_new_proc(PredInfo0, Arity, ArgModes, DeclaredArgModes,
-		ArgLives, MaybeDet, Context, PredInfo1, ProcId),
+		ArgLives, MaybeDet, Context, ArgsMethod, PredInfo1, ProcId),
 
 	%
 	% copy the clauses for the procedure from the pred_info to the
Index: compiler/unique_modes.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/unique_modes.m,v
retrieving revision 1.45
diff -u -r1.45 unique_modes.m
--- unique_modes.m	1998/01/30 06:12:58	1.45
+++ unique_modes.m	1998/02/08 02:21:54
@@ -453,10 +453,12 @@
 	% first off, try using the existing mode
 	%
 	mode_info_get_module_info(ModeInfo0, ModuleInfo),
-	module_info_pred_proc_info(ModuleInfo, PredId, ProcId0, _, ProcInfo),
+	module_info_pred_proc_info(ModuleInfo, PredId, ProcId0,
+		PredInfo, ProcInfo),
 	proc_info_argmodes(ProcInfo, ProcArgModes0),
 	proc_info_interface_code_model(ProcInfo, CodeModel),
-	proc_info_never_succeeds(ProcInfo, NeverSucceeds),
+	proc_info_inferred_never_succeeds(PredInfo, ProcId0,
+		ProcInfo, NeverSucceeds),
 	unique_modes__check_call_modes(ArgVars, ProcArgModes0, CodeModel,
 				NeverSucceeds, ModeInfo1, ModeInfo2),
 
Index: library/mercury_builtin.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/mercury_builtin.m,v
retrieving revision 1.91
diff -u -r1.91 mercury_builtin.m
--- mercury_builtin.m	1998/01/27 04:47:40	1.91
+++ mercury_builtin.m	1998/02/08 03:01:21
@@ -186,33 +186,33 @@
 
 :- pred builtin_unify_int(int::in, int::in) is semidet.
 :- pred builtin_index_int(int::in, int::out) is det.
-:- pred builtin_compare_int(comparison_result::out, int::in, int::in) is det.
+:- pred builtin_compare_int(comparison_result::uo, int::in, int::in) is det.
 
 :- pred builtin_unify_character(character::in, character::in) is semidet.
 :- pred builtin_index_character(character::in, int::out) is det.
-:- pred builtin_compare_character(comparison_result::out, character::in,
+:- pred builtin_compare_character(comparison_result::uo, character::in,
 	character::in) is det.
 
 :- pred builtin_unify_string(string::in, string::in) is semidet.
 :- pred builtin_index_string(string::in, int::out) is det.
-:- pred builtin_compare_string(comparison_result::out, string::in, string::in)
+:- pred builtin_compare_string(comparison_result::uo, string::in, string::in)
 	is det.
 
 :- pred builtin_unify_float(float::in, float::in) is semidet.
 :- pred builtin_index_float(float::in, int::out) is det.
-:- pred builtin_compare_float(comparison_result::out, float::in, float::in)
+:- pred builtin_compare_float(comparison_result::uo, float::in, float::in)
 	is det.
 
 :- pred builtin_unify_pred((pred)::in, (pred)::in) is semidet.
 :- pred builtin_index_pred((pred)::in, int::out) is det.
-:- pred builtin_compare_pred(comparison_result::out, (pred)::in, (pred)::in)
+:- pred builtin_compare_pred(comparison_result::uo, (pred)::in, (pred)::in)
 	is det.
 
 % The following two preds are used for index/1 or compare/3 on
 % non-canonical types (types for which there is a `where equality is ...'
 % declaration).
 :- pred builtin_index_non_canonical_type(T::in, int::out) is det.
-:- pred builtin_compare_non_canonical_type(comparison_result::out,
+:- pred builtin_compare_non_canonical_type(comparison_result::uo,
 		T::in, T::in) is det.
 
 :- pred unused is det.
Index: runtime/mercury_ho_call.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_ho_call.c,v
retrieving revision 1.5
diff -u -r1.5 mercury_ho_call.c
--- mercury_ho_call.c	1997/12/20 11:11:30	1.5
+++ mercury_ho_call.c	1998/02/07 13:52:37
@@ -136,22 +136,9 @@
 	*/
 Define_label(det_closure_return);
 {
-	int	i, num_in_args, num_out_args;
-
 	MR_succip = pop(); /* restore succip */
-	num_in_args = pop(); /* restore the input arg counter */
-	num_out_args = pop(); /* restore the ouput arg counter */
-
-#ifdef	COMPACT_ARGS
-#else
-	save_registers();
-
-	for (i = 1; i <= num_out_args; i++) {
-		virtual_reg(i) = virtual_reg(i+num_in_args);
-	}
-
-	restore_registers();
-#endif
+	pop(); /* restore the input arg counter */
+	pop(); /* restore the ouput arg counter */
 
 	proceed();
 }
@@ -171,7 +158,6 @@
 
 	save_registers();
 
-#ifdef	COMPACT_ARGS
 	if (num_in_args < 3) {
 		for (i = 1; i <= num_extra_args; i++) {
 			virtual_reg(i+num_in_args) = virtual_reg(i+3);
@@ -185,21 +171,6 @@
 	for (i = 1; i <= num_in_args; i++) {
 		virtual_reg(i) = field(0, closure, i+1); /* copy args */
 	}
-#else
-	if (num_in_args < 2) {
-		for (i = 1; i <= num_extra_args; i++) {
-			virtual_reg(1+i+num_in_args) = virtual_reg(i+3);
-		}
-	} else if (num_in_args > 2) {
-		for (i = num_extra_args; i>0; i--) {
-			virtual_reg(1+i+num_in_args) = virtual_reg(i+3);
-		}
-	} /* else do nothing because i == 2 */
-
-	for (i = 1; i <= num_in_args; i++) {
-		virtual_reg(i+1) = field(0, closure, i+1); /* copy args */
-	}
-#endif
 
 	restore_registers();
 
@@ -212,22 +183,9 @@
 	*/
 Define_label(semidet_closure_return);
 {
-	int	i, num_in_args, num_out_args;
-
 	MR_succip = pop(); /* restore succip */
-	num_in_args = pop(); /* restore the input arg counter */
-	num_out_args = pop(); /* restore the ouput arg counter */
-
-#ifdef	COMPACT_ARGS
-#else
-	save_registers();
-
-	for (i = 1; i <= num_out_args; i++) {
-		virtual_reg(i+1) = virtual_reg(i+1+num_in_args);
-	}
-
-	restore_registers();
-#endif
+	pop(); /* restore the input arg counter */
+	pop(); /* restore the ouput arg counter */
 
 	proceed();
 }
@@ -273,22 +231,6 @@
 	*/
 Define_label(nondet_closure_return);
 {
-	int	i, num_in_args, num_out_args;
-
-	num_in_args = framevar(1); /* restore the input arg counter */
-	num_out_args = framevar(0); /* restore the ouput arg counter */
-
-#ifdef	COMPACT_ARGS
-#else
-	save_registers();
-
-	for (i = 1; i <= num_out_args; i++) {
-		virtual_reg(i) = virtual_reg(i+num_in_args);
-	}
-
-	restore_registers();
-#endif
-
 	succeed();
 }
 
Index: tests/valid/unreachable_code.m
===================================================================
RCS file: /home/staff/zs/imp/tests/valid/unreachable_code.m,v
retrieving revision 1.1
diff -u -r1.1 unreachable_code.m
--- unreachable_code.m	1995/11/14 08:03:46	1.1
+++ unreachable_code.m	1998/02/08 05:55:01
@@ -4,6 +4,7 @@
 :- type foo ---> foo.
 
 :- pred p(foo::in, foo::in) is semidet.
+:- pred q(int::in, foo::in, foo::in) is semidet.
 
 :- implementation.
 :- import_module require.
@@ -11,5 +12,15 @@
 p(X, Y) :-
 	error("err"),
 	X = Y.
+
+	% We used to report a bogus mode error for this.
+q(Int, X, Y) :-
+	Int = 1,
+	( Int = 2 ->
+		Pred = p
+	;
+		Pred = p
+	),
+	call(Pred, X, Y).
 
 %-----------------------------------------------------------------------------%



More information about the developers mailing list