Wild_Life Interpreter Version 2.13 Wed Jun 29 05:56:31 CDT 2016
Copyright (C) 1991-93 DEC Paris Research Laboratory
Extensions, Copyright (C) 1994-1995 Intelligent Software Group, SFU
 Uncommented DJD 2.13

non_strict(public) ? %% BD June 10 1993

public(public)?
public(str2psi)?
public(c_op)?
public(xfy)?
public(xfx)?

public(yfx)?  %% BD June 10 1993
public(fx)?
public(fy)?
public(xf)?
public(yf)?

public(set_module)?
public(open_module)?


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% S Y N T A X

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

set_module("syntax")?
built_ins#open_module("built_ins")?

% The problem guys:
c_op(1000,xfy,',')?
c_op(700,xfx,=)?


A=str2psi("{"),public(A)?
A=str2psi("}"),public(A)?
A=str2psi("["),public(A)?
A=str2psi("]"),public(A)?

% A=str2psi("("),public(A)?
% A=str2psi(")"),public(A)?
% A=str2psi("?"),public(A)?

A=str2psi("."),public(A)?
A=str2psi(","),public(A)?
A=str2psi("{}"),public(A)?


public(

'!', '#', '$<', '$>', '$>=', '$\==', '&', '*', '+', ',', '-', '->', '/',
'//', '/\', ':', ':-', '::', ':<', ':=', ':=<', ':==', ':>', ':><', ':>=',
':\<', ':\=<', ':\==', ':\>', ':\><', ':\>=', ';', '<', '<-', '<<', '<<-',
'<|', '=', '=:=', '=<', '===', '\===', '=>', '=\=', '>', '>=', '>>', '@',
'\/', '^', '`', 'and', 'end_of_file', 'or', 'not', 'xor', 'mod', '|', '\'

% , '<<<-'   Obsolete % RM: Feb 24 1993 

)?

public('\+','$==','$=<') ?    %% BD June 10 1993


% Operator declarations.
% Insofar as possible, these correspond with ISO standard Prolog.

% Declarations of sorts, functions, and predicates.
c_op(1200,xfx,:-)?
c_op(1200,xfx,->)?
c_op(1200,xfx,<|)?
c_op(1200,fx,::)?
c_op(1200,xfx,:=)?

% Control flow inside of predicates.
c_op(1150,xfx,|)?
c_op(1100,xfy,;)? 
c_op(900,fy,'\+')?

% Unification predicate and lookalikes.
c_op(700,xfx,<-)?
c_op(700,xfx,<<-)?

% Functions.
% All expressions have precedence < 700.
% PVR 24.2.94: changed according to Bruno's suggestion
c_op(675,yfx,or)?
c_op(675,yfx,xor)? % PVR 10.2.94
c_op(650,yfx,and)? 
c_op(625,fy,not)? % PVR 10.2.94

c_op(600,xfx,===)?
c_op(600,xfx,\===)?

% Arithmetic comparisons 
c_op(600,xfx,<)?
c_op(600,xfx,>)?
c_op(600,xfx,=<)?
c_op(600,xfx,>=)?
c_op(600,xfx,=:=)?
c_op(600,xfx,=\=)?

% String comparisons
c_op(600,xfx,$<)?
c_op(600,xfx,$>)?
c_op(600,xfx,$=<)?
c_op(600,xfx,$>=)?
c_op(600,xfx,$==)?
c_op(600,xfx,$\==)?

% Sort comparisons
c_op(600,xfx,:<)?
c_op(600,xfx,:>)?
c_op(600,xfx,:=<)?
c_op(600,xfx,:>=)?
c_op(600,xfx,:==)?
c_op(600,xfx,:><)?
c_op(600,xfx,:\<)?
c_op(600,xfx,:\>)?
c_op(600,xfx,:\=<)?
c_op(600,xfx,:\>=)?
c_op(600,xfx,:\==)?
c_op(600,xfx,:\><)?

% Arithmetic operations
c_op(500,yfx,+)?
c_op(500,yfx,-)?
c_op(500,yfx,/\)?
c_op(500,yfx,\/)?

