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(preparser, [parse/1, parse/2]).   15
   16:- ensure_loaded(parse_util).   17:- use_module(directive_handler).   18 
   19/*
   20 * parse(?File)
   21 * 	opens a stream to the file Arg1, tries to parse it as a prolog program and
   22 * 	closes the stream afterwards. 
   23 */
   24parse(File):-
   25    open(File,read,InStream),
   26    parse(File,InStream),
   27    close(InStream).
   28      
   29/*
   30 * parse(+File, +InStream)
   31 * 	creates some unic facts for the file Arg1 and starts the parsing of the
   32 * 	clauses contained in the stream Arg2 (which should be one to the file Arg1).
   33 */          
   34parse(File,InStream):-
   35    new_node_id_pdt(Id),	
   36    nb_setval(module_to_parse, user),
   37    parse_clauses(InStream,Id),
   38    nb_getval(module_to_parse,ActualModule),
   39    assert(fileT(Id,File,ActualModule)),    
   40    assert(fileT_ri(File,Id)).
   41
   42/*
   43 * parse_clause(+InStream,+FileId)
   44 *	  reads the first term from Arg1 if it is not EoF,
   45 *    parses possible subterms recursively and asserts some unic facts about the term.
   46 */
   47parse_clauses(InStream,FileId):-
   48    repeat,
   49    	catch(
   50        	read_term(InStream,Clause,
   51            	[   %term_position(Pos),        % output
   52              		subterm_positions(SubPos), % output
   53%                	module(CurrentModule),      % input
   54%                	singletons(Singletons),     % output
   55                	variable_names(VarNames)   % output
   56            	]),
   57        	error(Error,Context),
   58        	( assert(error(Error,Context,FileId)),  % <<<<
   59          	fail											%ToDo: eventually change this
   60        	)  
   61    	),  
   62     	(   Clause==end_of_file
   63    	->  true
   64    	;   nb_getval(module_to_parse,Module),
   65        	numbervars(VarNames,0,_),
   66        	parse_clause_elements(Clause,SubPos,FileId,VarNames,Module),
   67 %       	assert(node_attr(ClauseId,singletons,Singletons))   
   68 			fail
   69    	),
   70    !.
   71/*
   72 * ToDo: safe singeltons if needed,
   73 *       rewrite discription
   74 */
   75    
   76/*
   77 * parse_clause_elements(+Term,+Pos,+Parent,+VarNames,+Module)
   78 *    parses the term given in Arg1 to PEFs. The term has to be a clause.
   79 *    If it is a
   80 *    -  directive, a directiveT is defined and its body is parsed.
   81 *    -  fact, a clauseT is defined
   82 *    -  rule, a clauseT and a headT are defined, 
   83 *			its body is stored to be parsed later on.
   84 *	  Head elements are parsed with parse_head_literals/5.
   85 *    Body elements can later be parsed with parse_body_literals/6, 
   86 *
   87 *    Additionally the remaining arguments are used to define filePosTs for the
   88 *    corresponding position information.
   89 **/
   90parse_clause_elements((:- Body), Pos, FileId, VarNames, UnchangedModule) :- % Directive
   91   	!, 
   92   	Pos = term_position(From, To, _FFrom, _FTo, [SubPos]),
   93   	assert_new_node( :- Body,From,To,DirectiveId), 
   94   	Body =..[Functor|Args],
   95   	handle_directive(Functor,Args,SubPos,DirectiveId,FileId,UnchangedModule),
   96   	nb_getval(module_to_parse,Module),
   97   	assert(directiveT(DirectiveId,FileId,Module)),
   98   	Body =.. [Functor|Args],
   99 	assert(pos_and_vars(DirectiveId,SubPos,VarNames)).
  100   
  101parse_clause_elements((Head :- Body), Pos, FileId, VarNames, Module) :-  % Rule
  102	!, 
  103	Pos = term_position(From, To, _FFrom, _FTo, SubPos),
  104 	SubPos = [HeadPos, BodyPos], 
  105	assert_new_node(Head :- Body,From,To,ClauseId),  
  106	functor(Head,Functor,Arity),
  107    assert(clauseT(ClauseId,FileId,Module,Functor,Arity)),
  108	assert(pos_and_vars(ClauseId,BodyPos,VarNames)),
  109    parse_head_literal(Head, HeadPos, ClauseId, Module, VarNames).
  110
  111parse_clause_elements(Head, Pos, FileId, VarNames, Module) :-   % Fact
  112   	!, 					
  113   	(	Pos = term_position(From, To, _FFrom, _FTo, _SubPos)
  114   	;	Pos = From - To
  115   	),
  116   	assert_new_node(Head,From,To,ClauseId), 
  117	functor(Head,Functor,Arity),
  118    assert(clauseT(ClauseId,FileId,Module,Functor,Arity)),
  119    parse_head_literal(Head, Pos, ClauseId, Module, VarNames).    
  120 
  121 
  122 
  123 
  124parse_head_literal(Module:Head, Pos, ClauseId, _OrigModule, _VarNames) :-
  125    !,
  126    Pos = term_position(From, To, _FFrom, _FTo, _SubPos),
  127 %   SubPos = [ModuleFrom-ModuleTo, HeadPos],
  128   	assert_new_node(Module:Head,From,To,Id),   %<===   
  129   	functor(Head,Functor,Arity),
  130   	assert(headT(Id,ClauseId,Module,Functor,Arity)).    
  131
  132/******** 
  133 * Eva: Was genau soll in dem Fall da oben gespeichert werden?
  134 ********/
  135   	
  136parse_head_literal(Head, Pos, ClauseId, Module, _VarNames) :-
  137   	(	Pos = term_position(From, To, _FFrom, _FTo, _SubPos)
  138   	;	Pos = From - To
  139   	),
  140   	assert_new_node(Head,From,To,Id),   %<===   
  141   	functor(Head,Functor,Arity),
  142   	assert(headT(Id,ClauseId,Module,Functor,Arity))