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(graphML_api,[ prepare_for_writing/2,
   15						finish_writing/1,
   16						write_file/5,
   17						write_call_edge/8,
   18						write_load_edge/4,
   19						write_load_edge/5,
   20						write_predicates/3,
   21						write_file_as_element/7,
   22						write_file_as_element/8]).   23
   24:- use_module(util_for_graphML).   25:- use_module(pdt_common_pl('metainference/pdt_meta_specification')).   26:- use_module(pdt_common_pl('callgraph/pdt_call_graph')).   27:- use_module(library(lists), [member/2]).   28
   29prepare_for_writing(File,OutStream):-
   30	reset_id_translation,
   31    open(File,write,OutStream,[type(text)]),
   32    write_graphML_header(OutStream),
   33    write_graphML_ast_keys(OutStream),
   34    start_graph_element(OutStream),
   35    flush_output(OutStream).
   36  
   37finish_writing(OutStream):-
   38    close_graph_element(OutStream),
   39    write_graphML_footer(OutStream),
   40    close(OutStream).
   41    
   42write_file(Stream, _RelativePath, Filters, FilePath, Module) :-
   43	get_id(FilePath, Id),
   44	open_node(Stream, Id),
   45	write_data(Stream, 'id', Id),
   46	directory_file_path(_, FileName, FilePath),
   47	%file_name_extension(Name, _, FileName), 
   48	write_data(Stream, 'label', FileName),
   49	write_data(Stream,'fileName', FilePath),
   50	write_data(Stream,'module',Module),	
   51	(	Module=user
   52	->	write_data(Stream,'kind','file')
   53	;	write_data(Stream,'kind','module')
   54	),
   55	start_graph_element(Stream),
   56	write_predicates(Stream, FilePath, Filters),
   57	close_graph_element(Stream),
   58	close_node(Stream).	
   59
   60		
   61write_predicates(Stream, File, Filters):-
   62	forall(	(	predicate_in_file(File, Module, Name, Arity),
   63	
   64				/* Filtering */
   65				forall(member(M:F, Filters), (C =.. [F, Module:Name/Arity], call(M:C))),
   66				 
   67				first_line_of_predicate_in_file(Module, Name, Arity, File, Line)
   68			),
   69			(	write_predicate(Stream, File, Module, Name, Arity, Line),
   70				flush_output(Stream)
   71			)
   72	).	
   73    
   74write_file_as_element(Stream, FileId, FilePath, ModuleName, FileType, ExportedStaticPredicates, ExportedDynamicPredicates) :-
   75	write_file_as_element(Stream, FileId, FilePath, ModuleName, FileType, ExportedStaticPredicates, ExportedDynamicPredicates, _).
   76
   77write_file_as_element(Stream, FileId, FilePath, ModuleName, FileType, ExportedStaticPredicates, ExportedDynamicPredicates, StereoType) :-
   78    open_node(Stream,FileId),
   79    write_data(Stream,'kind','file_node'),
   80    write_data(Stream,'id',FileId),
   81    write_data(Stream,'file_node_name', ModuleName),
   82    write_data(Stream,'file_node_path', FilePath),
   83    write_data(Stream, 'file_node_type', FileType),
   84    write_data(Stream, 'exported_static_predicates', ExportedStaticPredicates),
   85    write_data(Stream, 'exported_dynamic_predicates', ExportedDynamicPredicates),
   86    (	nonvar(StereoType)
   87    ->	write_data(Stream, 'node_stereotype', StereoType)
   88    ;	true
   89    ),
   90    close_node(Stream).	
   91    
   92write_predicate(Stream, File, Module, Name, Arity, Line):-
   93    get_id(File-Module:Name/Arity, Id),
   94    open_node(Stream, Id),
   95    write_data(Stream, 'kind', 'predicate'),
   96    write_data(Stream, 'id', Id),
   97	write_data(Stream, 'functor', Name),
   98	write_data(Stream, 'arity', Arity),	
   99	write_data(Stream, 'moduleOfPredicate', Module),
  100	write_data(Stream, 'fileName', File),
  101	write_data(Stream, 'lineNumber', Line),
  102	functor(Head, Name, Arity),	
  103	(	predicate_property(Module:Head, dynamic)
  104	->	write_data(Stream, 'isDynamic', 'true')
  105	;	true
  106	),
  107	(	predicate_property(Module:Head, transparent)
  108	->	write_data(Stream, 'isTransparent', 'true')
  109	;	true
  110	),	
  111	(	predicate_property(Module:Head, multifile)
  112	->	write_data(Stream, 'isMultifile', 'true')
  113	;	true
  114	),		
  115	(	(	predicate_property(Module:Head, meta_predicate(_)), MetaType = meta
  116		;	extended_meta_predicate(Module:Head, _), MetaType = extended
  117		;	pdt_prolog_metainference:inferred_meta_pred(Head, Module, _), MetaType = inferred
  118		)
  119	->	(
  120			write_data(Stream, 'isMetaPredicate', 'true'),
  121			write_data(Stream, 'metaPredicateType', MetaType)
  122		)
  123	;	true
  124	),	
  125	(	exported_predicate(Module, Head)
  126	->	write_data(Stream, 'isExported', 'true')
  127	;	true
  128	),	
  129	(	locally_dead_predicate(Module, Name, Arity)
  130	->	write_data(Stream, 'isUnusedLocal', 'true')
  131	;	true
  132	),	
  133	
  134/*	start_graph_element(Stream),
  135	write_clauses(Stream,FileName),
  136	close_graph_element(Stream),
  137*/	close_node(Stream).
  138
  139    
  140write_load_edge(Stream, LoadingFileId, FileId, Imported) :-
  141	write_load_edge(Stream, LoadingFileId, FileId, Imported, _).
  142
  143write_load_edge(Stream, LoadingFileId, FileId, Imported, Label) :-
  144    open_edge(Stream, FileId, LoadingFileId),
  145    write_data(Stream, 'kind', 'loading'),
  146    write_data(Stream, 'imported_predicates', Imported),
  147    (	nonvar(Label)
  148    ->	write_data(Stream, 'label', Label)
  149    ;	true
  150    ),
  151    %write_data(Stream, 'kind', 'call'),
  152	close_edge(Stream).
  153    
  154write_call_edge(Stream, SourceModule, SourceName, SourceArity, TargetModule, TargetName, TargetArity, DependentFiles) :-
  155	functor(SourceHead, SourceName, SourceArity),
  156	(	predicate_property(SourceModule:SourceHead, multifile)
  157	->	calls_multifile(TargetModule, TargetName, TargetArity, SourceModule, SourceName, SourceArity, SourceFile, NumberOfCalls)
  158	;	calls(TargetModule, TargetName, TargetArity, SourceModule, SourceName, SourceArity, NumberOfCalls),
  159		predicate_property(SourceModule:SourceHead, file(SourceFile))
  160	),
  161	once(member(SourceFile, DependentFiles)),
  162	file_of_predicate(TargetModule, TargetName, TargetArity, TargetFile),
  163	once(member(TargetFile, DependentFiles)),
  164	has_id(SourceFile-SourceModule:SourceName/SourceArity, Source),
  165	has_id(TargetFile-TargetModule:TargetName/TargetArity, Target),
  166    open_edge(Stream, Source, Target),
  167    write_data(Stream, 'kind', 'call'),
  168    write_data(Stream, 'frequency', NumberOfCalls),
  169    write_data(Stream, 'fileName', SourceFile),
  170    write_call_metadata(Stream, TargetModule, TargetName, TargetArity, SourceModule, SourceName, SourceArity),
  171	close_edge(Stream),
  172	fail.
  173write_call_edge(_, _, _, _, _, _, _, _).
  174    
  175write_call_metadata(Stream, TargetModule, TargetName, TargetArity, SourceModule, SourceName, SourceArity) :-
  176	call_type(TargetModule, TargetName, TargetArity, SourceModule, SourceName, SourceArity, Info),
  177    write_call_metadata(Stream, Info), !.
  178write_call_metadata(_, _, _, _, _, _, _).
  179    
  180write_call_metadata(_Stream, call).
  181write_call_metadata(Stream, database(Meta, I)) :-
  182	write_data(Stream, 'metadata', database),
  183	write_edge_label(Stream, Meta, I).
  184	
  185write_call_metadata(Stream, metacall(Meta, I)) :-
  186	write_data(Stream, 'metadata', metacall),
  187	write_edge_label(Stream, Meta, I).
  188	
  189write_call_metadata(Stream, metacall(Meta, I, _)) :-
  190	write_data(Stream, 'metadata', metacall),
  191	write_edge_label(Stream, Meta, I).
  192	
  193write_edge_label(Stream, Meta, I) :-
  194	Meta =.. [F|Args],
  195	format_arg_terms(Args, I, NewArgs),
  196	Label =.. [F|NewArgs],
  197	write_data(Stream, 'label', Label).
  198	
  199format_arg_terms([], _, []).
  200format_arg_terms([H|T], 1, [R|T2]) :- !, 
  201	H =.. [F|Args],
  202	format_arg_terms(Args, 0, NewArgs),
  203	R =.. [F|NewArgs],
  204	format_arg_terms(T, 0, T2).
  205format_arg_terms([_|T], 0, ['...'|T2]) :- format_arg_terms(T, 0, T2).
  206format_arg_terms([_|T], I, ['...'|T2]) :- I2 is I - 1, format_arg_terms(T, I2, T2).	
  207	
  208write_graphML_header(OutStream):-
  209	write(OutStream,'<?xml version="1.0" encoding="UTF-8"?>'), nl(OutStream),
  210	write(OutStream,'<graphml xmlns="http://graphml.graphdrawing.org/xmlns"  
  211      xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
  212      xsi:schemaLocation="http://graphml.graphdrawing.org/xmlns http://graphml.graphdrawing.org/xmlns/1.0/graphml.xsd">'), 
  213	nl(OutStream).
  214	
  215write_graphML_ast_keys(OutStream):-
  216    write(OutStream, '<key id="id" for="node" attr.name="id" attr.type="string"/>'),
  217    nl(OutStream),
  218    write(OutStream, '<key id="kind" for="all" attr.name="kind" attr.type="string"/>'),
  219    nl(OutStream),
  220  	write(OutStream, '<key id="metadata" for="all" attr.name="metadata" attr.type="string" />'),
  221  	nl(OutStream),
  222    write(OutStream, '<key id="fileName" for="all" attr.name="fileName" attr.type="string"/>'),
  223    nl(OutStream),
  224    write(OutStream, '<key id="label" for="all" attr.name="label" attr.type="string" />'),
  225  	nl(OutStream),
  226    write(OutStream, '<key id="lineNumber" for="all" attr.name="lineNumber" attr.type="int">'),
  227    nl(OutStream),
  228  	write(OutStream, '    <default>-1</default>'),
  229  	nl(OutStream),
  230  	write(OutStream, '</key>'),
  231    nl(OutStream),
  232    write(OutStream, '<key id="offset" for="all" attr.name="offset" attr.type="string"/>'),
  233    nl(OutStream),
  234    write(OutStream, '<key id="file_node_name" for="node" attr.name="file_node_name" attr.type="string"/>'),
  235    nl(OutStream),
  236    write(OutStream, '<key id="file_node_path" for="node" attr.name="file_node_path" attr.type="string"/>'),
  237    nl(OutStream),
  238    write(OutStream, '<key id="file_node_type" for="node" attr.name="file_node_type" attr.type="string"/>'),
  239    nl(OutStream),
  240    write(OutStream, '<key id="module" for="node" attr.name="module" attr.type="string">'),
  241    nl(OutStream),
  242  	write(OutStream, '    <default>user</default>'),
  243  	nl(OutStream),
  244  	write(OutStream, '</key>'),
  245    nl(OutStream),
  246    write(OutStream, '<key id="functor" for="node" attr.name="functor" attr.type="string"/>'),
  247    nl(OutStream),
  248    write(OutStream, '<key id="arity" for="node" attr.name="arity" attr.type="int"/>'),
  249    nl(OutStream),
  250    write(OutStream, '<key id="moduleOfPredicate" for="node" attr.name="moduleOfPredicate" attr.type="string"/>'),
  251    nl(OutStream),
  252    write(OutStream, '<key id="isTransparent" for="node" attr.name="isTransparent" attr.type="boolean">'),
  253    nl(OutStream),
  254    write(OutStream, '    <default>false</default>'),
  255  	nl(OutStream),
  256  	write(OutStream, '</key>'),
  257    nl(OutStream),
  258    write(OutStream, '<key id="isDynamic" for="node" attr.name="isDynamic" attr.type="boolean">'),
  259    nl(OutStream),
  260    write(OutStream, '    <default>false</default>'),
  261  	nl(OutStream),
  262  	write(OutStream, '</key>'),
  263    nl(OutStream),   
  264    write(OutStream, '<key id="isMultifile" for="node" attr.name="isMultifile" attr.type="boolean">'),
  265    nl(OutStream),
  266    write(OutStream, '    <default>false</default>'),
  267  	nl(OutStream),
  268  	write(OutStream, '</key>'),
  269  	nl(OutStream),
  270    write(OutStream, '<key id="isMetaPredicate" for="node" attr.name="isMetaPredicate" attr.type="boolean">'),
  271    nl(OutStream),
  272    write(OutStream, '    <default>false</default>'),
  273  	nl(OutStream),
  274  	write(OutStream, '</key>'),
  275  	write(OutStream, '<key id="metaPredicateType" for="node" attr.name="metaPredicateType" attr.type="string">'),
  276  	nl(OutStream),
  277  	write(OutStream, '    <default>none</default>'),
  278  	nl(OutStream),
  279  	write(OutStream, '</key>'),
  280    nl(OutStream),
  281    write(OutStream, '<key id="isUnusedLocal" for="node" attr.name="isUnusedLocal" attr.type="boolean">'),
  282    nl(OutStream),
  283    write(OutStream, '    <default>false</default>'),
  284  	nl(OutStream),  	
  285  	write(OutStream, '</key>'),
  286    nl(OutStream),
  287    write(OutStream, '<key id="isExported" for="node" attr.name="isExported" attr.type="boolean">'),
  288    nl(OutStream),
  289    write(OutStream, '    <default>false</default>'),
  290  	nl(OutStream),
  291  	write(OutStream, '</key>'),
  292    nl(OutStream),   
  293    write(OutStream, '<key id="frequency" for="edge" attr.name="frequency" attr.type="int">'),
  294    nl(OutStream),
  295    write(OutStream, '    <default>1</default>'),
  296  	nl(OutStream),
  297  	write(OutStream, '</key>'),
  298    nl(OutStream),
  299    write(OutStream, '<key id="exported_static_predicates" for="node" attr.name="exported_static_predicates" attr.type="string" />'),
  300    nl(OutStream),
  301    write(OutStream, '<key id="exported_dynamic_predicates" for="node" attr.name="exported_dynamic_predicates" attr.type="string" />'),
  302    nl(OutStream),
  303    write(OutStream, '<key id="node_stereotype" for="node" attr.name="node_stereotype" attr.type="string" />'),
  304    nl(OutStream),
  305    write(OutStream, '<key id="imported_predicates" for="edge" attr.name="imported_predicates" attr.type="string" />'),
  306    nl(OutStream),
  307    write(OutStream, '<key id="edge_label" for="edge" attr.name="edge_label" attr.type="string" />'),
  308  	nl(OutStream),
  309    write(OutStream, '<key id="node_label" for="node" attr.name="node_label" attr.type="string" />'),
  310  	nl(OutStream),
  311    write(OutStream, '<key id="styles" for="all" attr.name="styles" attr.type="string" />'),
  312  	nl(OutStream),
  313    write(OutStream, '<key id="node_content" for="node" attr.name="node_content" attr.type="string" />'),
  314  	nl(OutStream),
  315    nl(OutStream).
  316    
  317
  318write_graphML_footer(OutStream):-
  319    write(OutStream,'</graphml>').
  320    
  321
  322    
  323start_graph_element(OutStream):-
  324    write(OutStream,'<graph edgedefault="directed">'), 
  325    nl(OutStream).
  326
  327close_graph_element(OutStream):-
  328    write(OutStream,'</graph>'), 
  329    nl(OutStream).
  330    
  331    
  332    
  333open_node(Stream,Id):-
  334    format(Stream, '<node id="~w">~n', [Id]).
  335
  336close_node(Stream):-
  337    write(Stream, '</node>'),
  338    nl(Stream).
  339   
  340open_edge(Stream,Source,Target):-
  341    format(Stream, '<edge source="~w" target="~w">~n', [Source, Target]). 
  342	
  343close_edge(Stream):-
  344    write(Stream, '</edge>'),
  345    nl(Stream).
  346
  347write_data(Stream,Key,Value):-
  348	format(Stream, '   <data key="~w">~w</data>~n', [Key,Value]).	
  349	
  350:- dynamic(pred_to_id/5).  351:- dynamic(atom_to_id/2).  352:- dynamic(current_id/1).  353
  354reset_id_translation :-
  355	retractall(pred_to_id(_,_,_,_,_)),
  356	retractall(atom_to_id(_,_)),
  357	retractall(current_id(_)),
  358	assertz(current_id(1)).
  359
  360get_new_id(NewId) :-
  361	var(NewId),
  362	retract(current_id(NewId)),
  363	succ(NewId, NextId),
  364	assertz(current_id(NextId)),
  365	!.
  366
  367get_id(File-Module:Name/Arity, Id) :-
  368	!,
  369	(	pred_to_id(File, Module, Name, Arity, Id)
  370	->	true
  371	;	get_new_id(Id),
  372		assertz(pred_to_id(File, Module, Name, Arity, Id))
  373	).
  374
  375get_id(Atom, Id) :-
  376	(	atom_to_id(Atom, Id)
  377	->	true
  378	;	get_new_id(Id),
  379		assertz(atom_to_id(Atom, Id))
  380	).
  381
  382has_id(File-Module:Name/Arity, Id) :-
  383	!,
  384	pred_to_id(File, Module, Name, Arity, Id).
  385has_id(Atom, Id) :-
  386	atom_to_id(Atom, Id)