module expansion, again

2014-02-09 10:47:44 +00:00 · 2014-02-09 10:47:44 +00:00 · ca0c43ba8d
parent 8d8a4104b9
commit ca0c43ba8d
8 changed files with 75 additions and 36 deletions
--- a/pl/arith.yap
+++ b/pl/arith.yap
@ -40,8 +40,8 @@ do_not_compile_expressions :- set_value('$c_arith',[]).
 	'$do_c_built_metacall'(G, M, OUT).
 '$do_c_built_in'(Mod:G, _, OUT) :- 
 	strip_module(Mod:G, M, G1),
-	var(G1), !,
-	'$do_c_built_metacall'(G1, M, OUT).
+	( var(G1) -> M = M2, G1 = G2 ; G1 = M2:G2), !, 
+	'$do_c_built_metacall'(G2, M2, OUT).
 '$do_c_built_in'(\+ G, _, OUT) :-
 	nonvar(G),
 	G = (A = B),
--- a/pl/boot.yap
+++ b/pl/boot.yap
@ -1113,7 +1113,9 @@ bootstrap(F) :-
 %                       Expanded is the final expanded term.
 %
 '$precompile_term'(Term, Expanded0, Expanded, BodyMod, SourceMod) :-
+%format('[ ~w~n',[Term]),  
 	'$module_expansion'(Term, Expanded0, ExpandedI, BodyMod, SourceMod), !,
