34
35:- module(interface,
36 [ bind_interface/2
37 ]). 38
39:- use_module(library(lists)). 40:- use_module(library(apply)). 41:- use_module(library(error)). 42:- reexport(library(compound_expand)). 43:- init_expansors. 44
45:- multifile
46 '$interface_spec'/2,
47 '$interface'/2,
48 '$implementation'/2. 49
52
53not_interface(M, F/A) :-
54 current_predicate(M:F/A),
55 functor(H, F, A),
56 \+ predicate_property(M:H, dynamic),
57 \+ predicate_property(M:H, imported_from(_)).
58
59this_interface(Interface, DIL) -->
60 [interface:'$interface'(Interface, DIL)].
61
62scope_decl(shared, F/A, (:- dynamic F/A)).
63scope_decl(local, F/A, (:- thread_local F/A)).
64
65decl_dynbridge(DIL, Scope) -->
66 {scope_decl(Scope, F/A, Decl)},
67 findall(Decl, member(F/A, DIL)).
68
69end_interface(Interface, Scope, DIL) -->
70 this_interface(Interface, DIL),
71 decl_dynbridge(DIL, Scope).
72
73term_expansion_decl(implements(Alias), Clauses) :-
74 '$current_source_module'(Implementation),
75 Implementation:use_module(Alias, []), 76 absolute_file_name(Alias, File, [file_type(prolog), access(read)]),
77 module_property(Interface, file(File)),
78 term_expansion_decl(implements_mod(Interface), Clauses).
79term_expansion_decl(implements_mod(Interface), Clauses) :-
80 '$current_source_module'(Implementation),
81 '$interface'(Interface, PIL),
82 phrase(( [interface:'$implementation'(Implementation, Interface)],
83 findall((:- meta_predicate Implementation:Spec),
84 ( member(F/A, PIL),
85 functor(Pred, F, A),
86 predicate_property(Interface:Pred, meta_predicate(Spec))
87 )),
88 findall((:- export(PI)), member(PI, PIL))
89 ), Clauses).
90term_expansion_decl(interfaces(Alias), Clauses) :-
91 term_expansion_decl(interfaces(Alias, shared), Clauses).
92term_expansion_decl(interfaces(Alias, Scope), Clauses) :-
93 '$current_source_module'(Interface),
94 Interface:use_module(Alias, []),
95 absolute_file_name(Alias, File, [file_type(prolog), access(read)]),
96 module_property(Implementation, file(File)),
97 term_expansion_decl(interfaces_mod(Implementation, Scope), Clauses).
98term_expansion_decl(interfaces_mod(Implementation), Clauses) :-
99 term_expansion_decl(interfaces_mod(Implementation, shared), Clauses).
100term_expansion_decl(interfaces_mod(Implementation, Scope), Clauses) :-
101 '$current_source_module'(Interface),
102 phrase(interfaces_mod_clauses(Interface, Scope, Implementation), Clauses).
103term_expansion_decl(interface, interface:'$interface_spec'(Interface, shared)) :-
104 '$current_source_module'(Interface).
105term_expansion_decl(interface(Scope), interface:'$interface_spec'(Interface, Scope)) :-
106 memberchk(Scope, [shared, local]),
107 '$current_source_module'(Interface).
108
109interfaces_mod_clauses(Interface, Scope, Implementation) -->
110 {module_property(Implementation, exports(PIL))},
111 findall((:- export(PI)), member(PI, PIL)),
112 end_interface(Interface, Scope, PIL).
113
114term_expansion((:- Decl), Clauses) :-
115 term_expansion_decl(Decl, Clauses).
116term_expansion(end_of_file, Clauses) :-
117 '$current_source_module'(Interface),
118 '$interface_spec'(Interface, Scope),
119 module_property(Interface, file(File)),
120 prolog_load_context(source, File),
121 module_property(Interface, exports(PIL)),
122 exclude(not_interface(Interface), PIL, DIL),
123 phrase(end_interface(Interface, Scope, DIL), Clauses, [end_of_file]).
124
125prolog:called_by(Pred, Interface, Context, PredL) :-
126 '$interface'(Interface, DIL),
127 member(F/A, DIL),
128 functor(Pred, F, A),
129 findall(@(Implementation:Pred, Context),
130 interface:'$implementation'(Implementation, Interface),
131 PredL),
132 PredL \= [].
138bind_interface(Interface, Implementation) :-
139 ( '$interface'(Interface, DIL)
140 ->true
141 ; existence_error(interface, Interface)
142 ),
143 ( '$implementation'(Implementation, Interface)
144 ->true
145 ; ( '$implementation'(Implementation, _)
146 ->existence_error(implementation, Implementation)
147 ; existence_error(binding, Interface->Implementation)
148 )
149 ),
150 forall(( member(F/A, DIL),
151 functor(H, F, A)
152 ),
153 ( retractall(Interface:H),
154 Implementation:assertz((Interface:H :- H))))