% Search a OO database:
% --------------------

:- dynamic( limit_count/1 ).
:- dynamic( limit/1 ).

% pre-loading of namespaces
% [load the namespaces in turn while queries are not being executed]

do_load_all_namespaces( List, X, Thread ) :-
	fork( load_and_prime_namespaces( List, X ), Thread ).

load_and_prime_namespaces( List, X ) :-
	load_namespaces( List, X ),
	prime_namespaces( List, X ).

load_namespaces( [], X ) :- !.
load_namespaces( [H|T], X ) :-
	( load_namespace( H, X ) -> true; true ),
	load_namespaces( T, X ).

load_namespace( H, X ) :-
	lock( X ),
	atom_chars( H, AtomChars ),
	atom_chars( '_database', EndChars ),
	append( AtomChars, EndChars, AssName ),
	atom_chars( AssemblyName, AssName ),
	( load_assembly( AssemblyName ) -> true; true ),
	write( 'Loaded: ' ), write( AssemblyName ), nl,
	unlock( X ).

prime_namespaces( [], X ) :- !.
prime_namespaces( [H|T], X ) :-
	( prime_namespace( H, X ) -> true; true ),
	prime_namespaces( T, X ).
	
prime_namespace( H, X ) :-
	lock( X ),
	write( 'priming...' ), nl,
	atom_chars( H, AtomChars ),
	atom_chars( '_database', EndChars ),
	append( AtomChars, EndChars, AssName ),
	atom_chars( AssemblyName, AssName ),
	( load_assembly( AssemblyName ) -> true; true ),
	oo_search_class_defines_prime( H, ['x'] ),
	write( 'Primed: ' ), write( H ), nl,
	unlock( X ).

% main entry
% ----------

echo_input( [] ) :- !.
echo_input( [H|T] ) :-
	write( H ), 
	nl, 
	echo_input( T ).
	
reverse(List, Reversed) :-
          reverse(List, [], Reversed).
reverse([], Reversed, Reversed).
reverse([Head|Tail], SoFar, Reversed) :-
          reverse(Tail, [Head|SoFar], Reversed).
	
% oo_search_namespaces( <list of namespaces>, <type of search>, <input>, <output> ).
% this should find the lists for every member of <list of namespaces> and
% append these lists together to form the <output>
% each namespace in the list is an atom of the form 'System', and this would load
% the DLL System_database.dll

oo_search_namespaces( Namespaces, Type, Classes, Static, Input, X, Limit, LOCK, Thread ) :-
	global_abolish( limit_count/1 ),
	global_abolish( limit/1 ),
	global_assert( limit_count( 0 ) ),
	global_assert( limit( Limit ) ),
	reverse( Namespaces, NamespacesR ),
	reverse( Input, InputR ),
	fork( oo_search_namespaces_lock( NamespacesR, Type, Classes, Static, InputR, X, LOCK ), Thread ).
	
oo_search_namespaces_lock( A, B, C, D, E, F, LOCK ) :-
	lock( LOCK ),
	oo_search_namespaces_inner( A, B, C, D, E, F ),
	unlock( LOCK ).
	
oo_search_namespaces_inner( [], _, _, _, _, X ) :- 
	!, 
	pulse( X, 0 ).
oo_search_namespaces_inner( [H|T], Type, Classes, Static, Input, X ) :-
	atom_chars( H, AtomChars ),
	atom_chars( '_database', EndChars ),
	append( AtomChars, EndChars, AssName ),
	atom_chars( AssemblyName, AssName ),
	load_assembly( AssemblyName ),
	% echo_input( Input ),
	oo_search_iterate_classes( H, Type, Classes, Static, Input, X ),
	( reached_end ->
		pulse( X, 0 )
	;
	    oo_search_namespaces_inner( T, Type, Classes, Static, Input, X )
	).

oo_search_iterate_classes( H, Type, [], either, Input, X ) :- 
	!,
	once( oo_search( H, _, _, Type, Input, X ) ).
