% Copyright: (C) Heike Stephan,  Stefan Brass, 2014
% Copying: Permitted under the GNU General Public License.
% This program is free software: you can redistribute it and/or  
% modify it under the terms of the GNU General   
% Public License as published by the Free Software      
% Foundation, either version 3 of the License, or (at   
% your option) any later version.                       
                                                       
% This program is distributed in the hope that it will be useful,
% but WITHOUT ANY WARRANTY; without even the implied    
% warranty of MERCHANTABILITY or FITNESS FOR A          
% PARTICULAR PURPOSE. See the GNU General Public 
% License for more details.                                                       
%       http://www.gnu.org/licenses/  


%==============================================================================
% Parser for Input Programs.
% The parser uses code from:
%
% sldmagic.pl
% Copyright:	(C) 1996-2015  Stefan Brass
% Copying:	Permitted under the GNU General Public License.
%==============================================================================
% modified by: Heike Stephan
% last modification: August 17th, 2015
%==============================================================================
% DESCRIPTION:
% The parser reads a Datalog program from an input file and stores the result of
% the parsing in the dynamic database.
% To parse a file, call load_program(Filename).
% The input file should have at the beginning the declaration of the EDB 
% predicates, in the form of facts
% db(Pred/Arity).
% This is followed by the datalog rules, which should have the format
% Head <- Lit1, Lit2.
% Also 0 and 1 body literal are allowed; in the former case, just write
% Head.
% The parsing result is stored in the following dynamic database relations:
% answer_pred(Pred, Arity) defines the answer predicate, for the query result;
% edb_pred(Pred, Arity) defines the edb predicates;
% idb_pred(Pred, Arity) defines the idb predicates;
% rule(Head, No, Type, BodyList) holds the rules of the program, where Head
% is the rule head literal, No is a unique number to identify the rule,
% Type is the type of the rule body for the push method 
% (edb: only one EDB body literal;
% idb: One idb body literal; idbedb: One idb and one edb body literal, assumed
% to be with idb first;
% idbidb: two idb body literals,
% empty: empty body);
% and BodyList is a list of the body literals.
%
% TODO: answer_pred should also store the argument data type, and further
% processing should check consistency.
%------------------------------------------------------------------------------

:- license(gpl).

%------------------------------------------------------------
% Operator '<-' for rule declaration; substitutes the Prolog ':-'.
%------------------------------------------------------------
%:- op(1200, xfx, '<-').

%------------------------------------------------------------------------------
% Operator for Defining Database Literals.
%------------------------------------------------------------------------------
:- op(1000, fy, db).

%------------------------------------------------------------------------------
% List of IDB-Predicates:
% First argument is the predicate name,
% second argument is its arity. (The argument types will not be computed by
% the parser, but in a later step.)
%------------------------------------------------------------------------------

:- dynamic idb_pred/2.

%------------------------------------------------------------------------------
% List of EDB-Predicates:
% First argument is the predicate name,
% second argument is a list of the argument types.
%------------------------------------------------------------------------------

:- dynamic edb_pred/2.

%------------------------------------------------------------------------------
% The answer predicate:
% First argument is the answer predicate name.
%------------------------------------------------------------------------------

:- dynamic answer_pred/1.

%------------------------------------------------------------------------------
% This stores all predicates occurred during parsing that, at the moment of
% parsing, can neither be identified as idb nor as edb predicates.
% They are retracted as soon as they can be identified.
% First argument is the predicate name,
% second argument is its arity.
%------------------------------------------------------------------------------
:- dynamic body_pred/2.

%------------------------------------------------------------------------------
% List of Query Patterns:
%------------------------------------------------------------------------------

% This predicate contains the given query.
% query(Query, Query_Pattern, Cond_Vars, Cond_Vals).
% Query is the query as entered, but with variables bound to terms of the form
% var(i) with a unique number i.
% If use_query_const is yes, Query_Pattern is the same as Query and Cond_Vars
% and Cond_Vals are [].
% If use_query_const is no, Query_Pattern is computed from Query by replacing
% constants also by terms of the from var(i).
% These terms are collected in Cond_Vars, and the corresponding constants are
% collected in Cond_Vals.

