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 1/7] 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 2/7] 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 3/7] 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 4/7] 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 5/7] 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 6/7] 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 7/7] 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,