Fix block/1 declarations and remove uses of $recorded (patch from David Powers).

This commit is contained in:
Vitor Santos Costa 2010-09-24 00:36:10 +01:00
parent 52a4680ac7
commit f9e687a971
2 changed files with 22 additions and 15 deletions

View File

@ -60,15 +60,20 @@ attgoal_for_delay(redo_dif(Done, X, Y), V) -->
[prolog:dif(X,Y)]. [prolog:dif(X,Y)].
attgoal_for_delay(redo_freeze(Done, V, Goal), V) --> attgoal_for_delay(redo_freeze(Done, V, Goal), V) -->
{ var(Done) }, !, { var(Done) }, !,
[prolog:freeze(V,Goal)]. { remove_when_declarations(Goal, NoWGoal) },
[ prolog:freeze(V,NoWGoal) ].
attgoal_for_delay(redo_eq(Done, X, Y, Goal), V) --> attgoal_for_delay(redo_eq(Done, X, Y, Goal), V) -->
{ var(Done), first_att(Goal, V) }, !, { var(Done), first_att(Goal, V) }, !,
[prolog:when(X=Y,Goal)]. [ prolog:when(X=Y,Goal) ].
attgoal_for_delay(redo_ground(Done, X, Goal), V) --> attgoal_for_delay(redo_ground(Done, X, Goal), V) -->
{ var(Done) }, !, { var(Done) }, !,
[prolog:when(ground(X),Goal)]. [ prolog:when(ground(X),Goal) ].
attgoal_for_delay(_, V) --> []. attgoal_for_delay(_, V) --> [].
remove_when_declarations(when(Cond,Goal,_), when(Cond,NoWGoal)) :- !,
remove_when_declarations(Goal, NoWGoal).
remove_when_declarations(Goal, Goal).
% %
% operators defined in this module: % operators defined in this module:
% %
@ -215,7 +220,7 @@ prolog:when(_,Goal) :-
% %
% support for when/2 like declaration. % support for when/2 like declaration.
% v%
% %
% when will block on a conjunction or disjunction of nonvar, ground, % when will block on a conjunction or disjunction of nonvar, ground,
% ?=, where ?= is both terms being bound together % ?=, where ?= is both terms being bound together
@ -357,8 +362,8 @@ prolog:'$block'(Conds) :-
prolog:'$block'(_). prolog:'$block'(_).
generate_blocking_code(Conds, G, Code) :- generate_blocking_code(Conds, G, Code) :-
'$extract_head_for_block'(Conds, G), extract_head_for_block(Conds, G),
'$recorded'('$blocking_code','$code'(G,OldConds),R), !, recorded('$blocking_code','$code'(G,OldConds),R), !,
erase(R), erase(R),
functor(G, Na, Ar), functor(G, Na, Ar),
'$current_module'(M), '$current_module'(M),

View File

@ -234,7 +234,7 @@ assertz_static(C) :-
'$erase_all_mf_dynamic'(Na,A,M) :- '$erase_all_mf_dynamic'(Na,A,M) :-
get_value('$consulting_file',F), get_value('$consulting_file',F),
'$recorded'('$multifile_dynamic'(_,_,_), '$mf'(Na,A,M,F,R), R1), recorded('$multifile_dynamic'(_,_,_), '$mf'(Na,A,M,F,R), R1),
erase(R1), erase(R1),
erase(R), erase(R),
fail. fail.
@ -649,12 +649,6 @@ abolish(X) :-
'$undefined'(G, Module), '$undefined'(G, Module),
functor(G,Name,Arity), functor(G,Name,Arity),
print_message(warning,no_match(abolish(Module:Name/Arity))). print_message(warning,no_match(abolish(Module:Name/Arity))).
% I cannot allow modifying static procedures in YAPOR
% this code has to be here because of abolish/2
% '$abolishs'(G, Module) :-
% '$has_yap_or', !,
% functor(G,A,N),
% '$do_error'(permission_error(modify,static_procedure,A/N),abolish(Module:G)).
'$abolishs'(G, M) :- '$abolishs'(G, M) :-
'$is_multifile'(G,M), !, '$is_multifile'(G,M), !,
functor(G,Name,Arity), functor(G,Name,Arity),
@ -927,7 +921,8 @@ current_predicate(A,T) :-
current_predicate(A) :- current_predicate(A) :-
'$current_predicate_inside'(A). '$current_predicate_inside'(A).
'$current_predicate_inside'(F) :- var(F), !, % only for the predicate '$current_predicate_inside'(F) :-
var(F), !, % only for the predicate
'$current_module'(M), '$current_module'(M),
'$current_predicate3'(M,F). '$current_predicate3'(M,F).
'$current_predicate_inside'(M:F) :- % module specified '$current_predicate_inside'(M:F) :- % module specified
@ -955,7 +950,14 @@ system_predicate(P) :-
'$ifunctor'(T,A,Arity), '$ifunctor'(T,A,Arity),
'$pred_exists'(T,M). '$pred_exists'(T,M).
'$current_predicate3'(M,A/Arity) :- nonvar(A), nonvar(Arity), !, '$current_predicate3'(M,A/Arity) :-
nonvar(M),
nonvar(A),
nonvar(Arity), !,
'$ifunctor'(Pred,A,Arity),
'$pred_exists'(Pred,M).
'$current_predicate3'(M,A/Arity) :-
nonvar(A), nonvar(Arity), !,
( (
'$current_predicate'(M,A,Arity) '$current_predicate'(M,A,Arity)
-> ->