:- dynamic query/4.

%------------------------------------------------------------------------------
% List of Program Rules:
% The first argument is  head literal,
% the second argument is a list of the body literals;
% the third is the line in the input document where the definition of this rule
% starts (for error messages).
%------------------------------------------------------------------------------

:- dynamic rule/3.



%------------------------------------------------------------------------------
% This holds a information about the state of parsing, e.g. information that
% the declaration part has been parsed. Current possible values:  
% parsing_decls, parsing_rules.
%------------------------------------------------------------------------------
%:- dynamic parsing_state/1.

%------------------------------------------------------------------------------
% The currently supported data types.
%------------------------------------------------------------------------------
type(id).
type(int).
type(float).
type(string).

%------------------------------------------------------------------------------
% load_program(+Filename):
%------------------------------------------------------------------------------

% This predicate reads the input file and stores all its information in
% the dynamic database.
% It fails on a syntax error, or when a rule is not range restricted.

load_program(Filename) :-
	%retractall(query(_,_)),
	retractall(edb_pred(_,_)),
	retractall(idb_pred(_,_)),
	retractall(answer_pred(_)),
	retractall(body_pred(_,_)),
	retractall(rule(_,_,_)),
	retractall(query(_,_,_,_)),
	
	%retractall(parsing_state(_)),
	
	%assertz(parsing_state(parsing_decls)),
	open(Filename, read, In_Stream),
	(read_rules(In_Stream) ->
		close(In_Stream), write('Program '),
		write(Filename), 
		write(' loaded.'), nl
	;
		close(In_Stream),
		write('Error at loading program.'), nl,
		fail
	)
	%findall((Head, Body),rule(Head, Body,_),Rules),
	%print_rules(Rules),
	
	%findall(/(Pred,Arity),body_pred(Pred,Arity),BP),
	%if
	%(BP=[] ->
	%    true;
	%    write('Undefined predicates: '),
	%    write(BP),
	%    nl,
	%    fail
	%)
	.

%------------------------------------------------------------------------------
% read_rules(+In_Stream):
%------------------------------------------------------------------------------

% This predicate reads each line until the end of file.
% (More precisely, not lines are read, but Prolog terms.)
% For every line, process_term is called.
% It fails on a syntax error (i.e. when read_term or process_term fails).

read_rules(In_Stream) :-
	read_term(In_Stream, Term,[term_position(Pos)]),
	(Term == end_of_file ->
		true
	;
	    stream_position_data(line_count,Pos,Line),
		process_term(Term, Line),
		!,
		read_rules(In_Stream)).

%------------------------------------------------------------------------------
% process_term(+Term, +Line):
%------------------------------------------------------------------------------

% This predicate is called for every input line (more precisely Prolog term).
% Its task is to process the input line, i.e. parse it and save the result
% in the dynamic database.
% The real work is done by parse_term_save_result.
% If something goes wrong (e.g. a syntax error) 
% this predicate shows the input term to the user and tells him/her that
% it contains an error.
% That is a very rudimentary error message, but better than nothing.
% It should be improved in a future version.
% Line is the Line where this term starts in the input file.

process_term(Term, Line) :-
	parse_term_save_result(Term, Line), !.

process_term(Term, Line) :-
	write('Error at parsing term: '),
	write(Term),nl,
	write('starting in line '),
	write(Line),
	write('.'),
	nl,
	fail.

%------------------------------------------------------------------------------
% parse_term_save_result(+Term, +Line):
%------------------------------------------------------------------------------

% This predicate mainly distinguishes between different types of input lines
% and delegates the work to the appropriate predicate.
% All processing predicates fail upon a syntax error and print an error message.
% The calling predicate process_term will print a small error message.

% Edb predicates are declared by the term db(Lit),
% where Lit is a literal of the form pred(Type1, Type2, ...),
% e.g. db(edge(int,int)). The currently supported data types are stored in the
% relation type/1.
%
% It is no longer important that all db declarations are at the beginning of the 
% program.
% Line is the line in the input program where this term starts.

