1:- multifile user:portray_message/2.    2:- dynamic   user:portray_message/2.   
    3user:portray_message(warning, not_loaded(_,_)).
    4
    5:- use_module(library(lists)).    6:- use_module(library(ordsets)).    7:- use_module(library(system)).    8:- use_module(library(terms)).    9:- use_module(library(charsio)).   10
   11vernum(N) :-
   12   ( predicate_property(current_prolog_flag(_,_),built_in)
   13     -> current_prolog_flag(version,Ver)
   14   ; predicate_property(prolog_flag(_,_),built_in)
   15     -> prolog_flag(version,Ver) ),
   16   name(Ver,VerName),
   17   append("SICStus ",N,VerName).
   18
   19:- vernum(VerNum),
   20   ( append("3.7",_,VerNum)
   21     -> use_module(library(db))
   22   ; use_module(library(bdb)) ).   23
   24common_statistics(X) :- statistics(runtime,[_,X]).
   25
   26% select(?Element, ?List, ?List2) 
   27% The result of removing an occurrence of Element in List is List2. 
   28common_select(V,X,Y) :- select(V,X,Y).
   29
   30common_file_exists(File) :- file_exists(File).
   31
   32common_file_delete(File) :-
   33	( file_exists(File) ->
   34	     delete_file(File)
   35	; true ).
   36
   37common_tmpname(TmpName) :- tmpnam(TmpName).
   38
   39common_number_chars(X,Y) :- number_chars(X,Y).
   40
   41
   42set_dirs :-
   43   prolog_load_context(directory,D),
   44   name(D,D2),
   45   last(D2,C),
   46   ( C == 47   % check if path ends in slash
   47     -> CCDir = D2
   48   ; format_to_atom(CCDir,"~s/",[D2]) ),
   49   iset(ccalc_dir,CCDir).
   50
   51
   52expand_filename(Filename,Expanded) :-
   53   absolute_file_name(Filename,Expanded).
   54
   55seeing_filename(Filename) :-
   56   seeing(Filename).
   57
   58format_to_atom(Atom,FormatString,Args) :-
   59        format_to_chars(FormatString,Args,Chars), name(Atom,Chars).
   60
   61format_to_charlist(Chars,Format,Args) :- format_to_chars(Format,Args,Chars).
   62
   63list([]).
   64list([_|_]).
   65
   66
   67%^jo- if the db is open, then close 
   68%^jo- do we still have rule_db?
   69%^jo- external db is created only if the number of grounded rules is large
   70%^jo- currently works with only sicstus.
   71
   72
   73db_init_external :-
   74   ( vernum(VerNum),
   75     ( append("3.7",_,VerNum)
   76       -> current_db(rule_db,_,_,DBref)
   77     ; db_current(rule_db,_,_,none,DBref) )
   78     -> db_close(DBref),
   79        system('rm rule_db/0 rule_db/if rule_db/spec; rmdir rule_db')
   80%  ; db_open(rule_db,update,_,DBref)
   81%    -> db_close(DBref), 
   82%       system('rm rule_db/0 rule_db/if rule_db/spec; rmdir rule_db')
   83   % the statements above caused problems when ccalc is loaded from a
   84   % directory other than the current working directory.  I think the
   85   % statements below have the same intended effect...
   86   ; file_exists('rule_db')
   87      -> system('rm -r rule_db')
   88   ; true ).
   89
   90
   91db_open_external(I) :-
   92        value(max_no_of_clauses_in_internal_db,MaxNoOfClauses),
   93        ( I = MaxNoOfClauses
   94            -> format("[Ext DB] ",[]), flush_output,
   95               db_open(rule_db,update,DBref),
   96               set_default_db(DBref), db_buffering(_,on)
   97        ; true ).
   98
   99db_store_rule(I,Term) :-
  100        value(max_no_of_clauses_in_internal_db,MaxNoOfClauses),
  101        I < MaxNoOfClauses -> assertz(Term) ; db_store(Term,_).
  102        
  103db_fetch_rule(Term) :-
  104        value(max_no_of_clauses_in_internal_db,MaxNoOfClauses),
  105        value(rule_count,I),
  106        ( I < MaxNoOfClauses
  107            -> call(Term)
  108        ; ( call(Term)
  109          ; db_findall(Term,TermList), member(Term,TermList) ) ).
  110
  111
  112/*
  113db_init_external.
  114        
  115db_open_external(_).
  116        
  117db_store_rule(_I,Term) :- assertz(Term).
  118        
  119db_fetch_rule(Term) :- call(Term).
  120*/
  121
  122
  123db_init_query_external.
  124
  125db_open_query_external(_).
  126        
  127db_store_query_rule(_I,Term) :- assertz(Term).
  128        
  129db_fetch_query_rule(Term) :- call(Term).
  130
  131
  132read_line(end_of_file) :-
  133        at_end_of_stream,
  134        !.
  135read_line(Cs) :- read_line_loop(Cs).  
  136
  137read_line_loop([]) :-
  138        at_end_of_line, !, skip_line.
  139read_line_loop([C|Cs]) :-
  140        get0(C), read_line_loop(Cs).
  141
  142
  143
  144common_ground(Term) :- var(Term), !, fail.
  145common_ground(Term) :- functor(Term,_F,N), common_ground(Term,0,N).
  146
  147common_ground(_A,N,N) :-
  148        !.
  149common_ground(A,I,N) :-
  150        I1 is I+1, arg(I1,A,Ai),
  151        ( var(Ai) -> fail
  152        ; functor(Ai,_F,M), common_ground(Ai,0,M) ),
  153        common_ground(A,I1,N).
  154
  155common_last([M|Ns],N) :- last([M|Ns],N).
  156        
  157
  158determine_os(OS) :-
  159% unifies OS with a string representing the operating system in use, as
  160% returned by the system call "uname"
  161   popen(uname,read,Stream),
  162   current_input(CurInput),
  163   set_input(Stream),
  164   read_line(OS),
  165   close(Stream),
  166   set_input(CurInput).
  167
  168
  169user_help :- cchelp.
  170help(Item) :- cchelp(Item).
  171
  172
  173% leave the following lines at the end of the file -- it causes problems
  174% otherwise
  175
  176:- op( 700, xfx, [ \= ] ).  177X \= Y :- \+ X = Y