[m-rev.] for review: allow execution of incomplete programs

Fergus Henderson fjh at cs.mu.OZ.AU
Fri Feb 21 07:49:11 AEDT 2003


Estimated hours taken: 7
Branches: main

Add support for two new compiler options,
`--allow-stubs' and `--no-warn-stubs',
to allow execution of programs which are incomplete.

`--allow-stubs' delays the reporting of errors for procedures with no
clauses until run-time, instead issuing only a warning at compile.
`--no-warn-stubs' allows even that warning to be supressed.

There are two major reasons for this change.
The first is just to make incremental development easier.
The second is for use in conjunction with foreign procs.
Once this change is committed and installed, I'd like to remove all of
the calls to sorry/1 in the standard library, and build the library with
`--allow-stubs --no-warn-stubs' if the grade is `il' or `java'.  This will
ensure that (1) we don't accidentally have any stubs undefined for the
C back-end and (2) by using `--warn-stubs' intead of `--no-warn-stubs',
we can get a list of all of the functions which are not yet implemented
for a given back-end.

library/private_builtin.m:
	Add a new procedure no_clauses/1, for reporting the
	run-time error.

compiler/options.m:
	Add and document the new options.

compiler/typecheck.m:
	Implement the new options.  For procedures with no
	clauses, if `--allow-stubs' is enabled, generate a
	stub body which just calls no_clauses/1 or sorry/1.

compiler/hlds_pred.m:
	Add a new marker `stub', for procedures whose body is an
	automatically-generated stub.

compiler/purity.m:
compiler/det_analysis.m:
compiler/unused_args.m:
	Don't issue warnings for `stub' procedures.

doc/user_guide.texi:
	Document the new options.

doc/reference_manual.texi:
	Document that there must be at least one clause for each
	declared predicate or function, since as far as I can tell
	this was until now not explicitly stated in the reference
	manual.  Also document that implementations are permitted
	to provide a method of processing Mercury programs for
	which this error is not reported until runtime.

tests/warnings/Mmakefile:
tests/warnings/Mercury.options:
tests/warnings/warn_stubs.m:
tests/warnings/warn_stubs.exp:
tests/hard_coded/Mmakefile:
tests/hard_coded/Mercury.options:
tests/hard_coded/allow_stubs.m:
tests/hard_coded/allow_stubs.exp:
	Test the new features.

XXX remember to check that this diff includes all
    the relevant files that have been changed!

Workspace: /home/ceres/fjh/mercury
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.115
diff -u -d -r1.115 hlds_pred.m
--- compiler/hlds_pred.m	14 Feb 2003 09:58:38 -0000	1.115
+++ compiler/hlds_pred.m	20 Feb 2003 17:39:26 -0000
@@ -222,7 +222,7 @@
 							% this clause applies
 							% (empty list means
 							% it applies to all
-							% clauses)
+							% modes)
 					hlds_goal,	% Body
 					implementation_language,
 							% implementation
@@ -369,7 +369,13 @@
 :- type pred_markers.
 
 :- type marker
-	--->	infer_type	% Requests type inference for the predicate
+	--->	stub		% The predicate has no clauses.
+				% typecheck.m will generate a body for
+				% the predicate which just throws an exception.
+				% This marker is used to tell purity analysis
+				% and determinism analysis not to issue warnings
+				% for these predicates.
+	;	infer_type	% Requests type inference for the predicate
 				% These markers are inserted by make_hlds
 				% for undeclared predicates.
 	;	infer_modes	% Requests mode inference for the predicate
Index: compiler/options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.405
diff -u -d -r1.405 options.m
--- compiler/options.m	17 Feb 2003 03:36:35 -0000	1.405
+++ compiler/options.m	20 Feb 2003 14:30:34 -0000
@@ -92,6 +92,7 @@
 		;	warn_non_tail_recursion
 		;	warn_target_code
 		;	warn_up_to_date
+		;	warn_stubs
 	% Verbosity options
 		;	verbose
 		;	very_verbose
@@ -171,6 +172,7 @@
 		;	reorder_disj
 		;	fully_strict
 		;	strict_sequential
+		;	allow_stubs
 		;	infer_types
 		;	infer_modes
 		;	infer_det
@@ -716,7 +718,8 @@
 	warn_undefined_options_variables - bool(yes),
 	warn_non_tail_recursion -	bool(no),
 	warn_target_code	-	bool(yes),
