1:- module(rsasak_pddl_parser,[parseProblem/3,parseDomain/3]).    2
    3:- use_module(library(logicmoo_planner)).    4
    5:- style_check(-singleton).    6
    7:- meta_predicate emptyOr(//,?,?).    8old_rsasak:- fail.
    9
   10
   11:- expects_dialect(sicstus).   12:-use_module(library(timeout)).   13:-use_module(library(lists)).   14
   15:- ensure_loaded(library(logicmoo/util_structs)).   16% :- ensure_loaded(library(sexpr_reader)).
   17%:- ensure_loaded(library(se)).
   18
   19:- decl_struct(domain(domain_name, requires, types, constants, predicates, functions, constraints, actions, dict(extraprops))).   20:- decl_struct(problem(problem_name, domain_name, requires, objects, init, goal, constraints, metric, length, dict(extraprops))).   21
   22:- decl_struct(action5(parameters=unk,sorted(preconditions),sorted(positiv_effect),sorted(negativ_effect),dict(extraprops))).   23
   24:- decl_argtypes(action(parameters=unk,sorted(preconditions),sorted(positiv_effect),sorted(negativ_effect),
   25     assign_effect,list(parameter_types),string(domain_name),list(varnames),
   26     dict(extraprops))).   27:- decl_struct(action(string(action_name),list(parameter_types),sorted(preconditions),sorted(positiv_effect),
   28        sorted(negativ_effect),sorted(assign_effect),
   29        callable(parameters),callable(constraints),dict(extraprops))).

 get_param_types0(+Df, +ListOfParams, -NameOrVarList, -TypeList)

   37get_param_types(Df,H,P,K):-must((get_param_types0(Df,H,P,K),length(P,L),length(K,L))).
   38
   39
   40use_default(s(var),'?'(H),H).
   41use_default(s(var),(H),H).
   42use_default(s(val),'?'(H),'?'(H)).
   43use_default(s(val),H,H).
   44use_default(Df,_,Df).
   45
   46adjust_types(T,GsNs,Ps):- must((get_param_types0(T, GsNs,Ps, _))).
   47adjust_types(T,GsNs,L):- must((get_param_types0(T, GsNs,Ps, Ks),pairs_keys_values(L,Ps, Ks))).
   48
   49get_param_types0(_,[], [] ,[]).
   50
   51get_param_types0(Df,[H|T],[P1|Ps],[K|Ks]):- 
   52    svar_fixvarname(H,Name),!,
   53    P1 = '?'(Name),
   54    use_default(Df,P1,K),
   55    get_param_types0(Df,T, Ps, Ks).
   56get_param_types0(Df,[H|T],[P1|Ps],[K|Ks]):-
   57    compound(H), H =.. [K, P1],not(is_list(P1)),!,
   58    get_param_types0(Df,T, Ps, Ks).
   59get_param_types0(Df,[H|T],[P1|Ps],[K|Ks]):-
   60    compound(H), H =.. [K, [P1]],!,    
   61    get_param_types0(Df,T, Ps, Ks).
   62get_param_types0(Df,[H|T],[P1,P2|Ps],[K,K|Ks]):-
   63    compound(H), H =.. [K, [P1,P2]],!,
   64    get_param_types0(Df,T, Ps, Ks).
   65
   66get_param_types0(Df,[H|T],[P1,P2,P3|Ps],[K,K,K|Ks]):-
   67    compound(H), H =.. [K, [P1,P2,P3]],!,
   68    get_param_types0(Df,T, Ps, Ks).
   69
   70
   71get_param_types0(Df,[H|T],[H|Ps],[K|Ks]):-  must(atom(H)),use_default(Df,H,K),
   72    get_param_types0(Df,T, Ps, Ks).
   73
   74
   75% FILENAME:  readFile.pl 
   76%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   77%%%  read_file
   78%%%  This is a modified version for parsing pddl files.
   79%%%  Read the input file character by character and parse it
   80%%%  into a list. Brackets, comma, period and question marks
   81%%%  are treated as separate words. White spaces separed 
   82%%%  words. 
   83%%%
   84%%%  Similar to read_sent in Pereira and Shieber, Prolog and
   85%%%        Natural Language Analysis, CSLI, 1987.
   86%%%
   87%%%  Examples:
   88%%%           :- read_file('input.txt', L).
   89%%%           input.txt> The sky was blue, after the rain.
   90%%%           L = [the, sky, was, blue, (','), after, the, rain, '.']
   91%%%
   92%%%           :- read_file('domain.pddl', L).
   93%%%           domain.pddl>
   94%%%           (define (domain BLOCKS)
   95%%%             (:requirements :strips :typing :action-costs)
   96%%%             (:types block)
   97%%%             (:predicates (on ?x - block ?y - block)
   98%%%           ...))
   99%%%           L = ['(', define, '(', domain, blocks, ')', '(', :, requirements|...].
  100
  101% :- expects_dialect(sicstus).
  102
  103fix_wordcase(Word,WordC):-upcase_atom(Word,UC),UC=Word,!,downcase_atom(Word,WordC).
  104fix_wordcase(Word,Word).
  105
  106:- use_module(library(wam_cl/sreader)).  107%
  108%read_file(+File, -List).
  109%
  110read_file(File, Words):- read_file(File, Words, _),!.
  111read_file(string(String), Words, textDoc) :- must(open_string(String,In)),!, current_input(Old),call_cleanup(( set_input(In), get_code(C), (read_rest(C, Words))),( set_input(Old))),!.
  112read_file( File, Words, File) :-  atom(File), exists_file(File), !, must(seeing(Old)),
  113  setup_call_cleanup( see(File), (get_code(C), read_rest(C, Words)),( seen, see(Old))),!.
  114read_file(File0, Words, File) :-  must((must_filematch(File0,File),exists_file(File),read_file( File, Words))),!.
  115
  116
  117/* Ends the input. */
  118read_rest(-1,[]) :- !.
  119
  120/* Spaces, tabs and newlines between words are ignored. */
  121read_rest(C,Words) :- ( C=32 ; C=10 ; C=9 ; C=13 ; C=92 ) , !,
  122                     get_code(C1),
  123                     read_rest(C1,Words).
  124
  125/* Brackets, comma, period or question marks are treated as separed words */
  126read_rest(C, [Char|Words]) :- ( C=40 ; C=41 ; C=44 ; C=45 ; C=46 ; C=63 ; C=58 ) , name(Char, [C]), !,
  127			get_code(C1),
  128			read_rest(C1, Words).
  129
  130/* Read comments to the end of line */
  131read_rest(59, Words) :- get_code(Next), !, 
  132			      read_comment(Next, Last),
  133			      read_rest(Last, Words).
  134
  135/* Otherwise get all of the next word. */
  136read_rest(C,[WordC|Words]) :- read_word(C,Chars,Next),
  137                             name(Word,Chars),fix_wordcase(Word,WordC),
  138                             read_rest(Next,Words).
  139
  140/* Space, comma, newline, backspace, carriage-return, 46 , 63,  ( ) period, end-of-file or question mark separate words. */
  141read_word(C,[],C) :- ( C=32 ; C=44 ; C=10 ; C=9 ; C=13 ;
  142                         C=46 ; C=63 ; C=40 ; C=41 ; C=58 ; C= -1 ) , !.
  143
  144/* Otherwise, get characters and convert to lower case. */
  145read_word(C,[LC|Chars],Last) :- C=LC, % lower_case(C, LC),
  146				get_code(Next),
  147                                read_word(Next,Chars,Last).
  148
  149/* Convert to lower case if necessary. */
  150lower_case(C,C) :- ( C <  65 ; C > 90 ) , !.
  151lower_case(C,LC) :- LC is C + 32.
  152
  153
  154/* Keep reading as long you dont find end-of-line or end-of-file */
  155read_comment(10, 10) :- !.
  156read_comment(-1, -1) :- !.
  157read_comment(_, Last) :- get_code(Next),
  158			 read_comment(Next, Last).
  159
  160%get0(C):-get_code(C), !.
  161
  162/* for reference ... 
  163newline(10).
  164comma(44).
  165space(32).
  166period(46).
  167question_mark(63).
  168*/
  169
  170
  171% FILENAME:  parseDomain.pl 
  172%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  173%% parseDomain.pl
  174%%   Simple parser of PDDL domain file into prolog syntax.
  175%% Author: Robert Sasak, Charles University in Prague
  176%%
  177%% Example: 
  178%% ?-parseDomain('blocks_world.pddl', O).
  179%%   O = domain(blocks,
  180%%        [strips, typing, 'action-costs'],
  181%%        [block],
  182%%        _G4108,
  183%%        [ on(block(?x), block(?y)),
  184%%	         ontable(block(?x)),
  185%%	         clear(block(?x)),
  186%%	         handempty,
  187%%	         holding(block(?x)) ],
  188%%        [number(f('total-cost', []))],
  189%%        _G4108,
  190%%        [ action('pick-up', [block(?x)],       %parameters
  191%%		      [clear(?x), ontable(?x), handempty], %preconditions
  192%%		      [holding(?x)],                       %positiv effects
  193%%          [ontable(?x), clear(?x), handempty], %negativ effects
  194%%          [increase('total-cost', 2)]),        %numeric effects
  195%%         ...],
  196%%       ...)
  197%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  198
  199
  200% parseDomain(+File, -Output).
  201%
  202% Parse PDDL domain File and return it rewritten prolog syntax.   
  203%
  204parseDomain(F, O):- parseDomain(F, O1, R), load_file_rest(F,O2,R),!,append_struct_list(O1,O2,O).
  205
  206
  207:-export(z2p/2).  208z2p(A,A).
  209:- dynamic(is_saved_type/3).  210save_type_named(Type,Named,O):- doall(retract((is_saved_type(Type,Named,_):-_))),nop(ain((is_saved_type(Type,Named,A):-z2p(O,A)))).
  211save_sterm(O):-nop((gensym(sterm,Named),save_type_named(sterm,Named,O))).
  212
  213append_struct_list(O1,O2,O):- listify(O1,L1),listify(O2,L2),append(L1,L2,O).
  214
  215first_n_elements(ListR,Num,List):-length(ListR,PosNum),min_sas(PosNum,Num,MinNum),length(List,MinNum),append(List,_,ListR),!.
  216
  217load_file(F):- must(read_file(F, L, Filename)),load_file_rest(Filename,O,L).
  218
  219load_file_rest(_,[],[]):-!.
  220load_file_rest(F,O,L):- first_n_elements(L,10,ES),load_file_rest_es10(F,O,L,ES).
  221load_file_rest(F,O,L):- throw(load_file_rest(F,O,L)).
  222
  223load_file_rest_es10(F,O,L,ES):-  append(_,['define','(','domain',Named|_],ES),!,
  224   domainBNF(O1, L, R1),prop_set(filename,O,F),
  225   save_type_named(domain,Named,O),
  226   load_file_rest(F,O2,R1),
  227   append_struct_list(O1,O2,O).
  228load_file_rest_es10(F,O,L,ES):- append(_,['(','problem',Named|_],ES),!,
  229   problem(O1, L, R1), prop_set(filename,O,F),
  230   save_type_named(domain,Named,O),
  231   load_file_rest(F,O2,R1),
  232   append_struct_list(O1,O2,O).
  233load_file_rest_es10(F,O,L,_ES):- 
  234   ensure_struct(sexpr_file,O1),prop_set(filename,O,F),
  235   sterm(SO, L, R1),prop_set(sterm_value,O1,SO),
  236   load_file_rest(F,O2,R1),
  237   append_struct_list(O1,O2,O).
  238
  239
  240load_domain(string(DP)):-!,load_file(string(DP)).
  241
  242
  243% parseDomain(+File, -Output, -RestOfFile)
  244%
  245% The same as above and also return rest of file. Can be useful when domain and problem are in one file.
  246%
  247parseDomain(File, Output, R) :- old_rsasak,!,
  248    read_file(File, List),
  249    domainBNF(Output, List, R).
  250parseDomain(File, Output, R) :-
  251    read_file(File, List, Filename),
  252    ensure_struct(domain,Output),    
  253    % trace,
  254    must_or_rtrace(prop_set(filename,Output,Filename)),
  255    % rtrace(bb_put(filename,Filename)),
  256    domainBNF(Output, List, R),!.
  257
  258
  259
  260
  261
  262:-thread_local(t_l:allow_sterm/0).  263
  264sterm2pterm(VAR,VAR):-var(VAR),!.
  265sterm2pterm(In,Out):-nonvar(Out),!,sterm2pterm(In,OutM),must(Out=OutM).
  266sterm2pterm('?'(Down),'?'(UP)):- svar_fixvarname(Down,UP),!.
  267sterm2pterm(KVList,T):- append(_,[_Item,'-',_Type],KVList),sterm2pterm_list(KVList,T).
  268%sterm2pterm(QDown,'?'(UP)):- \+ is_list(QDown),svar_fixvarname(QDown,UP),!.
  269sterm2pterm([S],S):-atom(S),!. % ,atom_concat(':',_,S),!.
  270sterm2pterm([Item,'-',Type],Item1):- atom(Type),Item1=..[Type,Item].
  271sterm2pterm([S|SLIST],PTERM):-atom(S),atom_concat(':',_,S),
  272            sterm2pterm_list(SLIST,PLIST),           
  273            PTERM=..[S,PLIST].
  274sterm2pterm([S|SLIST],PTERM):-atom(S),\+ svar(S,_),!,
  275            sterm2pterm_list(SLIST,PLIST),           
  276            PTERM=..[S|PLIST].
  277sterm2pterm(SLIST,PLIST):- is_list(SLIST),!,sterm2pterm_list(SLIST,PLIST).
  278sterm2pterm(VAR,VAR):-!.
  279
  280sterm2pterm_list([],[]).
  281sterm2pterm_list([Item,'-',Type|List],[H|T]):- atom(Type),H=..[Type,Item],sterm2pterm_list(List,T).
  282sterm2pterm_list([Item|List],[H|T]):- sterm2pterm(Item,H),sterm2pterm_list(List,T).
  283
  284sterm(_) --> [')'],{!,fail}.
  285sterm([]) --> ['(',')'],!.
  286sterm(A) --> action_def(A),!.
  287sterm(require_def(R)) --> require_def(R),!.
  288sterm(types(L))                    --> ['(',':',types],      typed_list_keys(type, L), [')'].
  289sterm(constants(L))                --> ['(',':',constants],  typed_list_keys(constant, L), [')'].
  290sterm(preds(P)) --> predicates_def(P).
  291%sterm([H,T]) --> skey(H),['('],!,zeroOrMore(sterm, T), [')'],!.
  292%sterm([H,T]) --> ['('],skey(H),!,oneOrMore(sterm, T), [')'],!.
  293sterm([H|T]) --> ['('],satom(H),!, zeroOrMore(sterm, T), [')'],!.
  294sterm([H|T]) --> ['('],sterm(H),!, zeroOrMore(sterm, T), [')'],!.
  295
  296
  297sterm(N)-->satom(N).
  298
  299satom(_) --> [')'],{!,fail}.
  300satom(V)                    --> skey(V),!.
  301satom('?'(V))                    --> ['?'],!,name(V).
  302satom(V)                         --> [V],!.
  303
  304skey(_) --> [')'],{!,fail}.
  305skey(N)                         --> [':'],!,name(S),{atom_concat(':',S,N)},!.
  306
  307
  308can_pddl_30.
  309
  310pddl_3_0 --> {can_pddl_30}, [],!.
  311pddl_3_0(_Feature) --> {fail, can_pddl_30}, [],!.
  312pddl_3_0_e(_Feature) --> {fail, can_pddl_30}, [],!.
  313
  314% Support for reading file as a list.
  315% :-[readFile].
  316
  317
  318% Defining operator ?. It is a syntax sugar for marking variables: ?x
  319:-op(300, fy, ?).  320
  321
  322dcgStructSetOpt(Struct,Name,DCG,H,T) :- call(DCG,Value,H,T)-> prop_set(Name,Struct,Value); H=T.
  323
  324dcgStructSetOptTraced(Struct,Name,DCG,H,T) :-(( call(DCG,Value,H,T)-> prop_set(Name,Struct,Value); H=T)).
  325
  326% domainBNF_dcg(domain(N, R, T, C, P, F, C, S))
  327%
  328% List of DCG rules describing structure of domain file in language PDDL.
  329% BNF description was obtain from http://www.cs.yale.edu/homes/dvm/papers/pddl-bnf.pdf
  330% This parser do not fully NOT support PDDL 3.0
  331% However you will find comment out lines ready for futher development.
  332%
  333domainBNF(domain(N, R, T, C, P, F, C, S))
  334			--> {old_rsasak},!, ['(','define', '(','domain'], name(N), [')'],
  335                             (require_def(R)	; []),
  336                             (types_def(T)    	; []), %:typing
  337                             (constants_def(C) 	; []),
  338                             (predicates_def(P)	; []),
  339                             (functions_def(F)	; []), %:fluents
  340%                             (constraints(C)	; []),    %:constraints
  341                             zeroOrMore(structure_def, S),
  342			     [')'].
  343
  344domainBNF(Output, List, R):- locally(tlbugger:skipMust, on_x_debug(domainBNF_dcg(Output, List, R))),!.
  345domainBNF(Output, List, R):- locally(t_l:allow_sterm,locally(tlbugger:skipMust, on_x_debug(domainBNF_dcg(Output, List, R)))),!,
  346   portray_clause((domainBNF:-t_l:allow_sterm,Output)).
  347domainBNF(Output, List, R):-  sterm(O, List, R), must_det_l((sterm2pterm(O,P),prop_put_extra_extra(Output,P),portray_clause((ed(Output):-P)))).
  348domainBNF(Output, List, R):- % trace,
  349             locally(-tlbugger:skipMust, on_x_debug(domainBNF_dcg(Output, List, R))),!.
  350
  351:-export(domainBNF_dcg//1).  352domainBNF_dcg(Struct)
  353                        --> ['(','define'],([':'];[]),['(','domain'], name(N), [')'],                   
  354                          {ensure_struct(domain,Struct) ,prop_set(domain_name, Struct,N),!},
  355                            dcgStructSetOpt(Struct,requires,require_def)  ,  
  356                            dcgStructSetOpt(Struct,types,types_def)    ,   %:typing
  357                            dcgStructSetOpt(Struct,constants,constants_def) ,
  358                            dcgStructSetOpt(Struct,predicates,predicates_def) ,
  359                            dcgStructSetOpt(Struct,functions,functions_def), %:fluents
  360                            dcgStructSetOptTraced(Struct,dconstraints,dconstraints_def)   ,    %:constraints
  361                            dcgStructSetOptTraced(Struct,actions,zeroOrMore(structure_def)), [')'].
  362                             
  363
  364require_def(R)		--> ['(',':','requirements'], oneOrMore(require_key, R), [')'].
  365require_key(strips)								--> [':strips'].
  366require_key(typing)								--> [':typing'].
  367require_key('action-costs')                             --> [':action-costs'].
  368require_key('goal-utilities')                             --> [':goal-utilities'].
  369%require_key('negative-preconditions')		--> [':negative-preconditions'].
  370%require_key('disjunctive-preconditions')	--> [':disjunctive-preconditions'].
  371require_key(equality)							--> [':equality'].
  372require_key('existential-preconditions')	--> [':existential-preconditions'].
  373require_key('universal-preconditions')		--> [':universal-preconditions'].
  374require_key('quantified-preconditions')	--> [':quantified-preconditions'].
  375require_key('conditional-effects')			--> [':conditional-effects'].
  376require_key(fluents)								--> [':fluents'].
  377require_key(adl)									--> [':adl'].
  378require_key('durative-actions')				--> [':durative-actions'].
  379require_key('derived-predicates')			--> [':derived-predicates'].
  380require_key('timed-initial-literals')		--> [':timed-initial-literals'].
  381require_key(preferences)						--> [':preferences'].
  382require_key(constraints)						--> [':constraints'].
  383% Universal requirements
  384require_key(R)		--> [':', R].
  385
  386types_def(L)                    --> ['(',':',types],      typed_list_keys(type, L), [')'].
  387constants_def(L)                --> ['(',':',constants],  typed_list_keys(constant, L), [')'].
  388predicates_def(P)		--> ['(',':',predicates], oneOrMore(atomic_formula_skeleton, P), [')'].
  389
  390atomic_formula_skeleton(F)  
  391   --> {old_rsasak},!, ['('], predicate(P), typed_list(variable, L), [')'], {F=..[P|L],!}.
  392atomic_formula_skeleton(Struct) -->
  393   ['('],  predicate(S), typed_list_exact(variable, L), [')'],
  394     { must_det_l((get_param_types(top,L,PIs,PTs), 
  395     SPI=..[S|PIs],SPT=..[S|PTs],SPDL=..[predicate,S|L],
  396     ensure_struct(predicate,[parameters=SPI, parameter_types=SPT, parameters_decl=SPDL],Struct)))}.
  397
  398
  399predicate(_) --> [P], {P==not,!,fail}.
  400predicate(P)			--> name(P).
  401
  402variable(V)                     --> ['?'], name(N), { /*logicmoo_i_sexp_reader:*/fix_varcase(N,N0), V =.. [?, N0]}.
  403
  404atomic_function_skeleton(f(S, L)) --> {old_rsasak},!, ['('], function_symbol(S), typed_list(variable, L), [')'].
  405atomic_function_skeleton(f(S,Struct)) -->
  406   ['('],  function_symbol(S), typed_list_exact(variable, L), [')'],
  407     { must_det_l((get_param_types(top,L,PIs,PTs), 
  408     SPI=..[S|PIs],SPT=..[S|PTs],SPDL=..[function,S|L],
  409     ensure_struct(predicate,[parameters=SPI, parameter_types=SPT, parameters_decl=SPDL],Struct)))}.
  410
  411
  412typed_list_keys(Type, OUT) --> {old_rsasak},!, typed_list(Type, OUT).
  413typed_list_keys(Type, OUT) -->  typed_list(name, L), 
  414 {must_det_l((get_param_types(Type, L,PIs,PTs), pairs_keys_values(OUT,PIs,PTs)))}.
  415
  416function_symbol(S)		--> name(S).
  417functions_def(F)		--> ['(',':',functions], function_typed_list(atomic_function_skeleton, F), [')'].	%:fluents
  418dconstraints_def(C)                 --> ['(',':',constraints], con_GD(C), [')'].                                                   %:constraints
  419structure_def(A)		--> action_def(A).
  420structure_def(D)               --> durative_action_def(D). %:durativeactions                                                                 %:durativeactions
  421%structure_def(D)		--> derived_def(D).		%:derivedpredicates
  422structure_def(D)         --> allowed_sterm(structure_def,D).
  423%typed_list(W, G)		--> oneOrMore(W, N), ['-'], type(T), {G =.. [T, N]}.
  424
  425typed_list(W, [G|Ns])		--> {old_rsasak},oneOrMore(W, N), ['-'], type(T), !, typed_list(W, Ns), {G =.. [T,N]}.
  426typed_list(W, N)		--> {old_rsasak},!, zeroOrMore(W, N).
  427typed_list(W, L) --> typed_list0(W, GsNs),{adjust_types(W,GsNs,L)}.
  428
  429typed_list_exact(W, L) --> typed_list0(W, L).
  430
  431
  432typed_list0(W, GsNs)           --> oneOrMore(W, N), ['-'], type(T), !, typed_list0(W, Ns), {findall(G,(member(E,N),G =.. [T,E]),Gs), append(Gs,Ns,GsNs)}.
  433typed_list0(W, N)                --> zeroOrMore(W, N).
  434
  435
  436allowed_sterm(Why,sterm(Why,D))--> {t_l:allow_sterm},sterm(D).                                                                           
  437
  438effected_typed_list(W, [G|Ns])           --> oneOrMore(W, N), ['-'], effect(T), !, effected_typed_list(W, Ns), {G =.. [T,N]}.
  439effected_typed_list(W, N)                --> zeroOrMore(W, N).
  440
  441primitive_type(N)		--> name(N).
  442type(either(PT))		--> ['(',either], !, oneOrMore(primitive_type, PT), [')'].
  443type(PT)			--> primitive_type(PT).
  444function_typed_list(W, [F|Ls])
  445				--> oneOrMore(W, L), ['-'], !, function_type(T), function_typed_list(W, Ls), {F =.. [T|L]}.	%:typing
  446function_typed_list(W, L)	--> zeroOrMore(W, L).
  447
  448function_type(number)		--> [number].
  449
  450emptyOr(_)			--> ['(',')'].
  451emptyOr(W)			--> W.
  452
  453% Actions definitons
  454action_def(Struct) --> {\+ old_rsasak},!, action_def_struct(Struct).
  455action_def(action(S, L, Precon, Pos, Neg, Assign))
  456				--> ['(',':',action], action_symbol(S),
  457						[':',parameters,'('], typed_list(variable, L), [')'],
  458						action_def_body(Precon, Pos, Neg, Assign),
  459					[')'].
  460
  461action_symbol(N)                --> name(N).
  462action_def_body(P, Pos, Neg, Assign)
  463				--> (([':',precondition], emptyOr(pre_GD(P)))	; []),
  464				(([':',effect],       emptyOr(effect(Pos, Neg, Assign)))	; []).
  465
  466
  467																	
  468action_def_struct(Struct)
  469                                --> 
  470           % action(S, PTs,  Precon, Pos, Neg, Assign, UT , C, Vars)
  471   {must((Struct = action(_, [], [],      [], [],  [],     [] , [],   mutable([sclass=dict]))))},
  472                                    ['(',':',action], action_symbol(S),
  473                                   dcgMust(( [':',parameters],
  474
  475                                    ['('], typed_list_exact(variable, L), [')'],
  476                                    {must_det_l((get_param_types(top,L,PIs,PTs),
  477                                    SPI=..[S|PIs],
  478                                    SPT=..[S|PTs],
  479                                    prop_set_nvlist(Struct,[action_name=S,parameters=SPI, parameter_types=SPT, parameters_decl=L])))},
  480                                    dcgMust((action_def_body(Struct))),
  481                                    [')'])),!.
  482
  483% Actions definitons
  484durative_action_def(action(S, vv(PTs), Precon, Pos, Neg, Assign, UT, []))
  485                                --> ['(',':',daction], action_symbol(S),
  486						[':',parameters,'('], typed_list(variable, L), [')'],
  487                                    {get_param_types(s(val),L,PIs,PTs),UT=..[S|PIs],!},
  488                                    da_def_body(Precon, Pos, Neg, Assign),
  489					[')'].
  490
  491
  492% % 2 ?- phrase(emptyOr(pre_GD(P)),['(',accessible,?,x,')','(','no-inventory-object',?,x,')','(','has-location',?,x,?,y,')'],X).
  493% % P = accessible(?x),
  494% % X = ['(', 'no-inventory-object', ?, x, ')', '(', 'has-location', ?, x|...] .
  495
  496da_def_body([P1,P2], Pos, Neg, Assign)
  497                                -->  
  498                                    (([':',duration], emptyOr(con_GD(P1)))                ; []),
  499                                    (([':',condition], emptyOr(pre_GD(P2)))                ; []),
  500				    (([':',effect],       emptyOr(effect(Pos, Neg, Assign)))	; []).
  501
  502action_def_body(Struct)
  503                                -->  
  504                                    (([':',precondition], emptyOr(pre_GD(P)))                ; []),
  505                                    (([':',effect],       emptyOr(effect(Pos, Neg, Assign))) ; []),
  506                                    {
  507                                      ignore(Pos=[]),
  508                                      must(prop_set_nvlist(Struct,[preconditions=P,positiv_effect=Pos,negativ_effect=Neg,assign_effect=Assign]))}.
  509
  510
  511
  512% % [1] 2 ?- pre_GD(X,['(',accessible,?,x,')'],[]).
  513% % X = accessible(?x) .
  514pre_GD(_)			--> [:,effect],{!,fail}.
  515% pre_GD(and(P))                  --> ['(',and],  zeroOrMore(pre_GD ,P), [')'].       
  516pre_GD([F])                     --> atomic_formula(term, F).
  517pre_GD(and(P))                  --> ['('],  oneOrMore(pre_GD ,P), [')'].       
  518pre_GD(P)			--> pref_GD(P).
  519% pre_GD(P)                       --> ['(',and], dcgMust((pre_GD(P), [')'])).
  520% pre_GD(forall(L, P))           --> pddl_3_0, ['(',forall,'('],  dcgMust(((typed_list(variable, L), [')'], pre_GD(P), [')']))).         %:universal-preconditions
  521pref_GD(preference(N, P))      --> pddl_3_0, ['(', preference], dcgOptionalGreedy(pref_name(N)),  dcgMust(gd(P)), dcgMust([')']).                         %:preferences
  522pref_GD(P)			--> gd(P).
  523pref_name(N)			--> name(N).
  524
  525% gd(and(P))                  --> pddl_3_0_e(gd), ['(',and],   zeroOrMore(gd ,P), [')'].       
  526% % gd(F)                           --> atomic_formula(term, F).                                                    %:this option is covered by gd(L)
  527gd(L)                          --> literal(term, L).                                                           %:negative-preconditions
  528gd(':-------------------------------------------------effect'(zzzzzzzzzzzz))                          --> [':','effect'].
  529gd(P)				--> ['(',and],  zeroOrMore(gd, P), [')'].
  530gd(or(P))                      --> pddl_3_0_e(gd), ['(',or],   zeroOrMore(gd ,P), [')'].                                       %:disjuctive-preconditions
  531gd(not(P))                     --> pddl_3_0_e(gd), ['(',not],  gd(P), [')'].                                                   %:disjuctive-preconditions
  532gd(imply(P1, P2))              --> pddl_3_0_e(gd), ['(',imply], gd(P1), gd(P2), [')'].                                         %:disjuctive-preconditions
  533gd(exists(L, P))               --> pddl_3_0_e(gd), ['(',exists,'('], typed_list(variable, L), [')'], gd(P), [')'].             %:existential-preconditions
  534gd(forall(L, P))               --> pddl_3_0_e(gd), ['(',forall,'('], typed_list(variable, L), [')'], gd(P), [')'].             %:universal-preconditions
  535gd(F)				--> f_comp(F).	%:fluents
  536f_comp(compare(C, E1, E2))	--> ['('], binary_comp(C), f_exp(E1), f_exp(E2), [')'].
  537
  538literal(T, not(F))              --> neg_atomic_formula(T,F).
  539literal(T, F)			--> atomic_formula(T, F).
  540
  541atomic_formula(_, F)		--> ['('], predicate(P), zeroOrMore(term, T), [')'], {F =.. [P|T]}.		% cheating, maybe wrong
  542
  543
  544neg_atomic_formula(T,F)       --> [not], atomic_formula(T,F).
  545neg_atomic_formula(T,F)       --> ['(',not], atomic_formula(T,F),[')'].
  546
  547
  548term(V)				--> variable(V).
  549term(V)                         --> number_sas(V).
  550term(N)                         --> [N],{bad_name(N),!,fail}.
  551term(N)                         --> name(N).
  552
  553f_exp(N)                        --> number_sas(N).
  554f_exp(op(O, E1, E2))		--> ['('],binary_op(O), f_exp(E1), f_exp(E2), [')'].
  555f_exp('-'(E))			--> ['(','-'], f_exp(E), [')'].
  556f_exp(H)			--> f_head(H).
  557f_head(F)			--> ['('], function_symbol(S), zeroOrMore(term, T), [')'], { F =.. [S|T] }.
  558f_head(S)				--> function_symbol(S).
  559binary_op(O)			--> multi_op(O).
  560binary_op(45)                   --> [45]. % 45 = minus = '-'  (TODO - WHY IS THIS HERE?)
  561binary_op('-')                  --> ['-'].
  562binary_op('/')			--> ['/'].
  563multi_op('*')			--> ['*'].
  564multi_op('+')			--> ['+'].
  565binary_comp('>')		--> ['>'].
  566binary_comp('<')		--> ['<'].
  567binary_comp('=')		--> ['='].
  568binary_comp('>=')		--> ['>='].
  569binary_comp('<=')		--> ['<='].
  570number_sas(N)                       --> [N], {number(N),!}.
  571number(N)			--> number_sas(N).
  572
  573effect(P, N, A)			--> ['(',and], c_effect(P, N, A), [')'].
  574effect(P, [M|N], A)             --> ['(',not], c_effect([M|P], N, A), [')'].
  575effect(P, N, A)			--> c_effect(P, N, A).
  576
  577c_effect(forall(Es))            --> pddl_3_0, ['(',forall,'('], effected_typed_list(variable,Es), [')', ')'].    %:conditional-effects
  578c_effect(when(P, E))           --> pddl_3_0, ['(',when], gd(P), cond_effect(E), [')'].                   %:conditional-effects
  579c_effect(P, N, A)		--> p_effect(P, N, A).
  580p_effect([], [], [])		--> [].
  581p_effect(Ps, Ns, [F|As])       
  582     --> ['('], assign_op(O), f_head(H), f_exp(E), [')'], p_effect(Ps, Ns, As), {F =.. [O, H, E]}.
  583p_effect(Ps, [F|Ns], As)        --> neg_atomic_formula(term,F), p_effect(Ps, Ns, As).
  584p_effect([F|Ps], Ns, As)	--> atomic_formula(term, F), p_effect(Ps, Ns, As).
  585
  586p_effect(op(O, H, E))          --> pddl_3_0(op/3), ['('], assign_op(O), dcgMust((f_head(H), f_exp(E), [')'])).            %:fluents , What is difference between rule 3 lines above???
  587
  588cond_effect(E)                 --> ['(',and], zeroOrMore(p_effect, E), [')'].                  %:conditional-effects
  589cond_effect(E)                 --> p_effect(E).                                                %:conditional-effects
  590assign_op(assign)		--> [assign].
  591assign_op(scale_up)		--> [scale_up].
  592assign_op(scale_down)		--> [scale_down].
  593assign_op(increase)		--> [increase].
  594assign_op(decrease)		--> [decrease].
  595
  596
  597% BNF description include operator <term>+ to mark zero or more replacements.
  598% This DCG extension to overcome this. 
  599oneOrMore(W, [R|Rs], A, C) :- call(W, R, A, B),  (
  600					oneOrMore(W, Rs, B, C) ;
  601					(Rs = [] , C = B) 
  602				).
  603% BNF operator <term>*
  604zeroOrMore(W, R)		--> oneOrMore(W, R).
  605zeroOrMore(_, [])		--> [].
  606
  607% Name is everything that is not number, bracket or question mark.
  608% Those rules are not necessary, but rapidly speed up parsing process.
  609name(N)				--> [N], {integer(N), !, fail}.
  610name(N)				--> [N], {float(N), !, fail}.
  611name(N)				--> [N], {N=')', !, fail}.
  612name(N)				--> [N], {N='(', !, fail}.
  613name(N)				--> [N], {N='?', !, fail}.
  614name(N)				--> [N], {N='-', !, fail}.
  615name(N)				--> [N].
  616
  617bad_name(N):- (var(N);number(N)),!.
  618bad_name(':').
  619bad_name('not').
  620bad_name(N):-arg(_,v('(',')',?,(-)),N).
  621
  622% FILENAME:  parseProblem.pl 
  623%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  624%% parseDomain.pl
  625%%   Simple parser of PDDL domain file into prolog syntax.
  626%% Author: Robert Sasak, Charles University in Prague
  627%%
  628%% Example: 
  629%% ?-parseProblem('problem.pddl', O).
  630%%   O = problem('blocks-4-0',							%name
  631%%              blocks,										%domain name
  632%%              _G1443,                            %require definition
  633%%              [block(d, b, a, c)],					%object declaration
  634%%              [ clear(c), clear(a), clear(b), clear(d), ontable(c), %initial state
  635%%                ontable(a), ontable(b), ontable(d), handempty,
  636%%                set('total-cost', 0)	],
  637%%              [on(d, c), on(c, b), on(b, a)],		%goal
  638%%              _G1447,										%constraints-not implemented
  639%%              metric(minimize, 'total-cost'),		%metric
  640%%              _G1449										%length_specification-not implemented
  641%%              )
  642%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  643
  644% parseProblem(+File, -Output).
  645%
  646% Parse PDDL problem File and return rewritten prolog syntax. 
  647%
  648parseProblem(F, O):-parseProblem(F, O, R), load_file_rest(F,_O,R),!.
  649
  650
  651% parseProblem(+File, -Output, -RestOfFile).
  652%
  653% The same as above and also return rest of file. Can be useful when domain and problem are in one file.
  654%
  655parseProblem(F, O, R) :-
  656	read_file(F, L),
  657	problem(O, L, R), !.
  658	
  659parseProblem(F, O, R) :-
  660   read_file(F, L , Filename),!,
  661   ensure_struct(problem,O),
  662   prop_set(filename,O,Filename),  
  663   problem_new(O, L, R),!.    
  664
  665% Support for reading file as a list.
  666% :-[readFile].
  667
  668
  669% DCG rules describing structure of problem file in language PDDL.
  670%
  671% BNF description was obtain from http://www.cs.yale.edu/homes/dvm/papers/pddl-bnf.pdf
  672% This parser do not fully NOT support PDDL 3.0
  673% However you will find comment out lines ready for futher development.
  674% Some of the rules are already implemented in parseDomain.pl
  675%
  676% :-[parseDomain]. %make sure that it is loaded.
  677problem_new(Output, List, R):- locally(tlbugger:skipMust, on_x_debug(problem_dcg(Output, List, R))),!.
  678problem_new(Output, List, R):- locally(t_l:allow_sterm,locally(tlbugger:skipMust, on_x_debug(problem_dcg(Output, List, R)))),!,
  679   portray_clause((problem:-t_l:allow_sterm,Output)).
  680% problem(P     , List, R):- dtrace,trace,must(sterm(O, List, R)),!,must(sterm2pterm(O,P)),!,portray_clause((ed:-P)).
  681problem_new(Output, List, R):- must(problem_dcg(Output, List, R)),!.
  682
  683problem(New) --> {\+ old_rsasak}, problem_dcg(Struct). 
  684problem(problem(Name, Domain, R, OD, I, G, _, MS, LS))   
  685				--> ['(',define,'(',problem,Name,')',
  686							'(',':',domain, Domain,')'],
  687                     (require_def(R)		; []),
  688							(objects_def(OD)	; []),
  689							init_def(I),
  690							goal_def(G),
  691%                     (pconstraints(C)		; []), %:constraints
  692							(metric_spec(MS)	; []),
  693                     (length_spec(LS)	; []),
  694				[')'].
  695
  696problem_dcg(Struct)   
  697        --> ['(',define],([':'];[]),['(',problem,Name,')','(',':',domain, Domain,')'],
  698                 {ensure_struct(problem,[problem_name=Name,domain_name=Domain],Struct)},
  699                    dcgStructSetOpt(Struct,requires,require_def),  
  700                    dcgStructSetOpt(Struct,objects,objects_def),
  701                    dcgStructSetOpt(Struct,init,init_def),  
  702                    dcgStructSetOpt(Struct,goal,goal_def),  
  703                    dcgStructSetOpt(Struct,pconstraints,pconstraints_def),   %:constraints  
  704                    dcgStructSetOpt(Struct,metric,metric_spec),  
  705                    dcgStructSetOpt(Struct,length,length_spec),
  706				[')'].
  707
  708
  709objects_def(L)           --> ['(',':',objects], typed_list_as_list(name, L),[')'].
  710
  711typed_list_as_list(W, OUT)   --> oneOrMore(W, N), ['-'],!, dcgMust(( type(T), typed_list_as_list(W, Ns), {G =.. [T,N], OUT = [G|Ns]})).
  712typed_list_as_list(W, N)                --> zeroOrMore(W, N).
  713
  714
  715goal_list(_,G) --> pre_GD(G).
  716goal_list(_,G) --> zeroOrMore(init_el,G).
  717goal_list(H,G) --> allowed_sterm(H,G).
  718
  719init_def(I)                         --> ['(',':',init], goal_list(init_el,I), [')'].
  720
  721init_el(I)                      --> literal(term, I).
  722init_el(I)                      --> pre_GD(I).
  723init_el(set(H,N))               --> ['(','='], f_head(H), number_sas(N), [')'].                                     % fluents
  724init_el(at(N, L))               --> ['(',at], number_sas(N), literal(name, L), [')'].                               % timed-initial literal
  725goal_def(G)                         --> ['(',':',goal],goal_list(goal,G),[')'].
  726pconstraints_def(C)                 --> ['(',':',constraints], pref_con_GD(C), [')'].                               % constraints
  727pref_con_GD(and(P))		--> ['(',and], zeroOrMore(pref_con_GD, P), [')'].
  728%pref_con_GD(foral(L, P))	--> ['(',forall,'('], typed_list(variable, L), [')'], pref_con_GD(P), [')'].	%universal-preconditions
  729%pref_con_GD(prefernce(N, P))	--> ['(',preference], (pref_name(N) ; []), con_GD(P), [')'].			%prefernces
  730pref_con_GD(P)			--> con_GD(P).
  731
  732con_GD(and(L))			--> ['(',and], zeroOrMore(con_GD, L), [')'].
  733con_GD(forall(L, P))		--> ['(',forall,'('], typed_list(variable, L),[')'], con_GD(P), [')'].
  734con_GD(at_end(P))		--> ['(',at,end],	gd(P), [')'].
  735con_GD(always(P))		--> ['(',always],	gd(P), [')'].
  736con_GD(sometime(P))		--> ['(',sometime],	gd(P), [')'].
  737con_GD(within(N, P))            --> ['(',within], number_sas(N), gd(P), [')'].
  738
  739con_GD(at_most_once(P))		--> ['(','at-most-once'], gd(P),[')'].
  740con_GD(some_time_after(P1, P2))	--> ['(','sometime-after'], gd(P1), gd(P2), [')'].
  741con_GD(some_time_before(P1, P2))--> ['(','sometime-before'], gd(P1), gd(P2), [')'].
  742con_GD(always_within(N, P1, P2))--> ['(','always-within'], number_sas(N), gd(P1), gd(P2), [')'].
  743con_GD(hold_during(N1, N2, P))  --> ['(','hold-during'], number_sas(N1), number_sas(N2), gd(P), [')'].
  744con_GD(hold_after(N, P))        --> ['(','hold-after'], number_sas(N), gd(P),[')'].
  745
  746metric_spec(metric(O, E))       --> ['(',':',metric], optimization(O), dcgMust((metric_f_exp(E), [')'])).
  747
  748optimization(minimize)		--> [minimize].
  749optimization(maximize)		--> [maximize].
  750
  751metric_f_exp(E)			--> ['('], binary_op(O), metric_f_exp(E1), metric_f_exp(E2), [')'], {E =..[O, E1, E2]}.
  752metric_f_exp(multi_op(O,[E1|E]))--> ['('], multi_op(O), metric_f_exp(E1), oneOrMore(metric_f_exp, E), [')']. % I dont see meanful of this rule, in additional is missing in f-exp
  753metric_f_exp(E)			--> ['(','-'], metric_f_exp(E1), [')'], {E=..[-, E1]}.
  754metric_f_exp(N)                 --> number_sas(N).
  755metric_f_exp(F)                 --> ['('], function_symbol(S), zeroOrMore(name, Ns), [')'], { F=..[S|Ns]}.%concat_atom_iio([S|Ns], '-', F) }.
  756metric_f_exp(function(S))	--> function_symbol(S).
  757metric_f_exp(total_time)	--> ['total-time'].
  758metric_f_exp(is_violated(N))	--> ['(','is-violated'], pref_name(N), [')'].
  759
  760% Work arround
  761metric_f_exp(is_violated(N,V))    --> ['(','*','(','is-violated'], pref_name(N), [')'],number_sas(V),[')'].
  762
  763% Work arround
  764length_spec([])			--> [not_defined].	% there is no definition???
  765
  766:- fixup_exports.