1/*****************************************************************************
    2 * This file is part of the Prolog Development Tool (PDT)
    3 * 
    4 * Author: Lukas Degener (among others)
    5 * WWW: http://sewiki.iai.uni-bonn.de/research/pdt/start
    6 * Mail: pdt@lists.iai.uni-bonn.de
    7 * Copyright (C): 2004-2012, CS Dept. III, University of Bonn
    8 * 
    9 * All rights reserved. This program is  made available under the terms
   10 * of the Eclipse Public License v1.0 which accompanies this distribution,
   11 * and is available at http://www.eclipse.org/legal/epl-v10.html
   12 * 
   13 ****************************************************************************/
   14
   15:- use_module(library(error)). 
   16:- use_module(library(memfile)).  
   17
   18:- multifile test/1.   19
   20/*
   21 * SWI Compability
   22 * specific for SWI Prolog
   23 */
   24
   25:- dynamic outdir/1.   26:- dynamic file_output/1.   27:- dynamic output_to_file/0.   28:- dynamic output_to_memory/3.   29:- dynamic output_to_memory_key/1.   30
   31
   32index_information(Predicate, I) :-
   33	predicate_property(Predicate, indexed(I)).
   34
   35output_to_file.
   36
   37toggle_out :-
   38    output_to_file,
   39    print('output console'),
   40    !,
   41    retract(output_to_file).
   42toggle_out :-
   43    print('output file'),
   44    assert(output_to_file).
   45
   46/*
   47 * open_printf_to_memory(Key) 
   48 *
   49 * Use the following pattern to ensure closing of your stream:
   50 *    call_cleanup(
   51 *   	  (	    
   52 *    	open_printf_to_memory(<key>),
   53 *	  ), close_printf_to_memory(<key>, Content)).
   54 *
   55 */
   56 
   57open_printf_to_memory(Key) :-
   58    output_to_memory(Key,Handle,Stream),
   59    retractall(output_to_memory(Key,_,_)),
   60    catch((
   61    close(Stream),
   62    free_memory_file(Handle)),
   63    Exception,true),
   64    format('EXCEPTION: catched Exception in open_printf_to_memory. Possible reason: trying to create an existing stream~nSTREAM: ~w ~n~w ~n', [Key,Exception]),
   65    fail.
   66
   67open_printf_to_memory(Key) :-
   68    !, 
   69    new_memory_file(Handle),
   70    open_memory_file(Handle, write, Stream),
   71    asserta(output_to_memory(Key,Handle,Stream)),
   72	select_printf(Key).
   73
   74/*
   75 * close_printf_to_memory(+Key,-Content) 
   76 *
   77 * Closes the current memory stream with key Key. The output is written into Content.
   78 * After closing, printf is set to the last memory stream that was opened before this one.
   79 * If Key does not exist, nothing will happen
   80 *
   81 */
   82my_call_cleanup(Goal,Cleanup):-
   83    catch(Goal,E,true),!,
   84    Cleanup,
   85    (	nonvar(E)
   86    ->	throw(E)
   87    ;	true
   88    ).
   89my_call_cleanup(_,Cleanup):-    
   90    Cleanup,
   91    fail.
   92    
   93close_printf_to_memory(Key,Content):-
   94	
   95    my_call_cleanup(
   96    	close_and_get_content(Key,Content),
   97    	delete_printf_to_memory(Key)
   98    ).
   99%close_printf_to_memory(_,_) :-
  100 %   throw('no memory file exists').
  101 
  102
  103close_and_get_content(Key,Content):-
  104    output_to_memory(Key,Handle,Stream),
  105	close(Stream),
  106	memory_file_to_atom(Handle,Content).
  107
  108delete_printf_to_memory(Key):-
  109
  110    output_to_memory(Key,Handle,_),
  111    retractall(output_to_memory(Key,_,_)),
  112	free_memory_file(Handle),
  113	(  	output_to_memory_key(Key) 
  114    -> 	retract(output_to_memory_key(Key)),
  115		select_printf_last
  116	;  	true
  117	).
  118
  119%close_printf_to_memory(Key,Content) :-
  120%	output_to_memory(Key,Handle,Stream),
  121%	!,
  122%    call_cleanup(      	
  123%    	memory_file_to_atom(Handle,Content),
  124%		do_close_printf_to_memory(Key,Stream,Handle)		
  125%	).
  126%
  127%do_close_printf_to_memory(Key,Stream,Handle):-
  128%    close(Stream),
  129%    free_memory_file(Handle),
  130%   	retract(output_to_memory(Key, Handle,Stream)),    
  131%    (  	output_to_memory_key(Key) 
  132%    -> 	retract(output_to_memory_key(Key)),
  133%		select_printf_last
  134%	;  	true
  135%	).
  136    
  137
  138    
  139
  140close_all_printf_to_memory:-
  141    close_all_printf_to_memory(_).
  142    
  143close_all_printf_to_memory(ContentTemp2):-
  144    not(output_to_memory(_,_,_)),
  145    ContentTemp2 = ''.    
  146
  147close_all_printf_to_memory(Content) :-
  148    output_to_memory(Key,_,_),   
  149    !, 
  150    close_printf_to_memory(Key,ContentTemp),
  151    close_all_printf_to_memory(ContentTemp2),
  152    concat(ContentTemp,ContentTemp2,Content).
  153
  154/*
  155 * select_printf(+Key)
  156 *
  157 * Select current memory stream.
  158 */
  159
  160select_printf(Key) :-
  161	retractall(output_to_memory_key(_)),
  162	assert(output_to_memory_key(Key)).
  163
  164select_printf_last :-
  165	output_to_memory(LastKey,_,_),
  166	select_printf(LastKey).
  167	
  168select_printf_last.
  169
  170test(memory_file) :-
  171    open_printf_to_memory(testkey),
  172    printf(asdf),
  173    printf(asdf),
  174    close_printf_to_memory(testkey,Content),
  175    Content = asdfasdf.
  176
  177printf(_format, _args) :-
  178    output_to_memory(_,_,_stream),
  179    !,
  180    format(_stream, _format, _args).
  181
  182%printf(_format, _args) :-
  183%    output_to_tmp(_stream),
  184%    !,
  185%    format(_stream, _format, _args).
  186
  187printf(_format, _args) :-
  188    output_to_file,
  189    file_output(_stream),
  190    !,
  191    format(_stream, _format, _args).
  192
  193printf(_format, _args) :-
  194    current_output(_stream),
  195    format(_stream, _format, _args),
  196    flush_output.
  197
  198
  199printf(_format) :-
  200    printf(_format, []).
  201%    file_output(_stream),
  202%    current_output(_stream),
  203%    format(_stream, _format, []).
  204
  205    
  206
  207println :-
  208    printf('~n').
  209
  210
  211/*
  212	assert1T(+Term)
  213	Asserts term Term. If Term already exists it will not be 
  214	asserted. The predicate always succeeds.
  215*/
  216assert1T(Fact) :- call(Fact) -> true ; assert(Fact).
  217
  218/*
  219	retractT(+Term)
  220	Retracts Term. The predicate succeeds also if a fact 
  221	unifying with Term does not exists when the predicate
  222	is called.
  223*/
  224
  225retractT(Fact) :- call(Fact) -> retract(Fact) ; true.
  226
  227/* The following, original versions of the above two 
  228   predicates are BAD :-( !!!
  229
  230assert1T(_x) :- assert1(_x).
  231assert1T(_).
  232
  233retractT(_x) :- retract(_x).
  234retractT(_).
  235
  236   They create one useless choicepoint and backtrack even if
  237   the fact is actually asserted / retracted. That is expensive 
  238   and might be the cause of spurious follow-up errors in 
  239   contexts that expect assert not to backtrack or retract 
  240   not to backtrack once more than the existing number of 
  241   retractable facts!    -- GK, 27.03.2009
  242*/
  243
  244/*
  245	stringAppend(?Atom1, ?Atom2, Atom3)
  246	
  247	Atom3 forms the concatination of Atom1 and Atom2.
  248	At least two arguments must be instantiated.
  249	
  250	Mapped to atom_concat/3. (Needed for ISO-Prolog Compatibility).
  251*/
  252
  253stringAppend(S1, _S2, _Ret) :-
  254	nonvar(S1),
  255	S1 = unqualified(_,_),
  256	throw(exception).
  257
  258stringAppend(_S1, S2, _Ret) :-
  259	nonvar(S2),
  260	S2 = unqualified(_,_),
  261	throw(exception).
  262
  263stringAppend(_S1, _S2, Ret) :-
  264	nonvar(Ret),
  265	Ret = unqualified(_,_),
  266	throw(exception).
  267
  268stringAppend(Str1, Str2, Ret) :-
  269    atom_concat(Str1, Str2, Ret).
  270
  271/*
  272stringAppend(_str1, _str2, _Ret) :-
  273    atomic(_str1),
  274    atomic(_str2),
  275    atom_concat(_str1, _str2, _Ret),
  276    !.
  277    
  278
  279stringAppend(_str1, _str2, _Ret) :-
  280    atomic(_str1),
  281    atomic(_Ret),
  282    atom_concat(_str1, _str2, _Ret),
  283    !.
  284    
  285
  286stringAppend(_str1, _str2, _Ret) :-
  287    atomic(_str2),
  288    atomic(_Ret),
  289    atom_concat(_str1, _str2, _Ret),
  290    !.
  291    
  292stringAppend(_str1, _str2, _Ret) :-
  293    write(_str1),
  294	user:debugme(_str1, _str2, _Ret).
  295
  296user:debugme(_str1, _str2, _Ret).
  297	
  298	*/
  299	
  300test('stringAppend/3#1') :- stringAppend('','','').
  301test('stringAppend/3#2') :- stringAppend('a','','a').
  302test('stringAppend/3#3') :- stringAppend('','a','a').
  303test('stringAppend/3#4') :- stringAppend('a','b','ab').
  304test('stringAppend/3#4') :- stringAppend('uwe ','tarek bardey','uwe tarek bardey').
  305
  306list2java(l, S) :-
  307    concat_atom(l, ', ', S).
  308
  309
  310mapPredicate(_, _ ,[] ,[]).
  311mapPredicate(Pred, Arg1 ,[Arg2H | Arg2T] ,[RetH | RetT]) :-
  312               Q =.. [Pred, Arg1, Arg2H, RetH],
  313               call(Q),
  314               mapPredicate(Pred, Arg1, Arg2T, RetT).
  315
  316sum(Int1, Int2, Int3) :- plus(Int1, Int2, Int3).
  317
  318int2string(_int, _string) :- swritef(_string, "%d", [_int]).
  319
  320equals(_term1, _term2) :- _term1 = _term2.
  321nequals(_term1, _term2) :- _term1 \= _term2.
  322
  323debugPrint(_str) :- writef(_str).
  324
  325
  326
  327
  328:- dynamic(output_to_memory/2).  329
  330open_print_to_memory :-
  331	output_to_memory(_,_),
  332	throw('memory file still open').
  333
  334open_print_to_memory :-
  335    !,
  336    new_memory_file(Handle),
  337    open_memory_file(Handle, write, Stream),
  338    current_output(Out),
  339    assert(output_to_memory(Handle,Out)),
  340    set_output(Stream).
  341
  342close_print_to_memory(Content) :-
  343    output_to_memory(Handle,Out),
  344    !,
  345    current_output(MemStream),
  346    close(MemStream),
  347    set_output(Out),
  348    memory_file_to_atom(Handle,Content),
  349    free_memory_file(Handle),
  350    retract(output_to_memory(Handle,Out)).
  351
  352close_print_to_memory(_) :-
  353    throw('no memory file exists').
  354
  355/*
  356:- redefine_system_predicate(get_single_char(_)).
  357
  358get_single_char(A) :-
  359    print(aha),
  360    system:get_single_char(A).
  361*/
  362
  363/*
  364 * disable_tty_control
  365 *
  366 * Disables tty control char-wise read on the windows platform.
  367 */
  368:- if(pdt_support:pdt_support(tty_control)).  369disable_tty_control :- 
  370	(	current_prolog_flag(windows, _)
  371	->	set_prolog_flag(tty_control, false)
  372	;	true
  373	). 
  374
  375:- disable_tty_control.  376:- endif.  377
  378
  379read_term_atom(Atom,Term,Options):-
  380	atom_to_memory_file(Atom,Handle),
  381	open_memory_file(Handle, read, Stream),
  382	catch(read_term(Stream,Term,Options),
  383	      Exception,
  384	      write(Exception)),
  385	close(Stream),free_memory_file(Handle),
  386	( nonvar(Exception) ->
  387	   throw(Exception);
  388	   true
  389	)