View source with raw comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker, Johan Romme
    4    E-mail:        J.Wielemaker@cs.vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2012-2016, 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(ifprolog,
   36	  [ calling_context/1,			% -Module
   37	    context/2,				% :Goal, +Mapping
   38	    block/3,				% :Goal, +Tag, :Recovery
   39	    exit_block/1,			% +Tag
   40	    cut_block/1,			% +Tag
   41
   42	    modify_mode/3,			% +PI, -Old, +New
   43	    debug_mode/3,			% +PI, -Old, +New
   44	    ifprolog_debug/1,			% :Goal,
   45	    debug_config/3,			% +Key, +Current, +Value
   46	    float_format/2,			% -Old, +New
   47	    program_parameters/1,		% -Argv
   48	    user_parameters/1,			% -Argv
   49	    match/2,				% +Mask, +Atom
   50	    match/3,				% +Mask, +Atom, ?Replacements
   51	    lower_upper/2,			% ?Lower, ?Upper
   52	    current_error/1,			% -Stream
   53	    writeq_atom/2,			% +Term, -Atom
   54	    write_atom/2,			% +Term, -Atom
   55	    write_formatted_atom/3,		% -Atom, +Format, +ArgList
   56	    write_formatted/2,			% +Format, +ArgList
   57	    write_formatted/3,			% +Stream, +Format, +ArgList
   58	    atom_part/4,			% +Atom, +Pos, +Len, -Sub
   59	    atom_prefix/3,			% +Atom, +Len, -Sub
   60	    atom_suffix/3,			% +Atom, +Len, -Sub
   61	    atom_split/3,			% +Atom, +Delimiter, ?Subatoms
   62	    if_concat_atom/2,			% +List, ?Atom
   63	    if_concat_atom/3,			% +List, +Delimiter, ?Atom
   64	    getchar/3,				% +Atom, +Pos, -Char
   65	    parse_atom/6,			% +Atom, +StartPos, ?EndPos,
   66						% ?Term, ?VarList, ?Error
   67	    index/3,				% +Atom, +String, -Position
   68	    list_length/2,			% +List, ?Length
   69	    load/1,				% :FileName
   70%	    unload/1,				% +Module
   71	    file_test/2,			% +File, +Mode
   72	    filepos/2,				% @Stream, -Line
   73	    filepos/3,				% @Stream, -Line, -Column
   74	    getcwd/1,				% -Dir
   75	    assign_alias/2,			% +Alias, @Stream
   76	    get_until/3,			% +SearchChar, ?Text, ?EndChar
   77	    get_until/4,			% @In, +SearchChar, ?Text, ?EndChar
   78	    for/3,				% +Start, ?Counter, +End
   79	    prolog_version/1,                   % -Atom
   80	    proroot/1,				% -Atom
   81	    system_name/1,			% -Atom
   82	    localtime/9,			% +Time, ?Year, ?Month,
   83						% ?Day, ?DoW, ?DoY,
   84						% ?Hour, ?Min, ?Sec
   85
   86	    asserta_with_names/2,		% @Term, +VarNames
   87	    assertz_with_names/2,		% @Term, +VarNames
   88	    clause_with_names/3,		% ?Head, ?Body, ?VarNames
   89	    retract_with_names/2,		% ?Clause, ?VarNames
   90	    predicate_type/2,			% @Predicate, ?Type
   91	    current_visible/2,			% @Module, @Predicate
   92	    current_signal/2,			% ?Signal, ?Mode
   93	    digit/1,				% +Character
   94	    letter/1,				% +Character
   95
   96	    current_global/1,			% +Name
   97	    get_global/2,			% +Name, ?Value
   98	    set_global/2,			% +Name, ?Value
   99	    unset_global/1,			% +Name
  100
  101	    current_default_module/1,		% -Module
  102	    set_default_module/1,		% +Module
  103
  104	    op(1150, fx, (meta)),
  105	    op(1150, fx, (export)),
  106	    op(100, xfx, @),
  107	    op(900, xfx, =>),
  108	    op(900,  fy, not)
  109	  ]).  110:- use_module(library(debug)).  111:- use_module(library(arithmetic)).  112:- use_module(library(memfile)).  113:- use_module(library(apply)).  114:- set_prolog_flag(double_quotes, codes).

IF/Prolog compatibility package