parse_term_save_result((db(Lit)), Line) :-
    %parsing_state(parsing_decls),
	%!, 
	Lit =..[Pred|TypeList],
	(atom(Pred) ->
		save_edb(Pred,TypeList)
	;
		write('Error in line '),
		write(Line),
		write(': '),
		write(Pred),
		write(' is not a legal identifier.'), nl, fail
	).
    
parse_term_save_result((answer(Pred)), Line):-
    (atom(Pred) ->
	    save_answer_pred(Pred, Line)
	;
	    write('Error: no structured terms as argument for \'answer\' allowed.'),
	    nl,
	    fail
	)
	.

% Recognizes a program rule. For the determination of the Type value it is 
% IMPORTANT that all edb declarations are known before this rule is called.
parse_term_save_result((Head :- Body),Line) :-
    %(parsing_state(parsing_decls) ->
    %    retract(parsing_state(parsing_decls)),
    %    assertz(parsing_state(parsing_rules))
    %    ;
    %    % else
    %    parsing_state(parsing_rules)
    %),
	!,
	check_range_restriction(Head, Body),
	parse_head(Head, Line),
	parse_body(Body, BodyList),
	save_rule(Head, BodyList,Line).
	
%parse_term_save_result((_ :- _)) :-
%	!,
%	write('Please use the operator \'<-\' for rule definition.'),
%	nl, fail.

parse_term_save_result(A,Line) :-
    %(parsing_state(parsing_decls) ->
    %    retract(parsing_state(parsing_decls)),
    %    assertz(parsing_state(parsing_rules))
    %    ;
    %    % else
    %    parsing_state(parsing_rules)
    %),
    callable(A),
    check_range_restriction(A, true),
%    parse_head_literal(A),
    parse_head(A, Line),
    %write('No rules with empty bodies allowed.'),nl,
    %fail.
    save_rule(A, [],Line).
%------------------------------------------------------------------------------
% check_range_restriction(+Head, +Body)
%------------------------------------------------------------------------------
	
% Checks a rule given as term Head and term Body for range restriction.
% This is the case if the head variables are a subset of the body variables.

check_range_restriction(Head, Body) :-
	% Terms have to be copied to produce fresh variables.
	% Obviously, subset uses unification so the Head and
	% Body terms are changed during this test.
	% Due to unification, subset does not work correctly
	% in this case.
	copy_term([Head, Body], [Head2, Body2]),
	term_variables([Head2, Body2], VarsAll),
	term_variables(Head2, VarsHead),
	term_variables(Body2, VarsBody),
	numbervars(VarsAll,0,_),
	subset(VarsHead, VarsBody),!.
	
check_range_restriction(Head,Body) :-
	write('Rule '),
	write(Head), write(' <- '), write(Body),
	write(' is not range restricted.'),nl, fail.
	
%check_arity_params(_, []).
%check_arity_params(Arity, [Par | Params]) :- Par =< Arity, check_arity_params(Arity, Params).

	
%------------------------------------------------------------------------------
% save_edb(+Pred, +TypeList):
%------------------------------------------------------------------------------

% This predicate processes the declarations of database (edb) predicates.
% It stores the declaration in the dynamic database if it is not already there.
% For a predicate identifier only one type list is allowed. 
% Idb predicates and edb predicates are ensured to be disjoint.

save_edb(Pred, TypeList) :-
	edb_pred(Pred, TypeList),
	!.

save_edb(Pred, TypeList) :-
	edb_pred(Pred, TypeList2),
	!,
	write('Predicate '),
	write(Pred),
	write(TypeList),
	write(' is already defined as EDB predicate with types '),
	write(TypeList2), nl,
	fail.

save_edb(Pred, _) :-
	idb_pred(Pred, _),
	Pred \= answer,
	!,
	write('Predicate '),
	write(Pred),
	%write('/'),
	%write(Arity),
	write(' is already defined as IDB predicate.'),nl,
	fail.
	
save_edb(answer, _) :-
	!,
	write('Predicate name answer is reserved.'),nl,
	fail.

save_edb(Pred, TypeList) :-
	\+ idb_pred(Pred, _),
	\+ edb_pred(Pred, _),
	check_types(TypeList),
	assertz(edb_pred(Pred,TypeList)),!.

