32:- module(lps, [pop_lps_dialect/0,push_lps_dialect/0,dialect_input_stream/1, calc_load_module_lps/1]). 34
35
36 39
40:- multifile
41 user:goal_expansion/2,
42 user:file_search_path/2,
43 user:prolog_file_type/2,
44 lps_dialect_expansion/2. 45
46:- dynamic
47 user:goal_expansion/2,
48 user:file_search_path/2,
49 user:prolog_file_type/2. 50
52
53
54lps_debug(Info):- ignore(notrace((debug(lps(dialect),'~N% ~p.',[Info])))).
63lps_dialect_expansion(expects_dialect(Dialect), Out):-
64 65 swi \== Dialect ->
66 Out = debug(lps(term_expansion),'~q.',[(expects_dialect(Dialect))])
67 ; Out=pop_lps_dialect.
80
81 84
87
88:-
89 exists_source(library(dialect/lps)) -> true;
90 (prolog_load_context(directory, ThisDir),
91 absolute_file_name('..', Dir,
92 [ file_type(directory),
93 access(read),
94 relative_to(ThisDir),
95 file_errors(fail)
96 ]),
97 asserta((user:file_search_path(library, Dir)))). 109:- user:file_search_path(lps_library, Dir) -> true;
110 (prolog_load_context(directory, ThisDir),
111 absolute_file_name('../..', Dir,
112 [ file_type(directory),
113 access(read),
114 relative_to(ThisDir),
115 file_errors(fail)
116 ]),
117 asserta((user:file_search_path(lps_library, Dir)))).
126push_lps_file_extension :-
127 asserta((user:prolog_file_type(lps, prolog) :-
128 prolog_load_context(dialect, lps))).
129
130
131:- push_lps_file_extension. 132
133
134:- multifile
135 prolog:message//1. 136
137prolog:message(lps_unsupported(Goal)) -->
138 [ 'LPS emulation (lps.pl): unsupported: ~p'-[Goal] ].
139
140
141:- use_module(library(pengines),[pengine_self/1]).
142
143calc_load_module_lps(OM):- pengine_self(OM),!.
144calc_load_module_lps(OM):-
145 '$current_typein_module'(TM),
146 prolog_load_context(module,Load),strip_module(_,Strip,_),
147 context_module(Ctx),'$current_source_module'(SM),
148 ((SM==Load,SM\==user)-> Module = SM ;
149 ((TM\==Load,TM\==user) -> Module = TM ; (Module = SM))),
150 OM=Load,
151 lps_debug([ti=TM,load=Load,strip=Strip,ctx=Ctx,sm=SM,lps=Module,using=OM]),!.
152
153calc_load_module_lps(Module):-
154 (member(Call,[
155 prolog_load_context(module,Module),
156 pengine_self(Module),
157 '$current_source_module'(Module),
158 '$current_typein_module'(Module),
159 interpreter:lps_program_module(Module),
160 strip_module(_,Module,_),
161 context_module(Module),
162 source_location(Module,_)]),
163 call(Call),
164 lps_debug(calc_load_module_lps(Call)),
165 \+ likely_reserved_module(Module)); interpreter:must_lps_program_module(Module).
166get_lps_program_module(Module):- interpreter:lps_program_module(Module).
167
168set_lps_program_module(Module):- interpreter:must_lps_program_module(Module).
169
170likely_reserved_module(Module):- Module=user;
171 module_property(Module,P), member(P,[class(library),class(system),exported_operators([_|_]),exports([_|_])]).
172
173
174
175
176 :- volatile(tmp:module_dialect_lps/4). 177:- thread_local(tmp:module_dialect_lps/4). 178
179
180:- lps:export(lps:push_lps_dialect/0).
181:- system:import(lps:push_lps_dialect/0).
182
183:- system:module_transparent(lps:setup_dialect/0).
184:- system:module_transparent(lps:pop_lps_dialect/0). 185:- system:module_transparent(lps:push_lps_dialect/0). 187
188lps:setup_dialect:-
189 lps_debug(push_lps_dialect),lps_debug(ops),
190 (push_lps_dialect->true;(trace,push_lps_dialect)),
191 lps_debug(continue_lps_dialect),lps_debug(ops).
192
193:- system:module_transparent(prolog_dialect:expects_dialect/1).
195
196
197
200
201
202get_lps_alt_user_module(_User,LPS_USER):- interpreter:lps_program_module(LPS_USER),!.
203get_lps_alt_user_module( user, db):-!.
204get_lps_alt_user_module( User,LPS_USER):- is_lps_alt_user_module(User,LPS_USER),!.
206
208is_lps_alt_user_module(_User,Out):- gensym(lps, Out).
209
211
212
213lps_operators(Module,[
214 op(900,fy,(Module:not)),
215 op(1200,xfx,(Module:then)),
216 op(1185,fx,(Module:if)),
217 op(1190,xfx,(Module:if)),
218 op(1100,xfy,(Module:else)),
219 op(1050,xfx,(Module:terminates)),
220 op(1050,xfx,(Module:initiates)),
221 op(1050,xfx,(Module:updates)),
222 223 op(1050,fx,(Module:observe)),
224 op(1050,fx,(Module:false)),
225 op(1050,fx,(Module:initially)),
226 op(1050,fx,(Module:fluents)),
227 op(1050,fx,(Module:events)),
228 op(1050,fx,(Module:prolog_events)),
229 op(1050,fx,(Module:actions)),
230 op(1050,fx,(Module:unserializable)),
231 232 op(999,fx,(Module:update)),
233 op(999,fx,(Module:initiate)),
234 op(999,fx,(Module:terminate)),
235 op(997,xfx,(Module:in)),
236 op(995,xfx,(Module:at)),
237 op(995,xfx,(Module:during)),
238 op(995,xfx,(Module:from)),
239 op(994,xfx,(Module:to)), 240 op(1050,xfy,(Module:(::))),
241
242 243 op(1200,xfx,(Module:(<-))),
244 op(1050,fx,(Module:(<-))),
245 246 op(700,xfx,((Module:(<=))))
247]).
248
249add_lps_to_module(Module):-
250 notrace(interpreter:ensure_loaded(library('../engine/interpreter.P'))),
251 notrace(lps_term_expander:ensure_loaded(library('../swish/term_expander.pl'))),
252 notrace(lps_repl:ensure_loaded(library(lps_corner))),
253 254 interpreter:check_lps_program_module(Module),
255 Module:style_check(-discontiguous), Module:style_check(-singleton),
256 db:define_lps_into_module(Module),
257 !.
258
259push_lps_dialect:-
260 calc_load_module_lps(Module),
261 lps_expects_dialect(Module, Module).
262
263lps_expects_dialect(User, User):-
264 User==user,
265 get_lps_alt_user_module(User,LPS_USER),
266 LPS_USER\==user,
267 lps_debug(alt_module(User,LPS_USER)),
268 '$set_source_module'(LPS_USER),!,
269 lps_expects_dialect(User, LPS_USER).
270
271
272lps_expects_dialect(Was, Module):-
273 add_lps_to_module(Module),
274 dialect_input_stream(Source),
275 lps_operators(Module, Ops),
276 push_operators(Module:Ops, Undo),
277 278 asserta(tmp:module_dialect_lps(Source,Was,Module,Undo)),!.
279
280dialect_input_stream(Source):- prolog_load_context(source,Source)->true;current_input(Source).
282
283pop_lps_dialect:-
284 dialect_input_stream(Source),
285 retract(tmp:module_dialect_lps(Source,Was,Module,Undo)),!,
286 pop_operators(Undo),
287 lps_debug(pop_lps_dialect(Source,Module->Was)),
288 289 lps_debug(ops).
290pop_lps_dialect:-
291 retract(tmp:module_dialect_lps(Source,Was,Module,Undo)),!,
292 print_message(warning, format('~q', [warn_pop_lps_dialect_fallback(Source,Module->Was)])),
293 294 295 pop_operators(Undo),
296 297 lps_debug(ops).
298pop_lps_dialect:-
299 lps_debug(ops),
300 print_message(warning, format('~q', [missing_pop_lps_dialect_fallback])).
301
302
303
304 307
308:- multifile
309 prolog:alternate_syntax/4. 310
311
312prolog:alternate_syntax(lps, Module,
313 lps:push_lps_operators(Module),
314 lps:pop_lps_operators).
315
316
320
321push_lps_operators :-
322 '$set_source_module'(Module, Module),
323 push_lps_operators(Module).
324
325push_lps_operators(Module) :-
326 lps_operators(Module, Ops),
327 push_operators(Module:Ops).
328
329pop_lps_operators :-
330 pop_operators.
331
332
333user:goal_expansion(In, Out) :-
334 prolog_load_context(dialect, lps),
335 lps_dialect_expansion(In, Out).
336
337
338
339system:term_expansion(In, PosIn, Out, PosOut) :-
340 prolog_load_context(dialect, lps),
341 In == (:- include(system('date_utils.pl'))),
342 PosIn=PosOut,
343 expects_dialect(swi),
344 Out = [(:- expects_dialect(swi)),
345 (:- include(system('date_utils.pl'))),
346 (:- expects_dialect(lps))],!.
347
348system:term_expansion(In, PosIn, Out, PosOut) :- In == end_of_file,
349 prolog_load_context(dialect, lps),
350 dialect_input_stream(Source),
351 tmp:module_dialect_lps(Source,_,_,_),
352 pop_lps_dialect,!,
353 Out = In,
354 PosIn = PosOut
LPS Compatibility module
This module provides compatibility to LPS through the directive expects_dialect/1:
.lps
extension as extension for Prolog files. If both a.pl
and.lps
is present, the.lps
file is loaded if the current environment expects LPS.