c_op(400,yfx,*)?
c_op(400,yfx,//)?
c_op(400,yfx,/)?
c_op(400,yfx,>>)?
c_op(400,yfx,<<)?
c_op(400,yfx,mod)? % PVR 24.2.94
c_op(200,fy,-)? % PVR 24.2.94
c_op(200,xfy,^)?
c_op(200,fy,\)?

% Unify function and coreference tag
c_op(150,yfx,.)? % PVR 24.2.94
c_op(100,xfy,&)?   % RM: Feb  1 1993  % PVR 24.2.94
c_op(75,fy,`)?  % RM: Feb  1 1993 % PVR 24.2.94
c_op(50,xfy,:)? % PVR 24.2.94

%%% Old stuff:

% c_op(700,xfx,<<<-) ?  % RM: Feb  8 1993    Obsolete % RM: Feb 24 1993 
% c_op(695,fx,`)?  % Quote is loosest of the functions
% c_op(500,xfy,\)?
% c_op(500,fx,+)? PVR 24.2.94
% c_op(500,fx,-)? PVR 24.2.94

% Project operator
% c_op(400,yfx,##)?   % RM: Jan  7 1993

%% c_op(300,yfx,mod)? BD June 10 1993

% Module operator
% c_op(130,xfy,#)?   % RM: Jan  7 1993 


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% B U I L T _ I N 

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

built_ins#set_module("built_ins")?

open_module("syntax")? % This module contains symbols init. in built_ins.c
% open_module("x")?

%% BD June 11 1993
global(tools_dir<-"~/life_local/Tools/") ?

global(examples_dir<-"~/life_local/Examples/") ?
global(superlint_dir<-"~/life_local/Examples/SuperLint/") ?
global(demo_dir<-"~/life_local/Demo/") ? %% MJV January 16 1996
global(lib_dir<-"~/life_local/Lib/") ?

simple_load("~/life_local/Source/built_ins.lf") ?       %% Copyright 1991 Digital Equipment Corporation.
% All Rights Reserved.
%
% The BUILT_IN module
%
% This file should not be modified by the user.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%	$Id: built_ins.lf.in,v 1.2 1996/01/17 00:47:28 vorbeck Exp $	

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Declarations
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%% public built_ins

public(trace_input, query, declaration, error, abort, aborthook,abs, append,
       apply, asc, assert, asserta, bagof, beep, begin_raw, bool,
       bool_pred,bi_load_path, call_once,
       call_handler, ceiling, children, chr, clause,
       close, cond, cons, copy_pointer, copy_rules, copy_term, cos, cpu_time,
       current_module, delay_check, disj, display_module_status,
       display_modules, dynamic, end_raw, eval, evalin, exists_file,
       exists_choice, exp, fail, false, features, floor, fx, fy, gc, genint,
       get, get_choice, get_raw, glb, halt, has_feature, implies, in_raw,
       inherited_modules, init, initrandom, input_file, int, int2str,
       is_function, is_number, is_predicate, is_sort, is_value, least_sorts,
       length,life_ext, list, listing, load, load_module,
       load_path,load_suffixes, loaded_file, local_time, log, lub, map, maprel,
       max, maxint, member, min, module, mresiduate, nil, nl, nl_err,
       non_strict, nonvar, op, open, open_in, open_modules, open_out, ops,
       % not, PVR 10.2.94
       page_width, parents, parse, pause, pretty_write, pretty_writeq,
       print_codes, print_depth, print_variables, private, project,
       psi2str, public, put, put_err, put_raw, random, read, read_token, real,
       real_time, reduce, repeat, reset_window_flag, residuate, retract, rlist,
       root_sort, run, set_choice, set_input, set_output, setq, simple_load,
       sin, sqrt, static, statistics, step, str, str2psi, strcon, string,
       strip, strlen, strval, subsort, substr, succeed,system, tan,
       time, tprove, trace, true, undo, var, verbose, window_flag,
       write, write_canonical, write_err, writeq, writeq_err, import,
       % xor, PVR 10.2.94
       substitute,is_persistent, global, persistent, display_persistent, alias,
       bestof, % RM: Apr 15 1993
       private_feature, % RM: Mar 11 1993
       split_double, 	% RM: Jun 29 1993
       string_address,	% RM: Jul 6 1993
       deref_length, 	% RM: Jul 15 1993
       argv,         	% RM: Sep 20 1993  PVR 11.2.94
       public_symbols,	% RM: Jan 28 1994
       chdir, 		% RM: Feb 10 1994
       getenv, 		% RM: Feb 10 1994
       module_name,	% RM: Feb 16 1994
       combined_name,	% RM: Feb 16 1994
       quiet,           % BD: Feb 17 1994
       feature_values)?

%%% These are considered private:
%%% '*** ERROR ***', '<NULL PSI TERM>',
%%% bottom,comment,constant,variable,init

private(c_op)? % RM: Feb 24 1993


%%% Operators

% c_op(300,yfx,mod)? PVR 24.2.94


%%% Built-in sorts.

cons <| list.
nil <| list.
list <| built_in.

string <| built_in.

real <| built_in.
int <| real.

bool <| built_in.
true <| bool.
false <| bool.

%%% non strict declarations

non_strict(non_strict)?
non_strict(dynamic)?
non_strict(static)?
non_strict(delay_check)?
non_strict(listing)?
non_strict(evalin)?
non_strict(eval)?
non_strict(global) ?           %% BD 3.3.94
non_strict(persistent) ?       %% BD 3.3.94

%%% SYSTEM MODULE

built_ins#set_module("sys")?
built_ins#open_module("syntax")?

built_ins#public
	(bitvector,regexp,stream,file_stream,socket_stream,
	 make_bitvector,bitvector_and,bitvector_or,bitvector_xor,
	 bitvector_not,bitvector_count,bitvector_get,bitvector_set,
	 bitvector_clear,
	 regexp_compile,regexp_execute,
	 fopen,fclose,get_buffer,get_record,get_code,ftell,fseek,
	 socket,bind,connect,fwrite,fflush,listen,accept,
	 errno,errmsg,
	 import_symbol,
	 process_no_children,process_exited,process_signaled,
	 process_stopped,process_continued,
	 fork,wait,waitpid,kill,int2stream,stdin,stdout,stderr,
	 cuserid,gethostname,lazy_project,wait_on_feature,my_wait_on_feature,
	 apply1,getpid,ftruncate,stream2sys_stream,sys_stream2stream
%% 	 @DBM_LF@  Commented 2.13 DJD
)?

% built_ins#non_strict(wait_on_feature)?

bytedata  <| built_ins#built_in. % DENYS: BYTEDATA
bitvector <| bytedata.
regexp    <| bytedata.
stream    <| bytedata.
file_stream   <| stream.
socket_stream <| stream.

built_ins#global(stdin  <- int2stream(0,"r")&file_stream)?
built_ins#global(stdout <- int2stream(1,"w")&file_stream)?
built_ins#global(stderr <- int2stream(2,"w")&file_stream)?

built_ins#persistent(string_out)?
string_out <<-
	S:fopen(Path:built_ins#strcon("/tmp/.life",
				      built_ins#psi2str(getpid)),"w+")
    |
	0=built_ins#system(built_ins#strcon("rm ",Path)),%unlink was non portable
	S.stream = sys_stream2stream(S),
	S.stdout = (O|built_ins#open_out("stdout",O))?

psi2string(X) -> S | psi2stringX(X,S).

psi2stringX(X,S) :-
	fseek(O:string_out,0),
	built_ins#set_output(O.stream),
	built_ins#writeq(X),
	fflush(O),
	built_ins#set_output(O.stdout),
	N=ftell(O),
	fseek(O,0),
	S=get_buffer(O,N).

built_ins#public(psi2string)?

built_ins#set_module("built_ins")?

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%  For correct operation of the interpreter, nothing before this line should
%%%  be modified.  What comes after is used for definition of built-ins and can
%%%  be edited (albeit very carefully).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% System built-ins
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%% call once must be a boolean function for use in cond
%non_strict(call_once)?	                          %% DENYS Jan 25 1995
%call_once(G) -> T | (evalin(G),T=true;T=false),!. %% DENYS Jan 25 1995

%%% A more useful listing predicate from the c_listing built-in.

non_strict(listing)?
X:listing :-
	%%	trace(T,U),   % RM: Dec  9 1992 
	listing_2(features(X), X).
	%%	trace(T,U).

listing_2([],    _) :- !.
listing_2([F],   X) :- !, nl, listing_3(F, X).
listing_2([F|L], X) :- nl, listing_3(F, X), listing_2(L, X).

listing_3(F, X) :- P=X.F, c_listing(P), listing_4(P).

listing_4(P) :- var(P), !,
        write("% '@' is the top sort."), nl.
listing_4(P:int)    :- !, listing_4a(int).       %% uncommented 2.13 DJD
listing_4(P:real)   :- !, listing_4a(real).     %% uncommented 2.13 DJD
listing_4(P:string) :- !, listing_4a(string).   %% uncommented 2.13 DJD
%% listing_4(P) :- listing_4a(P).                 %% commented 2.13 DJD

listing_4a(P) :- is_sort(P), is_value(P)=false, !, 
	listing_5(parents(P), P),
        listing_6(children(P), P).
	% write("% Parents: "),writeq(parents(P)), nl,
	% write("% Children: "),writeq(children(P)), nl.


listing_4a(_).

listing_5([], _) :- !.
listing_5([X|Xs], Y) :-
	writeq(Y), write(" <| "), writeq(X), write("."), nl,
	listing_5(Xs, Y).

listing_6([], _) :- !.
listing_6([X|Xs], Y) :-
	writeq(X), write(" <| "), writeq(Y), write("."), nl,
	listing_6(Xs, Y).


%%% An op predicate that handles any pattern of arguments. 

non_strict(op)?
op(P,K,F,precedence=>P,kind=>K,functor=>F) :-
	trace(T,U),
	( op_2(P,K,F), trace(T,U)
	; trace(T,U), fail
	).

op_2(P,K,F) :- nonvar(P), nonvar(K), nonvar(F), F=list, !, op_3(F,P,K).
op_2(P,K,F) :- nonvar(F), F=list, !,
	write_err("*** Error: invalid operator declaration."),
	nl_err.
op_2(P,K,F) :- nonvar(P), nonvar(K), nonvar(F), !, c_op(P,K,F).
op_2(P,K,F) :- member(op(P,K,F),ops).

% List of operators.
op_3([]) :- !.
op_3([H|T],P,K) :- op_2(P,K,H),op_3(T,P,K).


%%% Default call handler.
%%% This is called for predicates that have no definition.
%%% More sophisticated call handlers can be written to do auto-loading
%%% of undefined predicates.

call_handler(P) :- is_sort(P), !,
	write_err("*** Error: the sort '"),writeq_err(P),
        write_err("' occurs where a predicate or function is expected."),
	nl_err, abort.
call_handler(P) :- !,
	write_err("*** Error: '"),writeq_err(P),
        write_err("' is not a predicate or a function."), nl_err,
	abort.


%%% Pause for N seconds.
pause(N) :-
	S=real_time,
	repeat,
	real_time-S>N,
	!.

%%% Time a goal (whether it succeeds or fails).
run(G) :-
	S=cpu_time,
	(G;succeed),
	!,
	write("Time = ",cpu_time-S," sec"),
	nl.


%%% Personal customizing.

init :-
	exists_file("./.wild_life"),
	simple_load("./.wild_life"),
	quiet_write("Loaded customizing file from current directory."),
	!.

init :-
	exists_file("~/.wild_life"),
	simple_load("~/.wild_life"),
	quiet_write("Loaded customizing file from home directory."),
	!.

init :-
	quiet_write("No customizing file loaded."),
	!.

%% init :-                                        %% was in .set_up
%% 	exists_file("+SETUPDIR+/.wild_life"),
%% 	simple_load("+SETUPDIR+/.wild_life"),
%% 	write("Loaded default customizing file."), nl
%% 	!.

init :-
	write_err("*** Warning: couldn't access any customizing file."),
	nl_err.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Input-Output
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%% Newline

nl :- write("
").

nl_err :- write_err("
").


%%% Beep

beep :- put(7).


%%% Quiet writing for support of '-q' option
%%% This built-in doesn't write anything if the '-q' option is enabled.
%%% 21.1 & RM: Feb 17 1993 

quiet_write :- quiet, !.
S:quiet_write :- quiet_write_loop(features(S),S), nl.

quiet_write_loop([]) :- !.
quiet_write_loop([X|L], S) :-
	write(S.X),
	quiet_write_loop(L, S).



%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Loading Files
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%% A very useful load that searches a path, does suffix completion,
%%% and remembers if a file has already been loaded.
%%% The default path may be extended by an optional user-defined function
%%% load_path that gives a disjunction of directories to search in.
%%% The set of default suffixes may be extended by an optional user-defined
%%% function load_suffixes that gives a disjunction of suffixes.
%%% This predicate accepts an arbitrary number of arguments.

persistent(load_option,top_load,loading) ?
load_option <<- false ?
loading <<- false ?

non_strict(load)?
X:load :-
	CM = current_module,
	F = features(X),
	(
	    loading,!,
	    load_2(F,X)
	;
	    loading <<- true,
	    top_load <<- get_choice,
	    load_2(F,X),!,loading <<- false
	;
	    open_out("stdout",_),
	    open_in("stdin",_),
	    set_module(CM),
	    loading <<- false,
	    fail
	).

load_2([F|L],X) :-
	(
	    find_file(X.F,CF),!,
	    (
		has_feature(CF,consulted,Bool),!,
		quiet_write("*** File """,CF,""" is already loaded.")
	    ;
		quiet_write("*** Loading File """,CF,""""),
		first_load(CF)
	    ),
	    load_2(L,X)
	;
	    set_choice(top_load),fail
	).
load_2([]).

first_load(CF) :-
	(
	    load_option,!,
	    consulted.CF <<- true,
	    simple_exp_load(CF)
	;
	    consulted.CF <<- false,
	    simple_load(CF)
	).

find_file(F:string,CF) :-
	!,
        (
	    CF=strcon(bi_load_path,
		      strcon(F,
			     life_ext)),
	    exists_file(CF), !
	;
	    write_err("*** File """,F,""" not found."),nl_err,
	    fail 
	).
find_file(F) :-
	write_err("*** Error: File name "),
	writeq_err(F),
	write_err(" should be a string."),
	nl_err,
	fail.

bi_load_path ->  {
		     ""
                 ;
		     strcon((load_path | is_function(`load_path)),
			    %% {"";"/"}
			    "/"
			   )
		 ;
		     lib_dir
		 ;
		     tools_dir
                 ; %% "+SETUPDIR+/Examples/"   % BD June 10 1993
		     examples_dir
		 ;
		     superlint_dir
		 ; %% For the Demo Directory   % MJV January 16 1996
		     demo_dir
		 }.

%%% The user may define a function load_suffixes that returns a
%%% disjunction of other suffixes to be used.
life_ext -> { ".lf"
            ; ""
	    ; (load_suffixes | is_function(`load_suffixes))
	    ; ".life"
	    }.


%%% reconsult facility

public(reconsult) ?

non_strict(reconsult)?

X:reconsult :-
	CM = current_module,
	F = features(X),
	(
	    loading,!,
	    reconsult_2(F,X)
	;
	    loading <<- true,
	    top_load <<- get_choice,
	    reconsult_2(F,X),!,loading <<- false
	;
	    open_out("stdout",_),
	    open_in("stdin",_),
	    set_module(CM),
	    loading <<- false,
	    fail
	).

reconsult_2([F|L],X) :-
	find_file(X.F,CF),!,
	(
	    has_feature(CF,consulted,Bool),!,
	    (
		Bool,!,
		reload(CF,Bool)
	    ;
		write_err("*** File """,CF,""" cannot be reconsulted."),
		nl_err
	    )
	;
	    quiet_write("*** Loading File """,CF,""""),
	    first_load(CF)
	),
	reconsult_2(L,X).
reconsult_2([]).


reload(CF,Bool) :-
	retract_file(Bool),
	quiet_write("*** Reconsulting File """,CF,""""),
	quiet_write(" "),
	quiet_write("*** Warning: sort,public,non_strict and operators ",
		    "declarations are not undone."),
	quiet_write("***          Rules added using queries in the ",
		    "file are not retracted."),
	quiet_write(" "),
	first_load(CF).


retract_file(B) :-
	X = current_module,
	retract_modules(features(B),B),
	set_module(X).

retract_modules([M1|Ms],B) :- !,
	M = psi2str(M1),
	%% set_module(M),
	retract_functions(features(B.M1.functions,M),B.M1.functions), 
	retract_predicates(features(B.M1.preds,M),B.M1.preds).
retract_modules([]).

retract_functions([F|Fs]) :- !,
	(
	    retract_all_f(F)
	;
	    retract_functions(Fs)
	).
retract_functions([]).
retract_predicates([F|Fs]) :- !,
	(
	    retract_all_p(F)
	;
	    retract_predicates(Fs)
	).
retract_predicates([]).


retract_all_f(F) :-
	retract((F -> @)),
	retract_all_f(F).
retract_all_p(F) :-
	retract((F :- @)),
	retract_all_p(F).



%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Meta features
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%% Negation

\+ X :- X,!,fail.
(\+) .

%%% Quote

non_strict(`)?
`X -> X.


%%% Definition of bagof using non-backtrackable destructive assignment.
%%% bagof(X,G) -> R:[]:cond(call_once((G,R<<-[X|R],fail)),R,R). % (19.8)
%%% This version does not allow non-residuating functions in G &
%%% "leaks" the evaluation of G into X on the outside:
%%% bagof(X,G) -> R:[] | (G,R<<-[X|R],fail ; true).

%%% This version seems to be completely clean:
%%% non_strict(bagof)?
%%% bagof(X,G) -> R:[] | (evalin(G),R<<-[evalin(X)|R],fail ; R<-copy_term(R)).

%%% New version using persistent terms:     RM: Feb 16 1993 
%%% The old version had a complexity of O(n2), now down to O(n).

non_strict(bagof)?
bagof(X,G) -> N |
        L<<-[],
        ((evalin(G),                         % Prove G
          L<<-[evalin(X)|copy_pointer(L)],   % Record the binding of X
          fail)                              % Force back-tracking on G
        ;
         (N<-copy_term(L))).                 % Copy the resulting global term
                                             % back onto the stack.


%%% Best solution to a goal by some relation:

non_strict(bestof)?
bestof(X,R,G) -> N |
       L<<-first_value,
       (evalin(G),                         % Prove G
	cond(L:==first_value,              % Record the binding of X
	     L<<-evalin(X),
	     cond(R(X,L),                  % Compare to last value
		  L<<-evalin(X),
		  succeed)),
	fail                               % Force back-tracking on G
	;
        N<-copy_term(L)).                  % Copy the resulting global term
                                           % back onto the stack.


% Reducing a monoidal binary operator over a list:
reduce(F,E,[H|T]) -> F(H,reduce(F,E,T)).
reduce(F,E,[]) -> E.

% Mapping a function over a list:
map(F,[H|T])->[F(H)|map(F,T)].
map(F,[])->[].

% Mapping a unary relation over a list:
maprel(P,[H|T]) :- !,root_sort(P) & @(H),maprel(P,T).
maprel(P,[]).



%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Basic Lists Manipulation
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

append([H|T],L:list)->[H|append(T,L)].
append([],L:list)->L.

length([H|T])->1+length(T).
length([])->0.

member(X,[X|_]).
member(X,[_|L]) :- member(X,L).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Arithmetic
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

A^N:int -> cond(N<0,1/pwr(A,-N),pwr(A,N)).

pwr(A,0) -> 1.
pwr(A,1) -> A.
% PVR 24.2.94
pwr(A,N) -> cond((N /\ 1)=:=0, X*X, X*X*A) | X=pwr(A,N>>1).
% pwr(A,N) -> A*pwr(A,(N-1)).

abs(R) -> cond(R<0,-R,R).
max(A,B) -> cond(A>B,A,B).
min(A,B) -> cond(A>B,B,A).


% Generate a unique integer for each call to genint
persistent(genint_counter)?
genint_counter<<-0?
genint -> copy_term(genint_counter) | genint_counter<<-genint_counter+1.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% String Manipulation
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

"" $== "" -> true.
S1:string $== S2:string ->
    (asc(S1)=:=asc(S2)) and
    lenstreq(substr(S1,2,L1:strlen(S1)),substr(S2,2,L2:strlen(S2)),L1,L2).

lenstreq("","",_,_) -> true.
lenstreq(S1,S2,L1,L2) ->
    L1=:=L2 and L1>0 and (asc(S1)=:=asc(S2)) and
    lenstreq(substr(S1,2,LL1:(L1-1)),substr(S2,2,LL2:(L2-1)),LL1,LL2).

"" $=< string -> true.
string $=< "" -> false.
S1:string $=< S2:string ->
    (C1:asc(S1)<C2:asc(S2))
    or
    (C1=:=C2 and lenstrle(substr(S1,2,L1:strlen(S1)),
                              substr(S2,2,L2:strlen(S2)),
                              L1,L2)).

lenstrle("",string,_,_) -> true.
lenstrle(string,"",_,_) -> false.
lenstrle(S1,S2,L1,L2) ->
    (C1:asc(S1) < C2:asc(S2))
    or
    (C1=:=C2 and lenstrle(substr(S1,2,LL1:(L1-1)),
                              substr(S2,2,LL2:(L2-1)),
                              LL1,LL2)).

S1:string $< S2:string -> S1$=<S2 and not(S1$==S2).
S1:string $> S2:string -> not(S1$=<S2).
S1:string $>= S2:string -> not(S1$=<S2) or S1$==S2.
S1:string $\== S2:string -> not(S1$==S2).

%%% Convert "any" psi-term to a string.
%%% This converts strings to themselves, integers to a string giving their
%%% value, and other psi-terms to a string giving their print name.

str(X) -> cond(is_value(X),strval(X),psi2str(X)).

strval(S:string) -> S.
strval(N:int) -> int2str(N).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%  Declarations of support of modules      RM: Jan  6 1993
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

module(N) :-
	N:<string,
        !,
	set_module(N),
	setq(open_modules,[]),
	setq(inherited_modules,[]),
	open("syntax"),
	open("built_ins"),
	open("x").
						
module(N) :-                                     % PVR 13.9.93
	write_err("*** Error: module name '"),writeq_err(N),
	write_err("' should be a string"),
	nl_err.

X:open :- open_list(features(X), X).

open_list([]) :- !.
open_list([F|FL], X) :- open_one(X.F), open_list(FL, X).

open_one(N:string) :- !,
	open_module(N),
	setq(open_modules,[N|open_modules]).

open_one(N) :-                                   % PVR 13.9.93
	write_err("*** Error: module argument '"),writeq_err(N),
	write_err("' of open should be a string"),
	nl_err.


display_module_status :-
	write("%%%%%%%%%%%%%%%%%%%%"),nl,
	write("%%% current module: ",current_module),nl,
	write("%%% open modules: ",open_modules),nl,
	write("%%% inherited modules: ",inherited_modules),nl,
	write("%%%%%%%%%%%%%%%%%%%%"),nl.


public(import_clauses)?
non_strict(import_clauses)?

import_clauses(for => Sort,
               replacing => RepList) :-

	(
	    is_function(Sort),
	    (Connect = ->) ;
	    
	    is_predicate(Sort),
	    (Connect = :-) ;
	    
	    write_err("*** Import: ",Sort," is not a predicate or function"),
	    nl_err,
	    fail
        ),
	! ,
	get_and_replace(Sort,Connect,RepList);
	succeed.


get_and_replace(Sort,Connect,RepList) :-
	Connect=@(Sort,Body),
	clause(Connect),
	%%	write("Importing clause:"),
	%%	nl,
	%%	writeq(Connect),
	%%	nl,
	replace(Connect,RepList),
	%%	write("as clause:"),
	%%	nl,
	%%	writeq(Connect),
	%%	nl,
	%%	nl,
	R=root_sort(Connect.1),
	dynamic(R),
	assert(Connect),
	fail.


replace(Connect,[]) :- ! .
replace(Connect,[(A,B)|T]) :-
	substitute(A,B,Connect),
	replace(Connect,T).


%%% PVR 13.9.93
non_strict(import)?
X:import :-
	load&strip(X),
	import_list(features(X), X).

import_list([]) :- !.
import_list([F|FL], X) :- import_one(X.F), import_list(FL,X).

import_one(X) :-
	Module =remove_path(X),
	(open(Module),!;succeed).

remove_path(File) -> remove_path_loop(File,strlen(File)).

remove_path_loop(File,0) -> File.
remove_path_loop(File,L) -> cond(L<1,
				 File,
				 cond(substr(File,L,1) $== "/",
				      substr(File,L+1,strlen(File)-L),
				      remove_path_loop(File,L-1))).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%  Compatibility with older versions 
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

project(A,B) -> B.A.


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
%% Obsolete
%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%public('\+','$==','$=<', c_op,append_file, built_in, day, encode,
%%%       freeze,functor,genint_counter, hour, inf_loop, kind, lenstreq,
%%%       lenstrle,c_listing,  minute, month, precedence, second, stream,
%%%       warning, 
%%%       weekday, where, set_module, open_module,xf, xfx, xfy, yf, yfx,
%%%       new_block, block_struct, block_valueintset,block_valuerealset,
%%%       block_valueintget,block_valuerealget,block_subblockset,
%%%       block_subblockget,is_block,same_block, block_privateintget,
%%%       block_privateintset,block_privaterealget,block_privaterealset,
%%%       block_wake,
%%%       c_xareallzero, c_xareallpos, c_xareallneg,
%%%       c_xelm, c_xadd_basic, c_xclean_linear, c_xobjective,
%%%       syntax
%%%      ) ?

%%%c_op(1200,fx,block_struct)?    % RM 20 Jan 93


%%%% To force a type encoding.
%%%encode?

%%% non_strict(global)?  %% RM: Apr  8 1993 

%%%non_strict(assert)?  %% 17.9
%%%non_strict(asserta)?  %% 17.9
%%%non_strict(clause)?  %% 17.9
%%%non_strict(retract)?  %% 17.9
%%%non_strict(cond)? %% 24.8

%%%A ## B -> A.B.


%%%A poor man's global variable update:
%%%set(X,V) :- retract((X->@)), !, assert((X->V)).
%%%set(X,V) :- dynamic(X), assert((X->V)).

%%%This has become a C built-in:
%%%non_strict(setq)?
%%%setq(X,V) :- Value = eval(V), retract((X->@)), !, assert((X->Value)).
%%%setq(X,V) :- dynamic(X), Value = eval(V), assert((X->Value)).


%%%These are removed since their functionality is subsumed by that of
%%%unification.
%%%Lisp pseudo-compatibility.
%%%nil -> [].
%%%cons(H,T) -> [H|T].
%%%car([H|T]) -> H.
%%%cdr([H|T]) -> T.

%%%Repeat.
%%%repeat.
%%%repeat :- repeat.

%%%Handy for functional programming.
%%%where -> @.

%%%Logic functions (some are C built-ins).

%%%and(false,bool) -> false.
%%%and(bool,false) -> false.
%%%and(true,true) -> true.

%%%or(true,bool) -> true.
%%%or(bool,true) -> true.
%%%or(false,false) -> false.

% PVR 10.2.94
%%%not(true) -> false.
%%%not(false) -> true.
%%%xor(true,false) -> true.
%%%xor(false,true) -> true.
%%%xor(bool,bool) -> false.

%%%dynamic(genint_counter)?
%%%genint_counter -> 0.
%%%genint -> N:genint_counter | setq(genint_counter,N+1).

%%%This works but results in several genints in the same expression
%%%all getting the same resulting value:
%%%persistent(genint_counter)?
%%%genint_counter<<-0?
%%%genint -> N:genint_counter | genint_counter<<-N+1.

%%%This is now a C built-in:
%%%int2str(N:int) -> cond(N<0,
%%%                       strcon("-",num(-N)),
%%%                       num(N)).

%%%num(N) -> cond(N<10,
%%%                   psi2str(chr(N+48)),
%%%                   strcon(num(Q:floor(N/10)),num(N-Q*10))).

%%%This is the same speed:
%%%num2str(0) -> "0".
%%%num2str(1) -> "1".
%%%num2str(2) -> "2".
%%%num2str(3) -> "3".
%%%num2str(4) -> "4".
%%%num2str(5) -> "5".
%%%num2str(6) -> "6".
%%%num2str(7) -> "7".
%%%num2str(8) -> "8".
%%%num2str(9) -> "9".
%%%num2str(N:int) ->
%%%        cond(N<0,
%%%             strcon("-",num2str(-N)),
%%%             strcon(num2str(Q:floor(N/10)),num2str(N-Q*10))).

%%% nl :- put(10).
%%% nl_err :- put_err(10).
%%% Infinite loop.
%%% inf_loop -> inf_loop.

%%%copy_rules(Symbol,SourceModule,NewName) :-
%%%	load_module(SourceModule),
%%%	var(NewName),
%%%	copy_rules(Symbol,SourceModule,NewName).
 <EOF>
% BD June 10 1993
simple_load("~/life_local/Source/term_expansion.lf") ?
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%                   TERM EXPANSION
%
% Author: Bruno Dumant
%
% Copyright 1993-1994 Digital Equipment Corporation
% All rights reserved 
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%	$Id: term_expansion.lf,v 1.2 1994/12/08 23:34:30 duchier Exp $	

public(associate_expanders,quiet_associate_expanders,
       add_expanders_a,add_expanders_z,remove_expanders,
       term_expansion,term_xpand,
       expand_load,
       load_exp,import_exp,
       new_suffix)?

persistent(consulted)?
persistent(expansion_methods_table) ?
global(loading_file,line) ?



%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% associating expanders with symbols
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%% Association

associate_expanders(Sort,Expanders,Type) :-
	cond( has_feature(combined_name(Sort),expansion_methods_table),
	      warn("redefining expansion methods for: ",Sort,".")
	    ),
	quiet_associate_expanders(Sort,Expanders,Type).

quiet_associate_expanders(Sort,Expanders,Type) :-
	cond( Expanders :< list,
	      expansion_methods_table.combined_name(Sort)
	      <<- (Expanders,Type),
	      expansion_methods_table.combined_name(Sort)
	      <<- ([Expanders],Type)
	    ).

%%%associate_expander(associate_expander,make_association) ?
%%%make_association(associate_expander(Sort,Expander,Type),
%%%		 in_clauses => In,
%%%		 out_clauses => In) :-
%%%	associate_expander(Sort,Expander,Type).


add_expanders_a(Sort,Expanders,Type) :-
	( has_feature(combined_name(Sort),expansion_methods_table,E),!,
	  ( Expanders :< list,!,
	    E.1 <<- append(Expanders,E.1)
	  ;
	    E.1 <<- [Expanders|copy_pointer(E.1)]
	  ),
	  cond( Type :\== @,
		cond( Type :\== E.2,
		      ( warn("Changing the type of the expansion ",
				"method for ",
				Sort,"."),
			E.2 <<- Type
		      )
		    )
	      )
	;
	  quiet_associate_expanders(Sort,Expanders,Type)
	).
	    
%%%associate_expander(add_expander_a,assoc_a) ?
%%%assoc_a(add_expander_a(Sort,Expander,Type),
%%%	in_clauses => In,
%%%	out_clauses => In) :-
%%%	add_expander_a(Sort,Expander,Type).


add_expanders_z(Sort,Expanders,Type) :-
	( has_feature(combined_name(Sort),expansion_methods_table,E),!,
	  ( Expanders :< list,!,
	    E.1 <<- append(E.1,Expanders) 
	  ;
	    E.1 <<- append(E.1,[Expanders])
	  ),
	  cond( Type :\== @,
		cond( Type :\== E.2,
		      ( warn("Changing the type of the expansion ",
				"method for ",
				Sort,"."),
			E.2 <<- Type
		      )
		    )
	      )
	;
	  quiet_associate_expanders(Sort,Expanders,Type)
	).

%%%associate_expander(add_expander_z,assoc_z) ?
%%%assoc_z(add_expander_z(Sort,Expander,Type),
%%%	in_clauses => In,
%%%	out_clauses => In) :-
%%%	add_expander_z(Sort,Expander,Type).


remove_expanders(Sort,Expanders) :-
	( has_feature(combined_name(Sort),expansion_methods_table,E),!,
	  E.1 <<- rm_exp(Expanders,E.1)
	;
	  succeed
	).

rm_exp([A|B],L) -> rm_exp(B,rm_exp1(L,A)).
rm_exp([],L) -> L.
rm_exp(A,L) -> rm_exp1(L,A).

rm_exp1([A|B],Exp) -> cond( Exp :== A,
			    rm_exp1(B,Exp),
			    [A|rm_exp1(B,Exp)]
			  ).
rm_exp1([],Exp) -> [].
	
%%% expanding

composed_expansion(A,B,(Exp,Type),file => File,line => Line) :-
	( Exp :== [],!,
	  B = [A]
	;
	  cond( Type :== @,
		Clauses = [A],
		Clauses = [root_sort(Type) & strip(A)]
	      ),
	  apply_expanders(Exp,Clauses,B,
			  file => File, line => Line)
	).

apply_expanders([Exp|Exps],In,Out,
		file => File, line => Line) :-
	!,
	apply_expander(In,Exp,
		       in_clauses => Inter,out_clauses => [],
		       file => File, line => Line),
	apply_expanders(Exps,Inter,Out,
			file => File, line => Line).
apply_expanders([],Clauses,Clauses).


apply_expander([Cl1|Cls],Expander,
	       in_clauses => In,out_clauses => Out,
	       file => File, line => Line) :-
	!,
	copy_term(Expander) & @(Cl1,
				in_clauses => In,
				out_clauses => Inter,
				file => File, line => Line),
	apply_expander(Cls,Expander,
		       in_clauses => Inter,
		       out_clauses => Out,
		       symbol => Symbol,file => File, line => Line).
apply_expander([],in_clauses => In,out_clauses => In).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% term_expansion
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

dynamic(term_expansion) ?
assert(term_expansion),retract(term_expansion) ?

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% simple_exp_load
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%% simple_exp_load
%%% a 'simple_load' predicate using read, expanding facts when necessary,
%%% and writing the expanded version if asked.

simple_exp_load(File) :-
	OldFile <- root_sort(loading_file),
	OldLine <- root_sort(line),
	line <- @,
	cond( OldFile :== @, OldFile = "?"),
	loading_file <- File,
	CM = current_module,
	open_in(File,StreamIn),
	cond( expand2file,
	      open_out(new_suffix(File,".exp"),StreamOut)
	    ),
	consulted.File <<- true,
	load_expanded(StreamIn,StreamOut),
	set_module(CM),
	file <- OldFile,
	line <- OldLine.

load_expanded(StreamIn,StreamOut) :-
	(
	    next_rule(Expr,Type,End,line),
	    ( End,!,
	      close(StreamIn),
	      cond( expand2file,
		    close(StreamOut)
		  )
	    ;
	      cond( Type :== declaration,
		    process_declaration(Expr,StreamOut),
		    cond( Type :== query,
			  process_query(Expr,StreamIn,StreamOut),
			  (
			      set_choice(top_load),
			      write_syntax_error(StreamIn,StreamOut)
			  )
			)
		  ),
	      fail
	    )
	;
	    load_expanded(StreamIn,StreamOut)
	).

next_rule(X,Type,Bool,Line) :-
	read(X,Type,Line),
	Bool = ( X :=< end_of_file).



%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% processing queries
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%% proving queries of a file

non_strict(process_query) ?
process_query(Query,StreamIn,StreamOut) :-
	(
%%%	    has_feature(combined_name(Query),expansion_methods_table,M),
%%%	    M :\== [],!,
%%%	    process_declaration(Query,StreamOut)
%%%	;
	    
	    retract(( load_query :- @ )),
	    assert(( load_query :- Query )),
	    open_in("stdin",_),
	    
	    @ = call_once(load_query),
	    
	    set_input(StreamIn),
	    cond( expand2file,
	        output_query(Query,StreamOut)
	    ),
	    fail
	;
	    succeed
	).

dynamic(load_query) ?
load_query.


output_query(Query,StreamOut) :-
	set_output(StreamOut),
	cond( Query :== load,
	      write_canonical(modify_load(Query)),
	      cond( Query :== import,
		    write_canonical(modify_import(Query)),
		    write_canonical(Query)
		  )
	    ),
	write("?"),nl,nl,
	open_out("stdout",_).

modify_load(X) ->
	load_exp & strip(X).
modify_import(X) ->
	import_exp&strip(X).



%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Processing declarations
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


%%% asserting declarations of a file

process_declaration(Declaration,StreamOut) :-
	(
	    term_xpand(Declaration,NewDefs),!,
	    process_defs(NewDefs,StreamOut)
	;
	    nl_err,
	    write_err("*** Error: "),nl_err,write_err("    "),
	    writeq_err(Declaration),write_err("."),nl_err,
	    write_err("    could not be expanded in file """,
	                   loading_file,""""," near line ",line,"."),
	    nl_err
	).


term_xpand(A,B) :-
	(
	    has_feature(combined_name(A),expansion_methods_table,M),!,
	    composed_expansion(A,B,M,file => loading_file,line => line),! 
	;
	    (
		clause(( term_expansion(A) :- @ ))
	    ;
	        clause(( term_expansion(A) ))
	    ),!,
	    term_expansion(A,B,
			   file => loading_file,
			   line => line),!
	;
	    A = B
	).


process_defs(NewDefs,StreamOut) :-
	(
	    expand2file,
	    set_output(StreamOut),
	    cond( NewDefs :=< list,
		  maprel(write_def, NewDefs),
		  write_def(NewDefs)
		),
	    open_out("stdout",_),
	    fail
	;
	    assert_rules,
	    cond( NewDefs :=< list,
		  maprel(assert_def, NewDefs),
		  assert_def(NewDefs)
		),
	    fail
	;
	    succeed
	).

assert_def(X) :-
	cond( Bool:(consulted.loading_file),
	      cond( X :== (->),
		    Bool.current_module.functions.(X.1) <<- true,
		    cond( X :== (:-),
			  Bool.current_module.preds.(X.1) <<- true,
			  cond( X :== (<|) or X :== (::) or X :== (:=),
				succeed,
				Bool.current_module.preds.X <<- true 
			      )
			)
		  )
	    ),
	assert(X).

write_def(X) :-
	write_canonical(X),
	write("."),
	nl,nl.



%%% writing syntax errors

write_syntax_error(StreamIn,StreamOut) :-
	close(StreamIn),
	cond( expand2file,
	    close(StreamOut)
	),
	fail.	



%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% load options
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%% setting options

persistent(assert_rules)?   %% will expanded rules be asserted ?
assert_rules <<- false ?    

persistent(expand2file) ?   %% will expanded rules be written in a file ?
expand2file <<- false ?


%%% load_option is defined in built_ins.lf. It is used to decide whether term
%%% expansion is used or not.

expand_load(Assert,Expand2File) :-
	cond( var(Assert),
	      Assert = copy_term(assert_rules),
	      (
		  Assert :< bool,
		  assert_rules <<- Assert
	      )
	    ),
	cond( var(Expand2File),
	      Expand2File = copy_term(expand2file),
	      (
		  Expand2File :< bool,
		  expand2file <<- Expand2File
	      )
	    ),
	load_option <<- assert_rules or expand2file. 




%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Loading expanded files
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


non_strict(load_exp)?
X:load_exp :-
	CM = current_module,
	F = features(X),
	(
	    loading,!,
	    load_exp_2(F,X)
	;
	    loading <<- true,
	    top_load <<- get_choice,
	    load_exp_2(F,X),!,loading <<- false
	;
	    open_out("stdout",_),
	    open_in("stdin",_),
	    set_module(CM),
	    loading <<- false,
	    fail
	).

load_exp_2([F|L],X) :-
	(
	    find_file(new_suffix(X.F,".exp"),CF),!,
	    (
		has_feature(CF,consulted,Bool),!,
		quiet_write_err("*** File """,CF,""" is already loaded.")
	    ;
		consulted.CF <<- false,
		quiet_write_err("*** Loading File """,CF,""""),
		simple_load(CF)
	    ),
	    load_exp_2(L,X)
	;
	    set_choice(top_load),fail
	).
load_exp_2([]).

X:import_exp :-
	load_exp&strip(X),
	open&strip(X).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% utilities
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

new_suffix(F,S) -> strcon(prefix(F),S).

prefix(F) -> prefix2(F,1,strlen(F)).
 

prefix2(F,N,Length) ->
	cond(asc(substr(F,N,1)) =:= asc("."),
	     substr(F,1,N-1),
	     cond( N =:= Length,
	         F,
		 prefix2(F,N+1,Length)
	     )
	 ).

warn :- quiet,!.
X:warn :-
	write_err("*** Warning: "),
	write_err&strip(X),
	nl_err.

quiet_write_err :- quiet,!.
C:quiet_write_err :-
	write_err&strip(C),
	nl_err.
 <EOF>
simple_load("~/life_local/Source/onlinedoc.lf")?
%	$Id: onlinedoc.lf,v 1.2 1994/12/08 23:31:40 duchier Exp $	
%%% routine to give information on symbols online

%module("built_in") ?

public(add_man,man) ?

persistent(online_info) ?

non_strict(add_man) ?

add_man(X,S) :-
	S :< string,
	cond( X :< list,
	      ( true |
		S1 <<- S,
		info_list(X,S1)
	      ),
	      one_info(X,S)
	    ).

info_list([X|L],S) :-
	!,
	one_info(X,S),
	info_list(L,S).
info_list([]):- !.

one_info(X,S) :-
	Module = current_module,
	online_info.current_module.X <<- S.


non_strict(man) ?
persistent(exits_entry) ?
op(1200,fy,man) ?

man(X) :-
	man2(features(online_info),psi2str(X),false).

man2([A|B],S,Entry) :-
	!,
	(
	    has_feature(S,online_info.A,Info),!,
	    write("In module: ",A,","),nl,nl,
	    write(Info),
	    nl,
	    nl,
	    man2(B,S,true)
	;
	    man2(B,S,Entry)
	).
man2([],S,Entry) :-
	cond( Entry,
	      succeed,
	      (write(" No manual entry for ",S),nl)
	    ).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Built-ins documentation
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

add_man(add_man,
	" add_man(X,S) ?

  input: X is a symbol name, or a list of symbol names;
         S is a string containing the information describing X. 

  add_man stores the information describing its first argument. 
  ") ?

add_man((man),
	" man X ?

  input: X is a symbol name.

  ""man"" reads information about X stored by ""add_man"",
  and writes it on the standard output. 
  ") ? 

add_man(reconsult,
	" reconsult(File1,File2,...) ?

  input: File1, File2,... : strings (file names)

  reconsult(File1,File2,...) is a facility offered to avoid restarting 
  Wild_Life each time you make a minor modification to a file. It works 
  properly in 90% of the cases, but there are some limitations. 

  1) reconsult may only be used with expand_load(true).
  2) reconsult retracts the definitions of the functions and predicates 
     occurring in the previous version of the file, then reloads the 
     file, reexecuting the queries and directives. 

  3) Warnings:

     - if a function or predicate was defined across multiple files,
       the whole definition is retracted, not only the rules that 
       appeared in the reconsulted file.
     - Sort declarations are never retracted. It means that the sort 
       hierarchy can be only be extended.
     - Some directives have non-retractable side-effects: 
       public,private,private_feature,dynamic,static,non_strict,
       strict,op,global,persistent.
     - If a query in the file asserts rules, these rules are not 
       retracted when reconsulting the file. This should anyway never 
       occur: use expanders, and end your rules with a dot.

  4) Files are identified by the complete name (path included) used 
     to load them. It means that you may have problems if you don't 
     use the same name to load and reconsult the file.
  ") ?
 <EOF>

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% X start up.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% PVR 13.10.93

% persistent(x_loaded), x_loaded<<-false?

% public(x_loaded)?
% persistent(x_loaded)?
% x_loaded<<-false?

% public(load_x)?
% dynamic(load_x)?
% 
% load_x :-
% 	retract(load_x :- G),
% 	assert((load_x :- write_err("*** X library already loaded."),nl)),
% 	quiet_write("Loading X library..."),
% 	simple_load("~/life_local/xpublic.lf"),      % RM: Jan 13 1993 
% 	simple_load("~/life_local/xconstants.lf"),
% 	simple_load("~/life_local/xtables.lf"),
% 	simple_load("~/life_local/xgetset.lf"),
% 	simple_load("~/life_local/xpred.lf").
% 
%%  simple_load("~/life_local/xfunctions.lf"),  % RM: Mar 11 1993 
% 
  
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% Get ready for user input

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% The 'user' module:

display_modules(false) ?

module("user")?
open_module("built_ins")?
open_module("syntax")?
% PVR 13.10.93 open_module("x")?
init,
initrandom(real_time)?
No customizing file loaded.

% display_modules(false)?   % BD June 10 1993
% display_module_status?
 <EOF>
>  <EOF>

*** Exiting Wild_Life  [0.000s cpu, 0.000s gc (-nan%)]
