1/*****************************************************************************
    2 * This file is part of the Prolog Development Tool (PDT)
    3 * 
    4 * WWW: http://sewiki.iai.uni-bonn.de/research/pdt/start
    5 * Mail: pdt@lists.iai.uni-bonn.de
    6 * Copyright (C): 2004-2012, CS Dept. III, University of Bonn
    7 * 
    8 * All rights reserved. This program is  made available under the terms
    9 * of the Eclipse Public License v1.0 which accompanies this distribution,
   10 * and is available at http://www.eclipse.org/legal/epl-v10.html
   11 * 
   12 ****************************************************************************/
   13
   14:- module(literal_parser, [parse_bodies/0]).   15
   16:- use_module('analyzer/metafile_referencer').   17:- use_module(library(lists)).   18:- ensure_loaded(parse_util).   19
   20%Todo: Kommentar verfassen
   21/*parse_bodies:-				%TODO: wieder zum laufen bringen!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   22	clauseT(ClauseId,_,_,_,_),
   23		termT(ClauseId,ClauseTerm),							% no directives considered
   24		ClauseTerm = (_Head :- Body),						% facts without a body will not be considered
   25		pos_and_vars(ClauseId,BodyPos,VarNames),
   26		parse_body_literals(Body, BodyPos, ClauseId, ClauseId, Module, VarNames),
   27		retract(pos_and_vars(ClauseId,BodyPos,VarNames)),
   28		fail.*/
   29parse_bodies:-				%TODO: wieder auf Files einschr�nken!!!!!!!!!!
   30	pos_and_vars(ClauseId,BodyPos,VarNames),
   31		termT(ClauseId,ClauseTerm),
   32		(	(	ClauseTerm = (_Head :- Body),
   33				clauseT(ClauseId,_,Module,_,_)
   34			)
   35		;	(	ClauseTerm = (:- Body),
   36				directiveT(ClauseId,_,Module)
   37			)
   38		),
   39		parse_body_literals(Body, BodyPos, ClauseId, ClauseId, Module, VarNames),
   40		retract(pos_and_vars(ClauseId,BodyPos,VarNames)),
   41		fail.
   42parse_bodies.
   43
   44
   45parse_body_literals(Module:Literal, Pos, _ParentId, ClauseId, _OrigModule, VarNames) :-
   46    !, 
   47    Pos = term_position(From, To, _FFrom, _FTo, SubPos),
   48    SubPos = [ModuleFrom-ModuleTo, LiteralPos],
   49	assert_new_node(Module:Literal,From,To,Id),   %<===  
   50    assert_new_node(Module,ModuleFrom,ModuleTo,_MId),
   51    parse_body_literals(Literal, LiteralPos, Id, ClauseId, Module, VarNames).				%<--Achtung hier stimmt die Parent-Kette nicht!!!! 
   52/*****
   53* ToDo: What does I have to assert from all the above?
   54******/
   55   
   56parse_body_literals([A|B], Pos, _ParentId, _ClauseId, _Module, _VarNames) :- 
   57   !,
   58   Pos = list_position(From, To, _ElemPos, _TailPos),		
   59   assert_new_node([A|B],From,To,_Id).		
   60   	
   61/*
   62* ToDo: list elemens should be visited!!!!
   63**/
   64
   65/*
   66* ToDo: edge-references for meta-literals
   67**/
   68parse_body_literals('$VAR'(_A), _Pos, _ParentId, _ClauseId, _Module, _VarNames) :- 
   69	!. 
   70%	Pos = From - To.
   71%	assert_new_node('$Var'(A),From,To,_Id).    %<===
   72/*
   73* ToDo: is that all that should happening for Variables?
   74**/  							
   75  
   76/*parse_body_literals(Body, Pos, ParentId, ClauseId, Module, VarNames) :- 
   77	atom(Body), 
   78	!, 
   79	Pos = From - To,
   80	assert_new_node(Body,From,To,Id),  %<===
   81   	functor(Body,Functor,Arity),
   82    assert(literalT(Id,ParentId,ClauseId,Functor,Arity)).  							
   83*/   	
   84
   85   
   86parse_body_literals(Body, Pos, ParentId, ClauseId, Module, VarNames) :- 
   87   	%xref:is_metaterm(Body, MetaArguments),
   88   	catch(	
   89   		metafile_referencer:is_metaterm(Module, Body, MetaArguments),
   90   		_,
   91   		true
   92   	),
   93   	!, 
   94   	Pos = term_position(From, To, _FFrom, _FTo, SubPos),
   95   	assert_new_node(Body,From,To,Id),   %<===
   96   	functor(Body,Functor,Arity),
   97    assert(literalT(Id,ParentId,ClauseId,Module,Functor,Arity)),
   98    assert(metaT(Id,ParentId,ClauseId,Module,Functor,Arity)),
   99	forall( member(Meta, MetaArguments), 
  100           process_meta_argument(Meta, SubPos, Id, ClauseId, Module, VarNames)			
  101   	).		
  102  
  103parse_body_literals(Literal, Pos, ParentId, ClauseId, Module, _VarNames) :- 
  104	% Phuuu, finally a simple literal:
  105	% Store it! 
  106	(	Pos = term_position(From, To, _FFrom, _FTo, _SubPos)
  107   	;	Pos = From - To
  108   	),
  109	assert_new_node(Literal,From,To,Id),   %<===
  110	functor(Literal,Functor,Arity),
  111    assert(literalT(Id,ParentId,ClauseId,Module,Functor,Arity)),
  112    assert(lirteralT_ri(Functor,Arity,Module,Id)).
  113    %assert(pos_and_vars(Id,_SubPos,VarNames)).
  114
  115process_meta_argument( (Nr,MetaTerm), Pos, ParentId, ClauseId, Module, VarNames) :- 
  116    nth1(Nr,Pos,TermPos),
  117    parse_body_literals(MetaTerm, TermPos, ParentId, ClauseId, Module, VarNames)