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

Merge branch 'master' of ../yap-6.2

Browse Source
This commit is contained in:
Vitor Santos Costa 2010-12-15 00:07:02 +00:00
commit ba6567285c
13 changed files with 143 additions and 160 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
C/c_interface.c
View File

@ -2054,7 +2054,6 @@ YAP_RestartGoal(void)
{
int out;
BACKUP_MACHINE_REGS();
if (Yap_AllowRestart) {
P = (yamop *)FAILCODE;
do_putcf = myputc;
@ -2650,6 +2649,8 @@ YAP_Init(YAP_init_args *yap_init)
/* first, initialise the saved state */
Term t_goal = MkAtomTerm(AtomStartupSavedState);
YAP_RunGoalOnce(t_goal);
Yap_InitYaamRegs();
/* reset stacks */
return YAP_BOOT_FROM_SAVED_CODE;
} else {
return YAP_BOOT_FROM_SAVED_STACKS;
@ -2681,6 +2682,8 @@ YAP_Init(YAP_init_args *yap_init)
fgoal = Yap_MkFunctor(Yap_LookupAtom("module"), 1);
goal = Yap_MkApplTerm(fgoal, 1, as);
YAP_RunGoalOnce(goal);
/* reset stacks */
Yap_InitYaamRegs();
}
Yap_PutValue(Yap_FullLookupAtom("$live"), MkAtomTerm (Yap_FullLookupAtom("$true")));
}

78
C/cdmgr.c
View File

@ -507,8 +507,6 @@ STATIC_PROTO(Int p_new_multifile, (void));
STATIC_PROTO(Int p_is_multifile, (void));
STATIC_PROTO(Int p_optimizer_on, (void));
STATIC_PROTO(Int p_optimizer_off, (void));
STATIC_PROTO(Int p_in_this_f_before, (void));
STATIC_PROTO(Int p_first_cl_in_f, (void));
STATIC_PROTO(Int p_is_dynamic, (void));
STATIC_PROTO(Int p_kill_dynamic, (void));
STATIC_PROTO(Int p_compile_mode, (void));
@ -2431,80 +2429,6 @@ Yap_add_logupd_clause(PredEntry *pe, LogUpdClause *cl, int mode) {
}
}
static Int
p_in_this_f_before(void)
{ /* '$in_this_file_before'(N,A,M) */
unsigned int arity;
Atom at;
Term t;
register consult_obj *fp;
Prop p0;
Term mod;
if (IsVarTerm(t = Deref(ARG1)) || !IsAtomTerm(t))
return (FALSE);
else
at = AtomOfTerm(t);
if (IsVarTerm(t = Deref(ARG2)) || !IsIntTerm(t))
return (FALSE);
else
arity = IntOfTerm(t);
if (IsVarTerm(mod = Deref(ARG3)) || !IsAtomTerm(mod))
return FALSE;
if (arity)
p0 = PredPropByFunc(Yap_MkFunctor(at, arity), mod);
else
p0 = PredPropByAtom(at, mod);
if (!ConsultSp || ConsultSp == ConsultBase || LastAssertedPred == RepPredProp(p0) || (fp = ConsultSp)->p == p0)
return FALSE;
else
fp++;
for (; fp < ConsultBase; ++fp)
if (fp->p == p0)
break;
if (fp != ConsultBase)
return TRUE;
else
return FALSE;
}
static Int
p_first_cl_in_f(void)
{ /* '$first_cl_in_file'(+N,+Ar,+Mod) */
unsigned int arity;
Atom at;
Term t;
register consult_obj *fp;
Prop p0;
Term mod;
if (IsVarTerm(t = Deref(ARG1)) || !IsAtomTerm(t))
return (FALSE);
else
at = AtomOfTerm(t);
if (IsVarTerm(t = Deref(ARG2)) || !IsIntTerm(t))
return (FALSE);
else
arity = IntOfTerm(t);
if (IsVarTerm(mod = Deref(ARG3)) || !IsAtomTerm(mod))
return (FALSE);
if (arity)
p0 = PredPropByFunc(Yap_MkFunctor(at, arity),mod);
else
p0 = PredPropByAtom(at, mod);
if (LastAssertedPred == RepPredProp(p0))
return FALSE;
if (!ConsultSp)
return FALSE;
for (fp = ConsultSp; fp < ConsultBase; ++fp)
if (fp->p == p0)
break;
if (fp != ConsultBase)
return FALSE;
return TRUE;
}
#if EMACS
/*
@ -5732,8 +5656,6 @@ Yap_InitCdMgr(void)
Yap_InitCPred("$clean_up_dead_clauses", 0, p_clean_up_dead_clauses, SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$optimizer_off", 0, p_optimizer_off, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$kill_dynamic", 2, p_kill_dynamic, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$in_this_file_before", 3, p_in_this_f_before, SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$first_clause_in_file", 3, p_first_cl_in_f, SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$new_multifile", 3, p_new_multifile, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$is_multifile", 2, p_is_multifile, TestPredFlag | SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$is_profiled", 1, p_is_profiled, SafePredFlag|SyncPredFlag|HiddenPredFlag);

7
C/exec.c
View File

@ -1002,6 +1002,8 @@ exec_absmi(int top)
Yap_PrologMode = UserMode;
}
Yap_CloseSlots();
YENV = ASP;
YENV[E_CB] = Unsigned (B);
out = Yap_absmi(0);
Yap_StartSlots();
/* make sure we don't leave a FAIL signal hanging around */
@ -1054,9 +1056,9 @@ init_stack(int arity, CELL *pt, int top, choiceptr saved_b)
#if defined(YAPOR) || defined(THREADS)
WPP = NULL;
#endif
YENV[E_CB] = Unsigned (B);
CP = YESCODE;
/* start with some slots so that we can use them */
Yap_StartSlots();
CP = YESCODE;
}
static Term
@ -1639,6 +1641,7 @@ Yap_InitYaamRegs(void)
EX = NULL;
init_stack(0, NULL, TRUE, NULL);
/* the first real choice-point will also have AP=FAIL */
/* always have an empty slots for people to use */
CurSlot = 0;
GlobalArena = TermNil;
h0var = MkVarTerm();