save_edb(Pred, TypeList) :-
	write('Error at storing EDB-Predicate '),
	write(Pred), write(TypeList),
	nl,
	fail.
	
%------------------------------------------------------------------------------
% check_types(+TypeList):
%------------------------------------------------------------------------------
% Checks the types given in TypeList if they are indeed supported.

check_types([]).

check_types([Type|TypeList]) :- 
    type(Type),
    check_types(TypeList),!.
    
check_types([Type|_]) :-
    write('Data type '),
    write(Type),
    write(' is not supported.'), nl,
    fail.
	
%------------------------------------------------------------------------------
% save_idb(+Pred):
%------------------------------------------------------------------------------

% This predicate is called for every predicate in the input program that
% occurs in the head of a rule, which is therefore stored as idb predicate.
% For a predicate identifier only one arity is allowed. 
% Idb predicates and edb predicates are ensured to be disjoint.

save_idb(Idb, _) :-
	functor(Idb, Pred, Arity),
	idb_pred(Pred, Arity),
	!.
	
save_idb(Idb, Line) :-
	functor(Idb, Pred, Arity1),
	idb_pred(Pred, Arity2),
	Arity1 \== Arity2,
	!,
	write('Error in line '),
	write(Line),
	write(': IDB predicate '),
	write(Idb),
	write(' is already defined with arity '),
	write(Arity2),
	nl, fail.
	
save_idb(Idb, Line) :-
	functor(Idb, Pred, _),
	edb_pred(Pred,_),!,
	write('Error in line '),
	write(Line),
	write(': Predicate '),
	write(Pred),
	write(' is already defined as EDB predicate.'),nl,
	fail.

save_idb(Idb,_) :-
	functor(Idb, Pred, Arity),
	\+ edb_pred(Pred,_),	
	\+ idb_pred(Pred,_),
	assertz(idb_pred(Pred,Arity)),
	%if
	(body_pred(Pred,Arity) ->
	    retract(body_pred(Pred,Arity));
	    true	
	),!.

save_idb(Idb, Line) :-
	write('Error in line '),
	write(Line),
	write(' at storing IDB-Predicate '),
	write(Idb),
	nl,
	fail.

%------------------------------------------------------------------------------
% save_answer_pred(+Pred):
%------------------------------------------------------------------------------	

save_answer_pred(Pred, Line) :-
    answer_pred(Pred) ->
        true
    ;
        (answer_pred(Pred2), Pred2 \== Pred ->
            write('Error at storing answer predicate '),
            write(Pred),
            write(' in line '),
            write(Line),
            write(': only one answer predicate allowed.'),
            nl, fail
        ;
            assertz(answer_pred(Pred))
        )
    .

%------------------------------------------------------------------------------
% save_rule(+Internal_Head, +Internal_Body, +Line):
%------------------------------------------------------------------------------

% This predicate stores a rule from the input program in internal format
% in the dynamic database if it is not already there.
% The internal format is 
% rule(FirstBodyLiteral, No, BodyLiterals, Internal_Head)
% where FirstBodyLiteral is a list of the first body literal (empty list for
% empty body),
% No is a unique identifying rule number,
% Internal_Head is the head literal of the rule
% and BodyLiterals is a list of its remaining body literals.
% The rule is already checked for correctness.
	
% This version should do the check for an existing rule.
save_rule(Internal_Head, Internal_Body, _) :-
	copy_term((Internal_Head, Internal_Body), (NewHead, NewBody)),
	%rule([NewFirst], _, NewBody, NewHead,_),
	rule(NewHead, NewBody,_),
	(Internal_Head, Internal_Body) =@= (NewHead, NewBody),	% rule already exists
	!.

save_rule(Internal_Head, Internal_Body,Line) :-
    %rule_no(No),
	assertz(rule(Internal_Head, Internal_Body, Line)), 
	%retract(rule_no(No)),
	%No2 is No+1,
	%assertz(rule_no(No2)),
	!.
	
