% Predicates to export to other module files:

% Instead of setting these, call SWI like this: pl -G 0 -L 0
% That gives maximal stack sizes.

%:- limit_stack(local,20000).
%:- limit_stack(global,4000).

% also use 'goal' key in save_program/2 to save init. goal
% but may be best to qcompile/1 the system, and use qload/1 for loading state

:- module(site,[remove_dups/2,head/2,t_style_check/1,t_no_style_check/1,rev/2,
    t_open/3,t_write/2,t_working_directory/1,file_exists/1,
    t_absolute_file_name/3,directory_exists/1,t_write/1,t_see/1,
    t_read_term/2,t_tell/1,file_must_exist/1,is_lower/1,is_alnum/1,
    samsort/2,p_vertices/2,p_transpose/2,selectchk/3,warshall/2,t_abolish/1,
    s_transpose/2,getpid/1,last/3,t_reconsult/1,unix/1,ord_intersect/3,
    t_samsort/3,string_append/3,t_div/3,p_to_s_graph/2,s_to_p_graph/2,
    write_backslash/0,fail_if_undefined/1,get_line/1,append/2,nonmember/2,
    keys_and_values/3,print_length/2,gensym/2,t_select/3,close_all_streams/0,
    basic_save_state/2,
% basic_load_state/1, - waiting for Carsten on this one - also add it below
    compile/1,environ/2,ord_subset/2,ord_intersection/3,ord_add_element/3,
    ord_union/3,site_import/2,get_assoc/3,put_assoc/4,ord_union/2,
    ord_del_element/3,ord_subtract/3,ord_intersect/2,ord_intersection/2,
    on_exception/3,t_print_message/2,t_cputime/1]).

:- module_transparent remove_dups/2,head/2,t_style_check/1,t_no_style_check/1,rev/2,
    t_open/3,t_write/2,t_working_directory/1,file_exists/1,
    t_absolute_file_name/3,directory_exists/1,t_write/1,t_see/1,
    t_read_term/2,t_tell/1,file_must_exist/1,is_lower/1,is_alnum/1,
    samsort/2,p_vertices/2,p_transpose/2,selectchk/3,warshall/2,t_abolish/1,
    s_transpose/2,getpid/1,last/3,t_reconsult/1,unix/1,ord_intersect/3,
    t_samsort/3,string_append/3,t_div/3,p_to_s_graph/2,s_to_p_graph/2,
    write_backslash/0,fail_if_undefined/1,get_line/1,append/2,nonmember/2,
    keys_and_values/3,print_length/2,gensym/2,t_select/3,close_all_streams/0,
    basic_save_state/2,
%   basic_load_state/1,
    compile/1,environ/2,ord_subset/2,ord_intersection/3,ord_add_element/3,
    ord_union/3,site_import/2,get_assoc/3,put_assoc/4,ord_union/2,
    ord_del_element/3,ord_subtract/3,ord_intersect/2,ord_intersection/2,
    t_print_message/2,on_exception/3,t_cputime/1.
%
% BUILT-IN: memberchk/2,is_list/1,member/2,reverse/2,concat_atom/2,concat/3
%

%
% LIBRARY MODULES:
%

:- use_module(library(gensym)).  % gensym/2
:- use_module(library(quintus)). % unix/1

%
% PREDICATES WITH DIFFERENT NAMES IN SWI:
%

compile(File) :-
  consult(File).

remove_dups(List,Set) :-
  sort(List,Set).  % better than list_to_set, which might unify 
                        %  non-ground terms

t_abolish(P/A) :-
  abolish(P,A).

% Vertausche Argumente!
t_read_term(X,Y) :-
	user:read_term(Y,X).

file_exists(X) :-
	exists_file(X).
file_must_exist(X) :-
	exists_file(X).
directory_exists(X) :-
	exists_directory(X).

string_append(X,Y,Z) :-
	concat(X,Y,Z).

% SWI write/1 does not respect $VAR syntax, but print/1 does.

t_write(X) :-
        print(X).
t_write(Stream,Term) :-
        print(Stream,Term).