2
H/iatoms.h
View File

@ -162,7 +162,7 @@
AtomMfClause = Yap_FullLookupAtom("$mf_clause");
AtomMinus = Yap_LookupAtom("-");
AtomModify = Yap_LookupAtom("modify");
AtomMultiFile = Yap_FullLookupAtom("$multi_file");
AtomMultiFile = Yap_FullLookupAtom("$mf");
AtomMutable = Yap_LookupAtom("mutable");
AtomMutableVariable = Yap_FullLookupAtom("$mutable_variable");
AtomMyddasDB = Yap_FullLookupAtom("$myddas_db");

4
library/dialect/swi.yap
View File

@ -189,7 +189,9 @@ goal_expansion(open_null_stream(A), system:swi_open_null_stream(A)) :- swi_io.
/* SWI specific */
goal_expansion(is_stream(A), system:swi_is_stream(A)) :- swi_io.
goal_expansion(set_stream(A,B),system:swi_set_stream(A,B)) :- swi_io.
goal_expansion(with_output_to(A,B),system:swi_with_output_to(A,B)) :- swi_io.
% careful: with_output_to/2 requires setting user_output, and this
% confuses emulation.
goal_expansion(with_output_to(A,B),with_output_to(A,B)) :- swi_io.
goal_expansion(set_prolog_IO(A,B,C), system:swi_set_prolog_IO(A,B,C)) :- swi_io.
goal_expansion(protocol(A), system:swi_protocol(A)) :- swi_io.
goal_expansion(protocola(A), system:swi_protocola(A)) :- swi_io.

16
library/dialect/swi/fli/swi.c
View File