save_rule(Internal_Head, Internal_Body, Line) :-
	write('Error at storing rule '),
	write(Internal_Head), write(' :- '), write(Internal_Body),
	write(' in line '),
	write(Line),
	nl,
	fail.
	
%------------------------------------------------------------------------------
% parse_head(+Head):
%------------------------------------------------------------------------------

% This predicate checks a head of an input rule for syntactical correctness.
% The head predicate is stored as idb predicate.

parse_head(Head, Line) :-
	callable(Head),
	parse_head_literal(Head),	
	save_idb(Head, Line),!.

parse_head(Head, _) :-
	write('Error at parsing rule head: '),
	write(Head),
	nl,
	fail.
%------------------------------------------------------------------------------
% parse_body(+Body, -BodyList):
%------------------------------------------------------------------------------

% This predicate checks the body of an input rule for correctness
% and translates it into an internal format, which is a list of literals.
% This list is returned in BodyList.

 parse_body(','(Atom,Body), [Atom | BodyList]) :-
	!,
	parse_body_literal(Atom),
	parse_body(Body, BodyList).

%parse_body((Atom1, Atom2), [Atom1, Atom2]) :-
%    !,
%    parse_body_literal(Atom1),
%    parse_body_literal(Atom2).

parse_body(Atom, [Atom]) :-
	parse_body_literal(Atom),!.
    

parse_body(Term, _) :-
	write('Error at parsing rule body: '),
	write(Term),
	nl,
	fail.
	
%------------------------------------------------------------------------------
% parse_query_body(+Body, -BodyList, -BoundList):
%------------------------------------------------------------------------------
	
%parse_query_body(','(Atom,Body), [NewAtom | BodyList], BoundSet) :-
%	!,
%	parse_query_body_literal(Atom, NewAtom, BoundList1),
%	parse_query_body(Body, BodyList, BoundList2),
%	union(BoundList1, BoundList2, BoundSet).

%parse_query_body(Atom, [NewAtom], BoundList) :-
%	callable(Atom),!,	
%	parse_query_body_literal(Atom, NewAtom, BoundList).

%parse_query_body(Term, _, _) :-
%	write('Error at parsing query body: '),
%	write(Term),
%	nl,
%	fail.

%-------------------------------------------------------------------------------
% parse_query(+Query, -InternalQuery, -Bindings):
%-------------------------------------------------------------------------------

% Parsing the query. Parsing is done by calling parse_body. InternalQuery 
% returns the parsed query in the format ([], QueryList) 
% where QueryList is a list of literals.

%parse_query(Query, QueryList, BoundList) :-
%	%term_variables(Query,VarList),
%	%Answer =.. [answer|VarList],
%	parse_query_body(Query, QueryList, BoundList), !
%	.
	
%parse_query(Query, _, _) :-
%	write('Error at parsing query: '),
%	write(Query),
%	nl, fail.
	
%------------------------------------------------------------------------------
% parse_query(+Query, -Query_Pattern, -Cond_Vars, -Cond_Vals):
%------------------------------------------------------------------------------

% parsing the query is a little bit more difficult, because it is influenced
% by the option use_query_const. If this option is yes, we have the simple
% case, when all we need to do is to bind variables in the query to terms of
% the form var(i) with a unique i.
% We also currently support only queries to idb predicates.
% A query to an edb predicate would need no program and no transformation.

%parse_query(Query, Query, [], []) :-
%	use_option(use_query_const, yes),
%	%functor(Query, Pred, Arity),
%	Query =.. [Pred|Args],
%	save_idb(Query),
%	parse_args(Args),
%	rep_vars_args(Args, 0, _).

% If use_query_const is no, we have to replace the constants in the query
% by variables, which are collected in Cond_Vars. The corresponding constants
% are collected in Cond_Vals.
% Note that it is possible that use_query_const is no, but the query contains
% no constants. In this case, we get exactly the same result as if
% use_query_const were yes.

%parse_query(Query, Query_Pattern, Cond_Vars, Cond_Vals) :-
%	use_option(use_query_const, no),
%	functor(Query, Pred, Arity),
%	save_idb(Pred, Arity),
%	Query =.. [Pred|Args],
%	parse_query_args(Args, Internal_Args, Cond_Vars, Cond_Vals),
%	Query_Pattern =.. [Pred|Internal_Args].