This library realises emulation of IF/Prolog. As with all the emulation layers in the dialect directory, the emulation has been established on `as needed' basis from porting programs. This implies that the emulation is incomplete. Emumated directives, predicates and libraries are often not 100% compatible with the IF/Prolog version.

Note that this emulation layer targets primarily IF/Prolog version 5.

Please help extending this library and submit patches to bugs@swi-prolog.org. */

  130:- module_transparent
  131	calling_context/1.  132
  133:- meta_predicate
  134	context(0, +),
  135	block(0, +, 0),
  136	modify_mode(:, -, +),
  137	debug_mode(:, -, +),
  138	ifprolog_debug(0),
  139	load(:),
  140	asserta_with_names(:, +),
  141	assertz_with_names(:, +),
  142	clause_with_names(:, -, -),
  143	retract_with_names(:, -),
  144	predicate_type(:, -),
  145	current_global(:),
  146	get_global(:, -),
  147	set_global(:, +),
  148	unset_global(:).  149
  150
  151		 /*******************************
  152		 *	     EXPANSION		*
  153		 *******************************/
  154
  155:- multifile
  156	user:goal_expansion/2,
  157	user:term_expansion/2,
  158	user:file_search_path/2,
  159	user:prolog_file_type/2,
  160	ifprolog_goal_expansion/2,
  161	ifprolog_term_expansion/2.  162:- dynamic
  163	user:goal_expansion/2,
  164	user:term_expansion/2,
  165	user:file_search_path/2,
  166	user:prolog_file_type/2.  167
  168:- dynamic
  169	in_module_interface/1.  170
  171user:goal_expansion(In, Out) :-
  172	prolog_load_context(dialect, ifprolog),
  173	ifprolog_goal_expansion(In, Out).
  174
  175user:term_expansion(In, Out) :-
  176	prolog_load_context(dialect, ifprolog),
  177	ifprolog_term_expansion(In, Out).
 ifprolog_goal_expansion(+In, +Out)
goal_expansion rules to emulate IF/Prolog behaviour in SWI-Prolog. The expansions below maintain optimization from compilation. Defining them as predicates would loose compilation.



 context(:Goal, Handler)
Is mapped to catch(Goal, Error, Recover) is Handler is
error(_,_) => Recover. Other cases are not covered by the
emulation.





 asserta(Head, Body) is det


 assertz(Head, Body) is det


 retract(Head, Body) is det
Mapped to asserta((Head:-Body)), etc. Note that this masks
SWI-Prolog's asserta/2, etc.


  199ifprolog_goal_expansion(Module:Goal, Expanded) :-
  200	Module == system, nonvar(Goal), !,
  201	expand_goal(Goal, ExpandedGoal),
  202	head_pi(ExpandedGoal, PI),
  203	(   current_predicate(ifprolog:PI),
  204	    \+ predicate_property(ExpandedGoal, imported_from(_))
  205	->  Expanded = ifprolog:ExpandedGoal
  206	;   Expanded = ExpandedGoal
  207	).
  208ifprolog_goal_expansion(Goal, Expanded) :-
  209	if_goal_expansion(Goal, Expanded).
  210
  211if_goal_expansion(context(Goal, [Error => Recover]),
  212		  catch(Goal, Error, Recover)) :-
  213	assertion(Error = error(_,_)).
  214if_goal_expansion(assertz(Head,Body),
  215		  assertz((Head:-Body))).
  216if_goal_expansion(asserta(Head,Body),
  217		  asserta((Head:-Body))).
  218if_goal_expansion(retract(Head,Body),
  219		  retract((Head:-Body))).
  220if_goal_expansion(Call@Module, call((Module:Goal)@Module)) :-
  221	nonvar(Call),
  222	Call = call(Goal).
  223if_goal_expansion(concat_atom(L,A), if_concat_atom(L,A)).
  224if_goal_expansion(concat_atom(L,D,A), if_concat_atom(L,D,A)).
  225
  226
  227head_pi(M:Head, M:PI) :- !,
  228	head_pi(Head, PI).
  229head_pi(Head, Name/Arity) :-
  230	functor(Head, Name, Arity).



 ifprolog_term_expansion(+In, +Out)
term_expansion rules to emulate IF/Prolog behaviour in
SWI-Prolog.





 meta(+ListOfPI)
Mapped to module_transparent/1. Not sure whether this is
correct. It surely is not very elegant to map to a deprecated
feature. Luckily, although the module_transparent/1 API is
deprecated, the underlying functionality is still core of the
module system.



Note that if :- meta appears inside a module interface, the
predicate is also exported.





 export(+ListOfPI) is det


 discontiguous +ListOfPI is det
Mapped to comma-lists





 module(+Name)


 begin_module(+Name)


 end_module(+Name)
These are emulated correctly, provided module/1 is the first
term of the file and the implementation is part of the same
file. Begin/end are ignored.


  262ifprolog_term_expansion((:- meta([])), []).
  263ifprolog_term_expansion((:- meta(List)),
  264			[ (:- module_transparent(Spec))
  265			| Export
  266			]) :-
  267	pi_list_to_pi_term(List, Spec),
  268	(   in_module_interface(_)
  269	->  Export = [(:- export(Spec))]
  270	;   Export = []
  271	).
  272
  273ifprolog_term_expansion((:- export([])), []).
  274ifprolog_term_expansion((:- export(List)),
  275			(:- export(Spec))) :-
  276	is_list(List),
  277	pi_list_to_pi_term(List, Spec).
  278
  279ifprolog_term_expansion((:- private(_)), []).
  280
  281ifprolog_term_expansion((:- discontiguous([])), []).
  282ifprolog_term_expansion((:- discontiguous(List)),
  283			(:- discontiguous(Spec))) :-
  284	is_list(List),
  285	pi_list_to_pi_term(List, Spec).
  286
  287ifprolog_term_expansion((:- multifile([])), []).
  288ifprolog_term_expansion((:- multifile(List)),
  289			(:- multifile(Spec))) :-
  290	is_list(List),
  291	pi_list_to_pi_term(List, Spec).
  292
  293ifprolog_term_expansion((:- module(Name)),
  294			(:- module(Name, []))) :-
  295	asserta(in_module_interface(Name)).
  296ifprolog_term_expansion((:- begin_module(Name)), []) :-
  297	prolog_load_context(module, Loading),
  298	assertion(Name == Loading),
  299	retract(in_module_interface(Name)).
  300ifprolog_term_expansion((:- end_module(_)), []).
  301ifprolog_term_expansion((:- end_module), []).
  302ifprolog_term_expansion((:- nonotify), []).	% TBD: set verbosity
  303
  304
  305ifprolog_term_expansion((:- import(Module)),
  306			(:- use_module(File))) :-
  307	(   module_property(Module, file(File))
  308	->  true
  309	;   existence_error(module, Module)
  310	).
  311ifprolog_term_expansion((:- import(Module, ImportList)),
  312			(:- use_module(File, ImportList))) :-
  313	(   module_property(Module, file(File))
  314	->  true
  315	;   existence_error(module, Module)
  316	).



 pi_list_to_pi_term(+List, -CommaList) is det


  320pi_list_to_pi_term([PI], PI) :- !.
  321pi_list_to_pi_term([H|T], (H,CommaList)) :-
  322	pi_list_to_pi_term(T, CommaList).
  323
  324                 /*******************************
  325                 *          LIBRARY SETUP       *
  326                 *******************************/




 push_ifprolog_library
Pushes searching for dialect/ifprolog in front of every library
directory that contains such as sub-directory.


  333push_ifprolog_library :-
  334        (   absolute_file_name(library(dialect/ifprolog), Dir,
  335                               [ file_type(directory),
  336                                 access(read),
  337                                 solutions(all),
  338                                 file_errors(fail)
  339                               ]),
  340            asserta((user:file_search_path(library, Dir) :-
  341                    prolog_load_context(dialect, ifprolog))),
  342            fail
  343        ;   true
  344        ).



 push_ifprolog_file_extension
Looks for .pro files before looking for .pl files if the current
dialect is pro. If the dialect is not active, the .pro files
are found as last resort.


  352push_ifprolog_file_extension :-
  353	asserta((user:prolog_file_type(pro, prolog) :-
  354		prolog_load_context(dialect, ifprolog))).
  355
  356user:prolog_file_type(pro, prolog) :-
  357	\+ prolog_load_context(dialect, ifprolog).
  358
  359:- push_ifprolog_library,
  360   push_ifprolog_file_extension.  361
  362
  363		 /*******************************
  364		 *	    PREDICATES		*
  365		 *******************************/




 calling_context(-Context)
Mapped to context_module/1.


  371calling_context(Context) :-
  372	context_module(Context).



 context(:Goal, +Mapping)
IF/Prolog context/2 construct. This is the true predicate. This
is normally mapped by goal-expansion.




bug
- Does not deal with IF/Prolog signal mapping







  381context(M:Goal, Mapping) :-
  382	member(Error => Action, Mapping),
  383	nonvar(Error),
  384	Error = error(_,_), !,
  385	catch(M:Goal, Error, Action).
  386context(M:Goal, _Mapping) :-
  387	M:Goal.



 block(:Goal, +Tag, :Recovery)


 exit_block(+Tag)


 cut_block(+Tag) is semidet
The control construct block/3 runs Goal in a block labelled Tag.
If Goal calls exit_block/1 using a matching Tag, the execution
of Goal is abandoned using exception handling and execution
continues by running Recovery. Goal can call cut_block/1. If
there is a block with matching Tag, all choice points created
since the block was started are destroyed.




bug
- The block control structure is implemented on top of
catch/3 and throw/1. If catch/3 is used inside Goal,
the user must ensure that either (1) the protected
goal does not call exit_block/1 or cut_block/1 or (2)
the Catcher of the catch/3 call does not unify with
a term block(_,_).







  407block(Goal, Tag, Recovery) :-
  408	prolog_current_choice(Choice),
  409	catch(Goal, block(Tag, Choice), Recovery).
  410
  411exit_block(Tag) :-
  412	throw(block(Tag, _)).
  413
  414cut_block(Tag) :-
  415	prolog_current_frame(Frame),
  416	findall(Choice,			% use findall/3 to avoid binding
  417		prolog_frame_attribute(
  418		    Frame, parent_goal,
  419		    system:catch(_, block(Tag, Choice), _)),
  420		[Choice]),
  421	nonvar(Choice),
  422	prolog_cut_to(Choice).



 modify_mode(+PI, -OldMode, +NewMode) is det
Switch between static and dynamic code. Fully supported, but
notably changing static to dynamic code is not allowed if the
predicate has clauses.


  430modify_mode(PI, OldMode, NewMode) :-
  431	pi_head(PI, Head),
  432	old_mode(Head, OldMode),
  433	set_mode(PI, OldMode, NewMode).
  434
  435old_mode(Head, Mode) :-
  436	(   predicate_property(Head, dynamic)
  437	->  Mode = on
  438	;   Mode = off
  439	).
  440
  441set_mode(_, Old, Old) :- !.
  442set_mode(PI, _, on) :- !,
  443	dynamic(PI).
  444set_mode(PI, _, off) :-
  445	compile_predicates([PI]).
  446
  447pi_head(M:PI, M:Head) :- !,
  448	pi_head(PI, Head).
  449pi_head(Name/Arity, Term) :-
  450	functor(Term, Name, Arity).



 debug_mode(:PI, -Old, +New)
Old is not unified. Only New == off is mapped to disable
debugging of a predicate.


  457debug_mode(PI, _, off) :- !,
  458	'$hide'(PI).
  459debug_mode(_, _, on).



 ifprolog_debug(:Goal)
Map IF/Prolog debug(Goal)@Module. This should run Goal in debug
mode. We rarely needs this type of measures in SWI-Prolog.


  466ifprolog_debug(Goal) :-
  467	Goal.



 debug_config(+Key, -Current, +Value)
Ignored. Prints a message.


  473debug_config(Key,Current,Value) :-
  474	print_message(informational, ignored(debug_config(Key,Current,Value))).



 float_format(-Old, +New)
Ignored. Prints a message. Cannot be emulated. Printing floats
with a specified precision can only be done using format/2.


  481float_format(Old, New) :-
  482	print_message(informational, ignored(float_format(Old, New))).



 program_parameters(-List:atom)
All command-line argument, including the executable,


  488program_parameters(Argv) :-
  489	current_prolog_flag(os_argv, Argv).



 user_parameters(-List:atom)
Parameters after --.


  495user_parameters(Argv) :-
  496	current_prolog_flag(argv, Argv).



 match(+Mask, +Atom) is semidet
Same as once(match(Mask, Atom, _Replacements)).


  502match(Mask, Atom) :-
  503	match(Mask, Atom, _), !.



 match(+Mask, +Atom, ?Replacements) is nondet
Pattern matching. This emulation should be complete. Can be
optimized using caching of the pattern-analysis or doing the
analysis at compile-time.


  511match(Mask, Atom, Replacements) :-
  512	atom_codes(Mask, MaskCodes),
  513	atom_codes(Atom, Codes),
  514	phrase(match_pattern(Pattern), MaskCodes), !,
  515	pattern_goal(Pattern, Codes, Replacements, Goal),
  516	Goal.
  517
  518pattern_goal([], [], [], true).
  519pattern_goal([string(String)|T], Codes, Replacements, Goal) :- !,
  520	append(String, Rest, Codes),
  521	pattern_goal(T, Rest, Replacements, Goal).
  522pattern_goal([star|T], Codes, [Atom|Replacements], Goal) :-
  523	append(Replacement, Rest, Codes),
  524	Goal = (atom_codes(Atom, Replacement),Goal2),
  525	pattern_goal(T, Rest, Replacements, Goal2).
  526pattern_goal([set(S)|T], [C|Rest], [Atom|Replacements], Goal) :-
  527	memberchk(C, S), !,
  528	Goal = (char_code(Atom, C),Goal2),
  529	pattern_goal(T, Rest, Replacements, Goal2).
  530pattern_goal([any|T], [C|Rest], [Atom|Replacements], Goal) :-
  531	Goal = (char_code(Atom, C),Goal2),
  532	pattern_goal(T, Rest, Replacements, Goal2).
  533
  534match_pattern([set(S)|T]) -->
  535	"[",
  536	match_set(S), !,
  537	match_pattern(T).
  538match_pattern([string(List)|T]) -->
  539	non_special(List),
  540	{ List \== [] }, !,
  541	match_pattern(T).
  542match_pattern([star|T]) -->
  543	"*", !,
  544	match_pattern(T).
  545match_pattern([any|T]) -->
  546	"?", !,
  547	match_pattern(T).
  548match_pattern([]) --> [].
  549
  550match_set([]) --> "]", !.
  551match_set(L) -->
  552	[C0], "-", [C1],
  553	{ C1 \= 0'],
  554	  C0 =< C1,
  555	  numlist(C0, C1, Range),
  556	  append(Range, T, L)
  557	},
  558	match_set(T).
  559match_set([C|L]) -->
  560	[C],
  561	match_set(L).
  562
  563non_special([H|T]) -->
  564	[H],
  565	{ \+ special(H) }, !,
  566	non_special(T).
  567non_special([]) --> [].
  568
  569special(0'*).
  570special(0'?).
  571special(0'[).



 lower_upper(+Lower, -Upper) is det


lower_upper(-Lower, +Upper) is det
Multi-moded combination of upcase_atom/2 and downcase_atom/2.


  579lower_upper(Lower, Upper) :-
  580	nonvar(Lower), !,
  581	upcase_atom(Lower, Upper).
  582lower_upper(Lower, Upper) :-
  583	downcase_atom(Upper, Lower).



 load(File)
Mapped to consult. I think that the compatible version should
only load .qlf (compiled) code.


  590load(File) :-
  591	consult(File).



 unload(+Module) is det
Unload the named module.




bug
- : What to do with modules that are not associated to a
file?







  600unload(Module) :-
  601	module_property(Module, file(File)), !,
  602	unload_file(File).
  603unload(_Module) :-
  604	assertion(fail).



 file_test(+File, +Mode)
Mapped to access_file/2 (which understand more modes). Note that
this predicate is defined in the module system to allow for
direct calling.


  612file_test(File, Mode) :-
  613	access_file(File, Mode).



 filepos(@Stream, -Line)
from the IF/Prolog documentation The predicate filepos/2
determines the current line position of the specified input
stream and unifies the result with Line. The current line
position is the number of line processed + 1


  622filepos(Stream, Line) :-
  623	line_count(Stream, L),
  624	Line is L + 1.



 getcwd(-Dir)
The predicate getcwd/1 unifies Dir with the full pathname of the
current working directory.


  632getcwd(Dir) :-
  633	working_directory(Dir, Dir).



 filepos(@Stream, -Line, -Column)
from the IF/Prolog documentation The predicate filepos/2
determines the current line position of the specified input
stream and unifies the result with Line. The current line
position is the number of line processed + 1


  642filepos(Stream, Line, Column) :-
  643	line_count(Stream, L),
  644	line_position(Stream, C),
  645	Line is L + 1,
  646	Column is C + 1.



 assign_alias(+Alias, @Stream) is det


  651assign_alias(Alias, Stream) :-
  652	set_stream(Stream, alias(Alias)).



 writeq_atom(+Term, -Atom)
Use writeq/1 to write Term to Atom.


  658writeq_atom(Term, Atom) :-
  659	with_output_to(atom(Atom), writeq(Term)).



 write_atom(+Term, -Atom)
Use write/1 to write Term to Atom.


  665write_atom(Term, Atom) :-
  666	with_output_to(atom(Atom), write(Term)).



 current_error(-Stream)
Doesn't exist in SWI-Prolog, but user_error is always an alias
to the current error stream.


  673current_error(user_error).
  674
  675
  676		 /*******************************
  677		 *	  FORMATTED WRITE	*
  678		 *******************************/




 write_formatted_atom(-Atom, +Format, +ArgList) is det


 write_formatted(+Format, +ArgList) is det


 write_formatted(@Stream, +Format, +ArgList) is det
Emulation of IF/Prolog formatted write. The emulation is very
incomplete. Notable asks for dealing with aligned fields, etc.




bug
- Not all format characters are processed
- Incomplete processing of modifiers, fieldwidth and precision


To be done
- This should become goal-expansion based to process
format specifiers at compile-time.







  692write_formatted_atom(Atom, Format, ArgList) :-
  693	with_output_to(atom(Atom), write_formatted(Format, ArgList)).
  694
  695write_formatted(Format, ArgList) :-
  696	write_formatted(current_output, Format, ArgList).
  697
  698write_formatted(Out, Format, ArgList) :-
  699	atom_codes(Format, Codes),
  700	phrase(format_string(FormatCodes), Codes), !,
  701	string_codes(FormatString, FormatCodes),
  702	format(Out, FormatString, ArgList).
  703
  704format_string([]) --> [].
  705format_string(Fmt) -->
  706	"%", format_modifiers(Flags, FieldLen, Precision), [IFC], !,
  707	{   map_format([IFC], Flags, FieldLen, Precision, Repl)
  708	->  append(Repl, T, Fmt)
  709	;   print_message(warning, ifprolog_format(IFC)),
  710	    %backtrace(20),
  711	    T = Fmt
  712	},
  713	format_string(T).
  714format_string([H|T]) -->
  715	[H],
  716	format_string(T).
  717
  718map_format(Format, [], default, default, Mapped) :- !,
  719	map_format(Format, Mapped).
  720map_format(Format, Flags, Width, Precision, Mapped) :-
  721	integer(Width), !,			% left/right aligned in Width
  722	map_format(Format, Field),
  723	format_precision(Precision, Field, PrecField),
  724	fill_code(Flags, [Fill]),
  725	(   memberchk(-, Flags)			% left aligned
  726	->  format(codes(Mapped), '~~|~s~~`~ct~~~d+', [PrecField, Fill, Width])
  727	;   format(codes(Mapped), '~~|~~`~ct~s~~~d+', [Fill, PrecField, Width])
  728	).
  729map_format(Format, Flags, _, _, Mapped) :-
  730	memberchk(#, Flags),
  731	can_format(Format, Mapped), !.
  732map_format(Format, _, _, Precision, Mapped) :-
  733	map_format(Format, Field),
  734	format_precision(Precision, Field, Mapped).
  735
  736can_format("o", "0~8r").
  737can_format("x", "0x~16r").
  738can_format("X", "0x~16R").
  739can_format("w", "~k").
  740
  741map_format("t", "~w").
  742map_format("q", "~q").
  743map_format("s", "~a").
  744map_format("f", "~f").
  745map_format("e", "~e").
  746map_format("E", "~E").
  747map_format("g", "~G").
  748map_format("d", "~d").
  749map_format("x", "~16r").
  750map_format("o", "~8r").
  751map_format("X", "~16R").
  752map_format("O", "~8R").
  753map_format("c", "~c").
  754map_format("%", "%").
  755
  756have_precision("d").
  757have_precision("D").
  758have_precision("e").
  759have_precision("E").
  760have_precision("f").
  761have_precision("g").
  762have_precision("G").
  763
  764format_precision(N, [0'~|C], [0'~|Field]) :-
  765    integer(N),
  766    have_precision(C),
  767    !,
  768    format(codes(Field), '~d~s', [N, C]).
  769format_precision(_, Field, Field).
  770
  771fill_code(Flags, "0") :- memberchk(0, Flags), !.
  772fill_code(_,     " ").



 format_modifiers(-Flags, -FieldLength, -Precision) is det
Read the IF/Prolog format modifiers. We currently do not process
any of the modifiers! Some code seems to be using e.g. %07lx. We
assume this is the same as -07x (assuming l=left).


  780format_modifiers(Flags, FieldLength, Precision) -->
  781	format_flags(Flags0),
  782	digits(FieldLengthDigits),
  783	{   FieldLengthDigits == []
  784	->  FieldLength = default
  785	;   number_codes(FieldLength, FieldLengthDigits)
  786	},
  787	(   "."
  788	->  digits(PrecisionDigits),
  789	    { number_codes(Precision, PrecisionDigits) }
  790	;   { Precision = default }
  791	),
  792	opt_alignment(Flags0, Flags).
  793
  794format_flags([H|T]) -->
  795	format_flag(H), !,
  796	format_flags(T).
  797format_flags([]) --> [].
  798
  799format_flag(+) --> "+".		% Always prefix number with a sign
  800format_flag(-) --> "-".		% Left-justify
  801format_flag(space) --> " ".	% Space before positive numbers
  802format_flag(#) --> "#".		% Canonical output
  803format_flag(0) --> "0".		% Use leading 0 for integers
  804
  805digits([D0|T]) -->
  806	digit(D0), !,
  807	digits(T).
  808digits([]) --> [].
  809
  810digit(D) --> [D], {between(0'0, 0'9, D)}.
  811
  812opt_alignment(L, [-|L]) --> "l", !.
  813opt_alignment(L, L) --> [].



 get_until(+SearchChar, -Text, -EndChar) is det


 get_until(@Stream, +SearchChar, -Text, -EndChar) is det
Read input from Stream until SearchChar. Unify EndChar with
either SearchChar or the atom end_of_file.


  822get_until(SearchChar, Text, EndChar) :-
  823	get_until(current_input, SearchChar, Text, EndChar).
  824
  825get_until(In, SearchChar, Text, EndChar) :-
  826	get_char(In, C0),
  827	get_until(C0, In, SearchChar, Codes, EndChar),
  828	atom_chars(Text, Codes).
  829
  830get_until(C0, _, C0, [], C0) :- !.
  831get_until(end_of_file, _, _,  [], end_of_file) :- !.
  832get_until(C0, In, Search, [C0|T], End) :-
  833	get_char(In, C1),
  834	get_until(C1, In, Search, T, End).
  835
  836
  837		 /*******************************
  838		 *	      PARSE		*
  839		 *******************************/




 atom_part(+Atom, +Pos, +Len, -Sub) is det
True when Sub is part of the atom [Pos,Pos+Len). Unifies Sub
with '' if Pos or Len is out of range!?


  846atom_part(_, Pos, _, Sub) :-
  847	Pos < 1, !,
  848	Sub = ''.
  849atom_part(_, _, Len, Sub) :-
  850	Len < 1, !,
  851	Sub = ''.
  852atom_part(Atom, Pos, _, Sub) :-
  853	atom_length(Atom, Len),
  854	Pos > Len, !,
  855	Sub = ''.
  856atom_part(Atom, Pos, Len, Sub) :-
  857	Pos >= 1,
  858	Pos0 is Pos - 1,
  859	atom_length(Atom, ALen),
  860	Len0 is min(Len, ALen-Pos0),
  861	sub_atom(Atom, Pos0, Len0, _, Sub).



 atom_prefix(+Atom, +Len, -Sub) is det
Unifies Sub with the atom formed by the first Len characters in
atom.




  871atom_prefix(_, Len, Sub) :-
  872	Len < 1, !,
  873	Sub = ''.
  874atom_prefix(Atom, Len, Sub) :-
  875	atom_length(Atom, AtomLen),
  876	Len > AtomLen, !,
  877	Sub = Atom.
  878atom_prefix(Atom, Len, Sub) :-
  879	sub_atom(Atom, 0, Len, _, Sub).



 atom_suffix(+Atom, +Len, -Sub) is det
Unifies Sub with the atom formed by the last Len characters in
atom.




  889atom_suffix(_, Len, Sub) :-
  890	Len < 1, !,
  891	Sub = ''.
  892atom_suffix(Atom, Len, Sub) :-
  893	atom_length(Atom, AtomLen),
  894	Len > AtomLen, !,
  895	Sub = Atom.
  896atom_suffix(Atom, Len, Sub) :-
  897	atom_length(Atom, AtomLen),
  898	Pos is AtomLen - Len,
  899	sub_atom(Atom, Pos, Len, _, Sub).



 atom_split(+Atom, +Delimiter, ?Subatoms)
Split Atom over Delimiter and unify the parts with Subatoms.


  905atom_split(Atom, Delimiter, Subatoms)  :-
  906	atomic_list_concat(Subatoms, Delimiter, Atom).



 if_concat_atom(+List, +Delimiter, -Atom) is det
True when Atom is the concatenation of the lexical form of all
elements from List, using Delimiter to delimit the elements.



The behavior of this ifprolog predicate is different w.r.t.
SWI-Prolog in two respect: it supports arbitrary terms in List
rather than only atomic and it does not work in mode -,+,+.


  917if_concat_atom(List, Delimiter, Atom) :-
  918	maplist(write_term_to_atom, List, AtomList),
  919	atomic_list_concat(AtomList, Delimiter, Atom).
  920
  921write_term_to_atom(Term, Atom) :-
  922	(   atomic(Term)
  923	->  Atom = Term
  924	;   with_output_to(string(Atom), write(Term))
  925	).



 if_concat_atom(+List, -Atom) is det
True when Atom is the concatenation of the lexical form of all
elements from List. Same as if_concat_atom/3 using '' as
delimiter.


  933if_concat_atom(List, Atom) :-
  934	maplist(write_term_to_atom, List, AtomList),
  935	atomic_list_concat(AtomList, Atom).



 getchar(+Atom, +Pos, -Char)
Unifies Char with the Position-th character in Atom
If Pos < 1 or Pos > length of Atom, then fail.


  942getchar(_, Pos, _) :-
  943	Pos < 1, !,
  944	fail.
  945getchar(Atom, Pos, _) :-
  946	atom_length(Atom, Len),
  947	Pos > Len, !,
  948	fail.
  949getchar(Atom, Pos, Char) :-
  950	P is Pos - 1,
  951	sub_atom(Atom, P, 1, _, Char).



 parse_atom(+Atom, +StartPos, ?EndPos, ?Term, ?VarList, ?Error)
Read from an atom.




Arguments:





StartPos- is 1-based position to start reading


Error- is the 1-based position of a syntax error or 0 if
there is no error.












  962parse_atom(Atom, StartPos, EndPos, Term, VarList, Error) :-
  963	setup_call_cleanup(
  964	    ( atom_to_memory_file(Atom, MemF),
  965	      open_memory_file(MemF, read, In)
  966	    ),
  967	    ( StartPos0 is StartPos-1,
  968	      seek(In, StartPos0, bof, _),
  969	      catch(read_term(In, Term, [variable_names(VarList)]), E, true),
  970	      parse_atom_error(E, Error),
  971	      character_count(In, EndPos0),
  972	      EndPos is EndPos0+1
  973	    ),
  974	    ( close(In),
  975	      free_memory_file(MemF)
  976	    )).
  977
  978parse_atom_error(Var, Pos) :-
  979	var(Var), !, Pos = 0.
  980parse_atom_error(error(_, stream(_Stream, _, _, Pos)), Pos1) :-
  981	Pos1 is Pos+1.



 index(+Atom, +String, -Position) is semidet
True when Position is the first occurrence of String in Atom.
Position is 1-based.


  989index(Atom, String, Position) :-
  990	sub_string(Atom, Pos0, _, _, String), !,
  991        Position is Pos0 + 1.



 list_length(+List, ?Length) is det
Deterministic version of length/2. Current implementation simply
calls length/2.


  998list_length(List, Length) :-
  999	length(List, Length).
 1000
 1001
 1002		 /*******************************
 1003		 *	      MISC		*
 1004		 *******************************/




 for(+Start, ?Count, +End) is nondet
Similar to between/3, but can count down if Start > End.


 1010for(Start, Count, End) :-
 1011	Start =< End, !,
 1012	between(Start, End, Count).
 1013for(Start, Count, End) :-
 1014	nonvar(Count), !,
 1015	between(End, Start, Count).
 1016for(Start, Count, End) :-
 1017	Range is Start-End,
 1018	between(0, Range, X),
 1019	Count is Start-X.



 prolog_version(-Version)
Return IF/Prolog simulated version string


 1025prolog_version(Version) :-
 1026	current_prolog_flag(version_data, swi(Major, Minor, Patch, _)),
 1027	atomic_list_concat([Major, Minor, Patch], '.', Version).



 proroot(-Path)
True when Path is the installation location of the Prolog
system.


 1034proroot(Path) :-
 1035	current_prolog_flag(home, Path).



 system_name(-SystemName)
True when SystemName identifies the operating system. Note that
this returns the SWI-Prolog arch flag, and not the IF/Prolog
identifiers.


 1043system_name(SystemName) :-
 1044	current_prolog_flag(arch, SystemName).



 localtime(+Time, ?Year, ?Month, ?Day, ?DoW, ?DoY, ?Hour, ?Min, ?Sec)
Break system time into its components. Deefines components:




YearYear number4 digits


MonthMonth number1..12


DayDay of month1..31


DoWDay of week1..7 (Mon-Sun)


DoYDay in year1..366


HourHours0..23


MinMinutes0..59


SecSeconds0..59






Note that in IF/Prolog V4, Year is 0..99, while it is a
four-digit number in IF/Prolog V5. We emulate IF/Prolog V5.


 1062localtime(TimeExpr, Year, Month, Day, DoW, DoY, Hour, Min, Sec) :-
 1063	arithmetic_expression_value(TimeExpr, Time),
 1064        stamp_date_time(Time, date(Year, Month, Day,
 1065				   Hour, Min, SecFloat,
 1066				   _Off, _TZ, _DST), local),
 1067        Sec is floor(SecFloat),
 1068	Date = date(Year,Month,Day),
 1069	day_of_the_year(Date, DoY),
 1070        day_of_the_week(Date, DoW).



 current_global(+Name) is semidet


 get_global(+Name, ?Value) is det


 set_global(+Name, ?Value) is det


 unset_global(+Name) is det
IF/Prolog global variables, mapped to SWI-Prolog's nb_*
predicates.


 1081current_global(Name) :-
 1082	gvar_name(Name, GName),
 1083	nb_current(GName, _).
 1084
 1085get_global(Name, Value) :-
 1086	gvar_name(Name, GName),
 1087	nb_getval(GName, Value).
 1088
 1089set_global(Name, Value) :-
 1090	gvar_name(Name, GName),
 1091	nb_setval(GName, Value).
 1092
 1093unset_global(Name) :-
 1094	gvar_name(Name, GName),
 1095	nb_delete(GName).
 1096
 1097gvar_name(Module:Name, GName) :-
 1098	atomic_list_concat([Module, :, Name], GName).



 current_default_module(-Module) is det
Name of the toplevel typein module.


 1105current_default_module(Module) :-
 1106	'$current_typein_module'(Module).



 set_default_module(+Module) is det
Set the default toplevel module.


 1112set_default_module(Module) :-
 1113	module(Module).
 1114
 1115
 1116		 /*******************************
 1117		 *	      DATABASE		*
 1118		 *******************************/
 1119
 1120:- dynamic
 1121	names/2.



 asserta_with_names(@Clause, +VarNames) is det


 assertz_with_names(@Clause, +VarNames) is det


 clause_with_names(?Head, ?Body, -VarNames) is det


 retract_with_names(?Clause, -VarNames) is det
Predicates that manage the database while keeping track of
variable names.


 1131asserta_with_names(M:Clause, VarNames) :-
 1132	term_varnames(Clause, VarNames, VarTerm),
 1133	system:asserta(M:Clause, Ref),
 1134	asserta(names(Ref, VarTerm)).
 1135assertz_with_names(M:Clause, VarNames) :-
 1136	term_varnames(Clause, VarNames, VarTerm),
 1137	system:assertz(M:Clause, Ref),
 1138	asserta(names(Ref, VarTerm)).
 1139
 1140term_varnames(Term, VarNames, VarTerm) :-
 1141	findall(Vars,
 1142		( term_variables(Term, Vars),
 1143		  bind_names(VarNames)
 1144		),
 1145		[ VarList ]),
 1146	VarTerm =.. [ v | VarList ].
 1147
 1148bind_names([]).
 1149bind_names([Name=Var|T]) :-
 1150	Name=Var,
 1151	bind_names(T).
 1152
 1153
 1154clause_with_names(M:Head, Body, VarNames) :-
 1155	clause(M:Head, Body, Ref),
 1156	(   names(Ref, VarTerm)
 1157	->  term_variables((Head:-Body), Vars),
 1158	    VarTerm =.. [v|NameList],
 1159	    make_bindings(NameList, Vars, VarNames)
 1160	;   VarNames = []
 1161	).
 1162
 1163retract_with_names(M:Term, VarNames) :-
 1164	clause(M:Term, Ref),
 1165	erase(Ref),
 1166	(   retract(names(Ref, VarTerm))
 1167	->  term_variables((Term), Vars),
 1168	    VarTerm =.. [v|NameList],
 1169	    make_bindings(NameList, Vars, VarNames)
 1170	;   VarNames = []
 1171	).
 1172
 1173make_bindings([], [], []).
 1174make_bindings([Name|NT], [Var|VT], [Name=Var|BT]) :-
 1175	make_bindings(NT, VT, BT).



 predicate_type(:PI, -Type) is det
True when Type describes the type of PI. Note that the value
linear seems to mean you can use clause/2 on it, which is true
for any SWI-Prolog predicate that is defined. Therefore, we use
it for any predicate that is defined.


 1185predicate_type(M:Name/Arity, Type) :-
 1186	functor(Head, Name, Arity),
 1187	Pred = M:Head,
 1188	(   (   predicate_property(Pred, built_in)
 1189	    ;	predicate_property(Pred, foreign)
 1190	    )
 1191	->  Type = builtin
 1192	;   predicate_property(Pred, imported_from(_))
 1193	->  Type = imported
 1194	;   predicate_property(Pred, dynamic)
 1195	->  Type = linear
 1196	;   control(Head)
 1197	->  Type = control
 1198	;   Name == call
 1199	->  Type = control
 1200	;   current_predicate(M:Name/Arity)
 1201	->  Type = linear
 1202	;   Type = undefined
 1203	).
 1204
 1205control((_,_)).
 1206control((_;_)).
 1207control((_->_)).
 1208control((_*->_)).
 1209control((!)).



 current_visible(@Module, @PredicateIndicator)
FIXME check with documentation


 1215current_visible(Module, Name/Arity) :-
 1216	atom(Name), integer(Arity), !,
 1217	functor(Head, Name, Arity),
 1218	predicate_property(Module:Head, visible).
 1219current_visible(Module, Name/Arity) :-
 1220	predicate_property(Module:Head, visible),
 1221	functor(Head, Name, Arity).



 current_signal(?Signal, ?Mode) is nondet
True when Mode is the current mode for handling Signal. Modes
are on, off, default, ignore. Signals are abort,
alarm, interrupt, pipe, quit, termination, user_1
and user_2.




To be done
- Implement







 1232current_signal(_,_) :- fail.



 digit(+A)
Is the character A a digit [0-9]


 1238digit(A) :-
 1239	char_type(A, digit).



 letter(+A)
Is the character A a letter [A-Za-z]


 1244letter(A) :-
 1245	char_type(A, alpha).
 1246
 1247		 /*******************************
 1248		 *	    ARITHMETIC		*
 1249		 *******************************/
 1250
 1251:- arithmetic_function(system:time/0). 1252:- arithmetic_function(system:trunc/1). 1253:- arithmetic_function(system:ln/1). 1254:- arithmetic_function(system:minint/0). 1255:- arithmetic_function(system:maxint/0). 1256:- arithmetic_function(system:dbsize/0). 1257:- arithmetic_function(system:dbused/0). 1258:- arithmetic_function(system:ssize/0). 1259:- arithmetic_function(system:gused/0). 1260:- arithmetic_function(system:lused/0). 1261:- arithmetic_function(system:tused/0). 1262
 1263system:time(Time) :-
 1264	get_time(GetTime),
 1265	Time is round(GetTime).  % Time in seconds since 1970-01-01 00:00:00 UTC
 1266system:trunc(Val, Trunc) :-
 1267	Trunc is truncate(Val).
 1268system:ln(Val, Log) :-
 1269	Log is log(Val).
 1270system:minint(MinInt) :-
 1271	MinInt is -1<<31.
 1272system:maxint(MaxInt) :-
 1273	MaxInt is 1<<31 - 1.
 1274system:dbsize(0).
 1275system:dbused(0).
 1276system:ssize(Size) :-
 1277	statistics(globallimit, Size).
 1278system:gused(Size) :-
 1279	statistics(globalused, Size).
 1280system:lused(Size) :-
 1281	statistics(localused, Size).
 1282system:tused(Size) :-
 1283	statistics(trailused, Size).
 1284
 1285
 1286		 /*******************************
 1287		 *	       MESSAGES		*
 1288		 *******************************/
 1289
 1290prolog:message(ifprolog_format(IFC)) -->
 1291	[ 'Unknown specifier for write_formatted/3: ~c'-[IFC] ].
 1292
 1293
 1294		 /*******************************
 1295		 *	  COLOUR SUPPORT	*
 1296		 *******************************/
 1297
 1298:- multifile
 1299	prolog_colour:style/2,
 1300	prolog_colour:goal_colours/2. 1301
 1302prolog_colour:goal_colours(meta(_),
 1303			   ifprolog-[predicates]).
 1304prolog_colour:goal_colours(private(_),
 1305			   ifprolog-[predicates]).
 1306prolog_colour:goal_colours(import(Module,_),
 1307			   ifprolog-[module(Module),predicates]).
 1308prolog_colour:goal_colours(begin_module(Module),
 1309			   ifprolog-[module(Module)]).
 1310prolog_colour:goal_colours(end_module(Module),
 1311			   ifprolog-[module(Module)]).
 1312prolog_colour:goal_colours(end_module,
 1313			   ifprolog-[]).
 1314prolog_colour:goal_colours(nonotify,
 1315			   ifprolog-[]).
 1316
 1317prolog_colour:style(goal(ifprolog,_), [ colour(blue), background(lightcyan) ])