add user_flags/s prolog_flag
This commit is contained in:
parent
495529e69e
commit
ec30e08f69
@ -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)
|
||||
@*
|
||||
|
@ -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]).
|
||||
|
@ -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), !,
|
||||
|
@ -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)) -->
|
||||
|
Reference in New Issue
Block a user