+%format('      -> ~w~n',[Expanded0]),  
 	(
 	 '$access_yap_flags'(9,1)      /* strict_iso on */
        ->
--- a/pl/control.yap
+++ b/pl/control.yap
@ -146,24 +146,6 @@ setup_call_catcher_cleanup(Setup, Goal, Catcher, Cleanup) :-
 	'$nb_getval'('$catch', Ball, fail),
 	throw(Ball).	

-%%% The unknown predicate,
-%	informs about what the user wants to be done when
-%	there are no clauses for a certain predicate */
-
-unknown(V0, V) :-
-	prolog_flag(unknown, V0, V).
-
-'$unknown_error'(Mod:Goal) :-
-	functor(Goal,Name,Arity),
-	'$program_continuation'(PMod,PName,PAr),
-	'$do_error'(existence_error(procedure,Name/Arity),context(Mod:Goal,PMod:PName/PAr)).
-
-'$unknown_warning'(Mod:Goal) :-
-	functor(Goal,Name,Arity),
-	'$program_continuation'(PMod,PName,PAr),
-	print_message(error,error(existence_error(procedure,Name/Arity), context(Mod:Goal,PMod:PName/PAr))),
-	fail.
-
 %%% Some "dirty" predicates

 % Only efective if yap compiled with -DDEBUG
--- a/pl/hacks.yap
+++ b/pl/hacks.yap
@ -35,7 +35,7 @@ prolog:'$stack_dump' :-
 run_formats([], _).
 run_formats([Com-Args|StackInfo], Stream) :-
 	format(Stream, Com, Args),
-	run_formats(StackInfo, user_error).
+	run_formats(StackInfo, Stream).

 display_stack_info(CPs,Envs,Lim,PC) :-
 	display_stack_info(CPs,Envs,Lim,CP,Lines,[]),
--- a/pl/history.pl
+++ b/pl/history.pl
@ -49,7 +49,6 @@
 %   call Goal and pretend it has not seen anything.  This hook is used
 %   by the GNU-Emacs interface to for communication between GNU-EMACS
 %   and SWI-Prolog.
-
 prolog:read_history(History, Help, DontStore, Prompt, Term, Bindings) :-
 	repeat,
 	    prompt_history(Prompt),
@ -285,4 +284,4 @@ matching_event(String, Event) :-
        '$append'(String, _, Event), !.

 '$append'(Head, OldAndTail, String) :-
-	lists:append(Head, OldAndTail, String).
+	lists:append(Head, OldAndTail, String).
--- a/pl/modules.yap
+++ b/pl/modules.yap
@ -301,10 +301,10 @@ expand_goal(G, G).
 	NG =.. [Name|NGArgs].

 '$expand_args'([], _, [], []).
-'$expand_args'([A|GArgs], CurMod, 0.GDefs, [NA|NGArgs]) :-
+'$expand_args'([A|GArgs], CurMod, [0|GDefs], [NA|NGArgs]) :-
 	'$do_expand'(A, CurMod, NA), !,
 	'$expand_args'(GArgs, CurMod, GDefs, NGArgs).
-'$expand_args'([A|GArgs], CurMod, _.GDefs, [A|NGArgs]) :-
+'$expand_args'([A|GArgs], CurMod, [_|GDefs], [A|NGArgs]) :-
 	'$expand_args'(GArgs, CurMod, GDefs, NGArgs).

 % args are:
@ -459,21 +459,43 @@ expand_goal(G, G).
 '$module_u_vars'(_,[],_).

 '$module_u_vars'(0,_,_,[]) :- !.
-'$module_u_vars'(I,D,H,[Y|L]) :-
+'$module_u_vars'(I,D,H,LF) :-
 	arg(I,D,X), ( X=':' ; integer(X)),
-	arg(I,H,Y), var(Y), !,
+	arg(I,H,A), '$uvar'(A, LF, L), !,
 	I1 is I-1,
 	'$module_u_vars'(I1,D,H,L).
 '$module_u_vars'(I,D,H,L) :-
 	I1 is I-1,
 	'$module_u_vars'(I1,D,H,L).

+'$uvar'(Y, [Y|L], L)  :- var(Y), !.
+% support all/3
+'$uvar'(same( G, _), LF, L)  :-
+    '$uvar'(G, LF, L).
+
 % expand arguments of a meta-predicate
 % $meta_expansion(ModuleWhereDefined,CurrentModule,Goal,ExpandedGoal,MetaVariables)

+'$meta_expansion0'(G,_Mod,MP,_HM, G1,_HVars) :-
+    var(G), !,
+    G1 = call(MP:G).
+'$meta_expansion0'(M:G,_Mod,_MP,_HM,G1,_HVars) :-
+    var(M), !,
+    G1 = '$execute_wo_mod'(G,M).
+% support for all/3
+'$meta_expansion0'(same(G, P),Mod,MP,HM, same(G1, P),HVars) :- !,
+    '$meta_expansion0'(G,Mod,MP,HM,G1,HVars).
+'$meta_expansion0'(G,Mod,MP,HM,M2:G2,HVars) :-
+    nonvar(G), G \= _:_,
+    '$module_expansion'(G,_,G1,MP,MP,HM,HVars), !,
+    strip_module(MP:G1, M2, G2).
+'$meta_expansion0'(G,Mod,MP,HM,M1:G1,HVars) :-
+    strip_module(MP:G,M1,G1).
+
+
 '$meta_expansion'(G,Mod,MP,HM,G1,HVars) :-
 	functor(G,F,N),
-	'$meta_predicate'(F,Mod,N,D), !,
+	'$meta_predicate'(F,Mod,N,D), !, % we're in an argument
 %	format(user_error,'[ ~w ',[G]),
 	functor(G1,F,N),
 	'$meta_expansion_loop'(N, D, G, G1, HVars, Mod, MP, HM).
@ -483,9 +505,15 @@ expand_goal(G, G).
 '$meta_expansion_loop'(0,_,_,_,_,_,_,_) :- !.
 '$meta_expansion_loop'(I,D,G,NG,HVars,CurMod,M,HM) :- 
 	arg(I,D,X), (X==':' -> true ; integer(X)),
-	arg(I,G,A), '$do_expand'(A,HVars),
+	arg(I,G,A), 
+	'$should_expand'(A,HVars),
 	!,
-	arg(I,NG,M:A),
+	( X ==0 ->
+	      '$meta_expansion0'(A,CurMod,M,HM,NA,HVars)
+	  ;
+	      NA = M:A
+	),
+	arg(I,NG,NA),
 	I1 is I-1,
 	'$meta_expansion_loop'(I1, D, G, NG, HVars, CurMod, M, HM).
 '$meta_expansion_loop'(I, D, G, NG, HVars, CurMod, M, HM) :- 
@ -495,9 +523,9 @@ expand_goal(G, G).
 	'$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'(_,_).
+'$should_expand'(V,HVars) :- var(V), !, '$not_in_vars'(V,HVars).
+'$should_expand'(_:_,_) :- !, fail.
+'$should_expand'(_,_).

 '$not_in_vars'(_,[]).
 '$not_in_vars'(V,[X|L]) :- X\==V, '$not_in_vars'(V,L).
@ -571,8 +599,6 @@ source_module(Mod) :-
 	forall(0,0),
 	format(+,:),
 	format(+,+,:),
-	format_time(?,+,:),
-	format_time(?,+,:,+),
 	freeze(?,0),
 	hide_predicate(:),
 	if(0,0,0),
--- a/pl/preds.yap
+++ b/pl/preds.yap
@ -1063,3 +1063,33 @@ clause_property(ClauseRef, predicate(PredicateIndicator)) :-
 	'$set_flag'(P, M, Flag, V).


+unknown(V0, V) :-
+    strip_module(V, M, G),
+    recorded('$unknown_handle', M0:G0, R), !,
+    recordz('$unknown_handle', M:G, _),
+    erase( R ),
+    strip_module(V0, M0, G0).
+unknown(V0, V) :-
+    strip_module(V, M, G),
+    recordz('$unknown_handle', M:G, _),
+    V0 = fail.
+
+%%% The unknown predicate,
+%	informs about what the user wants to be done when
+%	there are no clauses for a certain predicate */
+
+'$unknown_error'(Call) :-
+    recorded( '$unknown_handle', M:Goal, _), 
+    arg(1, Goal, Call), !,
+    once(M:Goal).
+'$unknown_error'(Mod:Goal) :-
+	functor(Goal,Name,Arity),
+	'$program_continuation'(PMod,PName,PAr),
+	'$do_error'(existence_error(procedure,Name/Arity),context(Mod:Goal,PMod:PName/PAr)).
+
+'$unknown_warning'(Mod:Goal) :-
+	functor(Goal,Name,Arity),
+	'$program_continuation'(PMod,PName,PAr),
+	print_message(error,error(existence_error(procedure,Name/Arity), context(Mod:Goal,PMod:PName/PAr))),
+	fail.
+
--- a/pl/setof.yap
+++ b/pl/setof.yap
@ -142,7 +142,7 @@ bagof(Template, Generator, Bag) :-
 % But this version of all does not allow for repeated answers
 % if you want them use findall	

-all(T,G same X,S) :- !, all(T same X,G,Sx), '$$produce'(Sx,S,X).
+all(T, G same X,S) :- !, all(T same X,G,Sx), '$$produce'(Sx,S,X).
 all(T,G,S) :- 
 	'$init_db_queue'(Ref),
 	( '$catch'(Error,'$clean_findall'(Ref,Error),_),