/** <module> LPS Compatibility module

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

	==
	:- expects_dialect(lps)
	==

@tbd 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.

@tbd	The dialect-compatibility packages are developed in a
	`demand-driven' fashion.  Please contribute to this package. Fill it in!
@author Douglas R. Miles

*/

:- module(lps, [lps_pop_dialect/2, lps_expects_dialect/1, expecting_lps_dialect/0, 
   lps_debug/1, lps_expects_dialect/4,dialect_input_stream_lps/1]).
% :- asserta(swish:is_a_module).


		 /*******************************
		 *	     EXPANSION		*
		 *******************************/

:- multifile
	user:goal_expansion/2,
	user:file_search_path/2,
	user:prolog_file_type/2,
	lps_dialect_expansion/2.
	
:- dynamic
	user:goal_expansion/2,
	user:file_search_path/2,
	user:prolog_file_type/2.

% :- notrace(system:ensure_loaded(library(operators))).


% lps_debug(Info):- ignore(notrace((debug(lps(dialect),'~N% ~p.',[Info])))).
lps_debug(_):-!.
lps_debug(I):- ignore(notrace(lps_debug0(I))).

lps_debug0(state):- !, lps_state.
lps_debug0(X):- format(user_error,'~N% LPS_DEBUG: ~p.~n',[X]),flush_output(user_error).

show_all_debug_lps(G):- ignore(((G *-> lps_debug0(G);lps_debug0(failed(G))),fail)).


lps_state:-!,
  show_all_debug_lps(prolog_load_context(dialect,_)),
  G = lpstmp:module_dialect_lps(_,_,_,Module,_),
  OP = current_op(_,fy,(Module:'-')),
  show_all_debug_lps((G,OP)),
  show_all_debug_lps(predicate_property(G,number_of_clauses(_))),
  Module = user, show_all_debug_lps((OP)).

:- export(lps:lps_state/0).
:- system:import(lps:lps_state/0).



%%	lps_dialect_expansion(+In, +Out)
%
%	goal_expansion rules to emulate LPS behaviour in SWI-Prolog. The
%	expansions  below  maintain  optimization    from   compilation.
%	Defining them as predicates would loose compilation.

lps_dialect_expansion(expects_dialect(Dialect), lps_expects_dialect(Dialect)):-!.

lps_expects_dialect(Dialect):-  
 prolog_load_context(module, Module),  
 notrace((
  lps:(prolog_load_context(dialect, Was),
  dialect_input_stream_lps(Source),
  lps_debug(lps_expects_dialect(Dialect,Source,Was,Module))))),
  lps_expects_dialect(Dialect,Source,Was,Module),
  lps_debug(state).

expecting_lps_dialect:- 
 notrace((
  prolog_load_context(dialect, lps),
  prolog_load_context(module, Module),
  dialect_input_stream_lps(Source),
  lpstmp:module_dialect_lps(lps,Source,_,Module,_Undo))).


  %prolog_load_context(dialect, Was)
%  ((Was==lps, Dialect\==lps)-> lps_pop_dialect ; true),
%  expects_dialect(Dialect).

/*
 % current_prolog_flag(emulated_dialect, lps) 
 dumpST,
 wdmsg(expects_dialect(Dialect)),
   fail,
   % in case it is used more than once   
   lps == Dialect -> 
       Out = debug(lps(term_expansion),'~q.',[(expects_dialect(Dialect))])
     ; Out=lps_pop_dialect.
*/
/*
lps_dialect_expansion(eval_arith(Expr, Result),
	      Result is Expr).

lps_dialect_expansion(if(Goal, Then),
	      (Goal *-> Then; true)).
lps_dialect_expansion(if(Goal, Then, Else),
	      (Goal *-> Then; Else)).
lps_dialect_expansion(style_check(Style),
	      lps_style_check(Style)).

*/

		 /*******************************
		 *	    LIBRARY SETUP	*
		 *******************************/

%	Pushes searching for  dialect/lps  in   front  of  every library
%	directory that contains such as sub-directory.

:-      
   exists_source(library(dialect/lps)) -> true;
   (prolog_load_context(directory, ThisDir),
   absolute_file_name('..', Dir,
          [ file_type(directory),
            access(read),
            relative_to(ThisDir),
            file_errors(fail)
          ]),
   asserta((user:file_search_path(library, Dir)))).
