big cleanup: cpmpile under style checker.
fix broken module stuff.
This commit is contained in:
Vítor Santos Costa
parent
092303f837
commit
e9cc545f68
@ -377,7 +377,7 @@ absolute_file_name(File0,File) :-
|
||||
'$system_catch'(win_registry_get_value(HKEY, Library, Dir), prolog,_,fail).
|
||||
% not installed on registry
|
||||
'$system_library_directories'(Library, Dir) :-
|
||||
'$yap_paths'(_DLLs, ODir1, OBinDir ),
|
||||
'$yap_paths'(_DLLs, ODir1, _OBinDir ),
|
||||
% '$absolute_file_name'( OBinDir, BinDir ),
|
||||
% '$swi_current_prolog_flag'(executable, Bin1),
|
||||
% prolog_to_os_filename( Bin2, Bin1 ),
|
||||
@ -434,7 +434,7 @@ absolute_file_name(File0,File) :-
|
||||
'$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), !.
|
||||
'$extend_path_directory'(Name, D, File, Opts, NewFile, Call) :-
|
||||
user:file_search_path(Name, IDirs),
|
||||
@ -472,7 +472,7 @@ prolog_file_name(File, PrologFileName) :-
|
||||
atom(File), !,
|
||||
operating_system_support:true_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
|
||||
|
||||
88
pl/arith.yap
88
pl/arith.yap
@ -189,6 +189,31 @@ do_c_built_in(X is Y, _, P) :-
|
||||
expand_expr(Y, P0, X0),
|
||||
'$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
|
||||
'$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),
|
||||
'$do_and'(P, Q, R0),
|
||||
'$do_and'(R0, Comp, R).
|
||||
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
|
||||
).
|
||||
do_c_built_in(P, _, P).
|
||||
do_c_built_in(P, _M, P).
|
||||
|
||||
do_c_built_metacall(G1, Mod, '$execute_wo_mod'(G1,Mod)) :-
|
||||
var(Mod), !.
|
||||
@ -241,11 +241,13 @@ do_c_built_metacall(G1, Mod, call(Mod:G1)).
|
||||
% V is the result of the simplification,
|
||||
% X the result of the initial expression
|
||||
% and the last argument is how we are writing this result
|
||||
'$drop_is'(V, V1, P0, G) :- var(V), !, % usual case
|
||||
V = V1, P0 = G.
|
||||
'$drop_is'(V, V1, P0, G) :-
|
||||
var(V),
|
||||
!, % usual case
|
||||
V = V1,
|
||||
P0 = G.
|
||||
'$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
|
||||
'$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_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).
|
||||
|
||||
%% contains_illegal_dcgnt(+Term) is semidet.
|
||||
|
||||
16
pl/atoms.yap
16
pl/atoms.yap
@ -45,21 +45,21 @@ atom_concat(Xs,At) :-
|
||||
% just slice first atom
|
||||
'$atom_concat_constraints'([At0|Xs], 0, At, Unbound) :-
|
||||
atom(At0), !,
|
||||
sub_atom(At, 0, Sz, L, At0 ),
|
||||
sub_atom(At, 0, _Sz, L, At0 ),
|
||||
sub_atom(At, _, L, 0, Atr ), %remainder
|
||||
'$atom_concat_constraints'(Xs, 0, Atr, Unbound).
|
||||
% 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'(Xs, mid(Next,At1), At, Unbound).
|
||||
'$atom_concat_constraints'(Xs, mid(Next,_At1), At, Unbound).
|
||||
% end of a run
|
||||
'$atom_concat_constraints'([At0|Xs], mid(end, At1), At, Unbound) :-
|
||||
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, _, L, 0, Atr), %remainder
|
||||
'$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'(Xs, mid(NextFollow, At1), At, Unbound).
|
||||
'$atom_concat_constraints'(Xs, mid(Follow, At1), At, Unbound).
|
||||
|
||||
'$process_atom_holes'([]).
|
||||
'$process_atom_holes'([hole(At0, Next, At1, End)|Unbound]) :- End == end, !,
|
||||
@ -190,21 +190,21 @@ string_concat(Xs,At) :-
|
||||
% just slice first string
|
||||
'$string_concat_constraints'([At0|Xs], 0, At, Unbound) :-
|
||||
string(At0), !,
|
||||
sub_string(At, 0, Sz, L, At0 ),
|
||||
sub_string(At, 0, _Sz, L, At0 ),
|
||||
sub_string(At, _, L, 0, Atr ), %remainder
|
||||
'$string_concat_constraints'(Xs, 0, Atr, Unbound).
|
||||
% 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'(Xs, mid(Next,At1), At, Unbound).
|
||||
'$string_concat_constraints'(Xs, mid(Next,_At1), At, Unbound).
|
||||
% end of a run
|
||||
'$string_concat_constraints'([At0|Xs], mid(end, At1), At, Unbound) :-
|
||||
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, _, L, 0, Atr), %remainder
|
||||
'$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'(Xs, mid(NextFollow, At1), At, Unbound).
|
||||
'$string_concat_constraints'(Xs, mid(Follow, At1), At, Unbound).
|
||||
|
||||
'$process_string_holes'([]).
|
||||
'$process_string_holes'([hole(At0, Next, At1, End)|Unbound]) :- End == end, !,
|
||||
|
||||
@ -129,7 +129,7 @@ style_check(V) :-
|
||||
'$do_error'( type_error('+|-|?(Flag)', V), style_check(V) ).
|
||||
style_check(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) :-
|
||||
@ -183,7 +183,7 @@ style_check_(+charset) :-
|
||||
style_check_(-charset) :-
|
||||
'$style_checker'( [ -charset ] ).
|
||||
style_check_('?'(Info) ) :-
|
||||
lists:member( Style, [ singleton, discontiguous, multiple ] ),
|
||||
L = [ singleton, discontiguous, multiple ],
|
||||
( lists:member(Style, L ) -> Info = +Style ; Info = -Style ).
|
||||
style_check_([]).
|
||||
style_check_([H|T]) :- style_check(H), style_check(T).
|
||||
|
||||
105
pl/consult.yap
105
pl/consult.yap
@ -234,13 +234,18 @@ load_files(Files,Opts) :-
|
||||
'$lf_option'('$context_module', 27, _).
|
||||
'$lf_option'('$parent_topts', 28, _).
|
||||
'$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_option'(Op, Id, _),
|
||||
arg( Id, TOpts, Val ).
|
||||
|
||||
'$set_lf_opt'( Op, TOpts, Val) :-
|
||||
'$lf_option'(Op, Id, _),
|
||||
setarg( Id, TOpts, Val ).
|
||||
|
||||
'$load_files'(Files, Opts, Call) :-
|
||||
( '$nb_getval'('$lf_status', OldTOpts, fail), nonvar(OldTOpts) ->
|
||||
'$lf_opt'(silent, OldTOpts, OldVerbosity),
|
||||
@ -374,8 +379,8 @@ load_files(Files,Opts) :-
|
||||
( Val == false -> true ;
|
||||
Val == true -> true ;
|
||||
'$do_error'(domain_error(unimplemented_option,register(Val)),Call) ).
|
||||
'$process_lf_opt'('$context_module', Val, Call) :-
|
||||
( atom(File) -> true ; '$do_error'(type_error(atom,File),Call) ).
|
||||
'$process_lf_opt'('$context_module', Mod, Call) :-
|
||||
( atom(Mod) -> true ; '$do_error'(type_error(atom,Mod),Call) ).
|
||||
|
||||
|
||||
'$lf_default_opts'(I, LastOpt, _TOpts) :- I > LastOpt, !.
|
||||
@ -417,7 +422,7 @@ load_files(Files,Opts) :-
|
||||
'$lf'(user_input, Mod, _, TOpts) :- !,
|
||||
b_setval('$source_file', user_input),
|
||||
'$do_lf'(Mod, user_input, user_input, TOpts).
|
||||
'$lf'(File, Mod, Call, TOpts) :-
|
||||
'$lf'(File, Mod, _Call, TOpts) :-
|
||||
'$lf_opt'(stream, TOpts, Stream),
|
||||
var( Stream ),
|
||||
H0 is heapused, '$cputime'(T0,_),
|
||||
@ -463,6 +468,7 @@ load_files(Files,Opts) :-
|
||||
'$lf_opt'(imports, TOpts, Imports),
|
||||
'$start_lf'(If, Mod, Stream, TOpts, File, Reexport, Imports),
|
||||
character_count(Stream, Pos),
|
||||
'$set_lf_opt'('$source_pos', TOpts, Pos),
|
||||
close(Stream).
|
||||
'$lf'(X, _, Call, _) :-
|
||||
'$do_error'(permission_error(input,stream,X),Call).
|
||||
@ -471,15 +477,15 @@ load_files(Files,Opts) :-
|
||||
'$file_loaded'(Stream, Mod, Imports, TOpts), !,
|
||||
'$lf_opt'('$options', TOpts, Opts),
|
||||
'$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 ).
|
||||
'$start_lf'(changed, Mod, Stream, TOpts, UserFile, Reexport, Imports) :-
|
||||
'$file_unchanged'(Stream, Mod, Imports, TOpts), !,
|
||||
'$lf_opt'('$options', TOpts, Opts),
|
||||
'$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 ).
|
||||
'$start_lf'(_, Mod, Stream, TOpts, File, Reexport, Imports) :-
|
||||
'$start_lf'(_, Mod, Stream, TOpts, File, _Reexport, _Imports) :-
|
||||
'$do_lf'(Mod, Stream, File, TOpts).
|
||||
|
||||
|
||||
@ -654,7 +660,7 @@ db_files(Fs) :-
|
||||
'$lf_opt'(consult, TOpts, Reconsult0),
|
||||
'$lf_opt'('$options', TOpts, Opts),
|
||||
'$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),
|
||||
H0 is heapused, '$cputime'(T0,_),
|
||||
'$set_current_loop_stream'(OldStream, Stream),
|
||||
@ -681,18 +687,19 @@ db_files(Fs) :-
|
||||
'$skip_unix_header'(Stream)
|
||||
;
|
||||
true
|
||||
),
|
||||
'$loop'(Stream,Reconsult),
|
||||
'$lf_opt'(imports, TOpts, Imports),
|
||||
'$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,
|
||||
),
|
||||
'$loop'(Stream,Reconsult),
|
||||
'$lf_opt'(imports, TOpts, Imports),
|
||||
'$import_to_current_module'(File, ContextModule, Imports, _, TOpts),
|
||||
'$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 ->
|
||||
'$clear_reconsulting'
|
||||
;
|
||||
'$clear_reconsulting'
|
||||
;
|
||||
true
|
||||
),
|
||||
'$set_current_loop_stream'(Stream, OldStream),
|
||||
@ -712,13 +719,14 @@ db_files(Fs) :-
|
||||
% 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'('$source_pos', TOpts, Pos),
|
||||
( QComp == auto ; QComp == large, Pos > 100*1024),
|
||||
'$absolute_file_name'(UserF,[file_type(qly),solutions(first),expand(true)],F,load_files(File)),
|
||||
!,
|
||||
'$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?
|
||||
'$msg_level'( TOpts, Verbosity) :-
|
||||
@ -752,7 +760,7 @@ db_files(Fs) :-
|
||||
'$bind_module'(_, load_files).
|
||||
'$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, _),_),
|
||||
% enable loading C-predicates from a different file
|
||||
recorded( '$load_foreign_done', [File, M0], _),
|
||||
@ -761,7 +769,7 @@ db_files(Fs) :-
|
||||
'$import_to_current_module'(File, ContextModule, Imports, RemainingImports, TOpts) :-
|
||||
recorded('$module','$module'(File, Module, _Source, ModExports, _),_),
|
||||
Module \= ContextModule, !,
|
||||
% '$lf_opt'('$call', TOpts, Call),
|
||||
'$lf_opt'('$call', TOpts, Goal),
|
||||
'$convert_for_export'(Imports, ModExports, Module, ContextModule, TranslationTab, RemainingImports, Goal),
|
||||
'$add_to_imports'(TranslationTab, Module, ContextModule).
|
||||
'$import_to_current_module'(_, _, _, _, _).
|
||||
@ -797,7 +805,6 @@ db_files(Fs) :-
|
||||
'$system_catch'(('$user_call'(G,M) -> true), M, Error, user:'$LoopError'(Error, top)),
|
||||
fail
|
||||
;
|
||||
OldMode = on,
|
||||
fail
|
||||
).
|
||||
'$exec_initialisation_goals' :-
|
||||
@ -837,7 +844,7 @@ include(+ _F_) is directive
|
||||
),
|
||||
'$set_current_loop_stream'(OldStream, Stream),
|
||||
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 = [] ),
|
||||
'$lf_opt'(encoding, TOpts, Encoding),
|
||||
'$set_encoding'(Stream, Encoding),
|
||||
@ -987,10 +994,10 @@ prolog_load_context(term_position, Position) :-
|
||||
% format( 'IL=~w~n', [(F1:Imports->M)] ),
|
||||
'$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('$lf_loaded','$lf_loaded'(F1, _, _),_),
|
||||
same_file(F1,F), !.
|
||||
same_file(F1, F), !.
|
||||
'$ensure_file_loaded'(F, M, F1) :-
|
||||
% loaded from the same module, but does not define a module.
|
||||
recorded('$lf_loaded','$lf_loaded'(F1, _, M),_),
|
||||
@ -1005,7 +1012,8 @@ prolog_load_context(term_position, Position) :-
|
||||
% format( 'IU=~w~n', [(F1:Imports->M)] ),
|
||||
'$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('$lf_loaded','$lf_loaded'(F1,Age,_),R),
|
||||
same_file(F1,F), !,
|
||||
@ -1021,14 +1029,38 @@ prolog_load_context(term_position, Position) :-
|
||||
|
||||
|
||||
% 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),
|
||||
( F0 == user_input, nonvar(UserFile) -> UserFile = F
|
||||
; F = F0 ),
|
||||
( F == user_input -> working_directory(Dir,Dir) ; file_directory_name(F, Dir) ),
|
||||
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) ),
|
||||
( recordaifnot('$lf_loaded','$lf_loaded'( F, Age, M), _) -> true ; true ),
|
||||
recorda('$lf_loaded','$lf_loaded'( F, M, Reconsult, UserFile, OldF, Line, Opts), _).
|
||||
@ -1142,7 +1174,7 @@ unload_file( F0 ) :-
|
||||
% eliminate multi-files;
|
||||
% get rid of file-only predicataes.
|
||||
'$unload_file'( FileName, _F0 ) :-
|
||||
'$current_predicate_var'(A,Mod,P).
|
||||
'$current_predicate_var'(_A,Mod,P),
|
||||
'$owner_file'(P,Mod,FileName),
|
||||
\+ '$is_multifile'(P,Mod),
|
||||
functor( P, Na, Ar),
|
||||
@ -1150,7 +1182,7 @@ unload_file( F0 ) :-
|
||||
fail.
|
||||
%next multi-file.
|
||||
'$unload_file'( FileName, _F0 ) :-
|
||||
recorded('$lf_loaded','$lf_loaded'( F, Age, _), R),
|
||||
recorded('$lf_loaded','$lf_loaded'( FileName, _Age, _), R),
|
||||
erase(R),
|
||||
fail.
|
||||
'$unload_file'( FileName, _F0 ) :-
|
||||
@ -1159,16 +1191,12 @@ unload_file( F0 ) :-
|
||||
erase(ClauseRef),
|
||||
fail.
|
||||
'$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(R),
|
||||
fail.
|
||||
'$unload_file'( FileName, _F0 ) :-
|
||||
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),
|
||||
recorded('$multifile_defs','$defined'(FileName,_Name,_Arity,_Mod), R),
|
||||
erase(R),
|
||||
fail.
|
||||
'$unload_file'( FileName, _F0 ) :-
|
||||
@ -1442,7 +1470,8 @@ initialization(G,OPT) :-
|
||||
'$do_error'(type_error(OPT),initialization(G,OPT))
|
||||
).
|
||||
'$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).
|
||||
% ignore for now.
|
||||
|
||||
@ -146,7 +146,7 @@ notrace(G) :-
|
||||
'$debug_stop'( State ),
|
||||
'$call'(G1, CP, G, M),
|
||||
'$$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 ),
|
||||
@ -196,10 +196,8 @@ over _G_.
|
||||
If you want _G_ to be deterministic you should use if-then-else, as
|
||||
it is both more efficient and more portable.
|
||||
|
||||
|
||||
*/
|
||||
if(X,Y,Z) :-
|
||||
yap_hacks:env_choice_point(CP0),
|
||||
(
|
||||
CP is '$last_choice_pt',
|
||||
'$call'(X,CP,if(X,Y,Z),M),
|
||||
@ -372,9 +370,8 @@ setup_call_catcher_cleanup(Setup, Goal, Catcher, Cleanup) :-
|
||||
'$cleanup_exception'(Exception, _, _) :-
|
||||
throw(Exception).
|
||||
|
||||
'$safe_call_cleanup'(Goal, Cleanup, Catcher, Exception) :-
|
||||
'$current_choice_point'(MyCP1),
|
||||
'$coroutining':freeze_goal(Catcher, '$clean_call'(Active, Cleanup)),
|
||||
'$safe_call_cleanup'(Goal, Cleanup, Catcher, _Exception) :-
|
||||
'$coroutining':freeze_goal(Catcher, '$clean_call'(_Active, Cleanup)),
|
||||
(
|
||||
yap_hacks:trail_suspension_marker(Catcher),
|
||||
yap_hacks:enable_interrupts,
|
||||
|
||||
@ -101,7 +101,7 @@ wake_delay(redo_dif(Done, X, Y)) :-
|
||||
wake_delay(redo_freeze(Done, V, Goal)) :-
|
||||
redo_freeze(Done, V, 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)) :-
|
||||
redo_ground(Done, X, Goal).
|
||||
|
||||
@ -135,7 +135,7 @@ attribute_goals(Var) -->
|
||||
{ get_attr(Var, '$coroutining', Delays) },
|
||||
attgoal_for_delays(Delays, Var).
|
||||
|
||||
attgoal_for_delays([], V) --> [].
|
||||
attgoal_for_delays([], _V) --> [].
|
||||
attgoal_for_delays([G|AllAtts], V) -->
|
||||
attgoal_for_delay(G, 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) -->
|
||||
{ var(Done), first_att(Goal, V) }, !,
|
||||
[ 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) }, !,
|
||||
[ 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(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(V, G, Done, LG0, LGF) :- var(V), !,
|
||||
when(V, G, _Done, LG, LG) :- var(V), !,
|
||||
'$do_error'(instantiation_error,when(V,G)).
|
||||
when(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),
|
||||
check_first_attvar(Vs, V).
|
||||
|
||||
check_first_attvar(V.Vs, V0) :- attvar(V), !, V == V0.
|
||||
check_first_attvar(_.Vs, V0) :-
|
||||
check_first_attvar([V|_Vs], V0) :- attvar(V), !, V == V0.
|
||||
check_first_attvar([_|Vs], V0) :-
|
||||
check_first_attvar(Vs, V0).
|
||||
|
||||
/**
|
||||
|
||||
@ -35,7 +35,7 @@ dbload_from_stream(R, M0, Type) :-
|
||||
fail
|
||||
).
|
||||
|
||||
close_dbload(R, exo) :-
|
||||
close_dbload(_R, exo) :-
|
||||
retract(dbloading(Na,Arity,M,T,NaAr,_)),
|
||||
nb_getval(NaAr,Size),
|
||||
exo_db_get_space(T, M, Size, Handle),
|
||||
@ -44,9 +44,9 @@ close_dbload(R, exo) :-
|
||||
fail.
|
||||
close_dbload(R, exo) :-
|
||||
seek(R, 0, bof, _),
|
||||
exodb_add_facts(R, M),
|
||||
exodb_add_facts(R, _M),
|
||||
fail.
|
||||
close_dbload(R, mega) :-
|
||||
close_dbload(_R, mega) :-
|
||||
retract(dbloading(Na,Arity,M,T,NaAr,_)),
|
||||
nb_getval(NaAr,Size),
|
||||
dbload_get_space(T, M, Size, Handle),
|
||||
@ -55,7 +55,7 @@ close_dbload(R, mega) :-
|
||||
fail.
|
||||
close_dbload(R, mega) :-
|
||||
seek(R, 0, bof, _),
|
||||
dbload_add_facts(R, M),
|
||||
dbload_add_facts(R, _M),
|
||||
fail.
|
||||
close_dbload(_, _) :-
|
||||
retractall(dbloading(_Na,_Arity,_M,_T,_NaAr,_Handle)),
|
||||
|
||||
29
pl/debug.yap
29
pl/debug.yap
@ -117,19 +117,18 @@ mode and the existing spy-points, when the debugger is on.
|
||||
),
|
||||
!,
|
||||
'$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))).
|
||||
'$suspy_predicates_by_name'(A,nospy,M) :-
|
||||
'$suspy_predicates_by_name'(A,nospy,M) :-
|
||||
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),
|
||||
functor(T,A,N),
|
||||
'$do_suspy'(S, A, N, T, M).
|
||||
'$do_suspy_predicates_by_name'(A, S, M) :-
|
||||
recorded('$import','$import'(EM,M,T0,_,A,N),_),
|
||||
functor(T0,A0,N0),
|
||||
'$do_suspy'(S, A0, N0, T, EM).
|
||||
'$do_suspy_predicates_by_name'(A, S, M) :-
|
||||
recorded('$import','$import'(EM,M,_,T,A,N),_),
|
||||
'$do_suspy'(S, A, N, T, EM).
|
||||
|
||||
|
||||
%
|
||||
@ -217,7 +216,7 @@ The possible forms for _P_ are the same as in `spy P`.
|
||||
nospy L :-
|
||||
'$current_module'(M),
|
||||
'$suspy'(L, nospy, M), fail.
|
||||
nospy _.
|
||||
nospy _.
|
||||
|
||||
/** @pred nospyall
|
||||
|
||||
@ -226,18 +225,18 @@ Removes all existing spy-points.
|
||||
|
||||
|
||||
*/
|
||||
nospyall :-
|
||||
nospyall :-
|
||||
'$init_debugger',
|
||||
prolog:debug_action_hook(nospyall), !.
|
||||
nospyall :-
|
||||
nospyall :-
|
||||
recorded('$spy','$spy'(T,M),_), functor(T,F,N), '$suspy'(F/N,nospy,M), fail.
|
||||
nospyall.
|
||||
nospyall.
|
||||
|
||||
% debug mode -> debug flag = 1
|
||||
|
||||
debug :-
|
||||
debug :-
|
||||
'$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),
|
||||
print_message(informational,debug(debug)).
|
||||
|
||||
@ -748,7 +747,7 @@ be lost.
|
||||
'$loop_fail'(GoalNumber, G, Module, CalledFromDebugger).
|
||||
'$loop_spy_event'(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, !,
|
||||
'$continue_debugging'(zip, CalledFromDebugger).
|
||||
'$loop_spy_event'(error('$done_spy'(GoalNumber),_), _, _, _, _) :- !,
|
||||
@ -891,7 +890,7 @@ be lost.
|
||||
'$spycall'(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),
|
||||
F /\ 0x08402000 =\= 0, !, % dynamic procedure, logical semantics, or source
|
||||
% use the interpreter
|
||||
|
||||
@ -339,7 +339,7 @@ print_message(_, Term) :-
|
||||
flush_output(user_output),
|
||||
flush_output(user_error),
|
||||
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_error),
|
||||
'$messages':prefix(Level, LinePrefix, Stream, LinesF, Lines), !,
|
||||
|
||||
115
pl/flags.yap
115
pl/flags.yap
@ -691,24 +691,18 @@ yap_flag(index,X) :-
|
||||
'$do_error'(domain_error(flag_value,index+X),yap_flag(index,X)).
|
||||
|
||||
% do or do not indexation
|
||||
yap_flag(index_sub_term_search_depth,X) :- var(X),
|
||||
'$access_yap_flags'(23, X), !.
|
||||
yap_flag(index_sub_term_search_depth,X,X) :-
|
||||
integer(X), X > 0,
|
||||
'$set_yap_flags'(23,X1).
|
||||
yap_flag(index_sub_term_search_depth,X,X) :-
|
||||
\+ integer(X),
|
||||
'$do_error'(type_error(integer,X),yap_flag(index_sub_term_search_depth,X)).
|
||||
yap_flag(index_sub_term_search_depth,X,X) :-
|
||||
'$do_error'(domain_error(out_of_range,index_sub_term_search_depth+X),yap_flag(index_sub_term_search_depth,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).
|
||||
yap_flag(index_sub_term_search_depth,X) :-
|
||||
var(X),
|
||||
'$access_yap_flags'(23, X), !.
|
||||
yap_flag(index_sub_term_search_depth,X) :-
|
||||
integer(X),
|
||||
X > 0,
|
||||
'$set_yap_flags'(23,X).
|
||||
yap_flag(index_sub_term_search_depth,X) :-
|
||||
\+ integer(X),
|
||||
'$do_error'(type_error(integer,X),yap_flag(index_sub_term_search_depth,X)).
|
||||
yap_flag(index_sub_term_search_depth,X) :-
|
||||
'$do_error'(domain_error(out_of_range,index_sub_term_search_depth+X),yap_flag(index_sub_term_search_depth,X)).
|
||||
|
||||
% tabling mode
|
||||
yap_flag(tabling_mode,Options) :-
|
||||
@ -725,16 +719,6 @@ yap_flag(tabling_mode,Option) :-
|
||||
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(verbose, X).
|
||||
|
||||
@ -933,27 +917,6 @@ yap_flag(single_var_warnings,X) :-
|
||||
|
||||
yap_flag(system_options,X) :-
|
||||
'$system_options'(X).
|
||||
|
||||
'$system_options'(big_numbers) :-
|
||||
'$has_bignums'.
|
||||
'$system_options'(coroutining) :-
|
||||
'$yap_has_coroutining'.
|
||||
'$system_options'(depth_limit) :-
|
||||
\+ '$undefined'(get_depth_limit(_), prolog).
|
||||
'$system_options'(low_level_tracer) :-
|
||||
\+ '$undefined'(start_low_level_trace, prolog).
|
||||
'$system_options'(or_parallelism) :-
|
||||
\+ '$undefined'('$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) :-
|
||||
var(X), !,
|
||||
@ -1081,6 +1044,46 @@ yap_flag(max_threads,X) :-
|
||||
yap_flag(max_threads,X) :-
|
||||
'$do_error'(domain_error(flag_value,max_threads+X),yap_flag(max_threads,X)).
|
||||
|
||||
% should match definitions in Yap.h
|
||||
'$transl_to_index_mode'(0, off).
|
||||
'$transl_to_index_mode'(1, single).
|
||||
'$transl_to_index_mode'(2, compact).
|
||||
'$transl_to_index_mode'(3, multi).
|
||||
'$transl_to_index_mode'(3, on). % default is multi argument indexing
|
||||
'$transl_to_index_mode'(4, max).
|
||||
|
||||
|
||||
% should match with code in stdpreds.c
|
||||
'$transl_to_yap_flag_tabling_mode'(0,default).
|
||||
'$transl_to_yap_flag_tabling_mode'(1,batched).
|
||||
'$transl_to_yap_flag_tabling_mode'(2,local).
|
||||
'$transl_to_yap_flag_tabling_mode'(3,exec_answers).
|
||||
'$transl_to_yap_flag_tabling_mode'(4,load_answers).
|
||||
'$transl_to_yap_flag_tabling_mode'(5,local_trie).
|
||||
'$transl_to_yap_flag_tabling_mode'(6,global_trie).
|
||||
'$transl_to_yap_flag_tabling_mode'(7,coinductive).
|
||||
|
||||
'$system_options'(big_numbers) :-
|
||||
'$has_bignums'.
|
||||
'$system_options'(coroutining) :-
|
||||
'$yap_has_coroutining'.
|
||||
'$system_options'(depth_limit) :-
|
||||
\+ '$undefined'(get_depth_limit(_), prolog).
|
||||
'$system_options'(low_level_tracer) :-
|
||||
\+ '$undefined'(start_low_level_trace, prolog).
|
||||
'$system_options'(or_parallelism) :-
|
||||
\+ '$undefined'('$c_yapor_start', prolog).
|
||||
'$system_options'(rational_trees) :-
|
||||
'$yap_has_rational_trees'.
|
||||
'$system_options'(readline) :-
|
||||
'$swi_current_prolog_flag'(readline, true).
|
||||
'$system_options'(tabling) :-
|
||||
\+ '$undefined'('$c_table'(_,_,_), prolog).
|
||||
'$system_options'(threads) :-
|
||||
\+ '$undefined'('$thread_join'(_), prolog).
|
||||
'$system_options'(wam_profiler) :-
|
||||
\+ '$undefined'(reset_op_counters, prolog).
|
||||
|
||||
'$yap_system_flag'(agc_margin).
|
||||
'$yap_system_flag'(chr_toplevel_show_store).
|
||||
'$yap_system_flag'(debugger_print_options).
|
||||
@ -1307,7 +1310,7 @@ create_prolog_flag(Name, Value, Options) :-
|
||||
'$check_flag_name'(Name, _) :-
|
||||
atom(Name), !.
|
||||
'$check_flag_name'(Name, G) :-
|
||||
'$do_error'(type_error(atom),G).
|
||||
'$do_error'(type_error(atom,Name),G).
|
||||
|
||||
'$check_flag_options'(O, _, _, G) :-
|
||||
var(O),
|
||||
@ -1316,11 +1319,11 @@ create_prolog_flag(Name, Value, Options) :-
|
||||
'$check_flag_options'([O1|Os], Domain, RW, G) :- !,
|
||||
'$check_flag_optionsl'([O1|Os], Domain, RW, G).
|
||||
'$check_flag_options'(O, _, _, G) :-
|
||||
'$do_error'(type_error(list),G).
|
||||
'$do_error'(type_error(list,O),G).
|
||||
|
||||
|
||||
'$check_flag_optionsl'([], _, read_write, G).
|
||||
'$check_flag_optionsl'([V|Os], Domain, RW, G) :-
|
||||
'$check_flag_optionsl'([], _, read_write, _G).
|
||||
'$check_flag_optionsl'([V|_Os], _Domain, _RW, G) :-
|
||||
var(V),
|
||||
'$do_error'(instantiation_error,G).
|
||||
'$check_flag_optionsl'([type(Type)|Os], Domain, RW, G) :- !,
|
||||
@ -1329,7 +1332,7 @@ create_prolog_flag(Name, Value, Options) :-
|
||||
'$check_flag_optionsl'([access(Access)|Os], Domain, RW, G) :- !,
|
||||
'$check_flag_access'(Access, RW, G),
|
||||
'$check_flag_optionsl'(Os, Domain, _, G).
|
||||
'$check_flag_optionsl'(Os, Domain, RW, G) :-
|
||||
'$check_flag_optionsl'(Os, _Domain, _RW, G) :-
|
||||
'$do_error'(domain_error(create_prolog_flag,Os),G).
|
||||
|
||||
'$check_flag_type'(V, _, G) :-
|
||||
@ -1348,7 +1351,7 @@ create_prolog_flag(Name, Value, Options) :-
|
||||
'$do_error'(instantiation_error,G).
|
||||
'$check_flag_access'(read_write, read_write, _) :- !.
|
||||
'$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).
|
||||
|
||||
'$user_flag_value'(F, Val) :-
|
||||
@ -1376,7 +1379,7 @@ create_prolog_flag(Name, Value, Options) :-
|
||||
'$check_flag_value'(Value, _, G) :-
|
||||
\+ ground(Value), !,
|
||||
'$do_error'(instantiation_error,G).
|
||||
'$check_flag_value'(Value, Domain, G) :-
|
||||
'$check_flag_value'(Value, Domain, _G) :-
|
||||
var(Domain), !,
|
||||
'$flag_domain_from_value'(Value, Domain).
|
||||
'$check_flag_value'(_, term, _) :- !.
|
||||
|
||||
16
pl/hacks.yap
16
pl/hacks.yap
@ -38,7 +38,7 @@ run_formats([Com-Args|StackInfo], Stream) :-
|
||||
run_formats(StackInfo, Stream).
|
||||
|
||||
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_error),
|
||||
print_message_lines(user_error, '', Lines).
|
||||
@ -47,7 +47,7 @@ code_location(Info,Where,Location) :-
|
||||
integer(Where) , !,
|
||||
'$pred_for_code'(Where,Name,Arity,Mod,Clause),
|
||||
construct_code(Clause,Name,Arity,Mod,Info,Location).
|
||||
code_location(Ixnfo,_,Info).
|
||||
code_location(Info,_,Info).
|
||||
|
||||
construct_code(-1,Name,Arity,Mod,Where,Location) :- !,
|
||||
number_codes(Arity,ArityCode),
|
||||
@ -157,7 +157,7 @@ list_of_qmarks(I,[?|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].
|
||||
@ -182,7 +182,7 @@ beautify_hidden_goal('$continue_with_command'(Command,V,P,G,Source),prolog) -->
|
||||
['TopLevel'(Command,G,V,P,Source)].
|
||||
beautify_hidden_goal('$spycall'(G,M,InControl,Redo),prolog) -->
|
||||
['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)].
|
||||
beautify_hidden_goal('$system_catch'(G,Mod,Exc,Handler),prolog) -->
|
||||
[catch(Mod:G, Exc, Handler)].
|
||||
@ -200,7 +200,7 @@ beautify_hidden_goal('$load_files'(_,_,Name),prolog) -->
|
||||
[Name].
|
||||
beautify_hidden_goal('$reconsult'(Files,Mod),prolog) -->
|
||||
[reconsult(Mod:Files)].
|
||||
beautify_hidden_goal('$undefp'([M|G]),prolog) -->
|
||||
beautify_hidden_goal('$undefp'([Mod|G]),prolog) -->
|
||||
['CallUndefined'(Mod:G)].
|
||||
beautify_hidden_goal('$undefp'(?),prolog) -->
|
||||
['CallUndefined'(?:?)].
|
||||
@ -218,9 +218,9 @@ beautify_hidden_goal('$findall'(T,G,S,A),prolog) -->
|
||||
[findall(T,G,S,A)].
|
||||
beautify_hidden_goal('$listing'(G,M,_Stream),prolog) -->
|
||||
[listing(M:G)].
|
||||
beautify_hidden_goal('$call'(G,CP,?,M),prolog) -->
|
||||
beautify_hidden_goal('$call'(G,_CP,?,M),prolog) -->
|
||||
[call(M:G)].
|
||||
beautify_hidden_goal('$call'(G,CP,G0,M),prolog) -->
|
||||
beautify_hidden_goal('$call'(_G,_CP,G0,M),prolog) -->
|
||||
[call(M:G0)].
|
||||
beautify_hidden_goal('$current_predicate'(M,Na,Ar),prolog) -->
|
||||
[current_predicate(M,Na/Ar)].
|
||||
@ -228,6 +228,6 @@ beautify_hidden_goal('$current_predicate_for_atom'(Name,M,Ar),prolog) -->
|
||||
{ functor(P, Name, Ar) },
|
||||
[current_predicate(Name,M:P)].
|
||||
beautify_hidden_goal('$list_clauses'(Stream,M,Pred),prolog) -->
|
||||
[listing(M:Pred)].
|
||||
[listing(Stream,M:Pred)].
|
||||
|
||||
|
||||
|
||||
@ -64,7 +64,7 @@ listing(MV) :-
|
||||
listing(Stream, MV) :-
|
||||
strip_module( MV, M, I),
|
||||
'$mlisting'(Stream, I, M).
|
||||
listing(Stream, []) :- !.
|
||||
listing(_Stream, []) :- !.
|
||||
listing(Stream, [MV|MVs]) :- !,
|
||||
listing(Stream, MV),
|
||||
listing(Stream, MVs).
|
||||
@ -74,9 +74,9 @@ listing(Stream, [MV|MVs]) :- !,
|
||||
;
|
||||
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)
|
||||
;
|
||||
@ -160,7 +160,7 @@ listing(Stream, [MV|MVs]) :- !,
|
||||
format( Stream, ':- ~q:~q.~n', [M,PredDef])
|
||||
),
|
||||
fail.
|
||||
'$list_clauses'(Stream, M, Pred) :-
|
||||
'$list_clauses'(Stream, _M, _Pred) :-
|
||||
nl( Stream ),
|
||||
fail.
|
||||
'$list_clauses'(Stream, M, Pred) :-
|
||||
|
||||
@ -175,7 +175,7 @@ open_shared_object(File, Opts, Handle) :-
|
||||
prolog_load_context(module, M),
|
||||
ignore( recordzifnot( '$foreign', M:'$swi_foreign'(File,Opts, Handle), _) ).
|
||||
|
||||
'$open_shared_opts'(Opts, G, OptsI) :-
|
||||
'$open_shared_opts'(Opts, G, _OptsI) :-
|
||||
var(Opts), !,
|
||||
'$do_error'(instantiation_error,G).
|
||||
'$open_shared_opts'([], _, 0) :- !.
|
||||
|
||||
@ -137,7 +137,7 @@ generate_message(M) -->
|
||||
|
||||
stack_dump(error(_,_)) -->
|
||||
{ fail },
|
||||
{ recorded(sp_info,local_sp(P,CP,Envs,CPs),_) },
|
||||
{ recorded(sp_info,local_sp(_P,CP,Envs,CPs),_) },
|
||||
{ Envs = [_|_] ; CPs = [_|_] }, !,
|
||||
[nl],
|
||||
'$hacks':display_stack_info(CPs, Envs, 20, CP).
|
||||
@ -222,7 +222,7 @@ system_message(myddas_version(Version)) -->
|
||||
[ 'MYDDAS version ~a' - [Version] ].
|
||||
system_message(yes) -->
|
||||
[ 'yes' ].
|
||||
system_message(error,error(Msg,Info)) -->
|
||||
system_message(error(Msg,Info)) -->
|
||||
( { var(Msg) } ; { var(Info)} ), !,
|
||||
['bad error ~w' - [error(Msg,Info)]].
|
||||
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(DomainType, Opt).
|
||||
system_message(error(format_argument_type(Type,Arg), Where)) -->
|
||||
[ 'FORMAT ARGUMENT ERROR- ~~~a called with ~w in ~w: ' - [Type,Arg,Where]],
|
||||
domain_error(DomainType, Opt).
|
||||
[ 'FORMAT ARGUMENT ERROR- ~~~a called with ~w in ~w: ' - [Type,Arg,Where]].
|
||||
system_message(error(existence_error(directory,Key), Where)) -->
|
||||
[ 'EXISTENCE ERROR- ~w: ~w not an existing directory' - [Where,Key] ].
|
||||
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)) -->
|
||||
[ 'INSTANTIATION ERROR- ~w: expected bound value' - [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)) -->
|
||||
[ 'OPERATING SYSTEM ERROR- ~w' - [Where] ].
|
||||
system_message(error(out_of_heap_error, Where)) -->
|
||||
[ 'OUT OF DATABASE SPACE ERROR- ~w' - [Where] ].
|
||||
system_message(error(out_of_stack_error, 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] ].
|
||||
system_message(error(out_of_attvars_error, Where)) -->
|
||||
[ 'OUT OF STACK SPACE ERROR- ~w' - [Where] ].
|
||||
@ -385,7 +384,7 @@ system_message(error(unknown, Where)) -->
|
||||
[ 'EXISTENCE ERROR- procedure ~w undefined' - [Where] ].
|
||||
system_message(error(unhandled_exception,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] ].
|
||||
system_message(Messg) -->
|
||||
[ '~q' - Messg ].
|
||||
@ -431,10 +430,10 @@ domain_error(predicate_spec, Opt) --> !,
|
||||
[ '~w invalid predicate specifier' - [Opt] ].
|
||||
domain_error(radix, Opt) --> !,
|
||||
[ 'invalid radix ~w' - [Opt] ].
|
||||
vdomain_error(read_option, Opt) --> !,
|
||||
domain_error(read_option, Opt) --> !,
|
||||
[ '~w invalid option to read_term' - [Opt] ].
|
||||
domain_error(semantics_indicatior, Opt) --> !,
|
||||
[ '~w expected predicate indicator, got ~w' - [Opt] ].
|
||||
domain_error(semantics_indicator, Opt) --> !,
|
||||
[ 'predicate indicator, got ~w' - [Opt] ].
|
||||
domain_error(shift_count_overflow, Opt) --> !,
|
||||
[ 'shift count overflow in ~w' - [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, P, [at_same_line|Lines]) :- !,
|
||||
prolog:print_message_lines(_S, _, []) :- !.
|
||||
prolog:print_message_lines(_S, P, [at_same_line|Lines]) :- !,
|
||||
print_message_line(S, Lines, Rest),
|
||||
prolog:print_message_lines(S, P, Rest).
|
||||
prolog:print_message_lines(S, kind(Kind), Lines) :- !,
|
||||
@ -670,7 +669,7 @@ pred_arity((H:-_),Name,Arity) :-
|
||||
pred_arity((H-->_),Name,Arity) :- !,
|
||||
nonvar(H),
|
||||
!,
|
||||
functor(HL,Name,1),
|
||||
functor(H,Name,A1),
|
||||
Arity is A1+2.
|
||||
pred_arity(H,Name,Arity) :-
|
||||
functor(H,Name,Arity).
|
||||
|
||||
@ -481,12 +481,12 @@ of predicates.
|
||||
recorda('$system_initialisation', source_mode(New,Old), _).
|
||||
|
||||
'$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?
|
||||
(
|
||||
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),
|
||||
erase( R ),
|
||||
@ -508,7 +508,7 @@ of predicates.
|
||||
( 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, _, 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 ),
|
||||
sort( Everything0, Everything ),
|
||||
( 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:-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
|
||||
% 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) ->
|
||||
true
|
||||
;
|
||||
@ -633,7 +633,7 @@ source_module(Mod) :-
|
||||
% 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?
|
||||
% I cannot use call here because of format/3
|
||||
% modules:
|
||||
@ -642,6 +642,7 @@ source_module(Mod) :-
|
||||
% 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) :-
|
||||
var(V), !,
|
||||
( '$not_in_vars'(V,HVars)
|
||||
@ -707,7 +708,7 @@ expand_goal(G, G).
|
||||
'$do_expand'(M:G, HM, _BM, _SM, HVars, M:GI) :- !,
|
||||
nonvar(M),
|
||||
'$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),
|
||||
call(SM:goal_expansion(G, GI))
|
||||
@ -757,13 +758,13 @@ expand_goal(G, G).
|
||||
GI \== G, !,
|
||||
'$expand_modules'(GI, G1, GO, HM, BM, SM, 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.
|
||||
'$match_mod'(G, M, ORIG, HM, G1),
|
||||
'$c_built_in'(G1, M, Gi),
|
||||
'$match_mod'(G, HM, BM0, SM, G1),
|
||||
'$c_built_in'(G1, BM0, Gi),
|
||||
Gi = G2.
|
||||
'$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) :- !,
|
||||
% NG = G.
|
||||
@ -771,12 +772,12 @@ expand_goal(G, G).
|
||||
nonvar(G),
|
||||
'$system_predicate'(G,prolog),
|
||||
% \+ '$is_metapredicate'(G, prolog),
|
||||
\+ '$is_multifile'(G,H),
|
||||
\+ '$is_multifile'(G,M),
|
||||
!. % prolog: needs no module info.
|
||||
% same module as head, and body goal (I cannot get rid of qualifier before
|
||||
% meta-call.
|
||||
'$match_mod'(G, HMod, _, HM, G) :- HMod == HM, !.
|
||||
'$match_mod'(G, GMod, _, _, GMod:G).
|
||||
'$match_mod'(G, HMod, BM, _HM, G) :- HMod == BM, !.
|
||||
'$match_mod'(G, _, GMod, _, GMod:G).
|
||||
|
||||
|
||||
% be careful here not to generate an undefined exception.
|
||||
@ -951,7 +952,7 @@ meta_predicate declaration
|
||||
arg(I,NG,NA),
|
||||
I1 is I-1,
|
||||
'$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,NG,A),
|
||||
I1 is I-1,
|
||||
@ -961,11 +962,11 @@ meta_predicate declaration
|
||||
var(G), !.
|
||||
'$meta_expansion0'(M:G, _HM, _BM, SM, G1, _HVars) :-
|
||||
var(M), !,
|
||||
G1 = '$execute_wo_mod'(G,SM).
|
||||
G1 = '$execute_wo_mod'(G,M).
|
||||
% support for all/3
|
||||
'$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, M1:G1,HVars) :-
|
||||
'$meta_expansion0'(G, HM, BM, SM, G1,HVars).
|
||||
'$meta_expansion0'(G, _HM, _BM, SM, M1:G1,_HVars) :-
|
||||
strip_module(SM:G,M1,G1).
|
||||
|
||||
|
||||
@ -1003,9 +1004,9 @@ its parent goal.
|
||||
NFlags is Fl \/ 0x200004,
|
||||
'$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), !.
|
||||
'$is_mt'(_M, _H, CM, B, B, CM).
|
||||
'$is_mt'(_M, _H, CM, B, B).
|
||||
|
||||
% comma has its own problems.
|
||||
:- '$install_meta_predicate'(','(0,0), prolog).
|
||||
@ -1226,7 +1227,7 @@ export_list(Module, List) :-
|
||||
'$simple_conversion'(Exports, Tab, E).
|
||||
'$simple_conversion'([F/N as NF|Exports], [F/N-NF/N|Tab], [NF/N|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,
|
||||
'$simple_conversion'(Exports, Tab, 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
|
||||
;
|
||||
'$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'([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) :-
|
||||
functor(G,N,K),
|
||||
'$follow_import_chain'(Mod,G,M0,G0),
|
||||
G0=..[N0|Args],
|
||||
G0=..[ N|Args],
|
||||
G1=..[N1|Args],
|
||||
( '$check_import'(M0,ContextMod,N1,K) ->
|
||||
( ContextMod = user ->
|
||||
@ -1371,7 +1372,7 @@ export_list(Module, List) :-
|
||||
M2 \= M1, !,
|
||||
b_getval('$lf_status', TOpts),
|
||||
'$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'(_,_,_,_).
|
||||
|
||||
'$redefine_action'(ask, M1, M2, M, _, N/K) :-
|
||||
@ -1384,7 +1385,7 @@ export_list(Module, List) :-
|
||||
'$redefine_action'(true, M1, _, _, _, _) :- !,
|
||||
recorded('$module','$module'(F, M1, _, _MyExports,_Line),_),
|
||||
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),_),
|
||||
'$current_module'(_, M2),
|
||||
'$do_error'(permission_error(import,M1:N/K,redefined,M2),F).
|
||||
@ -1556,15 +1557,15 @@ unload_module(Mod) :-
|
||||
% remove imported modules
|
||||
unload_module(Mod) :-
|
||||
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),
|
||||
current_op(X, Y, M:Op),
|
||||
lists:member( op(X, Y, Op), Exports ),
|
||||
op(X, 0, M:Op),
|
||||
fail.
|
||||
unload_module(Mod) :-
|
||||
recorded('$module','$module'( _, Mod, _, _, Exports), R),
|
||||
lists:member( op(X, Y, Op), Exports ),
|
||||
recorded('$module','$module'( _, Mod, _, _, Exports), _),
|
||||
lists:member( op(X, _Y, Op), Exports ),
|
||||
op(X, 0, Mod:Op),
|
||||
fail.
|
||||
unload_module(Mod) :-
|
||||
|
||||
@ -179,7 +179,7 @@ Since YAP4.3.0 multifile procedures can be static or dynamic.
|
||||
**/
|
||||
multifile(P) :-
|
||||
'$current_module'(OM),
|
||||
'$multifile'(P, M).
|
||||
'$multifile'(P, OM).
|
||||
|
||||
'$multifile'(V, _) :- var(V), !,
|
||||
'$do_error'(instantiation_error,multifile(V)).
|
||||
|
||||
16
pl/preds.yap
16
pl/preds.yap
@ -228,7 +228,7 @@ assert(C) :-
|
||||
'$do_error'(instantiation_error,assert(Mod:V)).
|
||||
'$assert_dynamic'(M:C,_,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).
|
||||
'$assert_dynamic'(CI,Mod,Where,R,P) :-
|
||||
'$expand_clause'(CI,C0,C,Mod,HM),
|
||||
@ -305,7 +305,7 @@ assertz_static(C) :-
|
||||
'$do_error'(instantiation_error,assert(M:V)).
|
||||
'$assert_static'(M:C,_,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).
|
||||
'$assert_static'(CI,Mod,Where,R,P) :-
|
||||
'$expand_clause'(CI,C0,C,Mod, HM),
|
||||
@ -599,7 +599,7 @@ retract(C) :-
|
||||
% '$is_dynamic'(H,M), !,
|
||||
F /\ 0x00002000 =:= 0x00002000, !,
|
||||
'$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).
|
||||
'$retract2'(_, H,M,_,_) :-
|
||||
'$undefined'(H,M), !,
|
||||
@ -748,7 +748,7 @@ dynamic procedures. Under other modes it will abolish any procedures.
|
||||
abolish(V) :- var(V), !,
|
||||
'$do_error'(instantiation_error,abolish(V)).
|
||||
abolish(Mod:V) :- var(V), !,
|
||||
'$do_error'(instantiation_error,abolish(M:V)).
|
||||
'$do_error'(instantiation_error,abolish(Mod:V)).
|
||||
abolish(M:X) :- !,
|
||||
'$abolish'(X,M).
|
||||
abolish(X) :-
|
||||
@ -935,7 +935,7 @@ dynamic_predicate(P,Sem) :-
|
||||
'$expand_clause'((H:-B),C1,C2,Mod,HM) :- !,
|
||||
strip_module(Mod:H, HM, H1),
|
||||
'$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) ->
|
||||
'$check_iso_strict_clause'(C1)
|
||||
;
|
||||
@ -1319,11 +1319,11 @@ compile_predicates(Ps) :-
|
||||
'$compile_predicates'(M:Ps, _, Call) :-
|
||||
'$compile_predicates'(Ps, M, Call).
|
||||
'$compile_predicates'([], _, _).
|
||||
'$compile_predicates'(P.Ps, M, Call) :-
|
||||
'$compile_predicate'(P, M, Call).
|
||||
'$compile_predicates'([P|Ps], M, Call) :-
|
||||
'$compile_predicate'(P, M, Call),
|
||||
'$compile_predicates'(Ps, M, Call).
|
||||
|
||||
'$compile_predicate'(P, M, Call) :-
|
||||
'$compile_predicate'(P, _M, Call) :-
|
||||
var(P), !,
|
||||
'$do_error'(instantiation_error,Call).
|
||||
'$compile_predicate'(M:P, _, Call) :-
|
||||
|
||||
@ -220,7 +220,7 @@ showprofres(A) :-
|
||||
|
||||
'$display_preds'(_, _, _, N, N) :- !.
|
||||
'$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) :-
|
||||
Sum is -NSum,
|
||||
Perc is (100*Sum)/Tot,
|
||||
|
||||
50
pl/qly.yap
50
pl/qly.yap
@ -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
|
||||
trying goal _G_.
|
||||
**/
|
||||
save_program(File, Goal) :-
|
||||
save_program(_File, Goal) :-
|
||||
recorda('$restore_goal', Goal ,_R),
|
||||
fail.
|
||||
save_program(File, _Goal) :-
|
||||
@ -210,8 +210,8 @@ save_program(File, _Goal) :-
|
||||
'$do_error'(domain_error(qsave_program,Opt), G).
|
||||
|
||||
% there is some ordering between flags.
|
||||
'$x_yap_flag'(goal, Goal).
|
||||
'$x_yap_flag'(language, V).
|
||||
'$x_yap_flag'(goal, _Goal).
|
||||
'$x_yap_flag'(language, _V).
|
||||
'$x_yap_flag'(M:unknown, V) :-
|
||||
current_module(M),
|
||||
yap_flag(M:unknown, V).
|
||||
@ -275,7 +275,7 @@ save_program(File, _Goal) :-
|
||||
load_files(library(win_menu), [silent(true)]),
|
||||
fail.
|
||||
'$init_from_saved_state_and_args' :-
|
||||
recorded('$reload_foreign_libraries',G,R),
|
||||
recorded('$reload_foreign_libraries',_G,R),
|
||||
erase(R),
|
||||
shlib:reload_foreign_libraries,
|
||||
fail.
|
||||
@ -406,10 +406,11 @@ qsave_file(F0, State) :-
|
||||
|
||||
'$qsave_file_'(File, UserF, _State) :-
|
||||
( File == user_input -> Age = 0 ; time_file64(File, Age) ),
|
||||
'$current_module'(M),
|
||||
assert(user:'$file_property'( '$lf_loaded'( UserF, Age, M) ) ),
|
||||
'$set_owner_file'( '$file_property'( _ ), user, File ),
|
||||
fail.
|
||||
'$qsave_file_'(File, UserF, State) :-
|
||||
'$qsave_file_'(File, UserF, _State) :-
|
||||
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) ) ),
|
||||
'$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).
|
||||
|
||||
'$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 ),
|
||||
clause(M:G, Body, ClauseRef),
|
||||
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) :-
|
||||
recorded('$module', '$module'(F,Mod,Source,Exps,L), _),
|
||||
recorded('$module', '$module'(_F,Mod,Source,Exps,L), _),
|
||||
'$fetch_parents_module'(Mod, Parents),
|
||||
'$fetch_imports_module'(Mod, Imps),
|
||||
'$fetch_multi_files_module'(Mod, MFs),
|
||||
@ -508,6 +509,7 @@ qload_module(Mod) :-
|
||||
Verbosity = informational
|
||||
),
|
||||
StartMsg = loading_module,
|
||||
EndMsg = module_loaded,
|
||||
'$current_module'(SourceModule, Mod),
|
||||
H0 is heapused, '$cputime'(T0,_),
|
||||
absolute_file_name( Mod, File, [expand(true),file_type(qly)]),
|
||||
@ -558,9 +560,8 @@ qload_module(Mod) :-
|
||||
'$install_term_expansions_module'(Mod, TEs),
|
||||
% last, export everything to the host: if the loading crashed you didn't actually do
|
||||
% no evil.
|
||||
'$convert_for_export'(all, Exps, Mod, SourceModule, TranslationTab, AllExports0, qload_module),
|
||||
'$add_to_imports'(TranslationTab, Mod, SourceModule), % insert ops, at least for now
|
||||
sort( AllExports0, AllExports ).
|
||||
'$convert_for_export'(all, Exps, Mod, SourceModule, TranslationTab, _AllExports0, qload_module),
|
||||
'$add_to_imports'(TranslationTab, Mod, SourceModule). % insert ops, at least for now
|
||||
|
||||
'$fetch_imports_module'(Mod, 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.
|
||||
'$fetch_import_module'(Mod, '$import'(Mod0,Mod,G0,G,N,K) - S) :-
|
||||
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) :-
|
||||
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).
|
||||
|
||||
% 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.
|
||||
'$fetch_multi_file_module'(Mod, '$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), _) :-
|
||||
recorded('$mf','$mf_clause'(FileName,_Name,_Arity,_Module,ClauseRef), _),
|
||||
instance(R, Clause ).
|
||||
'$fetch_multi_file_module'(Mod, '$mf_clause'(FileName,_Name,_Arity,Mod,Clause), _) :-
|
||||
recorded('$mf','$mf_clause'(FileName,_Name,_Arity,Mod,ClauseRef), _),
|
||||
instance(ClauseRef, Clause ).
|
||||
|
||||
'$fetch_term_expansions_module'(Mod, TEs) :-
|
||||
findall(Info, '$fetch_term_expansion_module'(Mod, Info), TEs).
|
||||
@ -644,7 +645,7 @@ qload_module(Mod) :-
|
||||
'$restore_load_files'([]).
|
||||
'$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)
|
||||
;
|
||||
@ -682,9 +683,9 @@ qload_module(Mod) :-
|
||||
'$do_foreign'('$swi_foreign'(File, Opts, Handle), More) :-
|
||||
open_shared_object(File, Opts, Handle, 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) :-
|
||||
!,
|
||||
call_shared_object_function( NewHandle, Function),
|
||||
@ -706,6 +707,7 @@ qload_file( F0 ) :-
|
||||
Verbosity = informational
|
||||
),
|
||||
StartMsg = loading_module,
|
||||
EndMsg = module_loaded,
|
||||
'$current_module'( SourceModule ),
|
||||
H0 is heapused,
|
||||
'$cputime'(T0,_),
|
||||
@ -737,21 +739,21 @@ qload_file( F0 ) :-
|
||||
print_message(Verbosity, loaded(EndMsg, File, Mod, T, H)),
|
||||
'$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), _),
|
||||
!.
|
||||
'$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) ),
|
||||
recorda('$lf_loaded','$lf_loaded'( FilePl, Age, SourceModule), _),
|
||||
fail.
|
||||
'$qload_file'(S, _SourceModule, _File, _FilePl, _F0, _ImportList) :-
|
||||
'$qload_file_preds'(S),
|
||||
fail.
|
||||
'$qload_file'(S, SourceModule, F, FilePl, _F0, _ImportList) :-
|
||||
user:'$file_property'( '$lf_loaded'( _, Age, _ ) ),
|
||||
'$qload_file'(_S, SourceModule, F, _FilePl, _F0, _ImportList) :-
|
||||
user:'$file_property'( '$lf_loaded'( F, Age, _ ) ),
|
||||
recordaifnot('$lf_loaded','$lf_loaded'( F, Age, SourceModule), _),
|
||||
fail.
|
||||
'$qload_file'(_S, SourceModule, _File, FilePl, F0, _ImportList) :-
|
||||
'$qload_file'(_S, _SourceModule, _File, FilePl, F0, _ImportList) :-
|
||||
b_setval('$source_file', F0 ),
|
||||
'$process_directives'( FilePl ),
|
||||
fail.
|
||||
@ -768,7 +770,7 @@ qload_file( F0 ) :-
|
||||
assert( Clause ),
|
||||
fail.
|
||||
'$process_directives'( FilePl ) :-
|
||||
user:'$file_property'( directive( MG, Mode, VL, Pos ) ),
|
||||
user:'$file_property'( directive( MG, _Mode, VL, Pos ) ),
|
||||
'$set_source'( FilePl, Pos ),
|
||||
strip_module(MG, M, G),
|
||||
'$process_directive'(G, reconsult, M, VL, Pos),
|
||||
|
||||
@ -275,7 +275,7 @@ on_signal(Signal,OldAction,NewAction) :-
|
||||
on_signal(Signal, OldAction, NewAction).
|
||||
on_signal(Signal,OldAction,default) :-
|
||||
'$reset_signal'(Signal, OldAction).
|
||||
on_signal(Signal,OldAction,Action) :-
|
||||
on_signal(_Signal,_OldAction,Action) :-
|
||||
var(Action), !,
|
||||
throw(error(system_error,'Somehow the meta_predicate declarations of on_signal are subverted!')).
|
||||
on_signal(Signal,OldAction,Action) :-
|
||||
@ -318,8 +318,8 @@ alarm(Number, Goal, Left) :-
|
||||
Secs is integer(Number),
|
||||
USecs is integer((Number-Secs)*1000000) mod 1000000,
|
||||
on_signal(sig_alarm, _, Goal),
|
||||
'$alarm'(Interval, 0, Left, _).
|
||||
alarm(Interval.USecs, Goal, Left.LUSecs) :-
|
||||
'$alarm'(Secs, USecs, Left, _).
|
||||
alarm([Interval|USecs], Goal, Left.LUSecs) :-
|
||||
on_signal(sig_alarm, _, Goal),
|
||||
'$alarm'(Interval, USecs, Left, LUSecs).
|
||||
|
||||
|
||||
@ -289,9 +289,7 @@ statistics(stack_shifts,[NOfHO,NOfSO,NOfTO]) :-
|
||||
'$inform_stack_overflows'(NOfSO,_),
|
||||
'$inform_trail_overflows'(NOfTO,_).
|
||||
statistics(atoms,[NOf,SizeOf]) :-
|
||||
'$statistics_atom_info'(NOf,SizeOf),
|
||||
'$inform_stack_overflows'(NOfSO,_),
|
||||
'$inform_trail_overflows'(NOfTO,_).
|
||||
'$statistics_atom_info'(NOf,SizeOf).
|
||||
statistics(static_code,[ClauseSize, IndexSize, TreeIndexSize, ExtIndexSize, SWIndexSize]) :-
|
||||
'$statistics_db_size'(ClauseSize, TreeIndexSize, ExtIndexSize, SWIndexSize),
|
||||
IndexSize is TreeIndexSize+ ExtIndexSize+ SWIndexSize.
|
||||
|
||||
@ -283,21 +283,21 @@ table(Pred) :-
|
||||
'$do_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), !,
|
||||
functor(PredFunctor, PredName, PredArity),
|
||||
'$do_error'(resource_error(tabling,Mod:PredName/PredArity),table(Mod:PredName/PredArity)).
|
||||
'$set_table'(Mod,PredFunctor,PredModeList) :-
|
||||
'$undefined'(PredFunctor,Mod), !,
|
||||
'$c_table'(Mod,PredFunctor,PredModeList).
|
||||
'$set_table'(Mod,PredFunctor,PredModeList) :-
|
||||
'$set_table'(Mod,PredFunctor,_PredModeList) :-
|
||||
'$flags'(PredFunctor,Mod,Flags,Flags),
|
||||
Flags /\ 0x00000040 =:= 0x00000040, !.
|
||||
'$set_table'(Mod,PredFunctor,PredModeList) :-
|
||||
'$flags'(PredFunctor,Mod,Flags,Flags),
|
||||
Flags /\ 0x1991F8C0 =:= 0,
|
||||
'$c_table'(Mod,PredFunctor,PredModeList), !.
|
||||
'$set_table'(Mod,PredFunctor,PredModeList) :-
|
||||
'$set_table'(Mod,PredFunctor,_PredModeList) :-
|
||||
functor(PredFunctor,PredName,PredArity),
|
||||
'$do_error'(permission_error(modify,table,Mod:PredName/PredArity),table(Mod:PredName/PredArity)).
|
||||
|
||||
|
||||
@ -307,7 +307,7 @@ thread_create(Goal, Id, Options) :-
|
||||
'$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], _),
|
||||
( var(Stack) -> Stack = DefaultStack; 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 ).
|
||||
'$thread_option'(detached(Detached), _, _, _, _, Detached, _, _, G0) :- !,
|
||||
( 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 ).
|
||||
% succeed silently, like SWI.
|
||||
'$thread_option'(Option, _, _, _, _, _, _, _, G0).
|
||||
'$thread_option'(_Option, _, _, _, _, _, _, _, _G0).
|
||||
% '$do_error'(domain_error(thread_option,Option),G0).
|
||||
|
||||
'$record_alias_info'(_, Alias) :-
|
||||
var(Alias), !.
|
||||
'$record_alias_info'(_, 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) :-
|
||||
recorda('$thread_alias', [Id|Alias], _).
|
||||
|
||||
@ -554,7 +554,7 @@ thread_exit(Term) :-
|
||||
thread_exit(Term) :-
|
||||
throw('$thread_finished'(exited(Term))).
|
||||
|
||||
'$run_at_thread_exit'(Id0) :-
|
||||
'$run_at_thread_exit'(_Id0) :-
|
||||
'$thread_run_at_exit'(G, M),
|
||||
catch(once(M:G), _, fail),
|
||||
fail.
|
||||
@ -714,7 +714,7 @@ thread_property(Id, Prop) :-
|
||||
).
|
||||
'$thread_property'(detached(Detached), Id) :-
|
||||
( '$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_property'(stack(Stack), Id) :-
|
||||
'$thread_stacks'(Id, Stack, _, _).
|
||||
@ -824,7 +824,7 @@ Prints a table of current threads and their status.
|
||||
|
||||
*/
|
||||
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
24
pl/utils.yap
@ -66,7 +66,7 @@ a postfix operator.
|
||||
'$do_error'(domain_error(operator_priority,P),G).
|
||||
'$check_op'(_,T,_,G) :-
|
||||
\+ atom(T), !,
|
||||
'$do_error'(type_error(atom,P),G).
|
||||
'$do_error'(type_error(atom,T),G).
|
||||
'$check_op'(_,T,_,G) :-
|
||||
\+ '$associativity'(T), !,
|
||||
'$do_error'(domain_error(operator_specifier,T),G).
|
||||
@ -80,7 +80,7 @@ a postfix operator.
|
||||
'$check_top_op'(P, T, V, G) :-
|
||||
atom(V), !,
|
||||
'$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).
|
||||
|
||||
'$associativity'(xfx).
|
||||
@ -95,18 +95,18 @@ a postfix operator.
|
||||
'$check_module_for_op'(MOp, G, _) :-
|
||||
var(MOp), !,
|
||||
'$do_error'(instantiation_error,G).
|
||||
'$check_module_for_op'(M:V, G, _) :-
|
||||
'$check_module_for_op'(M:_V, G, _) :-
|
||||
var(M), !,
|
||||
'$do_error'(instantiation_error,G).
|
||||
'$check_module_for_op'(M:V, G, NV) :-
|
||||
atom(M), !,
|
||||
'$check_module_for_op'(V, G, NV).
|
||||
'$check_module_for_op'(M:V, G, _) :- !,
|
||||
'$do_error'(type_error(atom,P),G).
|
||||
'$check_module_for_op'(V, G, V).
|
||||
'$check_module_for_op'(M:_V, G, _) :- !,
|
||||
'$do_error'(type_error(atom,M),G).
|
||||
'$check_module_for_op'(V, _G, V).
|
||||
|
||||
'$check_ops'(P, T, [], G) :- !.
|
||||
'$check_ops'(P, T, Op.NV, G) :- !,
|
||||
'$check_ops'(_P, _T, [], _G) :- !.
|
||||
'$check_ops'(P, T, [Op|NV], G) :- !,
|
||||
(
|
||||
var(NV)
|
||||
->
|
||||
@ -116,7 +116,7 @@ a postfix operator.
|
||||
'$check_op_name'(P, T, NOp, 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).
|
||||
|
||||
'$check_op_name'(_,_,V,G) :-
|
||||
@ -147,7 +147,7 @@ a postfix operator.
|
||||
'$op'(P, T, A) :-
|
||||
'$op2'(P,T,A).
|
||||
|
||||
'$opl'(P, T, _, []).
|
||||
'$opl'(_P, _T, _, []).
|
||||
'$opl'(P, T, M, [A|As]) :-
|
||||
'$op2'(P, T, M:A),
|
||||
'$opl'(P, T, M, As).
|
||||
@ -316,10 +316,6 @@ simple(V) :- var(V), !.
|
||||
simple(A) :- atom(A), !.
|
||||
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_)
|
||||
|
||||
|
||||
|
||||
@ -126,7 +126,7 @@ setting and clearing this flag are given under 7.7.
|
||||
'$do_error'(instantiation_error,G).
|
||||
'$check_boolean'(true,_,_,_) :- !.
|
||||
'$check_boolean'(false,_,_,_) :- !.
|
||||
'$check_boolean'(X,B,T,G) :-
|
||||
'$check_boolean'(_X, B, T, G) :-
|
||||
'$do_error'(domain_error(B,T),G).
|
||||
|
||||
/** @defgroup IO_Sockets YAP Old Style Socket and Pipe Interface
|
||||
@ -209,7 +209,7 @@ socket_connect(Sock, Host, Read) :-
|
||||
;
|
||||
true
|
||||
),
|
||||
yap_sockets:ip_socket(Domain, Type, Protocol, Sock).
|
||||
yap_sockets:tcp_connect(Sock, Host:Read).
|
||||
|
||||
/** @pred open_pipe_streams(Read, Write)
|
||||
|
||||
@ -319,7 +319,7 @@ Like display/1, but using stream _S_ to display the term.
|
||||
|
||||
*/
|
||||
display(Stream, T) :-
|
||||
write_term(Term, T, [ignore_ops(true)]).
|
||||
write_term(Stream, T, [ignore_ops(true)]).
|
||||
|
||||
/* interface to user portray */
|
||||
'$portray'(T) :-
|
||||
@ -574,7 +574,7 @@ stream_position_data(Prop, Term, Value) :-
|
||||
'$set_default_expand'(false) :- !,
|
||||
set_value('$open_expands_filename',false).
|
||||
'$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)).
|
||||
|
||||
%%! @}
|
||||
|
||||
|
||||
Reference in New Issue
Block a user