Menu
▾
▴
yap-commits — Logs of commits to the CVS
You can subscribe to this list here.
| 2001 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
(72) |
Jul
(30) |
Aug
(31) |
Sep
(41) |
Oct
(22) |
Nov
(70) |
Dec
(98) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2002 |
Jan
(194) |
Feb
(127) |
Mar
(47) |
Apr
(83) |
May
(154) |
Jun
(149) |
Jul
(49) |
Aug
(64) |
Sep
(98) |
Oct
(104) |
Nov
(99) |
Dec
(109) |
| 2003 |
Jan
(72) |
Feb
(105) |
Mar
(76) |
Apr
(66) |
May
(20) |
Jun
(51) |
Jul
(67) |
Aug
(16) |
Sep
(24) |
Oct
(52) |
Nov
(43) |
Dec
(92) |
| 2004 |
Jan
(16) |
Feb
(145) |
Mar
(137) |
Apr
(140) |
May
(29) |
Jun
(214) |
Jul
(167) |
Aug
(202) |
Sep
(188) |
Oct
(228) |
Nov
(283) |
Dec
(250) |
| 2005 |
Jan
(107) |
Feb
(162) |
Mar
(100) |
Apr
(110) |
May
(144) |
Jun
(19) |
Jul
(23) |
Aug
(127) |
Sep
(20) |
Oct
(76) |
Nov
(85) |
Dec
(171) |
| 2006 |
Jan
(86) |
Feb
(134) |
Mar
(213) |
Apr
(70) |
May
(81) |
Jun
(25) |
Jul
(6) |
Aug
(36) |
Sep
(20) |
Oct
(21) |
Nov
(368) |
Dec
(164) |
| 2007 |
Jan
(239) |
Feb
(126) |
Mar
(148) |
Apr
(24) |
May
(48) |
Jun
(238) |
Jul
(18) |
Aug
(13) |
Sep
(59) |
Oct
(73) |
Nov
(224) |
Dec
(39) |
| 2008 |
Jan
(53) |
Feb
(92) |
Mar
(134) |
Apr
(81) |
May
(53) |
Jun
(210) |
Jul
(31) |
Aug
(38) |
Sep
|
Oct
|
Nov
|
Dec
(2) |
| 2009 |
Jan
(1) |
Feb
(1) |
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: Vitor S. C. <vs...@us...> - 2008-07-22 23:34:45
|
Update of /cvsroot/yap/pl In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv25978/pl Modified Files: boot.yap errors.yap modules.yap preds.yap statistics.yap Log Message: SWI and module fixes Index: boot.yap =================================================================== RCS file: /cvsroot/yap/pl/boot.yap,v retrieving revision 1.189 retrieving revision 1.190 diff -u -r1.189 -r1.190 --- boot.yap 11 Jul 2008 17:02:09 -0000 1.189 +++ boot.yap 22 Jul 2008 23:34:50 -0000 1.190 @@ -386,28 +386,22 @@ % not 100% compatible with SICStus Prolog, as SICStus Prolog would put % module prefixes all over the place, although unnecessarily so. % - '$go_compile_clause'(Mod:G,V,N,Source) :- !, - '$go_compile_clause'(G,V,N,Mod,Source). - '$go_compile_clause'((M:G :- B),V,N,Source) :- !, - '$current_module'(M1), - (M1 = M -> - NG = (G :- B) - ; - '$preprocess_clause_before_mod_change'((G:-B),M1,M,NG) - ), - '$go_compile_clause'(NG,V,N,M,Source). '$go_compile_clause'(G,V,N,Source) :- '$current_module'(Mod), - '$go_compile_clause'(G,V,N,Mod,Source). - - '$go_compile_clause'(G, V, N, Mod, Source) :- - '$prepare_term'(G, V, G0, G1, Mod, Source), - '$$compile'(G1, G0, N, Mod). + '$go_compile_clause'(G,V,N,Mod,Mod,Source). + +'$go_compile_clause'(M:G,V,N,_,_,Source) :- !, + '$go_compile_clause'(G,V,N,M,M,Source). +'$go_compile_clause'((M:H :- B),V,N,_,BodyMod,Source) :- !, + '$go_compile_clause'((H :- B),V,N,M,BodyMod,Source). +'$go_compile_clause'(G,V,N,HeadMod,BodyMod,Source) :- !, + '$prepare_term'(G, V, G0, G1, BodyMod, HeadMod, Source), + '$$compile'(G1, G0, N, HeadMod). - '$prepare_term'(G, V, G0, G1, Mod, Source) :- + '$prepare_term'(G, V, G0, G1, BodyMod, SourceMod, Source) :- ( get_value('$syntaxcheckflag',on) -> - '$check_term'(Source, V, Mod) ; true ), - '$precompile_term'(G, G0, G1, Mod). + '$check_term'(Source, V, BodyMod) ; true ), + '$precompile_term'(G, G0, G1, BodyMod, SourceMod). % process an input clause '$$compile'(G, G0, L, Mod) :- @@ -857,7 +851,7 @@ % repeat other code. '$is_metapredicate'(G,CurMod) -> ( - '$meta_expansion'(CurMod,CurMod,G,NG,[]) -> + '$meta_expansion'(G,CurMod,CurMod,CurMod,NG,[]) -> '$execute0'(NG, CurMod) ; '$execute0'(G, CurMod) @@ -900,7 +894,18 @@ ) ), !, - '$execute0'(Goal,NM). + Goal \= fail, + '$complete_goal'(M, Goal, NM, G). + +'$complete_goal'(M, G, CurMod, G0) :- + ( + '$is_metapredicate'(G,CurMod) + -> + '$meta_expansion'(G, CurMod, M, M, NG,[]) -> + '$execute0'(NG, CurMod) + ; + '$execute0'(G, CurMod) + ). '$find_undefp_handler'(G,M,NG,user) :- \+ '$undefined'(unknown_predicate_handler(_,_,_), user), @@ -1052,16 +1057,18 @@ % return two arguments: Expanded0 is the term after "USER" expansion. % Expanded is the final expanded term. % -'$precompile_term'(Term, Expanded0, Expanded, Mod) :- +'$precompile_term'(Term, Expanded0, Expanded, BodyMod, SourceMod) :- + '$module_expansion'(Term, Expanded0, ExpandedI, BodyMod, SourceMod), !, ( - '$access_yap_flags'(9,1) /* strict_iso on */ + '$access_yap_flags'(9,1) /* strict_iso on */ -> - '$expand_term_modules'(Term, Expanded0, Expanded, Mod), - '$check_iso_strict_clause'(Expanded0) + Expanded = ExpandedI, + '$check_iso_strict_clause'(Expanded0) ; - '$expand_term_modules'(Term, Expanded0, ExpandedI, Mod), - '$expand_array_accesses_in_term'(ExpandedI,Expanded) + '$expand_array_accesses_in_term'(ExpandedI,Expanded) ). +'$precompile_term'(Term, Term, Term, _, _). + expand_term(Term,Expanded) :- ( \+ '$undefined'(term_expansion(_,_), user), @@ -1096,13 +1103,6 @@ '$c_arrays'(Expanded0,ExpandedF), !. '$expand_array_accesses_in_term'(Expanded,Expanded). -% -% Module system expansion -% -'$expand_term_modules'(A,B,C,M) :- '$module_expansion'(A,B,C,M), !. -'$expand_term_modules'(A,A,A,_). - - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % catch/throw implementation Index: errors.yap =================================================================== RCS file: /cvsroot/yap/pl/errors.yap,v retrieving revision 1.89 retrieving revision 1.90 diff -u -r1.89 -r1.90 --- errors.yap 12 Jun 2008 10:55:52 -0000 1.89 +++ errors.yap 22 Jul 2008 23:34:50 -0000 1.90 @@ -13,6 +13,9 @@ * * * Last rev: $Date$,$Author$ * * $Log$ +* Revision 1.90 2008/07/22 23:34:50 vsc +* SWI and module fixes +* * Revision 1.89 2008/06/12 10:55:52 vsc * fix syntax error messages * @@ -227,6 +230,8 @@ print_message(force(_Severity), Msg) :- !, print(user_error,Msg). +print_message(error, error(Msg,Info)) :- var(Info), !, + print_message(error, error(Msg, '')). print_message(error, error(Msg,[Info|local_sp(P,CP,Envs,CPs)])) :- !, nb_setval(sp_info,local_sp(P,CP,Envs,CPs)), print_message(error, error(Msg, Info)), Index: modules.yap =================================================================== RCS file: /cvsroot/yap/pl/modules.yap,v retrieving revision 1.83 retrieving revision 1.84 diff -u -r1.83 -r1.84 --- modules.yap 2 Jun 2008 17:20:28 -0000 1.83 +++ modules.yap 22 Jul 2008 23:34:50 -0000 1.84 @@ -181,37 +181,22 @@ % expand module names in a clause -'$module_expansion'(((Mod:H) :- B ),((Mod:H) :- B1),((Mod:H) :- BO),M) :- !, - '$is_mt'(Mod,H,B,IB,MM), - '$prepare_body_with_correct_modules'(IB, M, B0), - '$module_u_vars'(H,UVars,M), % collect head variables in - % expanded positions - '$module_expansion'(B0,B1,BO,M,MM,M,UVars). % expand body -'$module_expansion'((H:-B),(H:-B1),(H:-BO),M) :- - '$is_mt'(M,H,B,IB,MM), +% A1: Input Clause +% A2: Output Class to Compiler (lives in module HM) +% A3: Output Class to clause/2 and listing (lives in module HM) +% +% modules: +% A4: module for body of clause (this is the one used in looking up predicates) +% A5: context module (this is the current context +% A6: head module (this is the one used in compiling and accessing). +% +'$module_expansion'((H:-B),(H:-B1),(H:-BO),M,HM) :- !, + '$is_mt'(M, H, B, IB, MM), '$module_u_vars'(H,UVars,M), % collect head variables in % expanded positions - '$module_expansion'(IB,B1,BO,M,MM,M,UVars). -% $trace_module((H:-B),(H:-B1)). - -% expand module names in a body -'$prepare_body_with_correct_modules'(V,M,M:call(V)) :- var(V), !. -'$prepare_body_with_correct_modules'((A,B),M,(A1,B1)) :- !, - '$prepare_body_with_correct_modules'(A,M,A1), - '$prepare_body_with_correct_modules'(B,M,B1). -'$prepare_body_with_correct_modules'((A;B),M,(A1;B1)) :- !, - '$prepare_body_with_correct_modules'(A,M,A1), - '$prepare_body_with_correct_modules'(B,M,B1). -'$prepare_body_with_correct_modules'((A->B),M,(A1->B1)) :- !, - '$prepare_body_with_correct_modules'(A,M,A1), - '$prepare_body_with_correct_modules'(B,M,B1). -'$prepare_body_with_correct_modules'(true,_,true) :- !. -'$prepare_body_with_correct_modules'(fail,_,fail) :- !. -'$prepare_body_with_correct_modules'(false,_,false) :- !. -'$prepare_body_with_correct_modules'(M:G,M:G) :- !. -'$prepare_body_with_correct_modules'(G,M,G) :- - '$system_predicate'(G,M), !. -'$prepare_body_with_correct_modules'(G,M,M:G). + '$module_expansion'(IB,B1,BO,M,MM,HM,UVars). +% do not expand bodyless clauses. +'$module_expansion'(H,H,H,_,_). '$trace_module'(X) :- @@ -235,79 +220,113 @@ % expand module names in a body % args are: % goals to expand -% code to pass to compiler % code to pass to listing -% current module for looking up preds -% current module for fixing up meta-call arguments -% current module for predicate +% code to pass to compiler +% current module for looking up preds M +% default module DM +% head module HM +% +% to understand the differences, you can consider: +% +% a:(d:b(X) :- g:c(X), d(X), user:hello(X)). +% +% when we process meta-predicate c, HM=d, DM=a, BM=a, M=g and we should get: +% +% d:b(X) :- g:c(g:X), a:d(X), user:hello(X). +% +% on the other hand, +% +% a:(d:b(X) :- c(X), d(X), d:e(X)). +% +% will give +% +% d:b(X) :- a:c(a:X), a:d(X), e(X). +% +% % head variables. -'$module_expansion'(V,call(MM:V),call(MM:V),_M,MM,_TM,_) :- var(V), !. -'$module_expansion'((A,B),(A1,B1),(AO,BO),M,MM,TM,HVars) :- !, - '$module_expansion'(A,A1,AO,M,MM,TM,HVars), - '$module_expansion'(B,B1,BO,M,MM,TM,HVars). -'$module_expansion'((A*->B;C),(A1*->B1;C1),(yap_hacks:current_choicepoint(DCP),AO,yap_hacks:cut_at(DCP),BO; CO),M,MM,TM,HVars) :- !, - '$module_expansion'(A,A1,AOO,M,MM,TM,HVars), +% goals or arguments/sub-arguments? +% I cannot use call here because of format/3 +'$module_expansion'(V,NG,NG,_,MM,_,HVars) :- + var(V), !, + ( '$not_in_vars'(V,HVars) + -> + NG = call(MM:V) + ; + NG = call(V) + ). +'$module_expansion'((A,B),(A1,B1),(AO,BO),M,MM,HM,HVars) :- !, + '$module_expansion'(A,A1,AO,M,MM,HM,HVars), + '$module_expansion'(B,B1,BO,M,MM,HM,HVars). +'$module_expansion'((A*->B;C),(A1*->B1;C1),(yap_hacks:current_choicepoint(DCP),AO,yap_hacks:cut_at(DCP),BO; CO),M,MM,HM,HVars) :- !, + '$module_expansion'(A,A1,AOO,M,MM,HM,HVars), '$clean_cuts'(AOO, AO), - '$module_expansion'(B,B1,BO,M,MM,TM,HVars), - '$module_expansion'(C,C1,CO,M,MM,TM,HVars). -'$module_expansion'((A;B),(A1;B1),(AO;BO),M,MM,TM,HVars) :- !, - '$module_expansion'(A,A1,AO,M,MM,TM,HVars), - '$module_expansion'(B,B1,BO,M,MM,TM,HVars). -'$module_expansion'((A|B),(A1|B1),(AO|BO),M,MM,TM,HVars) :- !, - '$module_expansion'(A,A1,AO,M,MM,TM,HVars), - '$module_expansion'(B,B1,BO,M,MM,TM,HVars). -'$module_expansion'((A->B),(A1->B1),(AO->BO),M,MM,TM,HVars) :- !, - '$module_expansion'(A,A1,AOO,M,MM,TM,HVars), + '$module_expansion'(B,B1,BO,M,MM,HM,HVars), + '$module_expansion'(C,C1,CO,M,MM,HM,HVars). +'$module_expansion'((A;B),(A1;B1),(AO;BO),M,MM,HM,HVars) :- !, + '$module_expansion'(A,A1,AO,M,MM,HM,HVars), + '$module_expansion'(B,B1,BO,M,MM,HM,HVars). +'$module_expansion'((A|B),(A1|B1),(AO|BO),M,MM,HM,HVars) :- !, + '$module_expansion'(A,A1,AO,M,MM,HM,HVars), + '$module_expansion'(B,B1,BO,M,MM,HM,HVars). +'$module_expansion'((A->B),(A1->B1),(AO->BO),M,MM,HM,HVars) :- !, + '$module_expansion'(A,A1,AOO,M,MM,HM,HVars), '$clean_cuts'(AOO, AO), - '$module_expansion'(B,B1,BO,M,MM,TM,HVars). -'$module_expansion'(\+A,\+A1,\+AO,M,MM,TM,HVars) :- !, - '$module_expansion'(A,A1,AO,M,MM,TM,HVars). -'$module_expansion'(not(A),not(A1),not(AO),M,MM,TM,HVars) :- !, - '$module_expansion'(A,A1,AO,M,MM,TM,HVars). + '$module_expansion'(B,B1,BO,M,MM,HM,HVars). +'$module_expansion'(\+A,\+A1,\+AO,M,MM,HM,HVars) :- !, + '$module_expansion'(A,A1,AO,M,MM,HM,HVars). +'$module_expansion'(not(A),not(A1),not(AO),M,MM,HM,HVars) :- !, + '$module_expansion'(A,A1,AO,M,MM,HM,HVars). '$module_expansion'(true,true,true,_,_,_,_) :- !. '$module_expansion'(fail,fail,fail,_,_,_,_) :- !. '$module_expansion'(false,false,false,_,_,_,_) :- !. % 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. '$module_expansion'(M:G,call(M:G),'$execute_wo_mod'(G,M),_,_,_,_) :- var(M), !. -'$module_expansion'(M:G,G1,GO,_,_,TM,HVars) :- - '$module_expansion'(G,G1,GO,M,M,TM,HVars). -% if M1 is given explicitly process G within M1's context. -% '$module_expansion'(M:G,G1,GO,_Mod,_MM,TM,HVars) :- !, -% % is this imported from some other module M1? -% ( '$imported_pred'(G, M, M1) -> -% % continue recursively... -% '$module_expansion'(G,G1,GO,M1,M,TM,HVars) -% ; -% ( -% '$meta_expansion'(M, M, G, NG, HVars) -% ; -% G = NG -% ), -% '$complete_goal_expansion'(NG, M, M, TM, G1, GO, HVars) -% ). -% -% next, check if this is something imported. -% -% first, try doing goal_expansion -'$module_expansion'(G, G1, G0, CurMod, MM, TM, HVars) :- +'$module_expansion'(M:G,G1,GO,_,_,HM,HVars) :- !, + '$module_expansion'(G,G1,GO,M,M,HM,HVars). +'$module_expansion'(G, G1, GO, CurMod, MM, HM, HVars) :- '$pred_goal_expansion_on', user:goal_expansion(G, CurMod, GI), !, - '$module_expansion'(GI, G1, G0, CurMod, MM, TM, HVars). -'$module_expansion'(G, G1, GO, CurMod, MM, TM, HVars) :- + '$module_expansion'(GI, G1, GO, CurMod, MM, HM, HVars). +'$module_expansion'(G, G1, GO, CurMod, MM, HM,HVars) :- % is this imported from some other module M1? - ( '$imported_pred'(G, CurMod, GG, M1) -> - '$module_expansion'(GG, G1, GO, M1, MM, TM, HVars) + '$imported_pred'(G, CurMod, GG, M1), + !, + '$module_expansion'(GG, G1, GO, M1, MM, HM,HVars). +'$module_expansion'(G, G1, GO, CurMod, MM, HM,HVars) :- + '$meta_expansion'(G, CurMod, MM, HM, GI, HVars), !, + '$complete_goal_expansion'(GI, CurMod, MM, HM, G1, GO, HVars). +'$module_expansion'(G, G1, GO, CurMod, MM, HM, HVars) :- + '$complete_goal_expansion'(G, CurMod, MM, HM, G1, GO, HVars). + +% args are: +% goal to expand +% current module for looking up pred +% current module for looking up pred +% current module from top-level clause +% goal to pass to listing +% goal to pass to compiler +% head variables. +'$complete_goal_expansion'(G, M, CM, HM, G1, G2, HVars) :- + '$all_system_predicate'(G,M,ORIG), !, + % make built-in processing transparent. + '$match_mod'(G, M, ORIG, HM, G1), + '$c_built_in'(G1, M, Gi), + (Gi \== G1 -> + '$module_expansion'(Gi, G2, _, M, CM, HM, HVars) ; - ( - '$meta_expansion'(CurMod, MM, G, GI, HVars) - -> - true - ; - GI = G - ), - '$complete_goal_expansion'(GI, CurMod, MM, TM, G1, GO, HVars) + G2 = G1 ). +'$complete_goal_expansion'(G, GMod, _, HM, NG, NG, _) :- + '$match_mod'(G, GMod, GMod, HM, NG). + +%'$match_mod'(G, GMod, GMod, NG) :- !, +% NG = G. +'$match_mod'(G, _, SM, _, G) :- SM == prolog, !. % prolog: needs no module info. +% same module as head, and body goal (I cannot get rid of qualifier before +% meta-call. +'$match_mod'(G, HMod, _, HM, G) :- HMod == HM, !. +'$match_mod'(G, GMod, _, _, GMod:G). % be careful here not to generate an undefined exception. @@ -326,29 +345,6 @@ '$exit_undefp', fail. -% args are: -% goal to expand -% current module for looking up pred -% current module from top-level clause -% goal to pass to compiler -% goal to pass to listing -% head variables. -'$complete_goal_expansion'(G, M, CM, TM, G1, G2, HVars) :- - '$all_system_predicate'(G,M), !, - '$c_built_in'(G, M, Gi), - (Gi \== G -> - '$module_expansion'(Gi, _, G2, M, CM, TM, HVars), - % make built-in processing transparent. - (TM = M -> G1 = G ; G1 = M:G) - ; TM = M -> - G2 = G, G1 = G - ; - G2 = M:G, G1 = M:G % atts: - ). -'$complete_goal_expansion'(G, Mod, _, Mod, G, G, _) :- !. -'$complete_goal_expansion'(G, GMod, _, _, GMod:G, GMod:G, _). - - % module_transparent declaration % @@ -422,53 +418,34 @@ % expand arguments of a meta-predicate % $meta_expansion(ModuleWhereDefined,CurrentModule,Goal,ExpandedGoal,MetaVariables) -'$meta_expansion'(Mod,MP,G,G1,HVars) :- +'$meta_expansion'(G,Mod,MP,HM,G1,HVars) :- functor(G,F,N), '$meta_predicate'(F,Mod,N,D), !, +% format(user_error,'[ ~w ',[G]), functor(G1,F,N), - '$meta_expansion_loop'(N,D,G,G1,HVars,MP). -% format(user_error," gives ~w~n]",[G1]). + '$meta_expansion_loop'(N, D, G, G1, HVars, Mod, MP, HM). +% format(user_error,' gives ~w]`n',[G1]). % expand argument -'$meta_expansion_loop'(0,_,_,_,_,_) :- !. -'$meta_expansion_loop'(I,D,G,G1,HVars,M) :- +'$meta_expansion_loop'(0,_,_,_,_,_,_,_) :- !. +'$meta_expansion_loop'(I,D,G,NG,HVars,CurMod,M,HM) :- arg(I,D,X), (X==':' ; integer(X)), - arg(I,G,A), '$do_expand'(A,HVars), !, - '$process_expanded_arg'(A, M, NA), - arg(I,G1,NA), + arg(I,G,A), '$do_expand'(A,HVars), + !, + arg(I,NG,M:A), I1 is I-1, - '$meta_expansion_loop'(I1,D,G,G1,HVars,M). -'$meta_expansion_loop'(I,D,G,G1,HVars,M) :- + '$meta_expansion_loop'(I1, D, G, NG, HVars, CurMod, M, HM). +'$meta_expansion_loop'(I, D, G, NG, HVars, CurMod, M, HM) :- arg(I,G,A), - arg(I,G1,A), + arg(I,NG,A), I1 is I-1, - '$meta_expansion_loop'(I1,D,G,G1,HVars,M). + '$meta_expansion_loop'(I1, D, G, NG, HVars, CurMod, M, HM). % check if an argument should be expanded '$do_expand'(V,HVars) :- var(V), !, '$not_in_vars'(V,HVars). '$do_expand'(_:_,_) :- !, fail. '$do_expand'(_,_). -'$process_expanded_arg'(V, M, M:V) :- var(V), !. -'$process_expanded_arg'((V1,V2), M, (NV1,NV2)) :- !, - '$process_expanded_arg'(V1, M, NV1), - '$process_expanded_arg'(V2, M, NV2). -'$process_expanded_arg'((V1;V2), M, (NV1;NV2)) :- !, - '$process_expanded_arg'(V1, M, NV1), - '$process_expanded_arg'(V2, M, NV2). -'$process_expanded_arg'((V1|V2), M, (NV1|NV2)) :- !, - '$process_expanded_arg'(V1, M, NV1), - '$process_expanded_arg'(V2, M, NV2). -'$process_expanded_arg'((V1->V2), M, (NV1->NV2)) :- !, - '$process_expanded_arg'(V1, M, NV1), - '$process_expanded_arg'(V2, M, NV2). -'$process_expanded_arg'(\+V, M, \+NV) :- !, - '$process_expanded_arg'(V, M, NV). -'$process_expanded_arg'(M:A, _, M:A) :- !. -%'$process_expanded_arg'(G, M, G) :- -% '$system_predicate'(G,M), !. -'$process_expanded_arg'(A, M, M:A). - '$not_in_vars'(_,[]). '$not_in_vars'(V,[X|L]) :- X\==V, '$not_in_vars'(V,L). @@ -565,43 +542,13 @@ use_module(?,:,?), when(?,:), with_mutex(+,:), + (: -> :), + (: *-> :), + (: ; :), ^(+,:), \+ : . % -% if we are asserting something in somewhere else's module, -% we need this little bird. -% -% assert((a:g :- b)) then SICStus compiles this into the original module. -% YAP is not 100% compatible, as it will transform this into: -% a:assert(g :- user:b)) -% -'$preprocess_clause_before_mod_change'((H:-B),M,M1,(H:-B1)) :- - '$module_u_vars'(H,UVars,M1), - '$preprocess_body_before_mod_change'(B,M,UVars,B1). - -'$preprocess_body_before_mod_change'(V,M,_,call(M:V)) :- var(V), !. -'$preprocess_body_before_mod_change'((G1,G2),M,UVars,(NG1,NG2)) :- !, - '$preprocess_body_before_mod_change'(G1,M,UVars,NG1), - '$preprocess_body_before_mod_change'(G2,M,UVars,NG2). -'$preprocess_body_before_mod_change'((G1;G2),M,UVars,(NG1;NG2)) :- !, - '$preprocess_body_before_mod_change'(G1,M,UVars,NG1), - '$preprocess_body_before_mod_change'(G2,M,UVars,NG2). -'$preprocess_body_before_mod_change'((G1->G2),M,UVars,(NG1->NG2)) :- !, - '$preprocess_body_before_mod_change'(G1,M,UVars,NG1), - '$preprocess_body_before_mod_change'(G2,M,UVars,NG2). -'$preprocess_body_before_mod_change'(M:G,_,_,M:G) :- !. -'$preprocess_body_before_mod_change'(true,_,_,true) :- !. -'$preprocess_body_before_mod_change'(fail,_,_,fail) :- !. -'$preprocess_body_before_mod_change'(false,_,_,false) :- !. -'$preprocess_body_before_mod_change'(G,M,UVars,M:NG) :- - '$meta_expansion'(M, M, G, NG, UVars), !. -'$preprocess_body_before_mod_change'(G,M,_,G) :- - '$system_predicate'(G,M), !. -'$preprocess_body_before_mod_change'(G,M,_,M:G). - - -% % get rid of a module and of all predicates included in the module. % abolish_module(Mod) :- Index: preds.yap =================================================================== RCS file: /cvsroot/yap/pl/preds.yap,v retrieving revision 1.79 retrieving revision 1.80 diff -u -r1.79 -r1.80 --- preds.yap 3 Jun 2008 09:24:28 -0000 1.79 +++ preds.yap 22 Jul 2008 23:34:50 -0000 1.80 @@ -51,10 +51,6 @@ var(H), !, '$do_error'(instantiation_error,P). '$assert_clause'(M1:C, G, M1, Where, R, P) :- !, '$assert_clause2'(C, G, M1, Where, R, P). -'$assert_clause'(M:C, G, M1, Where, R, P) :- !, - '$preprocess_clause_before_mod_change'((C:-G),M1,M,C1), - C1 = (NH :- NG), - '$assert_clause2'(NH, NG, M, Where, R, P). '$assert_clause'(H, G, M1, Where, R, P) :- !, '$assert_clause2'(H, G, M1, Where, R, P). @@ -108,13 +104,7 @@ '$assert_dynamic'(M:C,_,Where,R,P) :- !, '$assert_dynamic'(C,M,Where,R,P). '$assert_dynamic'((H:-G),M1,Where,R,P) :- - (var(H) -> '$do_error'(instantiation_error,P) ; H=M:C), !, - ( M1 = M -> - '$assert_dynamic'((C:-G),M1,Where,R,P) - ; - '$preprocess_clause_before_mod_change'((C:-G),M1,M,C1), - '$assert_dynamic'(C1,M,Where,R,P) - ). + var(H), !, '$do_error'(instantiation_error,P). '$assert_dynamic'(CI,Mod,Where,R,P) :- '$expand_clause'(CI,C0,C,Mod), '$assert_dynamic2'(C0,C,Mod,Where,R,P). @@ -159,13 +149,7 @@ '$assert_static'(M:C,_,Where,R,P) :- !, '$assert_static'(C,M,Where,R,P). '$assert_static'((H:-G),M1,Where,R,P) :- - (var(H) -> '$do_error'(instantiation_error,P) ; H=M:C), !, - ( M1 = M -> - '$assert_static'((C:-G),M1,Where,R,P) - ; - '$preprocess_clause_before_mod_change'((C:-G),M1,M,C1), - '$assert_static'(C1,M,Where,R,P) - ). + var(H), !, '$do_error'(instantiation_error,P). '$assert_static'(CI,Mod,Where,R,P) :- '$expand_clause'(CI,C0,C,Mod), '$check_head_and_body'(C,H,B,P), @@ -753,7 +737,7 @@ '$expand_clause'(C0,C1,C2,Mod) :- - '$expand_term_modules'(C0, C1, C2, Mod), + '$module_expansion'(C0, C1, C2, Mod, Mod), ( get_value('$strict_iso',on) -> '$check_iso_strict_clause'(C1) ; @@ -845,9 +829,9 @@ '$predicate_property'(P,M,_,static) :- \+ '$is_dynamic'(P,M), \+ '$undefined'(P,M). -'$predicate_property'(P,M,_,meta_predicate(P)) :- +'$predicate_property'(P,M,_,meta_predicate(Q)) :- functor(P,Na,Ar), - '$meta_predicate'(M,Na,Ar,P). + '$meta_predicate'(Na,M,Ar,Q). '$predicate_property'(P,M,_,multifile) :- '$is_multifile'(P,M). '$predicate_property'(P,M,_,public) :- Index: statistics.yap =================================================================== RCS file: /cvsroot/yap/pl/statistics.yap,v retrieving revision 1.10 retrieving revision 1.11 diff -u -r1.10 -r1.11 --- statistics.yap 16 Jun 2008 21:22:15 -0000 1.10 +++ statistics.yap 22 Jul 2008 23:34:50 -0000 1.11 @@ -37,42 +37,42 @@ '$statistics'(Runtime,CPUtime,Walltime,HpSpa,HpInUse,HpMax,TrlSpa, TrlInUse,_TrlMax,StkSpa, GlobInU, LocInU,GlobMax,LocMax,NOfHO,TotHOTime,NOfSO,TotSOTime,NOfTO,TotTOTime,NOfGC,TotGCTime,TotGCSize,NOfAGC,TotAGCTime,TotAGCSize) :- TotalMemory is HpSpa+StkSpa+TrlSpa, - format(user_error,"memory (total)~t~d bytes~35+~n", [TotalMemory]), - format(user_error," program space~t~d bytes~35+", [HpSpa]), - format(user_error,":~t ~d in use~19+", [HpInUse]), + format(user_error,'memory (total)~t~d bytes~35+~n', [TotalMemory]), + format(user_error,' program space~t~d bytes~35+', [HpSpa]), + format(user_error,':~t ~d in use~19+', [HpInUse]), HpFree is HpSpa-HpInUse, - format(user_error,",~t ~d free~19+~n", [HpFree]), - format(user_error,"~t ~d max~73+~n", [HpMax]), - format(user_error," stack space~t~d bytes~35+", [StkSpa]), + format(user_error,',~t ~d free~19+~n', [HpFree]), + format(user_error,'~t ~d max~73+~n', [HpMax]), + format(user_error,' stack space~t~d bytes~35+', [StkSpa]), StackInUse is GlobInU+LocInU, - format(user_error,":~t ~d in use~19+", [StackInUse]), + format(user_error,':~t ~d in use~19+', [StackInUse]), StackFree is StkSpa-StackInUse, - format(user_error,",~t ~d free~19+~n", [StackFree]), - format(user_error," global stack:~t~35+", []), - format(user_error," ~t ~d in use~19+", [GlobInU]), - format(user_error,",~t ~d max~19+~n", [GlobMax]), - format(user_error," local stack:~t~35+", []), - format(user_error," ~t ~d in use~19+", [LocInU]), - format(user_error,",~t ~d max~19+~n", [LocMax]), - format(user_error," trail stack~t~d bytes~35+", [TrlSpa]), - format(user_error,":~t ~d in use~19+", [TrlInUse]), + format(user_error,',~t ~d free~19+~n', [StackFree]), + format(user_error,' global stack:~t~35+', []), + format(user_error,' ~t ~d in use~19+', [GlobInU]), + format(user_error,',~t ~d max~19+~n', [GlobMax]), + format(user_error,' local stack:~t~35+', []), + format(user_error,' ~t ~d in use~19+', [LocInU]), + format(user_error,',~t ~d max~19+~n', [LocMax]), + format(user_error,' trail stack~t~d bytes~35+', [TrlSpa]), + format(user_error,':~t ~d in use~19+', [TrlInUse]), TrlFree is TrlSpa-TrlInUse, - format(user_error,",~t ~d free~19+~n", [TrlFree]), + format(user_error,',~t ~d free~19+~n', [TrlFree]), OvfTime is (TotHOTime+TotSOTime+TotTOTime)/1000, - format(user_error,"~n~t~3f~12+ sec. for ~w code, ~w stack, and ~w trail space overflows~n", + format(user_error,'~n~t~3f~12+ sec. for ~w code, ~w stack, and ~w trail space overflows~n', [OvfTime,NOfHO,NOfSO,NOfTO]), TotGCTimeF is float(TotGCTime)/1000, - format(user_error,"~t~3f~12+ sec. for ~w garbage collections which collected ~d bytes~n", + format(user_error,'~t~3f~12+ sec. for ~w garbage collections which collected ~d bytes~n', [TotGCTimeF,NOfGC,TotGCSize]), TotAGCTimeF is float(TotAGCTime)/1000, - format(user_error,"~t~3f~12+ sec. for ~w atom garbage collections which collected ~d bytes~n", + format(user_error,'~t~3f~12+ sec. for ~w atom garbage collections which collected ~d bytes~n', [TotAGCTimeF,NOfAGC,TotAGCSize]), RTime is float(Runtime)/1000, - format(user_error,"~t~3f~12+ sec. runtime~n", [RTime]), + format(user_error,'~t~3f~12+ sec. runtime~n', [RTime]), CPUTime is float(CPUtime)/1000, - format(user_error,"~t~3f~12+ sec. cputime~n", [CPUTime]), + format(user_error,'~t~3f~12+ sec. cputime~n', [CPUTime]), WallTime is float(Walltime)/1000, - format(user_error,"~t~3f~12+ sec. elapsed time~n~n", [WallTime]), + format(user_error,'~t~3f~12+ sec. elapsed time~n~n', [WallTime]), fail. '$statistics'(_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_). |
|
From: Vitor S. C. <vs...@us...> - 2008-07-22 23:34:44
|
Update of /cvsroot/yap/library In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv25978/library Modified Files: lists.yap swi.yap Log Message: SWI and module fixes Index: lists.yap =================================================================== RCS file: /cvsroot/yap/library/lists.yap,v retrieving revision 1.17 retrieving revision 1.18 diff -u -r1.17 -r1.18 --- lists.yap 11 Jul 2008 17:02:09 -0000 1.17 +++ lists.yap 22 Jul 2008 23:34:49 -0000 1.18 @@ -17,12 +17,15 @@ nth/4, nth0/3, nth0/4, + nth1/3, + nth1/4, permutation/2, prefix/2, remove_duplicates/2, reverse/2, same_length/2, select/3, + selectchk/3, sublist/2, substitute/4, sum_list/2, @@ -31,9 +34,12 @@ list_concat/2, flatten/2, max_list/2, - min_list/2 + min_list/2, + numlist/3 ]). +:- ensure_loaded(library(error)). + % append(Prefix, Suffix, Combined) % is true when all three arguments are lists, and the members of Combined @@ -125,6 +131,14 @@ find_nth0(M, Tail, Elem). +nth1(V, In, Element) :- var(V), !, + generate_nth(1, V, In, Element). +nth1(1, [Head|_], Head) :- !. +nth1(N, [_|Tail], Elem) :- + nonvar(N), !, + M is N-1, % should be succ(M, N) + find_nth(M, Tail, Elem). + nth(V, In, Element) :- var(V), !, generate_nth(1, V, In, Element). nth(1, [Head|_], Head) :- !. @@ -168,6 +182,13 @@ +nth1(V, In, Element, Tail) :- var(V), !, + generate_nth(1, V, In, Element, Tail). +nth1(1, [Head|Tail], Head, Tail) :- !. +nth1(N, [Head|Tail], Elem, [Head|Rest]) :- + M is N-1, + nth1(M, Tail, Elem, Rest). + nth(V, In, Element, Tail) :- var(V), !, generate_nth(1, V, In, Element, Tail). nth(1, [Head|Tail], Head, Tail) :- !. @@ -243,6 +264,15 @@ same_length([_|List1], [_|List2]) :- same_length(List1, List2). +%% selectchk(+Elem, +List, -Rest) is semidet. +% +% Semi-deterministic removal of first element in List that unifies +% Elem. + +selectchk(Elem, List, Rest) :- + select(Elem, List, Rest0), !, + Rest = Rest0. + % select(?Element, ?Set, ?Residue) % is true when Set is a list, Element occurs in Set, and Residue is @@ -315,6 +345,7 @@ % flatten(X,Y) :- flatten_list(X,Y,[]). +flatten_list(V) --> {var(V)}, !. flatten_list([]) --> !. flatten_list([H|T]) --> !, flatten_list(H),flatten_list(T). flatten_list(H) --> [H]. @@ -345,3 +376,22 @@ min_list(L, Max0, Max) ). +%% numlist(+Low, +High, -List) is semidet. +% +% List is a list [Low, Low+1, ... High]. Fails if High < Low.% +% +% @error type_error(integer, Low) +% @error type_error(integer, High) + +numlist(L, U, Ns) :- + must_be(integer, L), + must_be(integer, U), + L =< U, + numlist_(L, U, Ns). + +numlist_(U, U, [U]) :- !. +numlist_(L, U, [L|Ns]) :- + succ(L, L2), + numlist_(L2, U, Ns). + + Index: swi.yap =================================================================== RCS file: /cvsroot/yap/library/swi.yap,v retrieving revision 1.28 retrieving revision 1.29 diff -u -r1.28 -r1.29 --- swi.yap 16 Jul 2008 10:45:47 -0000 1.28 +++ swi.yap 22 Jul 2008 23:34:50 -0000 1.29 @@ -19,9 +19,9 @@ append/3, delete/3, member/2, - memberchk/2, min_list/2, - nth/3]). + nth1/3, + nth0/3]). :- use_module(library(system), [datime/1, @@ -51,34 +51,40 @@ ; true. -:- use_module(library(maplist)). - :- multifile swi_predicate_table/4. -swi_predicate_table(_,maplist(X,Y),maplist,maplist(X,Y)). -swi_predicate_table(_,maplist(X,Y,Z),maplist,maplist(X,Y,Z)). -swi_predicate_table(_,maplist(X,Y,Z,W),maplist,maplist(X,Y,Z,W)). swi_predicate_table(_,append(X,Y),lists,append(X,Y)). swi_predicate_table(_,append(X,Y,Z),lists,append(X,Y,Z)). swi_predicate_table(_,member(X,Y),lists,member(X,Y)). swi_predicate_table(_,nextto(X,Y,Z),lists,nextto(X,Y,Z)). -swi_predicate_table(_,is_list(X),lists,is_list(X)). -swi_predicate_table(_,min_list(X,Y),lists,min_list(X,Y)). -swi_predicate_table(_,nth(X,Y,Z),lists,nth(X,Y,Z)). swi_predicate_table(_,delete(X,Y,Z),lists,delete(X,Y,Z)). -swi_predicate_table(_,nth1(X,Y,Z),lists,nth(X,Y,Z)). -swi_predicate_table(_,memberchk(X,Y),lists,memberchk(X,Y)). -swi_predicate_table(_,flatten(X,Y),lists,flatten(X,Y)). swi_predicate_table(_,select(X,Y,Z),lists,select(X,Y,Z)). +swi_predicate_table(_,selectchk(X,Y,Z),lists,selectchk(X,Y,Z)). +swi_predicate_table(_,nth0(X,Y,Z),lists,nth0(X,Y,Z)). +swi_predicate_table(_,nth1(X,Y,Z),lists,nth1(X,Y,Z)). +swi_predicate_table(_,last(X,Y),lists,last(X,Y)). +swi_predicate_table(_,reverse(X,Y),lists,reverse(X,Y)). +swi_predicate_table(_,permutation(X,Y),lists,permutation(X,Y)). +swi_predicate_table(_,flatten(X,Y),lists,flatten(X,Y)). +swi_predicate_table(_,sumlist(X,Y),lists,sumlist(X,Y)). +swi_predicate_table(_,min_list(X,Y),lists,min_list(X,Y)). +swi_predicate_table(_,max_list(X,Y),lists,max_list(X,Y)). +swi_predicate_table(_,memberchk(X,Y),lists,memberchk(X,Y)). swi_predicate_table(_,hash_term(X,Y),terms,term_hash(X,Y)). swi_predicate_table(_,term_hash(X,Y),terms,term_hash(X,Y)). -swi_predicate_table(_,term_variables(X,Y),terms,term_variables(X,Y)). -swi_predicate_table(_,term_variables(X,Y,Z),terms,term_variables(X,Y,Z)). swi_predicate_table(_,subsumes(X,Y),terms,subsumes(X,Y)). swi_predicate_table(_,unifiable(X,Y,Z),terms,unifiable(X,Y,Z)). swi_predicate_table(_,genarg(X,Y,Z),arg,genarg(X,Y,Z)). swi_predicate_table(_,tmp_file(X,Y),system,tmp_file(X,Y)). +swi_isl(X) :- lists:is_list(X). + +prolog:is_list(X) :- swi_isl(X). + +swi_mchk(X,Y) :- lists:memberchk(X,Y). + +prolog:memberchk(X,Y) :- swi_mchk(X,Y). + :- dynamic prolog:message/3. @@ -100,6 +106,15 @@ :- meta_predicate prolog:predsort(:,+,-). +switv(X,Y) :- term_variables(X, Y). +switv(X,Y,Z) :- term_variables(X, Y, Z). + +prolog:term_variables(X, Y) :- + switv(X, Y). + +prolog:term_variables(X, Y, Z) :- + switv(X, Y, Z). + prolog:plus(X, Y, Z) :- integer(X), integer(Y), !, @@ -318,3 +333,92 @@ prolog:(Term1 =@= Term2) :- variant(Term1, Term2), !. +% copied from SWI's boot/apply library +:- module_transparent + prolog:maplist/2, + maplist2/2, + prolog:maplist/3, + maplist2/3, + prolog:maplist/4, + maplist2/4, + prolog:maplist/5, + maplist2/5. + +% maplist(:Goal, +List) +% +% True if Goal can succesfully be applied on all elements of List. +% Arguments are reordered to gain performance as well as to make +% the predicate deterministic under normal circumstances. + +prolog:maplist(Goal, List) :- + maplist2(List, Goal). + +maplist2([], _). +maplist2([Elem|Tail], Goal) :- + call(Goal, Elem), + maplist2(Tail, Goal). + +% maplist(:Goal, ?List1, ?List2) +% +% True if Goal can succesfully be applied to all succesive pairs +% of elements of List1 and List2. + +prolog:maplist(Goal, List1, List2) :- + maplist2(List1, List2, Goal). + +maplist2([], [], _). +maplist2([Elem1|Tail1], [Elem2|Tail2], Goal) :- + call(Goal, Elem1, Elem2), + maplist2(Tail1, Tail2, Goal). + +% maplist(:Goal, ?List1, ?List2, ?List3) +% +% True if Goal can succesfully be applied to all succesive triples +% of elements of List1..List3. + +prolog:maplist(Goal, List1, List2, List3) :- + maplist2(List1, List2, List3, Goal). + +maplist2([], [], [], _). +maplist2([Elem1|Tail1], [Elem2|Tail2], [Elem3|Tail3], Goal) :- + call(Goal, Elem1, Elem2, Elem3), + maplist2(Tail1, Tail2, Tail3, Goal). + +% maplist(:Goal, ?List1, ?List2, ?List3, List4) +% +% True if Goal can succesfully be applied to all succesive +% quadruples of elements of List1..List4 + +prolog:maplist(Goal, List1, List2, List3, List4) :- + maplist2(List1, List2, List3, List4, Goal). + +maplist2([], [], [], [], _). +maplist2([Elem1|Tail1], [Elem2|Tail2], [Elem3|Tail3], [Elem4|Tail4], Goal) :- + call(Goal, Elem1, Elem2, Elem3, Elem4), + maplist2(Tail1, Tail2, Tail3, Tail4, Goal). + +prolog:compile_aux_clauses([]). +prolog:compile_aux_clauses([(:- G)|Cls]) :- + prolog_load_context(module, M), + once(M:G), + prolog:compile_aux_clauses(Cls). +prolog:compile_aux_clauses([Cl|Cls]) :- + prolog_load_context(module, M), + assert_static(M:Cl), + prolog:compile_aux_clauses(Cls). + +% +% convert from SWI's goal expansion to YAP/SICStus old style goal +% expansion. +% +user:term_expansion(goal_expansion(A,B),O) :- + prolog_load_context(module, user), !, + O = goal_expansion(A,user,B). +user:term_expansion(user:goal_expansion(A,B),O) :- !, + O = user:goal_expansion(A,_,B). +user:term_expansion((goal_expansion(A,B) :- G), O) :- + prolog_load_context(module, user), !, + O = (goal_expansion(A,user,B) :- G). +user:term_expansion((user:goal_expansion(A,B) :- G),O) :- + O = (user:goal_expansion(A,_,B) :- G). + |
|
From: Vitor S. C. <vs...@us...> - 2008-07-22 23:34:43
|
Update of /cvsroot/yap/C In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv25978/C Modified Files: cdmgr.c exec.c init.c iopreds.c Log Message: SWI and module fixes Index: cdmgr.c =================================================================== RCS file: /cvsroot/yap/C/cdmgr.c,v retrieving revision 1.230 retrieving revision 1.231 diff -u -r1.230 -r1.231 --- cdmgr.c 2 Jun 2008 17:20:28 -0000 1.230 +++ cdmgr.c 22 Jul 2008 23:34:44 -0000 1.231 @@ -13,6 +13,9 @@ * * * Last rev: $Date$,$Author$ * * $Log$ +* Revision 1.231 2008/07/22 23:34:44 vsc +* SWI and module fixes +* * Revision 1.230 2008/06/02 17:20:28 vsc * fix abolish bug * @@ -4788,6 +4791,13 @@ return FALSE; if (EndOfPAEntr(pe)) return FALSE; + if (pe->ModuleOfPred) { + if (!Yap_unify(ARG3,pe->ModuleOfPred)) + return FALSE; + } else { + if (!Yap_unify(ARG3,TermProlog)) + return FALSE; + } return(!pe->ModuleOfPred || /* any predicate in prolog module */ /* any C-pred */ pe->PredFlags & (UserCPredFlag|CPredFlag|BinaryTestPredFlag|AsmPredFlag|TestPredFlag) || @@ -4832,7 +4842,7 @@ } else return (FALSE); if (EndOfPAEntr(pe)) - return(FALSE); + return FALSE; pe->PredFlags |= HiddenPredFlag; return(TRUE); } @@ -6163,7 +6173,7 @@ Yap_InitCPred("$set_pred_module", 2, p_set_pred_module, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$parent_pred", 3, p_parent_pred, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$system_predicate", 2, p_system_pred, SafePredFlag|HiddenPredFlag); - Yap_InitCPred("$all_system_predicate", 2, p_all_system_pred, SafePredFlag|HiddenPredFlag); + Yap_InitCPred("$all_system_predicate", 3, p_all_system_pred, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$hide_predicate", 2, p_hide_predicate, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$hidden_predicate", 2, p_hidden_predicate, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$pred_for_code", 5, p_pred_for_code, SyncPredFlag|HiddenPredFlag); Index: exec.c =================================================================== RCS file: /cvsroot/yap/C/exec.c,v retrieving revision 1.139 retrieving revision 1.140 diff -u -r1.139 -r1.140 --- exec.c 4 Jun 2008 14:47:18 -0000 1.139 +++ exec.c 22 Jul 2008 23:34:44 -0000 1.140 @@ -664,6 +664,7 @@ } } pe = PredPropByFunc(f, mod); + // Yap_DebugPlWrite(mod);fprintf(stderr,"\n"); arity = ArityOfFunctor(f); /* I cannot use the standard macro here because otherwise I would dereference the argument and Index: init.c =================================================================== RCS file: /cvsroot/yap/C/init.c,v retrieving revision 1.172 retrieving revision 1.173 diff -u -r1.172 -r1.173 --- init.c 10 May 2008 23:24:12 -0000 1.172 +++ init.c 22 Jul 2008 23:34:48 -0000 1.173 @@ -1212,6 +1212,7 @@ Yap_heap_regs->functor_arrow = Yap_MkFunctor(AtomArrow, 2); Yap_heap_regs->functor_assert = Yap_MkFunctor(AtomAssert, 2); Yap_heap_regs->functor_at_found_one = Yap_MkFunctor(AtomFoundVar, 2); + Yap_heap_regs->functor_atom = Yap_MkFunctor(Yap_LookupAtom("atom"), 1); #ifdef COROUTINING Yap_heap_regs->functor_att_goal = Yap_MkFunctor(Yap_FullLookupAtom("$att_do"),2); #endif Index: iopreds.c =================================================================== RCS file: /cvsroot/yap/C/iopreds.c,v retrieving revision 1.183 retrieving revision 1.184 diff -u -r1.183 -r1.184 --- iopreds.c 11 Jul 2008 17:02:07 -0000 1.183 +++ iopreds.c 22 Jul 2008 23:34:48 -0000 1.184 @@ -2781,21 +2781,29 @@ return sno; } -static Int -p_open_mem_write_stream (void) /* $open_mem_write_stream(-Stream) */ +static int +OpenBufWriteStream(void) { - Term t; - int sno; char *nbuf; extern int Yap_page_size; + while ((nbuf = (char *)Yap_AllocAtomSpace(Yap_page_size*sizeof(char))) == NULL) { if (!Yap_growheap(FALSE, Yap_page_size*sizeof(char), NULL)) { Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); - return(FALSE); + return -1; } } - sno = open_buf_write_stream(nbuf, Yap_page_size); + return open_buf_write_stream(nbuf, Yap_page_size); +} + +static Int +p_open_mem_write_stream (void) /* $open_mem_write_stream(-Stream) */ +{ + Term t; + int sno; + + sno = OpenBufWriteStream(); if (sno == -1) return (PlIOError (SYSTEM_ERROR,TermNil, "new stream not available for open_mem_read_stream/1")); t = MkStream (sno); @@ -5337,18 +5345,41 @@ p_format2(void) { /* 'format'(Stream,Control,Args) */ int old_c_stream = Yap_c_output_stream; + int mem_stream = FALSE; Int out; + Term tin = Deref(ARG1); - /* needs to change Yap_c_output_stream for write */ - Yap_c_output_stream = CheckStream (ARG1, Output_Stream_f, "format/3"); + if (IsVarTerm(tin)) { + Yap_Error(INSTANTIATION_ERROR,tin,"format/3"); + return FALSE; + } + if (IsApplTerm(tin) && FunctorOfTerm(tin) == FunctorAtom) { + Yap_c_output_stream = OpenBufWriteStream(); + mem_stream = TRUE; + } else { + /* needs to change Yap_c_output_stream for write */ + Yap_c_output_stream = CheckStream (ARG1, Output_Stream_f, "format/3"); + } UNLOCK(Stream[Yap_c_output_stream].streamlock); if (Yap_c_output_stream == -1) { Yap_c_output_stream = old_c_stream; - return(FALSE); + return FALSE; } out = format(Deref(ARG2),Deref(ARG3),Yap_c_output_stream); - Yap_c_output_stream = old_c_stream; - return(out); + if (mem_stream) { + Term tat; + int stream = Yap_c_output_stream; + Yap_c_output_stream = old_c_stream; + if (out) { + tat = MkAtomTerm(Yap_LookupAtom(Stream[stream].u.mem_string.buf)); + CloseStream(stream); + if (!Yap_unify(tat,ArgOfTerm(1,ARG1))) + return FALSE; + } + } else { + Yap_c_output_stream = old_c_stream; + } + return out; } @@ -5421,7 +5452,7 @@ if (IsVarTerm(t1)) { Yap_Error(INSTANTIATION_ERROR,t1,"stream_select/3"); - return(FALSE); + return FALSE; } if (!IsPairTerm(t1)) { Yap_Error(TYPE_ERROR_LIST,t1,"stream_select/3"); |
|
From: Vitor S. C. <vs...@us...> - 2008-07-22 23:34:43
|
Update of /cvsroot/yap/docs In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv25978/docs Modified Files: yap.tex Log Message: SWI and module fixes Index: yap.tex =================================================================== RCS file: /cvsroot/yap/docs/yap.tex,v retrieving revision 1.259 retrieving revision 1.260 diff -u -r1.259 -r1.260 --- yap.tex 16 Jul 2008 10:45:46 -0000 1.259 +++ yap.tex 22 Jul 2008 23:34:49 -0000 1.260 @@ -6249,7 +6249,7 @@ @table @code -@item expand_term(@var{T},-@var{X}) +@item user:expand_term(@var{T},-@var{X}) @findex expand_term/2 @syindex expand_term/2 @cyindex expand_term/2 @@ -6260,7 +6260,7 @@ term read when consulting a file and before asserting or executing it. It rewrites a term @var{T} to a term @var{X} according to the following rules: first try to use the user defined predicate -@code{term_expansion/2}. If this call fails then the translating process +@code{user:term_expansion/2}. If this call fails then the translating process for DCG rules is applied, together with the arithmetic optimizer whenever the compilation of arithmetic expressions is in progress. @@ -8525,22 +8525,28 @@ is more efficient when it is applicable. @item nth0(?@var{N}, ?@var{List}, ?@var{Elem}) -@findex nth0/2 -@syindex nth0/2 -@cnindex nth0/2 +@findex nth0/3 +@syindex nth0/3 +@cnindex nth0/3 True when @var{Elem} is the Nth member of @var{List}, counting the first as element 0. (That is, throw away the first N elements and unify @var{Elem} with the next.) It can only be used to select a particular element given the list and index. For that task it is more efficient than @code{member/2} -@item nth(?@var{N}, ?@var{List}, ?@var{Elem}) -@findex nth/2 -@syindex nth/2 -@cnindex nth/2 +@item nth1(?@var{N}, ?@var{List}, ?@var{Elem}) +@findex nth1/3 +@syindex nth1/3 +@cnindex nth1/3 The same as @code{nth0/3}, except that it counts from 1, that is @code{nth(1, [H|_], H)}. +@item nth(?@var{N}, ?@var{List}, ?@var{Elem}) +@findex nth/3 +@syindex nth/3 +@cnindex nth/3 +The same as @code{nth1/3}. + @item nth0(?@var{N}, ?@var{List}, ?@var{Elem}, ?@var{Rest}) @findex nth0/4 @syindex nth0/4 @@ -8553,10 +8559,10 @@ @code{[a,b,c,d,e]}. @code{nth/4} is the same except that it counts from 1. @code{nth0/4} can be used to insert @var{Elem} after the Nth element of @var{Rest}. -@item nth(?@var{N}, ?@var{List}, ?@var{Elem}, ?@var{Rest}) -@findex nth/4 -@syindex nth/4 -@cnindex nth/4 +@item nth1(?@var{N}, ?@var{List}, ?@var{Elem}, ?@var{Rest}) +@findex nth1/4 +@syindex nth1/4 +@cnindex nth1/4 Unifies @var{Elem} with the Nth element of @var{List}, counting from 1, and @var{Rest} with the other elements. It can be used to select the Nth element of @var{List} (yielding @var{Elem} and @var{Rest}), or to @@ -8565,6 +8571,12 @@ [a,b,d,e])} unifies List with @code{[a,b,c,d,e]}. @code{nth/4} can be used to insert @var{Elem} after the Nth element of @var{Rest}. +@item nth(?@var{N}, ?@var{List}, ?@var{Elem}, ?@var{Rest}) +@findex nth/4 +@syindex nth/4 +@cnindex nth/4 +Same as @code{nth1/4}. + @item permutation(+@var{List},?@var{Perm}) @findex permutation/2 @syindex permutation/2 @@ -8596,12 +8608,26 @@ the other; mode @code{same_length(-,-)} generates two lists of the same length, in which case the arguments will be bound to lists of length 0, 1, 2, ... -@item select(?@var{Element}, ?@var{Set}, ?@var{Residue}) +@item select(?@var{Element}, ?@var{List}, ?@var{Residue}) @findex select/3 @syindex select/3 @cnindex select/3 -True when @var{Set} is a list, @var{Element} occurs in @var{Set}, and @var{Residue} is -everything in @var{Set} except @var{Element} (things stay in the same order). +True when @var{Set} is a list, @var{Element} occurs in @var{List}, and +@var{Residue} is everything in @var{List} except @var{Element} (things +stay in the same order). + +@item selectchk(?@var{Element}, ?@var{List}, ?@var{Residue}) +@findex selectchk/3 +@snindex selectchk/3 +@cnindex selectchk/3 +Semi-deterministic selection from a list. Steadfast: defines as + +@example +selectchk(Elem, List, Residue) :- + select(Elem, List, Rest0), !, + Rest = Rest0. +@end example + @item sublist(?@var{Sublist}, ?@var{List}) @findex sublist/2 @@ -8641,6 +8667,14 @@ @cnindex min_list/2 True when @var{Numbers} is a list of numbers, and @var{Min} is the minimum. +@item numlist(+@var{Low}, +@var{High}, +@var{List}) +@findex numlist/3 +@syindex numlist/3 +@cnindex numlist/3 +If @var{Low} and @var{High} are integers with @var{Low} @geq{} +@var{High}, unify @var{List} to a list @code{[Low, Low+1, ...High]}. See +also @code{between/3}. + @end table @node matrix, MATLAB, Lists, Library |
|
From: Vitor S. C. <vs...@us...> - 2008-07-22 23:34:43
|
Update of /cvsroot/yap/H In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv25978/H Modified Files: Heap.h amidefs.h rheap.h Log Message: SWI and module fixes Index: Heap.h =================================================================== RCS file: /cvsroot/yap/H/Heap.h,v retrieving revision 1.132 retrieving revision 1.133 diff -u -r1.132 -r1.133 --- Heap.h 28 May 2008 17:18:35 -0000 1.132 +++ Heap.h 22 Jul 2008 23:34:49 -0000 1.133 @@ -449,6 +449,7 @@ functor_arrow, functor_assert, functor_at_found_one, + functor_atom, #ifdef COROUTINING functor_att_goal, /* goal that activates attributed variables */ #endif @@ -762,6 +763,7 @@ #define FunctorArrow Yap_heap_regs->functor_arrow #define FunctorAssert Yap_heap_regs->functor_assert #define FunctorAtFoundOne Yap_heap_regs->functor_at_found_one +#define FunctorAtom Yap_heap_regs->functor_atom #ifdef COROUTINING #define FunctorAttGoal Yap_heap_regs->functor_att_goal #endif Index: amidefs.h =================================================================== RCS file: /cvsroot/yap/H/amidefs.h,v retrieving revision 1.33 retrieving revision 1.34 diff -u -r1.33 -r1.34 --- amidefs.h 26 Nov 2007 23:43:09 -0000 1.33 +++ amidefs.h 22 Jul 2008 23:34:49 -0000 1.34 @@ -13,6 +13,9 @@ * * * Last rev: $Date$ * * $Log$ + * Revision 1.34 2008/07/22 23:34:49 vsc + * SWI and module fixes + * * Revision 1.33 2007/11/26 23:43:09 vsc * fixes to support threads and assert correctly, even if inefficiently. * @@ -230,11 +233,6 @@ CELL next; } d; struct { - CODEADDR d; - struct pred_entry *p; - CELL next; - } dp; - struct { Int ClTrail; Int ClENV; Int ClRefs; Index: rheap.h =================================================================== RCS file: /cvsroot/yap/H/rheap.h,v retrieving revision 1.98 retrieving revision 1.99 diff -u -r1.98 -r1.99 --- rheap.h 12 May 2008 22:31:37 -0000 1.98 +++ rheap.h 22 Jul 2008 23:34:49 -0000 1.99 @@ -13,6 +13,9 @@ * * * Last rev: $Date$,$Author$ * * $Log$ +* Revision 1.99 2008/07/22 23:34:49 vsc +* SWI and module fixes +* * Revision 1.98 2008/05/12 22:31:37 vsc * fix previous fixes * @@ -774,6 +777,7 @@ Yap_heap_regs->functor_arrow = FuncAdjust(Yap_heap_regs->functor_arrow); Yap_heap_regs->functor_assert = FuncAdjust(Yap_heap_regs->functor_assert); Yap_heap_regs->functor_at_found_one = FuncAdjust(Yap_heap_regs->functor_at_found_one); + Yap_heap_regs->functor_atom = FuncAdjust(Yap_heap_regs->functor_atom); #ifdef COROUTINING Yap_heap_regs->functor_att_goal = FuncAdjust(Yap_heap_regs->functor_att_goal); #endif |
|
From: Vitor S. C. <vs...@us...> - 2008-07-22 23:34:43
|
Update of /cvsroot/yap/GPL In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv25978/GPL Modified Files: aggregate.pl error.pl Log Message: SWI and module fixes Index: aggregate.pl =================================================================== RCS file: /cvsroot/yap/GPL/aggregate.pl,v retrieving revision 1.3 retrieving revision 1.4 diff -u -r1.3 -r1.4 --- aggregate.pl 13 Mar 2008 14:37:58 -0000 1.3 +++ aggregate.pl 22 Jul 2008 23:34:49 -0000 1.4 @@ -42,10 +42,6 @@ :- use_module(library(error)). :- use_module(library(lists)). -:- if(current_prolog_flag(dialect, yap)). -:- use_module(library(maplist)). -:- endif. - :- module_transparent foreach/2, aggregate/3, Index: error.pl =================================================================== RCS file: /cvsroot/yap/GPL/error.pl,v retrieving revision 1.2 retrieving revision 1.3 diff -u -r1.2 -r1.3 --- error.pl 15 May 2008 13:41:45 -0000 1.2 +++ error.pl 22 Jul 2008 23:34:49 -0000 1.3 @@ -163,20 +163,6 @@ ; type_error(Type, X) ). -:- if(current_prolog_flag(dialect, yap)). - -% vsc: I hope it works like this -'$skip_list'(_, Rest, Rest) :- var(Rest), !. -'$skip_list'(_, [], _) :- !, fail. -'$skip_list'(Anything, [_|More], Rest) :- - '$skip_list'(Anything, [_|More], Rest). -'$skip_list'(Anything, [_|More], Rest) :- - '$skip_list'(Anything, More, Rest). -'$skip_list'(_Anything, Rest, Rest). - -:- endif. - - not_a_rational(X) :- ( var(X) -> instantiation_error(X) @@ -259,3 +245,18 @@ is_list_or_partial_list(L0) :- '$skip_list'(_, L0,L), ( var(L) -> true ; L == [] ). + +:- if(current_prolog_flag(dialect, yap)). + +% vsc: I hope it works like this +'$skip_list'(_, Rest, Rest) :- var(Rest), !. +'$skip_list'(_, [], _) :- !, fail. +'$skip_list'(Anything, [_|More], Rest) :- + '$skip_list'(Anything, [_|More], Rest). +'$skip_list'(Anything, [_|More], Rest) :- + '$skip_list'(Anything, More, Rest). +'$skip_list'(_Anything, Rest, Rest). + +:- endif. + + |
|
From: Vitor S. C. <vs...@us...> - 2008-07-22 23:34:41
|
Update of /cvsroot/yap In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv25978 Modified Files: changes-5.1.html Log Message: SWI and module fixes |
|
From: Vitor S. C. <vs...@us...> - 2008-07-16 10:58:53
|
Update of /cvsroot/yap/H In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv23835/H Modified Files: YapOpcodes.h Log Message: small fixes Index: YapOpcodes.h =================================================================== RCS file: /cvsroot/yap/H/YapOpcodes.h,v retrieving revision 1.44 retrieving revision 1.45 diff -u -r1.44 -r1.45 --- YapOpcodes.h 25 Mar 2008 22:03:13 -0000 1.44 +++ YapOpcodes.h 16 Jul 2008 10:58:59 -0000 1.45 @@ -13,6 +13,9 @@ * * * Last rev: $Date$ * * $Log$ +* Revision 1.45 2008/07/16 10:58:59 vsc +* small fixes +* * Revision 1.44 2008/03/25 22:03:13 vsc * fix some icc warnings * @@ -250,10 +253,10 @@ OPCODE(call_cpred ,sla), OPCODE(call_usercpred ,sla), OPCODE(call_c_wfail ,sdl), - OPCODE(call_bfunc_xx ,lxx), - OPCODE(call_bfunc_xy ,lxy), - OPCODE(call_bfunc_yx ,lxy), - OPCODE(call_bfunc_yy ,lyy), + OPCODE(call_bfunc_xx ,llxx), + OPCODE(call_bfunc_xy ,llxy), + OPCODE(call_bfunc_yx ,llxy), + OPCODE(call_bfunc_yy ,llyy), OPCODE(cut_t ,e), OPCODE(cut_e ,sla), OPCODE(try_clause ,ld), @@ -286,7 +289,7 @@ OPCODE(switch_on_func ,sssl), OPCODE(go_on_func ,sssl), OPCODE(if_func ,sssl), - OPCODE(if_not_then ,cll), + OPCODE(if_not_then ,clll), OPCODE(index_dbref ,e), OPCODE(index_blob ,e), OPCODE(trust_fail ,e), @@ -311,7 +314,7 @@ OPCODE(write_n_atoms ,sc), OPCODE(unify_n_voids ,os), OPCODE(write_n_voids ,s), - OPCODE(glist_valx ,ss), /* peephole */ + OPCODE(glist_valx ,xx), /* peephole */ OPCODE(glist_valy ,xy), /* peephole */ OPCODE(fcall ,sla), OPCODE(dexecute ,pp), |
|
From: Vitor S. C. <vs...@us...> - 2008-07-16 10:58:53
|
Update of /cvsroot/yap/pl In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv23835/pl Modified Files: messages.yap Log Message: small fixes Index: messages.yap =================================================================== RCS file: /cvsroot/yap/pl/messages.yap,v retrieving revision 1.14 retrieving revision 1.15 diff -u -r1.14 -r1.15 --- messages.yap 11 Jul 2008 17:02:10 -0000 1.14 +++ messages.yap 16 Jul 2008 10:58:59 -0000 1.15 @@ -142,7 +142,7 @@ ( { var(Msg) } ; { var(Info)} ), !, ['bad error ~w' - [error(Msg,Info)]]. system_message(error(consistency_error(Who),Where)) --> - [ 'CONSISTENCY ERROR- ~w ~w' - [Who,Where] ]. + [ 'CONSISTENCY ERROR (arguments not compatible with format)- ~w ~w' - [Who,Where] ]. system_message(error(context_error(Goal,Who),Where)) --> [ 'CONTEXT ERROR- ~w: ~w appeared in ~w' - [Goal,Who,Where] ]. system_message(error(domain_error(DomainType,Opt), Where)) --> |
|
From: Vitor S. C. <vs...@us...> - 2008-07-16 10:58:53
|
Update of /cvsroot/yap In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv23835 Modified Files: changes-5.1.html Log Message: small fixes |
|
From: Vitor S. C. <vs...@us...> - 2008-07-16 10:45:41
|
Update of /cvsroot/yap/library In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv19009/library Modified Files: apply_macros.yap swi.yap Log Message: add extra versions to maplist and fix apply macros to handle predicates with the same aargument. Index: apply_macros.yap =================================================================== RCS file: /cvsroot/yap/library/apply_macros.yap,v retrieving revision 1.5 retrieving revision 1.6 diff -u -r1.5 -r1.6 --- apply_macros.yap 11 Jul 2008 17:02:07 -0000 1.5 +++ apply_macros.yap 16 Jul 2008 10:45:47 -0000 1.6 @@ -14,7 +14,10 @@ :- module(apply_macros, [selectlist/3, checklist/2, + maplist/2, maplist/3, + maplist/4, + maplist/5, convlist/3, mapargs/3, sumargs/4, @@ -31,7 +34,10 @@ :- meta_predicate selectlist(:,+,-), checklist(:,+), + maplist(:,+), maplist(:,+,-), + maplist(:,+,+,-), + maplist(:,+,+,+,-), convlist(:,+,-), mapargs(:,+,-), mapargs_args(:,+,-,+), @@ -121,6 +127,15 @@ call(Pred, In), checklist(Pred, ListIn). +% maplist(Pred, OldList) +% succeeds when Pred(Old,New) succeeds for each corresponding +% Old in OldList, New in NewList. In InterLisp, this is MAPCAR. +% It is also MAP2C. Isn't bidirectionality wonderful? +maplist(_, []). +maplist(Pred, [In|ListIn]) :- + call(Pred, In), + maplist(Pred, ListIn). + % maplist(Pred, OldList, NewList) % succeeds when Pred(Old,New) succeeds for each corresponding % Old in OldList, New in NewList. In InterLisp, this is MAPCAR. @@ -130,6 +145,24 @@ call(Pred, In, Out), maplist(Pred, ListIn, ListOut). +% maplist(Pred, List1, List2, List3) +% succeeds when Pred(Old,New) succeeds for each corresponding +% Gi in Listi, New in NewList. In InterLisp, this is MAPCAR. +% It is also MAP2C. Isn't bidirectionality wonderful? +maplist(_, [], [], []). +maplist(Pred, [A1|L1], [A2|L2], [A3|L3]) :- + call(Pred, A1, A2, A3), + maplist(Pred, L1, L2, L3). + +% maplist(Pred, List1, List2, List3, List4) +% succeeds when Pred(Old,New) succeeds for each corresponding +% Gi in Listi, New in NewList. In InterLisp, this is MAPCAR. +% It is also MAP2C. Isn't bidirectionality wonderful? +maplist(_, [], [], [], []). +maplist(Pred, [A1|L1], [A2|L2], [A3|L3], [A4|L4]) :- + call(Pred, A1, A2, A3, A4), + maplist(Pred, L1, L2, L3, L4). + % convlist(Rewrite, OldList, NewList) % is a sort of hybrid of maplist/3 and sublist/3. % Each element of NewList is the image under Rewrite of some @@ -234,7 +267,7 @@ !, aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module), % the new goal - pred_name(maplist, Proto, GoalName), + pred_name(maplist, 3, Proto, GoalName), append(MetaVars, [ListIn, ListOut], GoalArgs), Goal =.. [GoalName|GoalArgs], % the new predicate declaration @@ -253,7 +286,26 @@ !, aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module), % the new goal - pred_name(checklist, Proto, GoalName), + pred_name(checklist, 2, Proto, GoalName), + append(MetaVars, [List], GoalArgs), + Goal =.. [GoalName|GoalArgs], + % the new predicate declaration + HeadPrefix =.. [GoalName|PredVars], + append_args(HeadPrefix, [[]], Base), + append_args(HeadPrefix, [[In|Ins]], RecursionHead), + append_args(Pred, [In], Apply), + append_args(HeadPrefix, [Ins], RecursiveCall), + compile_aux([ + Base, + (RecursionHead :- Apply, RecursiveCall) + ], Module). + +user:goal_expansion(maplist(Meta, List), Mod, Goal) :- + callable(Meta), + !, + aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module), + % the new goal + pred_name(maplist, 2, Proto, GoalName), append(MetaVars, [List], GoalArgs), Goal =.. [GoalName|GoalArgs], % the new predicate declaration @@ -267,12 +319,50 @@ (RecursionHead :- Apply, RecursiveCall) ], Module). +user:goal_expansion(maplist(Meta, L1, L2, L3), Mod, Goal) :- + callable(Meta), + !, + aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module), + % the new goal + pred_name(maplist, 4, Proto, GoalName), + append(MetaVars, [L1, L2, L3], GoalArgs), + Goal =.. [GoalName|GoalArgs], + % the new predicate declaration + HeadPrefix =.. [GoalName|PredVars], + append_args(HeadPrefix, [[], [], []], Base), + append_args(HeadPrefix, [[A1|A1s], [A2|A2s], [A3|A3s]], RecursionHead), + append_args(Pred, [A1, A2, A3], Apply), + append_args(HeadPrefix, [A1s, A2s, A3s], RecursiveCall), + compile_aux([ + Base, + (RecursionHead :- Apply, RecursiveCall) + ], Module). + +user:goal_expansion(maplist(Meta, L1, L2, L3, L4), Mod, Goal) :- + callable(Meta), + !, + aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module), + % the new goal + pred_name(maplist, 5, Proto, GoalName), + append(MetaVars, [L1, L2, L3, L4], GoalArgs), + Goal =.. [GoalName|GoalArgs], + % the new predicate declaration + HeadPrefix =.. [GoalName|PredVars], + append_args(HeadPrefix, [[], [], [], []], Base), + append_args(HeadPrefix, [[A1|A1s], [A2|A2s], [A3|A3s], [A4|A4s]], RecursionHead), + append_args(Pred, [A1, A2, A3, A4], Apply), + append_args(HeadPrefix, [A1s, A2s, A3s, A4s], RecursiveCall), + compile_aux([ + Base, + (RecursionHead :- Apply, RecursiveCall) + ], Module). + user:goal_expansion(selectlist(Meta, ListIn, ListOut), Mod, Goal) :- callable(Meta), !, aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module), % the new goal - pred_name(selectlist, Proto, GoalName), + pred_name(selectlist, 3, Proto, GoalName), append(MetaVars, [ListIn, ListOut], GoalArgs), Goal =.. [GoalName|GoalArgs], % the new predicate declaration @@ -294,7 +384,7 @@ !, aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module), % the new goal - pred_name(include, Proto, GoalName), + pred_name(include, 3, Proto, GoalName), append(MetaVars, [ListIn, ListOut], GoalArgs), Goal =.. [GoalName|GoalArgs], % the new predicate declaration @@ -315,7 +405,7 @@ !, aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module), % the new goal - pred_name(exclude, Proto, GoalName), + pred_name(exclude, 3, Proto, GoalName), append(MetaVars, [ListIn, ListOut], GoalArgs), Goal =.. [GoalName|GoalArgs], % the new predicate declaration @@ -336,7 +426,7 @@ !, aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module), % the new goal - pred_name(partition, Proto, GoalName), + pred_name(partition, 4, Proto, GoalName), append(MetaVars, [ListIn, List1, List2], GoalArgs), Goal =.. [GoalName|GoalArgs], % the new predicate declaration @@ -357,7 +447,7 @@ !, aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module), % the new goal - pred_name(partition2, Proto, GoalName), + pred_name(partition2, 5, Proto, GoalName), append(MetaVars, [ListIn, List1, List2, List3], GoalArgs), Goal =.. [GoalName|GoalArgs], % the new predicate declaration @@ -395,7 +485,7 @@ !, aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module), % the new goal - pred_name(convlist, Proto, GoalName), + pred_name(convlist, 3, Proto, GoalName), append(MetaVars, [ListIn, ListOut], GoalArgs), Goal =.. [GoalName|GoalArgs], % the new predicate declaration @@ -416,7 +506,7 @@ !, aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module), % the new goal - pred_name(sumlist, Proto, GoalName), + pred_name(sumlist, 4, Proto, GoalName), append(MetaVars, [List, AccIn, AccOut], GoalArgs), Goal =.. [GoalName|GoalArgs], % the new predicate declaration @@ -457,7 +547,7 @@ !, aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module), % the new goal - pred_name(mapnodes, Proto, GoalName), + pred_name(mapnodes, 3, Proto, GoalName), append(MetaVars, [[InTerm], [OutTerm]], GoalArgs), Goal =.. [GoalName|GoalArgs], % the new predicate declaration @@ -487,7 +577,7 @@ !, aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module), % the new goal - pred_name(checknodes, Proto, GoalName), + pred_name(checknodes, 2, Proto, GoalName), append(MetaVars, [[Term]], GoalArgs), Goal =.. [GoalName|GoalArgs], % the new predicate declaration @@ -515,7 +605,7 @@ !, aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module), % the new goal - pred_name(sumnodes, Proto, GoalName), + pred_name(sumnodes, 4, Proto, GoalName), append(MetaVars, [[Term], AccIn, AccOut], GoalArgs), Goal =.. [GoalName|GoalArgs], % the new predicate declaration @@ -583,7 +673,7 @@ aux_args([Arg|Args], MVars, [Arg|PArgs], PVars, [Arg|ProtoArgs]) :- aux_args(Args, MVars, PArgs, PVars, ProtoArgs). -pred_name(Macro, Proto, Name) :- - format_to_chars('\'~a(~w)\'.',[Macro, Proto], Chars), +pred_name(Macro, Arity, Proto, Name) :- + format_to_chars('\'~a(~d,~w)\'.',[Macro, Arity, Proto], Chars), read_from_chars(Chars, Name). Index: swi.yap =================================================================== RCS file: /cvsroot/yap/library/swi.yap,v retrieving revision 1.27 retrieving revision 1.28 diff -u -r1.27 -r1.28 --- swi.yap 16 Jul 2008 10:34:00 -0000 1.27 +++ swi.yap 16 Jul 2008 10:45:47 -0000 1.28 @@ -58,6 +58,10 @@ swi_predicate_table(_,maplist(X,Y),maplist,maplist(X,Y)). swi_predicate_table(_,maplist(X,Y,Z),maplist,maplist(X,Y,Z)). swi_predicate_table(_,maplist(X,Y,Z,W),maplist,maplist(X,Y,Z,W)). +swi_predicate_table(_,append(X,Y),lists,append(X,Y)). +swi_predicate_table(_,append(X,Y,Z),lists,append(X,Y,Z)). +swi_predicate_table(_,member(X,Y),lists,member(X,Y)). +swi_predicate_table(_,nextto(X,Y,Z),lists,nextto(X,Y,Z)). swi_predicate_table(_,is_list(X),lists,is_list(X)). swi_predicate_table(_,min_list(X,Y),lists,min_list(X,Y)). swi_predicate_table(_,nth(X,Y,Z),lists,nth(X,Y,Z)). @@ -65,9 +69,6 @@ swi_predicate_table(_,nth1(X,Y,Z),lists,nth(X,Y,Z)). swi_predicate_table(_,memberchk(X,Y),lists,memberchk(X,Y)). swi_predicate_table(_,flatten(X,Y),lists,flatten(X,Y)). -swi_predicate_table(_,member(X,Y),lists,member(X,Y)). -swi_predicate_table(_,append(X,Y),lists,append(X,Y)). -swi_predicate_table(_,append(X,Y,Z),lists,append(X,Y,Z)). swi_predicate_table(_,select(X,Y,Z),lists,select(X,Y,Z)). swi_predicate_table(_,hash_term(X,Y),terms,term_hash(X,Y)). swi_predicate_table(_,term_hash(X,Y),terms,term_hash(X,Y)). |
|
From: Vitor S. C. <vs...@us...> - 2008-07-16 10:45:40
|
Update of /cvsroot/yap In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv19009 Modified Files: changes-5.1.html Log Message: add extra versions to maplist and fix apply macros to handle predicates with the same aargument. |
|
From: Vitor S. C. <vs...@us...> - 2008-07-16 10:45:40
|
Update of /cvsroot/yap/docs In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv19009/docs Modified Files: yap.tex Log Message: add extra versions to maplist and fix apply macros to handle predicates with the same aargument. Index: yap.tex =================================================================== RCS file: /cvsroot/yap/docs/yap.tex,v retrieving revision 1.258 retrieving revision 1.259 diff -u -r1.258 -r1.259 --- yap.tex 11 Jul 2008 17:02:07 -0000 1.258 +++ yap.tex 16 Jul 2008 10:45:46 -0000 1.259 @@ -8025,6 +8025,30 @@ Creates @var{ListOut} by applying the predicate @var{Pred} to all elements of @var{ListIn}. +@item maplist(+@var{Pred}, ?@var{ListIn}) +@findex maplist/3 +@snindex maplist/3 +@cnindex maplist/3 + Creates @var{ListOut} by applying the predicate @var{Pred} to all +elements of @var{ListIn}. + +@item maplist(+@var{Pred}, ?@var{L1}, ?@var{L2}, ?@var{L3}) +@findex maplist/4 +@snindex maplist/4 +@cnindex maplist/4 + @var{L1}, @var{L2}, and @var{L3} are such that + @code{call(@var{Pred},@var{A1},@var{A2},@var{A3})} holds for every + corresponding element in lists @var{L1}, @var{L2}, and @var{L3}. + +@item maplist(+@var{Pred}, ?@var{L1}, ?@var{L2}, ?@var{L3}, ?@var{L4}) +@findex maplist/5 +@snindex maplist/5 +@cnindex maplist/5 + @var{L1}, @var{L2}, @var{L3}, and @var{L4} are such that + @code{call(@var{Pred},@var{A1},@var{A2},@var{A3},@var{A4})} holds + for every corresponding element in lists @var{L1}, @var{L2}, @var{L3}, and + @var{L4}. + @item checklist(+@var{Pred}, +@var{List}) @findex checklist/2 @snindex checklist/2 |
|
From: Vitor S. C. <vs...@us...> - 2008-07-16 10:34:02
|
Update of /cvsroot/yap/library In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv14146/library Modified Files: swi.yap Log Message: flatten does not need to be defined as a system predicate. Index: swi.yap =================================================================== RCS file: /cvsroot/yap/library/swi.yap,v retrieving revision 1.26 retrieving revision 1.27 diff -u -r1.26 -r1.27 --- swi.yap 22 May 2008 23:25:21 -0000 1.26 +++ swi.yap 16 Jul 2008 10:34:00 -0000 1.27 @@ -64,6 +64,7 @@ swi_predicate_table(_,delete(X,Y,Z),lists,delete(X,Y,Z)). swi_predicate_table(_,nth1(X,Y,Z),lists,nth(X,Y,Z)). swi_predicate_table(_,memberchk(X,Y),lists,memberchk(X,Y)). +swi_predicate_table(_,flatten(X,Y),lists,flatten(X,Y)). swi_predicate_table(_,member(X,Y),lists,member(X,Y)). swi_predicate_table(_,append(X,Y),lists,append(X,Y)). swi_predicate_table(_,append(X,Y,Z),lists,append(X,Y,Z)). @@ -316,26 +317,3 @@ prolog:(Term1 =@= Term2) :- variant(Term1, Term2), !. -%% flatten(+List1, ?List2) is det. -% -% Is true it List2 is a non nested version of List1. -% -% @deprecated Ending up needing flatten/3 often indicates, -% like append/3 for appending two lists, a bad -% design. Efficient code that generates lists -% from generated small lists must use difference -% lists, often possible through grammar rules for -% optimal readability. - -prolog:flatten(List, FlatList) :- - flatten(List, [], FlatList0), !, - FlatList = FlatList0. - -flatten(Var, Tl, [Var|Tl]) :- - var(Var), !. -flatten([], Tl, Tl) :- !. -flatten([Hd|Tl], Tail, List) :- !, - flatten(Hd, FlatHeadTail, List), - flatten(Tl, Tail, FlatHeadTail). -flatten(NonList, Tl, [NonList|Tl]). - |
|
From: Vitor S. C. <vs...@us...> - 2008-07-11 17:02:32
|
Update of /cvsroot/yap/include In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv30868/include Modified Files: YapInterface.h Log Message: fixes by Bart and Tom: mostly libraries but nasty one in indexing compilation. Index: YapInterface.h =================================================================== RCS file: /cvsroot/yap/include/YapInterface.h,v retrieving revision 1.29 retrieving revision 1.30 diff -u -r1.29 -r1.30 --- YapInterface.h 17 Jun 2008 13:37:51 -0000 1.29 +++ YapInterface.h 11 Jul 2008 17:02:07 -0000 1.30 @@ -341,15 +341,15 @@ #endif /* SFUNC */ -/* YAP_Term YAP_SetOutputMessage() */ + extern X_API void PROTO(YAP_SetOutputMessage,(void)); -/* YAP_Term YAP_SetOutputMessage() */ extern X_API int PROTO(YAP_StreamToFileNo,(YAP_Term)); -/* YAP_Term YAP_SetOutputMessage() */ extern X_API void PROTO(YAP_CloseAllOpenStreams,(void)); +extern X_API void PROTO(YAP_FlushAllStreams,(void)); + #define YAP_INPUT_STREAM 0x01 #define YAP_OUTPUT_STREAM 0x02 #define YAP_APPEND_STREAM 0x04 |
|
From: Vitor S. C. <vs...@us...> - 2008-07-11 17:02:32
|
Update of /cvsroot/yap/docs In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv30868/docs Modified Files: yap.tex Log Message: fixes by Bart and Tom: mostly libraries but nasty one in indexing compilation. Index: yap.tex =================================================================== RCS file: /cvsroot/yap/docs/yap.tex,v retrieving revision 1.257 retrieving revision 1.258 diff -u -r1.257 -r1.258 --- yap.tex 26 Jun 2008 13:09:15 -0000 1.257 +++ yap.tex 11 Jul 2008 17:02:07 -0000 1.258 @@ -1663,8 +1663,9 @@ @item compilation_mode(+@var{Mode}) This extension controls how procedures are compiled. If @var{Mode} - is @code{compile} clauses are compiled and no source code is stored; - is @code{assert_all} clauses are asserted into the data-base. + is @code{compact} clauses are compiled and no source code is stored; + if it is @code{source} clauses are compiled and source code is stored; + if it is @code{assert_all} clauses are asserted into the data-base. @end table @item ensure_loaded(@var{+F}) [ISO] @@ -14148,6 +14149,15 @@ three streams, that are always associated with the three standard Unix streams. It is most useful if you are doing @code{fork()}. +@findex YAP_FlushAllStreams (C-Interface function) +Last, one may sometimes need to flush all streams: +@example + void YAP_CloseAllOpenStreams(void) +@end example +@noindent +It is also useful before you do a @code{fork()}, or otherwise you may +have trouble with unflushed output. + @findex YAP_OpenStream (C-Interface function) The next routine allows a currently open file to become a stream. The routine receives as arguments a file descriptor, the true file name as a |
|
From: Vitor S. C. <vs...@us...> - 2008-07-11 17:02:31
|
Update of /cvsroot/yap/C In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv30868/C Modified Files: amasm.c c_interface.c index.c iopreds.c Log Message: fixes by Bart and Tom: mostly libraries but nasty one in indexing compilation. Index: amasm.c =================================================================== RCS file: /cvsroot/yap/C/amasm.c,v retrieving revision 1.101 retrieving revision 1.102 diff -u -r1.101 -r1.102 --- amasm.c 1 Apr 2008 22:28:41 -0000 1.101 +++ amasm.c 11 Jul 2008 17:02:07 -0000 1.102 @@ -13,6 +13,10 @@ * * * Last rev: $Date$ * * $Log$ +* Revision 1.102 2008/07/11 17:02:07 vsc +* fixes by Bart and Tom: mostly libraries but nasty one in indexing +* compilation. +* * Revision 1.101 2008/04/01 22:28:41 vsc * put YAPOR back to life. * @@ -3573,7 +3577,6 @@ DBTerm *x; StaticClause *cl; UInt osize; - if(!(x = fetch_clause_space(&t,size,cip,&osize))) { return NULL; } Index: c_interface.c =================================================================== RCS file: /cvsroot/yap/C/c_interface.c,v retrieving revision 1.119 retrieving revision 1.120 diff -u -r1.119 -r1.120 --- c_interface.c 17 Jun 2008 13:37:48 -0000 1.119 +++ c_interface.c 11 Jul 2008 17:02:07 -0000 1.120 @@ -12,6 +12,10 @@ * * * Last rev: $Date$,$Author$ * * $Log$ +* Revision 1.120 2008/07/11 17:02:07 vsc +* fixes by Bart and Tom: mostly libraries but nasty one in indexing +* compilation. +* * Revision 1.119 2008/06/17 13:37:48 vsc * fix c_interface not to crash when people try to recover slots that are * not there. @@ -439,6 +443,7 @@ X_API void STD_PROTO(YAP_SetOutputMessage, (void)); X_API int STD_PROTO(YAP_StreamToFileNo, (Term)); X_API void STD_PROTO(YAP_CloseAllOpenStreams,(void)); +X_API void STD_PROTO(YAP_FlushAllStreams,(void)); X_API Term STD_PROTO(YAP_OpenStream,(void *, char *, Term, int)); X_API long STD_PROTO(YAP_CurrentSlot,(void)); X_API long STD_PROTO(YAP_NewSlots,(int)); @@ -2010,6 +2015,16 @@ RECOVER_H(); } +X_API void +YAP_FlushAllStreams(void) +{ + BACKUP_H(); + + Yap_FlushStreams(); + + RECOVER_H(); +} + X_API Term YAP_OpenStream(void *fh, char *name, Term nm, int flags) { Index: index.c =================================================================== RCS file: /cvsroot/yap/C/index.c,v retrieving revision 1.201 retrieving revision 1.202 diff -u -r1.201 -r1.202 --- index.c 10 May 2008 23:24:11 -0000 1.201 +++ index.c 11 Jul 2008 17:02:07 -0000 1.202 @@ -13,6 +13,10 @@ * * * Last rev: $Date$,$Author$ * * $Log$ +* Revision 1.202 2008/07/11 17:02:07 vsc +* fixes by Bart and Tom: mostly libraries but nasty one in indexing +* compilation. +* * Revision 1.201 2008/05/10 23:24:11 vsc * fix threads and LU * @@ -1490,7 +1494,7 @@ case _write_x_val: case _write_x_loc: case _write_x_var: - cl = NEXTOP(cl,e); + cl = NEXTOP(cl,x); break; case _save_b_x: case _put_list: Index: iopreds.c =================================================================== RCS file: /cvsroot/yap/C/iopreds.c,v retrieving revision 1.182 retrieving revision 1.183 diff -u -r1.182 -r1.183 --- iopreds.c 16 Jun 2008 21:22:13 -0000 1.182 +++ iopreds.c 11 Jul 2008 17:02:07 -0000 1.183 @@ -5395,7 +5395,12 @@ fflush (NULL); #endif - return (TRUE); + return TRUE; +} + +void Yap_FlushStreams(void) +{ + (void)p_flush_all_streams(); } #if HAVE_SELECT |
|
From: Vitor S. C. <vs...@us...> - 2008-07-11 17:02:31
|
Update of /cvsroot/yap/H In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv30868/H Modified Files: yapio.h Log Message: fixes by Bart and Tom: mostly libraries but nasty one in indexing compilation. Index: yapio.h =================================================================== RCS file: /cvsroot/yap/H/yapio.h,v retrieving revision 1.41 retrieving revision 1.42 diff -u -r1.41 -r1.42 --- yapio.h 25 Mar 2008 22:03:14 -0000 1.41 +++ yapio.h 11 Jul 2008 17:02:07 -0000 1.42 @@ -300,6 +300,7 @@ #endif int STD_PROTO(Yap_GetStreamFd,(int)); void STD_PROTO(Yap_CloseStreams,(int)); +void STD_PROTO(Yap_FlushStreams,(void)); void STD_PROTO(Yap_CloseStream,(int)); int STD_PROTO(Yap_PlGetchar,(void)); int STD_PROTO(Yap_PlGetWchar,(void)); |
|
From: Vitor S. C. <vs...@us...> - 2008-07-11 17:02:04
|
Update of /cvsroot/yap/pl In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv30868/pl Modified Files: boot.yap consult.yap messages.yap Log Message: fixes by Bart and Tom: mostly libraries but nasty one in indexing compilation. Index: boot.yap =================================================================== RCS file: /cvsroot/yap/pl/boot.yap,v retrieving revision 1.188 retrieving revision 1.189 diff -u -r1.188 -r1.189 --- boot.yap 16 Jun 2008 21:22:15 -0000 1.188 +++ boot.yap 11 Jul 2008 17:02:09 -0000 1.189 @@ -300,7 +300,8 @@ '$execute_commands'([],_,_,_) :- !, fail. '$execute_commands'([C|Cs],VL,Con,Source) :- !, ( - '$execute_command'(C,VL,Con,Source) + '$execute_command'(C,VL,Con,Source), + fail ; '$execute_commands'(Cs,VL,Con,Source) ), @@ -1064,7 +1065,7 @@ expand_term(Term,Expanded) :- ( \+ '$undefined'(term_expansion(_,_), user), - user:term_expansion(Term,Expanded) + once(user:term_expansion(Term,Expanded)) ; '$expand_term_grammar'(Term,Expanded) ), Index: consult.yap =================================================================== RCS file: /cvsroot/yap/pl/consult.yap,v retrieving revision 1.77 retrieving revision 1.78 diff -u -r1.77 -r1.78 --- consult.yap 12 Jun 2008 10:55:52 -0000 1.77 +++ consult.yap 11 Jul 2008 17:02:10 -0000 1.78 @@ -27,7 +27,7 @@ % silent(true,false) => implemented % stream(Stream) => implemented % consult(consult,reconsult) => implemented -% compilation_mode(compile,source,assert_all) => implemented +% compilation_mode(compact,source,assert_all) => implemented % load_files(Files,Opts) :- '$load_files'(Files,Opts,load_files(Files,Opts)). @@ -92,7 +92,7 @@ nb_setval('$lf_verbose',silent). '$process_lf_opt'(skip_unix_comments,_,_,_,_,_,_,_,_,skip_unix_comments,_,_,_,_). '$process_lf_opt'(compilation_mode(source),_,_,_,_,_,_,_,_,_,source,_,_,_). -'$process_lf_opt'(compilation_mode(compile),_,_,_,_,_,_,_,_,_,compile,_,_,_). +'$process_lf_opt'(compilation_mode(compact),_,_,_,_,_,_,_,_,_,compact,_,_,_). '$process_lf_opt'(compilation_mode(assert_all),_,_,_,_,_,_,_,_,_,assert_all,_,_,_). '$process_lf_opt'(silent(false),_,_,_,_,_,_,_,_,_,_,_,_,_). '$process_lf_opt'(consult(reconsult),_,_,_,_,_,_,_,_,_,_,reconsult,_,_). @@ -253,7 +253,7 @@ ), '$change_alias_to_stream'('$loop_stream',OldStream), '$set_yap_flags'(18,GenerateDebug), - '$comp_mode'(_, OldCompMode), + '$comp_mode'(CompMode, OldCompMode), nb_setval('$consulting',Old), nb_setval('$consulting_file',OldF), cd(OldD), @@ -872,33 +872,22 @@ '$if_directive'((:- elif(_))). '$if_directive'((:- endif)). -'$comp_mode'(OldCompMode, CompMode) :- - ( - nb_getval('$assert_all',on) - -> - OldCompMode = assert_all - ; - '$access_yap_flags'(11,1) - -> - OldCompMode = source - ; - OldCompMode = compile - ), - ( - var(CompMode) -> - true - ; - CompMode == assert_all - -> - nb_setval('$assert_all',on) - ; - CompMode == source - -> - nb_setval('$assert_all',off), - '$set_yap_flags'(11,1) - ; - nb_setval('$assert_all',off), - '$set_yap_flags'(11,0) - ). +'$comp_mode'(_OldCompMode, CompMode) :- + var(CompMode), !. % just do nothing. +'$comp_mode'(OldCompMode, assert_all) :- + '$fetch_comp_status'(OldCompMode), + nb_setval('$assert_all',on). +'$comp_mode'(OldCompMode, source) :- + '$fetch_comp_status'(OldCompMode), + '$set_yap_flags'(11,1). +'$comp_mode'(OldCompMode, compact) :- + '$fetch_comp_status'(OldCompMode), + '$set_yap_flags'(11,0). + +'$fetch_comp_status'(assert_all) :- + nb_getval('$assert_all',on), !. +'$fetch_comp_status'(source) :- + '$get_yap_flags'(11,1). +'$fetch_comp_status'(compact). Index: messages.yap =================================================================== RCS file: /cvsroot/yap/pl/messages.yap,v retrieving revision 1.13 retrieving revision 1.14 diff -u -r1.13 -r1.14 --- messages.yap 16 Jun 2008 21:22:15 -0000 1.13 +++ messages.yap 11 Jul 2008 17:02:10 -0000 1.14 @@ -106,7 +106,7 @@ system_message(debug(trace)) --> [ 'Trace mode on.' ]. system_message(declaration(Args,Action)) --> - [ 'declaration ~w ~w.', [Args,Action] ]. + [ 'declaration ~w ~w.' - [Args,Action] ]. system_message(defined_elsewhere(P,F)) --> [ 'predicate ~q previously defined in file ~w' - [P,F] ]. system_message(import(Pred,To,From,private)) --> |
|
From: Vitor S. C. <vs...@us...> - 2008-07-11 17:02:03
|
Update of /cvsroot/yap/library In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv30868/library Modified Files: apply_macros.yap dgraphs.yap lists.yap rbtrees.yap splay.yap trees.yap Log Message: fixes by Bart and Tom: mostly libraries but nasty one in indexing compilation. Index: apply_macros.yap =================================================================== RCS file: /cvsroot/yap/library/apply_macros.yap,v retrieving revision 1.4 retrieving revision 1.5 diff -u -r1.4 -r1.5 --- apply_macros.yap 15 May 2008 13:41:47 -0000 1.4 +++ apply_macros.yap 11 Jul 2008 17:02:07 -0000 1.5 @@ -243,7 +243,6 @@ append_args(HeadPrefix, [[In|Ins], [Out|Outs]], RecursionHead), append_args(Pred, [In, Out], Apply), append_args(HeadPrefix, [Ins, Outs], RecursiveCall), - write(Goal),nl, compile_aux([ Base, (RecursionHead :- Apply, RecursiveCall) Index: dgraphs.yap =================================================================== RCS file: /cvsroot/yap/library/dgraphs.yap,v retrieving revision 1.10 retrieving revision 1.11 diff -u -r1.10 -r1.11 --- dgraphs.yap 26 Jun 2008 13:09:15 -0000 1.10 +++ dgraphs.yap 11 Jul 2008 17:02:08 -0000 1.11 @@ -32,7 +32,8 @@ dgraph_min_paths/3, dgraph_isomorphic/4, dgraph_path/3, - dgraph_reachable/3]). + dgraph_reachable/3 + ]). :- reexport(library(rbtrees), [rb_new/1 as dgraph_new]). Index: lists.yap =================================================================== RCS file: /cvsroot/yap/library/lists.yap,v retrieving revision 1.16 retrieving revision 1.17 diff -u -r1.16 -r1.17 --- lists.yap 3 Jun 2008 22:43:14 -0000 1.16 +++ lists.yap 11 Jul 2008 17:02:09 -0000 1.17 @@ -299,9 +299,6 @@ % is true when Lists is a list of lists, and List is the % concatenation of these lists. -list_concat(Lists, List) :- - list_concat(Lists, [], List). - list_concat([], []). list_concat([H|T], L) :- list_concat(H, L, Li), Index: rbtrees.yap =================================================================== RCS file: /cvsroot/yap/library/rbtrees.yap,v retrieving revision 1.16 retrieving revision 1.17 diff -u -r1.16 -r1.17 --- rbtrees.yap 11 Jun 2008 16:57:31 -0000 1.16 +++ rbtrees.yap 11 Jul 2008 17:02:09 -0000 1.17 @@ -63,6 +63,29 @@ :- meta_predicate rb_map(+,:,-), rb_partial_map(+,+,:,-), rb_apply(+,+,:,-). +/* +:- use_module(library(type_check)). + +:- type rbtree(K,V) ---> t(tree(K,V),tree(K,V)). +:- type tree(K,V) ---> black(tree(K,V),K,V,tree(K,V)) + ; red(tree(K,V),K,V,tree(K,V)) + ; ''. +:- type cmp ---> (=) ; (<) ; (>). + + +:- pred rb_new(rbtree(_K,_V)). +:- pred rb_empty(rbtree(_K,_V)). +:- pred rb_lookup(K,V,rbtree(K,V)). +:- pred lookup(K,V, tree(K,V)). +:- pred lookup(cmp, K, V, tree(K,V)). +:- pred rb_min(rbtree(K,V),K,V). +:- pred min(tree(K,V),K,V). +:- pred rb_max(rbtree(K,V),K,V). +:- pred max(tree(K,V),K,V). +:- pred rb_next(rbtree(K,V),K,pair(K,V),V). +:- pred next(tree(K,V),K,pair(K,V),V,tree(K,V)). +*/ + % create an empty tree. %% rb_new(-T) is det. % @@ -70,15 +93,15 @@ % % @deprecated Use rb_empty/1. -rb_new(t(Nil,Nil)) :- Nil = black([],[],[],[]). +rb_new(t(Nil,Nil)) :- Nil = black('',_,_,''). + +rb_new(K,V,t(Nil,black(Nil,K,V,Nil))) :- Nil = black('',_,_,''). %% rb_empty(?T) is semidet. % % Succeeds if T is an empty Red-Black tree. -rb_empty(t(Nil,Nil)) :- Nil = black([],[],[],[]). - -rb_new(K,V,t(Nil,black(Nil,K,V,Nil))) :- Nil = black([],[],[],[]). +rb_empty(t(Nil,Nil)) :- Nil = black('',_,_,''). %% rb_lookup(+Key, -Value, +T) is semidet. % @@ -88,7 +111,7 @@ rb_lookup(Key, Val, t(_,Tree)) :- lookup(Key, Val, Tree). -lookup(_, _, black([],_,_,[])) :- !, fail. +lookup(_, _, black('',_,_,'')) :- !, fail. lookup(Key, Val, Tree) :- arg(2,Tree,KA), compare(Cmp,KA,Key), @@ -110,8 +133,8 @@ rb_min(t(_,Tree), Key, Val) :- min(Tree, Key, Val). -min(red(black([],_,_,_),Key,Val,_), Key, Val) :- !. -min(black(black([],_,_,_),Key,Val,_), Key, Val) :- !. +min(red(black('',_,_,_),Key,Val,_), Key, Val) :- !. +min(black(black('',_,_,_),Key,Val,_), Key, Val) :- !. min(red(Right,_,_,_), Key, Val) :- min(Right,Key,Val). min(black(Right,_,_,_), Key, Val) :- @@ -124,8 +147,8 @@ rb_max(t(_,Tree), Key, Val) :- max(Tree, Key, Val). -max(red(_,Key,Val,black([],_,_,_)), Key, Val) :- !. -max(black(_,Key,Val,black([],_,_,_)), Key, Val) :- !. +max(red(_,Key,Val,black('',_,_,_)), Key, Val) :- !. +max(black(_,Key,Val,black('',_,_,_)), Key, Val) :- !. max(red(_,_,_,Left), Key, Val) :- max(Left,Key,Val). max(black(_,_,_,Left), Key, Val) :- @@ -139,7 +162,7 @@ rb_next(t(_,Tree), Key, Next, Val) :- next(Tree, Key, Next, Val, []). -next(black([],_,_,[]), _, _, _, _) :- !, fail. +next(black('',_,_,''), _, _, _, _) :- !, fail. next(Tree, Key, Next, Val, Candidate) :- arg(2,Tree,KA), arg(3,Tree,VA), @@ -169,7 +192,7 @@ rb_previous(t(_,Tree), Key, Previous, Val) :- previous(Tree, Key, Previous, Val, []). -previous(black([],_,_,[]), _, _, _, _) :- !, fail. +previous(black('',_,_,''), _, _, _, _) :- !, fail. previous(Tree, Key, Previous, Val, Candidate) :- arg(2,Tree,KA), arg(3,Tree,VA), @@ -241,7 +264,7 @@ rb_apply(t(Nil,OldTree), Key, Goal, t(Nil,NewTree)) :- apply(OldTree, Key, Goal, NewTree). -%apply(black([],_,_,[]), _, _, _) :- !, fail. +%apply(black('',_,_,''), _, _, _) :- !, fail. apply(black(Left,Key0,Val0,Right), Key, Goal, black(NewLeft,Key0,Val,NewRight)) :- Left \= [], @@ -288,7 +311,7 @@ enum(Key, Val, black(L,K,V,R)) :- - L \= [], + L \= '', enum_cases(Key, Val, L, K, V, R). enum(Key, Val, red(L,K,V,R)) :- enum_cases(Key, Val, L, K, V, R). @@ -309,7 +332,7 @@ lookupall(Key, Val, Tree). -lookupall(_, _, black([],_,_,[])) :- !, fail. +lookupall(_, _, black('',_,_,'')) :- !, fail. lookupall(Key, Val, Tree) :- arg(2,Tree,KA), compare(Cmp,KA,Key), @@ -369,7 +392,7 @@ % % actual insertion % -insert2(black([],[],[],[]), K, V, Nil, T, Status) :- !, +insert2(black('',_,_,''), K, V, Nil, T, Status) :- !, T = red(Nil,K,V,Nil), Status = not_done. insert2(red(L,K0,V0,R), K, V, Nil, NT, Flag) :- @@ -414,7 +437,7 @@ % % actual insertion, copied from insert2 % -insert_new_2(black([],[],[],[]), K, V, Nil, T, Status) :- !, +insert_new_2(black('',_,_,''), K, V, Nil, T, Status) :- !, T = red(Nil,K,V,Nil), Status = not_done. insert_new_2(red(L,K0,V0,R), K, V, Nil, NT, Flag) :- @@ -520,7 +543,7 @@ pretty_print(t(_,T)) :- pretty_print(T,6). -pretty_print(black([],[],[],[]),_) :- !. +pretty_print(black('',_,_,''),_) :- !. pretty_print(red(L,K,_,R),D) :- DN is D+6, pretty_print(L,DN), @@ -580,12 +603,12 @@ rb_del_min(t(Nil,T), K, Val, t(Nil,NT)) :- del_min(T, K, Val, Nil, NT, _). -del_min(red(black([],_,_,_),K,V,R), K, V, Nil, OUT, Flag) :- !, +del_min(red(black('',_,_,_),K,V,R), K, V, Nil, OUT, Flag) :- !, delete_red_node(Nil,R,OUT,Flag). del_min(red(L,K0,V0,R), K, V, Nil, NT, Flag) :- del_min(L, K, V, Nil, NL, Flag0), fixup_left(Flag0,red(NL,K0,V0,R), NT, Flag). -del_min(black(black([],_,_,_),K,V,R), K, V, Nil, OUT, Flag) :- !, +del_min(black(black('',_,_,_),K,V,R), K, V, Nil, OUT, Flag) :- !, delete_black_node(Nil,R,OUT,Flag). del_min(black(L,K0,V0,R), K, V, Nil, NT, Flag) :- del_min(L, K, V, Nil, NL, Flag0), @@ -600,12 +623,12 @@ rb_del_max(t(Nil,T), K, Val, t(Nil,NT)) :- del_max(T, K, Val, Nil, NT, _). -del_max(red(L,K,V,black([],_,_,_)), K, V, Nil, OUT, Flag) :- !, +del_max(red(L,K,V,black('',_,_,_)), K, V, Nil, OUT, Flag) :- !, delete_red_node(L,Nil,OUT,Flag). del_max(red(L,K0,V0,R), K, V, Nil, NT, Flag) :- del_max(R, K, V, Nil, NR, Flag0), fixup_right(Flag0,red(L,K0,V0,NR),NT, Flag). -del_max(black(L,K,V,black([],_,_,_)), K, V, Nil, OUT, Flag) :- !, +del_max(black(L,K,V,black('',_,_,_)), K, V, Nil, OUT, Flag) :- !, delete_black_node(L,Nil,OUT,Flag). del_max(black(L,K0,V0,R), K, V, Nil, NT, Flag) :- del_max(R, K, V, Nil, NR, Flag0), @@ -614,27 +637,27 @@ delete_red_node(L1,L2,L1,done) :- L1 == L2, !. -delete_red_node(black([],[],[],[]),R,R,done) :- !. -delete_red_node(L,black([],[],[],[]),L,done) :- !. +delete_red_node(black('',_,_,''),R,R,done) :- !. +delete_red_node(L,black('',_,_,''),L,done) :- !. delete_red_node(L,R,OUT,Done) :- delete_next(R,NK,NV,NR,Done0), fixup_right(Done0,red(L,NK,NV,NR),OUT,Done). delete_black_node(L1,L2,L1,not_done) :- L1 == L2, !. -delete_black_node(black([],[],[],[]),red(L,K,V,R),black(L,K,V,R),done) :- !. -delete_black_node(black([],[],[],[]),R,R,not_done) :- !. -delete_black_node(red(L,K,V,R),black([],[],[],[]),black(L,K,V,R),done) :- !. -delete_black_node(L,black([],[],[],[]),L,not_done) :- !. +delete_black_node(black('',_,_,''),red(L,K,V,R),black(L,K,V,R),done) :- !. +delete_black_node(black('',_,_,''),R,R,not_done) :- !. +delete_black_node(red(L,K,V,R),black('',_,_,''),black(L,K,V,R),done) :- !. +delete_black_node(L,black('',_,_,''),L,not_done) :- !. delete_black_node(L,R,OUT,Done) :- delete_next(R,NK,NV,NR,Done0), fixup_right(Done0,black(L,NK,NV,NR),OUT,Done). -delete_next(red(black([],[],[],[]),K,V,R),K,V,R,done) :- !. -delete_next(black(black([],[],[],[]),K,V,red(L1,K1,V1,R1)), +delete_next(red(black('',_,_,''),K,V,R),K,V,R,done) :- !. +delete_next(black(black('',_,_,''),K,V,red(L1,K1,V1,R1)), K,V,black(L1,K1,V1,R1),done) :- !. -delete_next(black(black([],[],[],[]),K,V,R),K,V,R,not_done) :- !. +delete_next(black(black('',_,_,''),K,V,R),K,V,R,not_done) :- !. delete_next(red(L,K,V,R),K0,V0,OUT,Done) :- delete_next(L,K0,V0,NL,Done0), fixup_left(Done0,red(NL,K,V,R),OUT,Done). @@ -742,7 +765,7 @@ rb_visit(t(_,T),L0,Lf) :- visit(T,L0,Lf). -visit(black([],_,_,_),L,L) :- !. +visit(black('',_,_,_),L,L) :- !. visit(red(L,K,V,R),L0,Lf) :- visit(L,[K-V|L1],Lf), visit(R,L0,L1). @@ -755,8 +778,18 @@ % True if call(Goal, Value) is true for all nodes in T. rb_map(t(Nil,Tree),Goal,t(Nil,NewTree)) :- - map(Tree,Goal,NewTree). + map(Tree,Goal,NewTree,Nil). + +map(black('',_,_,''),_,Nil,Nil) :- !. +map(red(L,K,V,R),Goal,red(NL,K,NV,NR),Nil) :- + call(Goal,V,NV), !, + map(L,Goal,NL,Nil), + map(R,Goal,NR,Nil). +map(black(L,K,V,R),Goal,black(NL,K,NV,NR),Nil) :- + call(Goal,V,NV), !, + map(L,Goal,NL,Nil), + map(R,Goal,NR,Nil). %% rb_map(+T, :G, -TN) is semidet. % @@ -765,21 +798,11 @@ % the value associated with Key in TN is ValF. Fails if % call(G,Val0,ValF) is not satisfiable for all Var0. -map(black([],[],[],[]),_,black([],[],[],[])) :- !. -map(red(L,K,V,R),Goal,red(NL,K,NV,NR)) :- - call(Goal,V,NV), !, - map(L,Goal,NL), - map(R,Goal,NR). -map(black(L,K,V,R),Goal,black(NL,K,NV,NR)) :- - call(Goal,V,NV), !, - map(L,Goal,NL), - map(R,Goal,NR). - rb_map(t(_,Tree),Goal) :- map(Tree,Goal). -map(black([],[],[],[]),_) :- !. +map(black('',_,_,''),_) :- !. map(red(L,_,V,R),Goal) :- call(Goal,V), !, map(L,Goal), @@ -796,26 +819,26 @@ % a list containing all new nodes as pairs K-V. rb_clone(t(Nil,T),t(Nil,NT),Ns) :- - clone(T,NT,Ns,[]). + clone(T,Nil,NT,Ns,[]). -clone(black([],[],[],[]),black([],[],[],[]),Ns,Ns) :- !. -clone(red(L,K,_,R),red(NL,K,NV,NR),NsF,Ns0) :- - clone(L,NL,NsF,[K-NV|Ns1]), - clone(R,NR,Ns1,Ns0). -clone(black(L,K,_,R),black(NL,K,NV,NR),NsF,Ns0) :- - clone(L,NL,NsF,[K-NV|Ns1]), - clone(R,NR,Ns1,Ns0). +clone(black('',_,_,''),Nil,Nil,Ns,Ns) :- !. +clone(red(L,K,_,R),Nil,red(NL,K,NV,NR),NsF,Ns0) :- + clone(L,Nil,NL,NsF,[K-NV|Ns1]), + clone(R,Nil,NR,Ns1,Ns0). +clone(black(L,K,_,R),Nil,black(NL,K,NV,NR),NsF,Ns0) :- + clone(L,Nil,NL,NsF,[K-NV|Ns1]), + clone(R,Nil,NR,Ns1,Ns0). rb_clone(t(Nil,T),ONs,t(Nil,NT),Ns) :- - clone(T,ONs,[],NT,Ns,[]). + clone(T,Nil,ONs,[],NT,Ns,[]). -clone(black([],[],[],[]),ONs,ONs,black([],[],[],[]),Ns,Ns) :- !. -clone(red(L,K,V,R),ONsF,ONs0,red(NL,K,NV,NR),NsF,Ns0) :- - clone(L,ONsF,[K-V|ONs1],NL,NsF,[K-NV|Ns1]), - clone(R,ONs1,ONs0,NR,Ns1,Ns0). -clone(black(L,K,V,R),ONsF,ONs0,black(NL,K,NV,NR),NsF,Ns0) :- - clone(L,ONsF,[K-V|ONs1],NL,NsF,[K-NV|Ns1]), - clone(R,ONs1,ONs0,NR,Ns1,Ns0). +clone(black('',_,_,''),Nil,ONs,ONs,Nil,Ns,Ns) :- !. +clone(red(L,K,V,R),Nil,ONsF,ONs0,red(NL,K,NV,NR),NsF,Ns0) :- + clone(L,Nil,ONsF,[K-V|ONs1],NL,NsF,[K-NV|Ns1]), + clone(R,Nil,ONs1,ONs0,NR,Ns1,Ns0). +clone(black(L,K,V,R),Nil,ONsF,ONs0,black(NL,K,NV,NR),NsF,Ns0) :- + clone(L,Nil,ONsF,[K-V|ONs1],NL,NsF,[K-NV|Ns1]), + clone(R,Nil,ONs1,ONs0,NR,Ns1,Ns0). %% rb_partial_map(+T, +Keys, :G, -TN) % @@ -832,7 +855,7 @@ rb_partial_map(T0, Map, Map0, Nil, Goal, TF). partial_map(T,[],[],_,_,T) :- !. -partial_map(black([],_,_,_),Map,Map,Nil,_,Nil) :- !. +partial_map(black('',_,_,_),Map,Map,Nil,_,Nil) :- !. partial_map(red(L,K,V,R),Map,MapF,Nil,Goal,red(NL,K,NV,NR)) :- partial_map(L,Map,MapI,Nil,Goal,NL), ( @@ -885,7 +908,7 @@ rb_keys(t(_,T),L0,Lf) :- keys(T,L0,Lf). -keys(black([],[],[],[]),L,L) :- !. +keys(black('',_,_,''),L,L) :- !. keys(red(L,K,_,R),L0,Lf) :- keys(L,[K|L1],Lf), keys(R,L0,L1). @@ -908,11 +931,11 @@ % list L. ord_list_to_rbtree([], t(Nil,Nil)) :- !, - Nil = black([], [], [], []). + Nil = black('', _, _, ''). ord_list_to_rbtree([K-V], t(Nil,black(Nil,K,V,Nil))) :- !, - Nil = black([], [], [], []). + Nil = black('', _, _, ''). ord_list_to_rbtree(List, t(Nil,Tree)) :- - Nil = black([], [], [], []), + Nil = black('', _, _, ''), Ar =.. [seq|List], functor(Ar,_,L), Height is integer(log(L)/log(2)), @@ -943,7 +966,7 @@ rb_size(t(_,T),Size) :- size(T,0,Size). -size(black([],_,_,_),Sz,Sz) :- !. +size(black('',_,_,_),Sz,Sz) :- !. size(red(L,_,_,R),Sz0,Szf) :- Sz1 is Sz0+1, size(L,Sz1,Sz2), @@ -974,7 +997,7 @@ % This code checks if a tree is ordered and a rbtree % % -rbtree(t(_,black([],[],[],[]))) :- !. +rbtree(t(_,black('',_,_,''))) :- !. rbtree(t(_,T)) :- catch(rbtree1(T),msg(S,Args),format(S,Args)). @@ -986,14 +1009,14 @@ throw(msg("root should be black",[])). -find_path_blacks(black([],[],[],[]), Bls, Bls) :- !. +find_path_blacks(black('',_,_,''), Bls, Bls) :- !. find_path_blacks(black(L,_,_,_), Bls0, Bls) :- Bls1 is Bls0+1, find_path_blacks(L, Bls1, Bls). find_path_blacks(red(L,_,_,_), Bls0, Bls) :- find_path_blacks(L, Bls0, Bls). -check_rbtree(black([],[],[],[]),Min,Max,Bls0) :- !, +check_rbtree(black('',_,_,''),Min,Max,Bls0) :- !, check_height(Bls0,Min,Max). check_rbtree(red(L,K,_,R),Min,Max,Bls) :- check_val(K,Min,Max), @@ -1061,11 +1084,11 @@ clean_tree(X2,X,TI,TF). bclean_tree(X,X,T0,TF) :- !, -% format("cleaning ~d~n", [X]), + format("cleaning ~d~n", [X]), rb_delete(T0,X,TF), ( rbtree(TF) -> true ; abort). bclean_tree(X1,X,T0,TF) :- -% format("cleaning ~d~n", [X1]), + format("cleaning ~d~n", [X1]), rb_delete(T0,X1,TI), X2 is X1-1, ( rbtree(TI) -> true ; abort), Index: splay.yap =================================================================== RCS file: /cvsroot/yap/library/splay.yap,v retrieving revision 1.2 retrieving revision 1.3 diff -u -r1.2 -r1.3 --- splay.yap 23 Apr 2002 22:43:10 -0000 1.2 +++ splay.yap 11 Jul 2008 17:02:09 -0000 1.3 @@ -104,7 +104,7 @@ bst(insert, Item, Val, Tree, NewTree). splay_del(Item, Tree, NewTree):- bst(access(true), Item, Val, Tree, n(Item, Val, Left, Right)), - join(Left, Right, NewTree). + splay_join(Left, Right, NewTree). splay_join(Left, Right, New):- join(L-L, Left, Right, New). splay_split(Item, Val, Tree, Left, Right):- Index: trees.yap =================================================================== RCS file: /cvsroot/yap/library/trees.yap,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -u -r1.1.1.1 -r1.2 --- trees.yap 9 Apr 2001 19:53:45 -0000 1.1.1.1 +++ trees.yap 11 Jul 2008 17:02:09 -0000 1.2 @@ -104,16 +104,11 @@ % a tool for everyday use. map_tree(Pred, t(Old,OLeft,ORight), t(New,NLeft,NRight)) :- - tree_apply(Pred, [Old,New]), + once(call(Pred, Old, New)), map_tree(Pred, OLeft, NLeft), map_tree(Pred, ORight, NRight). map_tree(_, t, t). -tree_apply(Pred,Args) :- - G =.. [Pred,Args], - call(G), !. - - % put_label(Index, OldTree, Label, NewTree) % constructs a new tree the same shape as the old which moreover has the % same elements except that the Index-th one is Label. Unlike the |
|
From: Vitor S. C. <vs...@us...> - 2008-07-11 17:02:02
|
Update of /cvsroot/yap/misc In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv30868/misc Modified Files: yap.def Log Message: fixes by Bart and Tom: mostly libraries but nasty one in indexing compilation. Index: yap.def =================================================================== RCS file: /cvsroot/yap/misc/yap.def,v retrieving revision 1.17 retrieving revision 1.18 diff -u -r1.17 -r1.18 --- yap.def 17 Jun 2008 21:04:27 -0000 1.17 +++ yap.def 11 Jul 2008 17:02:09 -0000 1.18 @@ -69,6 +69,7 @@ YAP_SetOutputMessage YAP_StreamToFileNo YAP_CloseAllOpenStreams +YAP_FlushAllStreams YAP_OpenStream YAP_NewSlots YAP_InitSlot |
|
From: Vitor S. C. <vs...@us...> - 2008-07-11 17:02:01
|
Update of /cvsroot/yap/library/system In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv30868/library/system Modified Files: sys.c Log Message: fixes by Bart and Tom: mostly libraries but nasty one in indexing compilation. Index: sys.c =================================================================== RCS file: /cvsroot/yap/library/system/sys.c,v retrieving revision 1.35 retrieving revision 1.36 diff -u -r1.35 -r1.36 --- sys.c 23 May 2008 13:16:13 -0000 1.35 +++ sys.c 11 Jul 2008 17:02:09 -0000 1.36 @@ -10,6 +10,10 @@ * * * $Id$ * * mods: $Log$ +* mods: Revision 1.36 2008/07/11 17:02:09 vsc +* mods: fixes by Bart and Tom: mostly libraries but nasty one in indexing +* mods: compilation. +* mods: * mods: Revision 1.35 2008/05/23 13:16:13 vsc * mods: fix sys.c for win32 * mods: @@ -713,6 +717,7 @@ close(outf); return(YAP_Unify(YAP_ARG6, YAP_MkIntTerm(errno))); } + YAP_FlushAllStreams(); /* we are now ready to fork */ if ((res = fork()) < 0) { /* close streams we don't need */ |
|
From: Vitor S. C. <vs...@us...> - 2008-07-11 17:02:01
|
Update of /cvsroot/yap In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv30868 Modified Files: changes-5.1.html Log Message: fixes by Bart and Tom: mostly libraries but nasty one in indexing compilation. |
|
From: Vitor S. C. <vs...@us...> - 2008-06-26 13:09:14
|
Update of /cvsroot/yap/library In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv14577/library Modified Files: dgraphs.yap undgraphs.yap wdgraphs.yap wundgraphs.yap Log Message: improve graphs a bit. Index: dgraphs.yap =================================================================== RCS file: /cvsroot/yap/library/dgraphs.yap,v retrieving revision 1.9 retrieving revision 1.10 diff -u -r1.9 -r1.10 --- dgraphs.yap 26 Mar 2008 14:41:44 -0000 1.9 +++ dgraphs.yap 26 Jun 2008 13:09:15 -0000 1.10 @@ -5,17 +5,17 @@ :- module( dgraphs, [ - dgraph_add_edge/4, - dgraph_add_edges/3, + dgraph_vertices/2, + dgraph_edge/3, + dgraph_edges/2, dgraph_add_vertex/3, dgraph_add_vertices/3, - dgraph_del_edge/4, - dgraph_del_edges/3, dgraph_del_vertex/3, dgraph_del_vertices/3, - dgraph_edge/3, - dgraph_edges/2, - dgraph_vertices/2, + dgraph_add_edge/4, + dgraph_add_edges/3, + dgraph_del_edge/4, + dgraph_del_edges/3, dgraph_to_ugraph/2, ugraph_to_dgraph/2, dgraph_neighbors/3, @@ -31,7 +31,8 @@ dgraph_max_path/5, dgraph_min_paths/3, dgraph_isomorphic/4, - dgraph_path/3]). + dgraph_path/3, + dgraph_reachable/3]). :- reexport(library(rbtrees), [rb_new/1 as dgraph_new]). @@ -191,7 +192,7 @@ delete_edge(Edges0, V, Edges) :- ord_del_element(Edges0, V, Edges). -dgraph_del_vertices(G0, Vs, GF) --> +dgraph_del_vertices(G0, Vs, GF) :- sort(Vs,SortedVs), delete_all(SortedVs, G0, G1), delete_remaining_edges(SortedVs, G1, GF). @@ -362,7 +363,7 @@ dgraph_min_paths(V1, Graph, Paths) :- dgraph_to_wdgraph(Graph, WGraph), - wdgraph_min_path(V1, WGraph, Paths). + wdgraph_min_paths(V1, WGraph, Paths). dgraph_path(V, G, [V|P]) :- rb_lookup(V, Children, G), @@ -403,3 +404,18 @@ rb_lookup(V1,NV1,Map), rb_lookup(V2,NV2,Map), translate_edges(Edges,Map,TEdges). + +dgraph_reachable(V, G, Edges) :- + rb_lookup(V, Children, G), + ord_list_to_rbtree([V-[]],Done0), + reachable(Children, Done0, _, G, Edges, []). + +reachable([], Done, Done, _, Edges, Edges). +reachable([V|Vertices], Done0, DoneF, G, EdgesF, Edges0) :- + rb_lookup(V,_, Done0), !, + reachable(Vertices, Done0, DoneF, G, EdgesF, Edges0). +reachable([V|Vertices], Done0, DoneF, G, [V|EdgesF], Edges0) :- + rb_lookup(V, Kids, G), + rb_insert(Done0, V, [], Done1), + reachable(Kids, Done1, DoneI, G, EdgesF, EdgesI), + reachable(Vertices, DoneI, DoneF, G, EdgesI, Edges0). Index: undgraphs.yap =================================================================== RCS file: /cvsroot/yap/library/undgraphs.yap,v retrieving revision 1.5 retrieving revision 1.6 diff -u -r1.5 -r1.6 --- undgraphs.yap 26 Mar 2008 14:41:45 -0000 1.5 +++ undgraphs.yap 26 Jun 2008 13:09:15 -0000 1.6 @@ -29,7 +29,8 @@ dgraph_vertices/2 as undgraph_vertices, dgraph_complement/2 as undgraph_complement, dgraph_symmetric_closure/2 as dgraph_to_undgraph, - dgraph_edge/3 as undgraph_edge + dgraph_edge/3 as undgraph_edge, + dgraph_reachable/3 as undgraph_reachable ]). Index: wdgraphs.yap =================================================================== RCS file: /cvsroot/yap/library/wdgraphs.yap,v retrieving revision 1.3 retrieving revision 1.4 diff -u -r1.3 -r1.4 --- wdgraphs.yap 5 Dec 2007 12:17:24 -0000 1.3 +++ wdgraphs.yap 26 Jun 2008 13:09:15 -0000 1.4 @@ -18,6 +18,8 @@ dgraph_to_wdgraph/2, wdgraph_neighbors/3, wdgraph_neighbours/3, + wdgraph_wneighbors/3, + wdgraph_wneighbours/3, wdgraph_transpose/2, wdgraph_transitive_closure/2, wdgraph_symmetric_closure/2, @@ -25,7 +27,8 @@ wdgraph_min_path/5, wdgraph_min_paths/3, wdgraph_max_path/5, - wdgraph_path/3]). + wdgraph_path/3, + wdgraph_reachable/3]). :- reexport(library(dgraphs), [dgraph_add_vertex/3 as wdgraph_add_vertex, @@ -279,13 +282,19 @@ cvt_neighbs(WEs, Es). wdgraph_neighbors(V, WG, Neighbors) :- - rb_lookup(V, WG, EdgesList0), + rb_lookup(V, EdgesList0, WG), cvt_wneighbs(EdgesList0, Neighbors). wdgraph_neighbours(V, WG, Neighbors) :- - rb_lookup(V, WG, EdgesList0), + rb_lookup(V, EdgesList0, WG), cvt_wneighbs(EdgesList0, Neighbors). +wdgraph_wneighbors(V, WG, Neighbors) :- + rb_lookup(V, Neighbors, WG). + +wdgraph_wneighbours(V, WG, Neighbors) :- + rb_lookup(V, Neighbors, WG). + wdgraph_transpose(Graph, TGraph) :- rb_visit(Graph, Edges), rb_clone(Graph, TGraph, NewNodes), @@ -433,3 +442,17 @@ wdgraph_to_dgraph(WG, G), dgraph_path(V, G, P). +wdgraph_reachable(V, G, Edges) :- + rb_lookup(V, Children, G), + ord_list_to_rbtree([V-[]],Done0), + reachable(Children, Done0, _, G, Edges, []). + +reachable([], Done, Done, _, Edges, Edges). +reachable([V-_|Vertices], Done0, DoneF, G, EdgesF, Edges0) :- + rb_lookup(V,_, Done0), !, + reachable(Vertices, Done0, DoneF, G, EdgesF, Edges0). +reachable([V-_|Vertices], Done0, DoneF, G, [V|EdgesF], Edges0) :- + rb_lookup(V, Kids, G), + rb_insert(Done0, V, [], Done1), + reachable(Kids, Done1, DoneI, G, EdgesF, EdgesI), + reachable(Vertices, DoneI, DoneF, G, EdgesI, Edges0). Index: wundgraphs.yap =================================================================== RCS file: /cvsroot/yap/library/wundgraphs.yap,v retrieving revision 1.4 retrieving revision 1.5 diff -u -r1.4 -r1.5 --- wundgraphs.yap 3 Jun 2008 22:43:14 -0000 1.4 +++ wundgraphs.yap 26 Jun 2008 13:09:15 -0000 1.5 @@ -13,6 +13,8 @@ wundgraph_edges/2, wundgraph_neighbors/3, wundgraph_neighbours/3, + wundgraph_wneighbors/3, + wundgraph_wneighbours/3, wdgraph_to_wundgraph/2, wundgraph_to_undgraph/2, wundgraph_min_tree/3, @@ -32,7 +34,9 @@ wdgraph_min_path/5 as wundgraph_min_path, wdgraph_min_paths/3 as wundgraph_min_paths, wdgraph_max_path/5 as wundgraph_max_path, - wdgraph_path/3 as wundgraph_path]). + wdgraph_path/3 as wundgraph_path, + wdgraph_reachable/3 as wundgraph_reachable + ]). :- use_module( library(wdgraphs), [ @@ -96,6 +100,25 @@ wundgraph_neighbors(V,Vertices,Children) :- wdgraph_neighbors(V,Vertices,Children0), ( + wdel_me(Children0,V,Children) + -> + true + ; + Children = Children0 + ). + +wundgraph_wneighbours(V,Vertices,Children) :- + wdgraph_wneighbours(V,Vertices,Children0), + ( + wdel_me(Children0,V,Children) + -> + true + ; + Children = Children0 + ). +wundgraph_wneighbors(V,Vertices,Children) :- + wdgraph_wneighbors(V,Vertices,Children0), + ( del_me(Children0,V,Children) -> true @@ -104,7 +127,7 @@ ). del_me([], _, []). -del_me([K-_|Children], K1, NewChildren) :- +del_me([K|Children], K1, NewChildren) :- ( K == K1 -> Children = NewChildren ; @@ -116,6 +139,19 @@ compact(Children, MoreChildren) ). +wdel_me([], _, []). +wdel_me([K-A|Children], K1, NewChildren) :- + ( K == K1 -> + Children = NewChildren + ; + K @< K1 -> + NewChildren = [K-A|ChildrenLeft], + wdel_me(Children, K1, ChildrenLeft) + ; + NewChildren = [K-A|MoreChildren], + compact(Children, MoreChildren) + ). + wundgraph_del_edge(Vs0,V1,V2,K,VsF) :- wdgraph_del_edge(Vs0,V1,V2,K,Vs1), wdgraph_del_edge(Vs1,V2,V1,K,VsF). |
|
From: Vitor S. C. <vs...@us...> - 2008-06-26 13:09:14
|
Update of /cvsroot/yap/docs In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv14577/docs Modified Files: yap.tex Log Message: improve graphs a bit. Index: yap.tex =================================================================== RCS file: /cvsroot/yap/docs/yap.tex,v retrieving revision 1.256 retrieving revision 1.257 diff -u -r1.256 -r1.257 --- yap.tex 18 Jun 2008 10:02:27 -0000 1.256 +++ yap.tex 26 Jun 2008 13:09:15 -0000 1.257 @@ -11197,6 +11197,13 @@ Unify @var{Edges} with all edges appearing in graph @var{Graph}. +@item dgraph_add_vertices(+@var{Graph}, +@var{Vertex}, -@var{NewGraph}) +@findex dgraph_add_vertex/3 +@snindex dgraph_add_vertex/3 +@cnindex dgraph_add_vertex/3 +Unify @var{NewGraph} with a new graph obtained by adding +vertex @var{Vertex} to the graph @var{Graph}. + @item dgraph_add_vertices(+@var{Graph}, +@var{Vertices}, -@var{NewGraph}) @findex dgraph_add_vertices/3 @snindex dgraph_add_vertices/3 @@ -11204,7 +11211,15 @@ Unify @var{NewGraph} with a new graph obtained by adding the list of vertices @var{Vertices} to the graph @var{Graph}. -@item dgraph_del_vertices(+@var{Vertices}, +@var{Graph}, -@var{NewGraph}) +@item dgraph_del_vertex(+@var{Graph}, +@var{Vertex}, -@var{NewGraph}) +@findex dgraph_del_vertex/3 +@syindex dgraph_del_vertex/3 +@cnindex dgraph_del_vertex/3 +Unify @var{NewGraph} with a new graph obtained by deleting vertex +@var{Vertex} and all the edges that start from or go to @var{Vertex} to +the graph @var{Graph}. + +@item dgraph_del_vertices(+@var{Graph}, +@var{Vertices}, -@var{NewGraph}) @findex dgraph_del_vertices/3 @syindex dgraph_del_vertices/3 @cnindex dgraph_del_vertices/3 @@ -11212,6 +11227,13 @@ vertices @var{Vertices} and all the edges that start from or go to a vertex in @var{Vertices} to the graph @var{Graph}. +@item dgraph_add_edge(+@var{Graph}, +@var{N1}, +@var{N2}, -@var{NewGraph}) +@findex dgraph_add_edge/4 +@snindex dgraph_add_edge/4 +@cnindex dgraph_add_edge/4 +Unify @var{NewGraph} with a new graph obtained by adding the edge +@var{N1}-@var{N2} to the graph @var{Graph}. + @item dgraph_add_edges(+@var{Graph}, +@var{Edges}, -@var{NewGraph}) @findex dgraph_add_edges/3 @snindex dgraph_add_edges/3 @@ -11219,6 +11241,14 @@ Unify @var{NewGraph} with a new graph obtained by adding the list of edges @var{Edges} to the graph @var{Graph}. +@item dgraph_del_edge(+@var{Graph}, +@var{N1}, +@var{N2}, -@var{NewGraph}) +@findex dgraph_del_edge/4 +@snindex dgraph_del_edge/4 +@cnindex dgraph_del_edge/4 +Succeeds if @var{NewGraph} unifies with a new graph obtained by +removing the edge @var{N1}-@var{N2} from the graph @var{Graph}. Notice +that no vertices are deleted. + @item dgraph_del_edges(+@var{Graph}, +@var{Edges}, -@var{NewGraph}) @findex dgraph_del_edges/3 @snindex dgraph_del_edges/3 @@ -11227,6 +11257,23 @@ edges @var{Edges} from the graph @var{Graph}. Notice that no vertices are deleted. +@item dgraph_to_ugraph(+@var{Graph}, -@var{UGraph}) +@findex dgraph_to_ugraph/2 +@snindex dgraph_to_ugraph/2 +@cnindex dgraph_to_ugraph/2 +Unify @var{UGraph} with the representation used by the @var{ugraphs} +unweighted graphs library, that is, a list of the form +@var{V-Neighbors}, where @var{V} is a node and @var{Neighbors} the nodes +children. + +@item ugraph_to_dgraph( +@var{UGraph}, -@var{Graph}) +@findex ugraph_to_dgraph/2 +@snindex ugraph_to_dgraph/2 +@cnindex ugraph_to_dgraph/2 +Unify @var{Graph} with the directed graph obtain from @var{UGraph}, +represented in the form used in the @var{ugraphs} unweighted graphs +library. + @item dgraph_neighbors(+@var{Vertex}, +@var{Graph}, -@var{Vertices}) @findex dgraph_neighbors/3 @snindex dgraph_neighbors/3 @@ -11255,7 +11302,7 @@ replacing all edges of the form @var{V1-V2} by edges of the form @var{V2-V1}. -@item dgraph_close(+@var{Graph1}, +@var{Graph2}, -@var{ComposedGraph}) +@item dgraph_compose(+@var{Graph1}, +@var{Graph2}, -@var{ComposedGraph}) @findex dgraph_compose/3 @snindex dgraph_compose/3 @cnindex dgraph_compose/3 @@ -11284,22 +11331,57 @@ @cnindex dgraph_top_sort/2 Unify @var{Vertices} with the topological sort of graph @var{Graph}. -@item dgraph_to_ugraph(+@var{Graph}, -@var{UGraph}) -@findex dgraph_to_ugraph/2 -@snindex dgraph_to_ugraph/2 -@cnindex dgraph_to_ugraph/2 -Unify @var{UGraph} with the representation used by the @var{ugraphs} -unweighted graphs library, that is, a list of the form -@var{V-Neighbors}, where @var{V} is a node and @var{Neighbors} the nodes -children. +@item dgraph_top_sort(+@var{Graph}, -@var{Vertices}, ?@var{Vertices0}) +@findex dgraph_top_sort/3 +@snindex dgraph_top_sort/3 +@cnindex dgraph_top_sort/3 +Unify the difference list @var{Vertices}-@var{Vertices0} with the +topological sort of graph @var{Graph}. + +@item dgraph_min_path(+@var{V1}, +@var{V1}, +@var{Graph}, -@var{Path}, ?@var{Costt}) +@findex dgraph_min_path/5 +@snindex dgraph_min_path/5 +@cnindex dgraph_min_path/5 +Unify the list @var{Path} with the minimal cost path between nodes +@var{N1} and @var{N2} in graph @var{Graph}. Path @var{Path} has cost +@var{Cost}. + +@item dgraph_max_path(+@var{V1}, +@var{V1}, +@var{Graph}, -@var{Path}, ?@var{Costt}) +@findex dgraph_max_path/5 +@snindex dgraph_max_path/5 +@cnindex dgraph_max_path/5 +Unify the list @var{Path} with the maximal cost path between nodes +@var{N1} and @var{N2} in graph @var{Graph}. Path @var{Path} has cost +@var{Cost}. + +@item dgraph_min_paths(+@var{V1}, +@var{Graph}, -@var{Paths}) +@findex dgraph_min_paths/3 +@snindex dgraph_min_paths/3 +@cnindex dgraph_min_paths/3 +Unify the list @var{Paths} with the minimal cost paths from node +@var{N1} to the nodes in graph @var{Graph}. + +@item dgraph_isomorphic(+@var{Vs}, +@var{NewVs}, +@var{G0}, -@var{GF}) +@findex dgraph_isomorphic/4 +@snindex dgraph_isomorphic/4 +@cnindex dgraph_isomorphic/4 +Unify the list @var{GF} with the graph isomorphic to @var{G0} where +vertices in @var{Vs} map to vertices in @var{NewVs}. + +@item dgraph_path(+@var{Vertex}, +@var{Graph}, ?@var{Path}) +@findex dgraph_path/3 +@snindex dgraph_path/3 +@cnindex dgraph_path/3 +The path @var{Path} is a path starting at vertex @var{Vertex} in graph +@var{Graph}. + +@item dgraph_reachable(+@var{Vertex}, +@var{Graph}, ?@var{Edges}) +@findex dgraph_path/3 +@snindex dgraph_path/3 +@cnindex dgraph_path/3 +The path @var{Path} is a path starting at vertex @var{Vertex} in graph +@var{Graph}. -@item ugraph_to_dgraph( +@var{UGraph}, -@var{Graph}) -@findex ugraph_to_dgraph/2 -@snindex ugraph_to_dgraph/2 -@cnindex ugraph_to_dgraph/2 -Unify @var{Graph} with the directed graph obtain from @var{UGraph}, -represented in the form used in the @var{ugraphs} unweighted graphs -library. @end table @node UnDGraphs, LAM , DGraphs, Library |