/*
:- prolog_load_context(directory, ThisDir),
   absolute_file_name('lps_autoload', Dir,
			       [ file_type(directory),
				 access(read),
                                 relative_to(ThisDir),
				 file_errors(fail)
			       ]),
      asserta((user:file_search_path(library, Dir) :-
	prolog_load_context(dialect, lps))).
*/
:- user:file_search_path(lps_library, Dir) -> true;
    (prolog_load_context(directory, ThisDir),
         absolute_file_name('../..', Dir,
			       [ file_type(directory),
				 access(read),
                                 relative_to(ThisDir),
				 file_errors(fail)
			       ]),
	    asserta((user:file_search_path(lps_library, Dir)))).



%%	push_lps_file_extension
%
%	Looks for .lps files before looking for .pl files if the current
%	dialect is =lps=.

push_lps_file_extension :-
	asserta((user:prolog_file_type(lps, prolog) :-
		    prolog_load_context(dialect, lps))).


:- push_lps_file_extension.


:- multifile
	prolog:message//1.

prolog:message(lps_unsupported(Goal)) -->
	[ 'LPS emulation (lps.pl): unsupported: ~p'-[Goal] ].


:- use_module(library(pengines),[pengine_self/1]). 

calc_load_module_lps(OM):- pengine_self(OM),!.
calc_load_module_lps(OM):- 
     '$current_typein_module'(TM), 
     prolog_load_context(module,Load),strip_module(_,Strip,_),
     context_module(Ctx),'$current_source_module'(SM),
     ((SM==Load,SM\==user)-> Module = SM ;
     ((TM\==Load,TM\==user) -> Module = TM ; (Module = SM))),
     OM=Load,
     lps_debug([ti=TM,load=Load,strip=Strip,ctx=Ctx,sm=SM,lps=Module,using=OM]),!.     

calc_load_module_lps(Module):- 
    (member(Call,[
     prolog_load_context(module,Module),
     pengine_self(Module),
     '$current_source_module'(Module),
     '$current_typein_module'(Module),
     get_lps_program_module(Module),
     strip_module(_,Module,_),
     context_module(Module),
     source_location(Module,_)]),
    call(Call),
    lps_debug(calc_load_module_lps(Call)),
    \+ likely_reserved_module(Module)).
calc_load_module_lps(Module):- set_lps_program_module(Module).


get_lps_program_module(Module):- interpreter:lps_program_module(Module).

set_lps_program_module(Module):- interpreter:must_lps_program_module(Module).

likely_reserved_module(Module):- Module=user; 
  module_property(Module,P), member(P,[class(library),class(system),exported_operators([_|_]),exports([_|_])]).