-	warn_up_to_date -		bool(yes)
+	warn_up_to_date -		bool(yes),
+	warn_stubs		-	bool(yes)
 ]).
 option_defaults_2(verbosity_option, [
 		% Verbosity Options
@@ -801,6 +804,7 @@
 	reorder_conj		-	bool(yes),
 	reorder_disj		-	bool(yes),
 	fully_strict		-	bool(yes),
+	allow_stubs		-	bool(no),
 	infer_types		-	bool(no),
 	infer_modes		-	bool(no),
 	infer_det		-	bool(yes),
@@ -1323,6 +1327,7 @@
 long_option("warn-non-tail-recursion",	warn_non_tail_recursion).
 long_option("warn-target-code",		warn_target_code).
 long_option("warn-up-to-date",		warn_up_to_date).
+long_option("warn-stubs",		warn_stubs).
 
 % verbosity options
 long_option("verbose",			verbose).
@@ -1427,6 +1432,7 @@
 long_option("reorder-disj",		reorder_disj).
 long_option("fully-strict",		fully_strict).
 long_option("strict-sequential",	strict_sequential).
+long_option("allow-stubs",		allow_stubs).
 long_option("infer-all",		infer_all).
 long_option("infer-types",		infer_types).
 long_option("infer-modes",		infer_modes).
@@ -2002,7 +2008,8 @@
 			warn_smart_recompilation -	bool(Enable),
 			warn_undefined_options_variables - bool(Enable),
 			warn_target_code	-	bool(Enable),
-			warn_up_to_date -		bool(Enable)
+			warn_up_to_date -		bool(Enable),
+			warn_stubs	-		bool(Enable)
 		], OptionTable0, OptionTable).
 special_handler(infer_all, bool(Infer), OptionTable0, ok(OptionTable)) :-
 	override_options([
@@ -2475,6 +2482,11 @@
 		"--no-warn-up-to-date",
 		"\tDon't warn if targets specified on the command line",
 		"\twith `--make' are already up to date.",
+		"--no-warn-stubs",
+		"\tDisable warnings about procedures for which there are no",
+		"\tclauses.  Note that this option only has any effect if",
+		"\tthe `--allow-stubs' option (described in the ""Language",
+		"\tSemantics Options"" section below) is enabled.",
 		"--no-warn-target-code",
 		"\tDisable warnings from the compiler used to process the",
 		"\ttarget code (e.g. gcc)."
@@ -2763,6 +2775,12 @@
 		"\tExecute disjunctions strictly left-to-right.",
 		"--fully-strict",
 		"\tDon't optimize away loops or calls to error/1.",
+		"--allow-stubs",
+		"\tAllow procedures to have no clauses.  Any calls to",
+		"\tsuch procedures will raise an exception at run-time.",
+		"\tThis option is sometimes useful during program development.",
+		"\t(See also the documentation for the `--warn-stubs' option",
+		"\tin the ""Warning Options"" section.)",
 		"--infer-all",
 		"\tAbbreviation for `--infer-types --infer-modes --infer-det'.",
 		"--infer-types",
Index: compiler/purity.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/purity.m,v
retrieving revision 1.50
diff -u -d -r1.50 purity.m
--- compiler/purity.m	4 Feb 2003 07:23:25 -0000	1.50
+++ compiler/purity.m	20 Feb 2003 18:56:39 -0000
@@ -883,6 +883,11 @@
 			% decls in c_code -- this is just because we
 			% assume they are pure, but you can declare them
 			% to be impure.
+			%
+			% We don't warn about exaggerated impurity declarations
+			% for "stub" procedures, i.e. procedures which
+			% originally had no clauses.
+			%
 		pred_info_get_markers(PredInfo, Markers),
 		pred_info_get_goal_type(PredInfo, GoalType),
 		( 
@@ -893,6 +898,8 @@
 			check_marker(Markers, class_method) 
 		;
 			check_marker(Markers, class_instance_method) 
+		;
+			check_marker(Markers, stub) 
 		)
 	->
 		PurityCheckResult = no_worries
@@ -935,8 +942,6 @@
 			% class methods or instance methods --- it just
 			% means that the predicate provided as an
 			% implementation was more pure than necessary.
-			% Likewise, we don't warn about exaggerated
-			% impurity decls on closures.
 		{ pred_info_get_markers(PredInfo, Markers) },
 		{ 
 			check_marker(Markers, class_method) 
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.327
diff -u -d -r1.327 typecheck.m
--- compiler/typecheck.m	12 Feb 2003 22:58:12 -0000	1.327
+++ compiler/typecheck.m	20 Feb 2003 18:46:10 -0000
@@ -311,91 +311,114 @@
 		module_info, module_info, bool, bool, io__state, io__state).
 :- mode typecheck_pred_type(in, in, in, out, in, out, out, out, di, uo) is det.
 
-typecheck_pred_type(Iteration, PredId, PredInfo0, PredInfo,
-		ModuleInfo0, ModuleInfo, Error, Changed, IOState0, IOState) :-
+typecheck_pred_type(Iteration, PredId, !PredInfo,
+		ModuleInfo0, ModuleInfo, Error, Changed, !IOState) :-
 	(
 	    % Compiler-generated predicates are created already type-correct,
 	    % there's no need to typecheck them.  Same for builtins.
 	    % But, compiler-generated unify predicates are not guaranteed
 	    % to be type-correct if they call a user-defined equality pred
 	    % or if it is a special pred for an existentially typed data type.
-	    ( code_util__compiler_generated(PredInfo0),
-	      \+ special_pred_needs_typecheck(PredInfo0, ModuleInfo0)
-	    ; code_util__predinfo_is_builtin(PredInfo0)
+	    ( code_util__compiler_generated(!.PredInfo),
+	      \+ special_pred_needs_typecheck(!.PredInfo, ModuleInfo0)
+	    ; code_util__predinfo_is_builtin(!.PredInfo)
 	    )
 	->
-	    pred_info_clauses_info(PredInfo0, ClausesInfo0),
+	    pred_info_clauses_info(!.PredInfo, ClausesInfo0),
 	    clauses_info_clauses(ClausesInfo0, Clauses0),
 	    ( Clauses0 = [] ->
-		pred_info_mark_as_external(PredInfo0, PredInfo)
+		pred_info_mark_as_external(!PredInfo)
 	    ;
-	        PredInfo = PredInfo0
+	        true
 	    ),
-	    Error = no,
-	    Changed = no,
 	    ModuleInfo = ModuleInfo0,
-	    IOState = IOState0
+	    Error = no,
+	    Changed = no
 	;
-	    globals__io_get_globals(Globals, IOState0, IOState1),
+	    globals__io_get_globals(Globals, !IOState),
 	    ( Iteration = 1 ->
-		maybe_add_field_access_function_clause(ModuleInfo0,
-			PredInfo0, PredInfo0a),
-		maybe_improve_headvar_names(Globals, PredInfo0a, PredInfo1),
+		maybe_add_field_access_function_clause(ModuleInfo0, !PredInfo),
+		maybe_improve_headvar_names(Globals, !PredInfo),
 
 		% The goal_type of the pred_info may have been changed
 		% by maybe_add_field_access_function_clause.
-		module_info_set_pred_info(ModuleInfo0, PredId, PredInfo1,
+		module_info_set_pred_info(ModuleInfo0, PredId, !.PredInfo,
 			ModuleInfo)
 	    ;
-		PredInfo1 = PredInfo0,
-		ModuleInfo = ModuleInfo0
+	    	ModuleInfo = ModuleInfo0
 	    ),
-	    pred_info_arg_types(PredInfo1, _ArgTypeVarSet, ExistQVars0,
+	    pred_info_arg_types(!.PredInfo, _ArgTypeVarSet, ExistQVars0,
 		    ArgTypes0),
-	    pred_info_clauses_info(PredInfo1, ClausesInfo0),
+	    pred_info_clauses_info(!.PredInfo, ClausesInfo0),
 	    clauses_info_clauses(ClausesInfo0, Clauses0),
 	    clauses_info_headvars(ClausesInfo0, HeadVars),
-	    clauses_info_varset(ClausesInfo0, VarSet),
+	    clauses_info_varset(ClausesInfo0, VarSet0),
 	    clauses_info_explicit_vartypes(ClausesInfo0, ExplicitVarTypes0),
+	    pred_info_get_markers(!.PredInfo, Markers0),
+	    % Handle the --allow-stubs and --warn-stubs options.
+	    % If --allow-stubs is set, and there are no clauses,
+	    % issue a warning if --warn-stubs is set, and then
+	    % generate a "stub" clause that just throws an exception.
 	    ( 
-		Clauses0 = [] 
+	    	Clauses0 = [],
+		globals__lookup_bool_option(Globals, allow_stubs, yes),
+		\+ check_marker(Markers0, class_method)
+	    ->
+		( globals__lookup_bool_option(Globals, warn_stubs, yes) ->
+			report_no_clauses("Warning", PredId, !.PredInfo,
+				ModuleInfo, !IOState)
+		;
+			true
+		),
+		error_util__describe_one_pred_name(ModuleInfo, PredId,
+			PredName),
+		generate_stub_clause(PredName, !PredInfo, ModuleInfo,
+			StubClause, VarSet0, VarSet),
+		Clauses1 = [StubClause],
+	        clauses_info_set_clauses(ClausesInfo0, Clauses1,
+			ClausesInfo1),
+	        clauses_info_set_varset(ClausesInfo1, VarSet,
+			ClausesInfo2)
+	    ;
+	    	VarSet = VarSet0,
+	        Clauses1 = Clauses0,
+		ClausesInfo2 = ClausesInfo0
+	    ),
+	    (
+	        Clauses1 = []
 	    ->
 			% There are no clauses for class methods.
 			% The clauses are generated later on,
 			% in polymorphism__expand_class_method_bodies
-	        pred_info_get_markers(PredInfo1, Markers),
-		( check_marker(Markers, class_method) ->
-			IOState = IOState1,
+		( check_marker(Markers0, class_method) ->
 				% For the moment, we just insert the types
 				% of the head vars into the clauses_info
 			map__from_corresponding_lists(HeadVars, ArgTypes0,
 				VarTypes),
-			clauses_info_set_vartypes(ClausesInfo0, VarTypes,
+			clauses_info_set_vartypes(ClausesInfo2, VarTypes,
 				ClausesInfo),
-			pred_info_set_clauses_info(PredInfo1, ClausesInfo,
-				PredInfo2),
+			pred_info_set_clauses_info(!.PredInfo, ClausesInfo,
+				!:PredInfo),
 				% We also need to set the head_type_params
 				% field to indicate that all the existentially
 				% quantified tvars in the head of this
 				% pred are indeed bound by this predicate.
 			term__vars_list(ArgTypes0,
 				HeadVarsIncludingExistentials),
-			pred_info_set_head_type_params(PredInfo2,
-				HeadVarsIncludingExistentials, PredInfo),
+			pred_info_set_head_type_params(!.PredInfo,
+				HeadVarsIncludingExistentials, !:PredInfo),
 			Error = no,
 			Changed = no
 		;
-			report_error_no_clauses(PredId, PredInfo1, ModuleInfo,
-			    IOState1, IOState),
-			PredInfo = PredInfo1,
+			report_no_clauses("Error", PredId, !.PredInfo,
+				ModuleInfo, !IOState),
 			Error = yes,
 			Changed = no
 		)
 	    ;
-	        pred_info_typevarset(PredInfo1, TypeVarSet0),
-	        pred_info_import_status(PredInfo1, Status),
-	        pred_info_get_markers(PredInfo1, Markers),
-		( check_marker(Markers, infer_type) ->
+	        pred_info_typevarset(!.PredInfo, TypeVarSet0),
+	        pred_info_import_status(!.PredInfo, Status),
+		( check_marker(Markers0, infer_type) ->
 			% For a predicate whose type is inferred,
 			% the predicate is allowed to bind the type
 			% variables in the head of the predicate's
@@ -404,17 +427,17 @@
 			% `pred foo(T1, T2, ..., TN)' by make_hlds.m.
 			Inferring = yes,
 			write_pred_progress_message("% Inferring type of ",
-				PredId, ModuleInfo, IOState1, IOState2),
+				PredId, ModuleInfo, !IOState),
 			HeadTypeParams1 = [],
 			PredConstraints = constraints([], [])
 		;
 			Inferring = no,
 			write_pred_progress_message("% Type-checking ",
-				PredId, ModuleInfo, IOState1, IOState2),
+				PredId, ModuleInfo, !IOState),
 			term__vars_list(ArgTypes0, HeadTypeParams0),
 			list__delete_elems(HeadTypeParams0, ExistQVars0,
 				HeadTypeParams1),
-			pred_info_get_class_context(PredInfo1,
+			pred_info_get_class_context(!.PredInfo,
 				PredConstraints)
 		),
 
@@ -427,18 +450,18 @@
 		%
 		dual_constraints(PredConstraints, Constraints),
 
-		( pred_info_is_field_access_function(ModuleInfo, PredInfo1) ->
+		( pred_info_is_field_access_function(ModuleInfo, !.PredInfo) ->
 			IsFieldAccessFunction = yes
 		;
 			IsFieldAccessFunction = no
 		),
-		typecheck_info_init(IOState2, ModuleInfo, PredId,
+		typecheck_info_init(!.IOState, ModuleInfo, PredId,
 				IsFieldAccessFunction, TypeVarSet0, VarSet,
 				ExplicitVarTypes0, HeadTypeParams1,
 				Constraints, Status, TypeCheckInfo1),
 		typecheck_info_get_type_assign_set(TypeCheckInfo1,
 				OrigTypeAssignSet),
-		typecheck_clause_list(Clauses0, HeadVars, ArgTypes0, Clauses,
+		typecheck_clause_list(Clauses1, HeadVars, ArgTypes0, Clauses,
 				TypeCheckInfo1, TypeCheckInfo2),
 		% we need to perform a final pass of context reduction
 		% at the end, before checking the typeclass constraints
@@ -452,8 +475,8 @@
 				InferredTypeConstraints0, ConstraintProofs,
 				TVarRenaming, ExistTypeRenaming),
 		map__optimize(InferredVarTypes0, InferredVarTypes),
-		clauses_info_set_vartypes(ClausesInfo0, InferredVarTypes,
-				ClausesInfo1),
+		clauses_info_set_vartypes(ClausesInfo2, InferredVarTypes,
+				ClausesInfo3),
 
 		%
 		% Apply substitutions to the explicit vartypes.
@@ -467,13 +490,13 @@
 		apply_variable_renaming_to_type_map(TVarRenaming,
 			ExplicitVarTypes1, ExplicitVarTypes),
 
-		clauses_info_set_explicit_vartypes(ClausesInfo1,
-			ExplicitVarTypes, ClausesInfo2),
-		clauses_info_set_clauses(ClausesInfo2, Clauses, ClausesInfo),
-		pred_info_set_clauses_info(PredInfo1, ClausesInfo, PredInfo2),
-		pred_info_set_typevarset(PredInfo2, TypeVarSet, PredInfo3),
-		pred_info_set_constraint_proofs(PredInfo3, ConstraintProofs,
-			PredInfo4),
+		clauses_info_set_explicit_vartypes(ClausesInfo3,
+			ExplicitVarTypes, ClausesInfo4),
+		clauses_info_set_clauses(ClausesInfo4, Clauses, ClausesInfo),
+		pred_info_set_clauses_info(!.PredInfo, ClausesInfo, !:PredInfo),
+		pred_info_set_typevarset(!.PredInfo, TypeVarSet, !:PredInfo),
+		pred_info_set_constraint_proofs(!.PredInfo, ConstraintProofs,
+			!:PredInfo),
 
 		%
 		% Split the inferred type class constraints into those 
@@ -495,8 +518,8 @@
 		% bound in to types that make the constraints satisfiable,
 		% causing the error to go away.
 		%
-		pred_info_set_unproven_body_constraints(PredInfo4,
-				UnprovenBodyConstraints, PredInfo5),
+		pred_info_set_unproven_body_constraints(!.PredInfo,
+				UnprovenBodyConstraints, !:PredInfo),
 
 		( Inferring = yes ->
 			%
@@ -509,14 +532,14 @@
 			%
 			% Now save the information we inferred in the pred_info
 			%
-			pred_info_set_head_type_params(PredInfo5,
-				HeadTypeParams, PredInfo6),
-			pred_info_set_arg_types(PredInfo6, TypeVarSet,
-				ExistQVars, ArgTypes, PredInfo7),
-			pred_info_get_class_context(PredInfo1,
+			pred_info_set_head_type_params(!.PredInfo,
+				HeadTypeParams, !:PredInfo),
+			pred_info_set_arg_types(!.PredInfo, TypeVarSet,
+				ExistQVars, ArgTypes, !:PredInfo),
+			pred_info_get_class_context(!.PredInfo,
 				OldTypeConstraints),
-			pred_info_set_class_context(PredInfo7,
-				InferredTypeConstraints, PredInfo),
+			pred_info_set_class_context(!.PredInfo,
+				InferredTypeConstraints, !:PredInfo),
 			%
 			% Check if anything changed
 			%
@@ -535,10 +558,10 @@
 				Changed = yes
 			)
 		; % Inferring = no
-			pred_info_set_head_type_params(PredInfo5,
-				HeadTypeParams2, PredInfo6),
+			pred_info_set_head_type_params(!.PredInfo,
+				HeadTypeParams2, !:PredInfo),
 			pred_info_get_maybe_instance_method_constraints(
-				PredInfo6, MaybeInstanceMethodConstraints0),
+				!.PredInfo, MaybeInstanceMethodConstraints0),
 
 			%
 			% leave the original argtypes etc., but 
@@ -586,21 +609,89 @@
 				MaybeInstanceMethodConstraints),
 
 			% save the results in the pred_info
-			pred_info_set_arg_types(PredInfo6, TypeVarSet,
-				ExistQVars, RenamedOldArgTypes, PredInfo7),
-			pred_info_set_class_context(PredInfo7,
-				RenamedOldConstraints, PredInfo8),
+			pred_info_set_arg_types(!.PredInfo, TypeVarSet,
+				ExistQVars, RenamedOldArgTypes, !:PredInfo),
+			pred_info_set_class_context(!.PredInfo,
+				RenamedOldConstraints, !:PredInfo),
 			pred_info_set_maybe_instance_method_constraints(
-				PredInfo8, MaybeInstanceMethodConstraints,
-				PredInfo),
+				!.PredInfo, MaybeInstanceMethodConstraints,
+				!:PredInfo),
 
 			Changed = no
 		),
 		typecheck_info_get_found_error(TypeCheckInfo4, Error),
-		typecheck_info_get_io_state(TypeCheckInfo4, IOState)
+		typecheck_info_get_io_state(TypeCheckInfo4, !:IOState)
 	    )
 	).
 
+	
+	% Mark the predicate as a stub, and generate a clause of the form
+	%	<p>(...) :-
+	%		PredName = "<Predname>",
+	%		private_builtin.no_clauses(PredName).
+	% or
+	%	<p>(...) :-
+	%		PredName = "<Predname>",
+	%		private_builtin.sorry(PredName).
+	% depending on whether the predicate is part of
+	% the Mercury standard library or not.
+:- pred generate_stub_clause(string, pred_info, pred_info, module_info, clause,
+		prog_varset, prog_varset).
+:- mode generate_stub_clause(in, in, out, in, out, in, out) is det.
+generate_stub_clause(PredName, PredInfo0, PredInfo, ModuleInfo, StubClause,
+		VarSet0, VarSet) :-
+	%
+	% Mark the predicate as a stub
+	% (i.e. record that it originally had no clauses)
+	%
+	pred_info_get_markers(PredInfo0, Markers0),
+	add_marker(Markers0, stub, Markers),
+	pred_info_set_markers(PredInfo0, Markers, PredInfo),
+
+	%
+	% Generate `PredName = "<PredName>"'
+	%
+	varset__new_named_var(VarSet0, "PredName", PredNameVar, VarSet),
+	pred_info_context(PredInfo, Context),
+	create_atomic_unification(PredNameVar,
+		functor(string_const(PredName), no, []),
+		Context, explicit, [], Unify - UnifyGoalInfo0),
+	goal_info_set_nonlocals(UnifyGoalInfo0,
+		set__make_singleton_set(PredNameVar), UnifyGoalInfo),
+	%
+	% Generate `private_builtin.no_clauses(PredName)'
+	% or `private_builtin.sorry(PredName)'
+	%
+	mercury_private_builtin_module(PrivateBuiltin),
+	pred_info_module(PredInfo, ModuleName),
+	( mercury_std_library_module_name(ModuleName) ->
+		CalleeName = "sorry"
+	;
+		CalleeName = "no_clauses"
+	),
+	CalleeSymName = qualified(PrivateBuiltin, CalleeName),
+	module_info_get_predicate_table(ModuleInfo, PredicateTable),
+	(
+		predicate_table_search_pred_m_n_a(PredicateTable,
+			PrivateBuiltin, CalleeName, 1, [CalleePredId0])
+	->
+		CalleePredId = CalleePredId0
+	;
+		error("generate_stub_clauses: cannot find private_builtin."
+			++ CalleeName ++ "/1")
+	),
+	hlds_pred__initial_proc_id(CalleeProcId),
+	Call = call(CalleePredId, CalleeProcId, [PredNameVar],
+			not_builtin, no, CalleeSymName),
+	goal_info_init(Context, GoalInfo),
+	goal_info_set_nonlocals(GoalInfo,
+		set__make_singleton_set(PredNameVar), CallGoalInfo),
+	%
+	% Combine the unification and call into a conjunction
+	%
+	Body = conj([Unify - UnifyGoalInfo, Call - CallGoalInfo]) - GoalInfo,
+	StubClause = clause([], Body, mercury, Context).
+
 :- pred rename_instance_method_constraints(map(tvar, tvar),
 		maybe(instance_method_constraints),
 		maybe(instance_method_constraints)).
@@ -4968,15 +5059,16 @@
 
 %-----------------------------------------------------------------------------%
 
-:- pred report_error_no_clauses(pred_id, pred_info,
+:- pred report_no_clauses(string, pred_id, pred_info,
 					module_info, io__state, io__state).
-:- mode report_error_no_clauses(in, in, in, di, uo) is det.
+:- mode report_no_clauses(in, in, in, in, di, uo) is det.
 
-report_error_no_clauses(PredId, PredInfo, ModuleInfo) -->
+report_no_clauses(MessageKind, PredId, PredInfo, ModuleInfo) -->
 	{ pred_info_context(PredInfo, Context) },
 	{ error_util__describe_one_pred_name(ModuleInfo, PredId, PredName0) },
 	{ string__append(PredName0, ".", PredName) },
-	{ ErrorMsg = [ words("Error: no clauses for "), fixed(PredName) ] },
+	{ ErrorMsg = [ words(MessageKind ++ ": no clauses for "),
+		fixed(PredName) ] },
 	error_util__write_error_pieces(Context, 0, ErrorMsg).
 
 %-----------------------------------------------------------------------------%
Index: compiler/unused_args.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unused_args.m,v
retrieving revision 1.80
diff -u -d -r1.80 unused_args.m
--- compiler/unused_args.m	17 Jan 2003 05:56:48 -0000	1.80
+++ compiler/unused_args.m	20 Feb 2003 17:52:54 -0000
@@ -1541,6 +1541,12 @@
 				% that have unused arguments.
 			\+ code_util__predinfo_is_builtin(PredInfo),
 			\+ code_util__compiler_generated(PredInfo),
+				% Don't warn about stubs for procedures
+				% with no clauses -- in that case,
+				% we *expect* that none of the arguments
+				% will be used,
+			pred_info_get_markers(PredInfo, Markers),
+			\+ check_marker(Markers, stub),
 				% Don't warn about lambda expressions
 				% not using arguments. (The warning
 				% message for these doesn't contain
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.272
diff -u -d -r1.272 reference_manual.texi
--- doc/reference_manual.texi	20 Feb 2003 15:12:13 -0000	1.272
+++ doc/reference_manual.texi	20 Feb 2003 17:16:13 -0000
@@ -1822,6 +1822,17 @@
 and only one function with a given name and arity in each module.
 It is an error to declare the same predicate or function twice.
 
+There must be at least one clause defined for each declared predicate or
+function, except for those defined using the foreign language interface
+(@pxref{Foreign language interface} and @ref{C interface}).
+However, Mercury implementations are permitted to provide a method
+of processing Mercury programs in which such errors are not reported
+until and unless the predicate or function is actually called.
+(The University of Melbourne Mercury implementation provides this
+with its @samp{--allow-stubs} option.  This can be useful during
+program development, since it allows you to execute parts of
+a program while the program's implementation is still incomplete.)
+
 Note that a predicate defined using DCG notation (@pxref{DCG-rules})
 will appear to be defined with two fewer arguments than it is declared
 with.  It will also appear to be called with two fewer arguments when
Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.354
diff -u -d -r1.354 user_guide.texi
--- doc/user_guide.texi	20 Feb 2003 15:12:13 -0000	1.354
+++ doc/user_guide.texi	20 Feb 2003 15:12:37 -0000
@@ -4220,6 +4220,17 @@
 with @samp{--make} are already up to date.
 @end table
 
+ at sp 1
+ at item --no-warn-stubs
+ at findex --no-warn-stubs
+ at findex --warn-stubs
+Disable warnings about procedures for which there are no
+clauses.  Note that this option only has any effect if
+the @samp{--allow-stubs} option (@pxref{Language semantics options})
+is enabled.
+
+ at end table
+
 @node Verbosity options
 @section Verbosity options
 @cindex Verbosity options
@@ -4721,6 +4732,20 @@
 @item --fully-strict
 @findex --fully-strict
 Don't optimize away loops or calls to @code{error/1}.
+
+ at sp 1
+ at item --allow-stubs
+ at findex --allow-stubs
+ at cindex Stubs
+ at cindex Procedures with no clauses
+ at cindex No clauses, procedures with
+ at cindex Clauses, procedures without
+
+Allow procedures to have no clauses.
+Any calls to such procedures will raise an exception at run-time.
+This option is sometimes useful during program development.
+(See also the documentation for the @samp{--warn-stubs} option
+in @ref{Warning options}.)
 
 @sp 1
 @item --infer-all
Index: library/private_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/private_builtin.m,v
retrieving revision 1.112
diff -u -d -r1.112 private_builtin.m
--- library/private_builtin.m	14 Feb 2003 10:03:27 -0000	1.112
+++ library/private_builtin.m	20 Feb 2003 16:21:28 -0000
@@ -1169,6 +1169,9 @@
 :- pred unsafe_type_cast(T1, T2).
 :- mode unsafe_type_cast(in, out) is det.
 
+	% unused/0 should never be called.
+	% The compiler sometimes generates references to this procedure,
+	% but they should never get executed.
 :- pred unused is det.
 
 	% N.B. interface continued below.
@@ -1222,9 +1225,17 @@
 :- 	  mode nonvar(in) is det.
 :- 	  mode nonvar(unused) is failure.
 
+% no_clauses/1 is used to report a run-time error when there is a call
+% to a procedure for which there are no clauses, and the procedure was
+% compiled with `--allow-stubs' and is not part of the Mercury standard
+% library.  (If the procedure is part of the Mercury standard library,
+% the compiler will generate a call to sorry/1 instead of no_clauses/1.)
+
+:- pred no_clauses(string::in) is erroneous.
+
 % sorry/1 is used to apologize about the fact that we have not implemented
-% some predicate or function in the library for a given back end. The argument
-% should give the name of the predicate or function.
+% some predicate or function in the Mercury standard library for a given
+% back end. The argument should give the name of the predicate or function.
 
 :- pred sorry(string::in) is erroneous.
 
@@ -1244,8 +1255,11 @@
 nonvar(_::unused) :- fail.
 
 sorry(PredName) :-
-	error("sorry, `" ++ PredName ++ "' not implemented\n" ++
+	error("sorry, " ++ PredName ++ " not implemented\n" ++
 		"for this target language (or compiler back-end).").
+
+no_clauses(PredName) :-
+	error("no clauses for " ++ PredName).
 
 :- pragma foreign_proc(c, imp, [will_not_call_mercury, thread_safe], "").
 :- pragma foreign_proc(il, imp,
Index: tests/hard_coded/Mercury.options
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mercury.options,v
retrieving revision 1.4
diff -u -d -r1.4 Mercury.options
--- tests/hard_coded/Mercury.options	30 Jan 2003 05:59:30 -0000	1.4
+++ tests/hard_coded/Mercury.options	20 Feb 2003 19:28:09 -0000
@@ -1,3 +1,4 @@
+MCFLAGS-allow_stubs	=	--allow-stubs --no-warn-stubs --infer-all
 MCFLAGS-checked_nondet_tailcall	=	--checked-nondet-tailcalls
 MCFLAGS-bigtest		=	--intermodule-optimization -O3
 MCFLAGS-constraint	=	--constraint-propagation --enable-termination
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.190
diff -u -d -r1.190 Mmakefile
--- tests/hard_coded/Mmakefile	18 Feb 2003 06:27:32 -0000	1.190
+++ tests/hard_coded/Mmakefile	20 Feb 2003 19:26:32 -0000
@@ -209,10 +209,11 @@
 # The following tests are passed only in some grades.
 
 # Deep profiling cannot yet handle exceptions being caught, which the
-# user_defined_equality test case does.
+# allow_stubs and user_defined_equality test cases do.
 
 ifeq "$(findstring profdeep,$(GRADE))" ""
 	EXCEPTION_PROGS = \
+		allow_stubs \
 		user_defined_equality
 else
 	EXCEPTION_PROGS =
Index: tests/hard_coded/allow_stubs.exp
===================================================================
RCS file: tests/hard_coded/allow_stubs.exp
diff -N tests/hard_coded/allow_stubs.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/allow_stubs.exp	20 Feb 2003 19:32:58 -0000
@@ -0,0 +1,2 @@
+hello world
+going goodbye
Index: tests/hard_coded/allow_stubs.m
===================================================================
RCS file: tests/hard_coded/allow_stubs.m
diff -N tests/hard_coded/allow_stubs.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/allow_stubs.m	20 Feb 2003 19:35:06 -0000
@@ -0,0 +1,47 @@
+% test case for the `--allow-stubs' option.
+
+:- module allow_stubs.
+:- interface.
+:- import_module io.
+
+:- pred main(io::di, io::uo) is cc_multi.
+
+:- implementation.
+:- import_module exception, std_util.
+
+main -->
+	hello,
+	trap_exceptions(how_are_you),
+	trap_exceptions(going_today),
+	goodbye.
+
+hello --> print("hello world"), nl.
+
+:- pred goodbye(io::di, io::uo) is det.
+goodbye --> print("goodbye"), nl.
+
+:- pred how_are_you(io::di, io::uo) is det.
+
+:- mode going_today(di, uo) is det.
+going_today -->
+	print("going "),
+	today.
+
+:- pred today(io::di, io::uo) is det.
+
+:- pred unused1(T::di, T::uo) is det.
+:- pred unused2(T::di, T::uo) is det.
+unused1(IO0, IO) :- unused2(IO0, IO).
+
+:- impure pred imp(io::di, io::uo) is det.
+
+:- mode trap_exceptions(pred(di, uo) is det, di, uo) is cc_multi.
+trap_exceptions(IOGoal) -->
+	try_io((pred({}::out, di, uo) is det --> IOGoal), Res),
+	( { Res = succeeded({}) }
+	; { Res = exception(Exception) },
+	  print("[caught exception: "),
+	  print(univ_value(Exception)),
+	  print("]\n")
+	).
+
Index: tests/warnings/Mercury.options
===================================================================
RCS file: /home/mercury1/repository/tests/warnings/Mercury.options,v
retrieving revision 1.4
diff -u -d -r1.4 Mercury.options
--- tests/warnings/Mercury.options	17 Feb 2003 06:20:06 -0000	1.4
+++ tests/warnings/Mercury.options	20 Feb 2003 19:38:32 -0000
@@ -26,3 +26,4 @@
 	# lower optimization levels.
 MCFLAGS-infinite_recursion	= --excess-assign --common-struct
 
+MCFLAGS-warn_stubs		= --allow-stubs --warn-unused-args
Index: tests/warnings/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/warnings/Mmakefile,v
retrieving revision 1.29
diff -u -d -r1.29 Mmakefile
--- tests/warnings/Mmakefile	17 Feb 2003 06:20:06 -0000	1.29
+++ tests/warnings/Mmakefile	20 Feb 2003 18:50:57 -0000
@@ -24,7 +24,8 @@
 	state_vars_test \
 	unused_args_analysis \
 	unused_args_test \
-	unused_import
+	unused_import \
+	warn_stubs
 
 PROGS=$(COMPILE_PROGS) $(ERRORCHECK_PROGS) up_to_date
 
Index: tests/warnings/warn_stubs.exp
===================================================================
RCS file: tests/warnings/warn_stubs.exp
diff -N tests/warnings/warn_stubs.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/warnings/warn_stubs.exp	20 Feb 2003 19:37:28 -0000
@@ -0,0 +1,2 @@
+warn_stubs.m:004: Warning: no clauses for predicate `warn_stubs.main/2'.
+warn_stubs.m:005: Warning: no clauses for predicate `warn_stubs.foo/0'.
Index: tests/warnings/warn_stubs.m
===================================================================
RCS file: tests/warnings/warn_stubs.m
diff -N tests/warnings/warn_stubs.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/warnings/warn_stubs.m	20 Feb 2003 19:37:12 -0000
@@ -0,0 +1,5 @@
+:- module warn_stubs.
+:- interface.
+:- import_module io.
+:- pred main(io::di, io::uo) is det.
+:- impure pred foo is det.

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
The University of Melbourne         |  of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh>  |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
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