yap-6.3/pl/directives.yap

/*************************************************************************
*									 *
*	 YAP Prolog 							 *
*									 *
*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
*									 *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
*									 *
**************************************************************************
*									 *
* File:		directives.yap						 *
* Last rev:								 *
* mods:									 *
* comments:	directing system execution				 *
*									 *
*************************************************************************/

'$all_directives'(_:G1) :- !,
	'$all_directives'(G1).
'$all_directives'((G1,G2)) :- !,
	'$all_directives'(G1),
	'$all_directives'(G2).
'$all_directives'(G) :- !,
	'$directive'(G).

'$directive'(block(_)).
'$directive'(char_conversion(_,_)).
'$directive'(compile(_)).
'$directive'(consult(_)).
'$directive'(discontiguous(_)).
'$directive'(dynamic(_)).
'$directive'(elif(_)).
'$directive'(else).
'$directive'(encoding(_)).
'$directive'(endif).
'$directive'(ensure_loaded(_)).
'$directive'(expects_dialect(_)).
'$directive'(if(_)).
'$directive'(include(_)).
'$directive'(initialization(_)).
'$directive'(meta_predicate(_)).
'$directive'(module(_,_)).
'$directive'(module(_,_,_)).
'$directive'(module_transparent(_)).
'$directive'(multifile(_)).
'$directive'(noprofile(_)).
'$directive'(parallel).
'$directive'(public(_)).
'$directive'(op(_,_,_)).
'$directive'(set_prolog_flag(_,_)).
'$directive'(reconsult(_)).
'$directive'(reexport(_)).
'$directive'(reexport(_,_)).
'$directive'(sequential).
'$directive'(sequential(_)).
'$directive'(thread_initialization(_)).
'$directive'(thread_local(_)).
'$directive'(uncutable(_)).
'$directive'(use_module(_)).
'$directive'(use_module(_,_)).
'$directive'(use_module(_,_,_)).
'$directive'(wait(_)).

'$exec_directives'((G1,G2), Mode, M) :- !,
	'$exec_directives'(G1, Mode, M),
	'$exec_directives'(G2, Mode, M).
'$exec_directives'(G, Mode, M) :-
	'$exec_directive'(G, Mode, M).

'$exec_directive'(multifile(D), _, M) :-
	'$system_catch'('$multifile'(D, M), M,
	      Error,
	      user:'$LoopError'(Error, top)).
'$exec_directive'(discontiguous(D), _, M) :-
	'$discontiguous'(D,M).
'$exec_directive'(initialization(D), _, M) :-
	'$initialization'(M:D).
'$exec_directive'(thread_initialization(D), _, M) :-
	'$thread_initialization'(M:D).
'$exec_directive'(expects_dialect(D), _, _) :-
	'$expects_dialect'(D).
'$exec_directive'(encoding(Enc), _, _) :-
        '$set_encoding'(Enc).
'$exec_directive'(parallel, _, _) :-
	'$parallel'.
'$exec_directive'(sequential, _, _) :-
	'$sequential'.
'$exec_directive'(sequential(G), _, M) :-
	'$sequential_directive'(G, M).
'$exec_directive'(parallel(G), _, M) :-
	'$parallel_directive'(G, M).
'$exec_directive'(include(F), Status, _) :-
	'$include'(F, Status).
'$exec_directive'(module(N,P), Status, _) :-
	'$module'(Status,N,P).
'$exec_directive'(module(N,P,Op), Status, _) :-
	'$module'(Status,N,P,Op).
'$exec_directive'(meta_predicate(P), _, M) :-
	'$meta_predicate'(P, M).
'$exec_directive'(module_transparent(P), _, M) :-
	'$module_transparent'(P, M).
'$exec_directive'(noprofile(P), _, M) :-
	'$noprofile'(P, M).
'$exec_directive'(dynamic(P), _, M) :-
	'$dynamic'(P, M).
'$exec_directive'(thread_local(P), _, M) :-
	'$thread_local'(P, M).
'$exec_directive'(op(P,OPSEC,OP), _, _) :-
	op(P,OPSEC,OP).
'$exec_directive'(set_prolog_flag(F,V), _, _) :-
	set_prolog_flag(F,V).
'$exec_directive'(ensure_loaded(Fs), _, M) :-
	'$load_files'(M:Fs, [if(changed)], ensure_loaded(Fs)).
'$exec_directive'(char_conversion(IN,OUT), _, _) :-
	char_conversion(IN,OUT).
'$exec_directive'(public(P), _, M) :-
	'$public'(P, M).
'$exec_directive'(compile(Fs), _, M) :-
	'$load_files'(M:Fs, [], compile(Fs)).
'$exec_directive'(reconsult(Fs), _, M) :-
	'$load_files'(M:Fs, [], reconsult(Fs)).
'$exec_directive'(consult(Fs), _, M) :-
	'$consult'(Fs, M).
'$exec_directive'(use_module(F), _, M) :-
	'$load_files'(M:F, [if(not_loaded)],use_module(F)).
'$exec_directive'(reexport(F), _, M) :-
	'$reexport'(F, all, M).
'$exec_directive'(reexport(F,Spec), _, M) :-
	'$reexport'(F, Spec, M).
'$exec_directive'(use_module(F,Is), _, M) :-
	'$load_files'(M:F, [if(not_loaded),imports(Is)],use_module(F,Is)).
'$exec_directive'(use_module(Mod,F,Is), _, _) :-
	'$use_module'(Mod,F,Is).