@ -478,11 +478,7 @@ X_API int PL_get_chars(term_t l, char **sp, unsigned flags)
} else {
if (!(flags & (CVT_INTEGER|CVT_NUMBER|CVT_ATOMIC|CVT_WRITE|CVT_WRITE_CANONICAL|CVT_ALL)))
return cv_error(flags);
#if _WIN64
snprintf(tmp,SWI_BUF_SIZE,"%I64d",IntegerOfTerm(t));
#else
snprintf(tmp,SWI_BUF_SIZE,"%ld",IntegerOfTerm(t));
#endif
snprintf(tmp,SWI_BUF_SIZE,Int_FORMAT,IntegerOfTerm(t));
}
} else if (IsPairTerm(t)) {
if (!(flags & (CVT_LIST|CVT_WRITE|CVT_WRITE_CANONICAL|CVT_ALL))) {
@ -2578,12 +2574,7 @@ X_API qid_t PL_open_query(module_t ctx, int flags, predicate_t p, term_t t0)
Term t[2], m;
/* ignore flags and module for now */
if (execution == NULL)
PL_open_foreign_frame();
if (execution->open != 0) {
YAP_Error(0, 0L, "only one query at a time allowed\n");
return FALSE;
}
PL_open_foreign_frame();
execution->open=1;
execution->state=0;
PredicateInfo((PredEntry *)p, &yname, &arity, &m);
@ -2617,13 +2608,13 @@ X_API qid_t PL_open_query(module_t ctx, int flags, predicate_t p, term_t t0)
X_API int PL_next_solution(qid_t qi)
{
int result;
if (qi->open != 1) return 0;
if (setjmp(execution->env))
return 0;
if (qi->state == 0) {
result = YAP_RunGoal(qi->g);
} else {
Yap_AllowRestart = qi->open;
result = YAP_RestartGoal();
}
qi->state = 1;
@ -2894,6 +2885,7 @@ PL_set_engine(PL_engine_t engine, PL_engine_t *old)
}
return PL_ENGINE_SET;
#else
if (old) *old = (PL_engine_t)&Yap_WLocal;
return FALSE;
#endif
}

2
misc/ATOMS
View File

@ -167,7 +167,7 @@ A MetaCall F "$call"
A MfClause F "$mf_clause"
A Minus N "-"
A Modify N "modify"
A MultiFile F "$multi_file"
A MultiFile F "$mf"
A Mutable N "mutable"
A MutableVariable F "$mutable_variable"
A MyddasDB F "$myddas_db"

6
pl/boot.yap
View File

@ -461,14 +461,14 @@ true :- true.
'$$compile'(G1, G0, N, HeadMod).
'$prepare_term'(G, V, Pos, G0, G1, BodyMod, SourceMod, Source) :-
'$precompile_term'(G, G0, G1, BodyMod, SourceMod),
(
get_value('$syntaxcheckflag',on)
->
'$check_term'(G0, V, Pos, Source, BodyMod)
'$check_term'(Source, V, Pos, BodyMod)
;
true
).
),
'$precompile_term'(G, G0, G1, BodyMod, SourceMod).
% process an input clause
'$$compile'(G, G0, L, Mod) :-

146
pl/checker.yap
View File

