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

bug fices

Browse Source
This commit is contained in:
Vítor Santos Costa
2016-01-03 02:06:09 +00:00
parent 7a7354fb2b
commit 661f33ac7e
133 changed files with 6000 additions and 9890 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
pl/CMakeLists.txt
View File

@@ -26,11 +26,13 @@ set(PL_SOURCES
init.yap
listing.yap
lists.yap
messages.yap
load_foreign.yap
messages.yap
meta.yap
modules.yap
os.yap
preddecls.yap
preddyns.yap
preds.yap
profile.yap
protect.yap

1
pl/absf.yap
View File

@@ -133,6 +133,7 @@ user:prolog_file_type(qly, qly).
user:prolog_file_type(A, executable) :-
current_prolog_flag(shared_object_extension, A).
/**
@pred user:file_search_path(+Name:atom, -Directory:atom) is nondet

35
pl/arith.yap
View File

@@ -155,35 +155,8 @@ do_c_built_in(X is Y, _, _, P) :-
do_c_built_in(phrase(NT,Xs), Mod, H, NTXsNil) :-
'$_arith':do_c_built_in(phrase(NT,Xs,[]), Mod, H, NTXsNil).
do_c_built_in(phrase(NT,Xs0,Xs), Mod, _, NewGoal) :-
nonvar(NT), nonvar(Mod),
'$goal_expansion_allowed'(phrase(NT,Xs0,Xs), Mod),
Goal = phrase(NT,Xs0,Xs),
catch(prolog:'$translate_rule'((pseudo_nt --> Mod: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,
NewGoal2 = NewGoal1
; ( Xs0 = Xs0c, NewGoal1 ) = NewGoal2
),
'$yap_strip_module'(Mod:NewGoal2, M, NewGoal3),
(nonvar(NewGoal3) -> NewGoal == M:NewGoal3
;
var(M) -> NewGoal = '$execute_wo_mod'(NewGoal3,M)
;
NewGoal = '$execute_in_mod'(NewGoal3,M)
).
'$c_built_in_phrase'(NT, Xs0, Xs, Mod, NewGoal ).
do_c_built_in(Comp0, _, _, R) :- % now, do it for comparisons
'$compop'(Comp0, Op, E, F),
!,
@@ -267,7 +240,7 @@ expand_expr(T, E, V) :-
% after having expanded into Q
% and giving as result P (the last argument)
expand_expr(Op, X, O, Q, Q) :-
number(X),
number(X),
catch(is( O, Op, X),_,fail), !. % do not do error handling at compile time
expand_expr(Op, X, O, Q, P) :-
'$unary_op_as_integer'(Op,IOp),
@@ -362,7 +335,7 @@ expand_expr(Op, X, Y, O, Q, P) :-
'$do_and'(Z = X, Y = W, E).
'$goal_expansion_allowed'(phrase(_NT,_Xs0,_Xs), _Mod).
'$goal_expansion_allowed'(phrase(NT,_Xs0,_Xs), Mod).
%% contains_illegal_dcgnt(+Term) is semidet.
%

10
pl/attributes.yap
View File

@@ -45,6 +45,10 @@
unbind_attvar/1,
woken_att_do/4]).
:- dynamic attributes:existing_attribute/4.
:- dynamic attributes:modules_with_attributes/1.
:- dynamic attributes:attributed_module/3.
/** @pred get_attr(+ _Var_,+ _Module_,- _Value_)
@@ -426,7 +430,7 @@ prolog:call_residue(Goal,Residue) :-
call_residue(Goal,Module,Residue) :-
prolog:call_residue_vars(Module:Goal,NewAttVars),
(
attributes:has_modules_with_attributes([_|_])
attributes:modules_with_attributes([_|_])
->
project_attributes(NewAttVars, Module:Goal)
;
@@ -444,7 +448,7 @@ project_delayed_goals(G) :-
% just try to simplify store by projecting constraints
% over query variables.
% called by top_level to find out about delayed goals
attributes:has_modules_with_attributes([_|_]), !,
attributes:modules_with_attributes([_|_]), !,
attributes:all_attvars(LAV),
LAV = [_|_],
project_attributes(LAV, G), !.
@@ -487,7 +491,7 @@ attribute_goal/2 handler.
*/
project_attributes(AllVs, G) :-
attributes:has_modules_with_attributes(LMods),
attributes:modules_with_attributes(LMods),
LMods = [_|_],
term_variables(G, InputVs),
pick_att_vars(InputVs, AttIVs),

145
pl/boot.yap
View File

@@ -186,7 +186,7 @@ list, since backtracking could not "pass through" the cut.
*/
system_module(Mod, _SysExps, _Decls) :- !,
system_module(Mod).
new_system_module(Mod).
use_system_module(_init, _SysExps) :- !.
@@ -325,8 +325,6 @@ private(_).
Succeed.
Succeeds once.
*/
true :- true.
@@ -341,7 +339,7 @@ true :- true.
repeat,
'$current_module'(Module),
( Module==user ->
'$compile_mode'(_,0)
true % '$compile_mode'(_,0)
;
format(user_error,'[~w]~n', [Module])
),
@@ -618,11 +616,17 @@ number of steps.
%
%
'$execute_command'(C,_,_,top,Source) :- var(C), !,
'$do_error'(instantiation_error,meta_call(Source)).
'$execute_command'(C,_,_,top,Source) :- number(C), !,
'$do_error'(type_error(callable,C),meta_call(Source)).
'$execute_command'(R,_,_,top,Source) :- db_reference(R), !,
'$execute_command'(C,_,_,top,Source) :-
var(C),
!,
'$do_error'(instantiation_error,meta_call(Source)).
'$execute_command'(C,_,_,top,Source) :-
number(C),
!,
'$do_error'(type_error(callable,C),meta_call(Source)).
'$execute_command'(R,_,_,top,Source) :-
db_reference(R),
!,
'$do_error'(type_error(callable,R),meta_call(Source)).
'$execute_command'(end_of_file,_,_,_,_) :- !.
'$execute_command'(Command,_,_,_,_) :-
@@ -639,11 +643,12 @@ number of steps.
O = (:- G1)
->
'$process_directive'(G1, Option, M, VL, Pos)
;
;
'$execute_commands'(O,VL,Pos,Option,O)
).
'$execute_command'((?-G), VL, Pos, Option, Source) :-
Option \= top, !,
Option \= top,
!,
'$execute_command'(G, VL, Pos, top, Source).
'$execute_command'(G, VL, Pos, Option, Source) :-
'$continue_with_command'(Option, VL, Pos, G, Source).
@@ -658,7 +663,8 @@ number of steps.
'$process_directive'(G, top, M, VL, Pos) :-
current_prolog_flag(language_mode, yap), !, /* strict_iso on */
'$process_directive'(G, consult, M, VL, Pos).
'$process_directive'(G, top, _, _, _) :- !,
'$process_directive'(G, top, _, _, _) :-
!,
'$do_error'(context_error((:- G),clause),query).
%
% allow modules
@@ -676,34 +682,42 @@ number of steps.
% ISO does not allow goals (use initialization).
%
'$process_directive'(D, _, M, _VL, _Pos) :-
current_prolog_flag(language_mode, iso), !, % ISO Prolog mode, go in and do it,
'$do_error'(context_error((:- M:D),query),directive).
current_prolog_flag(language_mode, iso),
!, % ISO Prolog mode, go in and do it,
'$do_error'(context_error((:- M:D),query),directive).
%
% but YAP and SICStus does.
%
'$process_directive'(G, Mode, M, VL, Pos) :-
( '$undefined'('$save_directive'(G, Mode, M, VL, Pos),prolog) ->
true
;
;
'$save_directive'(G, Mode, M, VL, Pos)
->
->
true
;
;
true
),
( '$execute'(M:G) -> true ; format(user_error,':- ~w:~w failed.~n',[M,G]) ).
(
'$execute'(M:G)
->
true
;
format(user_error,':- ~w:~w failed.~n',[M,G])
).
'$continue_with_command'(Where,V,'$stream_position'(C,_P,A1,A2,A3),'$source_location'(_F,L):G,Source) :- !,
'$continue_with_command'(Where,V,'$stream_position'(C,L,A1,A2,A3),G,Source).
'$continue_with_command'(Where,V,'$stream_position'(C,_P,A1,A2,A3),'$source_location'(_F,L):G,Source) :-
!,
'$continue_with_command'(Where,V,'$stream_position'(C,L,A1,A2,A3),G,Source).
'$continue_with_command'(reconsult,V,Pos,G,Source) :-
% writeln(G),
'$go_compile_clause'(G,V,Pos,reconsult,Source),
fail.
'$go_compile_clause'(G,V,Pos,reconsult,Source),
fail.
'$continue_with_command'(consult,V,Pos,G,Source) :-
'$go_compile_clause'(G,V,Pos,consult,Source),
fail.
fail.
'$continue_with_command'(top,V,_,G,_) :-
'$query'(G,V).
'$query'(G,V).
%
% not 100% compatible with SICStus Prolog, as SICStus Prolog would put
@@ -714,13 +728,13 @@ number of steps.
% Pos the source position
% N where to add first or last
% Source the original clause
'$go_compile_clause'(G,Vs,Pos, Where, Source) :-
'$go_compile_clause'(G,Vs,Pos, Where, Source) :-
'$precompile_term'(G, G0, G1),
!,
'$$compile'(G1, Where, G0, _).
'$go_compile_clause'(G,Vs,Pos, Where, Source) :-
throw(error(system, compilation_failed(G))).
'$$compile'(C, Where, C0, R) :-
'$head_and_body'( C, MH, B ),
strip_module( MH, Mod, H),
@@ -731,7 +745,6 @@ number of steps.
;
true
),
% writeln(Mod:((H:-B))),
'$compile'((H:-B), Where, C0, Mod, R).
@@ -751,9 +764,10 @@ number of steps.
'$init_as_dynamic'( asserta ).
'$init_as_dynamic'( assertz ).
'$init_as_dynamic'( consult ) :- '$nb_getval'('$assert_all',on,fail).
'$init_as_dynamic'( reconsult ) :- '$nb_getval'('$assert_all',on,fail).
'$init_as_dynamic'( consult ) :-
'$nb_getval'('$assert_all',on,fail).
'$init_as_dynamic'( reconsult ) :-
'$nb_getval'('$assert_all',on,fail).
'$check_if_reconsulted'(N,A) :-
once(recorded('$reconsulted',N/A,_)),
@@ -769,7 +783,8 @@ number of steps.
'$clear_reconsulting' :-
recorded('$reconsulted',X,Ref),
erase(Ref),
X == '$', !,
X == '$',
!,
( recorded('$reconsulting',_,R) -> erase(R) ).
'$prompt_alternatives_on'(determinism).
@@ -777,10 +792,10 @@ number of steps.
/* Executing a query */
'$query'(end_of_file,_).
'$query'(G,[]) :-
'$prompt_alternatives_on'(OPT),
( OPT = groundness ; OPT = determinism), !,
( OPT = groundness ; OPT = determinism),
!,
'$yes_no'(G,(?-)).
'$query'(G,V) :-
(
@@ -827,17 +842,17 @@ number of steps.
'$delayed_goals'(G, V, NV, LGs, NCP) :-
(
CP is '$last_choice_pt',
'$current_choice_point'(NCP1),
'$current_choice_point'(NCP1),
'$attributes':delayed_goals(G, V, NV, LGs),
'$current_choice_point'(NCP2),
'$clean_ifcp'(CP),
NCP is NCP2-NCP1
'$current_choice_point'(NCP2),
'$clean_ifcp'(CP),
NCP is NCP2-NCP1
;
copy_term_nat(V, NV),
LGs = [],
% term_factorized(V, NV, LGs),
NCP = 0
).
).
'$out_neg_answer' :-
'$early_print'( help, false),
@@ -851,7 +866,7 @@ number of steps.
'$user_call'(G, M).
'$write_query_answer_true'([]) :- !,
format(user_error,'true',[]).
format(user_error,true,[]).
'$write_query_answer_true'(_).
@@ -883,18 +898,25 @@ number of steps.
% '$add_nl_outside_console',
fail
;
C== 10 -> '$add_nl_outside_console',
( '$undefined'('$early_print'(_,_),prolog) ->
format(user_error,'yes~n', [])
;
'$early_print'(help,yes)
C== 10
->
'$add_nl_outside_console',
(
'$undefined'('$early_print'(_,_),prolog)
->
format(user_error,'yes~n', [])
;
'$early_print'(help,yes)
)
;
C== 13 ->
C== 13
->
get0(user_input,NC),
'$do_another'(NC)
;
C== -1 -> halt
C== -1
->
halt
;
skip(user_input,10), '$ask_again_for_another'
).
@@ -909,7 +931,7 @@ number of steps.
'$another'.
'$write_answer'(_,_,_) :-
flush_output,
flush_output,
fail.
'$write_answer'(Vs, LBlk, FLAnsw) :-
'$purge_dontcares'(Vs,IVs),
@@ -969,7 +991,7 @@ number of steps.
format(codes(String),Format,G).
'$write_goal_output'(var([V|VL]), First, [var([V|VL])|L], next, L) :- !,
( First = first -> true ; format(user_error,',~n',[]) ),
( First = first -> true ; format(user_error,',~n',[]) ),
format(user_error,'~a',[V]),
'$write_output_vars'(VL).
'$write_goal_output'(nonvar([V|VL],B), First, [nonvar([V|VL],B)|L], next, L) :- !,
@@ -1281,7 +1303,9 @@ not(G) :- \+ '$execute'(G).
(
'$is_metapredicate'(G,CurMod)
->
'$expand_meta_call'(CurMod:G, [], NG)
'$disable_debugging',
( '$expand_meta_call'(CurMod:G, [], NG) -> true ; true ),
'$enable_debugging'
;
NG = G
),
@@ -1331,6 +1355,11 @@ bootstrap(F) :-
!,
close(Stream).
% '$undefp'([M0|G0], Default) :-
% writeln(M0:G0),
% fail.
'$loop'(Stream,exo) :-
prolog_flag(agc_margin,Old,0),
prompt1(': '), prompt(_,' '),
@@ -1382,10 +1411,15 @@ This predicate is used by YAP for preprocessingStatus) :-
%
% split head and body, generate an error if body is unbound.
%
'$check_head_and_body'((M:H:-B),M,H,B,P) :-
'$check_head_and_body'(C,M,H,B,P) :-
'$yap_strip_module'(C,M1,(MH:-B0)),
!,
'$yap_strip_module'(M1:MH,M,H),
( M == M1 -> B = B0 ; B = M1:B0),
error:is_callable(M:H,P).
'$check_head_and_body'(M:H, M, H, true, P) :-
'$check_head_and_body'(MH, M, H, true, P) :-
'$yap_strip_module'(MH,M,H),
error:is_callable(M:H,P).
% term expansion
%
@@ -1428,10 +1462,11 @@ whenever the compilation of arithmetic expressions is in progress.
*/
expand_term(Term,Expanded) :-
( '$do_term_expansion'(Term,Expanded)
->
true
;
(
'$do_term_expansion'(Term,Expanded)
->
true
;
'$expand_term_grammar'(Term,Expanded)
).

17
pl/consult.yap
View File

@@ -825,7 +825,6 @@ nb_setval('$if_le1vel',0).
true
; format(user_error,':- ~w:~w failed.~n',[M,G])
),
stop_low_level_trace,
fail.
'$exec_initialization_goals'.
@@ -884,7 +883,7 @@ nb_setval('$if_le1vel',0).
'$init_win_graphics',
fail.
'$do_startup_reconsult'(X) :-
catch(load_files(user:X, [silent(true)]), Error, '$LoopError'(Error)),
catch(load_files(user:X, [silent(true)]), Error, '$LoopError'(Error, consult)),
!,
( current_prolog_flag(halt_after_consult, false) -> true ; halt).
'$do_startup_reconsult'(_).
@@ -1411,14 +1410,16 @@ Similar to initialization/1, but allows for specifying when
*/
initialization(G0,OPT) :-
expand_goal(G0, G),
catch('$initialization'(G, OPT), Error, '$LoopError'( Error ) ),
catch('$initialization'(G, OPT), Error, '$LoopError'( Error, consult ) ),
fail.
initialization(_G,_OPT).
initialization(_G,_OPT) :-
stop_low_level_trace.
'$initialization'(G,OPT) :-
error:must_be_of_type(callable, G, initialization(G,OPT)),
error:must_be_of_type(oneof([after_load, now, restore]), OPT, initialization(G0,OPT)),
(
error:must_be_of_type(callable, G, initialization(G,OPT)),
error:must_be_of_type(oneof([after_load, now, restore]),
OPT, initialization(G0,OPT)),
(
OPT == now
->
( call(G) -> true ; format(user_error,':- ~w:~w failed.~n',[G]) )
@@ -1431,7 +1432,7 @@ initialization(_G,_OPT).
->
recordz('$call_at_restore', G, _ )
).
:- .
/**
@}

123
pl/debug.yap
View File

@@ -301,13 +301,14 @@ be lost.
'$trace_meta_call'( G, M, CP ) :-
'$do_spy'(G, M, CP, spy ).
% last argument to do_spy says that we are at the end of a context. It
% is required to know whether we are controlled by the debugger.
%'$do_spy'(V, M, CP, Flag) :-
% writeln('$do_spy'(V, M, CP, Flag)), fail.
'$do_spy'(V, M, CP, Flag) :-
'$stop_creeping',
'$stop_low_level_trace',
'$stop_creeping'(_),
var(V), !,
'$do_spy'(call(V), M, CP, Flag).
'$do_spy'(!, _, CP, _) :-
@@ -324,7 +325,7 @@ be lost.
'$do_spy'((T->A;B), M, CP, CalledFromDebugger) :- !,
( '$do_spy'(T, M, CP, debugger) -> '$do_spy'(A, M, CP, CalledFromDebugger)
;
'$do_spy'(B, M, CP, CalledFromDebugger)
).
'$do_spy'((T->A|B), M, CP, CalledFromDebugger) :- !,
@@ -333,7 +334,7 @@ be lost.
->
'$do_spy'(A, M, CP, CalledFromDebugger)
;
'$stop_creeping',
'stop_creeping'(_),
'$do_spy'(B, M, CP, CalledFromDebugger)
).
'$do_spy'((T->A), M, CP, CalledFromDebugger) :- !,
@@ -342,14 +343,14 @@ be lost.
(
'$do_spy'(A, M, CP, CalledFromDebugger)
;
'$stop_creeping',
'$stop_creeping'(_),
'$do_spy'(B, M, CP, CalledFromDebugger)
).
'$do_spy'((A|B), M, CP, CalledFromDebugger) :- !,
(
'$do_spy'(A, M, CP, CalledFromDebugger )
;
'$stop_creeping',
'$stop_creeping'(_) ,
'$do_spy'(B, M, CP, CalledFromDebugger )
).
'$do_spy'((\+G), M, CP, CalledFromDebugger) :- !,
@@ -412,17 +413,17 @@ be lost.
'$continue_debugging'(fail, CalledFromDebugger),
fail.
/**
/**
* core routine for the debugger
*
*
* @param _ GoalNumbera id
* @param _ S9c
* @param _
* @param Retry
* @param Det
* @param false
*
* @return
* @param _
* @param Retry
* @param Det
* @param false
*
* @return
*/
'$loop_spy2'(GoalNumber, G, Module, CalledFromDebugger, CP) :-
/* the following choice point is where the predicate is called */
@@ -432,7 +433,7 @@ be lost.
/* call port */
'$enter_goal'(GoalNumber, G, Module),
'$spycall'(G, Module, CalledFromDebugger, Retry),
'$stop_creeping',
'$stop_creeping'(_) ,
% make sure we are in system mode when running the debugger.
(
'$debugger_deterministic_goal'(G) ->
@@ -465,7 +466,7 @@ be lost.
(
arg(6, Info, true)
->
'$stop_creeping',
'$stop_creeping'(_) ,
'$show_trace'(redo,G,Module,GoalNumber,_), /* inform user_error */
nb_setarg(6, Info, false)
;
@@ -475,7 +476,7 @@ be lost.
fail /* to backtrack to spycall */
)
;
'$stop_creeping',
'$stop_creeping'(_) ,
'$show_trace'(fail,G,Module,GoalNumber,_), /* inform at fail port */
'$continue_debugging'(fail, CalledFromDebugger),
/* fail port */
@@ -532,54 +533,45 @@ be lost.
),
'$execute_nonstop'(G1,M).
'$spycall'(G, M, _, _) :-
(
'$system_predicate'(G,M)
;
'$system_module'(M)
),
'$is_metapredicate'(G, M),
!,
( '$is_metapredicate'(G, M)
->
'$expand_meta_call'(M:G, [], G10),
'$debugger_process_meta_arguments'(G10, M, G1),
'$execute'(M:G1)
;
'$execute'(M:G)
).
'$expand_meta_call'(M:G, [], G10),
G10 \== M:G,
CP is '$last_choice_pt',
'$debugger_input',
G10 = NM:NG,
'$do_spy'(NG, NM, CP, spy).
'$spycall'(G, M, _, _) :-
'$tabled_predicate'(G,M),
!,
'$continue_debugging_goal'(no, '$execute_nonstop'(G,M)).
'$spycall'(G, M, CalledFromDebugger, InRedo) :-
'$is_metapredicate'(G, M), !,
'$expand_meta_call'(M:G, [], G1),
'$spycall_expanded'(G1, M, CalledFromDebugger, InRedo).
'$spycall'(G, M, CalledFromDebugger, InRedo) :-
'$spycall_expanded'(G, M, CalledFromDebugger, InRedo).
'$spycall_expanded'(G, M, _CalledFromDebugger, InRedo) :-
'$predicate_flags'(G,M,F,F),
F /\ 0x08402000 =\= 0, !, % dynamic procedure, logical semantics, or source
% use the interpreter
CP is '$last_choice_pt',
'$clause'(G, M, Cl, _),
% I may backtrack to here from far away
( '$do_spy'(Cl, M, CP, debugger) ; InRedo = true ).
'$spycall_expanded'(G, M, CalledFromDebugger, InRedo) :-
'$undefined'(G, M), !,
'$get_undefined_pred'(G, M, Goal, NM), NM \= M,
'$spycall'(Goal, NM, CalledFromDebugger, InRedo).
'$spycall_expanded'(G, M, _, InRedo) :-
% I lost control here.
'$spycall_expanded'(G, M, _CalledFromDebugger, InRedo) :-
CP is '$last_choice_pt',
'$static_clause'(G,M,_,R),
'$stop_creeping',
% I may backtrack to here from far away
(
'$continue_debugging_goal'(no, '$execute_clause'(G, M, R, CP))
;
InRedo = true
).
'$is_source'( G, M ) % use the interpreter
->
'$clause'(G, M, Cl, _),
% I may backtrack to here from far away
( '$do_spy'(Cl, M, CP, debugger) ; InRedo = true )
;
(
'$static_clause'(G,M,_,R),
'$stop_creeping'(_) ,
% I may backtrack to here from far away
(
'$continue_debugging_goal'(no, '$execute_clause'(G, M, R, CP))
;
InRedo = true
)
)
).
%
%
@@ -590,9 +582,9 @@ be lost.
'$execute_clause'(G,Mod,Ref,CP),
'$$save_by'(CP2),
(CP1 == CP2 -> ! ; ( true ; '$creep', fail ) ),
'$stop_creeping'
'$stop_creeping'(_)
;
'$stop_creeping',
'$stop_creeping'(_) ,
fail
).
'$creep'(G,M) :-
@@ -602,17 +594,17 @@ be lost.
'$execute_nonstop'(G,M),
'$$save_by'(CP2),
(CP1 == CP2 -> ! ; ( true ; '$creep', fail ) ),
'$stop_creeping'
'$stop_creeping'(_)
;
fail
).
/**
/**
* call predicate M:G within the ddebugger
*
*
* @return
*
*
* @return
*/
'$trace'(G,M) :-
(
@@ -711,10 +703,17 @@ be lost.
set_prolog_flag(debug, OldDeb),
% '$skipeol'(0'!), % '
fail.
'$action'(0'<,_,_,_,_,_) :- !, % <'Depth
'$new_deb_depth',
'$skipeol'(0'<),
fail.
'$action'(0'<,_,_,_,_,_) :- !, % <'Depth
'$new_deb_depth',
'$skipeol'(0'<),
fail.
'$action'(0'C,_,_,_,_,_) :-
yap_flag(system_options, Opts),
memberchk( call_tracer, Opts),
!, % <'Depth
'$skipeol'(0'C),
'$start_low_level_trace',
'__NB_setval__'('$debug_jump',false).
'$action'(0'^,_,_,G,_,_) :- !, % '
'$print_deb_sterm'(G),
'$skipeol'(0'^),

4
pl/error.yap
View File

@@ -17,7 +17,7 @@
domain_error/3, % +Domain, +Values, +Term
existence_error/2, % +Type, +Term
permission_error/3, % +Action, +Type, +Term
must_be_instantiated/1, % +Term
must_be_instantiated/1, % +Term
instantiation_error/1, % +Term
representation_error/1, % +Reason
is_of_type/2 % +Type, +Term
@@ -106,7 +106,7 @@ must_be_of_type(Type, X) :-
; is_not(Type, X)
).
inline(must_be_of_type( callable, X ), error:is_callable(X, _) ).
inline(must_be_of_type( callable, X ), error:is_callable(X, _) ).
must_be_of_type(callable, X, Comment) :-
!,

57
pl/grammar.yap
View File

@@ -85,6 +85,8 @@ Grammar related built-in predicates:
:- use_system_module( '$_errors', ['$do_error'/2]).
:- use_module( library( expand_macros ) ).
% :- meta_predicate ^(?,0,?).
% ^(Xs, Goal, Xs) :- call(Goal).
@@ -100,15 +102,15 @@ Grammar related built-in predicates:
prolog:'$translate_rule'(Rule, (NH :- B) ) :-
source_module( SM ),
'$yap_strip_module'( SM:Rule, M0, (LP-->RP) ),
t_head(LP, NH0, NGs, S, SR, (LP-->M:RP)),
t_head(LP, NH0, NGs, S, SR, (LP-->SM:RP)),
'$yap_strip_module'( M0:NH0, M, NH1 ),
( M == SM -> NH = NH1, B = B0 ; NH = M:NH1, B = M:B0 ),
( M == SM -> NH = NH1 ; NH = M:NH1 ),
(var(NGs) ->
t_body(RP, _, last, S, SR, B1)
;
t_body((RP,{NGs}), _, last, S, SR, B1)
),
t_tidy(B1, B0).
t_tidy(B1, B).
t_head(V, _, _, _, _, G0) :- var(V), !,
@@ -265,6 +267,55 @@ prolog:'\\+'(A, S0, S) :-
t_body(\+ A, _, last, S0, S, Goal),
'$execute'(Goal).
:- multifile system:goal_expansion/2.
:- dynamic system:goal_expansion/2.
'$c_built_in_phrase'(NT, Xs0, Xs, Mod, NewGoal) :-
catch(prolog:'$translate_rule'(
(pseudo_nt --> Mod: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,
NewGoal2 = NewGoal1
; ( Xs0 = Xs0c, NewGoal1 ) = NewGoal2
),
'$yap_strip_module'(Mod:NewGoal2, M, NewGoal3),
(nonvar(NewGoal3) -> NewGoal = M:NewGoal3
;
var(M) -> NewGoal = '$execute_wo_mod'(NewGoal3,M)
;
NewGoal = '$execute_in_mod'(NewGoal3,M)
).
allowed_module(phrase(_,_),_).
allowed_module(phrase(_,_,_),_).
system:goal_expansion(Mod:phrase(NT,Xs, Xs),Mod:NewGoal) :-
source_module(M),
nonvar(NT), nonvar(Mod),
'$goal_expansion_allowed',
'$c_built_in_phrase'(NT, Xs0, Xs, Mod, NewGoal).
system:goal_expansion(Mod:phrase(NT,Xs0),Mod:NewGoal) :-
source_module(M),
nonvar(NT), nonvar(Mod),
'$goal_expansion_allowed',
'$c_built_in_phrase'(NT, [], Xs, Mod, NewGoal).
/**
@}

15
pl/init.yap
View File

@@ -22,7 +22,6 @@
@{
*/
:- system_module( '$_init', [!/0,
(:-)/1,
(?-)/1,
@@ -44,17 +43,18 @@
:- use_system_module( '$_boot', ['$cut_by'/1]).
% This is yap's init file
% This is the YAP init file
% should be consulted first step after booting
% These are pseudo declarations
% so that the user will get a redefining system predicate
:- '$init_pred_flag_vals'('$flag_info'(a,0), prolog).
/** @pred fail is iso
Always fails.
*/
fail :- fail.
@@ -160,7 +160,6 @@ print_message(Level, Msg) :-
'preds.yap',
'modules.yap'
].
:- stop_low_level_trace.
:- use_module('error.yap').
:- use_module('grammar.yap').
@@ -281,7 +280,6 @@ yap_hacks:cut_by(CP) :- '$$cut_by'(CP).
:- set_prolog_flag(generate_debug_info,true).
%
% cleanup ensure loaded and recover some data-base space.
%
@@ -291,7 +289,7 @@ yap_hacks:cut_by(CP) :- '$$cut_by'(CP).
:- set_value('$user_module',user), '$protect'.
:- style_check([-discontiguous,-multiple,-single_var]).
:- style_check([+discontiguous,+multiple,+single_var]).
%
% moved this to init_gc in gc.c to separate the alpha
@@ -376,6 +374,7 @@ If this hook predicate succeeds it must instantiate the _Action_ argument to th
Add some tests
*/
:- yap_flag(user:unknown,error).
:- stream_property(user_input, tty(true)) -> set_prolog_flag(readline, true) ; true.

3
pl/listing.yap
View File

@@ -59,9 +59,10 @@ name starts with a `$` character.
listing :-
current_output(Stream),
'$current_module'(Mod),
\+ system_module(Mod),
Mod \= prolog,
Mod \= system,
\+ '$hidden'( Mod ),
\+ '$hidden_atom'( Mod ),
'$current_predicate'(_,Mod,Pred, user),
'$undefined'(Pred, prolog), % skip predicates exported from prolog.
functor(Pred,Name,Arity),

30
pl/lists.yap
View File

@@ -2,9 +2,9 @@
* @file pl/lists.yap
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Thu Nov 19 09:54:00 2015
*
* @brief core lisy operations
*
*
* @brief core list operations
*
* @ingroup lists
* @{
*/
@@ -17,41 +17,40 @@
% means the same thing, but may only be used to test whether a known
% Element occurs in a known Set. In return for this limited use, it
% is more efficient when it is applicable.
/** @pred memberchk(+ _Element_, + _Set_)
/** @pred memberchk(+ _Element_, + _Set_)
As member/2, but may only be used to test whether a known
_Element_ occurs in a known Set. In return for this limited use, it
is more efficient when it is applicable.
*/
lists:memberchk(X,[X|_]) :- !.
lists:memberchk(X,[_|L]) :-
lists:memberchk(X,L).
% member(?Element, ?Set)
%% member(?Element, ?Set)
% is true when Set is a list, and Element occurs in it. It may be used
% to test for an element or to enumerate all the elements by backtracking.
% Indeed, it may be used to generate the Set!
/** @pred member(? _Element_, ? _Set_)
/** @pred member(? _Element_, ? _Set_)
True when _Set_ is a list, and _Element_ occurs in it. It may be used
to test for an element or to enumerate all the elements by backtracking.
*/
lists:member(X,[X|_]).
lists:member(X,[_|L]) :-
lists:member(X,L).
%% @pred identical_member(?Element, ?Set) is nondet
%
% identical_member holds true when Set is a list, and Element is
% exactly identical to one of the elements that occurs in it.
% exactly identical to one of the elements that occurs in it.
lists:identical_member(X,[Y|M]) :-
(
@@ -60,14 +59,14 @@ lists:identical_member(X,[Y|M]) :-
M \= [], lists:identical_member(X,M)
).
/** @pred append(? _List1_,? _List2_,? _List3_)
/** @pred append(? _List1_,? _List2_,? _List3_)
Succeeds when _List3_ unifies with the concatenation of _List1_
and _List2_. The predicate can be used with any instantiation
pattern (even three variables).
*/
lists:append([], L, L).
lists:append([H|T], L, [H|R]) :-
@@ -80,14 +79,14 @@ lists:append([H|T], L, [H|R]) :-
% is true when List is a list, in which Elem may or may not occur, and
% Residue is a copy of List with all elements identical to Elem lists:deleted.
/** @pred delete(+ _List_, ? _Element_, ? _Residue_)
/** @pred delete(+ _List_, ? _Element_, ? _Residue_)
eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee
True when _List_ is a list, in which _Element_ may or may not
occur, and _Residue_ is a copy of _List_ with all elements
identical to _Element_ deleted.
eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee
eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee
*/
lists:delete([], _, []).
lists:delete([Head|List], Elem, Residue) :-
@@ -140,4 +139,3 @@ prolog:length(L, M) :-
M is N + 1, NL = [_|L], '$$_length2'(L, O, M) ).
%% @}

1
pl/load_foreign.yap
View File

@@ -52,6 +52,7 @@ YAP also supports the SWI-Prolog interface to loading foreign code:
*/
load_foreign_files(Objs,Libs,Entry) :-
source_module(M),
'$check_objs_for_load_foreign_files'(Objs,NewObjs,load_foreign_files(Objs,Libs,Entry)),
'$check_libs_for_load_foreign_files'(Libs,NewLibs,load_foreign_files(Objs,Libs,Entry)),
'$check_entry_for_load_foreign_files'(Entry,load_foreign_files(Objs,Libs,Entry)),

222
pl/meta.yap
View File

@@ -64,7 +64,7 @@ meta_predicate declaration
'$is_mt'(H, B, HM, _SM, M, (context_module(CM),B), CM) :-
'$yap_strip_module'(HM:H, M, NH),
'$module_transparent'(_, M, _, NH), !.
'$is_mt'(_H, B, HM, _SM, BM, B, BM).
'$is_mt'(_H, B, _HM, _SM, BM, B, BM).
@@ -115,7 +115,7 @@ meta_predicate declaration
'$do_module_u_vars'(0,_,_,[]) :- !.
'$do_module_u_vars'(I,D,H,LF) :-
arg(I,D,X), ( X=':' ; integer(X)),
arg(I,D,X), ( X=':' -> true ; integer(X)),
arg(I,H,A), '$uvar'(A, LF, L), !,
I1 is I-1,
'$do_module_u_vars'(I1,D,H,L).
@@ -130,6 +130,50 @@ meta_predicate declaration
'$uvar'('^'( _, G), LF, L) :-
'$uvar'(G, LF, L).
/**
* @pred '$meta_expand'( _Input_, _HeadModule_, _BodyModule_, _SourceModule_, _HVars_-_Head_, _OutGoal_)
*
* expand Input if a metapredicate, otherwF,MI,Arity,PredDefise ignore
*
* @return
*/
'$meta_expand'(G, _, CM, HVars, OG) :-
var(G),
!,
(
lists:identical_member(G, HVars)
->
OG = G
;
OG = CM:G
).
% nothing I can do here:
'$meta_expand'(G0, PredDef, CM, HVars, NG) :-
G0 =.. [Name|GArgs],
PredDef =.. [Name|GDefs],
functor(PredDef, Name, Arity ),
length(NGArgs, Arity),
NG =.. [Name|NGArgs],
'$expand_args'(GArgs, CM, GDefs, HVars, NGArgs).
'$expand_args'([], _, [], _, []).
'$expand_args'([A|GArgs], CM, [M|GDefs], HVars, [NA|NGArgs]) :-
( M == ':' -> true ; number(M) ),
!,
'$expand_arg'(A, CM, HVars, NA),
'$expand_args'(GArgs, CM, GDefs, HVars, NGArgs).
'$expand_args'([A|GArgs], CM, [_|GDefs], HVars, [A|NGArgs]) :-
'$expand_args'(GArgs, CM, GDefs, HVars, NGArgs).
% check if an argument should be expanded
'$expand_arg'(G, CM, HVars, OG) :-
var(G),
!,
( lists:identical_member(G, HVars) -> OG = G; OG = CM:G).
'$expand_arg'(G, CM, _HVars, NCM:NG) :-
'$yap_strip_module'(CM:G, NCM, NG).
% expand module names in a body
% args are:
% goals to expand
@@ -171,25 +215,31 @@ meta_predicate declaration
!,
( lists:identical_member(V, HVars)
->
'$expand_goals'(call(V),NG,NGO,HM,SM,BM,HVars-H)
'$expand_goals'(call(V),NG,NGO,HM,SM,BM,HVars-H)
;
( atom(BM)
->
NG = call(BM:V),
NGO = '$execute_in_mod'(V,BM)
;
'$expand_goals'(call(BM:V),NG,NGO,HM,SM,BM,HVars-H)
;
'$expand_goals'(call(BM:V),NG,NGO,HM,SM,BM,HVars-H)
)
).
).
'$expand_goals'(BM:V,NG,NGO,HM,SM,_BM,HVarsH) :-
!,
'$yap_strip_module'( BM:V, CM, G),
'$expand_goals'(G,NG,NGO,HM,SM,CM,HVarsH).
'$yap_strip_module'( BM:V, CM, G),
nonvar(CM),
!,
'$expand_goals'(G,NG,NGO,HM,SM,CM,HVarsH).
'$expand_goals'(CM0:V,NG,NGO,HM,SM,BM,HVarsH) :-
strip_module( CM0:V, CM, G),
!,
'$expand_goals'(call(CM:G),NG,NGO,HM,SM,BM,HVarsH).
% if I don't know what the module is, I cannot do anything to the goal,
% so I just put a call for later on.
'$expand_goals'(V,NG,NGO,_HM,_SM,BM,_HVarsH) :-
var(BM),
!,
!,
NG = call(BM:V),
NGO = '$execute_wo_mod'(V,BM).
'$expand_goals'(depth_bound_call(G,D),
@@ -268,21 +318,30 @@ meta_predicate declaration
'$expand_goals'(true,true,true,_,_,_,_) :- !.
'$expand_goals'(fail,fail,fail,_,_,_,_) :- !.
'$expand_goals'(false,false,false,_,_,_,_) :- !.
'$expand_goals'(M:G,call(M:G),
'$execute_wo_mod'(G,M),_,_,_,_) :-
var(M),
!.
'$expand_goals'(G, G1, GO, HM, SM, BM, HVars) :-
'$yap_strip_module'(BM:G, NBM, GM),
'$do_expand_goals'(NBM:GM, G1, GO, HM, SM, BM, HVars).
'$expand_goal'(GM, G1, GO, HM, SM, NBM, HVars).
'$do_expand_goals'(V:G, call(V:G), call(V:G), HM, SM, BM, HVars) :-
var(V), !.
'$do_expand_goals'(G, G1, GO, HM, SM, BM, HVarsH) :-
'$yap_strip_module'(BM:G, NBM, GM),
'$do_expand_goal'(GM, G1, GO, HM, SM, NBM, HVarsH).
'$user_expansion'(MG, M2:G2) :-
'_user_expand_goal'(MG, MG2),
!,
'$yap_strip_module'( MG2, M2, G2).
'$user_expansion'(MG, MG).
/**
'$import_expansion'(M:G, M1:G1) :-
'$imported_predicate'(G, M, G1, M1),
!.
'$import_expansion'(MG, MG).
'$meta_expansion'(GM:G, BM, HVars, GM:GF) :-
functor(G, F, Arity ),
'$meta_predicate'(F, GM, Arity, PredDef),
!,
'$meta_expand'(G, PredDef, BM, HVars, GF).
'$meta_expansion'(GM:G, _BM, _HVars, GM:G).
/**
* @brief Perform meta-variable and user expansion on a goal _G_
*
* given the example
@@ -300,99 +359,36 @@ o:p(B) :- n:g, X is 2+3, call(B).
* @param HM source module, input, m
* @param M current module, input, `n`, `m`, `m`
* @param HVars-H, list of meta-variables and initial head, `[]` and `p(B)`
*
*
*
*
*/
'$expand_goal'(GM, G1F, GOF, HM, SM, BM, HVarsH) :-
'$yap_strip_module'(BM:GM, M, G),
'$do_expand_goal'(G, G1F, GOF, HM, SM, M, HVarsH).
'$expand_goal'(G0, G1F, GOF, HM, SM, BM, HVars-H) :-
'$yap_strip_module'( BM:G0, M0N, G0N),
'$user_expansion'(M0N:G0N, M1:G1),
'$import_expansion'(M1:G1, M2:G2),
'$meta_expansion'(M2:G2, M1, HVars, M2:B1F),
'$end_goal_expansion'(B1F, G1F, GOF, HM, SM, M2, H).
'$do_expand_goal'(G, G1F, GOF, HM, SM, BM, HVarsH) :-
'_user_expand_goal'(BM:G, BMG2), !,
'$yap_strip_module'( BMG2, BM2, G2),
'$new_cycle_of_goal_expansion'( G2, BM:G, G1F, GOF, HM, SM, BM2, HVarsH).
'$do_expand_goal'(G, G1F, GOF, HM, SM, BM, HVars-H) :-
% expand import table, to avoid overheads
(
'$imported_predicate'(G, BM, GI, MI)
->
true
;
GI = G,
MI = BM
),
% expand meta-arguments using the call module, BM, not the actual built-in module, MI
(
functor(GI, F, Arity ),
'$meta_predicate'(F,MI,Arity,PredDef)
->
'$meta_expand'(GI, PredDef, HM, SM, BM, HVars, GG)
;
GI = GG
),
'$end_goal_expansion'(GG, G1F, GOF, HM, SM, MI, H).
/**
* @pred '$meta_expand'( _Input_, _HeadModule_, _BodyModule_, _SourceModule_, _HVars_-_Head_, _OutGoal_)
1 *
* expand Input if a metapredicate, otherwF,MI,Arity,PredDefise ignore
*
* @return
*/
'$meta_expand'(G, _, _HM, _SM, CM, HVars, OG) :-
var(G),
!,
(
lists:identical_member(G, HVars)
->
OG = G
;
OG = CM:G
).
% nothing I can do here:
'$meta_expand'(G0, PredDef, HM, SM, CM, HVars, NG) :-
G0 =.. [Name|GArgs],
PredDef =.. [Name|GDefs],
functor(PredDef, Name, Arity ),
length(NGArgs, Arity),
NG =.. [Name|NGArgs],
'$expand_args'(GArgs, HM, SM, CM, GDefs, HVars, NGArgs).
'$expand_args'([], _, _ , _, [], _, []).
'$expand_args'([A|GArgs], HM, SM, CM, [M|GDefs], HVars, [NA|NGArgs]) :-
( M == ':' -> true ; number(M) ),
!,
'$expand_arg'(A, HM, SM, CM, HVars, NA),
'$expand_args'(GArgs, HM, SM, CM, GDefs, HVars, NGArgs).
'$expand_args'([A|GArgs], HM, SM, CM, [_|GDefs], HVars, [A|NGArgs]) :-
'$expand_args'(GArgs, HM, SM, CM, GDefs, HVars, NGArgs).
% check if an argument should be expanded
'$expand_arg'(G, _HM, _SM, CM, HVars, OG) :-
var(G),
!,
( lists:identical_member(G, HVars) -> OG = G; OG = CM:G).
'$expand_arg'(G, _HM, _SM, CM, _HVars, NCM:NG) :-
'$yap_strip_module'(CM:G, NCM, NG).
'$end_goal_expansion'(G, G1F, GOF, HM, SM, BM, H) :-
'$match_mod'(G, HM, SM, BM, G1F),
'$c_built_in'(G1F, BM, H, GO),
'$yap_strip_module'(BM:GO, MO, IGO),
'$match_mod'(IGO, HM, SM, MO, GOF).
'$new_cycle_of_goal_expansion'( G, BM:G1, G1F, GOF, HM, SM, M, HVarsH) :-
BM:G1 \== M:G,
!,
'$expand_goals'(G, G1F, GOF, HM, SM, BM, HVarsH).
'$user_expansion'(M0N:G0N, M1:G1) :-
'_user_expand_goal'(M0N:G0N, M:G),
( M:G == M0N:G0N
->
M1:G1 = M:G
;
'$user_expansion'(M:G, M1:G1)
).
'$match_mod'(G, HMod, SMod, M, O) :-
'$match_mod'(G, HMod, SMod, M, O) :-
(
% \+ '$is_multifile'(G1,M),
%->
'$system_predicate'(G,prolog)
'$is_system_predicate'(G,prolog)
->
O = G
;
@@ -403,20 +399,11 @@ o:p(B) :- n:g, X is 2+3, call(B).
O = M:G
).
expand_goal(Input, Output) :-
'$expand_meta_call'(Input, [], Output ).
'$expand_meta_call'(G, HVars, MF:GF ) :-
source_module(SM),
'$yap_strip_module'(SM:G, M, IG),
'$expand_goals'(IG, _, GF0, M, SM, M, HVars-G),
'$yap_strip_module'(M:GF0, MF, GF).
'$build_up'(HM, NH, SM, true, NH, true, NH) :- HM == SM, !.
'$build_up'(HM, NH, _SM, true, HM:NH, true, HM:NH) :- !.
'$build_up'(HM, NH, SM, B1, (NH :- B1), BO, ( NH :- BO)) :- HM == SM, !.
'$build_up'(HM, NH, _SM, B1, (HM:NH :- B1), BO, ( HM:NH :- BO)) :- !.
'$expand_clause_body'(true, _NH1, _HM1, _SM, _M, true, true ) :- !.
'$expand_clause_body'(B, H, HM, SM, M, B1, BO ) :-
'$module_u_vars'(HM , H, UVars), % collect head variables in
@@ -447,7 +434,7 @@ expand_goal(Input, Output) :-
'$verify_import'(_M:G, prolog:G) :-
'$system_predicate'(G, prolog).
'$is_system_predicate'(G, prolog).
'$verify_import'(M:G, NM:NG) :-
'$get_undefined_pred'(G, M, NG, NM),
!.
@@ -480,6 +467,15 @@ expand_goal(Input, Output) :-
'$build_up'(HM, NH, SM0, B1, Cl1, BO, ClO).
expand_goal(Input, Output) :-
'$expand_meta_call'(Input, [], Output ).
'$expand_meta_call'(G, HVars, MF:GF ) :-
source_module(SM),
'$yap_strip_module'(SM:G, M, IG),
'$expand_goals'(IG, _, GF0, M, SM, M, HVars-G),
'$yap_strip_module'(M:GF0, MF, GF).
:- '$meta_predicate'(prolog:(
abolish(:),
abolish(:,+),

21
pl/modules.yap
View File

@@ -230,7 +230,6 @@ Unfortunately it is still not possible to change argument order.
use_module(F,Is) :-
'$load_files'(F, [if(not_loaded),must_be_module(true),imports(Is)], use_module(F,Is)).
'$module'(O,N,P,Opts) :- !,
'$module'(O,N,P),
'$process_module_decls_options'(Opts,module(Opts,N,P)).
@@ -303,16 +302,20 @@ module is called, or as soon as it becomes the current type-in module.
*/
current_module(Mod) :-
'$all_current_modules'(Mod),
\+ prolog:'$system_module'(Mod).
\+ '$hidden_atom'(Mod).
/** @pred current_module( ? Mod:atom, ? _F_ : file ) is nondet
Succeeds if _M_ is a module associated with the file _F_, that is, if _File_ is the source for _M_. If _M_ is not declared in a file, _F_ unifies with `user`.
*/
current_module(Mod,TFN) :-
'$all_current_modules'(Mod),
( atom(Mod) -> true ; '$all_current_modules'(Mod) ),
( recorded('$module','$module'(TFN,Mod,_,_Publics, _),_) -> true ; TFN = user ).
system_module(Mod) :-
( atom(Mod) -> true ; '$all_current_modules'(Mod) ),
'$is_system_module'(Mod).
'$trace_module'(X) :-
telling(F),
tell('P0:debug'),
@@ -345,7 +348,7 @@ current_module(Mod,TFN) :-
% be careful here not to generate an undefined exception.
'$imported_predicate'(G, ImportingMod, G, prolog) :-
'$system_predicate'(G, prolog), !.
nonvar(G), '$is_system_predicate'(G, prolog), !.
'$imported_predicate'(G, ImportingMod, G0, ExportingMod) :-
( var(G) -> true ;
var(ImportingMod) -> true ;
@@ -365,7 +368,7 @@ current_module(Mod,TFN) :-
'$pred_exists'(G, user), !.
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod) :-
recorded('$dialect',swi,_),
get_prolog_flag(autoload, true),
prolog_flag(autoload, true),
prolog_flag(unknown, OldUnk, fail),
(
'$autoload'(G, ImportingMod, ExportingModI, swi)
@@ -385,6 +388,7 @@ current_module(Mod,TFN) :-
'$autoload'(G, _ImportingMod, ExportingMod, Dialect) :-
functor(G, Name, Arity),
'$pred_exists'(index(Name,Arity,ExportingMod,_),Dialect),
call(Dialect:index(Name,Arity,ExportingMod,_)),
!.
'$autoload'(G, ImportingMod, ExportingMod, _Dialect) :-
@@ -400,7 +404,7 @@ current_module(Mod,TFN) :-
autoloader:find_predicate(G,ExportingModI).
'$autoloader_find_predicate'(G,ExportingModI) :-
yap_flag(autoload, true, false),
yap_flag( unknown, Unknown, fast_fail),
yap_flag( unknown, Unknown, fail),
yap_flag(debug, Debug, false), !,
load_files([library(autoloader),
autoloader:library('INDEX'),
@@ -427,7 +431,6 @@ be associated to a new file.
'$declare_module'(Name, _Super, Context, _File, _Line) :-
add_import_module(Name, Context, start).
/**
\pred abolish_module( + Mod) is det
get rid of a module and of all predicates included in the module.
@@ -762,6 +765,8 @@ unload_module(Mod) :-
/* debug */
module_state :-
recorded('$module','$module'(HostF,HostM,SourceF, Everything, Line),_),
format('HostF ~a, HostM ~a, SourceF ~w, Everything ~w, Line ~d.~n', [HostF,HostM,SourceF, Everything, Line]),
format('HostF ~a, HostM ~a, SourceF ~w, Line ~d,~n Everything ~w.~n', [HostF,HostM,SourceF, Line, Everything]),
recorded('$import','$import'(HostM,M,G0,G,_N,_K),R),
format(' ~w:~w :- ~w:~w.~n',[M,G,HostM,G0]),
fail.
module_state.

2
pl/newmod.yap
View File

@@ -43,7 +43,7 @@ name with the `:/2` operator.
**/
'$module_dec'(system(N), Ps) :- !,
'$system_module'(N),
new_system_module(N),
recordz('$system_initialization', prolog:'$mk_system_predicates'( Ps , N ), _),
'$current_module'(_,N).
'$module_dec'(N, Ps) :-

2
pl/preddecls.yap
View File

@@ -25,6 +25,8 @@
:- use_system_module( '$_errors', ['$do_error'/2]).
'$log_upd'(1).
/**
@defgroup YAPPredDecls Declaring Properties of Predicates
@ingroup YAPCompilerSettings

25
pl/preddyns.yap
View File

@@ -177,8 +177,8 @@ source/0 ( (see Setting the Compiler)).
*/
retract( C ) :-
strip_module( C, M, H0),
'$check_head_and_body'(M:H0,_M,H,B,retract(M:C)),
strip_module( C, M, C0),
'$check_head_and_body'(C0,M,H,B,retract(M:C)),
'$predicate_flags'(H, M, F, F),
'$retract2'(F, H,M,B,_).
@@ -214,28 +214,29 @@ database reference is _R_. The predicate must be dynamic.
*/
retract(M:C,R) :- !,
strip_module( C, M, H0),
'$yap_strip_module'( C, M, H0),
'$retract'(H0, M, R).
'$retract'(C, M, R) :-
'$retract'(C, M0, R) :-
db_reference(R),
!,
'$is_dynamic'(H,M),
'$check_head_and_body'(M:C,_M,H,B,retract(C,R)),
'$check_head_and_body'(M0:C,M,H,B,retract(C,R)),
instance(R,(H:-B)),
erase(R).
'$retract'(C,M,R) :-
'$check_head_and_body'(C,_M,H,B,retract(C,R)),
'$retract'(C,M0,R) :-
'$check_head_and_body'(M0:C,M,H,B,retract(C,R)),
var(R), !,
'$retract2'(H, M, B, R).
'$retract'(C,M,_) :-
'$fetch_predicate_indicator_from_clause'(C, PI),
\+ '$dynamic'(Na/Ar,M),
'$fetch_predicate_indicator_from_clause'(C, M, PI),
\+ '$dynamic'(PI),
'$do_error'(permission_error(modify,static_procedure,PI),retract(M:C)).
'$fetch_predicate_indicator_from_clause'((C :- _), Na/Ar) :- !,
functor(C, Na, Ar).
'$fetch_predicate_indicator_from_clause'(C, Na/Ar) :-
'$fetch_predicate_indicator_from_clause'((C :- _), M:Na/Ar) :-
!,
functor(C, Na, Ar).
'$fetch_predicate_indicator_from_clause'(C, M:Na/Ar) :-
functor(C, Na, Ar).

86
pl/preds.yap
View File

@@ -117,7 +117,7 @@ Adds clause _C_ as the first clause for a static procedure.
*/
asserta_static(CI) :-
asserta_static(CI) :-
'$assert'(C , asserta_static, _ ).
@@ -137,7 +137,7 @@ static predicates, if source mode was on when they were compiled:
*/
assertz_static(CI) :-
assertz_static(CI) :-
'$assert'(C , assertz_static, _ ).
/** @pred clause(+ _H_, _B_) is iso
@@ -165,7 +165,7 @@ reference to the clause in the database. You can use instance/2
to access the reference's value. Note that you may not use
erase/1 on the reference on static procedures.
*/
clause(P,Q,R) :-
clause(P,Q,R) :-
'$instance_module'(R,M0), !,
instance(R,T0),
( T0 = (H :- B) -> Q = B ; H=T0, Q = true),
@@ -175,7 +175,7 @@ clause(P,Q,R) :-
M == M1
->
H1 = T
;
;
M1:H1 = T
).
clause(V0,Q,R) :-
@@ -188,18 +188,18 @@ clause(V0,Q,R) :-
Q = true,
R = '$exo_clause'(M,P),
'$execute0'(P, M).
'$clause'(P,M,Q,R) :-
'$is_source'(P, M), !,
'$static_clause'(P,M,Q,R).
'$clause'(P,M,Q,R) :-
'$is_log_updatable'(P, M), !,
'$log_update_clause'(P,M,Q,R).
'$clause'(P,M,Q,R) :-
'$is_source'(P, M), !,
'$static_clause'(P,M,Q,R).
'$clause'(P,M,Q,R) :-
'$some_recordedp'(M:P), !,
'$recordedp'(M:P,(P:-Q),R).
'$clause'(P,M,Q,R) :-
\+ '$undefined'(P,M),
( '$system_predicate'(P,M) -> true ;
( '$is_system_predicate'(P,M) -> true ;
'$number_of_clauses'(P,M,N), N > 0 ),
functor(P,Name,Arity),
'$do_error'(permission_error(access,private_procedure,Name/Arity),
@@ -533,7 +533,7 @@ predicate_property(Pred,Prop) :-
'$pred_exists'(Orig, SourceMod).
'$predicate_property'(P,M,_,built_in) :-
'$system_predicate'(P,M).
'$is_system_predicate'(P,M).
'$predicate_property'(P,M,_,source) :-
'$predicate_flags'(P,M,F,F),
F /\ 0x00400000 =\= 0.
@@ -584,7 +584,7 @@ predicate_statistics(P0,NCls,Sz,ISz) :-
'$is_log_updatable'(P, M), !,
'$lu_statistics'(P,NCls,Sz,ISz,M).
'$predicate_statistics'(P,M,_,_,_) :-
'$system_predicate'(P,M), !, fail.
'$is_system_predicate'(P,M), !, fail.
'$predicate_statistics'(P,M,_,_,_) :-
'$undefined'(P,M), !, fail.
'$predicate_statistics'(P,M,NCls,Sz,ISz) :-
@@ -613,36 +613,12 @@ Defines the relation: _P_ is a currently defined predicate whose name is the at
*/
current_predicate(A,T0) :-
'$yap_strip_module'(T0, M, T),
(
'$current_predicate'(A, M, T, user)
;
'$imported_predicate'(T, M, SourceT, SourceMod),
functor(T, A, _),
\+ '$system_predicate'(SourceT, SourceMod)
).
/** @pred system_predicate( _A_, _P_)
Defines the relation: _P_ is a built-in predicate whose name
is the atom _A_.
*/
system_predicate(A,T1) :-
'$yap_strip_module'( T1, M, T),
'$system_predicate3'( A, M, T).
'$system_predicate3'( A, M, T) :-
(
M \= prolog,
'$current_predicate'(A, M, T, system)
;
'$imported_predicate'(T, M, SourceT, SourceMod),
M \= prolog,
functor(T, A, _),
'$system_predicate'(SourceT, SourceMod)
;
'$current_predicate'(A, prolog, T, system)
).
(
'$current_predicate'(A,M, T, user)
;
'$imported_predicate'(T, M, T1, M1),
\+ '$is_system_predicate'(T1,M1)
).
/** @pred system_predicate( ?_P_ )
@@ -652,22 +628,32 @@ system_predicate(P0) :-
strip_module(P0, M, P),
(
var(P)
P = A/Arity, ground(P)
->
P = A/Arity,
'$system_predicate3'( A, M, T),
functor(T, A, Arity),
'$current_predicate'(A, M, T, _system),
'$is_system_predicate'( T, M)
;
P = A//Arity2, ground(P)
->
Arity is Arity2-2,
functor(T, A, Arity),
'$current_predicate'(A, M, T, _system),
'$is_system_predicate'( T, M)
;
P = A/Arity
->
'$current_predicate'(A, M, T, _system),
'$is_system_predicate'( T, M),
functor(T, A, Arity)
;
P = A//Arity2
->
'$system_predicate3'( A, M, T),
'$current_predicate'(A, M, T, _system),
'$is_system_predicate'( T, M),
functor(T, A, Arity),
Arity2 is Arity+2
;
P = A/Arity
->
'$system_predicate3'( A, M, T),
functor(T, A, Arity)
Arity >= 2,
Arity2 is Arity-2
;
'$do_error'(type_error(predicate_indicator,P),
system_predicate(P0))

34
pl/protect.yap
View File

@@ -19,33 +19,21 @@ xc/*************************************************************************
% This protects all code from further changes
% and also makes it impossible from some predicates to be seen
'$protect' :-
'$current_predicate'(_A, M, T0, all),
%format(' ~a ~n', [M]) ,
'$system_module'(M),
'$predicate_flags'(T0, M, Flags, Flags),
% not multifile, dynamic, or logical updates.
Flags /\ (0x20000000\/0x08000000\/0x00002000) =\= 0,
NFlags is Flags \/ 0x00004000,
'$predicate_flags'(T0, M, _Flags, NFlags),
%format('~w ~16r ~16r~n', [T0,Flags, NFlags]) ,
fail.
'$protect' :-
current_atom(Name),
atom_codes(Name,[0'$|_]), %'
'$hide_predicates'(Name),
'$hide'(Name),
fail.
sub_atom(Name,0,1,_, '$'),
'$hide'(Name),
fail.
'$protect' :-
'$hide_predicates'(bootstrap),
hide(bootstrap).
'$all_current_modules'(M),
M \= user,
'$current_predicate'(_,M,P,_),
functor(P,N,A),
'$new_system_predicate'(N,A,M),
% writeln(N/A),
fail.
'$protect'.
'$hide_predicates'(Name) :-
'$current_predicate'(Name, Mod, P, all),
'$hide_predicate'(P,Mod),
fail.
'$hide_predicates'(_).
% hide all atoms who start by '$'
'$hide'('$VAR') :- !, fail. /* not $VAR */
@@ -66,5 +54,5 @@ xc/*************************************************************************
'$hide'('$parse_quasi_quotations') :- !, fail.
'$hide'('$quasi_quotation') :- !, fail.
'$hide'('$qq_open') :- !, fail.
'$hide'(Name) :- hide(Name), fail.
%'$hide'(Name) :- hide_atom(Name), fail.

2
pl/qly.yap
View File

@@ -259,7 +259,7 @@ qend_program :-
fail.
'$do_init_state' :-
set_value('$user_module',user),
'$protect',
% '$protect',
fail.
'$do_init_state' :-
'$current_module'(prolog),

1
pl/signals.yap
View File

@@ -355,5 +355,6 @@ read_sig.
:- '$set_no_trace'('$execute_nonstop'(_,_), prolog).
:- '$set_no_trace'('$execute_clause'(_,_,_,_), prolog).
:- '$set_no_trace'('$restore_regs'(_,_), prolog).
:- '$set_no_trace'('$expand_meta_call'(_,_,_), prolog).
%%! @}

2
pl/spy.yap
View File

@@ -252,7 +252,7 @@ Switches on the debugger and enters tracing mode.
*/
trace :-
'$init_debugger',
'__NB_getval__'('$trace', on, fail), !.
fail.
trace :-
'__NB_setval__'('$trace',on),
'$start_debugging'(on),

4
pl/strict_iso.yap
View File

@@ -63,7 +63,7 @@
'$iso_check_a_goal'((_|_),_,_) :- !.
'$iso_check_a_goal'(G,_,G0) :-
current_prolog_flag(language, iso),
'$system_predicate'(G,prolog),
'$is+system_predicate'(G,prolog),
(
'$iso_builtin'(G)
->
@@ -90,7 +90,7 @@
'$check_iso_strict_goal'(B).
'$check_iso_strict_goal'(G) :-
'$system_predicate'(G,prolog), !,
'$is_system_predicate'(G,prolog), !,
'$check_iso_system_goal'(G).
'$check_iso_strict_goal'(_).

157
pl/undefined.yap
View File

@@ -37,88 +37,7 @@ with SICStus Prolog.
*/
/**
* @pred '$undefp_expand'(+ M0:G0, -MG)
*
* @param G0 input goal
* @param M0 current module
* @param G1 new goal
*
* @return succeeds on finding G1, otherwise fails.
*
* Tries:
* 1 - `user:unknown_predicate_handler`
* 2 - `goal_expansion`
* 1 - `import` mechanism`
*/
'$undefp_expand'(M0:G0, MG) :-
user:unknown_predicate_handler(G0,M0,M1:G1),
M0:G0 \== M1:G1,
!,
(
'$pred_exists'(G1, M1)
->
MG = M1:G1
;
'$undefp_expand_user'(M1:G1, MG)
).
'$undefp_expand'(MG0, MG) :-
'$undefp_expand_user'(MG0, MG).
'$undefp_expand_user'(M0:G0, MG) :-
'_user_expand_goal'(M0:G0, MG1),
M0:G0 \== MG1,
!,
'$yap_strip_module'( MG1, M1, G1),
(
'$pred_exists'(G1, M1)
->
MG = M1:G1
;
'$undefp_expand_import'(M1:G1, MG)
).
'$undefp_expand_user'(MG0, MG) :-
'$undefp_expand_import'(MG0, MG).
'$undefp_expand_import'(M0:G0, M1:G1) :-
'$get_undefined_pred'(G0, M0, G1, M1),
M0:G0 \== M1:G1.
'$undefp'([M0|G0], Default) :-
% make sure we do not loop on undefined predicates
yap_flag( unknown, Unknown, fast_fail),
yap_flag( debug, Debug, false),
(
'$undefp_expand'(M0:G0, NM:Goal),
Goal \= fail,
'$complete_goal'(M0, G0, Goal, NM, NG)
->
yap_flag( unknown, _, Unknown),
yap_flag( debug, _, Debug),
'$execute0'(NG, NM)
;
yap_flag( unknown, _, Unknown),
yap_flag( debug, _, Debug),
'$handle_error'(Default,G0,M0)
).
/** @pred unknown(- _O_,+ _N_)
The unknown predicate, informs about what the user wants to be done
when there are no clauses for a certain predicate.
This predicate is strongly deprecated. Use prolog_flag for generic
behaviour, and user:unknown_predicate_handler/3 for flexible behaviour
on undefined goals.
*/
unknown(P, NP) :-
prolog_flag( unknown, P, NP ).
/** @pred user:unknown_predicate_handler(+ _Call_, + _M_, - _N_)
/** @pred user:unknown_predicate_handler(+ _Call_, + _M_, - _N_)
In YAP, the default action on undefined predicates is to output an
`error` message. Alternatives are to silently `fail`, or to print a
@@ -150,7 +69,8 @@ followed by the failure of that call.
'$handle_error'(error,Goal,Mod) :-
functor(Goal,Name,Arity),
'program_continuation'(PMod,PName,PAr),
'$do_error'(existence_error(procedure,Name/Arity),context(Mod:Goal,PMod:PName/PAr)).
'$do_error'(existence_error(procedure,Name/Arity),
context(Mod:Goal,PMod:PName/PAr)).
'$handle_error'(warning,Goal,Mod) :-
functor(Goal,Name,Arity),
'program_continuation'(PMod,PName,PAr),
@@ -161,14 +81,69 @@ followed by the failure of that call.
:- '$set_no_trace'('$handle_error'(_,_,_), prolog).
'$complete_goal'(M, _G, CurG, CurMod, NG) :-
(
'$is_metapredicate'(CurG,CurMod)
->
'$expand_meta_call'(CurMod:CurG, [], NG)
;
NG = CurG
).
/**
Z * @pred '$undefp_expand'(+ M0:G0, -MG)
*
* @param G0 input goal
* @param M0 current module
* @param G1 new goal
*
* @return succeeds on finding G1, otherwise fails.
*
* Tries:
* 1 - `user:unknown_predicate_handler`
* 2 - `goal_expansion`
* 1 - `import` mechanism`
*/
'$undefp_search'(M0:G0, MG) :-
'$pred_exists'(unknown_predicate_handler(_,_,_,_), user),
'$yap_strip_module'(M0:G0, EM0, GM0),
user:unknown_predicate_handler(GM0,EM0,M1:G1),
!,
expand_goal(M1:G1, MG).
'$undefp_search'(MG, FMG) :-
expand_goal(MG, FMG).
'$undefp'([M0|G0], Action) :-
% make sure we do not loop on undefined predicates
'$stop_creeping'(Current),
yap_flag( unknown, _, fail),
yap_flag( debug, Debug, false),
(
'$undefp_search'(M0:G0, NM:NG),
( M0 \== NM -> true ; G0 \== NG ),
NG \= fail,
'$pred_exists'(NG,NM)
->
yap_flag( unknown, _, Action),
yap_flag( debug, _, Debug),
(
Current == true
->
% carry on signal processing
'$start_creep'([NM|NG], creep)
;
'$execute0'(NG, NM)
)
;
yap_flag( unknown, _, Action),
yap_flag( debug, _, Debug),
'$handle_error'(Action,G0,M0)
).
/** @pred unknown(- _O_,+ _N_)
The unknown predicate, informs about what the user wants to be done
when there are no clauses for a predicate. Using unknown/3 is
strongly deprecated. We recommend setting the `unknown` prolog
flag for generic behaviour, and calling the hook
user:unknown_predicate_handler/3 to fine-tune specific cases
undefined goals.
*/
unknown(P, NP) :-
prolog_flag( unknown, P, NP ).
/**
@}