LPS Compatibility module

This module provides compatibility to LPS through the directive expects_dialect/1:

:- expects_dialect(lps)

author

- Douglas R. Miles */

To be done

- this module meeds

Implement system predicates available in LPS we do not yet or do not wish to support in SWI-Prolog. Export these predicates.
Provide lps_<name>(...) predicates for predicates that exist both in LPS and SWI-Prolog and define goal_expansion/2 rules to map calls to these predicates to the lps_<name> version. Export these predicates.
Alter the library search path, placing dialect/lps before the system libraries.
Allow for .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.

- The dialect-compatibility packages are developed in a `demand-driven' fashion. Please contribute to this package. Fill it in!

32:- module(lps, [pop_lps_dialect/0,push_lps_dialect/0,dialect_input_stream/1, calc_load_module_lps/1]). 33% :- asserta(swish:is_a_module). 34 35 36 /******************************* 37 * EXPANSION * 38 *******************************/ 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 51% :- notrace(system:ensure_loaded(library(operators))). 52 53 54lps_debug(Info):- ignore(notrace((debug(lps(dialect),'~N% ~p.',[Info])))). 55% lps_debug(X):- format(user_error,'~N% LPS_DEBUG: ~q.~n',[X]),flush_output(user_error).

63lps_dialect_expansion(expects_dialect(Dialect), Out):- 64 % in case it is used more than once 65 swi \== Dialect -> 66 Out = debug(lps(term_expansion),'~q.',[(expects_dialect(Dialect))]) 67 ; Out=pop_lps_dialect. 68/* 69lps_dialect_expansion(eval_arith(Expr, Result), 70 Result is Expr). 71 72lps_dialect_expansion(if(Goal, Then), 73 (Goal *-> Then; true)). 74lps_dialect_expansion(if(Goal, Then, Else), 75 (Goal *-> Then; Else)). 76lps_dialect_expansion(style_check(Style), 77 lps_style_check(Style)). 78 79*/ 80 81 /******************************* 82 * LIBRARY SETUP * 83 *******************************/ 84 85% Pushes searching for dialect/lps in front of every library 86% directory that contains such as sub-directory. 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)))). 98/* 99:- prolog_load_context(directory, ThisDir), 100 absolute_file_name('lps_autoload', Dir, 101 [ file_type(directory), 102 access(read), 103 relative_to(ThisDir), 104 file_errors(fail) 105 ]), 106 asserta((user:file_search_path(library, Dir) :- 107 prolog_load_context(dialect, lps))). 108*/ 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). 186%:- system:module_transparent(lps:lps_expects_dialect/2). 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). 194%:- prolog_dialect:import(lps:push_lps_dialect/0). 195 196 197 198% :- prolog_dialect:asserta((())). 199% :- thread_local(interpreter:lps_program_module/1). 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),!. 205%get_lps_alt_user_module(_User,LPS_USER):- interpreter:lps_program_module(LPS_USER),!. 206 207% is_lps_alt_user_module(user,db):-!. 208is_lps_alt_user_module(_User,Out):- gensym(lps, Out). 209 210% is_lps_alt_user_module(db). 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 % Rejected ( op(1050,fx,impossible), 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 % notice ',' has priority 1000 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)), % from's priority higher 240 op(1050,xfy,(Module:(::))), 241 242 % lps.js syntax extras 243 op(1200,xfx,(Module:(<-))), 244 op(1050,fx,(Module:(<-))), 245 % -> is already defined as 1050, xfy, which will do given that lps.js does not support if-then-elses 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 %notrace(system:ensure_loaded(library(broadcast))), 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 %ignore(retract(tmp:module_dialect_lps(Source,_,_,_))), 278 asserta(tmp:module_dialect_lps(Source,Was,Module,Undo)),!. 279 280dialect_input_stream(Source):- prolog_load_context(source,Source)->true;current_input(Source). 281% dialect_input_stream(Source):- prolog_load_context(stream,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 %nop('$set_source_module'(Was)),!, 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 %dumpST, 294 %lps_debug(ops), 295 pop_operators(Undo), 296 %nop('$set_source_module'(Was)),!, 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 /******************************* 305 * SYNTAX HOOKS * 306 *******************************/ 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 317/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 318Note that we could generalise this to deal with all included files. 319- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 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