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)  2010-2014, VU University 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(sicstus,
   36	  [ (block)/1,			% +Heads
   37
   38	    if/3,			% :If, :Then, :Else
   39
   40	    use_module/3,		% ?Module, ?File, +Imports
   41
   42	    bb_put/2,			% :Key, +Value
   43	    bb_get/2,			% :Key, -Value
   44	    bb_delete/2,		% :Key, -Value
   45	    bb_update/3,		% :Key, -Old, +New
   46
   47	    create_mutable/2,		% ?Value, -Mutable
   48	    get_mutable/2,		% ?Value, +Mutable
   49	    update_mutable/2,		% ?Value, !Mutable
   50
   51	    read_line/1,		% -Codes
   52	    read_line/2,		% +Stream, -Codes
   53
   54	    trimcore/0,
   55
   56%	    call_residue/2,		% :Goal, -Residue
   57
   58	    prolog_flag/3,		% +Flag, -Old, +New
   59	    prolog_flag/2,		% +Flag, -Value
   60
   61	    op(1150, fx, (block))
   62	  ]).   63
   64:- use_module(sicstus/block).   65:- use_module(library(occurs)).   66:- use_module(library(debug)).   67:- use_module(library(error)).   68:- use_module(library(lists)).   69:- use_module(library(arithmetic)).

SICStus compatibility library

This library is intended to be activated using the directive below in files that are designed for use with SICStus Prolog. The changes are in effect until the end of the file and in each file loaded from this file.