'$exec_directive'(block(BlockSpec), _, _) :-
	'$block'(BlockSpec).
'$exec_directive'(wait(BlockSpec), _, _) :-
	'$wait'(BlockSpec).
'$exec_directive'(table(PredSpec), _, M) :-
	'$table'(PredSpec, M).
'$exec_directive'(uncutable(PredSpec), _, M) :-
	'$uncutable'(PredSpec, M).
'$exec_directive'(if(Goal), Context, M) :-
	'$if'(M:Goal, Context).
'$exec_directive'(else, Context, _) :-
	'$else'(Context).
'$exec_directive'(elif(Goal), Context, M) :-
	'$elif'(M:Goal, Context).
'$exec_directive'(endif, Context, _) :-
	'$endif'(Context).


yap_flag(V,Out) :-
	'$user_defined_flag'(V,_),
	(nonvar(V) ->
	 !
	;
	 true
	),
	'$user_flag_value'(V, Out).

yap_flag(V,Out) :-
	var(V), !,
	'$show_yap_flag_opts'(V,Out).

% do or do not machine code
yap_flag(fast,on) :- set_value('$fast',true).
yap_flag(fast,off) :- !, set_value('$fast',[]).

% do or do not machine code
yap_flag(argv,L) :- '$argv'(L).

% hide/unhide atoms
yap_flag(hide,Atom) :- !, hide(Atom).
yap_flag(unhide,Atom) :- !, unhide(Atom).

% hide/unhide atoms
yap_flag(encoding,DefaultEncoding) :- var(DefaultEncoding), !,
	'$default_encoding'(DefCode),
	'$valid_encoding'(DefaultEncoding, DefCode).
yap_flag(encoding,Encoding) :-
	'$valid_encoding'(Encoding, EncCode), !,
	'$default_encoding'(EncCode).
yap_flag(encoding,Encoding) :-
	'$do_error'(domain_error(io_mode,encoding(Encoding)),yap_flag(encoding,Encoding)).

% control garbage collection
yap_flag(gc,V) :-
	var(V), !,
	( get_value('$gc',[]) -> V = off ; V = on).
yap_flag(gc,on) :- !, set_value('$gc',true).
yap_flag(gc,off) :- !, set_value('$gc',[]).

yap_flag(gc_margin,N) :- 
	( var(N) -> 
	    get_value('$gc_margin',N)
	;
	  integer(N), N >0  ->
	    set_value('$gc_margin',N)
	;
	    '$do_error'(domain_error(flag_value,gc_margin+X),yap_flag(gc_margin,X))
	).
yap_flag(gc_trace,V) :-
	var(V), !,
	get_value('$gc_trace',N1),
	get_value('$gc_verbose',N2),
	get_value('$gc_very_verbose',N3),
	'$yap_flag_show_gc_tracing'(N1, N2, N3, V).
yap_flag(gc_trace,on) :- !,
	set_value('$gc_trace',true),
	set_value('$gc_verbose',[]),
	set_value('$gc_very_verbose',[]).
yap_flag(gc_trace,verbose) :- !,
	set_value('$gc_trace',[]),
	set_value('$gc_verbose',true),
	set_value('$gc_very_verbose',[]).
yap_flag(gc_trace,very_verbose) :- !,
	set_value('$gc_trace',[]),
	set_value('$gc_verbose',true),
	set_value('$gc_very_verbose',true).
yap_flag(gc_trace,off) :-
	set_value('$gc_trace',[]),
	set_value('$gc_verbose',[]),
	set_value('$gc_very_verbose',[]).
yap_flag(syntax_errors, V) :- var(V), !,
	'$get_read_error_handler'(V).
yap_flag(syntax_errors, Option) :-
	'$set_read_error_handler'(Option).
% compatibility flag
yap_flag(enhanced,on) :- !, set_value('$enhanced',true).
yap_flag(enhanced,off) :- set_value('$enhanced',[]).

%
% SWI compatibility flag
%
yap_flag(generate_debug_info,X) :-
	var(X), !,
        '$access_yap_flags'(18,Options),
	(Options =:= 0 -> X = false ; X = true ).
yap_flag(generate_debug_info,true) :- !,
	'$enable_restore_flag_info'(generate_debug_info),
	'$set_yap_flags'(18,1),
	source.
yap_flag(generate_debug_info,false) :- !,
	'$enable_restore_flag_info'(generate_debug_info),
	'$set_yap_flags'(18,0),
	no_source.
yap_flag(generate_debug_info,X) :-
	'$do_error'(domain_error(flag_value,generate_debug_info+X),yap_flag(generate_debug_info,X)).

'$enable_restore_flag_info'(_) :-
	nb_getval('$consulting_file',[]), !.
'$enable_restore_flag_info'(_) :-
	nb_getval('$initialization_goals',on), !.
'$enable_restore_flag_info'(Flag) :-
	'$show_consult_level'(Level1),
	yap_flag(Flag, Info),
	% it will be done after we leave the current consult level.
	Level is Level1-1,
	recorda('$initialisation',do(Level,yap_flag(Flag,Info)),_),
	fail.
'$enable_restore_flag_info'(_).

%
% show state of $
%
yap_flag(dollar_as_lower_case,V) :-
	var(V), !,
	'$type_of_char'(36,T),
	(T = 3 -> V = on ; V = off).
%
% make $a a legit atom
%
yap_flag(dollar_as_lower_case,on) :- !,
	'$change_type_of_char'(36,3).
