From b3088710d31bdd5ea2a6bbbd323f419664095d9d Mon Sep 17 00:00:00 2001
From: Vitor Santos Costa <vsc@dcc.fc.up.pt>
Date: Fri, 4 Dec 2009 11:00:13 +0000
Subject: [PATCH] emulate SWI module inheritance mechanism (at least, I hope).

---
 library/dialect/swi.yap | 21 +++++++------
 pl/boot.yap             |  2 +-
 pl/init.yap             |  2 ++
 pl/modules.yap          | 70 +++++++++++++++++++++++++++++++----------
 pl/preds.yap            |  2 +-
 5 files changed, 69 insertions(+), 28 deletions(-)

diff --git a/library/dialect/swi.yap b/library/dialect/swi.yap
index 733ca7d20..8a18400ec 100755
--- a/library/dialect/swi.yap
+++ b/library/dialect/swi.yap
@@ -109,15 +109,15 @@ swi_predicate_table(_,include(X,Y,Z),apply,include(X,Y,Z)).
 swi_predicate_table(_,exclude(X,Y,Z),apply,exclude(X,Y,Z)).
 swi_predicate_table(_,partition(X,Y,Z,A),apply,partition(X,Y,Z,A)).
 swi_predicate_table(_,partition(X,Y,Z,A,B),apply,partition(X,Y,Z,A,B)).
-swi_predicate_table(_,set_test_options(X),plunit,set_test_options(X)).
-swi_predicate_table(_,begin_tests(X),plunit,begin_tests(X)).
-swi_predicate_table(_,begin_tests(X,Y),plunit,begin_tests(X,Y)).
-swi_predicate_table(_,end_tests(X),plunit,end_tests(X)).
-swi_predicate_table(_,run_tests,plunit,run_tests).
-swi_predicate_table(_,run_tests(X),plunit,run_tests(X)).
-swi_predicate_table(_,load_test_files(X),plunit,load_test_files(X)).
-swi_predicate_table(_,running_tests,plunit,running_tests).
-swi_predicate_table(_,test_report(X),plunit,test_report(X)).
+% swi_predicate_table(_,set_test_options(X),plunit,set_test_options(X)).
+% swi_predicate_table(_,begin_tests(X),plunit,begin_tests(X)).
+% swi_predicate_table(_,begin_tests(X,Y),plunit,begin_tests(X,Y)).
+% swi_predicate_table(_,end_tests(X),plunit,end_tests(X)).
+% swi_predicate_table(_,run_tests,plunit,run_tests).
+% swi_predicate_table(_,run_tests(X),plunit,run_tests(X)).
+% swi_predicate_table(_,load_test_files(X),plunit,load_test_files(X)).
+% swi_predicate_table(_,running_tests,plunit,running_tests).
+% swi_predicate_table(_,test_report(X),plunit,test_report(X)).
 
 swi_mchk(X,Y) :- lists:memberchk(X,Y).
 
@@ -369,6 +369,7 @@ prolog:'$set_source_module'(Source0, SourceF) :-
 	prolog_load_context(module, Source0),
 	module(SourceF).
 
-prolog:'$declare_module'(_, _, _, _, _).
+prolog:'$declare_module'(Name, Context, _, _, _) :-
+	add_import_module(Name, Context, start).
 
 prolog:'$set_predicate_attribute'(_, _, _).
