Menu
▾
▴
[Yap-commits] CVS: pl boot.yap, 1.189, 1.190 errors.yap, 1.89, 1.90 modules.yap, 1.83, 1.84 preds.yap, 1.79, 1.80 statistics.yap, 1.10, 1.11
|
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'(_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_). |
