/* ** Author(s): Miguel Calejo ** Contact: info@interprolog.com, http://interprolog.com ** Copyright (C) InterProlog Consulting / Renting Point - Serviços de Informática Lda., Portugal 2016 ** Use and distribution, without any warranties, under the terms of the ** Apache 2.0 License, readable in http://www.apache.org/licenses/LICENSE-2.0.html */ /* Implement surface syntaxes, converting it to/from lps.swi internal syntax. To launch LPS with surface syntax, cd to the LPS home directory and: swipl -l utils/psyntax.P Typical use cases: - Support term_expansion/2 in SWISH, as shown in swish/term_expander.pl, which calls syntax2p/4 directly - Support golps/3 below for command line usage, which calls syntax2p_file/4 to convert file to file Two syntax conversion pairs are supported, indicated with the following constants: - lps2p: lps.swi surface to internal syntax - js2p: lps.js syntax to lps.swi internal syntax Conversion direction is determined by the instantiation of surface vs. internal term arguments below LIMITATION regarding lps.js files: they must NOT use # line comments; please use Prolog's % comments instead */ :- module(psyntax,[ lps2p_file/2, lps2p/3, syntax2p_file/4, syntax2p/4, syntax2p_literal/7, golps/2, golps/1, dumpjs/2, dumpjs/1, file_generator_name/2, may_clear_hints/0,term_colours/2,timeless_ref/1, set_top_term/1, dumploaded/2 ]). :- if(\+ current_prolog_flag(dialect, swi)). :- writeln("LPS requires SWI-Prolog"), throw(swi_prolog_required). :- endif. % DMILES Deal with Zero-Arity compounds unswi_functor(P,F,A):- \+ compound(P),!,functor(P,F,A). unswi_functor(P,F,A):- compound_name_arity(P,F,A). guarded_univ(P =.. L):- compound(P),!,compound_name_arguments(P,F,Args),L=[F|Args]. guarded_univ(P =.. L):- !, catch(P =.. L,E,(throw(error(guarded_univ(P =.. L),E)))). guarded_univ(PL):- throw(guarded_univ(PL)). :- if(current_module(swish)). % first, SWISH specific; see comments in interpreter.P :- use_module(library(pengines),[pengine_self/1]). :- use_module(library(prolog_clause)). :- use_module(library(pengines),[pengine_self/1]). % Useful for SWISH % dumploaded(ShowExternalSyntax) if == true dumps surface syntax, otherwise internal (Wei) syntax dumploaded(External,Translator) :- check_translator(Translator), % TODO: warn about generated clauses (e.g. from English) than will not appear here lps_swish_clause(H,Body,Vars), (External==true -> ( (Body==true -> InternalTerm=H ; InternalTerm=(H:-Body)), catch( syntax2p(Clause,Vars,Translator,_,InternalTerm), Ex, (print_message(error,Ex),fail)) ) ; Clause = (H:-Body)), % bindAllVars(Vars), % term_variables((H:-Body),VarValues), _Vars: [Name1=VarValue1,...] %_TermPos = term_position(Char,CharEnd,_,_,_), %print_message(error,error(syntax_error(whatever),file(File,LineNumber,_one,_Char))), pretty_write_withvars(Clause,Translator,Vars), writeln('.'), %write(' '), writeln(File), % e.g. pengine://fa945952-355c-47a3-bb48-bdf8dfdb4229/src %write(' '), writeln(TermPos/Vars), % e.g. term_position(384,446,416,420,[term_position(.... ])/[N=_1022] fail. dumploaded(_,_). % dumploaded(External) :- dumploaded(External,lps2p). lps_swish_clause(H,Body,Vars) :- interpreter:check_lps_program_swish_module, interpreter:lps_program_clause_file(H,Body,File), (atom_prefix(File,'pengine://') ; File==asserted, interpreter:program_predicate(H)), % hack to circumvent SWI/SWISH term_expansion bug ( interpreter:lps_source_position(H,_,_,Vars) -> true ; Vars=[]). :- endif. :- if( \+ current_module(swish)). % Now support for vanilla/barebones SWI Prolog: dumploaded(External,Translator) :- check_translator(Translator), % TODO: warn about generated clauses (e.g. from English) than will not appear here interpreter:lps_program_clause_file(H,Body,_File), ( interpreter:lps_source_position(H,_,_,Vars) -> true ; Vars=[]), (External -> (Body==true -> InternalTerm=H ; InternalTerm=(H:-Body)), catch( syntax2p(Clause,Vars,Translator,_,InternalTerm), Ex, (print_message(error,Ex),fail)) ; Clause = (H:-Body)), pretty_write_withvars(Clause,Translator,Vars), writeln('.'), fail. dumploaded(_,_). :- endif. % ...and finally the generic SWI support: :- use_module('../engine/db.P',[head_hint/3, '_currenty__defining'/1]). :- thread_local((timeless_ref/1, current_top_term/1)). clear_timeless_refs :- retractall(timeless_ref(_)). may_add_timeless_ref(G) :- % DMILES unswi_functor/3 Deal with Zero-Arity compounds unswi_functor(G,F,N), ( current_top_term(F/N); timeless_ref(F/N) ; assert(timeless_ref(F/N))), !. % DMILES unswi_functor/3 Deal with Zero-Arity compounds set_top_term(T) :- retractall(current_top_term(_)), (var(T)->F=var, N = -1 ; unswi_functor(T,F,N)), assert(current_top_term(F/N)). :- use_module('../engine/interpreter.P',[go/3, print_error/2, is_some_time/1, uassert/1, uretractall/1, collect_guessed_declarations/1,bindAllVars/1,intensional/1, macroaction/1,system_fluent/1,system_action/1, get_lps_program_module/1, cleanup_program/0, print_error_notices/1, date_stamp/1]). :- use_module(library(dialect/sicstus/system),[file_exists/1]). my_file_read(Stream,Term,Vars) :- read_term(Stream,Term,[variable_names(Vars)]). :- dynamic(their_lps_exactly/0). their_lps_exactly :- fail. % Surface syntax .pl :- if(\+ their_lps_exactly). % Surface syntax .pl :- use_module(library(lps_syntax)). :- else. user:'<='(A,B) :- A= is already defined as 1050, xfy, which will do given that lps.js does not support if-then-elses :- op(700,xfx,user:(<=)). user:(A<=B) :- A=Then+300, retract(expanding_in_thread(_,Then)), fail. may_clear_hints :- thread_self(T), get_time(Now), assert(expanding_in_thread(T,Now)), clear_hints. % ASSUMES that thread ids are unique!! :- dynamic expanding_in_thread/2. % thread, timestamp % hook into test suite runner: :- multifile interpreter:regenerate_file/1. % regenerate_file(F) F is an existing Wei syntax file that needs to be regenerated...if a source file for it can be found interpreter:regenerate_file(F) :- generate_file(F), !. %%% From here on, generic Prolog code %clear_head_hint(HH,Type,X) :- uretractall(head_hint(HH,Type,X)). %add_head_hint(HH,Type,X) :- uassert(head_hint(HH,Type,X)). clear_head_hint(HH,Type,X) :- retractall(head_hint(HH,Type,X)). add_head_hint(HH,Type,X) :- assert(head_hint(HH,Type,X)). closetail([]) :- !. closetail([_|L]) :- closetail(L). % comma_to_list(?NiceSyntax,+Syntaxclass,-Spec,?List). SyntaxClass and Spec as per SWI's Prolog_colour.pl comma_to_list(NS,_,_,L) :- var(NS), var(L), !, writeln('*** Bad var item'), fail. comma_to_list((One,Two),SC,delimiter-[SpecOne,SpecTwo],[One|Twol]):- Twol \== [], !, spec_for_one(One,SC,SpecOne), comma_to_list(Two,SC,SpecTwo,Twol). comma_to_list(One,SC,SpecOne,[One]) :- spec_for_one(One,SC,SpecOne). % spec_for_one(+NiceItem,+SyntaxClass,-ItemColourSpec) spec_for_one(_/_,SC,delimiter-[SC,classify]) :- !. spec_for_one(One,SC,SC) :- atom(One), !. spec_for_one(_One,SC,SC-classify). % functor_arityze(+TemplatesOrFA,-TemplatesList) replaces term functor/arities by their templates; % bidirectional (albeit losing information of course) functor_arityze([F/A|TOFAL],[G|FAL]) :- unswi_functor(G,F,A), !, functor_arityze(TOFAL,FAL). functor_arityze([T|TOFAL],[T|FAL]) :- !, functor_arityze(TOFAL,FAL). functor_arityze([],[]). :- dynamic untimed_are_relaxed/0. untimed_are_relaxed. % Bob's preference % Convert a file in LPS (new syntax) into Wei syntax and execute it golps(LPSP_file,Options,Results) :- (member(background(_),Options) -> % use unique file names to avoid clashs with other threads gensym('_f',ID), concat_atom([LPSP_file,ID, '_.P'],Pfile) ; concat_atom([LPSP_file,'_.P'],Pfile)), cleanup_program, % head_hints depend on l_events etc declarations, so we need to clear any previous program syntax2p_file(LPSP_file,Pfile,lps2p,true), go(Pfile,Options,Results). golps(LPSP_file,Options) :- golps(LPSP_file,Options,[]). golps(LPSP_file) :- golps(LPSP_file,[dc]). % Support for lps.js dumpjs(F,Options) :- (member(swish,Options) -> interpreter:go(F,[initialize_only|Options]); golps(F,[initialize_only|Options])), check_js_compliance(Notices), print_error_notices(Notices), date_stamp(D), (atomic(F)->F=FF;FF='SWISH Editor'), format("% Generated from ~w on ~w~n",[FF,D]), writeln("% Preamble for lps.js:\n is(A,A). \n%---"), % lps.js has no is/a, but does evaluate arith expressions in arguments dumploaded(true,js2p). dumpjs(F) :- dumpjs(F,[dc]). % File converters: % Fails if no source file exists % [46,108,112,115,119] .lpsw % [95,46,80] _.P % [46,108,112,115] .lps % generate_file(Filename) generate_file(F) :- (sub_atom(F,_,Nchars,0,'_.P') ; sub_atom(F,_,Nchars,0,'.lpsw')), !, sub_atom(F,0,_,Nchars,Source), (sub_atom(Source,_,_,0,'.lps'); sub_atom(Source,_,_,0,'.pl')), file_exists(Source), syntax2p_file(Source,F,lps2p,true). file_generator_name(F,FG) :- atom_codes(F,Codes), file_generator_name_(Codes,FG). file_generator_name_(Codes,FG) :- append(FGcodes,[95,46,80],Codes), !, atom_codes(FG,FGcodes). % _.P file_generator_name_(Codes,FG) :- append(FGcodes,[46,108,112,115,119],Codes), !, atom_codes(FG,FGcodes). % .lpsw % lps2p_file(?LPSfile,?LPSWfile) "new syntax", Nov-Dec 2016 lps2p_file(LPSfile,LPSWfile) :- atom(LPSfile), !, (atom(LPSWfile)->true;concat_atom([LPSfile,'_.lpsw'],LPSWfile)), syntax2p_file(LPSfile,LPSWfile,lps2p,true). lps2p_file(LPSfile,LPSWfile) :- atom(LPSWfile), (atom(LPSfile)->true;concat_atom([LPSWfile,'_.lps'],LPSfile)), syntax2p_file(LPSfile,LPSWfile,lps2p,false). check_translator(Translator) :- ( member(Translator,[/* no longer:lpsp2p,*/lps2p,js2p]) -> true ; throw('Bad syntax translator:'(Translator))). % Main file to file syntax converter % syntax2p_file(+OtherSyntaxFile,+P_Wei_file,+Translator,+ToWei) Translator is a functor for a predicate Translate(Term,Vars,NewTerm) % If ToWei==true it generates a .P (internal syntax) file from the first file, else vice-versa syntax2p_file(Lfile,Pfile,Translator,ToWei) :- check_translator(Translator), init_definition_newliner, clear_hints, clear_timeless_refs, (ToWei==true -> (file_exists(Lfile)->true;throw(non_existing_file(Lfile))), open(Lfile,read,IStr), open(Pfile,write,OStr), guarded_univ(Convert =.. [Translator,Term,Vars,NewTerm]) ; (file_exists(Pfile)->true;throw(non_existing_file(Pfile))), open(Pfile,read,IStr), open(Lfile,write,OStr), guarded_univ(Convert =.. [Translator,NewTerm,Vars,Term]) ), % IStr >= 0, OStr>=0, nonvar(IStr), nonvar(OStr), repeat, catch(my_file_read(IStr,Term_,Vars_),Ex,writeln(ex-Ex)), nonvar(Term_), term_includer(Term_,Vars_,[],Term,Vars), % inject terms from included files closetail(Vars), ( Term==end_of_file -> true ; set_top_term(Term), (Convert->true; write('*** failed '), writeln(Convert), fail), % When converting back to our syntax from Wei's, make sure T vars are not misinterpreted: % NO! Too strong % ((ToWei\==true, member(V,Vars), is_time_var(V)) -> true % ; % This combined with writeq.... can't do: bindAllVars(Vars), may_write_newline(NewTerm,OStr), pretty_write(NewTerm,Translator,OStr), writeln(OStr,'.'), fail ), !, (ToWei==true -> % may generate missing declarations collect_guessed_declarations(Facts), forall( member(Fact,Facts), (may_write_newline(Fact,OStr), pretty_write(Fact,Translator,OStr), writeln(OStr,'.')) ) ; true), close(OStr),close(IStr). % term_includer(+TermRead,+VarsRead,+FilesIncludedSoFar,-Term,-Vars) term_includer((:- include(F)), _, Included, Term,Vars) :- !, absolute_file_name(F,File), length(Included,N), (N>5 -> throw(too_many_file_inclusions(N,File)) ; true), term_in_file(File, [File|Included], Term, Vars). term_includer(T,V,_Included,T,V). % Inspired from http://www.swi-prolog.org/pldoc/man?predicate=setup_call_cleanup/3: term_in_file(File,Included,Term,Vars) :- setup_call_cleanup( open(File, read, In), term_in_stream(In, Included, Term, Vars), close(In) ). term_in_stream(In, Included, Term, Vars) :- repeat, my_file_read(In,T,Vars_), term_includer(T,Vars_,Included,Term,Vars), ( Term == end_of_file -> !, fail ; true ). % head_hint(HeadTemplate,Sort,Declared) Sort maybe l_timeless,event,fluent % a fact means that some head was read before and tagged as Sort % used only when transforming from some nicer to Wei syntax % Declared is 'true' if a declaration (not just usage) was detected head_hint(_,_):- current_prolog_flag(lps_translation_only,true),!,fail. head_hint(X,Sort) :- head_hint(X,Sort,_), !. head_hint(X,fluent) :- intensional(X). head_hint(X,event) :- macroaction(X). remember_hint(Type,H) :- nonvar(Type), nonvar(H), member(Type,[fluent,event,action,timeless]), unswi_functor(H,F,N), unswi_functor(HH,F,N), ( head_hint(HH,Type,_) -> true; add_head_hint(HH,Type,false) ). remember_timeless_hint(TL) :- remember_hint(timeless,TL). remember_event_hint(X) :- var(X), !. remember_event_hint((E from _T1 to _T2)) :- !, remember_event_hint(E). remember_event_hint((E during _Interval)) :- !, remember_event_hint(E). remember_event_hint(TL) :- remember_hint(event,TL). % Do we need events and actions?? %remember_action_hint((E during _Interval)) :- !, remember_action_hint(E). %remember_action_hint(TL) :- remember_hint(action,TL). remember_fluent_hint(X) :- var(X), !. remember_fluent_hint((F at _T)) :- !, remember_fluent_hint(F). remember_fluent_hint(TL) :- remember_hint(fluent,TL). remember_declaration(Type,H) :- nonvar(Type), nonvar(H), member(Type,[fluent,event,action,timeless]), unswi_functor(H,F,N), unswi_functor(HH,F,N), ( head_hint(HH,Type,true) -> true; clear_head_hint(HH,Type,_), add_head_hint(HH,Type,true) ). % remember_hints(Type,LiteralOrList) remember_hints(_Type,X) :- var(X), ! . %, !, write('*** Underspecified term of sort '), writeln(Type). remember_hints(_Type,[]) :- !. remember_hints(Type,[X1|Xn]) :- !, remember_hint(Type,X1), remember_hints(Type,Xn). remember_hints(Type,X) :- remember_hint(Type,X). % remember_declarations(Type,LiteralOrList) remember_declarations(Type,X) :- var(X), !, format(atom(M),"Underspecified declared term of sort ~w",[Type]), print_error(warning,M). remember_declarations(_Type,[]) :- !. remember_declarations(Type,[X1|Xn]) :- !, remember_declaration(Type,X1), remember_declarations(Type,Xn). remember_declarations(Type,X) :- remember_declaration(Type,X). clear_hints :- clear_head_hint(_,_,_). % convenience predicates for environment syntax checkers: ConversionPair(SurfaceTerm,Vars,InternalTerm) lps2p(LPSPterm,Vars,Pterm) :- syntax2p(LPSPterm,Vars,lps2p,Pterm). js2p(LPSPterm,Vars,Pterm) :- syntax2p(LPSPterm,Vars,js2p,Pterm). % Main term syntax converter syntax2p(NicerSyntaxTerm,Vars,Translator,Pterm) :- syntax2p(NicerSyntaxTerm,Vars,Translator,_NiceColouring,Pterm). % syntax2p(?NicerSyntaxTerm,+Vars,+Translator,NiceColouring,?InternalTerm) % Vars is a (closed tail) list of some_functor(Name,Variable) % Translator: lps2p (lps.swi surface syntax) or js2p (lps.js syntax) % Either NicerSyntaxTerm or InternalTerm must be bound; the other should be unbound % NiceColouring is a colouring specificatin term as per SWI's prolog_colouring.pl, for the NicerSyntaxTerm % null if undefined colouring, e.g. for timeless/Prolog literals (they'll be coloured elsewhere in SWI) % needs to be defined only for nonvar(NicerSyntaxTerm) % Probably needs to evolve to return error messages syntax2p(L,_,_TT,_,PT) :- var(L), var(PT), !, fail. % clauses and facts that are not transformed, just propagated: syntax2p(NT,_,TT,Spec,(H:-B)) :- (nonvar(NT)->ToWei=true;ToWei=false), NT = (H:-B), do_not_transform_may_hint(H,TT,ToWei,B,Spec), !. syntax2p(NT,_,TT,Spec,Fact) :- (nonvar(NT)->ToWei=true;ToWei=false), NT=Fact, Fact \= (_:-_), do_not_transform_may_hint(NT,TT,ToWei,true,Spec), !. % convenience notation for declarations: syntax2p((initially States),_Vars,lps2p, lps_delimiter - [Specs] , initial_state(StatesList)) :- !, comma_to_list(States,fluent,Specs,StatesList). syntax2p(initially(States),_Vars,js2p, null , initial_state(States)) :- !. % observe o1, o2, o3 from ... to ...: syntax2p((observe Obs),_Vars,lps2p,lps_delimiter - [Specs],observe([O1,O2|On],T2)) :- (nonvar(Obs)-> unswi_functor(Obs,',',2) ; true), !, ((syntax2p_observations(Obs,CT2,[O1,O2|On],T2,Specs), T2=CT2, nonvar(T2)) -> true % cannot use comma_to_list, which assumes DECLARATIONS, e.g. NOT usage with time variables and their auxiliary functors ; format(atom(M),"Bad observations: ~w",[(observe Obs)/observe([O1,O2|On],T2)]), print_error(error,M), fail). % single observations, declared as fact declarations; observations list case handled further below syntax2p((observe E from T1 to T2),_Vars,lps2p, lps_delimiter - [SpecHead], observe([E],T2)) :- !, syntax2p_literal((E from T1 to T2),[],lps2p,_,_,SpecHead,_). syntax2p((observe E to T2),_Vars,lps2p, lps_delimiter - [SpecHead],observe([E],T2)) :- !, syntax2p_literal((E to T2),[],lps2p,_,_,SpecHead,_). syntax2p((observe E at T2),_Vars,lps2p, lps_delimiter - [SpecHead],observe([E],T2)) :- is_some_time(T2), !, syntax2p_literal((E to T2),[],lps2p,_,_,SpecHead,_). syntax2p((observe E from T1),_Vars,lps2p, lps_delimiter - [SpecHead],observe([E],T2)) :- number(T1), !, T2 is T1+1, syntax2p_literal((E to T2),[],lps2p,_,_,SpecHead,_). % observe (Ev,Time) and observe(Ev,Time1,Time2) syntax2p(observe(E,T2),_Vars,js2p, null, observe([E],T2)) :- !. syntax2p(observe(E,_T1,T2),_Vars,js2p, null, observe([E],T2)) :- !. syntax2p((unserializable A),Vars,lps2p,Spec,unserializable(NL)) :- !, syntax2p((actions A),Vars,lps2p,Spec,actions(NL)). syntax2p((actions A),_Vars,lps2p,lps_delimiter - [Specs],actions(NL)) :- nonvar(A), !, comma_to_list(A,action,Specs,L), functor_arityze(L,NL), remember_declarations(action,NL). syntax2p((actions A),_Vars,lps2p,lps_delimiter - [Specs],actions(L)) :- !, comma_to_list(A,action,Specs,L). syntax2p(actions(A),_Vars,js2p,null,actions(L)) :- nonvar(L), !, L=A. % other conversion direction handled by do_not_transform_may_hint(..) syntax2p((events A),_Vars,lps2p,lps_delimiter - [Specs],events(NL)) :- nonvar(A), !, comma_to_list(A,event,Specs,L), functor_arityze(L,NL), remember_declarations(event,NL). syntax2p((events A),_Vars,lps2p,lps_delimiter - [Specs],events(L)) :- !, comma_to_list(A,event,Specs,L). syntax2p(events(A),_Vars,js2p,null,events(L)) :- nonvar(L), !, L=A. % other conversion direction handled by do_not_transform_may_hint(..) syntax2p((prolog_events A),_Vars,lps2p,lps_delimiter - [Specs],prolog_events(NL)) :- nonvar(A), !, comma_to_list(A,event,Specs,L), functor_arityze(L,NL), remember_declarations(event,NL). syntax2p((prolog_events A),_Vars,lps2p,lps_delimiter - [Specs],prolog_events(L)) :- !, comma_to_list(A,event,Specs,L). syntax2p((fluents A),_Vars,lps2p,lps_delimiter - [Specs],fluents(NL)) :- nonvar(A), !, comma_to_list(A,fluent,Specs,L), functor_arityze(L,NL), remember_declarations(fluent,NL). syntax2p((fluents A),_Vars,lps2p,lps_delimiter - [Specs],fluents(L)) :- !, comma_to_list(A,fluent,Specs,L). syntax2p(fluents(A),_Vars,js2p,null,fluents(NL)) :- nonvar(A), !, % list case handled by do_not_transform_may_hint(..) comma_to_list(A,fluent,_Specs,L), functor_arityze(L,NL), remember_declarations(fluent,NL). syntax2p(fluents(A),_Vars,js2p,null,fluents(L)) :- nonvar(L), !, L=A. % other conversion direction handled by do_not_transform_may_hint(..) % reactive rules: syntax2p((if A then C), Vars,lps2p, lps_delimiter-[lps_delimiter-SpecA,SpecC],reactive_rule(NA,NC)) :- !, syntax2p_sequence(A,Vars,TT,[_T1,_T2],SpecA,NA), syntax2p_sequence(C,Vars,TT,[_T3,_T4],SpecC,NC). syntax2p((A->C), Vars,js2p, null ,reactive_rule(NA,NC)) :- !, syntax2p((if A then C), Vars,lps2p, _Spec ,reactive_rule(NA,NC)). % pre-conditions: syntax2p((false B),Vars,lps2p,lps_delimiter-[SpecB],d_pre(IC)) :- !, syntax2p_sequence(B,Vars,lps2p,[_T1,_T2],single,_ET,SpecB,IC). syntax2p(( <- B),Vars,js2p,null,d_pre(IC)) :- !, syntax2p((false B),Vars,lps2p,_Spec,d_pre(IC)) . % now post-conditions: syntax2p(Surface,Vars,Tran,Spec,PT) :- % var(PT), (Tran=lps2p,Surface=(H if B);Tran=js2p,Surface=(H <- B)), ( H= (Event initiates Fluent), PT=initiated(NB1,Fluent,NBn), Spec=lps_delimiter-[lps_delimiter-[EC,FC],SpecB] ; H= (Event terminates Fluent), PT=terminated(NB1,Fluent,NBn), Spec=lps_delimiter-[lps_delimiter-[EC,FC],SpecB] ; ( Tran=lps2p, H = (Event updates Old to New in Fluent), Spec=lps_delimiter-[lps_delimiter-[EC,lps_delimiter-[lps_delimiter-[classify,classify],FC]],SpecB] ; Tran=js2p, H=updates(Event,Old,New), Fluent=Old, Spec=null ) , PT = updated(NB1,Fluent,Old-New,NBn) ), !, (var(Event)->Event=happens(_,_,_);true), remember_fluent_hint(Fluent), remember_event_hint(Event), % simple_event_colour(Event,EC), simple_fluent_colour(Fluent,FC), syntax2p_literal(Event,Vars,Tran,[T1,T2], _ETL, EC, NB1), syntax2p_sequence(B,Vars,Tran,[T1,T3],single,_ET,SpecB,NBn), (T3\==T1 -> T2=T3;true). % beware of collapsing the event time interval... syntax2p(H,Vars,Tran,Spec,PT) :- % var(PT), ( H= (Event initiates Fluent), PT=initiated(NB1,Fluent,NBn), Spec=lps_delimiter-[SpecE,FC] ; H= (Event terminates Fluent), PT=terminated(NB1,Fluent,NBn), Spec=lps_delimiter-[SpecE,FC] ; (Tran=lps2p, H = (Event updates Old to New in Fluent), Spec = lps_delimiter-[SpecE,lps_delimiter-[lps_delimiter-[classify,classify],FC]] ; Tran=js2p, H=updates(Event,Old,New), Fluent=Old, Spec=null), PT = updated(NB1,Fluent,Old-New,NBn) ), !, (var(Event)->Event=happens(_,_,_);true), remember_fluent_hint(Fluent), remember_event_hint(Event), simple_fluent_colour(Fluent,FC), syntax2p_sequence(Event,Vars,Tran,[_T1,_T2],single,_ET,SpecE,[NB1|NBn]). syntax2p(L,Vars,Tran,null,PT) :- var(L), guarded_univ(PT=..[F,NB1,Fluent,NBn]), ((F==terminated), L_ = (Event_ terminates Fluent) ; (F==initiated), L_ = (Event_ initiates Fluent)), !, syntax2p_sequence(Conditions,Vars,Tran,[_T1,_T2],single,_ET,_,[NB1|NBn]), (Conditions = (Event,Body) -> (Tran=lps2p->L = (L_ if Body);Tran=js2p, L = (L_ <- Body)) ; L = L_, Conditions=Event ), may_remove_lps_time(Event,Tran,Event_). syntax2p(L,Vars,Tran,null,updated(NB1,Fluent,Old-New,NBn)) :- var(L), !, syntax2p_sequence(Conditions,Vars,Tran,[_T1,_T2],single,_ET,_,[NB1|NBn]), (Tran=lps2p -> L_ = (Event_ updates Old to New in Fluent) ; Tran=js2p, L_ = updates(Event_,Fluent,New), (Old==Fluent -> true ; throw(over_detailed(updated(NB1,Fluent,Old-New,NBn))))), % lps.swi syntax is more general (Conditions = (Event,Body) -> (Tran=lps2p -> L = (L_ if Body) ; Tran=js2p, L = (L_ <- Body)) ; L = L_, Conditions=Event), may_remove_lps_time(Event,Tran,Event_). % intentional fluents and composite events, and more syntax2p(Surface,Vars,Tran,lps_delimiter-[SpecHead,SpecBody],PT) :- (Tran=lps2p->Surface=(Head if Body); Tran=js2p, Surface=(Head<-Body)), (var(PT) -> ToWei=true; ToWei=false), (ToWei==true -> syntax2p_literal(Head,Vars,Tran,[T1,T2],ETH,SpecHead,NH); true), ( PT = l_events(NH,NB), NH=happens(_,_,_); PT = l_int(NH,NB), NH = holds(_,_), remember_fluent_hint(Head) %TODO: make the processor look ahead at the rule body and decide correctly when the head has no explicit time, but events or fluents are in the body; ), !, (PT=l_int(_,_) -> IntervalType=single ; IntervalType = _), ((ToWei==false) -> syntax2p_literal(Head,Vars,Tran,[T1,T2],_,_,NH) ; true), syntax2p_sequence(Body,Vars,Tran,[T1body,T2body],IntervalType,_ETbody,SpecBody,NB), % we only bind head and body intervals fully if no explicit time is mentioned in head % First the case for fluents, which must bind: (NH = holds(_,_) -> T2body=T2, T1body=T1 ; true), ((ETH== (false) ) -> T2body=T2, T1body=T1 ; true). syntax2p((H:-B),_,_TT,null,PT) :- var(PT), (var(H);var(B)), !, fail. % time-dependent facts: syntax2p(Head,Vars,lps2p,Spec,l_int(WHead,[])) :- syntax2p_literal(Head,Vars,lps2p,[_T1,_T2],_,Spec,WHead), WHead = holds(_,_), !. syntax2p(Head,Vars,lps2p,Spec,l_events(WHead,[])) :- syntax2p_literal(Head,Vars,lps2p,[_T1,_T2],_,Spec,WHead), WHead = happens(_,_,_), !. syntax2p(Term, _, _Translator, classify,Term). % pass through for Wei terms or other Prolog facts % syntax2p_observations(ObsCommaList,CommaT2,ObsList,ListT2,-ColourSpec) CommaT2 must be unique syntax2p_observations(CL,CommaT2,[E],CommonT2,Spec) :- (nonvar(CL)-> \+ unswi_functor(CL,',',2) ; true), !, syntax2p_one_obsservation(CL,CommaT2,E,CommonT2,Spec). syntax2p_observations((Ob,CL),CommaT2,[E|L],CommonT2,delimiter-[Spec1,Specs]) :- syntax2p_one_obsservation(Ob,CommaT2,E,CommonT2,Spec1), syntax2p_observations(CL,CommaT2,L,CommonT2,Specs). syntax2p_one_obsservation((E from _ to CT2),T2,E,LT2,delimiter-[EC,classify]) :- !, CT2=T2,CT2=LT2, simple_event_colour(E,EC). syntax2p_one_obsservation((E to CT2),T2,E,LT2,delimiter-[EC,classify]) :- !, T2=CT2,CT2=LT2, simple_event_colour(E,EC). syntax2p_one_obsservation((E at CT2),T2,E,LT2,delimiter-[EC,classify]) :- atom(CT2), !, T2=CT2,CT2=LT2, simple_event_colour(E,EC). % for real times/dates syntax2p_one_obsservation(E,T2,E,T2,EC) :- simple_event_colour(E,EC). % assume T2 defined by another observation % Useful for js2p may_remove_lps_time((E from _ to _),js2p, E) :- !. may_remove_lps_time((E from _), js2p, E) :- !. may_remove_lps_time((E to _), js2p, E) :- !. may_remove_lps_time(E,_Tran,E). simple_event_colour(E,EC) :- atom(E) -> EC = event ; EC = event-classify. simple_fluent_colour(E,EC) :- atom(E) -> EC = fluent ; EC = fluent-classify. % syntax2p_sequence(NicerSequence,Vars,Translator,[Start,End],NiceColouring,WeiPsequence) [Start,End] may constrain time arguments syntax2p_sequence(NS,Vars,Translator,Interval,NC,W) :- syntax2p_sequence(NS,Vars,Translator,Interval,_IT,_ET,NC,W). % syntax2p_sequence(NS,Vars,Translator,[T1,T6],+IntervalType,ExplicitTime,NiceColouring,W) if IntervalType==single, T6 must be T1+1 syntax2p_sequence(NS,_,_,_,_,_,_,W) :- var(NS), var(W), !, fail. syntax2p_sequence((L1,L2),Vars,Translator,[T1,T6],IT, ET, delimiter-[Spec1,Spec2],[PT1|PT2]) :- PT2 \== [], !, syntax2p_literal(L1,Vars,Translator,[T2,T3], ETL, Spec1, PT1), syntax2p_sequence(L2,Vars,Translator,[T4,T5],IT,ETS,Spec2, PT2), % 'single' too strict, should probably reflect into a tc(...) ??? ( (ETL == (false), ETS == (false)) -> ET= (false) ; ET = true), (IT==single -> % this sequence must span over a single transition, two consecutive cycles (e.g post condition, precondition) ( % we need to be careful inadvertently binding event end times with fluents bound to a previous time ((T2==T3,ETL==false) /* L1 is a fluent without explicit time, or a timeless */ -> T1=T2 ; PT1=happens(_,_,_) -> (T1=T2,T6=T3) /* ..an event */ ; true /* ...a fluent with explicit time */), ((T4==T5,ETS==false) -> (T4=T1, (T2==T3 -> T5=T6; true)) /* L2 is a fluent without explicit time, or a timeless*/ ; memberchk(happens(_,_,_),PT2) -> (T1=T4,T6=T5) /* ..an event */ ; true /* ...a fluent with explicit time */) ) ; ( ( (ET== (false),\+ catch(untimed_are_relaxed,_,fail) ) -> T4=T3 ; % no explicit time and no single transition imposed: make the two literals adjacent in time true), T1=T2, T6=T5 ) ). syntax2p_sequence(true,_,_TT,[T,T],_,false,classify,[]) :- !. syntax2p_sequence(L,Vars,Translator,Interval,_,ET,Spec,[PT]) :- syntax2p_literal(L,Vars,Translator,Interval,ET,Spec,PT). % syntax2p_literal(NicerLiteral,+Vars,+Translator,[T1,T2],-ExplicitTime,-NiceColouring,WeiLiteral) % for events, [T1,T2] is their interval; for fluents, T1 is the time % ExplicitTime == true if the given literal has explicit time arguments, false otherwise syntax2p_literal((if Cond then Then else Else),Vars,Translator,[T1,T2],ET,lps_delimiter-[lps_delimiter-[NiceC],lps_delimiter-[NiceT,NiceE]],(CondW->ThenW;ElseW)) :- Translator = lps2p, !, syntax2p_sequence(Cond,Vars,Translator,[T1,TC],_,ETC,NiceC, CondW), syntax2p_sequence(Then,Vars,Translator,[TT,T2],_,ETT,NiceT, ThenW), syntax2p_sequence(Else,Vars,Translator,[_TE,T2],_,ETE,NiceE, ElseW), ( (ETC== (false),ETT== (false),ETE== (false)) -> ET=(false); ET=true), % force or not adjacent time intervals, depending on whether the user wrote explicit time ( (ETC== (false),ETT== (false)) -> TC=TT; true). % ( (ETC== (false),ETE== (false)) -> TC=TE; true). Can not bind this time, different branch... % alternative syntax for conditional (even though only the above will be used for translation from internal form): syntax2p_literal((Cond -> Then ; Else),Vars,Translator,Interval,ET,Spec,(CondW->ThenW;ElseW)) :- Translator = lps2p, !, syntax2p_literal((if Cond then Then else Else),Vars,Translator,Interval,ET,Spec,(CondW->ThenW;ElseW)). % if-then form, useful for "nested implications": syntax2p_literal((if Cond then Then),Vars,Translator,Interval,ET,lps_delimiter-[lps_delimiter-NiceC,NiceT],(CondW->ThenW;[true])) :- Translator = lps2p, !, syntax2p_literal((if Cond then Then else true),Vars,Translator,Interval,ET,lps_delimiter-[lps_delimiter-[NiceC],lps_delimiter-[NiceT,_NiceE]],(CondW->ThenW;[true])). % event cases first... syntax2p_literal(NT,_Vars,lps2p,[T1,T2],ET,event-NC,happens(NEA,T1,T2)) :- (nonvar(NT) -> ToInternal=true, guarded_univ(NT=..[EA,LT]) ; ToInternal=(false), guarded_univ(NEA=..[EA,NL])), (EA=initiate ; EA = terminate), % tricky handling to avoid infinite terms in the first branch: ( ToInternal, LT = (L from T1_), (var(T1_);is_some_time(T1_)), T1=T1_, ET=true, NC=[delimiter-[EF,classify]] ; ToInternal, LT = (L to T2), ET=true, NC=[delimiter-[EF,classify]] ; LT = (L from T1 to T2), ET=true, NC=[delimiter-[EF,classify]] ; % reverse translation uses this form ToInternal, LT = (L during [T1,T2]), ET=true, NC=[delimiter-[EF,classify]] ; ToInternal, LT=L, ET= (false), NC=EF ), !, NL=L, simple_fluent_colour(L,EF), remember_fluent_hint(L), (ToInternal -> guarded_univ(NEA=..[EA,NL]) ; guarded_univ(NT =..[EA,LT])). syntax2p_literal(update(in(to(Old,New),LT)),_Vars,lps2p,[T1,T2],ET,event-[delimiter-[classify,NC]],happens(update(Old-New,NL),T1,T2)) :- (nonvar(LT) -> ToInternal=true ; ToInternal=(false)), % tricky handling to avoid infinite terms in the first branch: ( ToInternal, LT = (L from T1_), (var(T1_);is_some_time(T1_)), T1=T1_, ET=true, NC=delimiter-[EF,classify] ; ToInternal, LT = (L to T2), ET=true, NC=delimiter-[EF,classify] ; LT = (L from T1 to T2), ET=true, NC=delimiter-[EF,classify] ; % reverse translation uses this form ToInternal, LT = (L during [T1,T2]), ET=true, NC=delimiter-[EF,classify] ; ToInternal, LT=L, ET= (false), NC=EF ), !, NL=L, simple_fluent_colour(L,EF), remember_fluent_hint(L). syntax2p_literal(LT,_Vars,_Tran,[T1,T2],true,delimiter-[RealEC,classify],happens(RealNL,T1,T2)) :- nonvar(LT), % tricky handling to avoid infinite terms in the first branch: ( LT = (L from T1_), (var(T1_);is_some_time(T1_)), T1=T1_; LT = (L to T2), (var(T2);is_some_time(T2)); LT = (L from T1 to T2) ; LT = (L during [T1,T2])), nonvar(L), !, (L=not(RealL) -> (RealNL=not(RealL), RealEC=lps_delimiter-[EC]) ; (L=RealL, RealNL=NL, RealEC=EC)), simple_event_colour(RealL,EC), remember_event_hint(RealL), NL=L. syntax2p_literal(LT,_Vars,lps2p,[T1,T2],false,EC,happens(NL,T1,T2)) :- % to allow "meta eventing" nonvar(LT), LT=happens(NL,T1,T2), !, simple_event_colour(LT,EC). syntax2p_literal(LT,_Vars,lps2p,[T1,T2],false,RealEC,happens(NL,T1,T2)) :- nonvar(LT), (LT=not(RealLT) -> RealEC=lps_delimiter-[EC]; (LT=RealLT,RealEC=EC)), ( head_hint(RealLT,event) ; head_hint(RealLT,action) /* too strong, due to external_predicate_for_lps/1: system_action(LT)*/ ), !, simple_event_colour(RealLT,EC), NL=LT. syntax2p_literal(LT_,_Vars,js2p,[T1,T2],true,null,happens(NL,T1,T2)) :- nonvar(LT_), guarded_univ(LT_=..[F|Args_]), append(Args,[T1,T2],Args_), guarded_univ(LT=..[F|Args]), ( head_hint(LT,event) ; head_hint(LT,action) ), !, NL=LT. syntax2p_literal(L,_Vars,_Tran,[T1,T2],true,null,happens(NL,T1,T2)) :- var(L), !, L = (NL from T1 to T2). % ...thus ommitting "..during..." in events is not fully supported when reversing the transform /* better adopt the preference of the previous clause, and let lps.js literals have explicit time; less ambiguity: syntax2p_literal(L,_Vars,js2p,[T1,T2],true,null,happens(NL,T1,T2)) :- var(L), !, NL=..[F|Args], append(Args,[T1,T2],Args_), L=..[F|Args_]. */ % ... now on to fluents... syntax2p_literal(LT,_Vars,Tran,[T1,T2],ET,Spec,holds(not(NL),T)) :- % not(fluent) at T is the preferred form, but 2 others available ( LT= (not(F) at T), (var(T);is_some_time(T)), Spec = delimiter - [delimiter-[EF],classify], ET=true ; LT= not(F at T), (var(T);is_some_time(T)), Spec = delimiter - [delimiter - [EF,classify]], ET=true ; Tran=lps2p, LT= not(F), head_hint(F,fluent), Spec = delimiter - [EF], ET=false ; Tran=js2p, LT= not(F_), nonvar(F_), guarded_univ(F_ =.. [Fun|Args_]), append(Args,[T],Args_), guarded_univ(F=..[Fun|Args]), head_hint(F,fluent), Spec = null, ET=true ), !, simple_fluent_colour(F,EF), NL=F, remember_fluent_hint(F), T1=T, T2=T. syntax2p_literal(not(FS),Vars,lps2p,[T1,T2],ET,Spec,holds(not(NL),T)) :- % lps.js admits no negated sequences syntax2p_sequence(FS,Vars,lps2p,[T1,T2],single,ET,NiceColouring,NL), member(holds(_,_),NL), !, Spec = delimiter - NiceColouring, T1=T. syntax2p_literal(LT,Vars,lps2p,[T1,T2],ET,Spec,holds(findall(X,WFS,L),T)) :- ( LT= (findall(X,FS,L) at T), Spec = lps_delimiter - [delimiter-[classify,NiceColouring,classify],classify], ET=true ; LT= findall(X,FS,L), Spec = delimiter-[classify,NiceColouring,classify], ET=false), syntax2p_sequence(FS,Vars,lps2p,[T1,T2],single,_ET,NiceColouring,WFS), member(holds(_,_),WFS), !, T1=T,T2=T. syntax2p_literal(LT,_Vars,_Tran,[T1,T2],true,delimiter-[FC,classify],holds(NL,T)) :- nonvar(LT), LT = (F at T), (var(T);is_some_time(T)), !, NL=F, T=T1,T=T2, simple_fluent_colour(F,FC), remember_fluent_hint(F). syntax2p_literal(F,_Vars,lps2p,[T1,T2],false,EF,holds(NL,T)) :- nonvar(F), ( head_hint(F,fluent) ; system_fluent(F)), !, simple_fluent_colour(F,EF), NL=F, T=T1, T=T2. syntax2p_literal(F_,_Vars,js2p,[T1,T2],false,null,holds(NL,T)) :- nonvar(F_), guarded_univ(F_=..[Fun|Args_]), append(Args,[T],Args_), guarded_univ(F=..[Fun|Args]), ( head_hint(F,fluent) ; system_fluent(F)), !, NL=F, T=T1, T=T2. syntax2p_literal(F,_Vars,lps2p,[T1,T2],false,EF,holds(NL,T)) :- % to allow meta "fluenting" nonvar(F), F=holds(NL,T), !, simple_fluent_colour(F,EF), T=T1, T=T2. syntax2p_literal(L,_Vars,_Tran,[T1,T2],true,null,holds(NL,T)) :- var(L), !, L = (NL at T), T1=T, T2=T. % ...thus ommitting "..at..." in fluents is not fully supported when reversing the transform syntax2p_literal(L,_,_Translator,[T,T],false,body(L),L) :- may_add_timeless_ref(L). % some timeless literal % Declare here predicates you wish to keep unchanged accross the transform % For some specific cases, predicate sort hints are remembered % Most bodies left var, as we may want to use Prolog there, for some kind of "meta-level" % Finally, we leave Wei syntax terms untouched when translating TO that syntax, so we can mixing them in % do_not_transform_may_hint(Head,SyntaxName,ToWei,Body,-ColourSpec) do_not_transform_may_hint(observe(Events,_),lps2p,_,_,lps_delimiter-classify) :-!, remember_hints(event,Events). do_not_transform_may_hint(fluent(F),_,_,_,lps_delimiter-[fluent-classify]) :- !, remember_declarations(fluent,F). do_not_transform_may_hint(fluents(Fls),_,true,_,lps_delimiter-[(fluents/* huh?? weird but probably irrelevant*/)-classify]) :- is_list(Fls), !, remember_declarations(fluent,Fls). do_not_transform_may_hint(event(E),_,_,_,lps_delimiter-[event-classify]) :- !, remember_declarations(event,E). do_not_transform_may_hint(events(Evs),_,true,_,lps_delimiter-[(events)-classify]) :- is_list(Evs), !, remember_declarations(event,Evs). do_not_transform_may_hint(prolog_events(Evs),_,true,_,lps_delimiter-[(events)-classify]) :- is_list(Evs), !, remember_declarations(event,Evs). do_not_transform_may_hint(action(A),_,_,_,lps_delimiter-[action-classify]) :- !, remember_declarations(action,A). do_not_transform_may_hint(actions(As),_,true,_,lps_delimiter-[(actions)-classify]) :- is_list(As), !, remember_declarations(action,As). do_not_transform_may_hint(unserializable(As),_,true,_,null) :- is_list(As), !. do_not_transform_may_hint(initial_state(S),_,true,_,lps_delimiter-[Specs]) :- !, remember_hints(fluent,S), comma_to_list(_,fluent,Specs,S). do_not_transform_may_hint(l_int(_,_),_,true,_,null). do_not_transform_may_hint(l_events(_,_),_,true,_,null). do_not_transform_may_hint(l_timeless(_,_),_,true,_,null). do_not_transform_may_hint(initiated(_,_,_),_,true,_,null). do_not_transform_may_hint(terminated(_,_,_),_,true,_,null). do_not_transform_may_hint(reactive_rule(_,_,_),_,true,_,null). do_not_transform_may_hint(reactive_rule(_,_),_,true,_,null). do_not_transform_may_hint(d_pre(_),_,true,_,null). do_not_transform_may_hint(maxTime(_),lps2p,_,_,lps_delimiter-classify). do_not_transform_may_hint(maxRealTime(_),lps2p,_,_,lps_delimiter-classify). do_not_transform_may_hint(minCycleTime(_),lps2p,_,_,lps_delimiter-classify). do_not_transform_may_hint(simulatedRealTimePerCycle(_),lps2p,_,_,lps_delimiter-classify). do_not_transform_may_hint(simulatedRealTimeBeginning(_),lps2p,_,_,lps_delimiter-classify). % pretty printing for all syntaxes % NOTE: this might be better rewritten using a separate module for the lps.js compatible printing, to ignore some lps.swi operators % pretty_write_withvars(Clause,Translator,VarsList) pretty_write_withvars(Term,Tran,Vars) :- guess_varname_list(Vars+Term,NewVs), pretty_write(Term,Tran,0,NewVs,user_output). pretty_write(Term,Translator,Stream) :- pretty_write(Term,Translator,0,[],Stream). my_write(S,T,Vars) :- guess_varname_list(Vars+S+T,NewVs), my_write(S,T,NewVs,lps2p). % my_write(Stream,Term,Vars,Translator) like writeq but printing nice variable names my_write(S,T,Vars,_) :- var(T), !, write_term(S,T,[quoted(true),variable_names(Vars)]). my_write(S,T,Vars,lps2p) :- !, write_term(S,T,[quoted(true),variable_names(Vars)]). %my_write(S,(X is E ),Vars,js2p) :- !, format(S,"is(~W,~W)",[ X,[quoted(true),variable_names(Vars)], E,[quoted(true),ignore_ops(true),variable_names(Vars)] ]). my_write(S,(X from T1 to T2),Vars,js2p) :- !, my_write_js_literal(S,X,Vars), format(S," from ~W to ~W",[ T1,[quoted(true),variable_names(Vars)], T2,[quoted(true),variable_names(Vars)] ]). my_write(S,(X from T1),Vars,js2p) :- !, my_write_js_literal(S,X,Vars), format(S," from ~W",[ T1,[quoted(true),variable_names(Vars)] ]). my_write(S,(X to T2),Vars,js2p) :- !, my_write_js_literal(S,X,Vars), format(S," from ~W",[ T2,[quoted(true),variable_names(Vars)] ]). my_write(S,(X at T),Vars,js2p) :- !, my_write_js_literal(S,X,Vars), format(S," at ~W",[ T,[quoted(true),variable_names(Vars)] ]). my_write(S,X,Vars,js2p) :- my_write_js_literal(S,X,Vars). my_write_js_literal(S,X,Vars) :- var(X), !, write_term(S,X,[variable_names(Vars)]). my_write_js_literal(S,X,_Vars) :- atomic(X), !, write_term(S,X,[]). my_write_js_literal(S,X,Vars) :- is_list(X), !, write_term(S,X,[quoted(true),variable_names(Vars)]). % can only happen in direction lps -> .P my_write_js_literal(S,X,Vars) :- guarded_univ(X=..[F|Args]), atom_codes(F,[C1|_]), (between(97,122,C1) -> % lower case start my_write_js_literal_args(Args,Vars,Args_), atomics_to_string(Args_,",",ArgsString), format(S,"~w(~w)",[F,ArgsString]) ; write_term(S,X,[quoted(true),variable_names(Vars)]) % just print normally with operators; e.g. X \== Y etc ). % my_write_js_literal_args(Args,VarNames,ArgsAsStrings) % necessary to use operators only inside literal arguments, e.g. my_write(...,X is 2+2,...) will print "is(X,2+2)" my_write_js_literal_args([A1|An],Vars,[S1|Sn]) :- !, format(string(S1),"~W",[A1,[quoted(true),variable_names(Vars)]]), my_write_js_literal_args(An,Vars,Sn). my_write_js_literal_args([],_,[]). % pretty_write(Term,Indent,Vars,Stream) pretty_write((if A then C),Translator,I,Vars,S) :- !, my_tab(S,I), write(S,'if '), my_write(S,A,Vars), nl(S), my_tab(S,I), write(S,'then '), writeln(S,''), NI is I+4, pretty_write(C,Translator,NI,Vars,S). pretty_write(( A->C),js2p,I,Vars,S) :- !, my_tab(S,I), pretty_write(A,js2p,I,Vars,S), write(S,' ->'), nl(S), my_tab(S,I), writeln(S,''), NI is I+4, pretty_write(C,js2p,NI,Vars,S). pretty_write((H if B),Translator,I,Vars,S) :- !, my_tab(S,I), my_write(S,H,Vars), writeln(S,' if'), my_tab(S,I), NI is I+4, pretty_write(B,Translator,NI,Vars,S). pretty_write((H <- B),Translator,I,Vars,S) :- !, my_tab(S,I), my_write(S,H,Vars,Translator), writeln(S,' <-'), my_tab(S,I), NI is I+4, pretty_write(B,Translator,NI,Vars,S). pretty_write((<- B),Translator,I,Vars,S) :- !, my_tab(S,I), writeln(S,'<- '), my_tab(S,I), NI is I+4, pretty_write(B,Translator,NI,Vars,S). pretty_write(Declaration,Translator,I,Vars,S) :- guarded_univ(Declaration=..[Op,C]), member(Op,[false,initially,fluents,events,prolog_events,actions]), !, my_tab(S,I), write(S,Op), (Translator\==js2p -> writeln(S,''), NI is I+4 ; NI=I), (Translator==js2p -> write(S,'(' ); true), pretty_write(C,Translator,NI,Vars,S), (Translator==js2p -> write(S,')' ); true). pretty_write(PostCondition,Translator,I,Vars,S) :- ( PostCondition = (E terminates F :- C), Op=(terminates) ; PostCondition = (E initiates F :- C), Op=(initiates) ; PostCondition = (E terminates F), C=true, Op=(terminates) ; PostCondition = (E initiates F), C=true, Op=(initiates) ), !, (Translator==lps2p -> my_tab(S,I), my_write(S,E,Vars,Translator), write(S,' '), write(S,Op), write(S,' '), pretty_write((F:-C),Translator,I,Vars,S) ; Translator==js2p -> my_tab(S,I), format(S,"~w(",Op), my_write(S,E,Vars,Translator), write(S,","), my_write(S,F,Vars,Translator), (C\==true -> write(S,","), my_write(S,C,Vars,Translator); true), write(S,")") ; throw(unknown_syntax(Translator)) ). pretty_write((H:-true),Translator,I,Vars,S) :- !, pretty_write(H,Translator,I,Vars,S). pretty_write((H:-B),lps2p,I,Vars,S) :- !, my_tab(S,I), my_write(S,H,Vars), writeln(S,' :-'), NI is I+4, pretty_write(B,lps2p,NI,Vars,S). pretty_write((H:-B),js2p,I,Vars,S) :- !, my_tab(S,I), my_write(S,H,Vars), writeln(S,' <-'), NI is I+4, pretty_write(B,js2p,NI,Vars,S). pretty_write((G1,G2),Translator,I,Vars,S) :- !, my_tab(S,I), my_write(S,G1,Vars,Translator), writeln(S,','), pretty_write(G2,Translator,I,Vars,S). pretty_write(not(G),Translator,I,Vars,S) :- !, my_tab(S,I), write(S,'not('), pretty_write(G,Translator,I,Vars,S), write(S,')'). pretty_write(G,Translator,I,Vars,S) :- my_tab(S,I), my_write(S,G,Vars,Translator). my_tab(_S,0) :- !. my_tab(S,I) :- I>0, write(S,' '), NI is I-1, my_tab(S,NI). % predicate_for(Term,Spec) predicate_for(V,none) :- var(V), !. predicate_for((H:-_),F/A) :- !, unswi_functor(H,F,A). predicate_for(H,F/A) :- unswi_functor(H,F,A). init_definition_newliner :- set_currently_defining(none). set_currently_defining(P) :- retractall('_currenty__defining'(_)), assert('_currenty__defining'(P)). may_write_newline(Term,S) :- predicate_for(Term,P), ( '_currenty__defining'(P) -> true ; set_currently_defining(P), writeln(S,'')).