This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/pl/directives.yap

1115 lines
32 KiB
Plaintext
Raw Normal View History

/*************************************************************************
* *
* 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(_)).
2009-04-25 18:54:21 +01:00
'$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).
2009-04-25 18:54:21 +01:00
'$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)).
2009-04-21 21:19:26 +01:00
'$enable_restore_flag_info'(_) :-
nb_getval('$consulting_file',[]), !.
2009-04-21 21:19:26 +01:00
'$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) :-
2009-03-13 19:40:27 +00:00
eraseall('$dialect'),
recorda('$dialect',swi,_),
2009-03-09 00:44:30 +00:00
load_files(library('dialect/swi'),[silent(true),if(not_loaded)]).
2009-03-13 19:40:27 +00:00
'$expects_dialect'(yap) :-
eraseall('$dialect'),
recorda('$dialect',yap,_).
2009-04-25 18:54:21 +01:00
'$thread_initialization'(M:D) :-
eraseall('$thread_initialization'),
recorda('$thread_initialization',M:D,_),
fail.
'$thread_initialization'(M:D) :-
'$initialization'(M:D).