oo_search_iterate_classes( H, Type, [], Static, Input, X ) :-
	!,
	once( oo_search( H, _, Static, Type, Input, X ) ).
oo_search_iterate_classes( H, Type, List, either, Input, X ) :-
	!,
	once( oo_search_iterate_classes_inner( H, Type, List, _, Input, X ) ).
oo_search_iterate_classes( H, Type, List, Static, Input, X ) :-
	once( oo_search_iterate_classes_inner( H, Type, List, Static, Input, X ) ).

oo_search_iterate_classes_inner( _, _, [], _, _, _ ) :- !.
oo_search_iterate_classes_inner( H, Type, [ClassHead|ClassTail], Static, Input, X ) :-
	oo_search( H, ClassHead, Static, Type, Input, X ),
	oo_search_iterate_classes_inner( H, Type, ClassTail, Static, Input, X ).

append( [], L, L ).
append( [H1|T1], L2, [H1|L3] ) :-
	append( T1, L2, L3 ).

% indirection.
% ------------

oo_search( N, Class, Static, meth_args, Args, List ) :- 
	oo_search_meth_args( N, Class, Static, Args, List ).
oo_search( N, Class, Static, meth_exact_args, Args, List ) :-
	oo_search_meth_exact_args( N, Class, Static, Args, List ).
oo_search( N, Class, Static, meth_exact_ordered_args, Args, List ) :-
	oo_search_meth_exact_ordered_args( N, Class, Static, Args, List ).
oo_search( N, Class, Static, meth_return, RetType, List ) :-
	oo_search_meth_return( N, Class, Static, RetType, List ).
oo_search( N, Class, Static, field_type, Type, List ) :-
	oo_search_field_type( N, Class, Static, Type, List ).
oo_search( N, Class, Static, class_defines, Member, List ) :-
	oo_search_class_defines( N, Member, List ).
oo_search( N, Class, Static, class_superclass, ClassInput, List ) :-
	oo_search_class_superclass( ClassInput, List ).
oo_search( N, Class, Static, class_direct_subclasses, ClassInput, List ) :-
	oo_search_class_direct_subclasses( ClassInput, List ).

% classes and interfaces are both members
% ---------------------------------------

members( A, B, C, D, E ) :- call( classmember( A, B, C, D, E ) ).
members( A, B, C, D, E ) :- call( interfacemember( A, B, C, D, E ) ).
members( A, B, C, D, E ) :- call( structmember( A, B, C, D, E ) ).

% pulse
% -----

pulse( X, N ) :-
	X = N,
	inc_count,
	fail.
pulse( _, _ ).

inc_count :-
	global_call( limit_count( C ) ),
	C1 is C + 1,
	global_retract( limit_count( C ) ),
	global_assert( limit_count( C1 ) ),
	write( 'Limit count is : ' ), write( C1 ), nl.
	
reached_end :-
	global_call( limit( L ) ),
	global_call( limit_count( C ) ),
	C == L.

not_reached_end :-
	global_call( limit( L ) ),
	global_call( limit_count( C ) ),
	C =\= L.

% method args
% -----------

oo_search_meth_args( N, Class, Static, Args, X ) :-
	meth_args( N, Class, Static, Args, Result ),
	pulse( X, Result ),
	reached_end, !.
oo_search_meth_args( _, _, _, _, _ ).
	
meth_args( N, C, Static, Args, class_method( C, M, Args2, Static ) ) :-
	members( N, C, Static, method, MArgs ),
	MArgs =.. [ M |[ RetType | Args2 ] ],
	once( list_subset( Args, Args2 ) ).

list_subset( [X|Xs], Ys ) :-
	select( X, Ys, Zs ),
	list_subset( Xs, Zs ).
list_subset( [], _ ).

select( H, [H|T], T ).
select( X, [H|T], [H|L] ) :-
	select( X, T, L ).
	
