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

big cleanup: cpmpile under style checker.

Browse Source 
fix broken module stuff.
This commit is contained in:
Vítor Santos Costa 2014-10-07 01:35:41 +01:00
parent 092303f837
commit e9cc545f68
26 changed files with 318 additions and 318 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
pl/absf.yap
View File

@ -377,7 +377,7 @@ absolute_file_name(File0,File) :-
'$system_catch'(win_registry_get_value(HKEY, Library, Dir), prolog,_,fail). '$system_catch'(win_registry_get_value(HKEY, Library, Dir), prolog,_,fail).
% not installed on registry % not installed on registry
'$system_library_directories'(Library, Dir) :- '$system_library_directories'(Library, Dir) :-
'$yap_paths'(_DLLs, ODir1, OBinDir ), '$yap_paths'(_DLLs, ODir1, _OBinDir ),
% '$absolute_file_name'( OBinDir, BinDir ), % '$absolute_file_name'( OBinDir, BinDir ),
% '$swi_current_prolog_flag'(executable, Bin1), % '$swi_current_prolog_flag'(executable, Bin1),
% prolog_to_os_filename( Bin2, Bin1 ), % prolog_to_os_filename( Bin2, Bin1 ),
@ -434,7 +434,7 @@ absolute_file_name(File0,File) :-
'$split_by_sep'(Start, N1, Dirs, Sep, Dir). '$split_by_sep'(Start, N1, Dirs, Sep, Dir).
'$extend_path_directory'(_Name, D, File, _Opts, File, Call) :- '$extend_path_directory'(_Name, _D, File, _Opts, File, _Call) :-
is_absolute_file_name(File), !. is_absolute_file_name(File), !.
'$extend_path_directory'(Name, D, File, Opts, NewFile, Call) :- '$extend_path_directory'(Name, D, File, Opts, NewFile, Call) :-
user:file_search_path(Name, IDirs), user:file_search_path(Name, IDirs),
@ -472,7 +472,7 @@ prolog_file_name(File, PrologFileName) :-
atom(File), !, atom(File), !,
operating_system_support:true_file_name(File, PrologFileName). operating_system_support:true_file_name(File, PrologFileName).
prolog_file_name(File, PrologFileName) :- prolog_file_name(File, PrologFileName) :-
'$do_error'(type_error(atom,T), prolog_file_name(File, PrologFileName)). '$do_error'(type_error(atom,File), prolog_file_name(File, PrologFileName)).
/** /**
@pred path(-Directories:list) is det,deprecated @pred path(-Directories:list) is det,deprecated

88
pl/arith.yap
View File

@ -189,6 +189,31 @@ do_c_built_in(X is Y, _, P) :-
expand_expr(Y, P0, X0), expand_expr(Y, P0, X0),
'$drop_is'(X0, X, P0, P) '$drop_is'(X0, X, P0, P)
). ).
do_c_built_in(phrase(NT,Xs), Mod, NTXsNil) :-
'$_arith':do_c_built_in(phrase(NT,Xs,[]), Mod, NTXsNil).
do_c_built_in(phrase(NT,Xs0,Xs), Mod, NewGoal) :-
'$goal_expansion_allowed'(phrase(NT,Xs0,Xs), Mod),
Goal = phrase(NT,Xs0,Xs),
callable(NT),
catch('$translate_rule'((pseudo_nt --> NT), Rule),
error(Pat,ImplDep),
( \+ '$harmless_dcgexception'(Pat),
throw(error(Pat,ImplDep))
)
),
Rule = (pseudo_nt(Xs0c,Xsc) :- NewGoal0),
Goal \== NewGoal0,
% apply translation only if we are safe
\+ '$contains_illegal_dcgnt'(NT), !,
( var(Xsc), Xsc \== Xs0c
-> Xs = Xsc, NewGoal1 = NewGoal0
; NewGoal1 = (NewGoal0, Xsc = Xs)
),
( var(Xs0c)
-> Xs0 = Xs0c,
NewGoal = NewGoal1
; ( Xs0 = Xs0c, NewGoal1 ) = NewGoal
).
do_c_built_in(Comp0, _, R) :- % now, do it for comparisons do_c_built_in(Comp0, _, R) :- % now, do it for comparisons
'$compop'(Comp0, Op, E, F), '$compop'(Comp0, Op, E, F),
!, !,
@ -197,32 +222,7 @@ do_c_built_in(Comp0, _, R) :- % now, do it for comparisons
expand_expr(F, Q, V), expand_expr(F, Q, V),
'$do_and'(P, Q, R0), '$do_and'(P, Q, R0),
'$do_and'(R0, Comp, R). '$do_and'(R0, Comp, R).
do_c_built_in(phrase(NT,Xs), NTXsNil) :- do_c_built_in(P, _M, P).
'$_arith':do_c_built_in(phrase(NT,Xs,[]), NTXsNil).
do_c_built_in(phrase(NT,Xs0,Xs), Mod, NewGoal) :-
'$goal_expansion_allowed'(phrase(NT,Xs0,Xs), Mod),
Goal = phrase(NT,Xs0,Xs),
callable(NT),
catch('$translate_rule'((pseudo_nt --> NT), Rule),
error(Pat,ImplDep),
( \+ '$harmless_dcgexception'(Pat),
throw(error(Pat,ImplDep))
)),
Rule = (pseudo_nt(Xs0c,Xsc) :- NewGoal0),
Goal \== NewGoal0,
% apply translation only if we are safe
\+ '$contains_illegal_dcgnt'(NT), !,
( var(Xsc), Xsc \== Xs0c
-> Xs = Xsc, NewGoal1 = NewGoal0
; NewGoal1 = (NewGoal0, Xsc = Xs)
),
( var(Xs0c)
-> Xs0 = Xs0c,
NewGoal = NewGoal1
; ( Xs0 = Xs0c, NewGoal1 ) = NewGoal
).
do_c_built_in(P, _, P).
do_c_built_metacall(G1, Mod, '$execute_wo_mod'(G1,Mod)) :- do_c_built_metacall(G1, Mod, '$execute_wo_mod'(G1,Mod)) :-
var(Mod), !. var(Mod), !.
@ -241,11 +241,13 @@ do_c_built_metacall(G1, Mod, call(Mod:G1)).
% V is the result of the simplification, % V is the result of the simplification,
% X the result of the initial expression % X the result of the initial expression
% and the last argument is how we are writing this result % and the last argument is how we are writing this result
'$drop_is'(V, V1, P0, G) :- var(V), !, % usual case '$drop_is'(V, V1, P0, G) :-
V = V1, P0 = G. var(V),
!, % usual case
V = V1,
P0 = G.
'$drop_is'(V, X, P0, P) :- % atoms '$drop_is'(V, X, P0, P) :- % atoms
'$do_and'(P1, X is V, P). '$do_and'(P0, X is V, P).
% Table of arithmetic comparisons % Table of arithmetic comparisons
'$compop'(X < Y, < , X, Y). '$compop'(X < Y, < , X, Y).
@ -394,32 +396,6 @@ expand_expr(Op, X, Y, O, Q, P) :-
'$do_and'(Z = X, Y = W, E). '$do_and'(Z = X, Y = W, E).
do_c_built_in(phrase(NT,Xs), NTXsNil) :-
'$_arith':do_c_built_in(phrase(NT,Xs,[]), NTXsNil).
do_c_built_in(phrase(NT,Xs0,Xs), Mod, NewGoal) :-
'$goal_expansion_allowed'(phrase(NT,Xs0,Xs), Mod),
Goal = phrase(NT,Xs0,Xs),
callable(NT),
catch('$translate_rule'((pseudo_nt --> NT), Rule),
error(Pat,ImplDep),
( \+ '$harmless_dcgexception'(Pat),
throw(error(Pat,ImplDep))
)),
Rule = (pseudo_nt(Xs0c,Xsc) :- NewGoal0),
Goal \== NewGoal0,
% apply translation only if we are safe
\+ '$contains_illegal_dcgnt'(NT), !,
( var(Xsc), Xsc \== Xs0c
-> Xs = Xsc, NewGoal1 = NewGoal0
; NewGoal1 = (NewGoal0, Xsc = Xs)
),
( var(Xs0c)
-> Xs0 = Xs0c,
NewGoal = NewGoal1
; ( Xs0 = Xs0c, NewGoal1 ) = NewGoal
).
'$goal_expansion_allowed'(phrase(_NT,_Xs0,_Xs), _Mod). '$goal_expansion_allowed'(phrase(_NT,_Xs0,_Xs), _Mod).
%% contains_illegal_dcgnt(+Term) is semidet. %% contains_illegal_dcgnt(+Term) is semidet.

16
pl/atoms.yap
View File

@ -45,21 +45,21 @@ atom_concat(Xs,At) :-
% just slice first atom % just slice first atom
'$atom_concat_constraints'([At0|Xs], 0, At, Unbound) :- '$atom_concat_constraints'([At0|Xs], 0, At, Unbound) :-
atom(At0), !, atom(At0), !,
sub_atom(At, 0, Sz, L, At0 ), sub_atom(At, 0, _Sz, L, At0 ),
sub_atom(At, _, L, 0, Atr ), %remainder sub_atom(At, _, L, 0, Atr ), %remainder
'$atom_concat_constraints'(Xs, 0, Atr, Unbound). '$atom_concat_constraints'(Xs, 0, Atr, Unbound).
% first hole: Follow says whether we have two holes in a row, At1 will be our atom % first hole: Follow says whether we have two holes in a row, At1 will be our atom
'$atom_concat_constraints'([At0|Xs], 0, At, [hole(At0, 0, At, Next)|Unbound]) :- '$atom_concat_constraints'([At0|Xs], 0, At, [hole(At0, 0, At, Next)|Unbound]) :-
'$atom_concat_constraints'(Xs, mid(Next,At1), At, Unbound). '$atom_concat_constraints'(Xs, mid(Next,_At1), At, Unbound).
% end of a run % end of a run
'$atom_concat_constraints'([At0|Xs], mid(end, At1), At, Unbound) :- '$atom_concat_constraints'([At0|Xs], mid(end, At1), At, Unbound) :-
atom(At0), !, atom(At0), !,
sub_atom(At, Next, Sz, L, At0), sub_atom(At, Next, _Sz, L, At0),
sub_atom(At, 0, Next, Next, At1), sub_atom(At, 0, Next, Next, At1),
sub_atom(At, _, L, 0, Atr), %remainder sub_atom(At, _, L, 0, Atr), %remainder
'$atom_concat_constraints'(Xs, 0, Atr, Unbound). '$atom_concat_constraints'(Xs, 0, Atr, Unbound).
'$atom_concat_constraints'([At0|Xs], mid(Next,At1), At, Next, [hole(At0, Next, At, Follow)|Unbound]) :- '$atom_concat_constraints'([At0|Xs], mid(Next,At1), At, Next, [hole(At0, Next, At, Follow)|Unbound]) :-
'$atom_concat_constraints'(Xs, mid(NextFollow, At1), At, Unbound). '$atom_concat_constraints'(Xs, mid(Follow, At1), At, Unbound).
'$process_atom_holes'([]). '$process_atom_holes'([]).
'$process_atom_holes'([hole(At0, Next, At1, End)|Unbound]) :- End == end, !, '$process_atom_holes'([hole(At0, Next, At1, End)|Unbound]) :- End == end, !,
@ -190,21 +190,21 @@ string_concat(Xs,At) :-
% just slice first string % just slice first string
'$string_concat_constraints'([At0|Xs], 0, At, Unbound) :- '$string_concat_constraints'([At0|Xs], 0, At, Unbound) :-
string(At0), !, string(At0), !,
sub_string(At, 0, Sz, L, At0 ), sub_string(At, 0, _Sz, L, At0 ),
sub_string(At, _, L, 0, Atr ), %remainder sub_string(At, _, L, 0, Atr ), %remainder
'$string_concat_constraints'(Xs, 0, Atr, Unbound). '$string_concat_constraints'(Xs, 0, Atr, Unbound).
% first hole: Follow says whether we have two holes in a row, At1 will be our string % first hole: Follow says whether we have two holes in a row, At1 will be our string
'$string_concat_constraints'([At0|Xs], 0, At, [hole(At0, 0, At, Next)|Unbound]) :- '$string_concat_constraints'([At0|Xs], 0, At, [hole(At0, 0, At, Next)|Unbound]) :-
'$string_concat_constraints'(Xs, mid(Next,At1), At, Unbound). '$string_concat_constraints'(Xs, mid(Next,_At1), At, Unbound).
% end of a run % end of a run
'$string_concat_constraints'([At0|Xs], mid(end, At1), At, Unbound) :- '$string_concat_constraints'([At0|Xs], mid(end, At1), At, Unbound) :-
string(At0), !, string(At0), !,
sub_string(At, Next, Sz, L, At0), sub_string(At, Next, _Sz, L, At0),
sub_string(At, 0, Next, Next, At1), sub_string(At, 0, Next, Next, At1),
sub_string(At, _, L, 0, Atr), %remainder sub_string(At, _, L, 0, Atr), %remainder
'$string_concat_constraints'(Xs, 0, Atr, Unbound). '$string_concat_constraints'(Xs, 0, Atr, Unbound).
'$string_concat_constraints'([At0|Xs], mid(Next,At1), At, Next, [hole(At0, Next, At, Follow)|Unbound]) :- '$string_concat_constraints'([At0|Xs], mid(Next,At1), At, Next, [hole(At0, Next, At, Follow)|Unbound]) :-
'$string_concat_constraints'(Xs, mid(NextFollow, At1), At, Unbound). '$string_concat_constraints'(Xs, mid(Follow, At1), At, Unbound).
'$process_string_holes'([]). '$process_string_holes'([]).
'$process_string_holes'([hole(At0, Next, At1, End)|Unbound]) :- End == end, !, '$process_string_holes'([hole(At0, Next, At1, End)|Unbound]) :- End == end, !,

4
pl/checker.yap
View File

@ -129,7 +129,7 @@ style_check(V) :-
'$do_error'( type_error('+|-|?(Flag)', V), style_check(V) ). '$do_error'( type_error('+|-|?(Flag)', V), style_check(V) ).
style_check(V) :- style_check(V) :-
\+atom(V), \+ list(V), V \= + _, V \= + _, !, \+atom(V), \+ list(V), V \= + _, V \= + _, !,
'$do_error'( domain_error(style_name(Flag), V), style_check(V) ). '$do_error'( domain_error(style_name, V), style_check(V) ).
style_check_(all) :- style_check_(all) :-
@ -183,7 +183,7 @@ style_check_(+charset) :-
style_check_(-charset) :- style_check_(-charset) :-
'$style_checker'( [ -charset ] ). '$style_checker'( [ -charset ] ).
style_check_('?'(Info) ) :- style_check_('?'(Info) ) :-
lists:member( Style, [ singleton, discontiguous, multiple ] ), L = [ singleton, discontiguous, multiple ],
( lists:member(Style, L ) -> Info = +Style ; Info = -Style ). ( lists:member(Style, L ) -> Info = +Style ; Info = -Style ).
style_check_([]). style_check_([]).
style_check_([H|T]) :- style_check(H), style_check(T). style_check_([H|T]) :- style_check(H), style_check(T).

105
pl/consult.yap
View File

@ -234,13 +234,18 @@ load_files(Files,Opts) :-
'$lf_option'('$context_module', 27, _). '$lf_option'('$context_module', 27, _).
'$lf_option'('$parent_topts', 28, _). '$lf_option'('$parent_topts', 28, _).
'$lf_option'(must_be_module, 29, false). '$lf_option'(must_be_module, 29, false).
'$lf_option'('$source_pos', 30, _).
'$lf_option'(last_opt, 29). '$lf_option'(last_opt, 30).
'$lf_opt'( Op, TOpts, Val) :- '$lf_opt'( Op, TOpts, Val) :-
'$lf_option'(Op, Id, _), '$lf_option'(Op, Id, _),
arg( Id, TOpts, Val ). arg( Id, TOpts, Val ).
'$set_lf_opt'( Op, TOpts, Val) :-
'$lf_option'(Op, Id, _),
setarg( Id, TOpts, Val ).
'$load_files'(Files, Opts, Call) :- '$load_files'(Files, Opts, Call) :-
( '$nb_getval'('$lf_status', OldTOpts, fail), nonvar(OldTOpts) -> ( '$nb_getval'('$lf_status', OldTOpts, fail), nonvar(OldTOpts) ->
'$lf_opt'(silent, OldTOpts, OldVerbosity), '$lf_opt'(silent, OldTOpts, OldVerbosity),
@ -374,8 +379,8 @@ load_files(Files,Opts) :-
( Val == false -> true ; ( Val == false -> true ;
Val == true -> true ; Val == true -> true ;
'$do_error'(domain_error(unimplemented_option,register(Val)),Call) ). '$do_error'(domain_error(unimplemented_option,register(Val)),Call) ).
'$process_lf_opt'('$context_module', Val, Call) :- '$process_lf_opt'('$context_module', Mod, Call) :-
( atom(File) -> true ; '$do_error'(type_error(atom,File),Call) ). ( atom(Mod) -> true ; '$do_error'(type_error(atom,Mod),Call) ).
'$lf_default_opts'(I, LastOpt, _TOpts) :- I > LastOpt, !. '$lf_default_opts'(I, LastOpt, _TOpts) :- I > LastOpt, !.
@ -417,7 +422,7 @@ load_files(Files,Opts) :-
'$lf'(user_input, Mod, _, TOpts) :- !, '$lf'(user_input, Mod, _, TOpts) :- !,
b_setval('$source_file', user_input), b_setval('$source_file', user_input),
'$do_lf'(Mod, user_input, user_input, TOpts). '$do_lf'(Mod, user_input, user_input, TOpts).
'$lf'(File, Mod, Call, TOpts) :- '$lf'(File, Mod, _Call, TOpts) :-
'$lf_opt'(stream, TOpts, Stream), '$lf_opt'(stream, TOpts, Stream),
var( Stream ), var( Stream ),
H0 is heapused, '$cputime'(T0,_), H0 is heapused, '$cputime'(T0,_),
@ -463,6 +468,7 @@ load_files(Files,Opts) :-
'$lf_opt'(imports, TOpts, Imports), '$lf_opt'(imports, TOpts, Imports),
'$start_lf'(If, Mod, Stream, TOpts, File, Reexport, Imports), '$start_lf'(If, Mod, Stream, TOpts, File, Reexport, Imports),
character_count(Stream, Pos), character_count(Stream, Pos),
'$set_lf_opt'('$source_pos', TOpts, Pos),
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).
@ -471,15 +477,15 @@ load_files(Files,Opts) :-
'$file_loaded'(Stream, Mod, Imports, TOpts), !, '$file_loaded'(Stream, Mod, Imports, TOpts), !,
'$lf_opt'('$options', TOpts, Opts), '$lf_opt'('$options', TOpts, Opts),
'$lf_opt'('$location', TOpts, ParentF:Line), '$lf_opt'('$location', TOpts, ParentF:Line),
'$loaded'(Stream, UserFile, Mod, ParentF, Line, not_loaded, _File, _Dir, Opts), '$loaded'(Stream, UserFile, Mod, ParentF, Line, not_loaded, _, _File, _Dir, Opts),
'$reexport'( TOpts, ParentF, Reexport, Imports, _File ). '$reexport'( TOpts, ParentF, Reexport, Imports, _File ).
'$start_lf'(changed, Mod, Stream, TOpts, UserFile, Reexport, Imports) :- '$start_lf'(changed, Mod, Stream, TOpts, UserFile, Reexport, Imports) :-
'$file_unchanged'(Stream, Mod, Imports, TOpts), !, '$file_unchanged'(Stream, Mod, Imports, TOpts), !,
'$lf_opt'('$options', TOpts, Opts), '$lf_opt'('$options', TOpts, Opts),
'$lf_opt'('$location', TOpts, ParentF:Line), '$lf_opt'('$location', TOpts, ParentF:Line),
'$loaded'(Stream, UserFile, Mod, ParentF, Line, changed, _File, _Dir, Opts), '$loaded'(Stream, UserFile, Mod, ParentF, Line, changed, _, _File, _Dir, Opts),
'$reexport'( TOpts, ParentF, Reexport, Imports, _File ). '$reexport'( TOpts, ParentF, Reexport, Imports, _File ).
'$start_lf'(_, Mod, Stream, TOpts, File, Reexport, Imports) :- '$start_lf'(_, Mod, Stream, TOpts, File, _Reexport, _Imports) :-
'$do_lf'(Mod, Stream, File, TOpts). '$do_lf'(Mod, Stream, File, TOpts).
@ -654,7 +660,7 @@ db_files(Fs) :-
'$lf_opt'(consult, TOpts, Reconsult0), '$lf_opt'(consult, TOpts, Reconsult0),
'$lf_opt'('$options', TOpts, Opts), '$lf_opt'('$options', TOpts, Opts),
'$lf_opt'('$location', TOpts, ParentF:Line), '$lf_opt'('$location', TOpts, ParentF:Line),
'$loaded'(Stream, UserFile, SourceModule, ParentF, Line, Reconsult, File, Dir, Opts), '$loaded'(Stream, UserFile, SourceModule, ParentF, Line, Reconsult0, Reconsult, File, 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), '$set_current_loop_stream'(OldStream, Stream),
@ -681,18 +687,19 @@ db_files(Fs) :-
'$skip_unix_header'(Stream) '$skip_unix_header'(Stream)
; ;
true true
), ),
'$loop'(Stream,Reconsult), '$loop'(Stream,Reconsult),
'$lf_opt'(imports, TOpts, Imports), '$lf_opt'(imports, TOpts, Imports),
'$import_to_current_module'(File, ContextModule, Imports, _, TOpts), '$import_to_current_module'(File, ContextModule, Imports, _, TOpts),
'$end_consult',
'$q_do_save_file'(File, UserFile, ContextModule, TOpts ),
H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
'$current_module'(Mod, SourceModule), '$current_module'(Mod, SourceModule),
H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
print_message(Verbosity, loaded(EndMsg, File, Mod, T, H)),
'$end_consult',
'$q_do_save_file'(File, UserFile, TOpts ),
( (
Reconsult = reconsult -> Reconsult = reconsult ->
'$clear_reconsulting' '$clear_reconsulting'
; ;
true true
), ),
'$set_current_loop_stream'(Stream, OldStream), '$set_current_loop_stream'(Stream, OldStream),
@ -712,13 +719,14 @@ db_files(Fs) :-
% format( 'O=~w~n', [Mod=UserFile] ), % format( 'O=~w~n', [Mod=UserFile] ),
!. !.
'$q_do_save_file'(File, UserF, ContextModule, TOpts ) :- '$q_do_save_file'(File, UserF, TOpts ) :-
'$lf_opt'(qcompile, TOpts, QComp), '$lf_opt'(qcompile, TOpts, QComp),
'$lf_opt'('$source_pos', TOpts, Pos),
( QComp == auto ; QComp == large, Pos > 100*1024), ( QComp == auto ; QComp == large, Pos > 100*1024),
'$absolute_file_name'(UserF,[file_type(qly),solutions(first),expand(true)],F,load_files(File)), '$absolute_file_name'(UserF,[file_type(qly),solutions(first),expand(true)],F,load_files(File)),
!, !,
'$qsave_file_'( File, UserF, F ). '$qsave_file_'( File, UserF, F ).
'$q_do_save_file'(_File, _, _ContextModule, _TOpts ). '$q_do_save_file'(_File, _, _TOpts ).
% are we in autoload and autoload_flag is false? % are we in autoload and autoload_flag is false?
'$msg_level'( TOpts, Verbosity) :- '$msg_level'( TOpts, Verbosity) :-
@ -752,7 +760,7 @@ db_files(Fs) :-
'$bind_module'(_, load_files). '$bind_module'(_, load_files).
'$bind_module'(Mod, use_module(Mod)). '$bind_module'(Mod, use_module(Mod)).
'$import_to_current_module'(File, ContextModule, Imports, RemainingImports, TOpts) :- '$import_to_current_module'(File, ContextModule, _Imports, _RemainingImports, _TOpts) :-
\+ recorded('$module','$module'(File, _Module, _, _ModExports, _),_), \+ recorded('$module','$module'(File, _Module, _, _ModExports, _),_),
% enable loading C-predicates from a different file % enable loading C-predicates from a different file
recorded( '$load_foreign_done', [File, M0], _), recorded( '$load_foreign_done', [File, M0], _),
@ -761,7 +769,7 @@ db_files(Fs) :-
'$import_to_current_module'(File, ContextModule, Imports, RemainingImports, TOpts) :- '$import_to_current_module'(File, ContextModule, Imports, RemainingImports, TOpts) :-
recorded('$module','$module'(File, Module, _Source, ModExports, _),_), recorded('$module','$module'(File, Module, _Source, ModExports, _),_),
Module \= ContextModule, !, Module \= ContextModule, !,
% '$lf_opt'('$call', TOpts, Call), '$lf_opt'('$call', TOpts, Goal),
'$convert_for_export'(Imports, ModExports, Module, ContextModule, TranslationTab, RemainingImports, Goal), '$convert_for_export'(Imports, ModExports, Module, ContextModule, TranslationTab, RemainingImports, Goal),
'$add_to_imports'(TranslationTab, Module, ContextModule). '$add_to_imports'(TranslationTab, Module, ContextModule).
'$import_to_current_module'(_, _, _, _, _). '$import_to_current_module'(_, _, _, _, _).
@ -797,7 +805,6 @@ db_files(Fs) :-
'$system_catch'(('$user_call'(G,M) -> true), M, Error, user:'$LoopError'(Error, top)), '$system_catch'(('$user_call'(G,M) -> true), M, Error, user:'$LoopError'(Error, top)),
fail fail
; ;
OldMode = on,
fail fail
). ).
'$exec_initialisation_goals' :- '$exec_initialisation_goals' :-
@ -837,7 +844,7 @@ include(+ _F_) is directive
), ),
'$set_current_loop_stream'(OldStream, Stream), '$set_current_loop_stream'(OldStream, Stream),
H0 is heapused, '$cputime'(T0,_), H0 is heapused, '$cputime'(T0,_),
'$loaded'(Stream, X, Mod, F, L, include, Y, _Dir, []), '$loaded'(Stream, X, Mod, F, L, include, _, Y, _Dir, []),
( '$nb_getval'('$included_file', OY, fail ) -> true ; OY = [] ), ( '$nb_getval'('$included_file', OY, fail ) -> true ; OY = [] ),
'$lf_opt'(encoding, TOpts, Encoding), '$lf_opt'(encoding, TOpts, Encoding),
'$set_encoding'(Stream, Encoding), '$set_encoding'(Stream, Encoding),
@ -987,10 +994,10 @@ prolog_load_context(term_position, Position) :-
% format( 'IL=~w~n', [(F1:Imports->M)] ), % format( 'IL=~w~n', [(F1:Imports->M)] ),
'$import_to_current_module'(F1, M, Imports, _, TOpts). '$import_to_current_module'(F1, M, Imports, _, TOpts).
'$ensure_file_loaded'(F, M, F1) :- '$ensure_file_loaded'(F, _M, F1) :-
recorded('$module','$module'(F1,_NM,_Source,_P,_),_), recorded('$module','$module'(F1,_NM,_Source,_P,_),_),
recorded('$lf_loaded','$lf_loaded'(F1, _, _),_), recorded('$lf_loaded','$lf_loaded'(F1, _, _),_),
same_file(F1,F), !. same_file(F1, F), !.
'$ensure_file_loaded'(F, M, F1) :- '$ensure_file_loaded'(F, M, F1) :-
% loaded from the same module, but does not define a module. % loaded from the same module, but does not define a module.
recorded('$lf_loaded','$lf_loaded'(F1, _, M),_), recorded('$lf_loaded','$lf_loaded'(F1, _, M),_),
@ -1005,7 +1012,8 @@ prolog_load_context(term_position, Position) :-
% format( 'IU=~w~n', [(F1:Imports->M)] ), % format( 'IU=~w~n', [(F1:Imports->M)] ),
'$import_to_current_module'(F1, M, Imports, _, TOpts). '$import_to_current_module'(F1, M, Imports, _, TOpts).
'$ensure_file_unchanged'(F, M, F1) :- % module can be reexported.
'$ensure_file_unchanged'(F, _M, F1) :-
recorded('$module','$module'(F1,_NM,_,_P,_),_), recorded('$module','$module'(F1,_NM,_,_P,_),_),
recorded('$lf_loaded','$lf_loaded'(F1,Age,_),R), recorded('$lf_loaded','$lf_loaded'(F1,Age,_),R),
same_file(F1,F), !, same_file(F1,F), !,
@ -1021,14 +1029,38 @@ prolog_load_context(term_position, Position) :-
% inform the file has been loaded and is now available. % inform the file has been loaded and is now available.
'$loaded'(Stream, UserFile, M, OldF, Line, Reconsult, F, Dir, Opts) :- '$loaded'(Stream, UserFile, M, OldF, Line, Reconsult0, Reconsult, F, Dir, Opts) :-
'$file_name'(Stream, F0), '$file_name'(Stream, F0),
( F0 == user_input, nonvar(UserFile) -> UserFile = F ( F0 == user_input, nonvar(UserFile) -> UserFile = F
; F = F0 ), ; F = F0 ),
( F == user_input -> working_directory(Dir,Dir) ; file_directory_name(F, Dir) ), ( F == user_input -> working_directory(Dir,Dir) ; file_directory_name(F, Dir) ),
nb_setval('$consulting_file', F ), nb_setval('$consulting_file', F ),
( Reconsult \== consult, Reconsult \== not_loaded, Reconsult \== changed, recorded('$lf_loaded','$lf_loaded'(F, _,_),R), erase(R), fail ; var(Reconsult) -> Reconsult = consult ; true ), (
( Reconsult \== consult, recorded('$lf_loaded','$lf_loaded'(F, _, _, _, _, _, _),R), erase(R), fail ; var(Reconsult) -> Reconsult = consult ; true ), Reconsult0 \== consult,
Reconsult0 \== not_loaded,
Reconsult \== changed,
recorded('$lf_loaded','$lf_loaded'(F, _,_),R),
erase(R),
fail
;
var(Reconsult0)
->
Reconsult = consult
;
Reconsult = Reconsult0
),
(
Reconsult \== consult,
recorded('$lf_loaded','$lf_loaded'(F, _, _, _, _, _, _),R),
erase(R),
fail
;
var(Reconsult)
->
Reconsult = consult
;
Reconsult = Reconsult0
),
( F == user_input -> Age = 0 ; time_file64(F, Age) ), ( F == user_input -> Age = 0 ; time_file64(F, Age) ),
( recordaifnot('$lf_loaded','$lf_loaded'( F, Age, M), _) -> true ; true ), ( recordaifnot('$lf_loaded','$lf_loaded'( F, Age, M), _) -> 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), _).
@ -1142,7 +1174,7 @@ unload_file( F0 ) :-
% eliminate multi-files; % eliminate multi-files;
% get rid of file-only predicataes. % get rid of file-only predicataes.
'$unload_file'( FileName, _F0 ) :- '$unload_file'( FileName, _F0 ) :-
'$current_predicate_var'(A,Mod,P). '$current_predicate_var'(_A,Mod,P),
'$owner_file'(P,Mod,FileName), '$owner_file'(P,Mod,FileName),
\+ '$is_multifile'(P,Mod), \+ '$is_multifile'(P,Mod),
functor( P, Na, Ar), functor( P, Na, Ar),
@ -1150,7 +1182,7 @@ unload_file( F0 ) :-
fail. fail.
%next multi-file. %next multi-file.
'$unload_file'( FileName, _F0 ) :- '$unload_file'( FileName, _F0 ) :-
recorded('$lf_loaded','$lf_loaded'( F, Age, _), R), recorded('$lf_loaded','$lf_loaded'( FileName, _Age, _), R),
erase(R), erase(R),
fail. fail.
'$unload_file'( FileName, _F0 ) :- '$unload_file'( FileName, _F0 ) :-
@ -1159,16 +1191,12 @@ unload_file( F0 ) :-
erase(ClauseRef), erase(ClauseRef),
fail. fail.
'$unload_file'( FileName, _F0 ) :- '$unload_file'( FileName, _F0 ) :-
recorded('$multifile_dynamic'(_,_,_), '$mf'(Na,A,M,FFileName,R), R1), recorded('$multifile_dynamic'(_,_,_), '$mf'(_Na,_A,_M,FileName,R), R1),
erase(R1), erase(R1),
erase(R), erase(R),
fail. fail.
'$unload_file'( FileName, _F0 ) :- '$unload_file'( FileName, _F0 ) :-
recorded('$multifile_defs','$defined'(FileName,Name,Arity,Mod), R), recorded('$multifile_defs','$defined'(FileName,_Name,_Arity,_Mod), R),
erase(R),
fail.
'$unload_file'( FileName, _F0 ) :-
recorded('$multifile_defs','$defined'(FileName,Name,Arity,Mod), R),
erase(R), erase(R),
fail. fail.
'$unload_file'( FileName, _F0 ) :- '$unload_file'( FileName, _F0 ) :-
@ -1442,7 +1470,8 @@ initialization(G,OPT) :-
'$do_error'(type_error(OPT),initialization(G,OPT)) '$do_error'(type_error(OPT),initialization(G,OPT))
). ).
'$initialization'(G,now) :- '$initialization'(G,now) :-
( call(G) -> true ; format(user_error,':- ~w:~w failed.~n',[M,G]) ). ( call(G) -> true ;
format(user_error,':- ~w failed.~n',[G]) ).
'$initialization'(G,after_load) :- '$initialization'(G,after_load) :-
'$initialization'(G). '$initialization'(G).
% ignore for now. % ignore for now.

9
pl/control.yap
View File

@ -146,7 +146,7 @@ notrace(G) :-
'$debug_stop'( State ), '$debug_stop'( State ),
'$call'(G1, CP, G, M), '$call'(G1, CP, G, M),
'$$save_by'(CP2), '$$save_by'(CP2),
(CP == CP2 -> ! ; '$debug_state'( NState ), ( true ; '$debug_restart'(NStart), fail ) ), (CP == CP2 -> ! ; '$debug_state'( NState ), ( true ; '$debug_restart'(NState), fail ) ),
'$debug_restart'( State ) '$debug_restart'( State )
; ;
'$debug_restart'( State ), '$debug_restart'( State ),
@ -196,10 +196,8 @@ over _G_.
If you want _G_ to be deterministic you should use if-then-else, as If you want _G_ to be deterministic you should use if-then-else, as
it is both more efficient and more portable. it is both more efficient and more portable.
*/ */
if(X,Y,Z) :- if(X,Y,Z) :-
yap_hacks:env_choice_point(CP0),
( (
CP is '$last_choice_pt', CP is '$last_choice_pt',
'$call'(X,CP,if(X,Y,Z),M), '$call'(X,CP,if(X,Y,Z),M),
@ -372,9 +370,8 @@ setup_call_catcher_cleanup(Setup, Goal, Catcher, Cleanup) :-
'$cleanup_exception'(Exception, _, _) :- '$cleanup_exception'(Exception, _, _) :-
throw(Exception). throw(Exception).
'$safe_call_cleanup'(Goal, Cleanup, Catcher, Exception) :- '$safe_call_cleanup'(Goal, Cleanup, Catcher, _Exception) :-
'$current_choice_point'(MyCP1), '$coroutining':freeze_goal(Catcher, '$clean_call'(_Active, Cleanup)),
'$coroutining':freeze_goal(Catcher, '$clean_call'(Active, Cleanup)),
( (
yap_hacks:trail_suspension_marker(Catcher), yap_hacks:trail_suspension_marker(Catcher),
yap_hacks:enable_interrupts, yap_hacks:enable_interrupts,

14
pl/corout.yap
View File

@ -101,7 +101,7 @@ wake_delay(redo_dif(Done, X, Y)) :-
wake_delay(redo_freeze(Done, V, Goal)) :- wake_delay(redo_freeze(Done, V, Goal)) :-
redo_freeze(Done, V, Goal). redo_freeze(Done, V, Goal).
wake_delay(redo_eq(Done, X, Y, Goal)) :- wake_delay(redo_eq(Done, X, Y, Goal)) :-
redo_eq(Done, X, Y, Goal, G). redo_eq(Done, X, Y, Goal, _G).
wake_delay(redo_ground(Done, X, Goal)) :- wake_delay(redo_ground(Done, X, Goal)) :-
redo_ground(Done, X, Goal). redo_ground(Done, X, Goal).
@ -135,7 +135,7 @@ attribute_goals(Var) -->
{ get_attr(Var, '$coroutining', Delays) }, { get_attr(Var, '$coroutining', Delays) },
attgoal_for_delays(Delays, Var). attgoal_for_delays(Delays, Var).
attgoal_for_delays([], V) --> []. attgoal_for_delays([], _V) --> [].
attgoal_for_delays([G|AllAtts], V) --> attgoal_for_delays([G|AllAtts], V) -->
attgoal_for_delay(G, V), attgoal_for_delay(G, V),
attgoal_for_delays(AllAtts, V). attgoal_for_delays(AllAtts, V).
@ -150,10 +150,10 @@ attgoal_for_delay(redo_freeze(Done, V, Goal), V) -->
attgoal_for_delay(redo_eq(Done, X, Y, Goal), V) --> attgoal_for_delay(redo_eq(Done, X, Y, Goal), V) -->
{ var(Done), first_att(Goal, V) }, !, { var(Done), first_att(Goal, V) }, !,
[ prolog:when(X=Y,Goal) ]. [ prolog:when(X=Y,Goal) ].
attgoal_for_delay(redo_ground(Done, X, Goal), V) --> attgoal_for_delay(redo_ground(Done, X, Goal), _V) -->
{ var(Done) }, !, { var(Done) }, !,
[ prolog:when(ground(X),Goal) ]. [ prolog:when(ground(X),Goal) ].
attgoal_for_delay(_, V) --> []. attgoal_for_delay(_, _V) --> [].
remove_when_declarations(when(Cond,Goal,_), when(Cond,NoWGoal)) :- !, remove_when_declarations(when(Cond,Goal,_), when(Cond,NoWGoal)) :- !,
remove_when_declarations(Goal, NoWGoal). remove_when_declarations(Goal, NoWGoal).
@ -380,7 +380,7 @@ prepare_goal_for_when(G, Mod, Mod:G).
% when/5 and when_suspend succeds when there is need to suspend a goal % when/5 and when_suspend succeds when there is need to suspend a goal
% %
% %
when(V, G, Done, LG0, LGF) :- var(V), !, when(V, G, _Done, LG, LG) :- var(V), !,
'$do_error'(instantiation_error,when(V,G)). '$do_error'(instantiation_error,when(V,G)).
when(nonvar(V), G, Done, LG0, LGF) :- when(nonvar(V), G, Done, LG0, LGF) :-
when_suspend(nonvar(V), G, Done, LG0, LGF). when_suspend(nonvar(V), G, Done, LG0, LGF).
@ -613,8 +613,8 @@ first_att(T, V) :-
term_variables(T, Vs), term_variables(T, Vs),
check_first_attvar(Vs, V). check_first_attvar(Vs, V).
check_first_attvar(V.Vs, V0) :- attvar(V), !, V == V0. check_first_attvar([V|_Vs], V0) :- attvar(V), !, V == V0.
check_first_attvar(_.Vs, V0) :- check_first_attvar([_|Vs], V0) :-
check_first_attvar(Vs, V0). check_first_attvar(Vs, V0).
/** /**

8
pl/dbload.yap
View File

@ -35,7 +35,7 @@ dbload_from_stream(R, M0, Type) :-
fail fail
). ).
close_dbload(R, exo) :- close_dbload(_R, exo) :-
retract(dbloading(Na,Arity,M,T,NaAr,_)), retract(dbloading(Na,Arity,M,T,NaAr,_)),
nb_getval(NaAr,Size), nb_getval(NaAr,Size),
exo_db_get_space(T, M, Size, Handle), exo_db_get_space(T, M, Size, Handle),
@ -44,9 +44,9 @@ close_dbload(R, exo) :-
fail. fail.
close_dbload(R, exo) :- close_dbload(R, exo) :-
seek(R, 0, bof, _), seek(R, 0, bof, _),
exodb_add_facts(R, M), exodb_add_facts(R, _M),
fail. fail.
close_dbload(R, mega) :- close_dbload(_R, mega) :-
retract(dbloading(Na,Arity,M,T,NaAr,_)), retract(dbloading(Na,Arity,M,T,NaAr,_)),
nb_getval(NaAr,Size), nb_getval(NaAr,Size),
dbload_get_space(T, M, Size, Handle), dbload_get_space(T, M, Size, Handle),
@ -55,7 +55,7 @@ close_dbload(R, mega) :-
fail. fail.
close_dbload(R, mega) :- close_dbload(R, mega) :-
seek(R, 0, bof, _), seek(R, 0, bof, _),
dbload_add_facts(R, M), dbload_add_facts(R, _M),
fail. fail.
close_dbload(_, _) :- close_dbload(_, _) :-
retractall(dbloading(_Na,_Arity,_M,_T,_NaAr,_Handle)), retractall(dbloading(_Na,_Arity,_M,_T,_NaAr,_Handle)),

29
pl/debug.yap
View File

@ -117,19 +117,18 @@ mode and the existing spy-points, when the debugger is on.
), ),
!, !,
'$do_suspy_predicates_by_name'(NA,S,EM). '$do_suspy_predicates_by_name'(NA,S,EM).
'$suspy_predicates_by_name'(A,spy,M) :- !, '$suspy_predicates_by_name'(A,spy,M) :- !,
print_message(warning,no_match(spy(M:A))). print_message(warning,no_match(spy(M:A))).
'$suspy_predicates_by_name'(A,nospy,M) :- '$suspy_predicates_by_name'(A,nospy,M) :-
print_message(warning,no_match(nospy(M:A))). print_message(warning,no_match(nospy(M:A))).
'$do_suspy_predicates_by_name'(A,S,M) :- '$do_suspy_predicates_by_name'(A,S,M) :-
current_predicate(A,M:T), current_predicate(A,M:T),
functor(T,A,N), functor(T,A,N),
'$do_suspy'(S, A, N, T, M). '$do_suspy'(S, A, N, T, M).
'$do_suspy_predicates_by_name'(A, S, M) :- '$do_suspy_predicates_by_name'(A, S, M) :-
recorded('$import','$import'(EM,M,T0,_,A,N),_), recorded('$import','$import'(EM,M,_,T,A,N),_),
functor(T0,A0,N0), '$do_suspy'(S, A, N, T, EM).
'$do_suspy'(S, A0, N0, T, EM).
% %
@ -217,7 +216,7 @@ The possible forms for _P_ are the same as in `spy P`.
nospy L :- nospy L :-
'$current_module'(M), '$current_module'(M),
'$suspy'(L, nospy, M), fail. '$suspy'(L, nospy, M), fail.
nospy _. nospy _.
/** @pred nospyall /** @pred nospyall
@ -226,18 +225,18 @@ Removes all existing spy-points.
*/ */
nospyall :- nospyall :-
'$init_debugger', '$init_debugger',
prolog:debug_action_hook(nospyall), !. prolog:debug_action_hook(nospyall), !.
nospyall :- nospyall :-
recorded('$spy','$spy'(T,M),_), functor(T,F,N), '$suspy'(F/N,nospy,M), fail. recorded('$spy','$spy'(T,M),_), functor(T,F,N), '$suspy'(F/N,nospy,M), fail.
nospyall. nospyall.
% debug mode -> debug flag = 1 % debug mode -> debug flag = 1
debug :- debug :-
'$init_debugger', '$init_debugger',
( nb_getval('$spy_gn',L) -> true ; nb_setval('$spy_gn',1) ), ( nb_getval('$spy_gn',_) -> true ; nb_setval('$spy_gn',1) ),
'$start_debugging'(on), '$start_debugging'(on),
print_message(informational,debug(debug)). print_message(informational,debug(debug)).
@ -748,7 +747,7 @@ be lost.
'$loop_fail'(GoalNumber, G, Module, CalledFromDebugger). '$loop_fail'(GoalNumber, G, Module, CalledFromDebugger).
'$loop_spy_event'(error('$fail_spy'(GoalNumber),_), _, _, _, _) :- !, '$loop_spy_event'(error('$fail_spy'(GoalNumber),_), _, _, _, _) :- !,
throw(error('$fail_spy'(GoalNumber),[])). throw(error('$fail_spy'(GoalNumber),[])).
'$loop_spy_event'(error('$done_spy'(G0),_), GoalNumber, G, _, CalledFromDebugger) :- '$loop_spy_event'(error('$done_spy'(G0),_), GoalNumber, _G, _, CalledFromDebugger) :-
G0 >= GoalNumber, !, G0 >= GoalNumber, !,
'$continue_debugging'(zip, CalledFromDebugger). '$continue_debugging'(zip, CalledFromDebugger).
'$loop_spy_event'(error('$done_spy'(GoalNumber),_), _, _, _, _) :- !, '$loop_spy_event'(error('$done_spy'(GoalNumber),_), _, _, _, _) :- !,
@ -891,7 +890,7 @@ be lost.
'$spycall'(G, M, CalledFromDebugger, InRedo) :- '$spycall'(G, M, CalledFromDebugger, InRedo) :-
'$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), '$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

2
pl/errors.yap
View File

@ -339,7 +339,7 @@ print_message(_, Term) :-
flush_output(user_output), flush_output(user_output),
flush_output(user_error), flush_output(user_error),
print_message_lines(Stream, LinePrefix, [nl|LinesF]). print_message_lines(Stream, LinePrefix, [nl|LinesF]).
'$print_system_message'(Error, Level, Lines) :- '$print_system_message'(_Error, Level, Lines) :-
flush_output(user_output), flush_output(user_output),
flush_output(user_error), flush_output(user_error),
'$messages':prefix(Level, LinePrefix, Stream, LinesF, Lines), !, '$messages':prefix(Level, LinePrefix, Stream, LinesF, Lines), !,

115
pl/flags.yap
View File

@ -691,24 +691,18 @@ yap_flag(index,X) :-
'$do_error'(domain_error(flag_value,index+X),yap_flag(index,X)). '$do_error'(domain_error(flag_value,index+X),yap_flag(index,X)).
% do or do not indexation % do or do not indexation
yap_flag(index_sub_term_search_depth,X) :- var(X), yap_flag(index_sub_term_search_depth,X) :-
'$access_yap_flags'(23, X), !. var(X),
yap_flag(index_sub_term_search_depth,X,X) :- '$access_yap_flags'(23, X), !.
integer(X), X > 0, yap_flag(index_sub_term_search_depth,X) :-
'$set_yap_flags'(23,X1). integer(X),
yap_flag(index_sub_term_search_depth,X,X) :- X > 0,
\+ integer(X), '$set_yap_flags'(23,X).
'$do_error'(type_error(integer,X),yap_flag(index_sub_term_search_depth,X)). yap_flag(index_sub_term_search_depth,X) :-
yap_flag(index_sub_term_search_depth,X,X) :- \+ integer(X),
'$do_error'(domain_error(out_of_range,index_sub_term_search_depth+X),yap_flag(index_sub_term_search_depth,X)). '$do_error'(type_error(integer,X),yap_flag(index_sub_term_search_depth,X)).
yap_flag(index_sub_term_search_depth,X) :-
% should match definitions in Yap.h '$do_error'(domain_error(out_of_range,index_sub_term_search_depth+X),yap_flag(index_sub_term_search_depth,X)).
'$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 % tabling mode
yap_flag(tabling_mode,Options) :- yap_flag(tabling_mode,Options) :-
@ -725,16 +719,6 @@ yap_flag(tabling_mode,Option) :-
yap_flag(tabling_mode,Options) :- yap_flag(tabling_mode,Options) :-
'$do_error'(domain_error(flag_value,tabling_mode+Options),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_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).
yap_flag(informational_messages,X) :- var(X), !, yap_flag(informational_messages,X) :- var(X), !,
yap_flag(verbose, X). yap_flag(verbose, X).
@ -933,27 +917,6 @@ yap_flag(single_var_warnings,X) :-
yap_flag(system_options,X) :- yap_flag(system_options,X) :-
'$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'('$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_flag(update_semantics,X) :- yap_flag(update_semantics,X) :-
var(X), !, var(X), !,
@ -1081,6 +1044,46 @@ yap_flag(max_threads,X) :-
yap_flag(max_threads,X) :- yap_flag(max_threads,X) :-
'$do_error'(domain_error(flag_value,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'(agc_margin).
'$yap_system_flag'(chr_toplevel_show_store). '$yap_system_flag'(chr_toplevel_show_store).
'$yap_system_flag'(debugger_print_options). '$yap_system_flag'(debugger_print_options).
@ -1307,7 +1310,7 @@ create_prolog_flag(Name, Value, Options) :-
'$check_flag_name'(Name, _) :- '$check_flag_name'(Name, _) :-
atom(Name), !. atom(Name), !.
'$check_flag_name'(Name, G) :- '$check_flag_name'(Name, G) :-
'$do_error'(type_error(atom),G). '$do_error'(type_error(atom,Name),G).
'$check_flag_options'(O, _, _, G) :- '$check_flag_options'(O, _, _, G) :-
var(O), var(O),
@ -1316,11 +1319,11 @@ create_prolog_flag(Name, Value, Options) :-
'$check_flag_options'([O1|Os], Domain, RW, G) :- !, '$check_flag_options'([O1|Os], Domain, RW, G) :- !,
'$check_flag_optionsl'([O1|Os], Domain, RW, G). '$check_flag_optionsl'([O1|Os], Domain, RW, G).
'$check_flag_options'(O, _, _, G) :- '$check_flag_options'(O, _, _, G) :-
'$do_error'(type_error(list),G). '$do_error'(type_error(list,O),G).
'$check_flag_optionsl'([], _, read_write, G). '$check_flag_optionsl'([], _, read_write, _G).
'$check_flag_optionsl'([V|Os], Domain, RW, G) :- '$check_flag_optionsl'([V|_Os], _Domain, _RW, G) :-
var(V), var(V),
'$do_error'(instantiation_error,G). '$do_error'(instantiation_error,G).
'$check_flag_optionsl'([type(Type)|Os], Domain, RW, G) :- !, '$check_flag_optionsl'([type(Type)|Os], Domain, RW, G) :- !,
@ -1329,7 +1332,7 @@ create_prolog_flag(Name, Value, Options) :-
'$check_flag_optionsl'([access(Access)|Os], Domain, RW, G) :- !, '$check_flag_optionsl'([access(Access)|Os], Domain, RW, G) :- !,
'$check_flag_access'(Access, RW, G), '$check_flag_access'(Access, RW, G),
'$check_flag_optionsl'(Os, Domain, _, G). '$check_flag_optionsl'(Os, Domain, _, G).
'$check_flag_optionsl'(Os, Domain, RW, G) :- '$check_flag_optionsl'(Os, _Domain, _RW, G) :-
'$do_error'(domain_error(create_prolog_flag,Os),G). '$do_error'(domain_error(create_prolog_flag,Os),G).
'$check_flag_type'(V, _, G) :- '$check_flag_type'(V, _, G) :-
@ -1348,7 +1351,7 @@ create_prolog_flag(Name, Value, Options) :-
'$do_error'(instantiation_error,G). '$do_error'(instantiation_error,G).
'$check_flag_access'(read_write, read_write, _) :- !. '$check_flag_access'(read_write, read_write, _) :- !.
'$check_flag_access'(read_only, read_only, _) :- !. '$check_flag_access'(read_only, read_only, _) :- !.
'$check_flag_type'(Atom, _, G) :- '$check_flag_access'(Atom, _, G) :-
'$do_error'(domain_error(create_prolog_flag_option(access),Atom),G). '$do_error'(domain_error(create_prolog_flag_option(access),Atom),G).
'$user_flag_value'(F, Val) :- '$user_flag_value'(F, Val) :-
@ -1376,7 +1379,7 @@ create_prolog_flag(Name, Value, Options) :-
'$check_flag_value'(Value, _, G) :- '$check_flag_value'(Value, _, G) :-
\+ ground(Value), !, \+ ground(Value), !,
'$do_error'(instantiation_error,G). '$do_error'(instantiation_error,G).
'$check_flag_value'(Value, Domain, G) :- '$check_flag_value'(Value, Domain, _G) :-
var(Domain), !, var(Domain), !,
'$flag_domain_from_value'(Value, Domain). '$flag_domain_from_value'(Value, Domain).
'$check_flag_value'(_, term, _) :- !. '$check_flag_value'(_, term, _) :- !.

16
pl/hacks.yap
View File

@ -38,7 +38,7 @@ run_formats([Com-Args|StackInfo], Stream) :-
run_formats(StackInfo, Stream). run_formats(StackInfo, Stream).
display_stack_info(CPs,Envs,Lim,PC) :- display_stack_info(CPs,Envs,Lim,PC) :-
display_stack_info(CPs,Envs,Lim,CP,Lines,[]), display_stack_info(CPs,Envs,Lim,PC,Lines,[]),
flush_output(user_output), flush_output(user_output),
flush_output(user_error), flush_output(user_error),
print_message_lines(user_error, '', Lines). print_message_lines(user_error, '', Lines).
@ -47,7 +47,7 @@ code_location(Info,Where,Location) :-
integer(Where) , !, integer(Where) , !,
'$pred_for_code'(Where,Name,Arity,Mod,Clause), '$pred_for_code'(Where,Name,Arity,Mod,Clause),
construct_code(Clause,Name,Arity,Mod,Info,Location). construct_code(Clause,Name,Arity,Mod,Info,Location).
code_location(Ixnfo,_,Info). code_location(Info,_,Info).
construct_code(-1,Name,Arity,Mod,Where,Location) :- !, construct_code(-1,Name,Arity,Mod,Where,Location) :- !,
number_codes(Arity,ArityCode), number_codes(Arity,ArityCode),
@ -157,7 +157,7 @@ list_of_qmarks(I,[?|L]) :-
list_of_qmarks(I1,L). list_of_qmarks(I1,L).
beautify_hidden_goal('$yes_no'(G,Query), prolog) --> beautify_hidden_goal('$yes_no'(G,_Query), prolog) -->
!, !,
{ Call =.. [(?), G] }, { Call =.. [(?), G] },
[Call]. [Call].
@ -182,7 +182,7 @@ beautify_hidden_goal('$continue_with_command'(Command,V,P,G,Source),prolog) -->
['TopLevel'(Command,G,V,P,Source)]. ['TopLevel'(Command,G,V,P,Source)].
beautify_hidden_goal('$spycall'(G,M,InControl,Redo),prolog) --> beautify_hidden_goal('$spycall'(G,M,InControl,Redo),prolog) -->
['DebuggerCall'(M:G, InControl, Redo)]. ['DebuggerCall'(M:G, InControl, Redo)].
beautify_hidden_goal('$do_spy'(Goal, Mod, CP, InControl),prolog) --> beautify_hidden_goal('$do_spy'(Goal, Mod, _CP, InControl),prolog) -->
['DebuggerCall'(Mod:Goal, InControl)]. ['DebuggerCall'(Mod:Goal, InControl)].
beautify_hidden_goal('$system_catch'(G,Mod,Exc,Handler),prolog) --> beautify_hidden_goal('$system_catch'(G,Mod,Exc,Handler),prolog) -->
[catch(Mod:G, Exc, Handler)]. [catch(Mod:G, Exc, Handler)].
@ -200,7 +200,7 @@ beautify_hidden_goal('$load_files'(_,_,Name),prolog) -->
[Name]. [Name].
beautify_hidden_goal('$reconsult'(Files,Mod),prolog) --> beautify_hidden_goal('$reconsult'(Files,Mod),prolog) -->
[reconsult(Mod:Files)]. [reconsult(Mod:Files)].
beautify_hidden_goal('$undefp'([M|G]),prolog) --> beautify_hidden_goal('$undefp'([Mod|G]),prolog) -->
['CallUndefined'(Mod:G)]. ['CallUndefined'(Mod:G)].
beautify_hidden_goal('$undefp'(?),prolog) --> beautify_hidden_goal('$undefp'(?),prolog) -->
['CallUndefined'(?:?)]. ['CallUndefined'(?:?)].
@ -218,9 +218,9 @@ beautify_hidden_goal('$findall'(T,G,S,A),prolog) -->
[findall(T,G,S,A)]. [findall(T,G,S,A)].
beautify_hidden_goal('$listing'(G,M,_Stream),prolog) --> beautify_hidden_goal('$listing'(G,M,_Stream),prolog) -->
[listing(M:G)]. [listing(M:G)].
beautify_hidden_goal('$call'(G,CP,?,M),prolog) --> beautify_hidden_goal('$call'(G,_CP,?,M),prolog) -->
[call(M:G)]. [call(M:G)].
beautify_hidden_goal('$call'(G,CP,G0,M),prolog) --> beautify_hidden_goal('$call'(_G,_CP,G0,M),prolog) -->
[call(M:G0)]. [call(M:G0)].
beautify_hidden_goal('$current_predicate'(M,Na,Ar),prolog) --> beautify_hidden_goal('$current_predicate'(M,Na,Ar),prolog) -->
[current_predicate(M,Na/Ar)]. [current_predicate(M,Na/Ar)].
@ -228,6 +228,6 @@ beautify_hidden_goal('$current_predicate_for_atom'(Name,M,Ar),prolog) -->
{ functor(P, Name, Ar) }, { functor(P, Name, Ar) },
[current_predicate(Name,M:P)]. [current_predicate(Name,M:P)].
beautify_hidden_goal('$list_clauses'(Stream,M,Pred),prolog) --> beautify_hidden_goal('$list_clauses'(Stream,M,Pred),prolog) -->
[listing(M:Pred)]. [listing(Stream,M:Pred)].

8
pl/listing.yap
View File

@ -64,7 +64,7 @@ listing(MV) :-
listing(Stream, MV) :- listing(Stream, MV) :-
strip_module( MV, M, I), strip_module( MV, M, I),
'$mlisting'(Stream, I, M). '$mlisting'(Stream, I, M).
listing(Stream, []) :- !. listing(_Stream, []) :- !.
listing(Stream, [MV|MVs]) :- !, listing(Stream, [MV|MVs]) :- !,
listing(Stream, MV), listing(Stream, MV),
listing(Stream, MVs). listing(Stream, MVs).
@ -74,9 +74,9 @@ listing(Stream, [MV|MVs]) :- !,
; ;
atom(MV) -> MV/_ = NA, '$do_listing'(Stream, M, NA) atom(MV) -> MV/_ = NA, '$do_listing'(Stream, M, NA)
; ;
MV = N//Ar -> ( integer(Ar) -> Ar2 is Ar+2, NA is N/Ar2 ; '$do_listing'(Stream, Na/Ar2, M), Ar2 >= 2, Ar is Ar2-2 ) MV = N//Ar -> ( integer(Ar) -> Ar2 is Ar+2, NA is N/Ar2 ; '$do_listing'(Stream, NA/Ar2, M), Ar2 >= 2, Ar is Ar2-2 )
; ;
MV = N/Ar, ( atom(N) -> true ; var(N) ), ( integer(Ar) -> true ; var(A) ) -> '$do_listing'(Stream, M, MV) MV = N/Ar, ( atom(N) -> true ; var(N) ), ( integer(Ar) -> true ; var(Ar) ) -> '$do_listing'(Stream, M, MV)
; ;
MV = M1:PP -> '$mlisting'(Stream, PP, M1) MV = M1:PP -> '$mlisting'(Stream, PP, M1)
; ;
@ -160,7 +160,7 @@ listing(Stream, [MV|MVs]) :- !,
format( Stream, ':- ~q:~q.~n', [M,PredDef]) format( Stream, ':- ~q:~q.~n', [M,PredDef])
), ),
fail. fail.
'$list_clauses'(Stream, M, Pred) :- '$list_clauses'(Stream, _M, _Pred) :-
nl( Stream ), nl( Stream ),
fail. fail.
'$list_clauses'(Stream, M, Pred) :- '$list_clauses'(Stream, M, Pred) :-

2
pl/load_foreign.yap
View File

@ -175,7 +175,7 @@ open_shared_object(File, Opts, Handle) :-
prolog_load_context(module, M), prolog_load_context(module, M),
ignore( recordzifnot( '$foreign', M:'$swi_foreign'(File,Opts, Handle), _) ). ignore( recordzifnot( '$foreign', M:'$swi_foreign'(File,Opts, Handle), _) ).
'$open_shared_opts'(Opts, G, OptsI) :- '$open_shared_opts'(Opts, G, _OptsI) :-
var(Opts), !, var(Opts), !,
'$do_error'(instantiation_error,G). '$do_error'(instantiation_error,G).
'$open_shared_opts'([], _, 0) :- !. '$open_shared_opts'([], _, 0) :- !.

25
pl/messages.yap
View File

@ -137,7 +137,7 @@ generate_message(M) -->
stack_dump(error(_,_)) --> stack_dump(error(_,_)) -->
{ fail }, { fail },
{ recorded(sp_info,local_sp(P,CP,Envs,CPs),_) }, { recorded(sp_info,local_sp(_P,CP,Envs,CPs),_) },
{ Envs = [_|_] ; CPs = [_|_] }, !, { Envs = [_|_] ; CPs = [_|_] }, !,
[nl], [nl],
'$hacks':display_stack_info(CPs, Envs, 20, CP). '$hacks':display_stack_info(CPs, Envs, 20, CP).
@ -222,7 +222,7 @@ system_message(myddas_version(Version)) -->
[ 'MYDDAS version ~a' - [Version] ]. [ 'MYDDAS version ~a' - [Version] ].
system_message(yes) --> system_message(yes) -->
[ 'yes' ]. [ 'yes' ].
system_message(error,error(Msg,Info)) --> system_message(error(Msg,Info)) -->
( { var(Msg) } ; { var(Info)} ), !, ( { var(Msg) } ; { var(Info)} ), !,
['bad error ~w' - [error(Msg,Info)]]. ['bad error ~w' - [error(Msg,Info)]].
system_message(error(consistency_error(Who),Where)) --> system_message(error(consistency_error(Who),Where)) -->
@ -233,8 +233,7 @@ system_message(error(domain_error(DomainType,Opt), Where)) -->
[ 'DOMAIN ERROR- ~w: ' - Where], [ 'DOMAIN ERROR- ~w: ' - Where],
domain_error(DomainType, Opt). domain_error(DomainType, Opt).
system_message(error(format_argument_type(Type,Arg), Where)) --> system_message(error(format_argument_type(Type,Arg), Where)) -->
[ 'FORMAT ARGUMENT ERROR- ~~~a called with ~w in ~w: ' - [Type,Arg,Where]], [ 'FORMAT ARGUMENT ERROR- ~~~a called with ~w in ~w: ' - [Type,Arg,Where]].
domain_error(DomainType, Opt).
system_message(error(existence_error(directory,Key), Where)) --> system_message(error(existence_error(directory,Key), Where)) -->
[ 'EXISTENCE ERROR- ~w: ~w not an existing directory' - [Where,Key] ]. [ 'EXISTENCE ERROR- ~w: ~w not an existing directory' - [Where,Key] ].
system_message(error(existence_error(key,Key), Where)) --> system_message(error(existence_error(key,Key), Where)) -->
@ -269,14 +268,14 @@ system_message(error(evaluation_error(zero_divisor), Where)) -->
system_message(error(instantiation_error, Where)) --> system_message(error(instantiation_error, Where)) -->
[ 'INSTANTIATION ERROR- ~w: expected bound value' - [Where] ]. [ 'INSTANTIATION ERROR- ~w: expected bound value' - [Where] ].
system_message(error(not_implemented(Type, What), Where)) --> system_message(error(not_implemented(Type, What), Where)) -->
[ '~w not implemented- ~w' - [Type, What] ]. [ '~w: ~w not implemented- ~w' - [Where, Type, What] ].
system_message(error(operating_system_error, Where)) --> system_message(error(operating_system_error, Where)) -->
[ 'OPERATING SYSTEM ERROR- ~w' - [Where] ]. [ 'OPERATING SYSTEM ERROR- ~w' - [Where] ].
system_message(error(out_of_heap_error, Where)) --> system_message(error(out_of_heap_error, Where)) -->
[ 'OUT OF DATABASE SPACE ERROR- ~w' - [Where] ]. [ 'OUT OF DATABASE SPACE ERROR- ~w' - [Where] ].
system_message(error(out_of_stack_error, Where)) --> system_message(error(out_of_stack_error, Where)) -->
[ 'OUT OF STACK SPACE ERROR- ~w' - [Where] ]. [ 'OUT OF STACK SPACE ERROR- ~w' - [Where] ].
vsystem_message(error(out_of_trail_error, Where)) --> system_message(error(out_of_trail_error, Where)) -->
[ 'OUT OF TRAIL SPACE ERROR- ~w' - [Where] ]. [ 'OUT OF TRAIL SPACE ERROR- ~w' - [Where] ].
system_message(error(out_of_attvars_error, Where)) --> system_message(error(out_of_attvars_error, Where)) -->
[ 'OUT OF STACK SPACE ERROR- ~w' - [Where] ]. [ 'OUT OF STACK SPACE ERROR- ~w' - [Where] ].
@ -385,7 +384,7 @@ system_message(error(unknown, Where)) -->
[ 'EXISTENCE ERROR- procedure ~w undefined' - [Where] ]. [ 'EXISTENCE ERROR- procedure ~w undefined' - [Where] ].
system_message(error(unhandled_exception,Throw)) --> system_message(error(unhandled_exception,Throw)) -->
[ 'UNHANDLED EXCEPTION - message ~w unknown' - [Throw] ]. [ 'UNHANDLED EXCEPTION - message ~w unknown' - [Throw] ].
system_message(error(uninstantiation_error(TE), Where)) --> system_message(error(uninstantiation_error(TE), _Where)) -->
[ 'UNINSTANTIATION ERROR - expected unbound term, got ~q' - [TE] ]. [ 'UNINSTANTIATION ERROR - expected unbound term, got ~q' - [TE] ].
system_message(Messg) --> system_message(Messg) -->
[ '~q' - Messg ]. [ '~q' - Messg ].
@ -431,10 +430,10 @@ domain_error(predicate_spec, Opt) --> !,
[ '~w invalid predicate specifier' - [Opt] ]. [ '~w invalid predicate specifier' - [Opt] ].
domain_error(radix, Opt) --> !, domain_error(radix, Opt) --> !,
[ 'invalid radix ~w' - [Opt] ]. [ 'invalid radix ~w' - [Opt] ].
vdomain_error(read_option, Opt) --> !, domain_error(read_option, Opt) --> !,
[ '~w invalid option to read_term' - [Opt] ]. [ '~w invalid option to read_term' - [Opt] ].
domain_error(semantics_indicatior, Opt) --> !, domain_error(semantics_indicator, Opt) --> !,
[ '~w expected predicate indicator, got ~w' - [Opt] ]. [ 'predicate indicator, got ~w' - [Opt] ].
domain_error(shift_count_overflow, Opt) --> !, domain_error(shift_count_overflow, Opt) --> !,
[ 'shift count overflow in ~w' - [Opt] ]. [ 'shift count overflow in ~w' - [Opt] ].
domain_error(source_sink, Opt) --> !, domain_error(source_sink, Opt) --> !,
@ -576,8 +575,8 @@ the _Prefix_ is printed too.
*/ */
prolog:print_message_lines(S, _, []) :- !. prolog:print_message_lines(_S, _, []) :- !.
prolog:print_message_lines(S, P, [at_same_line|Lines]) :- !, prolog:print_message_lines(_S, P, [at_same_line|Lines]) :- !,
print_message_line(S, Lines, Rest), print_message_line(S, Lines, Rest),
prolog:print_message_lines(S, P, Rest). prolog:print_message_lines(S, P, Rest).
prolog:print_message_lines(S, kind(Kind), Lines) :- !, prolog:print_message_lines(S, kind(Kind), Lines) :- !,
@ -670,7 +669,7 @@ pred_arity((H:-_),Name,Arity) :-
pred_arity((H-->_),Name,Arity) :- !, pred_arity((H-->_),Name,Arity) :- !,
nonvar(H), nonvar(H),
!, !,
functor(HL,Name,1), functor(H,Name,A1),
Arity is A1+2. Arity is A1+2.
pred_arity(H,Name,Arity) :- pred_arity(H,Name,Arity) :-
functor(H,Name,Arity). functor(H,Name,Arity).

57
pl/modules.yap
View File

@ -481,12 +481,12 @@ of predicates.
recorda('$system_initialisation', source_mode(New,Old), _). recorda('$system_initialisation', source_mode(New,Old), _).
'$add_module_on_file'(DonorMod, DonorF, SourceF, Exports) :- '$add_module_on_file'(DonorMod, DonorF, SourceF, Exports) :-
recorded('$module','$module'(DonorF, DonorMod, _, _, _),R), recorded('$module','$module'(OtherF, DonorMod, _, _, _),R),
% the module has been found, are we reconsulting? % the module has been found, are we reconsulting?
( (
DonorF \= OtherF DonorF \= OtherF
-> ->
'$do_error'(permission_error(module,redefined,DonorMod, OtherFile, DonorF),module(Mod,Exports)) '$do_error'(permission_error(module,redefined,DonorMod, OtherF, DonorF),module(DonorMod,Exports))
; ;
recorded('$module','$module'(DonorF,DonorMod, SourceF, _, _), R), recorded('$module','$module'(DonorF,DonorMod, SourceF, _, _), R),
erase( R ), erase( R ),
@ -508,7 +508,7 @@ of predicates.
( recorded('$module','$module'( DonorF, DonorM, _,DonorExports, _),_) -> true ; DonorF = user_input ), ( recorded('$module','$module'( DonorF, DonorM, _,DonorExports, _),_) -> true ; DonorF = user_input ),
( recorded('$module','$module'( HostF, HostM, SourceF, _, _),_) -> true ; HostF = user_input ), ( recorded('$module','$module'( HostF, HostM, SourceF, _, _),_) -> true ; HostF = user_input ),
recorded('$module','$module'(HostF, HostM, _, AllExports, _Line), R), erase(R), recorded('$module','$module'(HostF, HostM, _, AllExports, _Line), R), erase(R),
'$convert_for_export'(Exports, DonorExports, DonorM, HostM, TranslationTab, AllReExports, reexport(DonorF, Exports)), '$convert_for_export'(Exports, DonorExports, DonorM, HostM, _TranslationTab, AllReExports, reexport(DonorF, Exports)),
lists:append( AllReExports, AllExports, Everything0 ), lists:append( AllReExports, AllExports, Everything0 ),
sort( Everything0, Everything ), sort( Everything0, Everything ),
( source_location(_, Line) -> true ; Line = 0 ), ( source_location(_, Line) -> true ; Line = 0 ),
@ -576,10 +576,10 @@ source_module(Mod) :-
% %
'$module_expansion'(H, H, H, _HM, _BM, _SM) :- var(H), !. '$module_expansion'(H, H, H, _HM, _BM, _SM) :- var(H), !.
'$module_expansion'((H:-B), (H:-B1), (H:-BOO), HM, BM, SM) :- !, '$module_expansion'((H:-B), (H:-B1), (H:-BOO), HM, BM, SM) :- !,
'$is_mt'(HM, H, SM, B, IB, MM), '$is_mt'(HM, H, SM, B, IB),
'$module_u_vars'(H,UVars,HM), % collect head variables in '$module_u_vars'(H,UVars,HM), % collect head variables in
% expanded positions % expanded positions
'$expand_modules'(IB, B1, BO, HM, BM, MM, UVars), '$expand_modules'(IB, B1, BO, HM, BM, SM, UVars),
('$full_clause_optimisation'(H, SM, BO, BOO) -> ('$full_clause_optimisation'(H, SM, BO, BOO) ->
true true
; ;
@ -633,7 +633,7 @@ source_module(Mod) :-
% d:b(X) :- a:c(a:X), a:d(X), e(X). % d:b(X) :- a:c(a:X), a:d(X), e(X).
% %
% %
% head variables. % head variab'$expand_modules'(M:G,G1,GO,HM,_M,_SM,HVars)les.
% goals or arguments/sub-arguments? % goals or arguments/sub-arguments?
% I cannot use call here because of format/3 % I cannot use call here because of format/3
% modules: % modules:
@ -642,6 +642,7 @@ source_module(Mod) :-
% A6: head module (this is the one used in compiling and accessing). % A6: head module (this is the one used in compiling and accessing).
% %
% %
%'$expand_modules'(V,NG,NG,_,_,SM,HVars):- writeln(V), fail.
'$expand_modules'(V,NG,NG,_,_,SM,HVars) :- '$expand_modules'(V,NG,NG,_,_,SM,HVars) :-
var(V), !, var(V), !,
( '$not_in_vars'(V,HVars) ( '$not_in_vars'(V,HVars)
@ -707,7 +708,7 @@ expand_goal(G, G).
'$do_expand'(M:G, HM, _BM, _SM, HVars, M:GI) :- !, '$do_expand'(M:G, HM, _BM, _SM, HVars, M:GI) :- !,
nonvar(M), nonvar(M),
'$do_expand'(G, HM, M, M, HVars, GI). '$do_expand'(G, HM, M, M, HVars, GI).
'$do_expand'(G, HM, BM, SM, _HVars, GI) :- '$do_expand'(G, _HM, _BM, SM, _HVars, GI) :-
( (
'$pred_exists'(goal_expansion(G,GI), SM), '$pred_exists'(goal_expansion(G,GI), SM),
call(SM:goal_expansion(G, GI)) call(SM:goal_expansion(G, GI))
@ -757,13 +758,13 @@ expand_goal(G, G).
GI \== G, !, GI \== G, !,
'$expand_modules'(GI, G1, GO, HM, BM, SM, HVars). '$expand_modules'(GI, G1, GO, HM, BM, SM, HVars).
'$complete_goal_expansion'(G, HM, BM, SM, G1, G2, _HVars) :- '$complete_goal_expansion'(G, HM, BM, SM, G1, G2, _HVars) :-
'$all_system_predicate'(G, M, ORIG), !, '$all_system_predicate'(G, BM, BM0), !,
% make built-in processing transparent. % make built-in processing transparent.
'$match_mod'(G, M, ORIG, HM, G1), '$match_mod'(G, HM, BM0, SM, G1),
'$c_built_in'(G1, M, Gi), '$c_built_in'(G1, BM0, Gi),
Gi = G2. Gi = G2.
'$complete_goal_expansion'(G, HM, BM, SM, NG, NG, _) :- '$complete_goal_expansion'(G, HM, BM, SM, NG, NG, _) :-
'$match_mod'(G, BM, BM, HM, NG). '$match_mod'(G, HM, BM, SM, NG).
%'$match_mod'(G, GMod, GMod, NG) :- !, %'$match_mod'(G, GMod, GMod, NG) :- !,
% NG = G. % NG = G.
@ -771,12 +772,12 @@ expand_goal(G, G).
nonvar(G), nonvar(G),
'$system_predicate'(G,prolog), '$system_predicate'(G,prolog),
% \+ '$is_metapredicate'(G, prolog), % \+ '$is_metapredicate'(G, prolog),
\+ '$is_multifile'(G,H), \+ '$is_multifile'(G,M),
!. % prolog: needs no module info. !. % prolog: needs no module info.
% same module as head, and body goal (I cannot get rid of qualifier before % same module as head, and body goal (I cannot get rid of qualifier before
% meta-call. % meta-call.
'$match_mod'(G, HMod, _, HM, G) :- HMod == HM, !. '$match_mod'(G, HMod, BM, _HM, G) :- HMod == BM, !.
'$match_mod'(G, GMod, _, _, GMod:G). '$match_mod'(G, _, GMod, _, GMod:G).
% be careful here not to generate an undefined exception. % be careful here not to generate an undefined exception.
@ -951,7 +952,7 @@ meta_predicate declaration
arg(I,NG,NA), arg(I,NG,NA),
I1 is I-1, I1 is I-1,
'$meta_expansion_loop'(I1, D, G, NG, HVars, HM, BM, SM). '$meta_expansion_loop'(I1, D, G, NG, HVars, HM, BM, SM).
'$meta_expansion_loop'(I, D, G, NG, HVars, HM, BM, SM) :- '$meta_expansion_loop'(I, D, G, NG, HVars, HM, BM, SM) :-
arg(I,G,A), arg(I,G,A),
arg(I,NG,A), arg(I,NG,A),
I1 is I-1, I1 is I-1,
@ -961,11 +962,11 @@ meta_predicate declaration
var(G), !. var(G), !.
'$meta_expansion0'(M:G, _HM, _BM, SM, G1, _HVars) :- '$meta_expansion0'(M:G, _HM, _BM, SM, G1, _HVars) :-
var(M), !, var(M), !,
G1 = '$execute_wo_mod'(G,SM). G1 = '$execute_wo_mod'(G,M).
% support for all/3 % support for all/3
'$meta_expansion0'(same(G, P), HM, BM, SM, same(G1, P),HVars) :- !, '$meta_expansion0'(same(G, P), HM, BM, SM, same(G1, P),HVars) :- !,
'$meta_expansion0'(G, _HM, BM, SM, G1,HVars). '$meta_expansion0'(G, HM, BM, SM, G1,HVars).
'$meta_expansion0'(G, HM, BM, SM, M1:G1,HVars) :- '$meta_expansion0'(G, _HM, _BM, SM, M1:G1,_HVars) :-
strip_module(SM:G,M1,G1). strip_module(SM:G,M1,G1).
@ -1003,9 +1004,9 @@ its parent goal.
NFlags is Fl \/ 0x200004, NFlags is Fl \/ 0x200004,
'$flags'(P, M, Fl, NFlags). '$flags'(P, M, Fl, NFlags).
'$is_mt'(M, H, CM, B, (context_module(CM),B), CM) :- '$is_mt'(M, H, CM, B, (context_module(CM),B)) :-
'$module_transparent'(_, M, _, H), !. '$module_transparent'(_, M, _, H), !.
'$is_mt'(_M, _H, CM, B, B, CM). '$is_mt'(_M, _H, CM, B, B).
% comma has its own problems. % comma has its own problems.
:- '$install_meta_predicate'(','(0,0), prolog). :- '$install_meta_predicate'(','(0,0), prolog).
@ -1226,7 +1227,7 @@ export_list(Module, List) :-
'$simple_conversion'(Exports, Tab, E). '$simple_conversion'(Exports, Tab, E).
'$simple_conversion'([F/N as NF|Exports], [F/N-NF/N|Tab], [NF/N|E]) :- '$simple_conversion'([F/N as NF|Exports], [F/N-NF/N|Tab], [NF/N|E]) :-
'$simple_conversion'(Exports, Tab, E). '$simple_conversion'(Exports, Tab, E).
'$simple_conversion'([F//N as BF|Exports], [F/N2-NF/N2|Tab], [NF/N2|E]) :- '$simple_conversion'([F//N as NF|Exports], [F/N2-NF/N2|Tab], [NF/N2|E]) :-
N2 is N+1, N2 is N+1,
'$simple_conversion'(Exports, Tab, E). '$simple_conversion'(Exports, Tab, E).
'$simple_conversion'([op(Prio,Assoc,Name)|Exports], [op(Prio,Assoc,Name)|Tab], [op(Prio,Assoc,Name)|E]) :- '$simple_conversion'([op(Prio,Assoc,Name)|Exports], [op(Prio,Assoc,Name)|Tab], [op(Prio,Assoc,Name)|E]) :-
@ -1238,7 +1239,7 @@ export_list(Module, List) :-
-> ->
true true
; ;
'$bad_export'((N1/A1 as A2), Module, ContextModule) '$bad_export'((N1/A1 as N2), Module, ContextModule)
), ),
'$clean_conversion'(Ps, List, Module, ContextModule, Tab, MyExports, Goal). '$clean_conversion'(Ps, List, Module, ContextModule, Tab, MyExports, Goal).
'$clean_conversion'([N1/A1|Ps], List, Module, ContextModule, [N1/A1-N1/A1|Tab], [N1/A1|MyExports], Goal) :- !, '$clean_conversion'([N1/A1|Ps], List, Module, ContextModule, [N1/A1-N1/A1|Tab], [N1/A1|MyExports], Goal) :- !,
@ -1344,7 +1345,7 @@ export_list(Module, List) :-
'$do_import'( N/K-N1/K, Mod, ContextMod) :- '$do_import'( N/K-N1/K, Mod, ContextMod) :-
functor(G,N,K), functor(G,N,K),
'$follow_import_chain'(Mod,G,M0,G0), '$follow_import_chain'(Mod,G,M0,G0),
G0=..[N0|Args], G0=..[ N|Args],
G1=..[N1|Args], G1=..[N1|Args],
( '$check_import'(M0,ContextMod,N1,K) -> ( '$check_import'(M0,ContextMod,N1,K) ->
( ContextMod = user -> ( ContextMod = user ->
@ -1371,7 +1372,7 @@ export_list(Module, List) :-
M2 \= M1, !, M2 \= M1, !,
b_getval('$lf_status', TOpts), b_getval('$lf_status', TOpts),
'$lf_opt'(redefine_module, TOpts, Action), '$lf_opt'(redefine_module, TOpts, Action),
'$redefine_action'(Action, M1, M2, M, ContextM, N/K). '$redefine_action'(Action, M1, M2, Mod, ContextM, N/K).
'$check_import'(_,_,_,_). '$check_import'(_,_,_,_).
'$redefine_action'(ask, M1, M2, M, _, N/K) :- '$redefine_action'(ask, M1, M2, M, _, N/K) :-
@ -1384,7 +1385,7 @@ export_list(Module, List) :-
'$redefine_action'(true, M1, _, _, _, _) :- !, '$redefine_action'(true, M1, _, _, _, _) :- !,
recorded('$module','$module'(F, M1, _, _MyExports,_Line),_), recorded('$module','$module'(F, M1, _, _MyExports,_Line),_),
unload_file(F). unload_file(F).
'$redefine_action'(false, M1, M2, M, ContextM, N/K) :- '$redefine_action'(false, M1, M2, _M, ContextM, N/K) :-
recorded('$module','$module'(F, ContextM, _, _MyExports,_Line),_), recorded('$module','$module'(F, ContextM, _, _MyExports,_Line),_),
'$current_module'(_, M2), '$current_module'(_, M2),
'$do_error'(permission_error(import,M1:N/K,redefined,M2),F). '$do_error'(permission_error(import,M1:N/K,redefined,M2),F).
@ -1556,15 +1557,15 @@ unload_module(Mod) :-
% remove imported modules % remove imported modules
unload_module(Mod) :- unload_module(Mod) :-
setof( M, recorded('$import',_G0^_G^_N^_K^_R^'$import'(Mod,M,_G0,_G,_N,_K),_R), Ms), setof( M, recorded('$import',_G0^_G^_N^_K^_R^'$import'(Mod,M,_G0,_G,_N,_K),_R), Ms),
recorded('$module','$module'( _, Mod, _, _, Exports), R), recorded('$module','$module'( _, Mod, _, _, Exports), _),
lists:member(M, Ms), lists:member(M, Ms),
current_op(X, Y, M:Op), current_op(X, Y, M:Op),
lists:member( op(X, Y, Op), Exports ), lists:member( op(X, Y, Op), Exports ),
op(X, 0, M:Op), op(X, 0, M:Op),
fail. fail.
unload_module(Mod) :- unload_module(Mod) :-
recorded('$module','$module'( _, Mod, _, _, Exports), R), recorded('$module','$module'( _, Mod, _, _, Exports), _),
lists:member( op(X, Y, Op), Exports ), lists:member( op(X, _Y, Op), Exports ),
op(X, 0, Mod:Op), op(X, 0, Mod:Op),
fail. fail.
unload_module(Mod) :- unload_module(Mod) :-

2
pl/preddecls.yap
View File

@ -179,7 +179,7 @@ Since YAP4.3.0 multifile procedures can be static or dynamic.
**/ **/
multifile(P) :- multifile(P) :-
'$current_module'(OM), '$current_module'(OM),
'$multifile'(P, M). '$multifile'(P, OM).
'$multifile'(V, _) :- var(V), !, '$multifile'(V, _) :- var(V), !,
'$do_error'(instantiation_error,multifile(V)). '$do_error'(instantiation_error,multifile(V)).

16
pl/preds.yap
View File

@ -228,7 +228,7 @@ assert(C) :-
'$do_error'(instantiation_error,assert(Mod:V)). '$do_error'(instantiation_error,assert(Mod:V)).
'$assert_dynamic'(M:C,_,Where,R,P) :- !, '$assert_dynamic'(M:C,_,Where,R,P) :- !,
'$assert_dynamic'(C,M,Where,R,P). '$assert_dynamic'(C,M,Where,R,P).
'$assert_dynamic'((H:-G),M1,Where,R,P) :- '$assert_dynamic'((H:-_G),_M1,_Where,_R,P) :-
var(H), !, '$do_error'(instantiation_error,P). var(H), !, '$do_error'(instantiation_error,P).
'$assert_dynamic'(CI,Mod,Where,R,P) :- '$assert_dynamic'(CI,Mod,Where,R,P) :-
'$expand_clause'(CI,C0,C,Mod,HM), '$expand_clause'(CI,C0,C,Mod,HM),
@ -305,7 +305,7 @@ assertz_static(C) :-
'$do_error'(instantiation_error,assert(M:V)). '$do_error'(instantiation_error,assert(M:V)).
'$assert_static'(M:C,_,Where,R,P) :- !, '$assert_static'(M:C,_,Where,R,P) :- !,
'$assert_static'(C,M,Where,R,P). '$assert_static'(C,M,Where,R,P).
'$assert_static'((H:-G),M1,Where,R,P) :- '$assert_static'((H:-_G),_M1,_Where,_R,P) :-
var(H), !, '$do_error'(instantiation_error,P). var(H), !, '$do_error'(instantiation_error,P).
'$assert_static'(CI,Mod,Where,R,P) :- '$assert_static'(CI,Mod,Where,R,P) :-
'$expand_clause'(CI,C0,C,Mod, HM), '$expand_clause'(CI,C0,C,Mod, HM),
@ -599,7 +599,7 @@ retract(C) :-
% '$is_dynamic'(H,M), !, % '$is_dynamic'(H,M), !,
F /\ 0x00002000 =:= 0x00002000, !, F /\ 0x00002000 =:= 0x00002000, !,
'$recordedp'(M:H,(H:-B),R), '$recordedp'(M:H,(H:-B),R),
( F /\ 0x20000000 =:= 0x20000000, recorded('$mf','$mf_clause'(_,_,_,_,MRef),MR), erase(MR), fail ; true), ( F /\ 0x20000000 =:= 0x20000000, recorded('$mf','$mf_clause'(_,_,_,_,MRef),MR), erase(MR), erase(MRef), fail ; true),
erase(R). erase(R).
'$retract2'(_, H,M,_,_) :- '$retract2'(_, H,M,_,_) :-
'$undefined'(H,M), !, '$undefined'(H,M), !,
@ -748,7 +748,7 @@ dynamic procedures. Under other modes it will abolish any procedures.
abolish(V) :- var(V), !, abolish(V) :- var(V), !,
'$do_error'(instantiation_error,abolish(V)). '$do_error'(instantiation_error,abolish(V)).
abolish(Mod:V) :- var(V), !, abolish(Mod:V) :- var(V), !,
'$do_error'(instantiation_error,abolish(M:V)). '$do_error'(instantiation_error,abolish(Mod:V)).
abolish(M:X) :- !, abolish(M:X) :- !,
'$abolish'(X,M). '$abolish'(X,M).
abolish(X) :- abolish(X) :-
@ -935,7 +935,7 @@ dynamic_predicate(P,Sem) :-
'$expand_clause'((H:-B),C1,C2,Mod,HM) :- !, '$expand_clause'((H:-B),C1,C2,Mod,HM) :- !,
strip_module(Mod:H, HM, H1), strip_module(Mod:H, HM, H1),
'$current_module'(M), '$current_module'(M),
'$module_expansion'((H1:-B), C1, C2, HM, BM, M), '$module_expansion'((H1:-B), C1, C2, HM, M, M),
( get_value('$strict_iso',on) -> ( get_value('$strict_iso',on) ->
'$check_iso_strict_clause'(C1) '$check_iso_strict_clause'(C1)
; ;
@ -1319,11 +1319,11 @@ compile_predicates(Ps) :-
'$compile_predicates'(M:Ps, _, Call) :- '$compile_predicates'(M:Ps, _, Call) :-
'$compile_predicates'(Ps, M, Call). '$compile_predicates'(Ps, M, Call).
'$compile_predicates'([], _, _). '$compile_predicates'([], _, _).
'$compile_predicates'(P.Ps, M, Call) :- '$compile_predicates'([P|Ps], M, Call) :-
'$compile_predicate'(P, M, Call). '$compile_predicate'(P, M, Call),
'$compile_predicates'(Ps, M, Call). '$compile_predicates'(Ps, M, Call).
'$compile_predicate'(P, M, Call) :- '$compile_predicate'(P, _M, Call) :-
var(P), !, var(P), !,
'$do_error'(instantiation_error,Call). '$do_error'(instantiation_error,Call).
'$compile_predicate'(M:P, _, Call) :- '$compile_predicate'(M:P, _, Call) :-

2
pl/profile.yap
View File

@ -220,7 +220,7 @@ showprofres(A) :-
'$display_preds'(_, _, _, N, N) :- !. '$display_preds'(_, _, _, N, N) :- !.
'$display_preds'([], _, _, _, _). '$display_preds'([], _, _, _, _).
'$display_preds'([0-_|_], _Tot, _SoFar, _I, N) :- !. '$display_preds'([0-_|_], _Tot, _SoFar, _I, _N) :- !.
'$display_preds'([NSum-P|Ps], Tot, SoFar, I, N) :- '$display_preds'([NSum-P|Ps], Tot, SoFar, I, N) :-
Sum is -NSum, Sum is -NSum,
Perc is (100*Sum)/Tot, Perc is (100*Sum)/Tot,

50
pl/qly.yap
View File

@ -113,7 +113,7 @@ Saves an image of the current state of the YAP database in file
_F_, and guarantee that execution of the restored code will start by _F_, and guarantee that execution of the restored code will start by
trying goal _G_. trying goal _G_.
**/ **/
save_program(File, Goal) :- save_program(_File, Goal) :-
recorda('$restore_goal', Goal ,_R), recorda('$restore_goal', Goal ,_R),
fail. fail.
save_program(File, _Goal) :- save_program(File, _Goal) :-
@ -210,8 +210,8 @@ save_program(File, _Goal) :-
'$do_error'(domain_error(qsave_program,Opt), G). '$do_error'(domain_error(qsave_program,Opt), G).
% there is some ordering between flags. % there is some ordering between flags.
'$x_yap_flag'(goal, Goal). '$x_yap_flag'(goal, _Goal).
'$x_yap_flag'(language, V). '$x_yap_flag'(language, _V).
'$x_yap_flag'(M:unknown, V) :- '$x_yap_flag'(M:unknown, V) :-
current_module(M), current_module(M),
yap_flag(M:unknown, V). yap_flag(M:unknown, V).
@ -275,7 +275,7 @@ save_program(File, _Goal) :-
load_files(library(win_menu), [silent(true)]), load_files(library(win_menu), [silent(true)]),
fail. fail.
'$init_from_saved_state_and_args' :- '$init_from_saved_state_and_args' :-
recorded('$reload_foreign_libraries',G,R), recorded('$reload_foreign_libraries',_G,R),
erase(R), erase(R),
shlib:reload_foreign_libraries, shlib:reload_foreign_libraries,
fail. fail.
@ -406,10 +406,11 @@ qsave_file(F0, State) :-
'$qsave_file_'(File, UserF, _State) :- '$qsave_file_'(File, UserF, _State) :-
( File == user_input -> Age = 0 ; time_file64(File, Age) ), ( File == user_input -> Age = 0 ; time_file64(File, Age) ),
'$current_module'(M),
assert(user:'$file_property'( '$lf_loaded'( UserF, Age, M) ) ), assert(user:'$file_property'( '$lf_loaded'( UserF, Age, M) ) ),
'$set_owner_file'( '$file_property'( _ ), user, File ), '$set_owner_file'( '$file_property'( _ ), user, File ),
fail. fail.
'$qsave_file_'(File, UserF, State) :- '$qsave_file_'(File, UserF, _State) :-
recorded('$lf_loaded','$lf_loaded'( File, M, Reconsult, UserFile, OldF, Line, Opts), _), recorded('$lf_loaded','$lf_loaded'( File, M, Reconsult, UserFile, OldF, Line, Opts), _),
assert(user:'$file_property'( '$lf_loaded'( UserF, M, Reconsult, UserFile, OldF, Line, Opts) ) ), assert(user:'$file_property'( '$lf_loaded'( UserF, M, Reconsult, UserFile, OldF, Line, Opts) ) ),
'$set_owner_file'( '$file_property'( _ ), user, File ), '$set_owner_file'( '$file_property'( _ ), user, File ),
@ -440,7 +441,7 @@ qsave_file(F0, State) :-
setof(Info, '$fetch_multi_file_module'(File, Info), Multi_Files). setof(Info, '$fetch_multi_file_module'(File, Info), Multi_Files).
'$fetch_multi_file_file'(FileName, (M:G :- Body)) :- '$fetch_multi_file_file'(FileName, (M:G :- Body)) :-
recorded('$multifile_defs','$defined'(FileName,Name,Arity,Mod), _), recorded('$multifile_defs','$defined'(FileName,Name,Arity,M), _),
functor(G, Name, Arity ), functor(G, Name, Arity ),
clause(M:G, Body, ClauseRef), clause(M:G, Body, ClauseRef),
clause_property(ClauseRef, file(FileName) ). clause_property(ClauseRef, file(FileName) ).
@ -451,7 +452,7 @@ Saves an image of all the information compiled by the systemm on module _F_ to _
**/ **/
qsave_module(Mod, OF) :- qsave_module(Mod, OF) :-
recorded('$module', '$module'(F,Mod,Source,Exps,L), _), recorded('$module', '$module'(_F,Mod,Source,Exps,L), _),
'$fetch_parents_module'(Mod, Parents), '$fetch_parents_module'(Mod, Parents),
'$fetch_imports_module'(Mod, Imps), '$fetch_imports_module'(Mod, Imps),
'$fetch_multi_files_module'(Mod, MFs), '$fetch_multi_files_module'(Mod, MFs),
@ -508,6 +509,7 @@ qload_module(Mod) :-
Verbosity = informational Verbosity = informational
), ),
StartMsg = loading_module, StartMsg = loading_module,
EndMsg = module_loaded,
'$current_module'(SourceModule, Mod), '$current_module'(SourceModule, Mod),
H0 is heapused, '$cputime'(T0,_), H0 is heapused, '$cputime'(T0,_),
absolute_file_name( Mod, File, [expand(true),file_type(qly)]), absolute_file_name( Mod, File, [expand(true),file_type(qly)]),
@ -558,9 +560,8 @@ qload_module(Mod) :-
'$install_term_expansions_module'(Mod, TEs), '$install_term_expansions_module'(Mod, TEs),
% last, export everything to the host: if the loading crashed you didn't actually do % last, export everything to the host: if the loading crashed you didn't actually do
% no evil. % no evil.
'$convert_for_export'(all, Exps, Mod, SourceModule, TranslationTab, AllExports0, qload_module), '$convert_for_export'(all, Exps, Mod, SourceModule, TranslationTab, _AllExports0, qload_module),
'$add_to_imports'(TranslationTab, Mod, SourceModule), % insert ops, at least for now '$add_to_imports'(TranslationTab, Mod, SourceModule). % insert ops, at least for now
sort( AllExports0, AllExports ).
'$fetch_imports_module'(Mod, Imports) :- '$fetch_imports_module'(Mod, Imports) :-
findall(Info, '$fetch_import_module'(Mod, Info), Imports). findall(Info, '$fetch_import_module'(Mod, Info), Imports).
@ -568,12 +569,12 @@ qload_module(Mod) :-
% detect an import that is local to the module. % detect an import that is local to the module.
'$fetch_import_module'(Mod, '$import'(Mod0,Mod,G0,G,N,K) - S) :- '$fetch_import_module'(Mod, '$import'(Mod0,Mod,G0,G,N,K) - S) :-
recorded('$import', '$import'(Mod0,Mod,G0,G,N,K), _), recorded('$import', '$import'(Mod0,Mod,G0,G,N,K), _),
( recorded('$module','$module'(_, Mod0, S, _, _), R) -> true ; S = user_input ). ( recorded('$module','$module'(_, Mod0, S, _, _), _) -> true ; S = user_input ).
'$fetch_parents_module'(Mod, Parents) :- '$fetch_parents_module'(Mod, Parents) :-
findall(Parent, prolog:'$parent_module'(Mod,Parent), Parents). findall(Parent, prolog:'$parent_module'(Mod,Parent), Parents).
'$fetch_module_transparents_module'(Mod, Mmodule_Transparents) :- '$fetch_module_transparents_module'(Mod, Module_Transparents) :-
findall(Info, '$fetch_module_transparent_module'(Mod, Info), Module_Transparents). findall(Info, '$fetch_module_transparent_module'(Mod, Info), Module_Transparents).
% detect an module_transparenterator that is local to the module. % detect an module_transparenterator that is local to the module.
@ -593,9 +594,9 @@ qload_module(Mod) :-
% detect an multi_file that is local to the module. % detect an multi_file that is local to the module.
'$fetch_multi_file_module'(Mod, '$defined'(FileName,Name,Arity,Mod)) :- '$fetch_multi_file_module'(Mod, '$defined'(FileName,Name,Arity,Mod)) :-
recorded('$multifile_defs','$defined'(FileName,Name,Arity,Mod), _). recorded('$multifile_defs','$defined'(FileName,Name,Arity,Mod), _).
'$fetch_multi_file_module'(Mod, '$mf_clause'(FileName,_Name,_Arity,_Module,Clause), _) :- '$fetch_multi_file_module'(Mod, '$mf_clause'(FileName,_Name,_Arity,Mod,Clause), _) :-
recorded('$mf','$mf_clause'(FileName,_Name,_Arity,_Module,ClauseRef), _), recorded('$mf','$mf_clause'(FileName,_Name,_Arity,Mod,ClauseRef), _),
instance(R, Clause ). instance(ClauseRef, Clause ).
'$fetch_term_expansions_module'(Mod, TEs) :- '$fetch_term_expansions_module'(Mod, TEs) :-
findall(Info, '$fetch_term_expansion_module'(Mod, Info), TEs). findall(Info, '$fetch_term_expansion_module'(Mod, Info), TEs).
@ -644,7 +645,7 @@ qload_module(Mod) :-
'$restore_load_files'([]). '$restore_load_files'([]).
'$restore_load_files'([M-F0|Fs]) :- '$restore_load_files'([M-F0|Fs]) :-
( (
absolute_file_name( M, File, [expand(true),file_type(qly),access(read),file_errors(fail)]) absolute_file_name( M,_File, [expand(true),file_type(qly),access(read),file_errors(fail)])
-> ->
qload_module(M) qload_module(M)
; ;
@ -682,9 +683,9 @@ qload_module(Mod) :-
'$do_foreign'('$swi_foreign'(File, Opts, Handle), More) :- '$do_foreign'('$swi_foreign'(File, Opts, Handle), More) :-
open_shared_object(File, Opts, Handle, NewHandle), open_shared_object(File, Opts, Handle, NewHandle),
'$init_foreigns'(More, NewHandle). '$init_foreigns'(More, NewHandle).
'$do_foreign'('$swi_foreign'(_,_), More). '$do_foreign'('$swi_foreign'(_,_), _More).
'$init_foreigns'([], Handle, NewHandle). '$init_foreigns'([], _Handle, _NewHandle).
'$init_foreigns'(['$swi_foreign'( Handle, Function )|More], Handle, NewHandle) :- '$init_foreigns'(['$swi_foreign'( Handle, Function )|More], Handle, NewHandle) :-
!, !,
call_shared_object_function( NewHandle, Function), call_shared_object_function( NewHandle, Function),
@ -706,6 +707,7 @@ qload_file( F0 ) :-
Verbosity = informational Verbosity = informational
), ),
StartMsg = loading_module, StartMsg = loading_module,
EndMsg = module_loaded,
'$current_module'( SourceModule ), '$current_module'( SourceModule ),
H0 is heapused, H0 is heapused,
'$cputime'(T0,_), '$cputime'(T0,_),
@ -737,21 +739,21 @@ qload_file( F0 ) :-
print_message(Verbosity, loaded(EndMsg, File, Mod, T, H)), print_message(Verbosity, loaded(EndMsg, File, Mod, T, H)),
'$exec_initialisation_goals'. '$exec_initialisation_goals'.
'$qload_file'(S, SourceModule, F, FilePl, _F0, _ImportList) :- '$qload_file'(_S, SourceModule, _F, FilePl, _F0, _ImportList) :-
recorded('$lf_loaded','$lf_loaded'( FilePl, _Age, SourceModule), _), recorded('$lf_loaded','$lf_loaded'( FilePl, _Age, SourceModule), _),
!. !.
'$qload_file'(S, SourceModule, F, FilePl, _F0, _ImportList) :- '$qload_file'(_S, SourceModule, _F, FilePl, _F0, _ImportList) :-
( FilePl == user_input -> Age = 0 ; time_file64(FilePl, Age) ), ( FilePl == user_input -> Age = 0 ; time_file64(FilePl, Age) ),
recorda('$lf_loaded','$lf_loaded'( FilePl, Age, SourceModule), _), recorda('$lf_loaded','$lf_loaded'( FilePl, Age, SourceModule), _),
fail. fail.
'$qload_file'(S, _SourceModule, _File, _FilePl, _F0, _ImportList) :- '$qload_file'(S, _SourceModule, _File, _FilePl, _F0, _ImportList) :-
'$qload_file_preds'(S), '$qload_file_preds'(S),
fail. fail.
'$qload_file'(S, SourceModule, F, FilePl, _F0, _ImportList) :- '$qload_file'(_S, SourceModule, F, _FilePl, _F0, _ImportList) :-
user:'$file_property'( '$lf_loaded'( _, Age, _ ) ), user:'$file_property'( '$lf_loaded'( F, Age, _ ) ),
recordaifnot('$lf_loaded','$lf_loaded'( F, Age, SourceModule), _), recordaifnot('$lf_loaded','$lf_loaded'( F, Age, SourceModule), _),
fail. fail.
'$qload_file'(_S, SourceModule, _File, FilePl, F0, _ImportList) :- '$qload_file'(_S, _SourceModule, _File, FilePl, F0, _ImportList) :-
b_setval('$source_file', F0 ), b_setval('$source_file', F0 ),
'$process_directives'( FilePl ), '$process_directives'( FilePl ),
fail. fail.
@ -768,7 +770,7 @@ qload_file( F0 ) :-
assert( Clause ), assert( Clause ),
fail. fail.
'$process_directives'( FilePl ) :- '$process_directives'( FilePl ) :-
user:'$file_property'( directive( MG, Mode, VL, Pos ) ), user:'$file_property'( directive( MG, _Mode, VL, Pos ) ),
'$set_source'( FilePl, Pos ), '$set_source'( FilePl, Pos ),
strip_module(MG, M, G), strip_module(MG, M, G),
'$process_directive'(G, reconsult, M, VL, Pos), '$process_directive'(G, reconsult, M, VL, Pos),

6
pl/signals.yap
View File

@ -275,7 +275,7 @@ on_signal(Signal,OldAction,NewAction) :-
on_signal(Signal, OldAction, NewAction). on_signal(Signal, OldAction, NewAction).
on_signal(Signal,OldAction,default) :- on_signal(Signal,OldAction,default) :-
'$reset_signal'(Signal, OldAction). '$reset_signal'(Signal, OldAction).
on_signal(Signal,OldAction,Action) :- on_signal(_Signal,_OldAction,Action) :-
var(Action), !, var(Action), !,
throw(error(system_error,'Somehow the meta_predicate declarations of on_signal are subverted!')). throw(error(system_error,'Somehow the meta_predicate declarations of on_signal are subverted!')).
on_signal(Signal,OldAction,Action) :- on_signal(Signal,OldAction,Action) :-
@ -318,8 +318,8 @@ alarm(Number, Goal, Left) :-
Secs is integer(Number), Secs is integer(Number),
USecs is integer((Number-Secs)*1000000) mod 1000000, USecs is integer((Number-Secs)*1000000) mod 1000000,
on_signal(sig_alarm, _, Goal), on_signal(sig_alarm, _, Goal),
'$alarm'(Interval, 0, Left, _). '$alarm'(Secs, USecs, Left, _).
alarm(Interval.USecs, Goal, Left.LUSecs) :- alarm([Interval|USecs], Goal, Left.LUSecs) :-
on_signal(sig_alarm, _, Goal), on_signal(sig_alarm, _, Goal),
'$alarm'(Interval, USecs, Left, LUSecs). '$alarm'(Interval, USecs, Left, LUSecs).

4
pl/statistics.yap
View File

@ -289,9 +289,7 @@ statistics(stack_shifts,[NOfHO,NOfSO,NOfTO]) :-
'$inform_stack_overflows'(NOfSO,_), '$inform_stack_overflows'(NOfSO,_),
'$inform_trail_overflows'(NOfTO,_). '$inform_trail_overflows'(NOfTO,_).
statistics(atoms,[NOf,SizeOf]) :- statistics(atoms,[NOf,SizeOf]) :-
'$statistics_atom_info'(NOf,SizeOf), '$statistics_atom_info'(NOf,SizeOf).
'$inform_stack_overflows'(NOfSO,_),
'$inform_trail_overflows'(NOfTO,_).
statistics(static_code,[ClauseSize, IndexSize, TreeIndexSize, ExtIndexSize, SWIndexSize]) :- statistics(static_code,[ClauseSize, IndexSize, TreeIndexSize, ExtIndexSize, SWIndexSize]) :-
'$statistics_db_size'(ClauseSize, TreeIndexSize, ExtIndexSize, SWIndexSize), '$statistics_db_size'(ClauseSize, TreeIndexSize, ExtIndexSize, SWIndexSize),
IndexSize is TreeIndexSize+ ExtIndexSize+ SWIndexSize. IndexSize is TreeIndexSize+ ExtIndexSize+ SWIndexSize.

6
pl/tabling.yap
View File

@ -283,21 +283,21 @@ table(Pred) :-
'$do_table'(Mod,Pred) :- '$do_table'(Mod,Pred) :-
'$do_error'(type_error(callable,Mod:Pred),table(Mod:Pred)). '$do_error'(type_error(callable,Mod:Pred),table(Mod:Pred)).
'$set_table'(Mod,PredFunctor,PredModeList) :- '$set_table'(Mod,PredFunctor,_PredModeList) :-
'$undefined'('$c_table'(_,_,_),prolog), !, '$undefined'('$c_table'(_,_,_),prolog), !,
functor(PredFunctor, PredName, PredArity), functor(PredFunctor, PredName, PredArity),
'$do_error'(resource_error(tabling,Mod:PredName/PredArity),table(Mod:PredName/PredArity)). '$do_error'(resource_error(tabling,Mod:PredName/PredArity),table(Mod:PredName/PredArity)).
'$set_table'(Mod,PredFunctor,PredModeList) :- '$set_table'(Mod,PredFunctor,PredModeList) :-
'$undefined'(PredFunctor,Mod), !, '$undefined'(PredFunctor,Mod), !,
'$c_table'(Mod,PredFunctor,PredModeList). '$c_table'(Mod,PredFunctor,PredModeList).
'$set_table'(Mod,PredFunctor,PredModeList) :- '$set_table'(Mod,PredFunctor,_PredModeList) :-
'$flags'(PredFunctor,Mod,Flags,Flags), '$flags'(PredFunctor,Mod,Flags,Flags),
Flags /\ 0x00000040 =:= 0x00000040, !. Flags /\ 0x00000040 =:= 0x00000040, !.
'$set_table'(Mod,PredFunctor,PredModeList) :- '$set_table'(Mod,PredFunctor,PredModeList) :-
'$flags'(PredFunctor,Mod,Flags,Flags), '$flags'(PredFunctor,Mod,Flags,Flags),
Flags /\ 0x1991F8C0 =:= 0, Flags /\ 0x1991F8C0 =:= 0,
'$c_table'(Mod,PredFunctor,PredModeList), !. '$c_table'(Mod,PredFunctor,PredModeList), !.
'$set_table'(Mod,PredFunctor,PredModeList) :- '$set_table'(Mod,PredFunctor,_PredModeList) :-
functor(PredFunctor,PredName,PredArity), functor(PredFunctor,PredName,PredArity),
'$do_error'(permission_error(modify,table,Mod:PredName/PredArity),table(Mod:PredName/PredArity)). '$do_error'(permission_error(modify,table,Mod:PredName/PredArity),table(Mod:PredName/PredArity)).

14
pl/threads.yap
View File

@ -307,7 +307,7 @@ thread_create(Goal, Id, Options) :-
'$thread_options'(LOpts, Alias, Stack, Trail, System, Detached, AtExit, Mod, G) '$thread_options'(LOpts, Alias, Stack, Trail, System, Detached, AtExit, Mod, G)
). ).
'$thread_options'([], _, Stack, Trail, System, Detached, AtExit, M, _) :- '$thread_options'([], _, Stack, Trail, System, Detached, AtExit, _M, _) :-
recorded('$thread_defaults', [DefaultStack, DefaultTrail, DefaultSystem, DefaultDetached, DefaultAtExit], _), recorded('$thread_defaults', [DefaultStack, DefaultTrail, DefaultSystem, DefaultDetached, DefaultAtExit], _),
( var(Stack) -> Stack = DefaultStack; true ), ( var(Stack) -> Stack = DefaultStack; true ),
( var(Trail) -> Trail = DefaultTrail; true ), ( var(Trail) -> Trail = DefaultTrail; true ),
@ -330,17 +330,17 @@ thread_create(Goal, Id, Options) :-
( \+ integer(System) -> '$do_error'(type_error(integer,System),G0) ; true ). ( \+ integer(System) -> '$do_error'(type_error(integer,System),G0) ; true ).
'$thread_option'(detached(Detached), _, _, _, _, Detached, _, _, G0) :- !, '$thread_option'(detached(Detached), _, _, _, _, Detached, _, _, G0) :- !,
( Detached \== true, Detached \== false -> '$do_error'(domain_error(thread_option,Detached+[true,false]),G0) ; true ). ( Detached \== true, Detached \== false -> '$do_error'(domain_error(thread_option,Detached+[true,false]),G0) ; true ).
'$thread_option'(at_exit(AtExit), _, _, _, _, _, AtExit, M, G0) :- !, '$thread_option'(at_exit(AtExit), _, _, _, _, _, AtExit, _M, G0) :- !,
( \+ callable(AtExit) -> '$do_error'(type_error(callable,AtExit),G0) ; true ). ( \+ callable(AtExit) -> '$do_error'(type_error(callable,AtExit),G0) ; true ).
% succeed silently, like SWI. % succeed silently, like SWI.
'$thread_option'(Option, _, _, _, _, _, _, _, G0). '$thread_option'(_Option, _, _, _, _, _, _, _, _G0).
% '$do_error'(domain_error(thread_option,Option),G0). % '$do_error'(domain_error(thread_option,Option),G0).
'$record_alias_info'(_, Alias) :- '$record_alias_info'(_, Alias) :-
var(Alias), !. var(Alias), !.
'$record_alias_info'(_, Alias) :- '$record_alias_info'(_, Alias) :-
recorded('$thread_alias', [_|Alias], _), !, recorded('$thread_alias', [_|Alias], _), !,
'$do_error'(permission_error(create,thread,alias(Alias)), Goal). '$do_error'(permission_error(create,thread,alias(Alias)), create_thread).
'$record_alias_info'(Id, Alias) :- '$record_alias_info'(Id, Alias) :-
recorda('$thread_alias', [Id|Alias], _). recorda('$thread_alias', [Id|Alias], _).
@ -554,7 +554,7 @@ thread_exit(Term) :-
thread_exit(Term) :- thread_exit(Term) :-
throw('$thread_finished'(exited(Term))). throw('$thread_finished'(exited(Term))).
'$run_at_thread_exit'(Id0) :- '$run_at_thread_exit'(_Id0) :-
'$thread_run_at_exit'(G, M), '$thread_run_at_exit'(G, M),
catch(once(M:G), _, fail), catch(once(M:G), _, fail),
fail. fail.
@ -714,7 +714,7 @@ thread_property(Id, Prop) :-
). ).
'$thread_property'(detached(Detached), Id) :- '$thread_property'(detached(Detached), Id) :-
( '$thread_detached'(Id,Detached) -> true ; Detached = false ). ( '$thread_detached'(Id,Detached) -> true ; Detached = false ).
'$thread_property'(at_exit(M:G), Id) :- '$thread_property'(at_exit(M:G), _Id) :-
'$thread_run_at_exit'(G,M). '$thread_run_at_exit'(G,M).
'$thread_property'(stack(Stack), Id) :- '$thread_property'(stack(Stack), Id) :-
'$thread_stacks'(Id, Stack, _, _). '$thread_stacks'(Id, Stack, _, _).
@ -824,7 +824,7 @@ Prints a table of current threads and their status.
*/ */
thread_statistics(Id, Key, Val) :- thread_statistics(Id, Key, Val) :-
format("not implemented yet~n",[]). format("not implemented yet: ~w, ~w, ~w~n",[Id, Key, Val]).
%% @} %% @}

24
pl/utils.yap
View File

@ -66,7 +66,7 @@ a postfix operator.
'$do_error'(domain_error(operator_priority,P),G). '$do_error'(domain_error(operator_priority,P),G).
'$check_op'(_,T,_,G) :- '$check_op'(_,T,_,G) :-
\+ atom(T), !, \+ atom(T), !,
'$do_error'(type_error(atom,P),G). '$do_error'(type_error(atom,T),G).
'$check_op'(_,T,_,G) :- '$check_op'(_,T,_,G) :-
\+ '$associativity'(T), !, \+ '$associativity'(T), !,
'$do_error'(domain_error(operator_specifier,T),G). '$do_error'(domain_error(operator_specifier,T),G).
@ -80,7 +80,7 @@ a postfix operator.
'$check_top_op'(P, T, V, G) :- '$check_top_op'(P, T, V, G) :-
atom(V), !, atom(V), !,
'$check_op_name'(P, T, V, G). '$check_op_name'(P, T, V, G).
'$check_top_op'(P, T, V, G) :- '$check_top_op'(_P, _T, V, G) :-
'$do_error'(type_error(atom,V),G). '$do_error'(type_error(atom,V),G).
'$associativity'(xfx). '$associativity'(xfx).
@ -95,18 +95,18 @@ a postfix operator.
'$check_module_for_op'(MOp, G, _) :- '$check_module_for_op'(MOp, G, _) :-
var(MOp), !, var(MOp), !,
'$do_error'(instantiation_error,G). '$do_error'(instantiation_error,G).
'$check_module_for_op'(M:V, G, _) :- '$check_module_for_op'(M:_V, G, _) :-
var(M), !, var(M), !,
'$do_error'(instantiation_error,G). '$do_error'(instantiation_error,G).
'$check_module_for_op'(M:V, G, NV) :- '$check_module_for_op'(M:V, G, NV) :-
atom(M), !, atom(M), !,
'$check_module_for_op'(V, G, NV). '$check_module_for_op'(V, G, NV).
'$check_module_for_op'(M:V, G, _) :- !, '$check_module_for_op'(M:_V, G, _) :- !,
'$do_error'(type_error(atom,P),G). '$do_error'(type_error(atom,M),G).
'$check_module_for_op'(V, G, V). '$check_module_for_op'(V, _G, V).
'$check_ops'(P, T, [], G) :- !. '$check_ops'(_P, _T, [], _G) :- !.
'$check_ops'(P, T, Op.NV, G) :- !, '$check_ops'(P, T, [Op|NV], G) :- !,
( (
var(NV) var(NV)
-> ->
@ -116,7 +116,7 @@ a postfix operator.
'$check_op_name'(P, T, NOp, G), '$check_op_name'(P, T, NOp, G),
'$check_ops'(P, T, NV, G) '$check_ops'(P, T, NV, G)
). ).
'$check_ops'(P, T, Ops, G) :- '$check_ops'(_P, _T, Ops, G) :-
'$do_error'(type_error(list,Ops),G). '$do_error'(type_error(list,Ops),G).
'$check_op_name'(_,_,V,G) :- '$check_op_name'(_,_,V,G) :-
@ -147,7 +147,7 @@ a postfix operator.
'$op'(P, T, A) :- '$op'(P, T, A) :-
'$op2'(P,T,A). '$op2'(P,T,A).
'$opl'(P, T, _, []). '$opl'(_P, _T, _, []).
'$opl'(P, T, M, [A|As]) :- '$opl'(P, T, M, [A|As]) :-
'$op2'(P, T, M:A), '$op2'(P, T, M:A),
'$opl'(P, T, M, As). '$opl'(P, T, M, As).
@ -316,10 +316,6 @@ simple(V) :- var(V), !.
simple(A) :- atom(A), !. simple(A) :- atom(A), !.
simple(N) :- number(N). simple(N) :- number(N).
callable(V) :- var(V), !, fail.
callable(V) :- atom(V), !.
callable(V) :- functor(V,_,Ar), Ar > 0.
/** @pred nth_instance(? _Key_,? _Index_,? _R_) /** @pred nth_instance(? _Key_,? _Index_,? _R_)

8
pl/yio.yap
View File

@ -126,7 +126,7 @@ setting and clearing this flag are given under 7.7.
'$do_error'(instantiation_error,G). '$do_error'(instantiation_error,G).
'$check_boolean'(true,_,_,_) :- !. '$check_boolean'(true,_,_,_) :- !.
'$check_boolean'(false,_,_,_) :- !. '$check_boolean'(false,_,_,_) :- !.
'$check_boolean'(X,B,T,G) :- '$check_boolean'(_X, B, T, G) :-
'$do_error'(domain_error(B,T),G). '$do_error'(domain_error(B,T),G).
/** @defgroup IO_Sockets YAP Old Style Socket and Pipe Interface /** @defgroup IO_Sockets YAP Old Style Socket and Pipe Interface
@ -209,7 +209,7 @@ socket_connect(Sock, Host, Read) :-
; ;
true true
), ),
yap_sockets:ip_socket(Domain, Type, Protocol, Sock). yap_sockets:tcp_connect(Sock, Host:Read).
/** @pred open_pipe_streams(Read, Write) /** @pred open_pipe_streams(Read, Write)
@ -319,7 +319,7 @@ Like display/1, but using stream _S_ to display the term.
*/ */
display(Stream, T) :- display(Stream, T) :-
write_term(Term, T, [ignore_ops(true)]). write_term(Stream, T, [ignore_ops(true)]).
/* interface to user portray */ /* interface to user portray */
'$portray'(T) :- '$portray'(T) :-
@ -574,7 +574,7 @@ stream_position_data(Prop, Term, Value) :-
'$set_default_expand'(false) :- !, '$set_default_expand'(false) :- !,
set_value('$open_expands_filename',false). set_value('$open_expands_filename',false).
'$set_default_expand'(V) :- !, '$set_default_expand'(V) :- !,
'$do_error'(domain_error(flag_value,V),yap_flag(open_expands_file_name,X)). '$do_error'(domain_error(flag_value,V),yap_flag(open_expands_file_name,V)).
%%! @} %%! @}