From 1369057cc4b5293a35da66fd45f64c48dfc0a4f6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Mon, 13 Dec 2010 19:13:33 +0000 Subject: [PATCH 01/12] fix style checker to be more self-contained. --- C/cdmgr.c | 78 -------------------------- pl/boot.yap | 6 +- pl/checker.yap | 144 +++++++++++++++++++++++++++++++----------------- pl/consult.yap | 1 + pl/messages.yap | 8 +-- 5 files changed, 100 insertions(+), 137 deletions(-) diff --git a/C/cdmgr.c b/C/cdmgr.c index b8c7cd038..46cc99f1e 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -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); diff --git a/pl/boot.yap b/pl/boot.yap index bbe4e19a3..eac15a1b2 100755 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -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) :- diff --git a/pl/checker.yap b/pl/checker.yap index 3405c2b17..ac23cb0f2 100644 --- a/pl/checker.yap +++ b/pl/checker.yap @@ -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'(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)). diff --git a/pl/consult.yap b/pl/consult.yap index 598c56f53..adbf17b64 100755 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -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), diff --git a/pl/messages.yap b/pl/messages.yap index a3f7dbbec..9adc30ca4 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -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.' ]. From 9f8f8ee73e3a13514c1f91c5812a88db15ec270a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Mon, 13 Dec 2010 19:35:16 +0000 Subject: [PATCH 02/12] fix missing cut (obs from Bernd). --- pl/checker.yap | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pl/checker.yap b/pl/checker.yap index ac23cb0f2..6e52d9a53 100644 --- a/pl/checker.yap +++ b/pl/checker.yap @@ -177,7 +177,7 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T). '$ground_vars'(V2L). '$sv_list'([],[]). -'$sv_list'([[[95|_]|_]|T],L) :- +'$sv_list'([[95|_]._|T],L) :- !, '$sv_list'(T,L). '$sv_list'([_|V].T,L) :- nonvar(V), !, '$sv_list'(T,L). From 3933ee405371cdd7134aad48e5a2fcc1407eef19 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Mon, 13 Dec 2010 20:39:12 +0000 Subject: [PATCH 03/12] fix slot initialization problem. --- C/exec.c | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/C/exec.c b/C/exec.c index 418a6721a..ca5c9b1db 100644 --- a/C/exec.c +++ b/C/exec.c @@ -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 */ @@ -1019,6 +1021,9 @@ init_stack(int arity, CELL *pt, int top, choiceptr saved_b) collection is going up in the environment chain it doesn't get confused */ EX = NULL; + /* always have an empty slots for people to use */ + CurSlot = 0; + Yap_StartSlots(); // sl = Yap_InitSlot(t); YENV = ASP; YENV[E_CP] = (CELL)P; @@ -1054,9 +1059,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 From f89f7e8e98b324b0528c5e8e3ff69fe9fc68a424 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Mon, 13 Dec 2010 21:07:35 +0000 Subject: [PATCH 04/12] PL_set_engine should always return a sensible answer, even if multi-threading is not on. --- library/dialect/swi/fli/swi.c | 1 + 1 file changed, 1 insertion(+) diff --git a/library/dialect/swi/fli/swi.c b/library/dialect/swi/fli/swi.c index fd4a45264..53ac71acf 100755 --- a/library/dialect/swi/fli/swi.c +++ b/library/dialect/swi/fli/swi.c @@ -2894,6 +2894,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 } From eec588f488df37442548800be24004aa04d3f3d0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Mon, 13 Dec 2010 21:33:43 +0000 Subject: [PATCH 05/12] distribute goal_Expansion over comma --- pl/modules.yap | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/pl/modules.yap b/pl/modules.yap index a3ed65774..2fde70cb7 100644 --- a/pl/modules.yap +++ b/pl/modules.yap @@ -309,6 +309,8 @@ module(N) :- expand_goal(G, G) :- var(G), !. +expand_goal(G, M:NG) :- + '$do_expand'(G, M, NG), !. expand_goal(M:G, M:NG) :- '$do_expand'(G, M, NG), !. expand_goal(G, NG) :- @@ -316,6 +318,25 @@ expand_goal(G, NG) :- '$do_expand'(G, M, NG), !. expand_goal(G, G). +'$do_expand'((G1,G2), CurMod, (GI1,GI2)) :- !, + '$do_expand'(G1, CurMod, GI1), + '$do_expand'(G2, CurMod, GI2). +'$do_expand'((G1;G2), CurMod, (GI1;GI2)) :- !, + '$do_expand'(G1, CurMod, GI1), + '$do_expand'(G2, CurMod, GI2). +'$do_expand'((G1*->G2), CurMod, (GI1*->GI2)) :- !, + '$do_expand'(G1, CurMod, GI1), + '$do_expand'(G2, CurMod, GI2). +'$do_expand'((G1|G2), CurMod, (GI1|GI2)) :- !, + '$do_expand'(G1, CurMod, GI1), + '$do_expand'(G2, CurMod, GI2). +'$do_expand'((G1->G2), CurMod, (GI1->GI2)) :- !, + '$do_expand'(G1, CurMod, GI1), + '$do_expand'(G2, CurMod, GI2). +'$do_expand'(\+G1, CurMod, \+GI1) :- !, + '$do_expand'(G1, CurMod, GI1). +'$do_expand'(not(G1), CurMod, not(GI1)) :- !, + '$do_expand'(G1, CurMod, GI1). '$do_expand'(G, CurMod, GI) :- ( '$pred_exists'(goal_expansion(G,GI), CurMod), From 666ef1877d16f203ed5c3d0a4b040519eba9cd4a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Mon, 13 Dec 2010 22:03:54 +0000 Subject: [PATCH 06/12] itry to respect SWI semantics on expand_goal/2. --- pl/modules.yap | 44 ++++++++++++++++++++++---------------------- pl/preds.yap | 3 ++- 2 files changed, 24 insertions(+), 23 deletions(-) diff --git a/pl/modules.yap b/pl/modules.yap index 2fde70cb7..150c8ffe0 100644 --- a/pl/modules.yap +++ b/pl/modules.yap @@ -309,8 +309,6 @@ module(N) :- expand_goal(G, G) :- var(G), !. -expand_goal(G, M:NG) :- - '$do_expand'(G, M, NG), !. expand_goal(M:G, M:NG) :- '$do_expand'(G, M, NG), !. expand_goal(G, NG) :- @@ -318,25 +316,8 @@ expand_goal(G, NG) :- '$do_expand'(G, M, NG), !. expand_goal(G, G). -'$do_expand'((G1,G2), CurMod, (GI1,GI2)) :- !, - '$do_expand'(G1, CurMod, GI1), - '$do_expand'(G2, CurMod, GI2). -'$do_expand'((G1;G2), CurMod, (GI1;GI2)) :- !, - '$do_expand'(G1, CurMod, GI1), - '$do_expand'(G2, CurMod, GI2). -'$do_expand'((G1*->G2), CurMod, (GI1*->GI2)) :- !, - '$do_expand'(G1, CurMod, GI1), - '$do_expand'(G2, CurMod, GI2). -'$do_expand'((G1|G2), CurMod, (GI1|GI2)) :- !, - '$do_expand'(G1, CurMod, GI1), - '$do_expand'(G2, CurMod, GI2). -'$do_expand'((G1->G2), CurMod, (GI1->GI2)) :- !, - '$do_expand'(G1, CurMod, GI1), - '$do_expand'(G2, CurMod, GI2). -'$do_expand'(\+G1, CurMod, \+GI1) :- !, - '$do_expand'(G1, CurMod, GI1). -'$do_expand'(not(G1), CurMod, not(GI1)) :- !, - '$do_expand'(G1, CurMod, GI1). +'$do_expand'(M:G, CurMod, M:GI) :- !, + '$do_expand'(G, M, GI). '$do_expand'(G, CurMod, GI) :- ( '$pred_exists'(goal_expansion(G,GI), CurMod), @@ -353,7 +334,26 @@ expand_goal(G, G). true ; user:goal_expansion(G, GI) - ). + ), !. +'$do_expand'((G1,G2), CurMod, (GI1,GI2)) :- + '$do_expand'(G1, CurMod, GI1), + '$do_expand'(G2, CurMod, GI2). +'$do_expand'((G1;G2), CurMod, (GI1;GI2)) :- + '$do_expand'(G1, CurMod, GI1), + '$do_expand'(G2, CurMod, GI2). +'$do_expand'((G1*->G2), CurMod, (GI1*->GI2)) :- + '$do_expand'(G1, CurMod, GI1), + '$do_expand'(G2, CurMod, GI2). +'$do_expand'((G1|G2), CurMod, (GI1|GI2)) :- + '$do_expand'(G1, CurMod, GI1), + '$do_expand'(G2, CurMod, GI2). +'$do_expand'((G1->G2), CurMod, (GI1->GI2)) :- + '$do_expand'(G1, CurMod, GI1), + '$do_expand'(G2, CurMod, GI2). +'$do_expand'(\+G1, CurMod, \+GI1) :- + '$do_expand'(G1, CurMod, GI1). +'$do_expand'(not(G1), CurMod, not(GI1)) :- + '$do_expand'(G1, CurMod, GI1). % args are: % goal to expand diff --git a/pl/preds.yap b/pl/preds.yap index 875dc1b81..77815f9e7 100644 --- a/pl/preds.yap +++ b/pl/preds.yap @@ -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 ; From eb82f5fa2a1ed91539c279b00daa092b951c2ea1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Tue, 14 Dec 2010 09:30:40 +0000 Subject: [PATCH 07/12] more fixes to recursive call execution and backtracking from within C-mode. semweb java example now working. --- C/c_interface.c | 5 ++++- C/exec.c | 4 +--- library/dialect/swi/fli/swi.c | 9 ++------- 3 files changed, 7 insertions(+), 11 deletions(-) diff --git a/C/c_interface.c b/C/c_interface.c index 4ff55d9d6..eef287b9f 100755 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -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"))); } diff --git a/C/exec.c b/C/exec.c index ca5c9b1db..7850e88f5 100644 --- a/C/exec.c +++ b/C/exec.c @@ -1021,9 +1021,6 @@ init_stack(int arity, CELL *pt, int top, choiceptr saved_b) collection is going up in the environment chain it doesn't get confused */ EX = NULL; - /* always have an empty slots for people to use */ - CurSlot = 0; - Yap_StartSlots(); // sl = Yap_InitSlot(t); YENV = ASP; YENV[E_CP] = (CELL)P; @@ -1644,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(); diff --git a/library/dialect/swi/fli/swi.c b/library/dialect/swi/fli/swi.c index 53ac71acf..611d567b5 100755 --- a/library/dialect/swi/fli/swi.c +++ b/library/dialect/swi/fli/swi.c @@ -2578,12 +2578,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 +2612,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; From 628ae12d153744fca525e059ea707b46acee52c8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Tue, 14 Dec 2010 12:04:33 +0000 Subject: [PATCH 08/12] ifix warning message. --- library/dialect/swi/fli/swi.c | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/library/dialect/swi/fli/swi.c b/library/dialect/swi/fli/swi.c index 611d567b5..7b195b6eb 100755 --- a/library/dialect/swi/fli/swi.c +++ b/library/dialect/swi/fli/swi.c @@ -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))) { From 57aafe5d2318b46f74caed27ab6f3f193b12fc96 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Tue, 14 Dec 2010 12:04:44 +0000 Subject: [PATCH 09/12] don't use with_output_to/2 from PLStream: it gets confused by whose stdout it should write to. --- library/dialect/swi.yap | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/library/dialect/swi.yap b/library/dialect/swi.yap index a31997aa7..2df4ba5c0 100755 --- a/library/dialect/swi.yap +++ b/library/dialect/swi.yap @@ -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),system:swi_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. From 828f8b07f7c6fcd468763eb678dc54675cb21eb1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Tue, 14 Dec 2010 12:39:24 +0000 Subject: [PATCH 10/12] make YAP more compatible with SWI by going inside 0 arguments (obs from Roberto). --- pl/modules.yap | 40 +++++++++++++++++++--------------------- 1 file changed, 19 insertions(+), 21 deletions(-) diff --git a/pl/modules.yap b/pl/modules.yap index 150c8ffe0..f3b2e9d78 100644 --- a/pl/modules.yap +++ b/pl/modules.yap @@ -316,6 +316,7 @@ 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) :- @@ -325,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 ; @@ -335,25 +337,21 @@ expand_goal(G, G). ; user:goal_expansion(G, GI) ), !. -'$do_expand'((G1,G2), CurMod, (GI1,GI2)) :- - '$do_expand'(G1, CurMod, GI1), - '$do_expand'(G2, CurMod, GI2). -'$do_expand'((G1;G2), CurMod, (GI1;GI2)) :- - '$do_expand'(G1, CurMod, GI1), - '$do_expand'(G2, CurMod, GI2). -'$do_expand'((G1*->G2), CurMod, (GI1*->GI2)) :- - '$do_expand'(G1, CurMod, GI1), - '$do_expand'(G2, CurMod, GI2). -'$do_expand'((G1|G2), CurMod, (GI1|GI2)) :- - '$do_expand'(G1, CurMod, GI1), - '$do_expand'(G2, CurMod, GI2). -'$do_expand'((G1->G2), CurMod, (GI1->GI2)) :- - '$do_expand'(G1, CurMod, GI1), - '$do_expand'(G2, CurMod, GI2). -'$do_expand'(\+G1, CurMod, \+GI1) :- - '$do_expand'(G1, CurMod, GI1). -'$do_expand'(not(G1), CurMod, not(GI1)) :- - '$do_expand'(G1, CurMod, GI1). +'$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 @@ -476,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, From 68539ab1e0690d8a634fdd1133098b574bfd872f Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Tue, 14 Dec 2010 23:46:17 +0000 Subject: [PATCH 11/12] make sure with_output_to argument is not rewritten. --- library/dialect/swi.yap | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/library/dialect/swi.yap b/library/dialect/swi.yap index 2df4ba5c0..13b2d444b 100755 --- a/library/dialect/swi.yap +++ b/library/dialect/swi.yap @@ -191,7 +191,7 @@ 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. % careful: with_output_to/2 requires setting user_output, and this % confuses emulation. -%goal_expansion(with_output_to(A,B),system:swi_with_output_to(A,B)) :- swi_io. +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. From bd6da9dd40670e7aff8a1c5e424b90ff25f5e772 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Wed, 15 Dec 2010 00:06:14 +0000 Subject: [PATCH 12/12] fix reconsult of multifile predicates (static). --- H/iatoms.h | 2 +- misc/ATOMS | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/H/iatoms.h b/H/iatoms.h index 734cf954f..52293d316 100644 --- a/H/iatoms.h +++ b/H/iatoms.h @@ -161,7 +161,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"); diff --git a/misc/ATOMS b/misc/ATOMS index 3277e92a7..59f70987c 100644 --- a/misc/ATOMS +++ b/misc/ATOMS @@ -166,7 +166,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"