append( [], L2, L2 ). 
append( [H1|T1], L2, [H1|L3] ) :- append( T1, L2, L3 ). 
	
% method exact args
% -----------------
	
oo_search_meth_exact_args( N, Class, Static, Args, X ):-
	meth_exact_args( N, Class, Static, Args, Result ),
	pulse( X, Result ),
    reached_end, !.
oo_search_meth_exact_args( _, _, _, _, _ ).
		
meth_exact_args( N, C, Static, Args, class_method( C, M, Args2, Static ) ) :-
	members( N, C, Static, method, MArgs ),
	MArgs =.. [ M |[ RetType | Args2 ] ],
	list_perm( Args, Args2 ).

list_perm( [], [] ).
list_perm(List, [First|Perm]) :-
        select(First, List, Rest),
        list_perm(Rest, Perm).

% method exact ordered args
% -------------------------

oo_search_meth_exact_ordered_args( N, Class, Static, Args, X ) :-
	meth_exact_ordered_args( N, Class, Static, Args, Result ),
	pulse( X, Result ),
	reached_end, !.
oo_search_meth_exact_ordered_args( _, _, _, _, _ ).
	
meth_exact_ordered_args( N, C, Static, Args, class_method( C, M, Args2, Static ) ) :-
	members( N, C, Static, method, MArgs ),
	MArgs =.. [ M |[ RetType | Args2 ] ],
	list_equal( Args, Args2 ).

list_equal( [], [] ).
list_equal( [H|T1], [H|T2] ) :-
	list_equal( T1, T2 ).
	
% search for method which returns given type
% ------------------------------------------

oo_search_meth_return( N, Class, Static, [RetType], X ) :-
	meth_return( N, Class, Static, RetType, Result ),
	pulse( X, Result ),
	reached_end, !.
oo_search_meth_return( _, _, _, _, _ ).
	
meth_return( N, C, Static, RetType, class_method( C, M, Args, Static ) ) :-
	members( N, C, Static, method, MArgs ),
	MArgs =.. [M | [ RetType | Args ] ].
	
% search for field by type
% ------------------------

oo_search_field_type( N, Class, Static, [Type], X ) :-
	field_type( N, Class, Static, Type, Result ),
	pulse( X, Result ),
	reached_end, !.
oo_search_field_type( _, _, _, _, _ ).	

field_type( N, C, Static, Type, class_field( C, F, Static ) ) :-
	members( N, C, Static, field, FType ),
	FType =.. [ F, Type ].	

% search for a class which defines a given member name
% ----------------------------------------------------

oo_search_class_defines( N, [Member], X ) :-
	class_defines( N, Member, Result ),
	pulse( X, Result ),
	reached_end, !.
oo_search_class_defines( _, _, _ ).
	
class_defines( N, Member, class( Class ) ) :-
	members( N, Class, _, _, M ),
	M =.. [ Member | _ ].

% priming version of the above
% ----------------------------

oo_search_class_defines_prime( N, [Member] ) :-
	class_defines( N, Member, _ ),
	fail.
oo_search_class_defines_prime( _, _ ).

% find all superclasses starting with the direct one
% --------------------------------------------------

oo_search_class_superclass( [Class], X ) :-
	pulse( X, class( Class ) ),
	iterate_up_hierachy( Class, X ).

iterate_up_hierachy( Class, X ) :-
	call( derives( Superclass, Class ) ),
	pulse( X, class( Superclass ) ),
	not_reached_end, !,
	iterate_up_hierachy( Superclass, X ).
iterate_up_hierachy( _, _ ).

% direct subclasses
% -----------------

oo_search_class_direct_subclasses( [Class], X ) :-
	class_superclass( Result, Class ),
	pulse( X, class( Result ) ),
	reached_end, !.
oo_search_class_direct_subclasses( _, _ ).

class_superclass( Subclass, Class ) :-
	call( derives( Class, Subclass ) ).