%
% force quoting of '$a'
%
yap_flag(dollar_as_lower_case,off) :- 
	'$change_type_of_char'(36,7).

yap_flag(call_counting,X) :- (var(X); X = on; X = off), !,
	'$is_call_counted'(X).

yap_flag(bounded,X) :-
	var(X), !,
	'$access_yap_flags'(0, X1),
	'$transl_to_true_false'(X1,X).
yap_flag(bounded,X) :- !,
	(X = true ; X = false), !,
	'$do_error'(permission_error(modify,flag,bounded),yap_flag(bounded,X)).
yap_flag(bounded,X) :-
	'$do_error'(domain_error(flag_value,bounded+X),yap_flag(bounded,X)).

% do or do not indexation
yap_flag(index,X) :- var(X),
	'$access_yap_flags'(19, X1),
	'$transl_to_index_mode'(X1,X), !.
yap_flag(index,X)  :-
	'$transl_to_index_mode'(X1,X), !,
	'$set_yap_flags'(19,X1).
yap_flag(index,X) :-
	'$do_error'(domain_error(flag_value,index+X),yap_flag(index,X)).

yap_flag(home,X) :-
	'$yap_home'(X).

% should match definitions in Yap.h
'$transl_to_index_mode'(0, off).
'$transl_to_index_mode'(1, single).
'$transl_to_index_mode'(2, compact).
'$transl_to_index_mode'(3, multi).
'$transl_to_index_mode'(3, on). % default is multi argument indexing
'$transl_to_index_mode'(4, max).

% tabling mode
yap_flag(tabling_mode,Options) :- 
   var(Options), !,
   '$access_yap_flags'(20,Options).
yap_flag(tabling_mode,[]) :- !.
yap_flag(tabling_mode,[HOption|TOption]) :- !,
   yap_flag(tabling_mode,HOption),
   yap_flag(tabling_mode,TOption).
yap_flag(tabling_mode,(Option1,Option2)) :- !,
   yap_flag(tabling_mode,Option1),
   yap_flag(tabling_mode,Option2).
yap_flag(tabling_mode,Option) :-
   '$transl_to_tabling_mode'(Flag,Option),
   '$set_yap_flags'(20,Flag).
yap_flag(tabling_mode,Options) :-
   '$do_error'(domain_error(flag_value,tabling_mode+Options),yap_flag(tabling_mode,Options)).

% should match with code in stdpreds.c
'$transl_to_tabling_mode'(0,default).
'$transl_to_tabling_mode'(1,batched).
'$transl_to_tabling_mode'(2,local).
'$transl_to_tabling_mode'(3,exec_answers).
'$transl_to_tabling_mode'(4,load_answers).

yap_flag(informational_messages,X) :- var(X), !,
	 get_value('$verbose',X).
yap_flag(informational_messages,on)  :- !,
	set_value('$verbose',on),
	'$set_yap_flags'(22,0).
yap_flag(informational_messages,off) :- !,
	set_value('$verbose',off),
	'$set_yap_flags'(22,1).
yap_flag(informational_messages,X) :-
	'$do_error'(domain_error(flag_value,informational_messages+X),yap_flag(informational_messages,X)).

yap_flag(verbose,X) :- var(X), !,
	 get_value('$verbose',X0),
	 (X0 == on -> X = normal ; X = silent).
yap_flag(verbose,normal)  :- !,
	set_value('$verbose',on),
	'$set_yap_flags'(22,0).
yap_flag(verbose,silent) :- !,
	set_value('$verbose',off),
	'$set_yap_flags'(22,1).
yap_flag(verbose,X) :-
	'$do_error'(domain_error(flag_value,verbose+X),yap_flag(verbose,X)).

yap_flag(integer_rounding_function,X) :-
	var(X), !,
	'$access_yap_flags'(2, X1),
	'$transl_to_rounding_function'(X1,X).
yap_flag(integer_rounding_function,X) :-
	(X = down; X = toward_zero), !,
	'$do_error'(permission_error(modify,flag,integer_rounding_function),yap_flag(integer_rounding_function,X)).
yap_flag(integer_rounding_function,X) :-
	'$do_error'(domain_error(flag_value,integer_rounding_function+X),yap_flag(integer_rounding_function,X)).

yap_flag(max_arity,X) :-
	var(X), !,
	'$access_yap_flags'(1, X1),
	'$transl_to_arity'(X1,X).
yap_flag(max_arity,X) :-
	integer(X), X > 0, !,
	'$do_error'(permission_error(modify,flag,max_arity),yap_flag(max_arity,X)).
yap_flag(max_arity,X) :-
	'$do_error'(domain_error(flag_value,max_arity+X),yap_flag(max_arity,X)).

yap_flag(version,X) :-
	var(X), !,
	get_value('$version_name',X).
yap_flag(version,X) :-
	'$do_error'(permission_error(modify,flag,version),yap_flag(version,X)).

yap_flag(version_data,X) :-
	var(X), !,
	'$get_version_codes'(Major,Minor,Patch),
	X = yap(Major, Minor, Patch, _).
yap_flag(version_data,X) :-
	'$do_error'(permission_error(modify,flag,version),yap_flag(version_data,X)).

'$get_version_codes'(Major,Minor,Patch) :-
	get_value('$version_name',X),
	atom_codes(X,[0'Y,0'a,0'p,0'-|VersionTag]), %'
	'$fetch_num_code'(VersionTag,0,Major,L1),
	'$fetch_num_code'(L1,0,Minor,L2),
	'$fetch_num_code'(L2,0,Patch,[]).