:- set_feature(character_escapes,false).

% from the days before we knew how to turn char. escapes off:
write_backslash :-
	write('\').

% Style checking is different in SWI.
% WARNING: no_style_check(multiple) DOES NOT WORK IN SWI!!!
t_style_check(multiple)	:-
	!.
%	write('Sorry, NO multiple-style-check under SWI!'),
%	nl.

t_style_check(discontiguous) :-
	!,
	style_check(+discontiguous).
t_style_check(single_var) :-
	!,
	style_check(+singleton).
t_style_check(all) :-
	!,
	style_check(+discontiguous),
	style_check(+singleton).
t_style_check(X) :-
	style_check(+X).

t_no_style_check(multiple) :-
	!.
%	write('Sorry, NO multiple-style-check under SWI!'),
%	nl.
t_no_style_check(discontiguous)	:-
	!,
	style_check(-discontiguous).
t_no_style_check(single_var) :-
	!,
	style_check(-singleton).
t_no_style_check(all) :-
	!,
	style_check(-discontiguous),
	style_check(-singleton).
t_no_style_check(X) :-
	style_check(-X).

environ(Name,Value) :-
  getenv(Name,Value).

% SICStus and Quintus do this the *right* way.
t_select(Elt,List,Residue) :-
  select(List,Elt,Residue).

% ordset library predicates are built-in

ord_intersect(A,B,SortedC) :-
  intersection(A,B,C),
  sort(C,SortedC).
ord_intersection(A,B,SortedC) :-
  intersection(A,B,C),
  sort(C,SortedC).

ord_subset(Subset,Set) :-
  subset(Subset,Set).

ord_add_element(OldS,Elt,NewS) :-
  union(OldS,[Elt],NewS).

ord_union(S1,S2,S3) :-
  union(S1,S2,S3).

ord_union(Ss,U) :-
  ord_union2(Ss,[],U).

ord_union2([],Accum,Accum).
ord_union2([S|Ss],Accum,U) :-
  union(S,Accum,NewAccum),
  ord_union2(Ss,NewAccum,U).

ord_del_element(S1,Elt,S2) :-
  subtract(S1,[Elt],S2).

ord_subtract(S1,S2,Diff) :-
  subtract(S1,S2,Diff).

ord_intersect(S1,S2) :-
  intersection(S1,S2,Int),
  Int \== [].

ord_intersection([],[]).
ord_intersection([S|Ss],Int) :-
  ord_intersection2(Ss,S,Int).

ord_intersection2([],Accum,Accum).
ord_intersection2([S|Ss],Accum,Int) :-
  ord_intersection(S,Accum,NewAccum),
  ord_intersection2(Ss,NewAccum,Int).

site_import(M,Preds) :-
  M:use_module(troll_home(swi),Preds).


%
% PREDICATES THAT DON'T EXIST IN SWI:
%

:- ensure_loaded('swi_additions/samsort.pl'). % samsort/2, samsort/3
:- ensure_loaded('swi_additions/graphs.pl'). % p_vertices/2, p_transpose/2,
                                                 % warshall/2, s_transpose/2, 
                                               % p_to_s_graph/2, s_to_p_graph/2
:- ensure_loaded('swi_additions/sets.pl').    % selectchk/3
:- ensure_loaded('swi_additions/printlength.pl'). % print_length/2
:- ensure_loaded('swi_additions/assoc.pl').  % get_assoc/3, put_assoc/4

head([H|_],H).

append([],[]).
append([LsFirst|LsRest],L) :-
  append_act(LsFirst,LsRest,L).
append_act([],LsRest,L) :-
  append(LsRest,L).
append_act([X|LsFirst],LsRest,[X|L]) :-
  append_act(LsFirst,LsRest,L).

nonmember(X,L) :-
  \+ member(X,L).

keys_and_values([],[],[]).
keys_and_values([K-V|KVs],[K|Ks],[V|Vs]) :-
  keys_and_values(KVs,Ks,Vs).

rev(List, Revs) :-
        rev(List, [], Revs).
rev([], Revs, Revs).
rev([Head|Tail], Accum, Revs) :-
        rev(Tail, [Head|Accum], Revs).

t_working_directory(WD) :-
  environ('PWD',WD).

%%% there is a last/2 but no last/3

last(Fore,L,[Head|Tail]) :-
  last_act(Tail,Head,L,Fore).
last_act([],L,L,[]).
last_act([H|T],Head,L,[Head|Fore]) :-
  last_act(T,H,L,Fore).

% The option 'text' is called 'txt' in SWI
t_absolute_file_name(F,O,R) :-
	swi_replace(O,file_type(text),file_type(txt),O1),
	absolute_file_name(F,O1,R).
swi_replace([],_,_,[]).
swi_replace([H|T1],A,B,R) :-
	( H = A ->
	    R = [B|R1]
	;   R = [H|R1] ),
	swi_replace(T1,A,B,R1).


is_lower(97).  is_lower(98).  is_lower(99).  is_lower(100).
is_lower(101).  is_lower(102).  is_lower(103).  is_lower(104).
is_lower(105).  is_lower(106).  is_lower(107).  is_lower(108).
is_lower(109).  is_lower(110).  is_lower(111).  is_lower(112).
is_lower(113).  is_lower(114).  is_lower(115).  is_lower(116).
is_lower(117).  is_lower(118).  is_lower(119).  is_lower(120).
is_lower(121).  is_lower(122).  is_lower(224).  is_lower(225).
is_lower(226).  is_lower(227).  is_lower(228).  is_lower(229).
is_lower(230).  is_lower(231).  is_lower(232).  is_lower(233).
is_lower(234).  is_lower(235).  is_lower(236).  is_lower(237).
is_lower(238).  is_lower(239).  is_lower(240).  is_lower(241).
is_lower(242).  is_lower(243).  is_lower(244).  is_lower(245).
is_lower(246).  is_lower(247).  is_lower(248).  is_lower(249).
is_lower(250).  is_lower(251).  is_lower(252).  is_lower(253).
is_lower(254).

is_alnum(48).  is_alnum(49).  is_alnum(50).  is_alnum(51).
is_alnum(52).  is_alnum(53).  is_alnum(54).  is_alnum(55).
is_alnum(56).  is_alnum(57).  is_alnum(65).  is_alnum(66).
is_alnum(67).  is_alnum(68).  is_alnum(69).  is_alnum(70).
is_alnum(71).  is_alnum(72).  is_alnum(73).  is_alnum(74).
is_alnum(75).  is_alnum(76).  is_alnum(77).  is_alnum(78).
is_alnum(79).  is_alnum(80).  is_alnum(81).  is_alnum(82).
is_alnum(83).  is_alnum(84).  is_alnum(85).  is_alnum(86).
is_alnum(87).  is_alnum(88).  is_alnum(89).  is_alnum(90).
is_alnum(97).  is_alnum(98).  is_alnum(99).  is_alnum(100).
is_alnum(101).  is_alnum(102).  is_alnum(103).  is_alnum(104).
is_alnum(105).  is_alnum(106).  is_alnum(107).  is_alnum(108).
is_alnum(109).  is_alnum(110).  is_alnum(111).  is_alnum(112).
is_alnum(113).  is_alnum(114).  is_alnum(115).  is_alnum(116).
is_alnum(117).  is_alnum(118).  is_alnum(119).  is_alnum(120).
is_alnum(121).  is_alnum(122).  is_alnum(192).  is_alnum(193).
is_alnum(194).  is_alnum(195).  is_alnum(196).  is_alnum(197).
is_alnum(198).  is_alnum(199).  is_alnum(200).  is_alnum(201).
is_alnum(202).  is_alnum(203).  is_alnum(204).  is_alnum(205).
is_alnum(206).  is_alnum(207).  is_alnum(208).  is_alnum(209).
is_alnum(210).  is_alnum(211).  is_alnum(212).  is_alnum(213).
is_alnum(214).  is_alnum(215).  is_alnum(216).  is_alnum(217).
is_alnum(218).  is_alnum(219).  is_alnum(220).  is_alnum(221).
is_alnum(222).  is_alnum(223).  is_alnum(224).  is_alnum(225).
is_alnum(226).  is_alnum(227).  is_alnum(228).  is_alnum(229).
is_alnum(230).  is_alnum(231).  is_alnum(232).  is_alnum(233).
is_alnum(234).  is_alnum(235).  is_alnum(236).  is_alnum(237).
is_alnum(238).  is_alnum(239).  is_alnum(240).  is_alnum(241).
is_alnum(242).  is_alnum(243).  is_alnum(244).  is_alnum(245).
is_alnum(246).  is_alnum(247).  is_alnum(248).  is_alnum(249).
is_alnum(250).  is_alnum(251).  is_alnum(252).  is_alnum(253).
is_alnum(254).  is_alnum(255).


%% This should give a unique name and the prolog-pid!
%% We always return 1, the user can not compile two grammars in the 
%% same directory at the same time, anyway

getpid(1).

close_all_streams :-
  current_stream(_,_,S),
  close(S),
  fail.
close_all_streams.

% Get this - SWI doesn't allow you to write to user_error stream when loading
%  files is in progress.  So this writes to stdout.  The culprit is the call
%  in ./xcommon.pl.  One could directly use write/2 there and change this to
%  user_error instead.
t_print_message(_,T) :-    
  write('{'),write(T),write('}'),
  nl,flush.

% Carsten wird schon wissen, was er tut.
%string_char(Index,Str,X) :-
%	substring(Str ,Index ,1,X).


% Das ist der Megahack!
on_exception(existence_error(_,_,_,_,_),X,Handler) :-
	functor(X,Bef,Z),
	(dynamic(Bef/Z) ->
          (user:X)
        ; (user:Handler)).

% Besser:

fail_if_undefined(Pred) :-
        (current_predicate(_,Pred) ->
           call(Pred)
        ; fail).


% SWI does not automatically do file name expansion in see/1, tell/1 etc.

t_see(X) :-
	absolute_file_name(X,Y),
	see(Y).
t_tell(X) :-
	absolute_file_name(X,Y),
	tell(Y).
t_open(X,Y,Z) :-
	absolute_file_name(X,X1),
	open(X1,Y,Z).

%false :-
%	fail.

:- assert(user:(portray('$VAR'(_)) :- !,fail)).
:- assert(user:(portray(X) :- atom(X),write(X))).

%%% In Quintus, reconsulting a file loads its predicates into the user
%%%  module.  In SICStus, reconsulting a file loads its predicates into the
%%%  current module.  t_reconsult/1 loads a file's predicates into the user
%%%  module in both prologs.
%%% SWI behaves like SICStus.

t_reconsult(F) :-
  consult(user:F).

% t_cputime measures CPU time elapsed since prolog session was started in ms.

t_cputime(SinceStart) :-
  prolog:statistics(cputime,SinceStartinSecs),
  SinceStart is SinceStartinSecs * 1000.

% Quintus div/2 is '//'/2 in SWI

t_div(Quotient,Dividend,Divisor) :-
   Quotient is Dividend // Divisor.

% Is this right?  Alternative would be
%
% t_samsort(X,Y,Z) :-
%   samsort(user:X,Y,Z).
%
% Different prologs require insertion of module name in different places
% (the one chosen here assumes that patch code adds it lower a la SICStus)

t_samsort(X,Y,Z) :-
  samsort(X,Y,Z).

% Primitive get_line/1. Should do it for our purposes, I hope.

get_line(X) :-
	get0(user,Char),  % have to read from user since current input stream
                          %   might not be stdin 
	( Char == 10 ->
	    X = []
	;   X = [Char|Rest],
	    get_line(Rest) ).


basic_save_state(F,InitGoal) :-
  qsave_program(F,[local=0,  % max stack sizes
                   global=0,
                   trial=0,
                   goal=InitGoal]).
% do we need stand_alone option?  Don't seem to.
