View source with raw 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	  ]).

YAP Compatibility module

This module provides compatibility to YAP through the directive expects_dialect/1:

:- expects_dialect(yap)

The task of this module is:

Current set is taken from http://www.david-reitter.com/compling/prolog/compat_swi.pl, written by David Reitter and Steve Moyle

author
- Jan Wielemaker */
To be done
- Fill it in!
   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).
 yap_expansion(+In, +Out)
goal_expansion rules to emulate YAP behaviour in SWI-Prolog. The expansions below maintain optimization from compilation. Defining them as predicates would loose compilation.
  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		 *******************************/
 push_yap_library
Pushes searching for dialect/yap in front of every library directory that contains such as sub-directory.
  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	).
 push_yap_file_extension
Looks for .yap files before looking for .pl files if the current dialect is yap.
  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		 *******************************/
 gc
Garbage collect.
Compatibility
- yap
  160gc :-
  161	garbage_collect.
 depth_bound_call(:Goal, :Limit)
Equivalent to call_with_depth_limit(Goal, Limit, _Reached)
Compatibility
- yap
  169:- module_transparent
  170	depth_bound_call/2.  171
  172depth_bound_call(G, L) :-
  173	call_with_depth_limit(G, L, _).
 system(+Command)
Equivalent to shell(Command).
Compatibility
- yap
  181system(Command) :-
  182	shell(Command).
 exists(+File)
Equivalent to exists_file(File).
Compatibility
- yap
  190exists(File) :-
  191	exists_file(File).
 assert_static(:Term)
Assert as static predicate. SWI-Prolog provides compile_predicates/1 to achieve this. The emulation is a mere alias for assert/1, as immediate compilation would prohibit further calls to this predicate.
deprecated
- Use assert/1 and compile_predicates/1 after completing the predicate definition.
Compatibility
- yap
  204:- module_transparent
  205	assert_static/1.  206
  207assert_static(Term) :-
  208	assert(Term).
 source is det
YAP directive to maintain source-information. We have that always.
  216source.
 yap_flag(+Key, +Value) is det
Map some YAP flags to SWI-Prolog. Supported flags:
write_strings:Bool
If on, writes strings as "..." instead of a list of integers. In SWI-Prolog this only affects write routines that use portray.
  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), !.
 yap_style_check(+Style) is det
Map YAP style-check options onto the SWI-Prolog ones.
  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] ]