diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

flags, etc

Browse Source
This commit is contained in:
Vítor Santos Costa 2015-06-19 01:11:30 +01:00
parent c3487d0fc0
commit b93f10fe07
8 changed files with 161 additions and 1068 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pl/attributes.yap
View File

@ -324,7 +324,7 @@ do_continuation(Continuation, Module1) :-
execute_continuation(Continuation, Module1) :- execute_continuation(Continuation, Module1) :-
'$undefined'(Continuation, Module1), !, '$undefined'(Continuation, Module1), !,
'$current_module'( M ), '$current_module'( M ),
'$swi_current_prolog_flag'( M:unknown, Default ), current_prolog_flag( M:unknown, Default ),
'$undefp'([Module1|Continuation] , Default ). '$undefp'([Module1|Continuation] , Default ).
execute_continuation(Continuation, Mod) :- execute_continuation(Continuation, Mod) :-
% do not do meta-expansion nor any fancy stuff. % do not do meta-expansion nor any fancy stuff.

108
pl/boot.yap
View File

@ -324,20 +324,14 @@ true :- true.
set_value('$yap_inited', true), set_value('$yap_inited', true),
% do catch as early as possible % do catch as early as possible
( (
'$access_yap_flags'(15, 0), current_prolog_flag(halt_after_consult, false),
'$access_yap_flags'(22, 0), current_prolog_flag(verbose, normal),
\+ '$uncaught_throw' \+ '$uncaught_throw'
-> ->
'$version' '$version'
; ;
true true
), ),
(
'$access_yap_flags'(22, 0) ->
'$swi_set_prolog_flag'(verbose, normal)
;
'$swi_set_prolog_flag'(verbose, silent)
),
% '$init_preds', % needs to be done before library_directory % '$init_preds', % needs to be done before library_directory
% ( % (
% retractall(user:library_directory(_)), % retractall(user:library_directory(_)),
@ -347,17 +341,16 @@ true :- true.
% ; % ;
% true % true
% ), % ),
'$swi_current_prolog_flag'(file_name_variables, OldF), current_prolog_flag(file_name_variables, OldF),
'$swi_set_prolog_flag'(file_name_variables, true), set_prolog_flag(file_name_variables, true),
'$init_consult', '$init_consult',
'$swi_set_prolog_flag'(file_name_variables, OldF), set_prolog_flag(file_name_variables, OldF),
'$init_win_graphics',
'$init_globals', '$init_globals',
'$swi_set_prolog_flag'(fileerrors, true), set_prolog_flag(fileerrors, true),
set_value('$gc',on), set_value('$gc',on),
('$exit_undefp' -> true ; true), ('$exit_undefp' -> true ; true),
prompt1(' ?- '), prompt1(' ?- '),
'$swi_set_prolog_flag'(debug, false), set_prolog_flag(debug, false),
% simple trick to find out if this is we are booting from Prolog. % simple trick to find out if this is we are booting from Prolog.
% boot from a saved state % boot from a saved state
( (
@ -369,7 +362,7 @@ true :- true.
-> ->
bootstrap(X), bootstrap(X),
module( user ), module( user ),
qsave_program( "startup.yss") qsave_program( 'startup.yss')
; ;
true true
) )
@ -385,7 +378,7 @@ true :- true.
'$run_at_thread_start'. '$run_at_thread_start'.
'$init_globals' :- '$init_globals' :-
% '$swi_set_prolog_flag'(break_level, 0), % set_prolog_flag(break_level, 0),
% '$set_read_error_handler'(error), let the user do that % '$set_read_error_handler'(error), let the user do that
nb_setval('$chr_toplevel_show_store',false). nb_setval('$chr_toplevel_show_store',false).
@ -433,8 +426,9 @@ true :- true.
/* main execution loop */ /* main execution loop */
'$read_toplevel'(Goal, Bindings) :- '$read_toplevel'(Goal, Bindings) :-
fail,
'$pred_exists'(read_history(_,_,_,_,_,_), user), '$pred_exists'(read_history(_,_,_,_,_,_), user),
'$swi_current_prolog_flag'(readline, true), !, current_prolog_flag(readline, true), !,
read_history(h, '!h', read_history(h, '!h',
[trace, end_of_file], [trace, end_of_file],
Prompt, Goal, Bindings), !, Prompt, Goal, Bindings), !,
@ -446,34 +440,24 @@ true :- true.
'$read_toplevel'(Goal, Bindings) :- '$read_toplevel'(Goal, Bindings) :-
prompt1('?- '), prompt1('?- '),
prompt(_,'|: '), prompt(_,'|: '),
(print_message(error, E), '$system_catch'(read_term(user_input,
'$handle_toplevel_error'(Line, E))), Goal,
( [variable_names(Bindings)]),
'$pred_exists'(rl_add_history(_), user) prolog, E, '$handle_toplevel_error'( E) ).
->
format(atom(CompleteLine), '~W~W',
[ Line, [partial(true)],
'.', [partial(true)]
]),
user:rl_add_history(CompleteLine)
;
true
),
'$system_catch'(
atom_to_term(Line, Goal, Bindings), prolog, E,
( print_message(error, E),
fail
)
), !.
'$handle_toplevel_error'(_, syntax_error(_)) :- '$handle_toplevel_error'( syntax_error(_)) :-
!, !,
fail. fail.
'$handle_toplevel_error'(end_of_file, error(io_error(read,user_input),_)) :- '$handle_toplevel_error'( error(io_error(read,user_input),_)) :-
!. !.
'$handle_toplevel_error'(_, E) :- '$handle_toplevel_error'(_, E) :-
throw(E). throw(E).
/** @pred stream_property( _Stream_, _Prop_)
*/
% reset alarms when entering top-level. % reset alarms when entering top-level.
'$enter_top_level' :- '$enter_top_level' :-
'$alarm'(0, 0, _, _), '$alarm'(0, 0, _, _),
@ -482,8 +466,8 @@ true :- true.
'$clean_up_dead_clauses', '$clean_up_dead_clauses',
fail. fail.
'$enter_top_level' :- '$enter_top_level' :-
'$swi_current_prolog_flag'(break_level, BreakLevel), current_prolog_flag(break_level, BreakLevel),
'$swi_current_prolog_flag'(debug, DBON), current_prolog_flag(debug, DBON),
( (
'$nb_getval'('$trace', on, fail) '$nb_getval'('$trace', on, fail)
-> ->
@ -501,7 +485,7 @@ true :- true.
get_value('$top_level_goal',GA), GA \= [], !, get_value('$top_level_goal',GA), GA \= [], !,
set_value('$top_level_goal',[]), set_value('$top_level_goal',[]),
'$run_atom_goal'(GA), '$run_atom_goal'(GA),
'$swi_current_prolog_flag'(break_level, BreakLevel), current_prolog_flag(break_level, BreakLevel),
( (
Breaklevel \= 0 Breaklevel \= 0
-> ->
@ -523,7 +507,7 @@ true :- true.
nb_setval('$debug_run',off), nb_setval('$debug_run',off),
nb_setval('$debug_jump',off), nb_setval('$debug_jump',off),
'$command'(Command,Varnames,_Pos,top), '$command'(Command,Varnames,_Pos,top),
'$swi_current_prolog_flag'(break_level, BreakLevel), current_prolog_flag(break_level, BreakLevel),
( (
BreakLevel \= 0 BreakLevel \= 0
-> ->
@ -545,15 +529,11 @@ true :- true.
'$erase_sets'. '$erase_sets'.
'$version' :- '$version' :-
get_value('$version_name',VersionName), current_prolog_flag(version_git,VersionGit),
print_message(help, version(VersionName)), current_prolog_flag(compiled_at,AT),
get_value('$myddas_version_name',MYDDASVersionName), current_prolog_flag(version_data, yap(Mj, Mi, Patch, _) ),
MYDDASVersionName \== [], sub_atom( VersionGit, 0, 8, _, VERSIONGIT ),
print_message(help, myddas_version(MYDDASVersionName)), format(user_error, '% YAP ~d.~d.~d-~a (compiled ~a)~n', [Mj,Mi, Patch, VERSIONGIT, AT]),
fail.
'$version' :-
recorded('$version',VersionName,_),
print_message(help, VersionName),
fail. fail.
'$version'. '$version'.
@ -604,7 +584,7 @@ number of steps.
recorda('$result',going,_). recorda('$result',going,_).
'$command'(C,VL,Pos,Con) :- '$command'(C,VL,Pos,Con) :-
'$access_yap_flags'(9,1), !, current_prolog_flag(strict_iso, true), !, /* strict_iso on */
'$execute_command'(C,VL,Pos,Con,C). '$execute_command'(C,VL,Pos,Con,C).
'$command'(C,VL,Pos,Con) :- '$command'(C,VL,Pos,Con) :-
( (Con = top ; var(C) ; C = [_|_]) -> ( (Con = top ; var(C) ; C = [_|_]) ->
@ -675,7 +655,7 @@ number of steps.
% YAP accepts everything everywhere % YAP accepts everything everywhere
% %
'$process_directive'(G, top, M, VL, Pos) :- '$process_directive'(G, top, M, VL, Pos) :-
'$access_yap_flags'(8, 0), !, % YAP mode, go in and do it, current_prolog_flag(language_mode, yap), !, /* strict_iso on */
'$process_directive'(G, consult, M, VL, Pos). '$process_directive'(G, consult, M, VL, Pos).
'$process_directive'(G, top, _, _, _) :- !, '$process_directive'(G, top, _, _, _) :- !,
'$do_error'(context_error((:- G),clause),query). '$do_error'(context_error((:- G),clause),query).
@ -695,7 +675,7 @@ number of steps.
% ISO does not allow goals (use initialization). % ISO does not allow goals (use initialization).
% %
'$process_directive'(D, _, M, VL, Pos) :- '$process_directive'(D, _, M, VL, Pos) :-
'$access_yap_flags'(8, 1), !, % ISO Prolog mode, go in and do it, current_prolog_flag(language_mode, iso), !, % ISO Prolog mode, go in and do it,
'$do_error'(context_error((:- M:D),query),directive). '$do_error'(context_error((:- M:D),query),directive).
% %
% but YAP and SICStus does. % but YAP and SICStus does.
@ -754,10 +734,8 @@ number of steps.
% process an input clause % process an input clause
'$$compile'(G, G0, L, Mod) :- '$$compile'(G, G0, L, Mod) :-
'$head_and_body'(G,H,_), '$head_and_body'(G,H,_),
'$flags'(H, Mod, Fl, Fl),
is(NFl, /\, Fl, 0x00002000),
( (
NFl \= 0 '$is_dynamic'(H, Mod)
-> ->
'$assertz_dynamic'(L, G, G0, Mod) '$assertz_dynamic'(L, G, G0, Mod)
; ;
@ -897,7 +875,7 @@ number of steps.
flush_output, flush_output,
fail. fail.
'$present_answer'((?-), Answ) :- '$present_answer'((?-), Answ) :-
'$swi_current_prolog_flag'(break_level, BL ), current_prolog_flag(break_level, BL ),
( BL \= 0 -> format(user_error, '[~p] ',[BL]) ; ( BL \= 0 -> format(user_error, '[~p] ',[BL]) ;
true ), true ),
( recorded('$print_options','$toplevel'(Opts),_) -> ( recorded('$print_options','$toplevel'(Opts),_) ->
@ -1139,7 +1117,7 @@ incore(G) :- '$execute'(G).
). ).
'$enable_debugging' :- '$enable_debugging' :-
'$swi_current_prolog_flag'(debug, false), !. current_prolog_flag(debug, false), !.
'$enable_debugging' :- '$enable_debugging' :-
'$nb_getval'('$trace', on, fail), !, '$nb_getval'('$trace', on, fail), !,
'$creep'. '$creep'.
@ -1334,12 +1312,12 @@ bootstrap(F) :-
% '$open'(F, '$csult', Stream, 0, 0, F), % '$open'(F, '$csult', Stream, 0, 0, F),
% '$file_name'(Stream,File), % '$file_name'(Stream,File),
open(F, read, Stream), open(F, read, Stream),
stream_property(Stream, file_name(File)), stream_property(Stream, [file_name(File)]),
'$start_consult'(consult, File, LC), '$start_consult'(consult, File, LC),
file_directory_name(File, Dir), file_directory_name(File, Dir),
working_directory(OldD, Dir), working_directory(OldD, Dir),
( (
'$swi_current_prolog_flag'(verbose_load, silent) current_prolog_flag(verbose_load, silent)
-> ->
true true
; ;
@ -1351,7 +1329,7 @@ bootstrap(F) :-
'$current_module'(_, prolog), '$current_module'(_, prolog),
'$end_consult', '$end_consult',
( (
'$swi_current_prolog_flag'(verbose_load, silent) current_prolog_flag(verbose_load, silent)
-> ->
true true
; ;
@ -1388,7 +1366,7 @@ bootstrap(F) :-
!. !.
'$enter_command'(Stream,Mod,Status) :- '$enter_command'(Stream,Mod,Status) :-
read_clause(Stream, Command, [variable_names(Vars), term_position(Pos), syntax_errors(dec10) ]), read_term(Stream, Command, [variable_names(Vars), term_position(Pos), syntax_errors(dec10) ]),
'$command'(Command,Vars,Pos,Status). '$command'(Command,Vars,Pos,Status).
'$abort_loop'(Stream) :- '$abort_loop'(Stream) :-
@ -1426,7 +1404,7 @@ bootstrap(F) :-
'$module_expansion'(Term, Expanded0, ExpandedI, HeadMod, BodyMod, SourceMod), !, '$module_expansion'(Term, Expanded0, ExpandedI, HeadMod, BodyMod, SourceMod), !,
%format(' -> ~w~n',[Expanded0]), %format(' -> ~w~n',[Expanded0]),
( (
'$access_yap_flags'(9,1) /* strict_iso on */ current_prolog_flag(strict_iso, true) /* strict_iso on */
-> ->
Expanded = ExpandedI, Expanded = ExpandedI,
'$check_iso_strict_clause'(Expanded0) '$check_iso_strict_clause'(Expanded0)
@ -1571,7 +1549,7 @@ catch_ball(Ball, V) :-
catch_ball(C, C). catch_ball(C, C).
'$run_toplevel_hooks' :- '$run_toplevel_hooks' :-
'$swi_current_prolog_flag'(break_level, 0 ), current_prolog_flag(break_level, 0 ),
recorded('$toplevel_hooks',H,_), recorded('$toplevel_hooks',H,_),
H \= fail, !, H \= fail, !,
( call(user:H1) -> true ; true). ( call(user:H1) -> true ; true).

88
pl/consult.yap
View File

@ -214,8 +214,8 @@ load_files(Files,Opts) :-
'$lf_option'(silent, 8, _). '$lf_option'(silent, 8, _).
'$lf_option'(skip_unix_header, 9, true). '$lf_option'(skip_unix_header, 9, true).
'$lf_option'(compilation_mode, 10, Flag) :- '$lf_option'(compilation_mode, 10, Flag) :-
'$access_yap_flags'(11,YF), current_prolog_flag(source, YFlag),
( YF == 0 -> Flag = compact ; Flag = source ). ( YFlag == false -> Flag = compact ; Flag = source ).
'$lf_option'(consult, 11, reconsult). '$lf_option'(consult, 11, reconsult).
'$lf_option'(stream, 12, _). '$lf_option'(stream, 12, _).
'$lf_option'(register, 13, true). '$lf_option'(register, 13, true).
@ -227,7 +227,8 @@ load_files(Files,Opts) :-
'$lf_option'('$location', 19, _). '$lf_option'('$location', 19, _).
'$lf_option'(dialect, 20, yap). '$lf_option'(dialect, 20, yap).
'$lf_option'(format, 21, source). '$lf_option'(format, 21, source).
'$lf_option'(redefine_module, 22, false). '$lf_option'(redefine_module, 22, Warn) :-
( var(Warn) -> current_prolog_flag( redefine_warnings, Redefine ), Redefine = Warn ; true )).
'$lf_option'(reexport, 23, false). '$lf_option'(reexport, 23, false).
'$lf_option'(sandboxed, 24, false). '$lf_option'(sandboxed, 24, false).
'$lf_option'(scope_settings, 25, false). '$lf_option'(scope_settings, 25, false).
@ -436,13 +437,15 @@ load_files(Files,Opts) :-
; ;
stream_property(Stream, file_name(Y)) stream_property(Stream, file_name(Y))
), !, ), !,
( '$size_stream'(Stream, Pos) -> true ; Pos = 0), % start_low_level_trace,
( file_size(Stream, Pos) -> true ; Pos = 0),
'$set_lf_opt'('$source_pos', TOpts, Pos), '$set_lf_opt'('$source_pos', TOpts, Pos),
'$lf_opt'(reexport, TOpts, Reexport), '$lf_opt'(reexport, TOpts, Reexport),
'$lf_opt'(if, TOpts, If), '$lf_opt'(if, TOpts, If),
( var(If) -> If = true ; true ), ( var(If) -> If = true ; true ),
'$lf_opt'(imports, TOpts, Imports), '$lf_opt'(imports, TOpts, Imports),
'$start_lf'(If, Mod, Stream, TOpts, File, Y, Reexport, Imports), '$start_lf'(If, Mod, Stream, TOpts, File, Y, Reexport, Imports),
% stop_low_level_trace,
close(Stream). close(Stream).
'$lf'(X, _, Call, _) :- '$lf'(X, _, Call, _) :-
'$do_error'(permission_error(input,stream,X),Call). '$do_error'(permission_error(input,stream,X),Call).
@ -461,6 +464,7 @@ load_files(Files,Opts) :-
'$reexport'( TOpts, ParentF, Reexport, Imports, File ). '$reexport'( TOpts, ParentF, Reexport, Imports, File ).
'$start_lf'(_, Mod, PlStream, TOpts, _UserFile, File, Reexport, ImportList) :- '$start_lf'(_, Mod, PlStream, TOpts, _UserFile, File, Reexport, ImportList) :-
% check if there is a qly file % check if there is a qly file
% start_low_level_trace,
'$absolute_file_name'(File,[access(read),file_type(qly),file_errors(fail),solutions(first),expand(true)],F,qload_file(File)), '$absolute_file_name'(File,[access(read),file_type(qly),file_errors(fail),solutions(first),expand(true)],F,qload_file(File)),
open( F, read, Stream , [type(binary)] ), open( F, read, Stream , [type(binary)] ),
H0 is heapused, '$cputime'(T0,_), H0 is heapused, '$cputime'(T0,_),
@ -483,6 +487,7 @@ load_files(Files,Opts) :-
'$lf_opt'('$location', TOpts, ParentF:_Line), '$lf_opt'('$location', TOpts, ParentF:_Line),
'$reexport'( TOpts, ParentF, Reexport, ImportList, File ), '$reexport'( TOpts, ParentF, Reexport, ImportList, File ),
print_message(Verbosity, loaded( loaded, F, M, T, H)), print_message(Verbosity, loaded( loaded, F, M, T, H)),
% stop_low_level_trace,
'$exec_initialisation_goals' '$exec_initialisation_goals'
; ;
close( Stream), close( Stream),
@ -503,7 +508,7 @@ loaded, otherwise advertises the user about the existing name clashes
are not public remain invisible. are not public remain invisible.
When the files are not module files, ensure_loaded/1 loads them When the files are not module files, ensure_loaded/1 loads them
if they have not been loaded before, and naes nothing otherwise. if they have not been loaded before, and does nothing otherwise.
_F_ must be a list containing the names of the files to load. _F_ must be a list containing the names of the files to load.
*/ */
@ -543,7 +548,7 @@ consult(Fs) :-
'$consult'(Fs, M0). '$consult'(Fs, M0).
'$consult'(Fs,Module) :- '$consult'(Fs,Module) :-
'$access_yap_flags'(8, 2), % SICStus Prolog compatibility current_prolog_flag(language_mode, iso), % SICStus Prolog compatibility
!, !,
'$load_files'(Module:Fs,[],consult(Fs)). '$load_files'(Module:Fs,[],consult(Fs)).
'$consult'(Fs, Module) :- '$consult'(Fs, Module) :-
@ -646,6 +651,9 @@ db_files(Fs) :-
'$do_lf'(ContextModule, Stream, UserFile, File, TOpts) :- '$do_lf'(ContextModule, Stream, UserFile, File, TOpts) :-
stream_property(OldStream, alias(loop_stream) ),
'$lf_opt'(encoding, TOpts, Encoding),
set_stream( Stream, [alias(loop_stream), encoding(Encoding)] ),
'$lf_opt'('$context_module', TOpts, ContextModule), '$lf_opt'('$context_module', TOpts, ContextModule),
'$lf_opt'(reexport, TOpts, Reexport), '$lf_opt'(reexport, TOpts, Reexport),
'$msg_level'( TOpts, Verbosity), '$msg_level'( TOpts, Verbosity),
@ -653,8 +661,6 @@ db_files(Fs) :-
'$nb_getval'('$qcompile', ContextQCompiling, ContextQCompiling = never), '$nb_getval'('$qcompile', ContextQCompiling, ContextQCompiling = never),
nb_setval('$qcompile', QCompiling), nb_setval('$qcompile', QCompiling),
% format( 'I=~w~n', [Verbosity=UserFile] ), % format( 'I=~w~n', [Verbosity=UserFile] ),
'$lf_opt'(encoding, TOpts, Encoding),
'$set_encoding'(Stream, Encoding),
% export to process % export to process
b_setval('$lf_status', TOpts), b_setval('$lf_status', TOpts),
'$reset_if'(OldIfLevel), '$reset_if'(OldIfLevel),
@ -666,8 +672,7 @@ db_files(Fs) :-
'$loaded'(File, UserFile, SourceModule, ParentF, Line, Reconsult0, Reconsult, Dir, Opts), '$loaded'(File, UserFile, SourceModule, ParentF, Line, Reconsult0, Reconsult, Dir, Opts),
working_directory(OldD, Dir), working_directory(OldD, Dir),
H0 is heapused, '$cputime'(T0,_), H0 is heapused, '$cputime'(T0,_),
'$set_current_loop_stream'(OldStream, Stream), current_prolog_flag(generate_debug_info, GenerateDebug),
'$swi_current_prolog_flag'(generate_debug_info, GenerateDebug),
'$lf_opt'(compilation_mode, TOpts, CompMode), '$lf_opt'(compilation_mode, TOpts, CompMode),
'$comp_mode'(OldCompMode, CompMode), '$comp_mode'(OldCompMode, CompMode),
recorda('$initialisation','$',_), recorda('$initialisation','$',_),
@ -705,8 +710,8 @@ db_files(Fs) :-
; ;
true true
), ),
'$set_current_loop_stream'(Stream, OldStream), set_stream( OldStream, alias(loop_stream) ),
'$swi_set_prolog_flag'(generate_debug_info, GenerateDebug), set_prolog_flag(generate_debug_info, GenerateDebug),
'$comp_mode'(_CompMode, OldCompMode), '$comp_mode'(_CompMode, OldCompMode),
working_directory(_,OldD), working_directory(_,OldD),
% surely, we were in run mode or we would not have included the file! % surely, we were in run mode or we would not have included the file!
@ -735,13 +740,13 @@ db_files(Fs) :-
'$msg_level'( TOpts, Verbosity) :- '$msg_level'( TOpts, Verbosity) :-
'$lf_opt'(autoload, TOpts, AutoLoad), '$lf_opt'(autoload, TOpts, AutoLoad),
AutoLoad == true, AutoLoad == true,
'$swi_current_prolog_flag'(verbose_autoload, false), !, current_prolog_flag(verbose_autoload, false), !,
Verbosity = silent. Verbosity = silent.
'$msg_level'( _TOpts, Verbosity) :- '$msg_level'( _TOpts, Verbosity) :-
'$swi_current_prolog_flag'(verbose_load, false), !, current_prolog_flag(verbose_load, false), !,
Verbosity = silent. Verbosity = silent.
'$msg_level'( _TOpts, Verbosity) :- '$msg_level'( _TOpts, Verbosity) :-
'$swi_current_prolog_flag'(verbose, silent), !, current_prolog_flag(verbose, silent), !,
Verbosity = silent. Verbosity = silent.
'$msg_level'( TOpts, Verbosity) :- '$msg_level'( TOpts, Verbosity) :-
'$lf_opt'(silent, TOpts, Silent), '$lf_opt'(silent, TOpts, Silent),
@ -845,17 +850,16 @@ db_files(Fs) :-
true ; true ;
'$do_error'(permission_error(input,stream,Y),include(X)) '$do_error'(permission_error(input,stream,Y),include(X))
), ),
'$set_current_loop_stream'(OldStream, Stream),
H0 is heapused, '$cputime'(T0,_), H0 is heapused, '$cputime'(T0,_),
working_directory(Dir, Dir), working_directory(Dir, Dir),
'$lf_opt'(encoding, TOpts, Encoding),
set_stream(Stream, [encoding(Encoding),alias(loop_stream)] ),
'$loaded'(Y, X, Mod, OldY, L, include, _, Dir, []), '$loaded'(Y, X, Mod, OldY, L, include, _, Dir, []),
( '$nb_getval'('$included_file', OY, fail ) -> true ; OY = [] ), ( '$nb_getval'('$included_file', OY, fail ) -> true ; OY = [] ),
'$lf_opt'(encoding, TOpts, Encoding),
'$set_encoding'(Stream, Encoding),
nb_setval('$included_file', Y), nb_setval('$included_file', Y),
print_message(Verbosity, loading(including, Y)), print_message(Verbosity, loading(including, Y)),
'$loop'(Stream,Status), '$loop'(Stream,Status),
'$set_current_loop_stream'(Stream, OldStream), set_stream(OldStream, alias(loop_stream) ),
close(Stream), close(Stream),
H is heapused-H0, '$cputime'(TF,_), T is TF-T0, H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
print_message(Verbosity, loaded(included, Y, Mod, T, H)), print_message(Verbosity, loaded(included, Y, Mod, T, H)),
@ -870,16 +874,16 @@ db_files(Fs) :-
'$init_win_graphics', '$init_win_graphics',
fail. fail.
'$do_startup_reconsult'(X) :- '$do_startup_reconsult'(X) :-
( '$access_yap_flags'(15, 0) -> ( current_prolog_flag(language_mode, yap) ->
'$system_catch'(load_files(X, [silent(true)]), Module, Error, '$Error'(Error)) '$system_catch'(load_files(X, [silent(true)]), Module, Error, '$Error'(Error))
; ;
'$swi_set_prolog_flag'(verbose, silent), set_prolog_flag(verbose, silent),
'$system_catch'(load_files(X, [silent(true),skip_unix_header(true)]),Module,_,fail) '$system_catch'(load_files(X, [silent(true),skip_unix_header(true)]),Module,_,fail)
; ;
true true
), ),
!, !,
( '$access_yap_flags'(15, 0) -> true ; halt). ( current_prolog_flag(language_mode, yap) -> true ; halt).
'$do_startup_reconsult'(_). '$do_startup_reconsult'(_).
'$skip_unix_header'(Stream) :- '$skip_unix_header'(Stream) :-
@ -993,8 +997,7 @@ prolog_load_context(stream, Stream) :-
'$nb_getval'('$consulting_file', _, fail), '$nb_getval'('$consulting_file', _, fail),
'$current_loop_stream'(Stream). '$current_loop_stream'(Stream).
prolog_load_context(term_position, Position) :- prolog_load_context(term_position, Position) :-
'$current_loop_stream'(Stream), stream_property( Stream, [alias(loop_stream),position(Position)] ).
stream_property(Stream, position(Position) ).
% if the file exports a module, then we can % if the file exports a module, then we can
@ -1075,13 +1078,6 @@ prolog_load_context(term_position, Position) :-
true ), true ),
recorda('$lf_loaded','$lf_loaded'( F, M, Reconsult, UserFile, OldF, Line, Opts), _). recorda('$lf_loaded','$lf_loaded'( F, M, Reconsult, UserFile, OldF, Line, Opts), _).
'$set_encoding'(Encoding) :-
'$current_loop_stream'(Stream),
'$set_encoding'(Stream, Encoding).
'$set_encoding'(Stream, Encoding) :-
( Encoding == default -> true ; set_stream(Stream, encoding(Encoding)) ).
/** @pred make is det /** @pred make is det
SWI-Prolog originally included this built-in as a Prolog version of the Unix `make` SWI-Prolog originally included this built-in as a Prolog version of the Unix `make`
@ -1099,14 +1095,6 @@ make.
make_library_index(_Directory). make_library_index(_Directory).
'$file_name'(Stream,F) :-
stream_property(Stream, file_name(F)), !.
'$file_name'(user_input,user_input) :- !.
'$file_name'(user_output,user_ouput) :- !.
'$file_name'(user_error,user_error) :- !.
'$file_name'(_,[]).
'$fetch_stream_alias'(OldStream,Alias) :- '$fetch_stream_alias'(OldStream,Alias) :-
stream_property(OldStream, alias(Alias)), !. stream_property(OldStream, alias(Alias)), !.
@ -1116,22 +1104,6 @@ make_library_index(_Directory).
assert_static(Clause). assert_static(Clause).
'$set_current_loop_stream'(OldStream, Stream) :-
'$current_loop_stream'(OldStream), !,
'$new_loop_stream'(Stream).
'$set_current_loop_stream'(_OldStream, Stream) :-
'$new_loop_stream'(Stream).
'$new_loop_stream'(Stream) :-
(var(Stream) ->
nb_delete('$loop_stream')
;
nb_setval('$loop_stream',Stream)
).
'$current_loop_stream'(Stream) :-
'$nb_getval'('$loop_stream',Stream, fail).
exists_source(File) :- exists_source(File) :-
'$full_filename'(File, _AbsFile, exists_source(File)). '$full_filename'(File, _AbsFile, exists_source(File)).
@ -1664,15 +1636,15 @@ End of conditional compilation.
nb_setval('$assert_all',on). nb_setval('$assert_all',on).
'$comp_mode'(OldCompMode, source) :- '$comp_mode'(OldCompMode, source) :-
'$fetch_comp_status'(OldCompMode), '$fetch_comp_status'(OldCompMode),
'$set_yap_flags'(11,1). set_prolog_flag(source, true).
'$comp_mode'(OldCompMode, compact) :- '$comp_mode'(OldCompMode, compact) :-
'$fetch_comp_status'(OldCompMode), '$fetch_comp_status'(OldCompMode),
'$set_yap_flags'(11,0). set_prolog_flag(source, false).
'$fetch_comp_status'(assert_all) :- '$fetch_comp_status'(assert_all) :-
'$nb_getval'('$assert_all',on, fail), !. '$nb_getval'('$assert_all',on, fail), !.
'$fetch_comp_status'(source) :- '$fetch_comp_status'(source) :-
'$access_yap_flags'(11,1), !. current_prolog_flag(source, true), !.
'$fetch_comp_status'(compact). '$fetch_comp_status'(compact).
consult_depth(LV) :- '$show_consult_level'(LV). consult_depth(LV) :- '$show_consult_level'(LV).

34
pl/debug.yap
View File

@ -148,7 +148,7 @@ mode and the existing spy-points, when the debugger is on.
). ).
'$do_suspy'(S, F, N, T, M) :- '$do_suspy'(S, F, N, T, M) :-
'$system_predicate'(T,M), '$system_predicate'(T,M),
'$flags'(T,M,F,F), '$predicate_flags'(T,M,F,F),
F /\ 0x118dd080 =\= 0, F /\ 0x118dd080 =\= 0,
( S = spy -> ( S = spy ->
'$do_error'(permission_error(access,private_procedure,T),spy(M:F/N)) '$do_error'(permission_error(access,private_procedure,T),spy(M:F/N))
@ -243,16 +243,16 @@ debug :-
'$start_debugging'(Mode) :- '$start_debugging'(Mode) :-
(Mode == on -> (Mode == on ->
'$swi_set_prolog_flag'(debug, true) set_prolog_flag(debug, true)
; ;
'$swi_set_prolog_flag'(debug, false) set_prolog_flag(debug, false)
), ),
nb_setval('$debug_run',off), nb_setval('$debug_run',off),
nb_setval('$debug_jump',false). nb_setval('$debug_jump',false).
nodebug :- nodebug :-
'$init_debugger', '$init_debugger',
'$swi_set_prolog_flag'(debug, false), set_prolog_flag(debug, false),
nb_setval('$trace',off), nb_setval('$trace',off),
print_message(informational,debug(off)). print_message(informational,debug(off)).
@ -402,7 +402,7 @@ debugging :-
'$init_debugger', '$init_debugger',
prolog:debug_action_hook(nospyall), !. prolog:debug_action_hook(nospyall), !.
debugging :- debugging :-
( '$swi_current_prolog_flag'(debug, true) -> ( current_prolog_flag(debug, true) ->
print_message(help,debug(debug)) print_message(help,debug(debug))
; ;
print_message(help,debug(off)) print_message(help,debug(off))
@ -572,7 +572,7 @@ top-level. YAP disactivates debug mode, but spypoints are not removed.
+ `n` - nodebug + `n` - nodebug
stop debugging and continue execution. The command will not clear active stop debugging and continue execution. The command will not clear active
spy-points. §spy-points.
+ `e` - exit + `e` - exit
@ -667,7 +667,7 @@ be lost.
% %
% $spy may be called from user code, so be careful. % $spy may be called from user code, so be careful.
'$spy'([Mod|G]) :- '$spy'([Mod|G]) :-
'$swi_current_prolog_flag'(debug, false), !, current_prolog_flag(debug, false), !,
'$execute_nonstop'(G,Mod). '$execute_nonstop'(G,Mod).
'$spy'([Mod|G]) :- '$spy'([Mod|G]) :-
CP is '$last_choice_pt', CP is '$last_choice_pt',
@ -917,7 +917,7 @@ be lost.
'$spycall_expanded'(G, M, CalledFromDebugger, InRedo). '$spycall_expanded'(G, M, CalledFromDebugger, InRedo).
'$spycall_expanded'(G, M, _CalledFromDebugger, InRedo) :- '$spycall_expanded'(G, M, _CalledFromDebugger, InRedo) :-
'$flags'(G,M,F,F), '$predicate_flags'(G,M,F,F),
F /\ 0x08402000 =\= 0, !, % dynamic procedure, logical semantics, or source F /\ 0x08402000 =\= 0, !, % dynamic procedure, logical semantics, or source
% use the interpreter % use the interpreter
CP is '$last_choice_pt', CP is '$last_choice_pt',
@ -955,7 +955,7 @@ be lost.
). ).
'$tabled_predicate'(G,M) :- '$tabled_predicate'(G,M) :-
'$flags'(G,M,F,F), '$predicate_flags'(G,M,F,F),
F /\ 0x00000040 =\= 0. F /\ 0x00000040 =\= 0.
%'$trace'(P,G,Module,L,Deterministic) :- %'$trace'(P,G,Module,L,Deterministic) :-
@ -964,7 +964,7 @@ be lost.
% at this point we are done with leap or skip % at this point we are done with leap or skip
nb_setval('$debug_run',off), nb_setval('$debug_run',off),
% make sure we run this code outside debugging mode. % make sure we run this code outside debugging mode.
'$swi_set_prolog_flag'(debug, false), set_prolog_flag(debug, false),
repeat, repeat,
'$trace_msg'(P,G,Module,L,Deterministic), '$trace_msg'(P,G,Module,L,Deterministic),
( (
@ -977,13 +977,13 @@ be lost.
), ),
(Debug = on (Debug = on
-> ->
'$swi_set_prolog_flag'(debug, true) set_prolog_flag(debug, true)
; ;
Debug = zip Debug = zip
-> ->
'$swi_set_prolog_flag'(debug, true) set_prolog_flag(debug, true)
; ;
'$swi_set_prolog_flag'(debug, false) set_prolog_flag(debug, false)
), ),
!. !.
@ -1027,10 +1027,10 @@ be lost.
'$action'(0'!,_,_,_,_,_) :- !, % ! 'g execute '$action'(0'!,_,_,_,_,_) :- !, % ! 'g execute
read(debugger_input, G), read(debugger_input, G),
% don't allow yourself to be caught by creep. % don't allow yourself to be caught by creep.
'$swi_current_prolog_flag'(debug, OldDeb), current_prolog_flag(debug, OldDeb),
'$swi_set_prolog_flag'(debug, false), set_prolog_flag(debug, false),
( '$execute'(G) -> true ; true), ( '$execute'(G) -> true ; true),
'$swi_set_prolog_flag'(debug, OldDeb), set_prolog_flag(debug, OldDeb),
% '$skipeol'(0'!), % ' % '$skipeol'(0'!), % '
fail. fail.
'$action'(0'<,_,_,_,_,_) :- !, % <'Depth '$action'(0'<,_,_,_,_,_) :- !, % <'Depth
@ -1109,7 +1109,7 @@ be lost.
nodebug. nodebug.
'$action'(0'r,_,CallId,_,_,_) :- !, % 'r retry '$action'(0'r,_,CallId,_,_,_) :- !, % 'r retry
'$scan_number'(0'r,CallId,ScanNumber), % ' '$scan_number'(0'r,CallId,ScanNumber), % '
'$swi_set_prolog_flag'(debug, true), set_prolog_flag(debug, true),
throw(error('$retry_spy'(ScanNumber),[])). throw(error('$retry_spy'(ScanNumber),[])).
'$action'(0's,P,CallNumber,_,_,on) :- !, % 's skip '$action'(0's,P,CallNumber,_,_,on) :- !, % 's skip
'$skipeol'(0's), % ' '$skipeol'(0's), % '

870
pl/flags.yap
View File

@ -26,623 +26,6 @@
yap_flag/2, yap_flag/2,
yap_flag/3], []). yap_flag/3], []).
/** @defgroup Flags YAP Execution Flags
@ingroup builtins
@{
*/
:- use_system_module( '$_boot', ['$prompt_alternatives_on'/1]).
:- use_system_module( '$_checker', ['$syntax_check_discontiguous'/2,
'$syntax_check_multiple'/2,
'$syntax_check_single_var'/2]).
:- use_system_module( '$_control', ['$set_toplevel_hook'/1]).
:- use_system_module( '$_errors', ['$do_error'/2]).
:- use_system_module( '$_yio', ['$default_expand'/1,
'$set_default_expand'/1]).
yap_flag(V,Out) :-
'$user_defined_flag'(V,_,_,_),
(nonvar(V) ->
!
;
true
),
'$user_flag_value'(V, Out).
yap_flag(V,Out) :-
( var(V) ->
'$swi_current_prolog_flag'(V, Out)
;
'$swi_current_prolog_flag'(V, Current)
->
(var(Out) ->
Current = Out
;
'$swi_set_prolog_flag'(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',[]).
% hide/unhide atoms
yap_flag(hide,Atom) :- !, hide(Atom).
yap_flag(unhide,Atom) :- !, unhide(Atom).
% 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',[]).
% compatibility flag
yap_flag(agc_margin,Margin) :-
'$agc_threshold'(Margin).
%
% 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).
:- set_value('$associate',yap).
yap_flag(associate,X) :-
var(X), !,
get_value('$associate',X).
yap_flag(associate,X) :-
atom(X), !,
set_value('$associate',X).
yap_flag(associate,X) :-
'$do_error'(type_error(atom,X),associate(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)).
% do or do not indexation
yap_flag(index_sub_term_search_depth,X) :-
var(X),
'$access_yap_flags'(23, X), !.
yap_flag(index_sub_term_search_depth,X) :-
integer(X),
X > 0,
'$set_yap_flags'(23,X).
yap_flag(index_sub_term_search_depth,X) :-
\+ integer(X),
'$do_error'(type_error(integer,X),yap_flag(index_sub_term_search_depth,X)).
yap_flag(index_sub_term_search_depth,X) :-
'$do_error'(domain_error(out_of_range,index_sub_term_search_depth+X),yap_flag(index_sub_term_search_depth,X)).
% tabling mode
yap_flag(tabling_mode,Options) :-
var(Options), !,
'$access_yap_flags'(20,Options).
yap_flag(tabling_mode,[]) :- !,
yap_flag(tabling_mode,default).
yap_flag(tabling_mode,[HOption|TOption]) :- !,
yap_flag(tabling_mode,TOption),
yap_flag(tabling_mode,HOption).
yap_flag(tabling_mode,Option) :-
'$transl_to_yap_flag_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)).
yap_flag(informational_messages,X) :- var(X), !,
yap_flag(verbose, 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)).
/* 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(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(discontiguous_warnings,X) :-
var(X), !,
style_check(?(Disc)),
( Disc = +discontiguous,
X = on
;
Disc = -discontiguous,
X = off
), !.
yap_flag(discontiguous_warnings,X) :-
'$transl_to_on_off'(_,X), !,
(X == on ->
style_check(discontiguous)
;
style_check(-discontiguous)
).
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), !,
style_check(?(Disc)),
( Disc = +multiple,
X = on
;
Disc = -multiple,
X = off
), !.
yap_flag(redefine_warnings,X) :-
'$transl_to_on_off'(_,X), !,
(X == on ->
style_check(multiple)
;
style_check(-multiple)
).
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, fail).
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(qcompile,X) :-
var(X), !,
'$nb_getval'('$qcompile', X, X=never).
yap_flag(qcompile,X) :-
(X == never ; X == auto ; X == large ; X == part), !,
nb_setval('$qcompile',X).
yap_flag(qcompile,X) :-
'$do_error'(domain_error(flag_value,qcompile+X),yap_flag(qcompile,X)).
yap_flag(source,X) :-
var(X), !,
source_mode( X, X ).
yap_flag(source,X) :-
(X == off -> true ; X == on), !,
source_mode( _, X ).
yap_flag(source,X) :-
'$do_error'(domain_error(flag_value,source+X),yap_flag(source,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), !,
style_check(?(Disc)),
( Disc = +singletons,
X = on
;
Disc = -singletons,
X = off
), !.
yap_flag(single_var_warnings,X) :-
'$transl_to_on_off'(_,X), !,
(X == on ->
style_check(single_var)
;
style_check(-single_var)
).
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).
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,G) :-
var(G), !,
( recorded('$toplevel_hooks',G,_) -> G ; G = fail ).
yap_flag(toplevel_hook,G) :- !,
'$set_toplevel_hook'(G).
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(arithmetic_exceptions,OUT) :-
var(OUT), !,
'$access_yap_flags'(12,X),
'$transl_to_true_false'(X,OUT).
yap_flag(arithmetic_exceptions,true) :- !,
'$transl_to_true_false'(X,true),
'$set_yap_flags'(12,X).
yap_flag(arithmetic_exceptions,false) :- !,
'$transl_to_true_false'(X,false),
'$set_yap_flags'(12,X).
yap_flag(arithmetic_exceptions,X) :-
'$do_error'(domain_error(flag_value,arithmetic_exceptions+X),yap_flag(arithmetic_exceptions,[true,false])).
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)).
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), !,
stream_property(OUT,alias(user_input)).
yap_flag(user_input,Stream) :-
set_stream(Stream, alias(user_input)).
yap_flag(user_output,OUT) :-
var(OUT), !,
stream_property(OUT,alias(user_output)).
yap_flag(user_output,Stream) :-
set_stream(Stream, alias(user_output)).
yap_flag(user_error,OUT) :-
var(OUT), !,
stream_property(OUT,alias(user_error)).
yap_flag(user_error,Stream) :-
set_stream(Stream, alias(user_error)).
yap_flag(debugger_print_options,OUT) :-
var(OUT),
recorded('$print_options','$debugger'(OUT),_), !.
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) :-
recorda('$print_options','$toplevel'(Opts),_).
:- recorda('$print_options','$toplevel'([quoted(true),numbervars(true),portrayed(true)]),_).
yap_flag(host_type,X) :-
'$host_type'(X).
yap_flag(host_type,X) :-
'$host_type'(X).
yap_flag(argv,X) :-
'$argv'(X).
yap_flag(os_argv,X) :-
'$os_argv'(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)).
% 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).
% should match with code in stdpreds.c
'$transl_to_yap_flag_tabling_mode'(0,default).
'$transl_to_yap_flag_tabling_mode'(1,batched).
'$transl_to_yap_flag_tabling_mode'(2,local).
'$transl_to_yap_flag_tabling_mode'(3,exec_answers).
'$transl_to_yap_flag_tabling_mode'(4,load_answers).
'$transl_to_yap_flag_tabling_mode'(5,local_trie).
'$transl_to_yap_flag_tabling_mode'(6,global_trie).
'$transl_to_yap_flag_tabling_mode'(7,coinductive).
'$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'('$c_yapor_start', prolog).
'$system_options'(rational_trees) :-
'$yap_has_rational_trees'.
'$system_options'(readline) :-
'$swi_current_prolog_flag'(readline, true).
'$system_options'(tabling) :-
\+ '$undefined'('$c_table'(_,_,_), prolog).
'$system_options'(threads) :-
\+ '$undefined'('$thread_join'(_), prolog).
'$system_options'(wam_profiler) :-
\+ '$undefined'(reset_op_counters, prolog).
'$yap_system_flag'(agc_margin).
'$yap_system_flag'(arithmetic_exceptions).
'$yap_system_flag'(argv).
'$yap_system_flag'(chr_toplevel_show_store).
'$yap_system_flag'(debugger_print_options).
'$yap_system_flag'(discontiguous_warnings).
'$yap_system_flag'(dollar_as_lower_case).
% V = fast ;
% '$yap_system_flag'(file_name_variables).
% '$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 ).
% V = hide ;
'$yap_system_flag'(host_type ).
'$yap_system_flag'(index).
'$yap_system_flag'(index_sub_term_search_depth).
'$yap_system_flag'(tabling_mode).
'$yap_system_flag'(informational_messages).
'$yap_system_flag'(language).
'$yap_system_flag'(max_workers).
'$yap_system_flag'(max_threads).
'$yap_system_flag'(n_of_integer_keys_in_db).
'$yap_system_flag'(open_expands_filename).
'$yap_system_flag'(os_argv).
'$yap_system_flag'(profiling).
'$yap_system_flag'(prompt_alternatives_on).
'$yap_system_flag'(redefine_warnings).
'$yap_system_flag'(single_var_warnings).
'$yap_system_flag'(source).
'$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'(toplevel_hook).
'$yap_system_flag'(toplevel_print_options).
'$yap_system_flag'(typein_module).
'$yap_system_flag'(update_semantics).
'$yap_system_flag'(user_error).
'$yap_system_flag'(user_input).
'$yap_system_flag'(user_output).
'$yap_system_flag'(variable_names_may_end_with_quotes).
'$yap_system_flag'(version).
'$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) :- '$adjust_language'(cprolog) :-
% '$switch_log_upd'(0), % '$switch_log_upd'(0),
@ -686,218 +69,20 @@ yap_flag(max_threads,X) :-
unknown(_,error). unknown(_,error).
'$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_rounding_function'(0,toward_zero).
'$transl_to_rounding_function'(1,down).
'$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)), !.
/** @pred current_prolog_flag(? _Flag_,- _Value_) is iso
Obtain the value for a YAP Prolog flag. Equivalent to calling
yap_flag/2 with the second argument unbound, and unifying the
returned second argument with _Value_.
*/
current_prolog_flag(V,Out) :-
var(V), !,
yap_flag(V,NOut),
NOut = Out.
current_prolog_flag(V,Out) :-
atom(V), !,
yap_flag(V,NOut),
NOut = Out.
current_prolog_flag(M:V,Out) :-
current_module(M), atom(V), !,
yap_flag(M:V,NOut),
NOut = Out.
current_prolog_flag(V,Out) :-
'$do_error'(type_error(atom,V),current_prolog_flag(V,Out)).
/** @pred set_prolog_flag(+ _Flag_,+ _Value_) is iso
Set the value for YAP Prolog flag `Flag`. Equivalent to
calling yap_flag/2 with both arguments bound.
*/
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(M:V,Out) :-
current_module(M), atom(V), !,
'$swi_set_prolog_flag'(M:V,Out).
set_prolog_flag(F,V) :-
\+ atom(F), !,
'$do_error'(type_error(atom,F),set_prolog_flag(F,V)).
set_prolog_flag(F, Val) :-
'$swi_current_prolog_flag'(F, _), !,
'$swi_set_prolog_flag'(F, Val).
set_prolog_flag(F,V) :-
'$yap_system_flag'(F), !,
yap_flag(F,V).
set_prolog_flag(F,V) :-
'$swi_current_prolog_flag'(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))
).
/** @pred prolog_flag(? _Flag_,- _OldValue_,+ _NewValue_)
Obtain the value for a YAP Prolog flag and then set it to a new
value. Equivalent to first calling current_prolog_flag/2 with the
second argument _OldValue_ unbound and then calling
set_prolog_flag/2 with the third argument _NewValue_.
*/
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).
/** @pred create_prolog_flag(+ _Flag_,+ _Value_,+ _Options_) /** @pred create_prolog_flag(+ _Flag_,+ _Value_,+ _Options_)
Create a new YAP Prolog flag. _Options_ include
* `type(+_Type_)` with _Type_ one of `boolean`, `integer`, `float`, `atom`
and `term` (that is, any ground term)
Create a new YAP Prolog flag. _Options_ include `type(+Type)` and `access(+Access)` with _Access_ * `access(+_Access_)` with _Access_ one of `read_only` or `read_write`
one of `read_only` or `read_write` and _Type_ one of `boolean`, `integer`, `float`, `atom`
and `term` (that is, no type).
* `keeep(+_Keep_) protect existing flag.
*/ */
create_prolog_flag(Name, Value, Options) :- create_prolog_flag(Name, Value, Options) :-
'$check_flag_name'(Name, create_prolog_flag(Name, Value, Options)), '$flag_domain_from_value'( Value, Type ),
'$check_flag_options'(Options, Domain, RW, create_prolog_flag(Name, Value, Options)), '$create_prolog_flag'(Name, Value, [type(Type)|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,Name),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,O),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_access'(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'(true, boolean) :- !.
'$flag_domain_from_value'(false, boolean) :- !. '$flag_domain_from_value'(false, boolean) :- !.
@ -906,47 +91,6 @@ create_prolog_flag(Name, Value, Options) :-
'$flag_domain_from_value'(Value, atom) :- atom(Value), !. '$flag_domain_from_value'(Value, atom) :- atom(Value), !.
'$flag_domain_from_value'(_, term). '$flag_domain_from_value'(_, term).
/**
@pred source_mode(- _O_,+ _N_)
The state of source mode can either be on or off. When the source mode
is on, all clauses are kept both as compiled code and in a "hidden"
database. _O_ is unified with the previous state and the mode is set
according to _N_.
*/
% 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).
/** @pred source
After executing this goal, YAP keeps information on the source
of the predicates that will be consulted. This enables the use of
[listing/0](@ref listing), `listing/1` and [clause/2](@ref clause) for those
clauses.
The same as `source_mode(_,on)` or as declaring all newly defined
static procedures as `public`.
*/
source :- '$set_yap_flags'(11,1).
/** @pred no_source
The opposite to `source`.
The same as `source_mode(_,off)`.
*/
no_source :- '$set_yap_flags'(11,0).
/** /**
@} @}
*/ */

83
pl/init.yap
View File

@ -22,7 +22,6 @@
@{ @{
*/ */
:- system_module( '$_init', [!/0, :- system_module( '$_init', [!/0,
(:-)/1, (:-)/1,
(?-)/1, (?-)/1,
@ -109,17 +108,20 @@ otherwise.
:- '$handle_throw'(_,_,_), !. :- '$handle_throw'(_,_,_), !.
:- $all_current_modules(M), yap_flag(M:unknown, error) ; true.
:- bootstrap('errors.yap'). :- bootstrap('errors.yap').
:- bootstrap('lists.yap'). :- bootstrap('lists.yap').
:- bootstrap('consult.yap'). :- bootstrap('consult.yap').
:- bootstrap('preddecls.yap'). :- bootstrap('preddecls.yap').
:- bootstrap('preddyns.yap').
:- bootstrap('atoms.yap'). :- bootstrap('atoms.yap').
:- bootstrap('os.yap'). :- bootstrap('os.yap').
:- bootstrap('absf.yap'). :- bootstrap('absf.yap').
:-'$swi_set_prolog_flag'(verbose, normal). :-set_prolog_flag(verbose, normal).
:- [ 'directives.yap', :- [ 'directives.yap',
'utils.yap', 'utils.yap',
@ -185,6 +187,41 @@ version(yap,[6,3]).
:- ['undefined.yap']. :- ['undefined.yap'].
:- multifile user:portray_message/2.
:- dynamic user:portray_message/2.
/** @pred _CurrentModule_:goal_expansion(+ _G_,+ _M_,- _NG_), user:goal_expansion(+ _G_,+ _M_,- _NG_)
YAP now supports goal_expansion/3. This is an user-defined
procedure that is called after term expansion when compiling or
asserting goals for each sub-goal in a clause. The first argument is
bound to the goal and the second to the module under which the goal
_G_ will execute. If goal_expansion/3 succeeds the new
sub-goal _NG_ will replace _G_ and will be processed in the same
way. If goal_expansion/3 fails the system will use the default
rules.
*/
:- multifile user:goal_expansion/3.
:- dynamic user:goal_expansion/3.
:- multifile user:goal_expansion/2.
:- dynamic user:goal_expansion/2.
:- multifile system:goal_expansion/2.
:- dynamic system:goal_expansion/2.
:- multifile goal_expansion/2.
:- dynamic goal_expansion/2.
:- use_module('messages.yap'). :- use_module('messages.yap').
:- use_module('hacks.yap'). :- use_module('hacks.yap').
:- use_module('attributes.yap'). :- use_module('attributes.yap').
@ -197,13 +234,11 @@ version(yap,[6,3]).
:- use_module('../swi/library/menu.pl'). :- use_module('../swi/library/menu.pl').
:- use_module('../library/ypp.yap'). :- use_module('../library/ypp.yap').
yap_hacks:cut_by(CP) :- '$$cut_by'(CP). yap_hacks:cut_by(CP) :- '$$cut_by'(CP).
:- '$change_type_of_char'(36,7). % Make $ a symbol character :- '$change_type_of_char'(36,7). % Make $ a symbol character
:- '$swi_set_prolog_flag'(generate_debug_info,true). :- set_prolog_flag(generate_debug_info,true).
:- recorda('$dialect',yap,_). :- recorda('$dialect',yap,_).
@ -233,36 +268,6 @@ yap_hacks:cut_by(CP) :- '$$cut_by'(CP).
:- module(user). :- module(user).
/** @pred _CurrentModule_:goal_expansion(+ _G_,+ _M_,- _NG_), user:goal_expansion(+ _G_,+ _M_,- _NG_)
YAP now supports goal_expansion/3. This is an user-defined
procedure that is called after term expansion when compiling or
asserting goals for each sub-goal in a clause. The first argument is
bound to the goal and the second to the module under which the goal
_G_ will execute. If goal_expansion/3 succeeds the new
sub-goal _NG_ will replace _G_ and will be processed in the same
way. If goal_expansion/3 fails the system will use the default
rules.
*/
:- multifile goal_expansion/3.
:- dynamic goal_expansion/3.
:- multifile goal_expansion/2.
:- dynamic goal_expansion/2.
:- multifile system:goal_expansion/2.
:- dynamic system:goal_expansion/2.
:- multifile goal_expansion/2.
:- dynamic goal_expansion/2.
/** @pred _CurrentModule_:term_expansion( _T_,- _X_), user:term_expansion( _T_,- _X_) /** @pred _CurrentModule_:term_expansion( _T_,- _X_), user:term_expansion( _T_,- _X_)
@ -312,10 +317,6 @@ modules defining clauses for it too.
:- dynamic user:message_hook/3. :- dynamic user:message_hook/3.
:- multifile user:portray_message/2.
:- dynamic user:portray_message/2.
/** @pred exception(+ _Exception_, + _Context_, - _Action_) /** @pred exception(+ _Exception_, + _Context_, - _Action_)
@ -338,12 +339,10 @@ If this hook predicate succeeds it must instantiate the _Action_ argument to th
:- dynamic user:exception/3. :- dynamic user:exception/3.
:- yap_flag(unknown,error). :- yap_flag(user:unknown,error).
:- stream_property(user_input, tty(true)) -> set_prolog_flag(readline, true) ; true. :- stream_property(user_input, tty(true)) -> set_prolog_flag(readline, true) ; true.
/** /**
@} @}
*/ */

6
pl/listing.yap
View File

@ -117,7 +117,7 @@ listing(Stream, [MV|MVs]) :- !,
). ).
% %
% at this point we are ground and wew know who we want to list. % at this point we are ground and we know who we want to list.
% %
'$listing'(Name, Arity, M, Stream) :- '$listing'(Name, Arity, M, Stream) :-
% skip by default predicates starting with $ % skip by default predicates starting with $
@ -131,7 +131,7 @@ listing(Stream, [MV|MVs]) :- !,
'$do_error'(domain_error(predicate_spec,Name),listing(Name)). '$do_error'(domain_error(predicate_spec,Name),listing(Name)).
'$list_clauses'(Stream, M, Pred) :- '$list_clauses'(Stream, M, Pred) :-
'$flags'(Pred,M,Flags,Flags), '$predicate_flags'(Pred,M,Flags,Flags),
(Flags /\ 0x48602000 =\= 0 (Flags /\ 0x48602000 =\= 0
-> ->
nl(Stream), nl(Stream),
@ -192,7 +192,7 @@ listing(Stream, [MV|MVs]) :- !,
nl( Stream ), nl( Stream ),
fail. fail.
'$list_clauses'(Stream, M, Pred) :- '$list_clauses'(Stream, M, Pred) :-
'$flags'(Pred,M,Flags,Flags), '$predicate_flags'(Pred,M,Flags,Flags),
% has to be dynamic, source, or log update. % has to be dynamic, source, or log update.
Flags /\ 0x08402000 =\= 0, Flags /\ 0x08402000 =\= 0,
'$clause'(Pred, M, Body, _), '$clause'(Pred, M, Body, _),