'$fetch_num_code'([],Code,Code,[]).
'$fetch_num_code'([C|Cs],Code0,CodeF,L) :-
        C >= 0'0, C =< 0'9, !,
	CodeI is Code0*10+(C-0'0), %'
	'$fetch_num_code'(Cs,CodeI,CodeF,L).
'$fetch_num_code'([_|Cs],Code,Code,Cs).

yap_flag(max_integer,X) :-
	var(X), !,
	'$access_yap_flags'(0, 1),
	'$access_yap_flags'(3, X).
yap_flag(max_integer,X) :-
	integer(X), X > 0, !,
	'$do_error'(permission_error(modify,flag,max_integer),yap_flag(max_integer,X)).
yap_flag(max_integer,X) :-
	'$do_error'(domain_error(flag_value,max_integer+X),yap_flag(max_integer,X)).

yap_flag(max_tagged_integer,X) :-
	'$max_tagged_integer'(X), !.
yap_flag(max_tagged_integer,X) :-			       
	integer(X), X > 0, !,
	'$do_error'(permission_error(modify,flag,max_tagged_integer),yap_flag(max_tagged_integer,X)).
yap_flag(max_tagged_integer,X) :-
	'$do_error'(domain_error(flag_value,max_tagged_integer+X),yap_flag(max_tagged_integer,X)).

yap_flag(min_integer,X) :-
	var(X), !,
	'$access_yap_flags'(0, 1),
	'$access_yap_flags'(4, X).
yap_flag(min_integer,X) :-
	integer(X), X < 0, !,
	'$do_error'(permission_error(modify,flag,min_integer),yap_flag(min_integer,X)).
yap_flag(min_integer,X) :-
	'$do_error'(domain_error(flag_value,min_integer+X),yap_flag(min_integer,X)).

yap_flag(min_tagged_integer,X) :-
	'$min_tagged_integer'( X), !.
yap_flag(min_tagged_integer,X) :-
	integer(X), X > 0, !,
	'$do_error'(permission_error(modify,flag,min_tagged_integer),yap_flag(min_tagged_integer,X)).
yap_flag(min_tagged_integer,X) :-
	'$do_error'(domain_error(flag_value,min_tagged_integer+X),yap_flag(min_tagged_integer,X)).

/* ISO Core Revision DTR: new float flags

yap_flag(float_mantissa_digits,X) :-
	var(X), !,
	?????
yap_flag(float_mantissa_digits,X) :-
	integer(X), X > 0, !,
	'$do_error'(permission_error(modify,flag,float_mantissa_digits),yap_flag(float_mantissa_digits,X)).
yap_flag(float_mantissa_digits,X) :-
	'$do_error'(domain_error(flag_value,float_mantissa_digits+X),yap_flag(float_mantissa_digits,X)).

yap_flag(float_epsilon,X) :-
	var(X), !,
	?????
yap_flag(float_epsilon,X) :-
	float(X), X > 0, !,
	'$do_error'(permission_error(modify,flag,float_epsilon),yap_flag(float_epsilon,X)).
yap_flag(float_epsilon,X) :-
	'$do_error'(domain_error(flag_value,float_epsilon+X),yap_flag(float_epsilon,X)).

yap_flag(float_min_exponent,X) :-
	var(X), !,
	?????
yap_flag(float_min_exponent,X) :-
	integer(X), X > 0, !,
	'$do_error'(permission_error(modify,flag,float_min_exponent),yap_flag(float_min_exponent,X)).
yap_flag(float_epsilon,X) :-
	'$do_error'(domain_error(flag_value,float_min_exponent+X),yap_flag(float_min_exponent,X)).

yap_flag(float_max_exponent,X) :-
	var(X), !,
	?????
yap_flag(float_max_exponent,X) :-
	integer(X), X > 0, !,
	'$do_error'(permission_error(modify,flag,float_max_exponent),yap_flag(float_max_exponent,X)).
yap_flag(float_max_exponent,X) :-
	'$do_error'(domain_error(flag_value,float_max_exponent+X),yap_flag(float_max_exponent,X)).
*/

yap_flag(char_conversion,X) :-
	var(X), !,
	'$access_yap_flags'(5, X1),
	'$transl_to_on_off'(X1,X).
yap_flag(char_conversion,X) :-
	'$transl_to_on_off'(X1,X), !,
	'$set_yap_flags'(5,X1),
	( X1 = 1 ->
	    '$force_char_conversion'
	    ;
	    '$disable_char_conversion'
	).
yap_flag(char_conversion,X) :-
	'$do_error'(domain_error(flag_value,char_conversion+X),yap_flag(char_conversion,X)).

yap_flag(double_quotes,X) :-
	var(X), !,
	'$access_yap_flags'(6, X1),
	'$transl_to_trl_types'(X1,X).
yap_flag(double_quotes,X) :-
	'$transl_to_trl_types'(X1,X), !,
	'$set_yap_flags'(6,X1).
yap_flag(double_quotes,X) :-
	'$do_error'(domain_error(flag_value,double_quotes+X),yap_flag(double_quotes,X)).

yap_flag(n_of_integer_keys_in_db,X) :-
	var(X), !,
	'$resize_int_keys'(X).
yap_flag(n_of_integer_keys_in_db,X) :- integer(X), X > 0, !,
	'$resize_int_keys'(X).
yap_flag(n_of_integer_keys_in_db,X) :-
	'$do_error'(domain_error(flag_value,n_of_integer_keys_in_db+X),yap_flag(n_of_integer_keys_in_db,X)).

yap_flag(n_of_integer_keys_in_bb,X) :-
	var(X), !,
	'$resize_bb_int_keys'(X).
yap_flag(n_of_integer_keys_in_bb,X) :- integer(X), X > 0, !,
	'$resize_bb_int_keys'(X).
yap_flag(n_of_integer_keys_in_bb,X) :-
	'$do_error'(domain_error(flag_value,n_of_integer_keys_in_bb+X),yap_flag(n_of_integer_keys_in_bb,X)).

yap_flag(profiling,X) :- (var(X); X = on; X = off), !,
	'$is_profiled'(X).

yap_flag(strict_iso,OUT) :-
	var(OUT), !,
	'$access_yap_flags'(9,X),
	'$transl_to_on_off'(X,OUT).
yap_flag(strict_iso,on) :- !,
	yap_flag(language,iso),
	'$transl_to_on_off'(X,on),
	'$set_yap_flags'(9,X).
yap_flag(strict_iso,off) :- !,
	'$transl_to_on_off'(X,off),
	'$set_yap_flags'(9,X).
yap_flag(strict_iso,X) :-
	'$do_error'(domain_error(flag_value,strict_iso+X),yap_flag(strict_iso,X)).

yap_flag(variable_names_may_end_with_quotes,OUT) :-
	var(OUT), !,
	'$access_yap_flags'(21,X),
	'$transl_to_on_off'(X,OUT).
yap_flag(variable_names_may_end_with_quotes,on) :- !,
	'$transl_to_on_off'(X,on),
	'$set_yap_flags'(21,X).
yap_flag(variable_names_may_end_with_quotes,off) :- !,
	'$transl_to_on_off'(X,off),
	'$set_yap_flags'(21,X).
yap_flag(variable_names_may_end_with_quotes,X) :-
	'$do_error'(domain_error(flag_value,strict_iso+X),yap_flag(strict_iso,X)).

yap_flag(language,X) :-
	var(X), !,
	'$access_yap_flags'(8, X1),
	'$trans_to_lang_flag'(X1,X).
yap_flag(language,X) :-
	'$trans_to_lang_flag'(N,X), !,
	'$set_yap_flags'(8,N),
	'$adjust_language'(X).
yap_flag(language,X) :-
	'$do_error'(domain_error(flag_value,language+X),yap_flag(language,X)).

yap_flag(debug,X) :-
	var(X), !,
	('$debug_on'(true)
	->
	 X = on
	;
	 X = true
	).
yap_flag(debug,X) :-
	'$transl_to_on_off'(_,X), !,
	(X = on -> debug ; nodebug).
yap_flag(debug,X) :-
	'$do_error'(domain_error(flag_value,debug+X),yap_flag(debug,X)).

yap_flag(discontiguous_warnings,X) :-
	var(X), !,
	('$syntax_check_mode'(on,_), '$syntax_check_discontiguous'(on,_) ->
	    X = on
	;
	    X = off
	).
yap_flag(discontiguous_warnings,X) :-
	'$transl_to_on_off'(_,X), !,
	(X = on -> 
	    '$syntax_check_mode'(_,on),
	    '$syntax_check_discontiguous'(_,on)
	;
	    '$syntax_check_discontiguous'(_,off)).
yap_flag(discontiguous_warnings,X) :-
	'$do_error'(domain_error(flag_value,discontiguous_warnings+X),yap_flag(discontiguous_warnings,X)).

yap_flag(redefine_warnings,X) :-
	var(X), !,
	('$syntax_check_mode'(on,_), '$syntax_check_multiple'(on,_) ->
	    X = on
	;
	    X = off
	).
yap_flag(redefine_warnings,X) :-
	'$transl_to_on_off'(_,X), !,
	(X = on -> 
	    '$syntax_check_mode'(_,on),
	    '$syntax_check_multiple'(_,on)
	;
	    '$syntax_check_multiple'(_,off)).
yap_flag(redefine_warnings,X) :-
	'$do_error'(domain_error(flag_value,redefine_warnings+X),yap_flag(redefine_warnings,X)).

yap_flag(chr_toplevel_show_store,X) :-
	var(X), !,
	nb_getval('$chr_toplevel_show_store',X).
yap_flag(chr_toplevel_show_store,X) :-
	(X = true ; X = false), !,
	nb_setval('$chr_toplevel_show_store',X).
yap_flag(chr_toplevel_show_store,X) :-
	'$do_error'(domain_error(flag_value,chr_toplevel_show_store+X),yap_flag(chr_toplevel_show_store,X)).

yap_flag(open_expands_filename,Expand) :-
	var(Expand), !,
	'$default_expand'(Expand).
yap_flag(open_expands_filename,Expand) :-
	'$set_default_expand'(Expand).

yap_flag(single_var_warnings,X) :-
	var(X), !,
	('$syntax_check_mode'(on,_), '$syntax_check_single_var'(on,_) ->
	    X = on
	;
	    X = off
	).
yap_flag(single_var_warnings,X) :-
	'$transl_to_on_off'(_,X), !,
	(X = on -> 
	    '$syntax_check_mode'(_,on),
	    '$syntax_check_single_var'(_,on)
	;
	    '$syntax_check_single_var'(_,off)).
yap_flag(single_var_warnings,X) :-
	'$do_error'(domain_error(flag_value,single_var_warnings+X),yap_flag(single_var_warnings,X)).

yap_flag(system_options,X) :-
	'$system_options'(X).

'$system_options'(big_numbers) :-
	'$has_bignums'.
'$system_options'(coroutining) :-
	'$yap_has_coroutining'.
'$system_options'(depth_limit) :-
	\+ '$undefined'(get_depth_limit(_), prolog).
'$system_options'(low_level_tracer) :-
	\+ '$undefined'(start_low_level_trace, prolog).
'$system_options'(or_parallelism) :-
	\+ '$undefined'('$yapor_on', prolog).
'$system_options'(rational_trees) :-
	'$yap_has_rational_trees'.
'$system_options'(readline) :-
	'$has_readline'.
'$system_options'(tabling) :-
	\+ '$undefined'('$c_table'(_,_), prolog).
'$system_options'(threads) :-
	\+ '$no_threads'.
'$system_options'(wam_profiler) :-
	\+ '$undefined'(reset_op_counters, prolog).
	
yap_flag(unknown,X) :-
	var(X), !,
	unknown(X,_).
yap_flag(unknown,N) :-
	unknown(_,N).

yap_flag(to_chars_mode,X) :-
	var(X), !,
	( '$access_yap_flags'(7,0) -> X = quintus ; X = iso ).
yap_flag(to_chars_mode,quintus) :- !,
	'$set_yap_flags'(7,0).
yap_flag(to_chars_mode,iso) :- !,
	'$set_yap_flags'(7,1).
yap_flag(to_chars_mode,X) :-
	'$do_error'(domain_error(flag_value,to_chars_mode+X),yap_flag(to_chars_mode,X)).

yap_flag(character_escapes,X) :-
	var(X), !,
	'$access_yap_flags'(12,Y),	
	'$transl_to_character_escape_modes'(Y,X).
yap_flag(character_escapes,X) :- !,
	'$transl_to_character_escape_modes'(Y,X), !,
	'$set_yap_flags'(12,Y).
yap_flag(character_escapes,X) :-
	'$do_error'(domain_error(flag_value,character_escapes+X),yap_flag(to_chars_mode,X)).

yap_flag(update_semantics,X) :-
	var(X), !,
	( '$log_upd'(I) -> '$convert_upd_sem'(I,X) ).
yap_flag(update_semantics,logical) :- !,
	'$switch_log_upd'(1).
yap_flag(update_semantics,logical_assert) :- !,
	'$switch_log_upd'(2).
yap_flag(update_semantics,immediate) :- !,
	'$switch_log_upd'(0).
yap_flag(update_semantics,X) :-
	'$do_error'(domain_error(flag_value,update_semantics+X),yap_flag(update_semantics,X)).

yap_flag(toplevel_hook,X) :-
	var(X), !,
	( recorded('$toplevel_hooks',G,_) -> G ; true ).
yap_flag(toplevel_hook,G) :- !,
	'$set_toplevel_hook'(G).

yap_flag(unix,true) :-
	'$unix', !.
yap_flag(unix,false).

yap_flag(windows,true) :-
	'$win32', !.
yap_flag(windows,false).

yap_flag(shared_object_search_path,P) :-
	'$ld_path'(P).

yap_flag(typein_module,X) :-
	var(X), !,
	'$current_module'(X).
yap_flag(typein_module,X) :-
	module(X).

yap_flag(write_strings,OUT) :-
	var(OUT), !,
	'$access_yap_flags'(13,X),
	'$transl_to_on_off'(X,OUT).
yap_flag(write_strings,on) :- !,
	'$transl_to_on_off'(X,on),
	'$set_yap_flags'(13,X).
yap_flag(write_strings,off) :- !,
	'$transl_to_on_off'(X,off),
	'$set_yap_flags'(13,X).
yap_flag(write_strings,X) :-
	'$do_error'(domain_error(flag_value,write_strings+X),yap_flag(write_strings,X)).

yap_flag(stack_dump_on_error,OUT) :-
	var(OUT), !,
	'$access_yap_flags'(17,X),
	'$transl_to_on_off'(X,OUT).
yap_flag(stack_dump_on_error,on) :- !,
'$transl_to_on_off'(X,on),
	'$set_yap_flags'(17,X).
yap_flag(stack_dump_on_error,off) :- !,
	'$transl_to_on_off'(X,off),
	'$set_yap_flags'(17,X).
yap_flag(stack_dump_on_error,X) :-
	'$do_error'(domain_error(flag_value,stack_dump_on_error+X),yap_flag(stack_dump_on_error,X)).

yap_flag(user_input,OUT) :-
	var(OUT), !,
	'$flag_check_alias'(OUT, user_input).
	
yap_flag(user_input,Stream) :-
	'$change_alias_to_stream'(user_input,Stream).

yap_flag(user_output,OUT) :-
	var(OUT), !,
	'$flag_check_alias'(OUT, user_output).
yap_flag(user_output,Stream) :-
	'$change_alias_to_stream'(user_output,Stream).


yap_flag(user_error,OUT) :-
	var(OUT), !,
	'$flag_check_alias'(OUT, user_error).
yap_flag(user_error,Stream) :-
	'$change_alias_to_stream'(user_error,Stream).

yap_flag(debugger_print_options,OUT) :-
	var(OUT),
	recorded('$print_options','$debugger'(OUT),_), !.
yap_flag(debugger_print_options,Opts) :- !,
	'$check_io_opts'(Opts, yap_flag(debugger_print_options,Opts)),
	recorda('$print_options','$debugger'(Opts),_).

:- recorda('$print_options','$debugger'([quoted(true),numbervars(true),portrayed(true),max_depth(10)]),_).

yap_flag(toplevel_print_options,OUT) :-
	var(OUT),
	recorded('$print_options','$toplevel'(OUT),_), !.
yap_flag(toplevel_print_options,Opts) :- !,
	'$check_io_opts'(Opts, yap_flag(toplevel_print_options,Opts)),
	recorda('$print_options','$toplevel'(Opts),_).

yap_flag(fileerrors,OUT) :-
	var(OUT), !,
	get_value(fileerrors,X0),
	(X0 = [] -> X= 0 ; X = X0),
	'$transl_to_on_off'(X,OUT).
yap_flag(fileerrors,on) :- !,
	set_value(fileerrors,1).
yap_flag(fileerrors,off) :- !,
	set_value(fileerrors,0).
yap_flag(fileerrors,X) :-
	'$do_error'(domain_error(flag_value,fileerrors+X),yap_flag(fileerrors,X)).

:- recorda('$print_options','$toplevel'([quoted(true),numbervars(true),portrayed(true)]),_).

yap_flag(host_type,X) :-
	'$host_type'(X).

yap_flag(verbose_load,X) :-
	var(X), !,
	( get_value('$lf_verbose',silent) -> X = false ; X = true ).
yap_flag(verbose_load,true) :- !,
	set_value('$lf_verbose',informational).
yap_flag(verbose_load,false) :- !,
	set_value('$lf_verbose',silent),
	'$set_yap_flags'(7,1).
yap_flag(verbose_load,X) :-
	'$do_error'(domain_error(flag_value,verbose_auto_load+X),yap_flag(verbose_auto_load,X)).

yap_flag(verbose_auto_load,X) :-
	var(X), !,
	( get_value('$verbose_auto_load',true) -> X = true ; X = false ).
yap_flag(verbose_auto_load,true) :- !,
	set_value('$verbose_auto_load',true).
yap_flag(verbose_auto_load,false) :- !,
	set_value('$verbose_auto_load',false),
	'$set_yap_flags'(7,1).
yap_flag(verbose_auto_load,X) :-
	'$do_error'(domain_error(flag_value,verbose_auto_load+X),yap_flag(verbose_auto_load,X)).

yap_flag(float_format,X) :-
	var(X), !,
	'$float_format'(X).
yap_flag(float_format,X) :-
	atom(X), !,
	'$float_format'(X).
yap_flag(float_format,X) :-
	'$do_error'(type_error(atom,X),yap_flag(float_format,X)).

yap_flag(max_workers,X) :-
	var(X), !,
	'$max_workers'(X).
yap_flag(max_workers,X) :-
	integer(X), X > 0, !,
	'$do_error'(permission_error(modify,flag,max_workers),yap_flag(max_workers,X)).
yap_flag(max_workers,X) :-
	'$do_error'(domain_error(flag_value,max_workers+X),yap_flag(max_workers,X)).

yap_flag(max_threads,X) :-
	var(X), !,
	'$max_threads'(X).
yap_flag(max_threads,X) :-
	integer(X), X > 0, !,
	'$do_error'(permission_error(modify,flag,max_threads),yap_flag(max_threads,X)).
yap_flag(max_threads,X) :-
	'$do_error'(domain_error(flag_value,max_threads+X),yap_flag(max_threads,X)).

yap_flag(dialect,yap).

'$show_yap_flag_opts'(V,Out) :-
	(
		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 = fast  ;
		V = fileerrors  ;
		V = 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     ;
%	    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 = 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_flag(V, Out).

'$trans_to_lang_flag'(0,cprolog).
'$trans_to_lang_flag'(1,iso).
'$trans_to_lang_flag'(2,sicstus).

'$adjust_language'(cprolog) :-
	'$switch_log_upd'(0),
	'$syntax_check_mode'(_,off),
	'$syntax_check_single_var'(_,off),
	'$syntax_check_discontiguous'(_,off),
	'$syntax_check_multiple'(_,off),
	'$set_yap_flags'(12,0), % disable character escapes.
	'$set_yap_flags'(14,1),
	'$set_fpu_exceptions',
	unknown(_,fail).
'$adjust_language'(sicstus) :-
	'$switch_log_upd'(1),
	leash(full),
	'$syntax_check_mode'(_,on),
	'$syntax_check_single_var'(_,on),
	'$syntax_check_discontiguous'(_,on),
	'$syntax_check_multiple'(_,on),
	'$transl_to_on_off'(X1,on),
	'$set_yap_flags'(5,X1),
	'$force_char_conversion',
	'$set_yap_flags'(14,0),
	% CHARACTER_ESCAPE
	'$set_yap_flags'(12,1),
	'$set_fpu_exceptions',
	fileerrors,
	unknown(_,error).
'$adjust_language'(iso) :-
	'$switch_log_upd'(1),
	'$syntax_check_mode'(_,on),
	'$syntax_check_single_var'(_,on),
	'$syntax_check_discontiguous'(_,on),
	'$syntax_check_multiple'(_,on),
	% YAP_TO_CHARS
	'$set_yap_flags'(7,1),
	fileerrors,
	'$transl_to_on_off'(X1,on),
	% CHAR_CONVERSION
	'$set_yap_flags'(5,X1),
	'$force_char_conversion',
	% ALLOW_ASSERTING_STATIC
	'$set_yap_flags'(14,0),
	% CHARACTER_ESCAPE
	'$set_yap_flags'(12,1),
	'$set_fpu_exceptions',
	unknown(_,error).

'$transl_to_character_escape_modes'(0,off) :- !.
'$transl_to_character_escape_modes'(0,cprolog).
'$transl_to_character_escape_modes'(2,on) :- !.
'$transl_to_character_escape_modes'(1,iso).
'$transl_to_character_escape_modes'(2,sicstus).

'$convert_upd_sem'(0,immediate).
'$convert_upd_sem'(1,logical).
'$convert_upd_sem'(2,logical_assert).

'$transl_to_true_false'(0,false).
'$transl_to_true_false'(1,true).

'$transl_to_on_off'(0,off).
'$transl_to_on_off'(1,on).

'$transl_to_arity'(X1,X) :- X1 < 0, !, X = unbounded.
'$transl_to_arity'(X,X).

'$transl_to_rounding_function'(0,down).
'$transl_to_rounding_function'(1,toward_zero).

'$transl_to_trl_types'(0,chars).
'$transl_to_trl_types'(1,codes).
'$transl_to_trl_types'(2,atom).

'$yap_flag_show_gc_tracing'(true, _, _, on) :- !.
'$yap_flag_show_gc_tracing'(_, true, _, verbose) :- !.
'$yap_flag_show_gc_tracing'(_, _, on, very_verbose) :- !.
'$yap_flag_show_gc_tracing'(_, _, _, off).

'$flag_check_alias'(OUT, Alias) :-
	stream_property(OUT,[alias(Alias)]), !.
	
current_prolog_flag(V,Out) :-
	var(V), !,
	'$show_yap_flag_opts'(V,NOut),
	NOut = Out.
current_prolog_flag(V,Out) :-
	atom(V), !,
	yap_flag(V,NOut),
	NOut = Out.
current_prolog_flag(V,Out) :-
	'$do_error'(type_error(atom,V),current_prolog_flag(V,Out)).

set_prolog_flag(F,V) :-
	var(F), !,
	'$do_error'(instantiation_error,set_prolog_flag(F,V)).
set_prolog_flag(F,V) :-
	var(V), !,
	'$do_error'(instantiation_error,set_prolog_flag(F,V)).
set_prolog_flag(F,V) :-
	\+ atom(F), !,
	'$do_error'(type_error(atom,F),set_prolog_flag(F,V)).
set_prolog_flag(F,V) :-
	yap_flag(F,V).

prolog_flag(F, Old, New) :-
	var(F), !,
	'$do_error'(instantiation_error,prolog_flag(F,Old,New)).
prolog_flag(F, Old, New) :-
	current_prolog_flag(F, Old),
	set_prolog_flag(F, New).

prolog_flag(F, Old) :-
	current_prolog_flag(F, Old).

% if source_mode is on, then the source for the predicates
% is stored with the code
source_mode(Old,New) :-
	'$access_yap_flags'(11,X),
	'$transl_to_on_off'(X,Old),
	'$transl_to_on_off'(XN,New),
	'$set_yap_flags'(11,XN).

source :- '$set_yap_flags'(11,1).
no_source :- '$set_yap_flags'(11,0).

%
% allow users to define their own directives.
%
user_defined_directive(Dir,_) :-
	'$directive'(Dir), !.
user_defined_directive(Dir,Action) :-
	functor(Dir,Na,Ar),
	functor(NDir,Na,Ar),
	'$current_module'(M, prolog),
	assert_static('$directive'(NDir)),
	assert_static(('$exec_directive'(Dir, _, _) :- Action)),
	'$current_module'(_, M).

%
% allow users to define their own flags.
%
user_defined_flag(Atom) :- var(Atom), !,
	'$do_error'(instantiation_error,user_defined_flag(Atom)).
user_defined_flag(Atom) :-
	'$user_defined_flag'(Atom,_), !.
user_defined_flag(Atom) :-
	yap_flag(Atom, _), !,
	'$do_error'(domain_error(user_defined_prolog_flag,Atom),user_defined_flag(Atom)).
user_defined_flag(Atom) :-
	assert(prolog:'$user_defined_flag'(Atom,[])).

'$enumerate_user_flag'(V, Out) :-
	'$user_defined_flag'(V, Out).

'$user_flag_value'(F, Val) :-
	var(Val), !,
	'$user_defined_flag'(F,Val).
'$user_flag_value'(F, Val) :-
	atomic(Val), !,
	retractall(prolog:'$user_defined_flag'(F,_)),
	assert(prolog:'$user_defined_flag'(Atom,Val)).
'$user_flag_value'(F, Val) :-
	'$do_error'(type_error(atomic,Val),yap_flag(F,Val)).

'$expects_dialect'(swi) :-
	eraseall('$dialect'),
	recorda('$dialect',swi,_),
	load_files(library('dialect/swi'),[silent(true),if(not_loaded)]).
'$expects_dialect'(yap) :-
	eraseall('$dialect'),
	recorda('$dialect',yap,_).

'$thread_initialization'(M:D) :-
	eraseall('$thread_initialization'),
	recorda('$thread_initialization',M:D,_),
	fail.
'$thread_initialization'(M:D) :-
	'$initialization'(M:D).