%------------------------------------------------------------------------------
% parse_head_literal(+Lit):
%------------------------------------------------------------------------------

% This predicate checks a literal from the head of an input rule for correctness.
% The literal should be callable and its arguments not compound.

parse_head_literal(Lit) :-
	callable(Lit),
	Lit =.. [_|Args],
	%length(Args, Len),
	%((Functor = answer) ->
	%    (answer_pred(answer,Len) ->
	%        true
	%        ;
	%        %else
	%        (\+answer_pred(_,_) ->
	%            assertz(answer_pred(answer, Len))
	%            ;
	%            %else
	%            write('Only one answer predicate allowed.'), nl,
	%            fail
	%        )
	%    );
	%    %else
	%    true
	%),
	maplist(parse_arg, Args), !.
	
parse_head_literal(Lit) :-
	write('Error at parsing literal: '),
	write(Lit),
	nl,
	fail.
	
%------------------------------------------------------------------------------
% parse_body_literal(+Lit):
%------------------------------------------------------------------------------

% This predicate checks a literal from a body of an input rule for correctness.
% The literal should be callable and its arguments not compound, and its predicate
% must not be 'call'.

parse_body_literal(Lit) :-
	callable(Lit),
	Lit =.. [Func|Args],
	(Func \= 'call' ->
	    true
	;
	    write('Error: \'call\' is a reserved word. '),nl
	),
	maplist(parse_arg, Args), 
	length(Args,N),
	length(Args2,N),
	%if
	((\+edb_pred(Func,Args2),\+idb_pred(Func,N), \+body_pred(Func,N)) ->
	    assertz(body_pred(Func,N));
	    true
	),!.
	
parse_body_literal(Lit) :-
	write('Error at parsing literal: '),
	write(Lit),
	nl,
	fail.

%------------------------------------------------------------------------------
% parse_query_body_literal(+Lit, -NewLit, -BindingsSet):
%------------------------------------------------------------------------------
% Similar to parse_body_literal.
	
parse_query_body_literal(Lit, NewLit, BindingsSet) :-
	callable(Lit),
	Lit =.. [Func|Args],
	%Func \= 'answer',
	maplist(parse_query_arg, Args, NewArgs, Bindings),
	NewLit =..[Func|NewArgs],
	flatten(Bindings, BindingsFlat),
	list_to_set(BindingsFlat, BindingsSet),!.
	
parse_query_body_literal(Lit, _, _) :-
	write('Error at parsing query literal: '),
	write(Lit),
	nl,
	fail.

%------------------------------------------------------------------------------
% parse_arg(?Arg):
%------------------------------------------------------------------------------

% We do not allow structured terms, so every argument in the input program
% must be atomic or a variable.

parse_arg(Arg) :-
	atomic(Arg), !.

parse_arg(Arg) :-
	var(Arg), !.

parse_arg(Arg) :-
	write('Error: No structured terms like '),
	write(Arg),
	write(' allowed.'),
	nl, fail.
	
parse_query_arg(Arg, NewArg, [(NewArg, Arg)]) :-
	atomic(Arg), !.

parse_query_arg(Arg, Arg, []) :-
	var(Arg), !.

parse_query_arg(Arg, _, _) :-
	write('Error: No structured terms like '),
	write(Arg),
	write(' allowed.'),
	nl, fail.
	
%------------------------------------------------------------------------------
% print_rules(+Rules)
%
% Pretty printing the parsed rules.
% Rules: list of rules
%------------------------------------------------------------------------------

print_rules([]).
print_rules([(Head, Body)|Rules]) :-
    numbervars((Head, Body),0,_),
    %write(No),
    %write(': '),
    write(Head),
    %if
    (Body = [] ->
        write('.'),nl
        ;
        write(' :- '),
            print_body(Body),
            nl
    ),!,
    print_rules(Rules)
    .
    
print_body([]). 
print_body([Lit|Body]) :-
	write(Lit),
	((Body \= []) ->
		write(', ')
		;
		true
	),!,
	print_body(Body).
