1%-------------------------------------------------------------
    2% parser RuleML
    3% Marco Gavanelli
    4% 11 May 2006
    5% This is for RuleML 0.9
    6%-------------------------------------------------------------
    7
    8:-module(ruleml_parser,
    9	 [save_ics_ruleml/1,
   10	 ruleml_parse_file/3,
   11	 ruleml_parse/3]).   12
   13:- use_module(library(terms)).   14:- use_module(library(lists)).   15:- use_module(parser_utils).   16:- use_module(debug).   17:- use_module(library(xml)).   18
   19
   20save_ics_ruleml(FileName):-
   21    consult(ics),
   22    findall(ic(Body,Head),ics(Body,Head),ICList),
   23    numbervars(ICList,1,_),
   24    ruleml_parse(XML,xml,ICList),
   25    ground_options(XML),
   26    xml_parse(FileString,XML),
   27    open(FileName,write,Stream),
   28    write_file(Stream,FileString),
   29    close(Stream).
   30    
   31
   32ruleml_parse_file(FileName,ICList,Error):-
   33    read_file_to_string(FileName,FileString),
   34    xml_parse(FileString,XML),
   35%    xml_parse(Back,XML),
   36    (XML = xml(_,[X])
   37        ->  (X=pcdata(_)
   38                -> Error = no_ruleml
   39                ;  ruleml_parse(XML,xml,ICList), Error=[]
   40            )
   41        ;   Error = no_ruleml
   42    ).
   43
   44
   45
   46
   47ruleml_parse(xml(_,[L]),xml,ICList):- ruleml_parse(L,ruleml,ICList).
   48ruleml_parse(element('RuleML',_,[L]),ruleml,ICList):- ruleml_parse(L,assert,ICList).
   49ruleml_parse(element('Assert',_,L),assert,ICList):- ruleml_parse(L,implies_list,ICList).
   50
   51ruleml_parse(element('Implies',_,[element(body,_,[BodyX]),element(head,_,[HeadX])]),implies,IC):-
   52    IC = ic(Body,Head), 
   53    ruleml_parse(BodyX,conjunct,Body),
   54    ruleml_parse(HeadX,head,Head),!.
   55ruleml_parse(element('Implies',_,[element(head,_,[HeadX]),element(body,_,[BodyX])]),implies,IC):-
   56    IC = ic(Body,Head), 
   57    ruleml_parse(BodyX,conjunct,Body),
   58    ruleml_parse(HeadX,head,Head).
   59
   60
   61
   62ruleml_parse(element('Or',_,L),head,List):-
   63    List = [_,_|_], % OR must have at least two arguments
   64    ruleml_parse(L,disjunctlist,List).
   65ruleml_parse(RuleML,head,[List]):-
   66    ruleml_parse(RuleML,conjunct,List).
   67
   68ruleml_parse([],disjunctlist,[]).
   69ruleml_parse([H|T],disjunctlist,[A|R]):-
   70    ruleml_parse(H,conjunct,A),
   71    ruleml_parse(T,disjunctlist,R).
   72
   73ruleml_parse(element('And',_,L),conjunct,List):-
   74    List = [_,_|_], % And must have at least two arguments
   75    ruleml_parse(L,atomlist,List).
   76ruleml_parse(RuleML,conjunct,[Atom]):-
   77    ruleml_parse(RuleML,atom,Atom).
   78
   79
   80ruleml_parse([],atomlist,[]).
   81ruleml_parse([H|T],atomlist,[A|R]):-
   82    ruleml_parse(H,atom,A),
   83    ruleml_parse(T,atomlist,R).
   84
   85% Explicit Negation: if an atom is requested, but it starts with <Neg>
   86% then, produce a negated atom
   87ruleml_parse(XML,atom,Atom):- % XML -> IC
   88    % The negated atom may be optionally surrounded by a <strong> role
   89    ( XML = element('Neg',_,[element('Atom',_,[Rel|Args])])
   90    ; XML = element(strong,_,[element('Neg',_,[element('Atom',_,[Rel|Args])])])
   91    ),
   92    nonvar(Rel),!,
   93    ruleml_parse(Rel,rel,Fun),
   94    ruleml_parse(Args,termlist,AtomArgs),
   95    neg_functor(Fun,NegFun),
   96    Atom =.. [NegFun|AtomArgs].
   97% Default Negation: if an atom is requested, but it starts with <Naf>
   98% then, produce a negated atom
   99ruleml_parse(XML,atom,Atom):- % XML -> IC
  100    % The negated atom may be optionally surrounded by a <strong> role
  101    ( XML = element('Naf',_,[element('Atom',_,[Rel|Args])])
  102    ; XML = element(weak,_,[element('Naf',_,[element('Atom',_,[Rel|Args])])])
  103    ),
  104    nonvar(Rel),!,
  105    ruleml_parse(Rel,rel,Fun),
  106    ruleml_parse(Args,termlist,AtomArgs),
  107    naf_functor(Fun,NegFun),
  108    Atom =.. [NegFun|AtomArgs].
  109% Positive atom
  110ruleml_parse(element('Atom',_,[Rel|Args]),atom,Atom):- % XML -> IC
  111    nonvar(Rel),!,
  112    ruleml_parse(Rel,rel,Fun),
  113    ruleml_parse(Args,termlist,AtomArgs),
  114    Atom =.. [Fun|AtomArgs].
  115% Negated atom
  116ruleml_parse(element('Neg',_,[element('Atom',_,[Rel|Args])]),atom,Atom):- % IC -> XML
  117    nonvar(Atom),
  118    Atom =.. [NegFun|AtomArgs],
  119    neg_functor(Fun,NegFun),!,
  120    ruleml_parse(Rel,rel,Fun),
  121    ruleml_parse(Args,termlist,AtomArgs).
  122ruleml_parse(element('Naf',_,[element('Atom',_,[Rel|Args])]),atom,Atom):- % IC -> XML
  123    nonvar(Atom),
  124    Atom =.. [NegFun|AtomArgs],
  125    naf_functor(Fun,NegFun),!,
  126    ruleml_parse(Rel,rel,Fun),
  127    ruleml_parse(Args,termlist,AtomArgs).
  128ruleml_parse(element('Atom',[],[Rel|Args]),atom,Atom):- % IC -> XML
  129    nonvar(Atom),
  130    Atom =.. [Fun|AtomArgs],
  131    ruleml_parse(Rel,rel,Fun),
  132    ruleml_parse(Args,termlist,AtomArgs).
  133
  134ruleml_parse([],termlist,[]).
  135ruleml_parse([H|T],termlist,[A|R]):-
  136    ruleml_parse(H,term,A),
  137    ruleml_parse(T,termlist,R).
  138
  139ruleml_parse(element('Var',_,[pcdata(String)]),term,VarName):- % variable
  140    nonvar(String),
  141    atom_codes(VarName,String).
  142ruleml_parse(element('Var',[],[pcdata(String)]),term,VarName):- % variable
  143    nonvar(VarName), VarName='$VAR'(N),
  144    number_codes(N,C2),
  145    atom_codes('X',C1),
  146    append(C1,C2,String).
  147ruleml_parse(element('Ind',_,[pcdata(String)]),term,Constant):- % constant
  148    (atomic(Constant); nonvar(String)),!,
  149    atom_codes(Constant,String).
  150ruleml_parse(element('Cterm',_,[Ctor|Args]),term,Term):- %complex term, XML -> IC
  151    nonvar(Ctor),
  152    ruleml_parse(Ctor,ctor,Fun),
  153    ruleml_parse(Args,termlist,AtomArgs),
  154    Term =.. [Fun|AtomArgs].
  155ruleml_parse(element('Cterm',[],[Ctor|Args]),term,Term):- %complex term, IC -> XML
  156    nonvar(Term), Term =.. [Fun|AtomArgs],
  157    ruleml_parse(Ctor,ctor,Fun),
  158    ruleml_parse(Args,termlist,AtomArgs).
  159
  160
  161ruleml_parse(element('Rel',_,Functor),rel,Fconv):- % the functor of an atom
  162    ruleml_parse(Functor,functor_rel,Fconv).
  163ruleml_parse(element(op,_,[element('Rel',_,Functor)]),rel,Fconv):- % the functor of an atom: op is optional
  164    ruleml_parse(Functor,functor_rel,Fconv).
  165
  166ruleml_parse(element('Ctor',_,Functor),ctor,Fconv):- % the functor of a term
  167    ruleml_parse(Functor,functor,Fconv).
  168ruleml_parse(element(op,_,[element('Ctor',_,Functor)]),ctor,Fconv):- % the functor of a term: op is optional
  169    ruleml_parse(Functor,functor,Fconv).
  170
  171ruleml_parse(Functor,functor_rel,Fconv):-
  172    Functor = [pcdata(F)],
  173    (nonvar(F)
  174       ->   atom_codes(Fun,F),
  175            conv_fun(Fun,Fconv)
  176        ;   conv_fun(Fun,Fconv),
  177            atom_codes(Fun,F)
  178    ).
  179            
  180
  181ruleml_parse(Functor,functor,Fconv):-
  182    Functor = [pcdata(F)],
  183    atom_codes(Fconv,F).
  184
  185ruleml_parse([],implies_list,[]).
  186ruleml_parse([X|T],implies_list,[IC1|ICList]):-
  187    ruleml_parse(X,implies,IC1),
  188    ruleml_parse(T,implies_list,ICList).
  189
  190
  191
  192/*
  193ruleml_parse([],_,[]).
  194ruleml_parse([X|T],A,ICList):-
  195    ruleml_parse(X,A,IC1),
  196    ruleml_parse(T,A,IC2), append(IC1,IC2,ICList).
  197*/
  198
  199ruleml_parse(comment(X),_,[]):- nonvar(X). % so it does not insert comments in the ICS->XML
  200ruleml_parse(namespace(_,_,L),X,ICList):- ruleml_parse(L,X,ICList).
  201
  202
  203
  204conv_fun('E',e):- !.
  205conv_fun('EN',en):- !.
  206conv_fun('H',h):- !.
  207conv_fun('!H',noth):- !.
  208conv_fun('!E',note):- !.
  209conv_fun('!EN',noten):- !.
  210conv_fun(X,X).
  211
  212% Conversion, in SCIFF internal syntax, of a functor and the
  213% corresponding functor for explicit negation
  214% If a functor is not reported here, then it cannot be used with explicit negation
  215neg_functor(e,note):-!.
  216neg_functor(en,noten):-!.
  217
  218% same as neg_functor, but for negation as failure
  219naf_functor(h,noth).
  220
  221ground_options(T):- term_variables(T,V), ground_vars(V).
  222ground_vars([]).
  223ground_vars([[]|T]):- ground_vars(T).
  224/*
  225ground_options(X):- ground(X),!.
  226ground_options(element(_,X,_)):- var(X),!,X=[].
  227ground_options([H|T]):-
  228*/
  229
  230write_file(_,[]).
  231write_file(Stream,[C|T]):-
  232    put_code(Stream,C),
  233    write_file(Stream,T)