@ -106,7 +106,6 @@ no_style_check([]).
no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
'$syntax_check_mode'(O,N) :-
'$values'('$syntaxcheckflag',O,N).
@ -119,55 +118,78 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
'$syntax_check_multiple'(O,N) :-
'$values'('$syntaxcheckmultiple',O,N).
% reset current state of style checker.
'$init_style_check'(File) :-
recorded('$predicate_defs','$predicate_defs'(_,_,_,File),R),
erase(R),
fail.
'$init_style_check'(_).
'$check_term'(T,_,P,_Source,M) :-
% style checker proper..
'$check_term'(T,VL,P,_) :-
get_value('$syntaxchecksinglevar',on),
'$singletons_in_clause'(T, VL, Sv),
Sv = [_|_],
'$sv_warning'(Sv,T),
fail.
'$check_term'(T,_,P,M) :-
get_value('$syntaxcheckdiscontiguous',on),
'$xtract_head'(T,M,NM,_,F,A),
'$handle_discontiguous'(F,A,NM), fail.
'$check_term'(T,_,P,_Source,M) :-
% should always fail
'$handle_discontiguous'(F,A,NM),
fail.
'$check_term'(T,_,P,M) :-
get_value('$syntaxcheckmultiple',on),
'$xtract_head'(T,M,NM,_,F,A),
'$handle_multiple'(F,A,NM), fail.
'$check_term'(T,VL,P,_Source,_) :-
get_value('$syntaxchecksinglevar',on),
( '$chk_binding_vars'(T),
'$sv_list'(VL,Sv)
->
'$sv_warning'(Sv,T)
), fail.
'$check_term'(_,_,_,_,_).
'$handle_multiple'(F,A,NM),
fail.
'$check_term'(T,_,_,M) :-
once((
get_value('$syntaxcheckdiscontiguous',on)
;
get_value('$syntaxcheckmultiple',on)
)),
recorded('$reconsulting',File,_),
'$xtract_head'(T,M,NM,_,F,A),
\+ (
% allow duplicates if we are not the last predicate to have
% been asserted.
once(recorded('$predicate_defs','$predicate_defs'(F0,A0,M0,File),_)),
F0 = F, A0 = A, M0 = NM
),
recorda('$predicate_defs','$predicate_defs'(F,A,NM,File),_),
fail.
'$check_term'(_,_,_,_).
'$chk_binding_vars'(V) :- var(V), !, V = '$V'(_).
'$chk_binding_vars'('$V'(off)) :- !.
'$chk_binding_vars'(A) :- primitive(A), !.
'$chk_binding_vars'(S) :- S =.. [_|L],
'$chk_bind_in_struct'(L).
%
% output a list of singleton variables...
%
'$singletons_in_clause'(T, VL, Sv) :-
% first check which variables are not singleton
'$non_singletons_in_term'(T,[],V2L),
% bound them
'$ground_vars'(V2L),
% the remainder which do not start by _ are our target!
'$sv_list'(VL, Sv).
'$chk_bind_in_struct'([]).
'$chk_bind_in_struct'([H|T]) :-
'$chk_binding_vars'(H),
'$chk_bind_in_struct'(T).
'$ground_vars'([]).
'$ground_vars'(ground.V2L) :-
'$ground_vars'(V2L).
'$sv_list'([],[]).
'$sv_list'([[[95|_]|_]|T],L) :-
'$sv_list'([[95|_]._|T],L) :- !,
'$sv_list'(T,L).
'$sv_list'([[Name|'$V'(V)]|T],[Name|L]) :- var(V), !,
'$sv_list'([_|V].T,L) :- nonvar(V), !,
'$sv_list'(T,L).
'$sv_list'([_|T],L) :-
'$sv_list'([Name|_].T, Name.L) :-
'$sv_list'(T,L).
'$sv_warning'([],_) :- !.
'$sv_warning'(SVs,T) :-
'$sv_warning'([], _) :- !.
'$sv_warning'(SVs, T) :-
'$current_module'(OM),
'$xtract_head'(T,OM,M,H,Name,Arity),
( nb_getval('$consulting',false),
'$first_clause_in_file'(Name,Arity, OM) ->
ClN = 1 ;
'$number_of_clauses'(H,M,ClN0),
ClN is ClN0+1
),
print_message(warning,singletons(SVs,(M:Name/Arity),ClN)).
'$xtract_head'(T, OM, M, H, Name, Arity),
print_message(warning,singletons(SVs,(M:Name/Arity))).
'$xtract_head'(V,M,M,V,call,1) :- var(V), !.
'$xtract_head'((H:-_),OM,M,NH,Name,Arity) :- !,
@ -183,36 +205,54 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
'$xtract_head'(H,M,M,H,Name,Arity) :-
functor(H,Name,Arity).
% check if a predicate is discontiguous.
'$handle_discontiguous'(F,A,M) :-
recorded('$discontiguous_defs','$df'(F,A,M),_), !.
recorded('$discontiguous_defs','$df'(F,A,M),_), !,
fail.
'$handle_discontiguous'(F,A,M) :-
functor(Head, F, A),
'$is_multifile'(Head, M), !.
'$is_multifile'(Head, M), !,
fail.
'$handle_discontiguous'(F,A,M) :-
'$in_this_file_before'(F,A,M),
print_message(warning,clauses_not_together((M:F/A))).
nb_getval('$consulting_file', FileName),
% we have been there before
once(recorded('$predicate_defs','$predicate_defs'(F, A, M, FileName),_)),
% and we are not
\+ (
% the last predicate to have been asserted
once(recorded('$predicate_defs','$predicate_defs'(F0,A0,M0,FileName),_)),
F0 = F, A0 = A, M0 = M
),
print_message(warning,clauses_not_together((M:F/A))),
fail.
% never complain the second time
'$handle_multiple'(F,A,M) :-
\+ '$first_clause_in_file'(F,A,M), !.
'$handle_multiple'(_,_,_) :-
nb_getval('$consulting',true), !.
nb_getval('$consulting_file', FileName),
recorded('$predicate_defs','$predicate_defs'(F,A,M,FileName),_), !.
% first time we have a definition
'$handle_multiple'(F,A,M) :-
recorded('$predicate_defs','$predicate_defs'(F,A,M,Fil),_), !,
'$multiple_has_been_defined'(Fil, F/A, M), !.
'$handle_multiple'(F,A,M) :-
( recorded('$reconsulting',Fil,_) -> true ),
recorda('$predicate_defs','$predicate_defs'(F,A,M,Fil),_).
nb_getval('$consulting_file', FileName0),
recorded('$predicate_defs','$predicate_defs'(F,A,M,FileName),_),
FileName \= FileName0,
'$multiple_has_been_defined'(FileName, F/A, M), !.
% be careful about these cases.
% consult does not count
'$multiple_has_been_defined'(_, _, _) :-
nb_getval('$consulting',true), !.
% multifile does not count
'$multiple_has_been_defined'(_, F/A, M) :-
functor(S, F, A),
'$is_multifile'(S, M), !.
'$multiple_has_been_defined'(Fil,F/A,M) :-
% first, clean up all definitions in other files
% don't forget, we just removed everything.
recorded('$predicate_defs','$predicate_defs'(F,A,M,FileName),R),
erase(R),
fail.
'$multiple_has_been_defined'(Fil,P,M) :-
recorded('$reconsulting',F,_), !,
'$test_if_well_reconsulting'(F,Fil,M:P).
'$test_if_well_reconsulting'(F,F,_) :- !.
'$test_if_well_reconsulting'(_,Fil,P) :-
print_message(warning,defined_elsewhere(P,Fil)).
print_message(warning,defined_elsewhere(M:P,Fil)).
'$multifile'(V, _) :- var(V), !,
'$do_error'(instantiation_error,multifile(V)).

