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(directive_handler,[handle_directive/6]).   15
   16:- use_module(library(lists)).   17:- ensure_loaded(pdt_factbase).   18
   19handle_directive(op,Args,Pos,ParentId,FileId,Module):-
   20	!,									% operators
   21	Call =.. [op|Args],
   22	Args = [Precedence, Type, Name],
   23	(	member(Type,[xfx,  xfy, yfx,  yfy])
   24	->	Arity = 2
   25	;	Arity = 1
   26	),
   27	Pos = term_position(From, To, _FFrom, _FTo, _SubPos),
   28	assert_new_node(Call,From,To,Id), 
   29%	directiveT(ParentId,FileId,Module),			
   30	assert(operatorT(Id,ParentId,FileId,Module,Name,Arity,Type,Precedence)),
   31	call(Call).
   32
   33handle_directive(assert,[file_search_path(Name,Path)],_Pos, ParentId,_FileId,_Module):-
   34    !,				
   35	assert(	file_search_path(Name,Path)),
   36    Path =.. [OtherLib|NewPath],				
   37    (	NewPath == []		
   38    ->	LibDir = Path
   39    ;	(	file_search_path(OtherLib,OtherPath),     % <-- das kann schiefgehen, wenn noch nicht bekannt!!!!!
   40    		atom_concat(OtherPath,'/',OtherDir),	  % evtl. die relative Library speichern? Prolog macht es ja auch relativ
   41    		atom_concat(OtherDir,NewPath,LibDir)	
   42    	)
   43    ),
   44    assert(library_dir(Name,LibDir,ParentId)).		 
   45handle_directive(Other, Args,_Pos, ParentId, _FileId, _Module):-
   46   categorize_directive(Other,Args,ParentId).
   47   
   48   
   49    															%TODO: es k�nnen mehrere Anweisungen in einer Direktiven-Klausel sein.
   50categorize_directive(load_files,Args,ParentId):-									
   51    !,												%TODO: Test this
   52    nth1(1,Args,Files),	
   53	(	nth1(2,Args,SomeArgs)
   54	->	(	member(imports(Imports),SomeArgs),
   55			(	member(reexport(true),SomeArgs)
   56			->	assert(export_dir(Files,ParentId))
   57    		;	true
   58    		)
   59		)
   60	;	Imports=[]							
   61	),									
   62    assert(load_dir(ParentId,Files,Imports)).
   63categorize_directive(module,[NewModule, Exports],ParentId):-
   64    !,
   65    nb_setval(module_to_parse, NewModule),
   66    assert(export_dir(Exports,ParentId)).		
   67categorize_directive(use_module,Args,ParentId):-
   68	!,			
   69	nth1(1,Args,Files),	
   70	(	nth1(2,Args,Imports)
   71	;	Imports = all							
   72	),			
   73	assert(load_dir(ParentId,Files,Imports)).
   74categorize_directive(ensure_loaded,Args,ParentId):-
   75	!,					
   76	assert(load_dir(ParentId,Args,all)).			
   77categorize_directive(export,Args,ParentId):-
   78    !,
   79    assert(export_dir(Args,ParentId)).
   80categorize_directive(reexport,Args,ParentId):-
   81    !,
   82    nth1(1,Args,Files),	
   83	(	(	nth1(2,Args,Imports), ! )
   84	;	Imports = all
   85	),
   86    assert(load_dir(ParentId,Files,Imports)),
   87    assert(export_dir(reexport(ParentId,Imports),ParentId)).					
   88categorize_directive(import,Args,ParentId):-
   89    !,															% <-- muss behandlet werden
   90    assert(import_dir(Args,ParentId)).
   91categorize_directive(Functor,Args,ParentId):-				% kann das evtl mit use_module zusammen?
   92    (	Functor == consult
   93    ;	Functor == include				
   94    ;	Functor == '.'		
   95    ),										
   96    !,
   97    assert(load_dir(ParentId,Args,all)).
   98categorize_directive(Functor,Args,ParentId):-
   99    (	Functor == (multifile)
  100    ;   Functor == (dynamic)
  101    ;	Functor == (module_transparent)
  102    ;	Functor == (discontiguous)
  103    ;	Functor == (meta_predicate)
  104    ),
  105    !,
  106    assert(property_dir(ParentId,Functor,Args)).
  107/*categorize_directive(Functor,_Args,_ParentId,):-
  108 %   assert(other_dir(FileId,Args,ParentId,Pos)).        <-- hier evtl noch ausbauen bzw etwas speichern    
  109   writeln(Functor).*/
  110categorize_directive(_Functor,_Args,_ParentId)