View source with formatted comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2007-2014, University of Amsterdam
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(yap,
   36	  [ gc/0,
   37	    depth_bound_call/2,		% :Goal, +Limit
   38	    system/1,			% +Command
   39	    exists/1,			% +File
   40	    assert_static/1,		% :Term
   41	    source/0,
   42	    yap_flag/2,			% +Flag, +Value
   43	    yap_style_check/1		% +Style
   44	  ]).   45
   46/** <module> YAP Compatibility module
   47
   48This  module  provides  compatibility  to   YAP  through  the  directive
   49expects_dialect/1:
   50
   51	==
   52	:- expects_dialect(yap)
   53	==
   54
   55The task of this module is:
   56
   57	* Implement system predicates available in YAP we do not yet or
   58	do not wish to support in SWI-Prolog.  Export these predicates.
   59
   60	* Provide yap_<name>(...) predicates for predicates that exist
   61	both in YAP and SWI-Prolog and define goal_expansion/2 rules to
   62	map calls to these predicates to the yap_<name> version.
   63	Export these predicates.
   64
   65	* Alter the library search path, placing dialect/yap *before*
   66	the system libraries.
   67
   68	* Allow for =|.yap|= extension as extension for Prolog files.
   69	If both a =|.pl|= and =|.yap|= is present, the =|.yap|= file
   70	is loaded if the current environment expects YAP.
   71
   72Current            set            is              taken             from
   73http://www.david-reitter.com/compling/prolog/compat_swi.pl,  written  by
   74David Reitter and Steve Moyle
   75
   76@tbd	Fill it in!
   77@author Jan Wielemaker
   78*/
   79
   80		 /*******************************
   81		 *	     EXPANSION		*
   82		 *******************************/
   83
   84:- multifile
   85	user:goal_expansion/2,
   86	user:file_search_path/2,
   87	user:prolog_file_type/2,
   88	yap_expansion/2.   89:- dynamic
   90	user:goal_expansion/2,
   91	user:file_search_path/2,
   92	user:prolog_file_type/2.   93
   94user:goal_expansion(In, Out) :-
   95	prolog_load_context(dialect, yap),
   96	yap_expansion(In, Out).
   97
   98%%	yap_expansion(+In, +Out)
   99%
  100%	goal_expansion rules to emulate YAP behaviour in SWI-Prolog. The
  101%	expansions  below  maintain  optimization    from   compilation.
  102%	Defining them as predicates would loose compilation.
  103
  104yap_expansion(eval_arith(Expr, Result),
  105	      Result is Expr).
  106yap_expansion(if(Goal, Then),
  107	      (Goal *-> Then; true)).
  108yap_expansion(if(Goal, Then, Else),
  109	      (Goal *-> Then; Else)).
  110yap_expansion(style_check(Style),
  111	      yap_style_check(Style)).
  112
  113
  114		 /*******************************
  115		 *	    LIBRARY SETUP	*
  116		 *******************************/
  117
  118%%	push_yap_library
  119%
  120%	Pushes searching for  dialect/yap  in   front  of  every library
  121%	directory that contains such as sub-directory.
  122
  123push_yap_library :-
  124	(   absolute_file_name(library(dialect/yap), Dir,
  125			       [ file_type(directory),
  126				 access(read),
  127				 solutions(all),
  128				 file_errors(fail)
  129			       ]),
  130	    asserta((user:file_search_path(library, Dir) :-
  131		    prolog_load_context(dialect, yap))),
  132	    fail
  133	;   true
  134	).
  135
  136
  137%%	push_yap_file_extension
  138%
  139%	Looks for .yap files before looking for .pl files if the current
  140%	dialect is =yap=.
  141
  142push_yap_file_extension :-
  143	asserta((user:prolog_file_type(yap, prolog) :-
  144		    prolog_load_context(dialect, yap))).
  145
  146:- push_yap_library,
  147   push_yap_file_extension.  148
  149
  150		 /*******************************
  151		 *	 SYSTEM PREDICATES	*
  152		 *******************************/
  153
  154%%	gc
  155%
  156%	Garbage collect.
  157%
  158%	@compat yap
  159
  160gc :-
  161	garbage_collect.
  162
  163%%	depth_bound_call(:Goal, :Limit)
  164%
  165%	Equivalent to call_with_depth_limit(Goal, Limit, _Reached)
  166%
  167%	@compat yap
  168
  169:- module_transparent
  170	depth_bound_call/2.  171
  172depth_bound_call(G, L) :-
  173	call_with_depth_limit(G, L, _).
  174
  175%%	system(+Command)
  176%
  177%	Equivalent to shell(Command).
  178%
  179%	@compat yap
  180
  181system(Command) :-
  182	shell(Command).
  183
  184%%	exists(+File)
  185%
  186%	Equivalent to exists_file(File).
  187%
  188%	@compat yap
  189
  190exists(File) :-
  191	exists_file(File).
  192
  193%%	assert_static(:Term)
  194%
  195%	Assert    as    static    predicate.      SWI-Prolog    provides
  196%	compile_predicates/1 to achieve this. The   emulation  is a mere
  197%	alias for assert/1, as  immediate   compilation  would  prohibit
  198%	further calls to this predicate.
  199%
  200%	@compat yap
  201%	@deprecated Use assert/1 and compile_predicates/1 after
  202%	completing the predicate definition.
  203
  204:- module_transparent
  205	assert_static/1.  206
  207assert_static(Term) :-
  208	assert(Term).
  209
  210
  211%%	source is det.
  212%
  213%	YAP directive to  maintain  source-information.   We  have  that
  214%	always.
  215
  216source.
  217
  218
  219%%	yap_flag(+Key, +Value) is det.
  220%
  221%	Map some YAP flags to SWI-Prolog.  Supported flags:
  222%
  223%	    * write_strings: Bool
  224%	    If =on=, writes strings as "..." instead of a list of
  225%	    integers.  In SWI-Prolog this only affects write routines
  226%	    that use portray.
  227
  228yap_flag(write_strings, OnOff) :- !,
  229	map_bool(OnOff, Bool),
  230	set_prolog_flag(write_strings, Bool).
  231yap_flag(Flag, Value) :-
  232	fixme_true(yap_flag(Flag, Value)).
  233
  234map_bool(on, true) :- !.
  235map_bool(off, false) :- !.
  236map_bool(Bool, Bool).
  237
  238:- multifile
  239	user:portray/1.  240
  241user:portray(String) :-
  242	current_prolog_flag(write_strings, true),
  243	is_list(String),
  244	length(String, L),
  245	L > 2,
  246	maplist(printable, String),
  247	format('"~s"', [String]).
  248
  249printable(C) :-	code_type(C, graph), !.
  250printable(C) :-	code_type(C, space), !.
  251
  252
  253%%	yap_style_check(+Style) is det.
  254%
  255%	Map YAP style-check options onto the SWI-Prolog ones.
  256
  257yap_style_check(all) :- !,
  258	system:style_check([ +singleton,
  259			     +discontiguous
  260			   ]).
  261yap_style_check(Style) :-
  262	fixme_true(yap_style_check(Style)).
  263
  264
  265		 /*******************************
  266		 *	   UNIMPLEMENTED		*
  267		 *******************************/
  268
  269:- dynamic
  270	fixme_reported/1.  271
  272fixme_true(Goal) :-
  273	fixme_reported(Goal), !.
  274fixme_true(Goal) :-
  275	print_message(warning, yap_unsupported(Goal)),
  276	assert(fixme_reported(Goal)).
  277
  278
  279:- multifile
  280	prolog:message//1.  281
  282prolog:message(yap_unsupported(Goal)) -->
  283	[ 'YAP emulation (yap.pl): unsupported: ~p'-[Goal] ]