/*
:- volatile(tmp:module_dialect_lps/4).
:- thread_local(tmp:module_dialect_lps/4).

    :- volatile(lpstmp:module_dialect_lps/5).
:- thread_local(lpstmp:module_dialect_lps/5).


:- system:module_transparent(lps:setup_dialect/0). 
:- system:module_transparent(prolog_dialect:expects_dialect/1). 
lps:setup_dialect:- lps_expects_dialect(lps).
   

lps_operators(Module,[
  op(900,fy,(Module:not)), 
  op(1200,xfx,(Module:then)),
  op(1185,fx,(Module:if)),
  op(1190,xfx,(Module:if)),
  op(1100,xfy,(Module:else)), 
  op(1050,xfx,(Module:terminates)),
  op(1050,xfx,(Module:initiates)),
  op(1050,xfx,(Module:updates)),
  % Rejected    (      op(1050,fx,impossible), 
  op(1050,fx,(Module:observe)),
  op(1050,fx,(Module:false)),
  op(1050,fx,(Module:initially)),
  op(1050,fx,(Module:fluents)),
  op(1050,fx,(Module:events)),
  op(1050,fx,(Module:prolog_events)),
  op(1050,fx,(Module:actions)),
  op(1050,fx,(Module:unserializable)),
  % notice ',' has priority 1000
  op(999,fx,(Module:update)),
  op(999,fx,(Module:initiate)),
  op(999,fx,(Module:terminate)),
  op(997,xfx,(Module:in)),
  op(995,xfx,(Module:at)),
  op(995,xfx,(Module:during)),
  op(995,xfx,(Module:from)), 
  op(994,xfx,(Module:to)), % from's priority higher
  op(1050,xfy,(Module:(::))),
  
  % lps.js syntax extras
  op(1200,xfx,(Module:(<-))),
  op(1050,fx,(Module:(<-))),
  % -> is already defined as 1050, xfy, which will do given that lps.js does not support if-then-elses
  op(700,xfx,((Module:(<=))))
]).


add_lps_to_module(Module):-
   notrace(interpreter:ensure_loaded(library('../engine/interpreter.P'))),
   notrace(lps_term_expander:ensure_loaded(library('../swish/term_expander.pl'))),
   notrace(lps_repl:ensure_loaded(library(lps_corner))),
   %notrace(system:ensure_loaded(library(broadcast))),
   interpreter:check_lps_program_module(Module),
   Module:style_check(-discontiguous), Module:style_check(-singleton),
   db:define_lps_into_module(Module),
   !.

other_dialect(Dialect):- Dialect==swi.

:- system:module_transparent(lps:lps_expects_dialect/4).
:- system:import(lps:lps_expects_dialect/4).
lps_expects_dialect(SWI,Source,_,Module):- other_dialect(SWI),!,lps_pop_dialect(Source,Module), expects_dialect(SWI).
%lps_expects_dialect(SWI,_,Bin,_):- other_dialect(SWI),other_dialect(Bin),!, expects_dialect(SWI).
lps_expects_dialect(WAS,_,WAS,_):- !. % expects_dialect(WAS).
lps_expects_dialect(Next,Source,Was,Module):- lpstmp:module_dialect_lps(Next,Source,Was,Module,_Undo), !.
lps_expects_dialect(Next,StreamNow,Was,Module):- lpstmp:module_dialect_lps(Next,StreamBefore,Was,Module,_Undo),
   StreamNow \== StreamBefore,!,
   retract(lpstmp:module_dialect_lps(Next,StreamBefore,Was,Module,Undo)),
   asserta(lpstmp:module_dialect_lps(Next,StreamNow,Was,Module,Undo)),!.
  
:- system:module_transparent(lps:lps_expects_dialect/1).
:- system:import(lps:lps_expects_dialect/1).
lps_expects_dialect(lps,Source,Was,Module):-
   add_lps_to_module(Module),
   lps_operators(Module, Ops),
   push_operators(Module:Ops, Undo),
   %ignore(retract(lpstmp:module_dialect_lps(Dialect,Source,_,_,_))), 
   asserta(lpstmp:module_dialect_lps(lps,Source,Was,Module,Undo)),!.
  

dialect_input_stream_lps(Source):- prolog_load_context(source,Source)->true; Source = user_input.

:- system:module_transparent(lps:lps_pop_dialect/2).
:- system:import(lps:lps_pop_dialect/2).
lps_pop_dialect(Source,Module):-
    retract(lpstmp:module_dialect_lps(lps,Source,Was,Module,Undo)),!,
    %print_message(warning, format('~q', [warn_pop_lps_dialect_fallback(Source,Module->Was)])),
    lps_debug(pop_lps_dialect2(Source,Module->Was)),
    pop_operators(Undo),    
    %nop('$set_source_module'(Was)),!,
    lps_debug(state).
lps_pop_dialect(Source,Module):- 
   lps_debug(print_message(warning, format('~q', [missing_pop_lps_dialect_fallback(Source,Module)]))),
   lps_debug(state).


                 /*******************************
                 *         SYNTAX HOOKS         *
                 *******************************/

:- multifile
    prolog:alternate_syntax/4.


prolog:alternate_syntax(lps, Module,
                        lps:push_lps_operators(Module),
                        lps:pop_lps_operators(Module)).


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Note that we could generalise this to deal with all included files.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

push_lps_operators(Module) :-
    lps_operators(Module, Ops),
    push_operators(Module:Ops).

pop_lps_operators(_) :-
    pop_operators.


user:goal_expansion(In, Out) :-    
    lps_dialect_expansion(In, Out).


:- multifile(system:term_expansion/2).
:- module_transparent(system:term_expansion/2).
% :- export(system:term_expansion/2).
system:term_expansion(MIn, Out):- 
   notrace(strip_module(MIn,MM,In)),
   notrace(nonvar(In)), 
   (MIn==In->prolog_load_context(module, Module);MM=Module),
   notrace(In == end_of_file),
   prolog_load_context(dialect, lps),
   prolog_load_context(file, Source),
   prolog_load_context(module, Module),
   lps_pop_dialect(Source,Module),!,
   Out = In.