1/*****************************************************************************
    2 * This file is part of the Prolog Development Tool (PDT)
    3 * 
    4 * Author: Fabian Noth
    5 * WWW: http://sewiki.iai.uni-bonn.de/research/pdt/start
    6 * Mail: pdt@lists.iai.uni-bonn.de
    7 * Copyright (C): 2013, 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:- module( pdt_support, [ pdt_support/1 ]).   16
   17:- if(current_prolog_flag(dialect,swi)).   18	pdt_support(doc_collect).
   19	pdt_support(flag).
   20	pdt_support(count_inferences).
   21	pdt_support(tests).
   22	pdt_support(clause_property).
   23	pdt_support(last_call_optimisation).
   24	pdt_support(tty_control).
   25
   26:- elif(current_prolog_flag(dialect,yap)).   27	pdt_support(reverse_list).
   28	pdt_support(table).
   29	pdt_support(remove_duplicates).
   30	pdt_support(tty_control).
   31
   32:- else.   33	:- writeln('WARNING: unsupported Prolog dialect!\nSupported dialects are: SWI, YAP').   34
   35:- endif.   36
   37
   38% pdt_support(last_call_optimisation).
   39%     current_prolog_flag(last_call_optimisation, X) is supported
   40
   41% pdt_support(table).
   42%     tabling (and the table/1 directive) is supported
   43%     prints warning if not supported
   44
   45% pdt_support(doc_collect).
   46%     doc_collect/1 is supported.
   47%     prints warning if not supported
   48
   49% pdt_support(flag).
   50%     flag/3 is supported
   51%     alternative implementation is used if not supported
   52
   53% pdt_support(tty_control).
   54%     current_prolog_flag(tty_control, X) is supported
   55
   56% pdt_support(remove_duplicates).
   57%     remove_duplicates/2 is supported
   58%     alternative implementation is used if not supported
   59
   60% pdt_support(count_inferences)
   61%	  statistics(inferences, I) is supported
   62
   63
   64% pdt_support(tests).
   65
   66% pdt_support(clause_property).
   67
   68% pdt_support(reverse_list).
   69
   70
   71
   72
   73
   74:- if( \+ pdt_support(doc_collect) ).   75user:doc_collect(true) :-
   76	writeln('Warning: doc_collect/1 not supported by current prolog system').
   77:- endif.   78
   79:- if( \+ pdt_support(table)).   80user:table(X) :-
   81	write('WARNING: tabling not supported in current prolog version (predicate: '),
   82	write(X),
   83	write(')\n').
   84:- endif.   85
   86:- if(\+ pdt_support(flag)).   87user:flag(Name, _, _) :-
   88	var(Name),
   89	throw(instantiation_error(Name)), !.
   90
   91user:flag(Name, OldValue, NewValue) :-
   92	nb_current(Name, OldValue),
   93	nonvar(NewValue),
   94	nb_setval(Name, NewValue), !.
   95	
   96user:flag(Name, OldValue, NewValue) :-
   97	OldValue = 0,
   98	nonvar(NewValue),
   99	nb_setval(Name, NewValue), !.
  100:- endif.