This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/pl/consult.yap
vsc e5f4633c39 This commit was generated by cvs2svn to compensate for changes in r4,
which included commits to RCS files with non-trunk default branches.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@5 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
2001-04-09 19:54:03 +00:00

276 lines
7.3 KiB
Prolog

/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: consult.yap *
* Last rev: 8/2/88 *
* mods: *
* comments: Consulting Files in YAP *
* *
*************************************************************************/
'$ensure_loaded'(V) :- var(V), !,
throw(error(instantiation_error,ensure_loaded(V))).
'$ensure_loaded'([]) :- !.
'$ensure_loaded'([F|Fs]) :- !,
'$ensure_loaded'(F),
'$ensure_loaded'(Fs).
'$ensure_loaded'(X) :- atom(X), !,
'$find_in_path'(X,Y),
( open(Y,'$csult',Stream), !,
( '$loaded'(Stream) ->
( $consulting_file_name(Stream,TFN),
'$recorded'('$module','$module'(TFN,M,P),_) ->
$current_module(T,T), '$import'(P,M,T)
;
true
)
;
'$record_loaded'(Stream),
'$reconsult'(X,Stream)
),
close(Stream)
;
throw(error(permission_error(input,stream,X),ensure_loaded(X)))
).
'$ensure_loaded'(library(X)) :- !,
'$find_in_path'(library(X),Y),
( open(Y,'$csult',Stream), !,
( '$loaded'(Stream) ->
( '$consulting_file_name'(Stream,TFN),
'$recorded'($module,$module(TFN,M,P),_) ->
$current_module(T,T), $import(P,M,T)
;
true
)
;
'$record_loaded'(Stream),
'$reconsult'(Y,Stream)
),
close(Stream)
;
throw(error(permission_error(input,stream,library(X)),ensure_loaded(library(X))))
).
'$ensure_loaded'(V) :-
throw(error(type_error(atom,V),ensure_loaded(V))).
compile(P) :-
'$has_yap_or',
throw(error(context_error(compile(P),clause),query)).
compile(P) :-
'$compile'(P).
% leave compile mode to 1 for native code.
'$compile'(A) :-
'$compile_mode'(Old,0),
'$reconsult'(A),
'$compile_mode'(_,Old).
consult(Fs) :-
'$has_yap_or',
throw(error(context_error(consult(Fs),clause),query)).
consult(Fs) :-
'$consult'(Fs).
reconsult(Fs) :-
'$has_yap_or',
throw(error(context_error(reconsult(Fs),clause),query)).
reconsult(Fs) :-
'$reconsult'(Fs).
'$reconsult'(V) :- var(V), !,
throw(error(instantiation_error,reconsult(V))).
'$reconsult'([]) :- !.
'$reconsult'([F|Fs]) :- !,
'$reconsult'(F),
'$reconsult'(Fs).
'$reconsult'(X) :- atom(X), !,
'$find_in_path'(X,Y),
( open(Y,'$csult',Stream), !,
'$record_loaded'(Stream),
'$reconsult'(X,Stream), close(Stream)
;
throw(error(permission_error(input,stream,X),reconsult(X)))
).
'$reconsult'(library(X)) :- !,
'$find_in_path'(library(X),Y),
( open(Y,'$csult',Stream), !,
'$record_loaded'(Stream),
'$reconsult'(library(X),Stream), close(Stream)
;
throw(error(permission_error(input,stream,library(X)),reconsult(library(X))))
).
'$reconsult'(V) :-
throw(error(type_error(atom,V),reconsult(V))).
'$reconsult'(F,Stream) :-
'$getcwd'(OldD),
'$get_value'('$consulting_file',OldF),
'$set_consulting_file'(Stream),
H0 is heapused, T0 is cputime,
current_stream(File,_,Stream),
'$get_value'('$consulting',Old),
'$set_value'('$consulting',false),
'$start_reconsulting'(F),
'$start_consult'(reconsult,File,LC),
'$recorda'('$initialisation','$',_),
( '$get_value'('$verbose',on) ->
tab(user_error,LC),
'$format'(user_error, "[ reconsulting ~w... ]~n", [F])
; true ),
'$loop'(Stream,reconsult),
'$end_consult',
'$clear_reconsulting',
( LC == 0 -> prompt(_,' |: ') ; true),
( '$get_value'('$verbose',on) ->
tab(user_error,LC) ;
true ),
H is heapused-H0, T is cputime-T0,
( '$get_value'('$verbose',off) ->
true
;
'$format'(user_error, "[ ~w reconsulted ~w bytes in ~w seconds ]~n", [F,H,T])
),
'$set_value'('$consulting',Old),
'$set_value'('$consulting_file',OldF),
'$cd'(OldD),
!.
'$start_reconsulting'(F) :-
'$recorda'('$reconsulted','$',_),
'$recorda'('$reconsulting',F,_).
'EMACS_FILE'(F,File0) :-
format('''EMACS_RECONSULT''(~w).~n',[File0]),
'$getcwd'(OldD),
open(F,$csult,Stream),
'$find_in_path'(File0,File),
open(File,$csult,Stream0),
'$get_value'('$consulting_file',OldF),
'$set_consulting_file'(Stream0),
H0 is heapused, T0 is cputime,
'$get_value'('$consulting',Old),
'$set_value'('$consulting',false),
'$start_reconsulting'(File),
'$start_consult'(reconsult,File,LC),
'$recorda'('$initialisation','$',_),
( '$get_value'('$verbose',on) ->
tab(user_error,LC),
'$format'(user_error, "[ reconsulting ~w... ]~n", [F])
; true ),
'$loop'(Stream,reconsult),
'$end_consult',
'$clear_reconsulting',
( LC == 0 -> prompt(_,' |: ') ; true),
( '$get_value'($verbose,on) ->
tab(user_error,LC) ;
true ),
H is heapused-H0, T is cputime-T0,
( '$get_value'('$verbose',off) ->
true
;
'$format'(user_error, "[ ~w reconsulted ~w bytes in ~w seconds ]~n", [F,H,T])
),
'$set_value'('$consulting',Old),
'$set_value'('$consulting_file',OldF),
'$cd'(OldD),
!.
'$initialization'(V) :-
var(V), !,
throw(error(instantiation_error,initialization(V))).
'$initialization'(C) :- number(C), !,
throw(error(type_error(callable,C),initialization(C))).
'$initialization'(C) :- db_reference(C), !,
throw(error(type_error(callable,C),initialization(C))).
'$initialization'(G) :-
'$recorda'('$initialisation',G,_),
fail.
'$initialization'(_).
'$include'(V, _) :- var(V), !,
throw(error(instantiation_error,include(V))).
'$include'([], _) :- !.
'$include'([F|Fs], Status) :- !,
'$include'(F, Status),
'$include'(Fs, Status).
'$include'(X, Status) :- atom(X), !,
'$find_in_path'(X,Y),
'$values'('$included_file',OY,Y),
( open(Y,'$csult',Stream), !,
'$loop'(Stream,Status), close(Stream)
;
throw(error(permission_error(input,stream,Y),include(X)))
),
'$put_value'('$included_file',OY).
'$include'(V, _) :-
throw(error(type_error(atom,V),include(V))).
'$do_startup_reconsult'(X) :-
( '$access_yap_flags'(15, 0) ->
true
;
'$set_value'('$verbose',off)
),
'$find_in_path'(X,Y),
( open(Y,'$csult',Stream), !,
'$record_loaded'(Stream),
( '$access_yap_flags'(15, 0) -> true ; '$skip_unix_comments'(Stream) ),
'$reconsult'(X,Stream), close(Stream)
;
'$output_error_message'(permission_error(input,stream,X),reconsult(X))
),
( '$access_yap_flags'(15, 0) -> true ; halt).
'$skip_unix_comments'(Stream) :-
'$peek_byte'(Stream, 0'#), !, % 35 is ASCII for #
'$get0_line_codes'(Stream, _),
'$skip_unix_comments'(Stream).
'$skip_unix_comments'(Stream).
prolog_load_context(_, X) :-
'$get_value'('$consulting_file',[]), !, fail.
prolog_load_context(directory, DirName) :-
'$get_value'('$consulting_file',FileName),
(FileName = user_input ->
'$getcwd'(S),
atom_codes(DirName,S)
;
atom_codes(FileName,S),
'$strip_file_for_scd'(S,Dir,Unsure,Unsure),
atom_codes(DirName,Dir)
).
prolog_load_context(file, FileName) :-
'$get_value'('$included_file',IncFileName),
( IncFileName = [] ->
'$get_value'('$consulting_file',FileName)
;
FileName = IncFileName
).
prolog_load_context(module, X) :-
'$current_module'(X).
prolog_load_context(source, FileName) :-
'$get_value'('$consulting_file',FileName).
prolog_load_context(stream, Stream) :-
'$fetch_stream_alias'('$loop_stream', Stream).
prolog_load_context(term_position, Position) :-
'$fetch_stream_alias'('$loop_stream', Stream),
stream_position(Stream, Position).