diff --git a/pl/boot.yap b/pl/boot.yap
index 69f5b29a9..2d108f76d 100644
--- a/pl/boot.yap
+++ b/pl/boot.yap
@@ -906,7 +906,7 @@ not(G) :-    \+ '$execute'(G).
         % for undefined_predicates.
 	'$enter_undefp',
 	(
-	 '$imported_predicate'(NM,M,Goal,G)
+	 '$get_undefined_pred'(G, M, Goal, NM)
 	->
 	 '$exit_undefp'
 	;
diff --git a/pl/init.yap b/pl/init.yap
index 70e40df84..c98b8152a 100644
--- a/pl/init.yap
+++ b/pl/init.yap
@@ -86,6 +86,8 @@ lists:append([H|T], L, [H|R]) :-
 
 :- dynamic prolog:'$user_defined_flag'/4.
 
+:- dynamic prolog:'$parent_module'/2.
+
 :- multifile prolog:debug_action_hook/1.
 
 :- source.
diff --git a/pl/modules.yap b/pl/modules.yap
index bfebda934..f4e01d830 100644
--- a/pl/modules.yap
+++ b/pl/modules.yap
@@ -356,32 +356,31 @@ module(N) :-
 '$imported_pred'(G, ImportingMod, G0, ExportingMod) :-
 	'$enter_undefp',
 	'$undefined'(G, ImportingMod),
-	recorded('$import','$import'(ExportingMod,ImportingMod,G0,G,_,_),_),
+	'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod),
 	ExportingMod \= ImportingMod, !,
 	'$exit_undefp'.
-'$imported_pred'(G, ImportingMod, G0, ExportingMod) :-
-	'$undefined'(G, ImportingMod),
-	swi:swi_predicate_table(ImportingMod,G,ExportingMod,G0),
-	ExportingMod \= ImportingMod,
-	'$exit_undefp'.
 '$imported_pred'(G, ImportingMod, _, _) :-
 	'$exit_undefp',
 	fail.
 
-%
-% get all imported predicates
-%
-'$imported_predicate'(FM,Mod,FPred,Pred) :-
-	recorded('$import','$import'(IM,Mod,IPred,Pred,_,_),_),
-	'$continue_imported'(FM, IM, FPred, IPred).
-'$imported_predicate'(FM,Mod,FPred,Pred) :-
-	swi:swi_predicate_table(Mod,Pred,IM,IPred),
-	'$continue_imported'(FM, IM, FPred, IPred).
+'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod) :-
+	recorded('$import','$import'(ExportingModI,ImportingMod,G0I,G,_,_),_),
+	'$continue_imported'(ExportingMod, ExportingModI, G0, G0I).
+'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod) :-
+	swi:swi_predicate_table(ImportingMod,G,ExportingModI,G0I),
+	'$continue_imported'(ExportingMod, ExportingModI, G0, G0I).
+'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod) :-
+	prolog:'$parent_module'(ImportingMod,ExportingModI),
+	'$continue_imported'(ExportingMod, ExportingModI, G0, G).
 
+'$continue_imported'(Mod,Mod,Pred,Pred) :-
+	\+ '$undefined'(Pred, Mod), !.
 '$continue_imported'(FM,Mod,FPred,Pred) :-
 	recorded('$import','$import'(IM,Mod,IPred,Pred,_,_),_), !,
 	'$continue_imported'(FM, IM, FPred, IPred).
-'$continue_imported'(Mod,Mod,Pred,Pred).
+'$continue_imported'(FM,Mod,FPred,Pred) :-
+	prolog:'$parent_module'(Mod,IM),
+	'$continue_imported'(FM, IM, FPred, Pred).
 
 
 % module_transparent declaration
@@ -694,3 +693,42 @@ abolish_module(_).
 	'$conj_has_cuts'(G3, DCP, NG3, OK).
 '$conj_has_cuts'(G,_,G, _).
 
+set_base_module(ExportingModule) :-
+	var(ExportingModule),
+	'$do_error'(instantiation_error,set_base_module(ExportingModule)).
+set_base_module(ExportingModule) :-
+	atom(ExportingModule), !,
+	'$current_module'(Mod),
+	retractall(prolog:'$parent_module'(Mod,ExportingModule)),
+	asserta(prolog:'$parent_module'(Mod,ExportingModule)).
+set_base_module(ExportingModule) :-
+	'$do_error'(type_error(atom,ExportingModule),set_base_module(ExportingModule)).
+
+import_module(Mod, ImportModule) :-
+	var(Mod),
+	'$do_error'(instantiation_error,import_module(Mod, ImportModule)).
+import_module(Mod, ImportModule) :-
+	atom(Mod), !,
+	prolog:'$parent_module'(Mod,ImportModule).
+import_module(Mod, EM) :-
+	'$do_error'(type_error(atom,Mod),import_module(Mod, EM)).
+
+add_import_module(Mod, ImportModule, Pos) :-
+	var(Mod),
+	'$do_error'(instantiation_error,add_import_module(Mod, ImportModule, Pos)).
+add_import_module(Mod, ImportModule, Pos) :-
+	var(Pos),
+	'$do_error'(instantiation_error,add_import_module(Mod, ImportModule, Pos)).
+add_import_module(Mod, ImportModule, start) :-
+	atom(Mod), !,
+	retractall(prolog:'$parent_module'(Mod,ImportModule)),
+	asserta(prolog:'$parent_module'(Mod,ImportModule)).
+add_import_module(Mod, ImportModule, end) :-
+	atom(Mod), !,
+	retractall(prolog:'$parent_module'(Mod,ImportModule)),
+	assertz(prolog:'$parent_module'(Mod,ImportModule)).
+add_import_module(Mod, ImportModule, Pos) :-
+	\+ atom(Mod), !,
+	'$do_error'(type_error(atom,Mod),add_import_module(Mod, ImportModule, Pos)).
+add_import_module(Mod, ImportModule, Pos) :-
+	'$do_error'(domain_error(start_end,Pos),add_import_module(Mod, ImportModule, Pos)).
diff --git a/pl/preds.yap b/pl/preds.yap
index d157dfdb3..32336c57d 100644
--- a/pl/preds.yap
+++ b/pl/preds.yap
@@ -798,7 +798,7 @@ predicate_property(Pred,Prop) :-
 	'$pred_exists'(Pred,Mod), !,
 	'$predicate_property'(Pred,Mod,Mod,Prop).
 '$predicate_property2'(Pred,Prop,Mod) :- 
-	'$imported_predicate'(M,Mod,NPred,Pred),
+	'$imported_pred'(Pred, Mod, NPred, M),
 	(
 	 Prop = imported_from(M)
 	;