% 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).