SPACE 1/SPACE - Library 1 - Volume 1.iso/program/363/xprolog2/_boot

Text File | 1985-11-19 | 5.7 KB | 221 lines

/*

 *        X PROLOG  Vers. 2.0

 *

 *

 *    Written by :     Andreas Toenne

 *            CS Dept. , IRB

 *            University of Dortmund, W-Germany

 *            <[e-mail]>

 *            <....!seismo!unido!atoenne>

 *            <[e-mail]>

 *

 *    Copyright :    This software is copyrighted by Andreas Toenne.

 *            Permission is granted hereby to copy the entire

 *            package including this copyright notice without fee.

 *

 */



%    X Prolog Boot File



% hack to create an intermediate goal for call

% this make the cut local to call



call(A) :- $call(A).



% definitions for conjunction and disjunction

% both procedures are made transparent to the cut



(A ; B) :- $call(A).

(A ; B) :- $call(B).



(A , B) :- $call(A), $call(B).



% further predicates



not(Predicate) :- call(Predicate), !, fail.

not(Predicate).



clause(Head, Body) :- $clause(Head, Body, Help).  % see the documentation



A = A.                    % equality predicate :-)



print(Term) :- var(Term), !, write(Term).

print(Term) :- portray(Term).        % portray should be user defined



append([],L,L).                % common append procedure

append([X|L1],L2,[X|L3]) :- append(L1,L2,L3).



member(X, [X|_]).            % common member procedure

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



% toplevel interpreter loop

% the main goal should not be changed



main :- $loop(toplevel).        % start things

main.                    % just to make Xprolog happy



% this is a failure driven loop



$loop(toplevel) :-

    prompt(Old, '|    '),        % change the default prompt

    repeat,                % loop forever

        $prompt('?- '),        % give a prompt

        read(Term),        % wait for response

        $solve(Term, toplevel),    % solve the query

    prompt(_, Old),            % restore the prompt

    !.

$loop(Where) :-                % loop not at top level

    prompt(Old, '| '),        % different default prompt

    repeat,                % round and round again

        prompt_if_user,        % no prompt for files

        read(Term),        % read something

        $solve(Term, Where),    % solve it

    prompt(_, Old),            % restore the prompt

    !.



prompt_if_user :- seeing(user), $prompt('| '), !.

prompt_if_user.



$solve(end_of_file, _) :- !.        % the only way to stop the repeat

$solve(Term, _) :- var(Term), !, fail.    % don't accept strange goals

$solve(Term, Where) :-            % try to solve it as a goal

    $query(Term, Where, Goal, What), % check for sort of question

    !,

    prompt(Old, '|: '),

    $solve_goal(Goal, What),    % try to solve a goal

    prompt(_, Old),

    fail.

$solve(Term, Where) :-            % try to assert it

    $process(Term, Result),        % hook for preprocessors

    assertz(Result),        % assert it

    !,

    fail.

$solve(Term, _) :-            % assert or $process failed

    write('! clause: '),

    write(Term),

    fail.



% this is a hook to add preprocessors like the grammar rule translator

% to this top level interpreter.

% simply add via 'asserta' another clause for the preprocessor



$process(T,T).



% check the current term for a question or a command



$query(:-(X), _, X, command) :- !.    % this is a command

$query(?-(X), _, X, question) :- !.    % this is a question

$query(X, toplevel, X, question).    % always questions on top level



% this procedure solves goals

% note the use of $more and $goalvars



$solve_goal(Term, command) :-        % no answer, no alternatives

    call(Term),            % try it once

    !.                % and no further alternatives

$solve_goal(_, command)    :-        % above clause failed

    !,

    nl, write('?'), nl.        % notify the user

$solve_goal(Term, question) :-

    $goalvars(List),        % save the reader's symbol table

    call(Term),            % try the question

    $more(Ok),            % call(Term) had a alternative ?

    $reply(List, Ok),        % say 'yes' to the user

    nl,

    !.

$solve_goal(_, question) :-        % above clause failed !

    nl,

    write(no),            % sorry but ...

    nl,

    !.



$reply(List, Ok) :-            % say yes and show variables

    $show_variables(List),

    write(yes),            % horray

    Ok = yes,            % an alternative ?

    $askformore,            % check if the user wants it

    !.

$reply(_, Ok) :-            % no more alternative

    Ok = no,

    !.



$askformore :- get(X), skip(10), X \== 59. % 59 is ';'



$show_variables([]) :- !.

$show_variables([(Name, Variable)|L]) :-

    write(Name),

    write(' = '),

    write(Variable),

    nl,

    !,

    $show_variables(L).







% consult and friends

% we simply use the top level interpreter for the asserts and queries



[X|Y] :- $process_files([X|Y]).



$process_files([]) :- !.

$process_files([-File|Rest]) :- !, reconsult(File), $process_files(Rest).

$process_files([File|Rest]) :- !, consult(File), $process_files(Rest).



consult(File) :- !, $read_file(File, 0).



reconsult(File) :- !, $read_file(File, 1).



$read_file(File, R) :-

    Heap is heapused,

    Time is cputime,

    $reconsulting(R),

    $test_filename(File),        % check the file

    seeing(OldIn),

    telling(OldOut),

    see(File),            % open the file

    $do_loop,

    seen,                % close the file

    see(OldIn),

    tell(OldOut),

    $reconsulting(0),

    DiffTime is cputime - Time,

    DiffHeap is heapused - Heap,

    write(File),

    ( R == 0 , write('  consulted ') ;

      R == 1 , write('  reconsulted ')),

    write(DiffHeap), write(' bytes '),

    write(DiffTime), write(' msec.'),

    nl, !.



$do_loop :- $loop(filelevel).        % loop at filelevel

$do_loop.



$test_filename(user) :- !.        % this stream is always ok

$test_filename(File) :-

    not atom(File),            % invalid name

    nl,

    write('Invalid filename: '),

    write(File),

    nl,

    !, fail.

$test_filename(File) :-

    not exists(File),        % file not found

    nl,

    write('The file '),

    write(File),

    write(' does not exist.'),

    nl,

    !, fail.

$test_filename(_).            % is ok



%

% debugging hooks

%



leash(off) :- $leash(0).

leash(loose) :- $leash(1).

leash(half) :- $leash(5).

leash(tight) :- $leash(7).

leash(full) :- $leash(15).