diff --git a/docs/yap.tex b/docs/yap.tex index 34e0902c0..bdb5fb16f 100644 --- a/docs/yap.tex +++ b/docs/yap.tex @@ -7941,6 +7941,11 @@ prompts from the system were redirected to the stream automatically redirects the @code{user_error} alias to the original @code{stderr}. +@item user_flags +@findex user_flags (yap_flag/2 option) +@* +Define the behaviour of @code{set_prolog_flag/2} if the flag is not known. Values are @code{silent}, @code{warning} and @code{error}. The first two create the flag on-the-fly, with @code{warning} printing a message. The value @code{error} is consistent with ISO: it raises an existence error and does not create the flag. See also @code{create_prolog_flag/3}. The default is@code{error}, and developers are encouraged to use @code{create_prolog_flag/3} to create flags for their library. + @item user_input @findex user_input (yap_flag/2 option) @* diff --git a/library/dialect/swi.yap b/library/dialect/swi.yap index d4769b29a..61f9aa255 100755 --- a/library/dialect/swi.yap +++ b/library/dialect/swi.yap @@ -13,6 +13,8 @@ :- load_foreign_files([plstream], [], initIO). +:- set_prolog_flag(user_flags,silent). + :- ensure_loaded(library(atts)). :- use_module(library(charsio),[write_to_chars/2,read_from_chars/2]). diff --git a/pl/directives.yap b/pl/directives.yap index 88f6348e3..468a6a48f 100644 --- a/pl/directives.yap +++ b/pl/directives.yap @@ -773,6 +773,23 @@ yap_flag(prompt_alternatives_on,groundness) :- !, yap_flag(prompt_alternatives_on,X) :- '$do_error'(domain_error(flag_value,prompt_alternatives_on+X),yap_flag(prompt_alternatives_on,X)). +'$user_flags'(error). + +yap_flag(user_flags,OUT) :- + var(OUT), !, + '$user_flags'(OUT). +yap_flag(user_flags,silent) :- !, + '$purge_clauses'('$user_flags'(_),prolog), + '$compile'('$user_flags'(silent),0,'$user_flags'(silent),prolog). +yap_flag(user_flags,warning) :- !, + '$purge_clauses'('$user_flags'(_),prolog), + '$compile'('$user_flags'(warning),0,'$user_flags'(warning),prolog). +yap_flag(user_flags,error) :- !, + '$purge_clauses'('$user_flags'(_),prolog), + '$compile'('$user_flags'(error),0,'$user_flags'(error),prolog). +yap_flag(user_flags,X) :- + '$do_error'(domain_error(flag_value,user_flags+X),yap_flag(user_flags,X)). + yap_flag(stack_dump_on_error,OUT) :- var(OUT), !, '$access_yap_flags'(17,X), @@ -899,78 +916,79 @@ yap_flag(address_bits,X) :- yap_flag(dialect,yap). -'$show_yap_flag_opts'(V,Out) :- - ( - V = address_bits ; - V = answer_format ; - V = argv ; - V = bounded ; - V = char_conversion ; - V = character_escapes ; - V = chr_toplevel_show_store ; - V = debug ; - V = debugger_print_options ; - V = dialect ; - V = discontiguous_warnings ; - V = dollar_as_lower_case ; - V = double_quotes ; - V = encoding ; - V = executable ; +'$yap_system_flag'(address_bits). +'$yap_system_flag'(answer_format). +'$yap_system_flag'(argv). +'$yap_system_flag'(bounded). +'$yap_system_flag'(char_conversion). +'$yap_system_flag'(character_escapes). +'$yap_system_flag'(chr_toplevel_show_store). +'$yap_system_flag'(debug). +'$yap_system_flag'(debugger_print_options). +'$yap_system_flag'(dialect). +'$yap_system_flag'(discontiguous_warnings). +'$yap_system_flag'(dollar_as_lower_case). +'$yap_system_flag'(double_quotes). +'$yap_system_flag'(encoding). +'$yap_system_flag'(executable). % V = fast ; - V = fileerrors ; - V = float_format ; +'$yap_system_flag'(fileerrors ). +'$yap_system_flag'(float_format). % V = float_mantissa_digits ; % V = float_epsilon ; % V = float_min_exponent ; % V = float_max_exponent ; - V = gc ; - V = gc_margin ; - V = gc_trace ; - V = generate_debug_info ; +'$yap_system_flag'(gc ). +'$yap_system_flag'(gc_margin ). +'$yap_system_flag'(gc_trace ). +'$yap_system_flag'(generate_debug_info ). % V = hide ; - V = home ; - V = host_type ; - V = index ; - V = tabling_mode ; - V = informational_messages ; - V = integer_rounding_function ; - V = language ; - V = max_arity ; - V = max_integer ; - V = max_tagged_integer ; - V = max_workers ; - V = max_threads ; - V = min_integer ; - V = min_tagged_integer ; - V = n_of_integer_keys_in_db ; - V = open_expands_filename ; - V = profiling ; - V = prompt_alternatives_on ; - V = redefine_warnings ; - V = shared_object_search_path ; - V = single_var_warnings ; - V = stack_dump_on_error ; - V = strict_iso ; - V = syntax_errors ; - V = system_options ; - V = to_chars_mode ; - V = toplevel_hook ; - V = toplevel_print_options ; - V = typein_module ; - V = unix ; - V = unknown ; - V = update_semantics ; - V = user_error ; - V = user_input ; - V = user_output ; - V = variable_names_may_end_with_quotes ; - V = verbose ; - V = verbose_auto_load ; - V = version ; - V = version_data ; - V = windows ; - V = write_strings - ), +'$yap_system_flag'(home ). +'$yap_system_flag'(host_type ). +'$yap_system_flag'(index). +'$yap_system_flag'(tabling_mode). +'$yap_system_flag'(informational_messages). +'$yap_system_flag'(integer_rounding_function). +'$yap_system_flag'(language). +'$yap_system_flag'(max_arity). +'$yap_system_flag'(max_integer). +'$yap_system_flag'(max_tagged_integer). +'$yap_system_flag'(max_workers). +'$yap_system_flag'(max_threads). +'$yap_system_flag'(min_integer). +'$yap_system_flag'(min_tagged_integer). +'$yap_system_flag'(n_of_integer_keys_in_db). +'$yap_system_flag'(open_expands_filename). +'$yap_system_flag'(profiling). +'$yap_system_flag'(prompt_alternatives_on). +'$yap_system_flag'(redefine_warnings). +'$yap_system_flag'(shared_object_search_path). +'$yap_system_flag'(single_var_warnings). +'$yap_system_flag'(stack_dump_on_error). +'$yap_system_flag'(strict_iso). +'$yap_system_flag'(syntax_errors). +'$yap_system_flag'(system_options). +'$yap_system_flag'(to_chars_mode). +'$yap_system_flag'(toplevel_hook). +'$yap_system_flag'(toplevel_print_options). +'$yap_system_flag'(typein_module). +'$yap_system_flag'(unix). +'$yap_system_flag'(unknown). +'$yap_system_flag'(update_semantics). +'$yap_system_flag'(user_error). +'$yap_system_flag'(user_flags). +'$yap_system_flag'(user_input). +'$yap_system_flag'(user_output). +'$yap_system_flag'(variable_names_may_end_with_quotes). +'$yap_system_flag'(verbose). +'$yap_system_flag'(verbose_auto_load). +'$yap_system_flag'(version). +'$yap_system_flag'(version_data). +'$yap_system_flag'(windows). +'$yap_system_flag'(write_strings). + +'$show_yap_flag_opts'(V,Out) :- + '$yap_system_flag'(V), yap_flag(V, Out). '$trans_to_lang_flag'(0,cprolog). @@ -1080,8 +1098,25 @@ set_prolog_flag(F, Val) :- set_prolog_flag(F,V) :- \+ atom(F), !, '$do_error'(type_error(atom,F),set_prolog_flag(F,V)). +set_prolog_flag(F, Val) :- + prolog:'$user_defined_flag'(F,_,_,_), !, + yap_flag(F, Val). set_prolog_flag(F,V) :- + '$yap_system_flag'(F), !, yap_flag(F,V). +set_prolog_flag(F,V) :- + '$user_flags'(UFlag), + ( + UFlag = silent -> + create_prolog_flag(F, V, []) + ; + UFlag = warning -> + print_message(warning,existence_error(prolog_flag, F)), + create_prolog_flag(F, V, []) + ; + UFlag = error -> + '$do_error'(existence_error(prolog_flag, F),set_prolog_flag(F,V)) + ). prolog_flag(F, Old, New) :- var(F), !, diff --git a/pl/messages.yap b/pl/messages.yap index 65149e5c8..6024d6dee 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -127,6 +127,8 @@ system_message(no_match(P)) --> [ 'No matching predicate for ~w.' - [P] ]. system_message(leash([A|B])) --> [ 'Leashing set to ~w.' - [[A|B]] ]. +system_message(existence_error(prolog_flag,F)) --> + [ 'Prolog Flag ~w: new Prolog flags must be created using create_prolog_flag/3.' - [F] ]. system_message(singletons([SV],P,CLN)) --> [ 'Singleton variable ~s in ~q, clause ~d.' - [SV,P,CLN] ]. system_message(singletons(SVs,P,CLN)) --> @@ -154,6 +156,8 @@ system_message(error(context_error(Goal,Who),Where)) --> system_message(error(domain_error(DomainType,Opt), Where)) --> [ 'DOMAIN ERROR- ~w: ' - Where], domain_error(DomainType, Opt). +system_message(error(existence_error(prolog_flag,P), Where)) --> !, + [ 'EXISTENCE ERROR- ~w: prolog flag ~w is undefined' - [Where,P] ]. system_message(error(existence_error(procedure,P), context(Call,Parent))) --> !, [ 'EXISTENCE ERROR- procedure ~w is undefined, called from context ~w~n Goal was ~w' - [P,Parent,Call] ]. system_message(error(existence_error(stream,Stream), Where)) -->