:- expects_dialect(sicstus).
To be done
- The dialect-compatibility packages are developed in a `demand-driven' fashion. Please contribute to this package. */
   86:- multifile
   87	system:goal_expansion/2.   88
   89
   90		 /*******************************
   91		 *	    LIBRARY SETUP	*
   92		 *******************************/
 push_sicstus_library
Pushes searching for dialect/sicstus in front of every library directory that contains such as sub-directory.
   99push_sicstus_library :-
  100	(   absolute_file_name(library(dialect/sicstus), Dir,
  101			       [ file_type(directory),
  102				 access(read),
  103				 solutions(all),
  104				 file_errors(fail)
  105			       ]),
  106	    asserta((user:file_search_path(library, Dir) :-
  107		    prolog_load_context(dialect, sicstus))),
  108	    fail
  109	;   true
  110	).
  111
  112
  113:- push_sicstus_library.  114
  115
  116		 /*******************************
  117		 *	      OPERATORS		*
  118		 *******************************/
  119
  120%	declare all operators globally
  121
  122system:goal_expansion(op(Pri,Ass,Name),
  123		      op(Pri,Ass,user:Name)) :-
  124	\+ qualified(Name),
  125	prolog_load_context(dialect, sicstus).
  126
  127qualified(Var) :- var(Var), !, fail.
  128qualified(_:_).
 setup_dialect
Further dialect initialization.
  135setup_dialect.
  136
  137
  138		 /*******************************
  139		 *	      CONTROL		*
  140		 *******************************/
  141
  142:- meta_predicate
  143	if(0,0,0).  144
  145system:goal_expansion(if(If,Then,Else),
  146		      (If *-> Then ; Else)) :-
  147	prolog_load_context(dialect, sicstus),
  148	\+ (sub_term(X, [If,Then,Else]), X == !).
 if(:If, :Then, :Else)
Same as SWI-Prolog soft-cut construct. Normally, this is translated using goal-expansion. If either term contains a !, we use meta-calling for full compatibility (i.e., scoping the cut).
  156if(If, Then, Else) :-
  157	(   If
  158	*-> Then
  159	;   Else
  160	).
  161
  162
  163		 /*******************************
  164		 *	  LIBRARY MODULES	*
  165		 *******************************/
 rename_module(?SICStusModule, ?RenamedSICSTusModule) is nondet
True if RenamedSICSTusModule is the name that we use for the SICStus native module SICStusModule. We do this in places where the module-name conflicts. All explicitely qualified goals are mapped to the SICStus equivalent of the module.
  174:- multifile
  175	rename_module/2.  176
  177system:goal_expansion(M:Goal, SicstusM:Goal) :-
  178	atom(M),
  179	rename_module(M, SicstusM),
  180	prolog_load_context(dialect, sicstus).
  181
  182
  183		 /*******************************
  184		 *	     MODULES		*
  185		 *******************************/
  186
  187% SICStus use_module/1 does not require the target to be a module.
  188
  189system:goal_expansion(use_module(File), load_files(File, [if(changed)])).
 use_module(+Module, -File, +Imports) is det
use_module(-Module, +File, +Imports) is det
This predicate can be used to import from a named module while the file-location of the module is unknown or to get access to the module-name loaded from a file.

If both Module and File are given, we use Module and try to unify File with the absolute canonical path to the file from which Module was loaded. However, we succeed regardless of the success of this unification.

  203use_module(Module, File, Imports) :-
  204	atom(Module), !,
  205	module_property(Module, file(Path)),
  206	use_module(Path, Imports),
  207	ignore(File = Path).
  208use_module(Module, File, Imports) :-
  209	ground(File), !,
  210	absolute_file_name(File, Path,
  211			   [ file_type(prolog),
  212			     access(read)
  213			   ]),
  214	use_module(Path, Imports),
  215	module_property(Module, file(Path)).
  216use_module(Module, _, _Imports) :-
  217	instantiation_error(Module).
  218
  219
  220		 /*******************************
  221		 *	 FOREIGN RESOURCES      *
  222		 *******************************/
  223
  224/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  225SICStus uses foreign_resource(Name, Functions) and predicate definitions
  226similar to Quintus. qpforeign can generate  the   glue  code that can be
  227linked with swipl-ld. This  part  of   the  emulation  merely  skips the
  228declarations and Maps load_foreign_resource   to load_foreign_resource/2
  229from library(qpforeign).
  230- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  231
  232system:term_expansion(
  233	   (:- load_foreign_resource(Base)),
  234	   (:- initialization(load_foreign_resource(M:Base, Source), now))) :-
  235	prolog_load_context(source, Source),
  236	prolog_load_context(module, M).
  237system:term_expansion(
  238	   (:- module(Name, Exports, Options)),
  239	   [ (:- module(Name, Exports))
  240	   | Declarations
  241	   ]) :-
  242	prolog_load_context(dialect, sicstus),
  243	phrase(sicstus_module_decls(Options), Declarations).
  244
  245sicstus_module_decls([]) --> [].
  246sicstus_module_decls([H|T]) -->
  247	sicstus_module_decl(H),
  248	sicstus_module_decls(T).
  249
  250sicstus_module_decl(hidden(true)) --> !,
  251	[(:- set_prolog_flag(generate_debug_info, false))].
  252sicstus_module_decl(_) -->
  253	[].
  254
  255
  256		 /*******************************
  257		 *	       BB_*		*
  258		 *******************************/
  259
  260:- meta_predicate
  261	bb_put(:, +),
  262	bb_get(:, -),
  263	bb_delete(:, -),
  264	bb_update(:, -, +).  265
  266system:goal_expansion(bb_put(Key, Value), nb_setval(Atom, Value)) :-
  267	bb_key(Key, Atom).
  268system:goal_expansion(bb_get(Key, Value), nb_current(Atom, Value)) :-
  269	bb_key(Key, Atom).
  270system:goal_expansion(bb_delete(Key, Value),
  271		      (	  nb_current(Atom, Value),
  272			  nb_delete(Atom)
  273		      )) :-
  274	bb_key(Key, Atom).
  275system:goal_expansion(bb_update(Key, Old, New),
  276		      (	  nb_current(Atom, Old),
  277			  nb_setval(Atom, New)
  278		      )) :-
  279	bb_key(Key, Atom).
  280
  281bb_key(Module:Key, Atom) :-
  282	atom(Module), !,
  283	atomic(Key),
  284	atomic_list_concat([Module, Key], :, Atom).
  285bb_key(Key, Atom) :-
  286	atomic(Key),
  287	prolog_load_context(module, Module),
  288	atomic_list_concat([Module, Key], :, Atom).
 bb_put(:Name, +Value) is det
 bb_get(:Name, -Value) is semidet
 bb_delete(:Name, -Value) is semidet
 bb_update(:Name, -Old, +New) is semidet
SICStus compatible blackboard routines. The implementations only deal with cases where the module-sensitive key is unknown and meta-calling. Simple cases are directly mapped to SWI-Prolog non-backtrackable global variables.
  300bb_put(Key, Value) :-
  301	bb_key(Key, Name),
  302	nb_setval(Name, Value).
  303bb_get(Key, Value) :-
  304	bb_key(Key, Name),
  305	nb_current(Name, Value).
  306bb_delete(Key, Value) :-
  307	bb_key(Key, Name),
  308	nb_current(Name, Value),
  309	nb_delete(Name).
  310bb_update(Key, Old, New) :-
  311	bb_key(Key, Name),
  312	nb_current(Name, Old),
  313	nb_setval(Name, New).
  314
  315
  316		 /*******************************
  317		 *	     MUTABLES		*
  318		 *******************************/
 create_mutable(?Value, -Mutable) is det
Create a mutable term with the given initial Value.
Compatibility
- sicstus
  326create_mutable(Value, '$mutable'(Value,_)).
 get_mutable(?Value, +Mutable) is semidet
True if Value unifies with the current value of Mutable.
Compatibility
- sicstus
  334get_mutable(Value, '$mutable'(Value,_)).
 update_mutable(?Value, !Mutable) is det
Set the value of Mutable to Value. The old binding is restored on backtracking.
See also
- setarg/3.
Compatibility
- sicstus
  344update_mutable(Value, Mutable) :-
  345	functor(Mutable, '$mutable', 2), !,
  346	setarg(1, Mutable, Value).
  347update_mutable(_, Mutable) :-
  348	type_error(mutable, Mutable).
  349
  350
  351		 /*******************************
  352		 *	   LINE READING		*
  353		 *******************************/
 read_line(-Codes) is det
 read_line(+Stream, -Codes) is det
Read a line from the given or current input. The line read does not include the line-termination character. Unifies Codes with end_of_file if the end of the input is reached.
See also
- The SWI-Prolog primitive is read_line_to_codes/2.
Compatibility
- sicstus
  365read_line(Codes) :-
  366    read_line_to_codes(current_input, Codes).
  367
  368read_line(Stream, Codes) :-
  369    read_line_to_codes(Stream, Codes).
  370
  371
  372		 /*******************************
  373		 *  COROUTINING & CONSTRAINTS	*
  374		 *******************************/
  375
  376/* This is more complicated.  Gertjan van Noord decided to use
  377   copy_term/3 in Alpino.
  378
  379%%	call_residue(:Goal, -Residue) is nondet.
  380%
  381%	Residue is a list of VarSet-Goal.  Note that this implementation
  382%	is   incomplete.   Please   consult     the   documentation   of
  383%	call_residue_vars/2 for known issues.
  384
  385:- meta_predicate
  386	call_residue(0, -).
  387
  388call_residue(Goal, Residue) :-
  389	call_residue_vars(Goal, Vars),
  390	(   Vars == []
  391	->  Residue = []
  392	;   copy_term(Vars, _AllVars, Goals),
  393	    phrase(vars_by_goal(Goals), Residue)
  394	).
  395
  396vars_by_goal((A,B)) --> !,
  397	vars_by_goal(A),
  398	vars_by_goal(B).
  399vars_by_goal(Goal) -->
  400	{ term_attvars(Goal, AttVars),
  401	  sort(AttVars, VarSet)
  402	},
  403	[ VarSet-Goal ].
  404*/
 trimcore
Trims the stacks. Other tasks of the SICStus trimcore/0 are automatically scheduled by SWI-Prolog.
  411trimcore :-
  412	trim_stacks.
  413
  414
  415		 /*******************************
  416		 *	       FLAGS		*
  417		 *******************************/
 prolog_flag(+Flag, -Old, +New) is semidet
Query and set a Prolog flag. Use the debug/1 topic prolog_flag to find the flags accessed using this predicate.
  424prolog_flag(Flag, Old, New) :-
  425	debug(prolog_flag, 'prolog_flag(~q, ~q, ~q)', [Flag, Old, New]),
  426	current_prolog_flag(Flag, Old),
  427	set_prolog_flag(Flag, New).
 prolog_flag(+Flag, -Value) is semidet
Query a Prolog flag, mapping SICSTus flags to SWI-Prolog flags
  433prolog_flag(Flag, Value) :-
  434	debug(prolog_flag, 'prolog_flag(~q, ~q)', [Flag, Value]),
  435	sicstus_flag(Flag, Value).
  436
  437sicstus_flag(system_type, Type) :- !,
  438	(   current_prolog_flag(saved_program, true)
  439	->  Type = runtime
  440	;   Type = development
  441	).
  442sicstus_flag(Name, Value) :-
  443	current_prolog_flag(Name, Value).
  444
  445
  446		 /*******************************
  447		 *	     ARITHMETIC		*
  448		 *******************************/
  449
  450% Provide (#)/2 as arithmetic function.  Ideally, we should be able to
  451% bind multiple names to built-in functions.  This is rather slow.  We
  452% could also consider adding # internally, but not turning it into an
  453% operator.
  454
  455:- op(500, yfx, #).  456
  457:- arithmetic_function(user:(#)/2).  458:- arithmetic_function(user:(\)/2).  459
  460user:(#(X,Y,R)) :-				% SICStus 3
  461	R is xor(X,Y).
  462user:(\(X,Y,R)) :-				% SICStus 4
  463	R is xor(X,Y).
  464
  465
  466		 /*******************************
  467		 *	       HACKS		*
  468		 *******************************/
 prolog:$breaklevel(-BreakLevel, Unknown)
Query the current break-level
  474prolog:'$breaklevel'(BreakLevel, _) :-
  475	current_prolog_flag(break_level, BreakLevel), !.
  476prolog:'$breaklevel'(0, _)