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