1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2%% parseDomain.pl
    3%%   Simple parser of PDDL domain file into prolog syntax.
    4%% Author: Robert Sasak, Charles University in Prague
    5%%
    6%% Example: 
    7%% ?-parseProblem('problem.pddl', O).
    8%%   O = problem('blocks-4-0',							%name
    9%%              blocks,										%domain name
   10%%              _G1443,                            %require definition
   11%%              [block(d, b, a, c)],					%object declaration
   12%%              [ clear(c), clear(a), clear(b), clear(d), ontable(c), %initial state
   13%%                ontable(a), ontable(b), ontable(d), handempty,
   14%%                set('total-cost', 0)	],
   15%%              [on(d, c), on(c, b), on(b, a)],		%goal
   16%%              _G1447,										%constraints-not implemented
   17%%              metric(minimize, 'total-cost'),		%metric
   18%%              _G1449										%length_specification-not implemented
   19%%              )
   20%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   21
   22
   23% parseProblem(+File, -Output).
   24% Parse PDDL problem File and return rewritten prolog syntax. 
   25parseProblem(F, O):-parseProblem(F, O, _).
   26
   27% parseProblem(+File, -Output, -RestOfFile).
   28% The same as above and also return rest of file. Can be useful when domain and problem are in one file.
   29parseProblem(F, O, R) :-
   30	read_file(F, L),
   31	problem(O, L, R).
   32
   33% Support for reading file as a list.
   34:-[readFile].   35
   36
   37
   38% List of DCG rules describing structure of problem file in language PDDL.
   39% BNF description was obtain from http://www.cs.yale.edu/homes/dvm/papers/pddl-bnf.pdf
   40% This parser do not fully NOT support PDDL 3.0
   41% However you will find comment out lines ready for futher development.
   42% Some of the rules are already implemented in parseDomain.pl
   43:-[parseDomain]. %make sure that it is loaded.
   44problem(problem(Name, Domain, R, OD, I, G, _, MS, LS))   
   45				--> ['(',define,'(',problem,Name,')',
   46							'(',':',domain, Domain,')'],
   47                     (require_def(R)		; []),
   48							(object_declaration(OD)	; []),
   49							init(I),
   50							goal(G),
   51%                     (constraints(C)		; []), %:constraints
   52							(metric_spec(MS)	; []),
   53                     (length_spec(LS)	; []),
   54				[')'].
   55
   56object_declaration(L)		--> ['(',':',objects], typed_list(name, L),[')'].
   57init(I)                      	--> ['(',':',init], zeroOrMore(init_el, I), [')'].
   58
   59init_el(I)			--> literal(name, I).
   60init_el(set(H,N))		--> ['(','='], f_head(H), number(N), [')'].					%fluents
   61init_el(at(N, L))		--> ['(',at], number(N), literal(name, L), [')'].				% timed-initial literal
   62goal(G)				--> ['(',':',goal], pre_GD(G),[')'].
   63%constraints(C)			--> ['(',':',constraints], pref_con_GD(C), [')'].				% constraints
   64pref_con_GD(and(P))		--> ['(',and], zeroOrMore(pref_con_GD, P), [')'].
   65%pref_con_GD(foral(L, P))	--> ['(',forall,'('], typed_list(variable, L), [')'], pref_con_GD(P), [')'].	%universal-preconditions
   66%pref_con_GD(prefernce(N, P))	--> ['(',preference], (pref_name(N) ; []), con_GD(P), [')'].			%prefernces
   67pref_con_GD(P)			--> con_GD(P).
   68
   69con_GD(and(L))			--> ['(',and], zeroOrMore(con_GD, L), [')'].
   70con_GD(forall(L, P))		--> ['(',forall,'('], typed_list(variable, L),[')'], con_GD(P), [')'].
   71con_GD(at_end(P))		--> ['(',at,end],	gd(P), [')'].
   72con_GD(always(P))		--> ['(',always],	gd(P), [')'].
   73con_GD(sometime(P))		--> ['(',sometime],	gd(P), [')'].
   74con_GD(within(N, P))		--> ['(',within], number(N), gd(P), [')'].
   75
   76con_GD(at_most_once(P))		--> ['(','at-most-once'], gd(P),[')'].
   77con_GD(some_time_after(P1, P2))	--> ['(','sometime-after'], gd(P1), gd(P2), [')'].
   78con_GD(some_time_before(P1, P2))--> ['(','sometime-before'], gd(P1), gd(P2), [')'].
   79con_GD(always_within(N, P1, P2))--> ['(','always-within'], number(N), gd(P1), gd(P2), [')'].
   80con_GD(hold_during(N1, N2, P))	--> ['(','hold-during'], number(N1), number(N2), gd(P), [')'].
   81con_GD(hold_after(N, P))	--> ['(','hold-after'], number(N), gd(P),[')'].
   82
   83metric_spec(metric(O, E))	--> ['(',':',metric], optimization(O), metric_f_exp(E), [')'].
   84
   85optimization(minimize)		--> [minimize].
   86optimization(maximize)		--> [maximize].
   87
   88metric_f_exp(E)			--> ['('], binary_op(O), metric_f_exp(E1), metric_f_exp(E2), [')'], {E =..[O, E1, E2]}.
   89metric_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
   90metric_f_exp(E)			--> ['(','-'], metric_f_exp(E1), [')'], {E=..[-, E1]}.
   91metric_f_exp(N)			--> number(N).
   92metric_f_exp(F)			--> ['('], function_symbol(S), zeroOrMore(name, Ns), [')'], { concat_atom([S|Ns], '-', F) }.
   93metric_f_exp(function(S))	--> function_symbol(S).
   94metric_f_exp(total_time)	--> ['total-time'].
   95metric_f_exp(is_violated(N))	--> ['(','is-violated'], pref_name(N), [')'].
   96
   97% Work arround
   98length_spec([])			--> [not_defined].	% there is no definition???