1:-  use_module(library(logicmoo/xlisting)).    2
    3atom_hash(T,H) :- hash_term(T,H).
    4
    5format_to_atom(C,S,L) :-
    6   sformat(C2,S,L),
    7   string_to_atom(C2,C).
    8
    9format_to_charlist(Chars,Format,Args) :-
   10	format_to_atom(String,Format,Args),
   11	string_to_list(String,Chars).
   12system(X,Y) :- shell(X,Y).
   13system(X) :- shell(X).
   14
   15compile(X) :- consult(X).
   16
   17common_statistics(X) :-
   18	( value(last_stat_time,T) ->
   19	     statistics(cputime,T2),
   20	     X is 1000 * (T2 - T),
   21	     iset(last_stat_time,T2)
   22	; statistics(cputime,T),
   23	  X is 1000 * T,
   24	  iset(last_stat_time,T) ).
   25
   26% Apparently, SWI Prolog changed the behavior of "exists_file" so it only
   27% works for files, not directories.  So we use access_file/2, which works
   28% for both.
   29% -- Selim T. Erdogan, 9 May 2012
   30%common_file_exists(File) :- exists_file(File).
   31common_file_exists(File) :- access_file(File, exist).
   32
   33common_file_delete(File) :-
   34	( exists_file(File) ->
   35	     delete_file(File)
   36	; true ).
   37
   38common_tmpname(TmpName) :- tmp_file(temp, TmpName).
   39
   40common_number_chars(X,Y) :-
   41   % SWI-Prolog throws an exception instead of just failing when Y isn't
   42   % a string of numbers, so we have to trap the exception and fail normally
   43   catch(number_chars(X,Y),_,fail).
   44
   45
   46% The argument order SWI Prolog used to have for last/2 was the 
   47% reverse of many other systems (such as SICStus), so we had to have a 
   48% wrapper.  Now the order has been changed so we fixed the wrapper.
   49% -- Selim T. Erdogan, 26 Jan 2008
   50%
   51%common_last([M|Ns],N) :- last(N,[M|Ns]).
   52common_last([M|Ns],N) :- last([M|Ns],N).
   53
   54suffix(S,S).
   55suffix(S,[_|Rest]) :- suffix(S,Rest).
   56
   57/* This version of set_dirs was commented out because it didn't work right.
   58 * Now we use the one below the comments, taken directly from sicstus.3.7.1.pl.
   59set_dirs :-
   60   % set current working directory to current Unix working directory
   61   % (instead of the directory ccalc was loaded from) 
   62%   environ('PWD',PWD),  
   63%   working_directory(_,PWD),
   64   
   65   % set the value of ccalc_dir to the location from which ccalc.pl was
   66   % loaded
   67   seeing(Input),
   68   absolute_file_name(Input,FullName),
   69   determine_path(FullName,CCDir),
   70   iset(ccalc_dir,CCDir).
   71*/
   72set_dirs :-
   73   prolog_load_context(directory,D),
   74   name(D,D2),
   75   last(D2,C),
   76   ( C == 47   % check if path ends in slash
   77     -> CCDir = D2
   78   ; format_to_atom(CCDir,"~s/",[D2]) ),
   79   iset(ccalc_dir,CCDir).
   80
   81
   82environ(Var,Value) :- getenv(Var,Value).
   83/*
   84working_directory(OldDir,NewDir) :-
   85   prolog_load_context(stream,File),
   86   determine_path(File,OldDirStr),
   87   format_to_atom(OldDir0,"~w",[OldDirStr]),
   88   absolute_file_name(OldDir0,OldDir),
   89   chdir(NewDir).
   90*/
   91
   92expand_filename(Filename,Expanded) :-
   93   expand_file_name(Filename,[Temp|_]),
   94   absolute_file_name(Temp,Expanded).
   95
   96seeing_filename(Filename) :-
   97   seeing(S),
   98   stream_property(S,file_name(Filename)).
   99
  100
  101format_to_chars(Pat,Subs,Chars) :-
  102   sformat(Str,Pat,Subs),
  103   string_to_list(Str,Chars).
  104
  105list([_|_]).
  106          
  107
  108sum_list([],0).
  109sum_list([A|Rest],S) :-
  110	sum_list(Rest,R),
  111	S = R + A.
  112
  113
  114term_hash(Term,_X,Y,Hash) :-
  115        sumhash(Term,HT),
  116        ( var(HT) -> true ; Hash is HT mod Y ).
  117        
  118sumhash(Term,Hash) :-
  119        ( atom(Term)
  120            -> atom_hash(Term,Hash)
  121        ; integer(Term)
  122            -> Hash = Term
  123        ; compound(Term)
  124            -> functor(Term,F,N),
  125               atom_hash(F,HF),
  126               sumhash_args(Term,0,N,HN),
  127               ( var(HN)
  128                   -> true
  129               ; Hash is HF + HN )
  130        ; var(Term)
  131            -> true
  132        ; Hash = 0 ).
  133
  134sumhash_args(_Term,N,N,0) :-
  135        !.
  136sumhash_args(Term,M,N,HT) :-
  137        M1 is M+1,
  138        arg(M1,Term,A),
  139        sumhash(A,HA),
  140        ( var(HA)
  141            -> true
  142        ; sumhash_args(Term,M1,N,HN),
  143          ( var(HN)
  144              -> true
  145          ; HT is HA + HN ) ).
  146
  147
  148% The old versions of SWI Prolog used to have findall/3, but no 
  149% findall/4, while SICStus and other systems had the latter too.
  150% So we used to define it here ourselves.
  151% findall/4 was added to SWI in September 2007 so this is no longer
  152% necessary (and, in fact, re-defining a built-in predicate is 
  153% forbidden.) 
  154% -- Selim T. Erdogan, 26 Jan 2008
  155%
  156%findall(P,G,Ps,T) :-
  157%        findall(P,G,Xs), append(Xs,T,Ps).
  158
  159% false :- fail.
  160
  161ord_member(M,[N|Ns]) :-  
  162        ( M > N
  163            -> ord_member(M,Ns)
  164        ; M = N
  165            -> true 
  166        ; fail ).
  167        
  168ord_subset([M|Ms],[N|Ns]) :-
  169        ( M > N
  170            -> ord_subset([M|Ms],Ns)
  171        ; M = N
  172            -> ord_subset(Ms,Ns)
  173        ; fail ).
  174ord_subset([],_).
  175               
  176
  177read_line(end_of_file) :-
  178	at_end_of_stream,
  179	!.
  180read_line(Cs) :- read_line_loop(Cs).
  181          
  182read_line_loop([]) :-
  183        peek_char(C),
  184        ( C = end_of_file
  185            -> !
  186        ; C = '\n'
  187            -> !, get_char('\n')
  188        ; fail ).
  189read_line_loop([C|Cs]) :-
  190        get0(C), read_line_loop(Cs).
  191          
  192
  193skip_line :- read_line(_).
  194
  195common_ground(Term) :- var(Term), !, fail.
  196common_ground(Term) :- functor(Term,_F,N), common_ground(Term,0,N).
  197
  198common_ground(_A,N,N) :-
  199        !.
  200common_ground(A,I,N) :-
  201        I1 is I+1, arg(I1,A,Ai),
  202        ( var(Ai) -> fail
  203        ; functor(Ai,_F,M), common_ground(Ai,0,M) ),
  204        common_ground(A,I1,N).
  205        
  206db_init_external.
  207        
  208db_open_external(_).
  209        
  210db_store_rule(_I,Term) :- assertz(Term).
  211        
  212db_fetch_rule(Term) :- call(Term).
  213
  214db_init_query_external.
  215
  216db_open_query_external(_).
  217        
  218db_store_query_rule(_I,Term) :- assertz(Term).
  219        
  220db_fetch_query_rule(Term) :- call(Term).
  221              
  222common_select(V,X,Y) :-
  223        ( var(V) -> fail ; select(V,X,Y) ).
  224
  225
  226% remove_duplicates (List, Result)
  227%
  228% Removes duplicate entries in a list and sort it
  229%
  230
  231remove_duplicates(Xs,Ys) :-
  232   list_to_set(Xs,Ys).
  233
  234/*
  235remove_duplicates(Xs,Ys) :-
  236   remove_duplicates_aux(Xs,Zs), 
  237   sort(Zs,Ys). 
  238
  239
  240remove_duplicates_aux([], []).
  241
  242remove_duplicates_aux([X|Rest], Result) :-
  243        member(X, Rest), !,
  244        remove_duplicates_aux(Rest, Result).
  245        
  246remove_duplicates_aux([X|Rest], [X|Result]) :-
  247        % X is not a member of Rest as
  248        % the above clause has a cut in it.
  249        remove_duplicates_aux(Rest, Result).
  250*/
  251
  252nth(Index, List, Elem) :- nth1(Index,List,Elem).
  253
  254
  255% Apparently, SWI Prolog changed the behavior of "pipe" which we used to
  256% below, in determining the operating system.  So I made a new version
  257% of determine_os/1, using the built-in process_create/3.
  258%
  259% -- Selim T. Erdogan, 23 May 2012
  260%
  261% unifies OS with a string representing the operating system in use, as
  262% returned by the system call "uname"
  263%
  264determine_os(OS) :-
  265% Since the UTCS machines still have SWI Prolog 5.8.0, which doesn't
  266% seem to support process_create/3, we make sure that the version is
  267% higher than that before using process_create/3.
  268	current_prolog_flag(version,Ver),
  269	( Ver > 50800 
  270          -> (process_create(path(uname),[],[stdout(pipe(Stream))]),
  271              see(Stream))
  272          ;  see(pipe(uname))),
  273	read_line(OS),
  274	seen.
  275
  276:- dynamic((atomicFormula/1, (<=)/2 )).  277
  278% hook CCalc's help routines into Prolog's "help" predicate
  279prolog:help_hook(help) :- cchelp.
  280prolog:help_hook(help(Item)) :- cchelp(Item)