From a5e8dbc0963ebf078bce5323ffec840ef18c1164 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 28 Feb 2010 01:11:05 +0000 Subject: [PATCH] split directives into two files. --- Makefile.in | 4 +- pl/directives.yap | 1089 +------------------------------------------- pl/flags.yap | 1098 +++++++++++++++++++++++++++++++++++++++++++++ pl/init.yap | 3 +- 4 files changed, 1108 insertions(+), 1086 deletions(-) create mode 100644 pl/flags.yap diff --git a/Makefile.in b/Makefile.in index 0e7220ec4..bbfae6c2b 100755 --- a/Makefile.in +++ b/Makefile.in @@ -219,7 +219,9 @@ PL_SOURCES= \ $(srcdir)/pl/directives.yap \ $(srcdir)/pl/eam.yap \ $(srcdir)/pl/eval.yap \ - $(srcdir)/pl/errors.yap $(srcdir)/pl/grammar.yap \ + $(srcdir)/pl/errors.yap \ + $(srcdir)/pl/flags.yap \ + $(srcdir)/pl/grammar.yap \ $(srcdir)/pl/ground.yap \ $(srcdir)/pl/hacks.yap \ $(srcdir)/pl/init.yap \ diff --git a/pl/directives.yap b/pl/directives.yap index 468a6a48f..c19ebd4a0 100644 --- a/pl/directives.yap +++ b/pl/directives.yap @@ -165,1084 +165,12 @@ user_defined_directive(Dir,Action) :- assert_static(('$exec_directive'(Dir, _, _) :- Action)), '$current_module'(_, M). - -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). - -% do or do not machine code -yap_flag(executable,L) :- '$executable'(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)),_), +'$thread_initialization'(M:D) :- + eraseall('$thread_initialization'), + recorda('$thread_initialization',M:D,_), 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,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(prompt_alternatives_on,OUT) :- - var(OUT), !, - '$prompt_alternatives_on'(OUT). -yap_flag(prompt_alternatives_on,determinism) :- !, - '$purge_clauses'('$prompt_alternatives_on'(_),prolog), - '$compile'('$prompt_alternatives_on'(determinism),0,'$prompt_alternatives_on'(determinism),prolog). -yap_flag(prompt_alternatives_on,groundness) :- !, - '$purge_clauses'('$prompt_alternatives_on'(_),prolog), - '$compile'('$prompt_alternatives_on'(groundness),0,'$prompt_alternatives_on'(groundness),prolog). -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), - '$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(address_bits,X) :- - var(X), !, - '$address_bits'(X). -yap_flag(address_bits,X) :- - integer(X), X > 0, !, - '$do_error'(permission_error(modify,flag,address_bits),yap_flag(address_bits,X)). -yap_flag(address_bits,X) :- - '$do_error'(domain_error(flag_value,address_bits+X),yap_flag(address_bits,X)). - -yap_flag(dialect,yap). - -'$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 ; -'$yap_system_flag'(fileerrors ). -'$yap_system_flag'(float_format). -% V = float_mantissa_digits ; -% V = float_epsilon ; -% V = float_min_exponent ; -% V = float_max_exponent ; -'$yap_system_flag'(gc ). -'$yap_system_flag'(gc_margin ). -'$yap_system_flag'(gc_trace ). -'$yap_system_flag'(generate_debug_info ). -% V = hide ; -'$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). -'$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, Val) :- - prolog:'$user_defined_flag'(F,_,_,_), !, - yap_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), !, - '$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). - -create_prolog_flag(Name, Value, Options) :- - '$check_flag_name'(Name, create_prolog_flag(Name, Value, Options)), - '$check_flag_options'(Options, Domain, RW, create_prolog_flag(Name, Value, Options)), - '$check_flag_value'(Value, Domain, create_prolog_flag(Name, Value, Options)), - retractall(prolog:'$user_defined_flag'(Name,_,_,_)), - assert(prolog:'$user_defined_flag'(Name,Domain,RW,Value)). - -'$check_flag_name'(V, G) :- - var(V), - '$do_error'(instantiation_error,G). -'$check_flag_name'(Name, _) :- - atom(Name), !. -'$check_flag_name'(Name, G) :- - '$do_error'(type_error(atom),G). - -'$check_flag_options'(O, _, _, G) :- - var(O), - '$do_error'(instantiation_error,G). -'$check_flag_options'([], _, read_write, _) :- !. -'$check_flag_options'([O1|Os], Domain, RW, G) :- !, - '$check_flag_optionsl'([O1|Os], Domain, RW, G). -'$check_flag_options'(O, _, _, G) :- - '$do_error'(type_error(list),G). - - -'$check_flag_optionsl'([], _, read_write, G). -'$check_flag_optionsl'([V|Os], Domain, RW, G) :- - var(V), - '$do_error'(instantiation_error,G). -'$check_flag_optionsl'([type(Type)|Os], Domain, RW, G) :- !, - '$check_flag_type'(Type, Domain, G), - '$check_flag_optionsl'(Os, _, RW, G). -'$check_flag_optionsl'([access(Access)|Os], Domain, RW, G) :- !, - '$check_flag_access'(Access, RW, G), - '$check_flag_optionsl'(Os, Domain, _, G). -'$check_flag_optionsl'(Os, Domain, RW, G) :- - '$do_error'(domain_error(create_prolog_flag,Os),G). - -'$check_flag_type'(V, _, G) :- - var(V), - '$do_error'(instantiation_error,G). -'$check_flag_type'(boolean, boolean, _) :- !. -'$check_flag_type'(integer, integer, _) :- !. -'$check_flag_type'(float, float, _) :- !. -'$check_flag_type'(atom, atom, _) :- !. -'$check_flag_type'(term, term, _) :- !. -'$check_flag_type'(Atom, _, G) :- - '$do_error'(domain_error(create_prolog_flag_option(type),Atom),G). - -'$check_flag_access'(V, _, G) :- - var(V), - '$do_error'(instantiation_error,G). -'$check_flag_access'(read_write, read_write, _) :- !. -'$check_flag_access'(read_only, read_only, _) :- !. -'$check_flag_type'(Atom, _, G) :- - '$do_error'(domain_error(create_prolog_flag_option(access),Atom),G). - -'$user_flag_value'(F, Val) :- - var(Val), !, - '$user_defined_flag'(F,_,_,Val). -'$user_flag_value'(F, Val) :- - atomic(Val), !, - prolog:'$user_defined_flag'(F,Domain,RW,V0), - ( - Val == V0 - -> - true - ; - RW = read_only - -> - '$do_error'(permission_error(modify,flag,F),yap_flag(F,Val)) - ; - '$check_flag_value'(Val, Domain, yap_flag(F,Val)), - retractall(prolog:'$user_defined_flag'(F,_,_,_)), - assert(prolog:'$user_defined_flag'(F,Domain,RW,Val)) - ). -'$user_flag_value'(F, Val) :- - '$do_error'(type_error(atomic,Val),yap_flag(F,Val)). - -'$check_flag_value'(Value, _, G) :- - \+ ground(Value), !, - '$do_error'(instantiation_error,G). -'$check_flag_value'(Value, Domain, G) :- - var(Domain), !, - '$flag_domain_from_value'(Value, Domain). -'$check_flag_value'(_, term, _) :- !. -'$check_flag_value'(Value, atom, _) :- - atom(Value), !. -'$check_flag_value'(Value, integer, _) :- - integer(Value), !. -'$check_flag_value'(Value, float, _) :- - float(Value), !. -'$check_flag_value'(true, boolean, _) :- !. -'$check_flag_value'(false, boolean, _) :- !. -'$check_flag_value'(Value, Domain, G) :- - '$do_error'(domain_error(Domain,Value),G). - -'$flag_domain_from_value'(true, boolean) :- !. -'$flag_domain_from_value'(false, boolean) :- !. -'$flag_domain_from_value'(Value, integer) :- integer(Value), !. -'$flag_domain_from_value'(Value, float) :- float(Value), !. -'$flag_domain_from_value'(Value, atom) :- atom(Value), !. -'$flag_domain_from_value'(_, term). - +'$thread_initialization'(M:D) :- + '$initialization'(M:D). '$expects_dialect'(swi) :- eraseall('$dialect'), @@ -1252,11 +180,4 @@ create_prolog_flag(Name, Value, Options) :- 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). - diff --git a/pl/flags.yap b/pl/flags.yap new file mode 100644 index 000000000..0691379fb --- /dev/null +++ b/pl/flags.yap @@ -0,0 +1,1098 @@ +/************************************************************************* +* * +* YAP Prolog * +* * +* Yap Prolog was developed at NCCUP - Universidade do Porto * +* * +* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * +* * +************************************************************************** +* * +* File: flags.yap * +* Last rev: * +* mods: * +* comments: controlling YAP * +* * +*************************************************************************/ + + +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). + +% do or do not machine code +yap_flag(executable,L) :- '$executable'(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,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(flo + at_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(prompt_alternatives_on,OUT) :- + var(OUT), !, + '$prompt_alternatives_on'(OUT). +yap_flag(prompt_alternatives_on,determinism) :- !, + '$purge_clauses'('$prompt_alternatives_on'(_),prolog), + '$compile'('$prompt_alternatives_on'(determinism),0,'$prompt_alternatives_on'(determinism),prolog). +yap_flag(prompt_alternatives_on,groundness) :- !, + '$purge_clauses'('$prompt_alternatives_on'(_),prolog), + '$compile'('$prompt_alternatives_on'(groundness),0,'$prompt_alternatives_on'(groundness),prolog). +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), + '$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(address_bits,X) :- + var(X), !, + '$address_bits'(X). +yap_flag(address_bits,X) :- + integer(X), X > 0, !, + '$do_error'(permission_error(modify,flag,address_bits),yap_flag(address_bits,X)). +yap_flag(address_bits,X) :- + '$do_error'(domain_error(flag_value,address_bits+X),yap_flag(address_bits,X)). + +yap_flag(dialect,yap). + +'$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 ; +'$yap_system_flag'(fileerrors ). +'$yap_system_flag'(float_format). +% V = float_mantissa_digits ; +% V = float_epsilon ; +% V = float_min_exponent ; +% V = float_max_exponent ; +'$yap_system_flag'(gc ). +'$yap_system_flag'(gc_margin ). +'$yap_system_flag'(gc_trace ). +'$yap_system_flag'(generate_debug_info ). +% V = hide ; +'$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). +'$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, Val) :- + prolog:'$user_defined_flag'(F,_,_,_), !, + yap_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), !, + '$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). + +create_prolog_flag(Name, Value, Options) :- + '$check_flag_name'(Name, create_prolog_flag(Name, Value, Options)), + '$check_flag_options'(Options, Domain, RW, create_prolog_flag(Name, Value, Options)), + '$check_flag_value'(Value, Domain, create_prolog_flag(Name, Value, Options)), + retractall(prolog:'$user_defined_flag'(Name,_,_,_)), + assert(prolog:'$user_defined_flag'(Name,Domain,RW,Value)). + +'$check_flag_name'(V, G) :- + var(V), + '$do_error'(instantiation_error,G). +'$check_flag_name'(Name, _) :- + atom(Name), !. +'$check_flag_name'(Name, G) :- + '$do_error'(type_error(atom),G). + +'$check_flag_options'(O, _, _, G) :- + var(O), + '$do_error'(instantiation_error,G). +'$check_flag_options'([], _, read_write, _) :- !. +'$check_flag_options'([O1|Os], Domain, RW, G) :- !, + '$check_flag_optionsl'([O1|Os], Domain, RW, G). +'$check_flag_options'(O, _, _, G) :- + '$do_error'(type_error(list),G). + + +'$check_flag_optionsl'([], _, read_write, G). +'$check_flag_optionsl'([V|Os], Domain, RW, G) :- + var(V), + '$do_error'(instantiation_error,G). +'$check_flag_optionsl'([type(Type)|Os], Domain, RW, G) :- !, + '$check_flag_type'(Type, Domain, G), + '$check_flag_optionsl'(Os, _, RW, G). +'$check_flag_optionsl'([access(Access)|Os], Domain, RW, G) :- !, + '$check_flag_access'(Access, RW, G), + '$check_flag_optionsl'(Os, Domain, _, G). +'$check_flag_optionsl'(Os, Domain, RW, G) :- + '$do_error'(domain_error(create_prolog_flag,Os),G). + +'$check_flag_type'(V, _, G) :- + var(V), + '$do_error'(instantiation_error,G). +'$check_flag_type'(boolean, boolean, _) :- !. +'$check_flag_type'(integer, integer, _) :- !. +'$check_flag_type'(float, float, _) :- !. +'$check_flag_type'(atom, atom, _) :- !. +'$check_flag_type'(term, term, _) :- !. +'$check_flag_type'(Atom, _, G) :- + '$do_error'(domain_error(create_prolog_flag_option(type),Atom),G). + +'$check_flag_access'(V, _, G) :- + var(V), + '$do_error'(instantiation_error,G). +'$check_flag_access'(read_write, read_write, _) :- !. +'$check_flag_access'(read_only, read_only, _) :- !. +'$check_flag_type'(Atom, _, G) :- + '$do_error'(domain_error(create_prolog_flag_option(access),Atom),G). + +'$user_flag_value'(F, Val) :- + var(Val), !, + '$user_defined_flag'(F,_,_,Val). +'$user_flag_value'(F, Val) :- + atomic(Val), !, + prolog:'$user_defined_flag'(F,Domain,RW,V0), + ( + Val == V0 + -> + true + ; + RW = read_only + -> + '$do_error'(permission_error(modify,flag,F),yap_flag(F,Val)) + ; + '$check_flag_value'(Val, Domain, yap_flag(F,Val)), + retractall(prolog:'$user_defined_flag'(F,_,_,_)), + assert(prolog:'$user_defined_flag'(F,Domain,RW,Val)) + ). +'$user_flag_value'(F, Val) :- + '$do_error'(type_error(atomic,Val),yap_flag(F,Val)). + +'$check_flag_value'(Value, _, G) :- + \+ ground(Value), !, + '$do_error'(instantiation_error,G). +'$check_flag_value'(Value, Domain, G) :- + var(Domain), !, + '$flag_domain_from_value'(Value, Domain). +'$check_flag_value'(_, term, _) :- !. +'$check_flag_value'(Value, atom, _) :- + atom(Value), !. +'$check_flag_value'(Value, integer, _) :- + integer(Value), !. +'$check_flag_value'(Value, float, _) :- + float(Value), !. +'$check_flag_value'(true, boolean, _) :- !. +'$check_flag_value'(false, boolean, _) :- !. +'$check_flag_value'(Value, Domain, G) :- + '$do_error'(domain_error(Domain,Value),G). + +'$flag_domain_from_value'(true, boolean) :- !. +'$flag_domain_from_value'(false, boolean) :- !. +'$flag_domain_from_value'(Value, integer) :- integer(Value), !. +'$flag_domain_from_value'(Value, float) :- float(Value), !. +'$flag_domain_from_value'(Value, atom) :- atom(Value), !. +'$flag_domain_from_value'(_, term). + + + diff --git a/pl/init.yap b/pl/init.yap index c98b8152a..2bd34f4f8 100644 --- a/pl/init.yap +++ b/pl/init.yap @@ -45,7 +45,8 @@ otherwise. :- [ 'utils.yap', 'control.yap', 'arith.yap', - 'directives.yap']. + 'directives.yap', + 'flags.yap']. :- compile_expressions.