1
pl/consult.yap
View File

@ -252,6 +252,7 @@ use_module(M,F,Is) :-
'$access_yap_flags'(18,GenerateDebug),
'$consult_infolevel'(InfLevel),
'$comp_mode'(OldCompMode, CompMode),
( get_value('$syntaxcheckflag',on) -> '$init_style_check'(File) ; true ),
recorda('$initialisation','$',_),
( Reconsult = reconsult ->
'$start_reconsulting'(File),

8
pl/messages.yap
View File

@ -129,10 +129,10 @@ system_message(leash([A|B])) -->
[ 'Leashing set to ~w.' - [[A|B]] ].
system_message(existence_error(prolog_flag,F)) -->
[ 'Prolog Flag ~w: new Prolog flags must be created using create_prolog_flag/3.' - [F] ].
system_message(singletons([SV],P,CLN)) -->
[ 'Singleton variable ~s in ~q, clause ~d.' - [SV,P,CLN] ].
system_message(singletons(SVs,P,CLN)) -->
[ 'Singleton variables ~s in ~q, clause ~d.' - [SVsL, P, CLN] ],
system_message(singletons([SV],P)) -->
[ 'Singleton variable ~s in ~q.' - [SV,P] ].
system_message(singletons(SVs,P)) -->
[ 'Singleton variables ~s in ~q.' - [SVsL, P] ],
{ svs(SVs,SVsL,[]) }.
system_message(trace_command(-1)) -->
[ 'EOF is not a valid debugger command.' ].

25
pl/modules.yap
View File

@ -316,6 +316,9 @@ expand_goal(G, NG) :-
'$do_expand'(G, M, NG), !.
expand_goal(G, G).
'$do_expand'(G, _, G) :- var(G), !.
'$do_expand'(M:G, CurMod, M:GI) :- !,
'$do_expand'(G, M, GI).
'$do_expand'(G, CurMod, GI) :-
(
'$pred_exists'(goal_expansion(G,GI), CurMod),
@ -323,7 +326,8 @@ expand_goal(G, G).
->
true
;
recorded('$dialect',swi,_), system:goal_expansion(G, GI)
recorded('$dialect',swi,_),
system:goal_expansion(G, GI)
->
true
;
@ -332,7 +336,22 @@ expand_goal(G, G).
true
;
user:goal_expansion(G, GI)
).
), !.
'$do_expand'(G, CurMod, NG) :-
'$is_metapredicate'(G,CurMod), !,
functor(G, Name, Arity),
prolog:'$meta_predicate'(Name,CurMod,Arity,PredDef),
G =.. [Name|GArgs],
PredDef =.. [Name|GDefs],
'$expand_args'(GArgs, CurMod, GDefs, NGArgs),
NG =.. [Name|NGArgs].
'$expand_args'([], _, [], []).
'$expand_args'(A.GArgs, CurMod, 0.GDefs, NA.NGArgs) :-
'$do_expand'(A, CurMod, NA), !,
'$expand_args'(GArgs, CurMod, GDefs, NGArgs).
'$expand_args'(A.GArgs, CurMod, _.GDefs, A.NGArgs) :-
'$expand_args'(GArgs, CurMod, GDefs, NGArgs).
% args are:
% goal to expand
@ -455,7 +474,7 @@ expand_goal(G, G).
'$install_meta_predicate'(P, M1) :-
functor(P,F,N),
( M1 = prolog -> M = _ ; M1 = M),
( retractall('$meta_predicate'(F,M,N,_)), fail ; true),
( retractall(prolog:'$meta_predicate'(F,M,N,_)), fail ; true),
asserta(prolog:'$meta_predicate'(F,M,N,P)),
'$flags'(P, M1, Fl, Fl),
NFlags is Fl \/ 0x200000,

3
pl/preds.yap
View File

@ -212,7 +212,8 @@ assertz_static(C) :-
'$head_and_body'(C,H,B),
'$assertat_d'(last,H,B,C0,Mod,_).
'$assertz_dynamic'(X,C,C0,Mod) :-
'$head_and_body'(C,H,B), functor(H,N,A),
'$head_and_body'(C,H,B),
functor(H,N,A),
('$check_if_reconsulted'(N,A) ->
true
;