af0fb4f4d9
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2088 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
243 lines
6.8 KiB
Prolog
243 lines
6.8 KiB
Prolog
/* $Id: prolog_source.pl,v 1.1 2008-02-12 17:03:53 vsc Exp $
|
|
|
|
Part of SWI-Prolog
|
|
|
|
Author: Jan Wielemaker
|
|
E-mail: wielemak@science.uva.nl
|
|
WWW: http://www.swi-prolog.org
|
|
Copyright (C): 1985-2005, University of Amsterdam
|
|
|
|
This program is free software; you can redistribute it and/or
|
|
modify it under the terms of the GNU General Public License
|
|
as published by the Free Software Foundation; either version 2
|
|
of the License, or (at your option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public
|
|
License along with this library; if not, write to the Free Software
|
|
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
|
|
As a special exception, if you link this library with other files,
|
|
compiled with a Free Software compiler, to produce an executable, this
|
|
library does not by itself cause the resulting executable to be covered
|
|
by the GNU General Public License. This exception does not however
|
|
invalidate any other reasons why the executable file might be covered by
|
|
the GNU General Public License.
|
|
*/
|
|
|
|
:- module(prolog_source,
|
|
[ prolog_read_source_term/4, % +Stream, -Term, -Expanded, +Options
|
|
prolog_open_source/2, % +Source, -Stream
|
|
prolog_close_source/1, % +Stream
|
|
prolog_canonical_source/2 % +Spec, -Id
|
|
]).
|
|
:- use_module(operators).
|
|
:- use_module(debug).
|
|
|
|
/** <module> Examine Prolog source-files
|
|
|
|
The modile prolog_source.pl provides predicates to open, close and read
|
|
terms from Prolog source-files. This may seem easy, but there are a
|
|
couple of problems that must be taken care of.
|
|
|
|
* Source files may start with #!, supporting PrologScript
|
|
* Embeded operators declarations must be taken into account
|
|
* Style-check options must be taken into account
|
|
* Operators and style-check options may be implied by directives
|
|
* On behalf of the development environment we also wish to
|
|
parse PceEmacs buffers
|
|
|
|
This module concentrates these issues in a single library. Intended
|
|
users of the library are:
|
|
|
|
$ prolog_xref.pl : The Prolog cross-referencer
|
|
$ PceEmacs : Emacs syntax-colouring
|
|
$ PlDoc : The documentation framework
|
|
*/
|
|
|
|
:- thread_local
|
|
open_source/2. % Stream, State
|
|
|
|
:- multifile
|
|
requires_library/2,
|
|
prolog:xref_source_identifier/2, % +Source, -Id
|
|
prolog:xref_open_source/2. % +SourceId, -Stream
|
|
|
|
:- if(current_prolog_flag(dialect, yap)).
|
|
% yap
|
|
'$set_source_module'(M1, M2) :-
|
|
source_module(M1),
|
|
module(M2).
|
|
|
|
'$style_check'([Singleton,Discontiguous,Multiple], StyleF) :-
|
|
(
|
|
prolog_flag(single_var_warnings,on)
|
|
->
|
|
Singleton = singleton
|
|
;
|
|
Singleton = -singleton
|
|
),
|
|
(
|
|
prolog_flag(discontiguous_warnings,on)
|
|
->
|
|
Discontiguous = discontiguous
|
|
;
|
|
Discontiguous = -discontiguous
|
|
),
|
|
(
|
|
prolog_flag(redefine_warnings,on)
|
|
->
|
|
Multiple = multiple
|
|
;
|
|
Multiple = -multiple
|
|
),
|
|
style_check(StyleF).
|
|
:- endif.
|
|
|
|
|
|
/*******************************
|
|
* READING *
|
|
*******************************/
|
|
|
|
%% prolog_read_source_term(+In, -Term, -Expanded, +Options) is det.
|
|
%
|
|
% Read a term from a Prolog source-file. Options is a option list
|
|
% as normally provided to read_term/3.
|
|
%
|
|
% @param Term Term read
|
|
% @param Expanded Result of term-expansion on the term
|
|
|
|
prolog_read_source_term(In, Term, Expanded, Options) :-
|
|
'$set_source_module'(SM, SM),
|
|
read_term(In, Term,
|
|
[ module(SM)
|
|
| Options
|
|
]),
|
|
expand(Term, Expanded),
|
|
update_state(Expanded).
|
|
|
|
expand(Var, Var) :-
|
|
var(Var), !.
|
|
expand(Term, _) :-
|
|
requires_library(Term, Lib),
|
|
ensure_loaded(user:Lib),
|
|
fail.
|
|
expand('$:-'(X), '$:-'(X)) :- !, % boot module
|
|
style_check(+dollar).
|
|
expand(Term, Expanded) :-
|
|
expand_term(Term, Expanded).
|
|
|
|
%% requires_library(+Term, -Library)
|
|
%
|
|
% known expansion hooks. May be expanded as multifile predicate.
|
|
|
|
requires_library((:- emacs_begin_mode(_,_,_,_,_)), library(emacs_extend)).
|
|
requires_library((:- draw_begin_shape(_,_,_,_)), library(pcedraw)).
|
|
|
|
%% update_state(+Expanded) is det.
|
|
%
|
|
% Update operators and style-check options from the expanded term.
|
|
|
|
update_state([]) :- !.
|
|
update_state([H|T]) :- !,
|
|
update_state(H),
|
|
update_state(T).
|
|
update_state((:- Directive)) :- !,
|
|
update_directive(Directive).
|
|
update_state((?- Directive)) :- !,
|
|
update_directive(Directive).
|
|
update_state(_).
|
|
|
|
update_directive(module(Module, Public)) :- !,
|
|
'$set_source_module'(_, Module),
|
|
public_operators(Public).
|
|
update_directive(op(P,T,N)) :- !,
|
|
'$set_source_module'(SM, SM),
|
|
push_op(P,T,SM:N).
|
|
update_directive(style_check(Style)) :-
|
|
style_check(Style), !.
|
|
update_directive(_).
|
|
|
|
public_operators([]).
|
|
public_operators([H|T]) :- !,
|
|
( H = op(_,_,_)
|
|
-> update_directive(H)
|
|
; true
|
|
),
|
|
public_operators(T).
|
|
|
|
|
|
/*******************************
|
|
* SOURCES *
|
|
*******************************/
|
|
|
|
%% prolog_open_source(+CanonicalId:atomic, -Stream:stream) is det.
|
|
%
|
|
% Open source with given canonical id (see
|
|
% prolog_canonical_source/2) and remove the #! line if any.
|
|
% Streams opened using this predicate must be closed using
|
|
% prolog_close_source/1. Typically using the skeleton below. Using
|
|
% this skeleton, operator and style-check options are
|
|
% automatically restored to the values before opening the source.
|
|
%
|
|
% ==
|
|
% process_source(Src) :-
|
|
% prolog_open_source(Src, In),
|
|
% call_cleanup(process(Src), prolog_close_source(In)).
|
|
% ==
|
|
|
|
prolog_open_source(Src, Fd) :-
|
|
( prolog:xref_open_source(Src, Fd)
|
|
-> true
|
|
; open(Src, read, Fd)
|
|
),
|
|
( peek_char(Fd, #) % Deal with #! script
|
|
-> skip(Fd, 10)
|
|
; true
|
|
),
|
|
push_operators([]),
|
|
'$set_source_module'(SM, SM),
|
|
'$style_check'(Style, Style),
|
|
asserta(open_source(Fd, state(Style, SM))).
|
|
|
|
|
|
%% prolog_close_source(+In:stream) is det.
|
|
%
|
|
% Close a stream opened using prolog_open_source/2. Restores
|
|
% operator and style options.
|
|
|
|
prolog_close_source(In) :-
|
|
pop_operators,
|
|
( retract(open_source(In, state(Style, SM)))
|
|
-> '$style_check'(_, Style),
|
|
'$set_source_module'(_, SM)
|
|
; assertion(fail)
|
|
),
|
|
close(In).
|
|
|
|
|
|
%% prolog_canonical_source(+SourceSpec:ground, -Id:atomic) is det.
|
|
%
|
|
% Given a user-specification of a source, generate a unique and
|
|
% indexable identifier for it. For files we use the
|
|
% prolog_canonical absolute filename.
|
|
|
|
prolog_canonical_source(Src, Id) :- % Call hook
|
|
prolog:xref_source_identifier(Src, Id), !.
|
|
prolog_canonical_source(User, user) :-
|
|
User == user, !.
|
|
prolog_canonical_source(Source, Src) :-
|
|
absolute_file_name(Source,
|
|
[ file_type(prolog),
|
|
access(read),
|
|
file_errors(fail)
|
|
],
|
|
Src), !.
|
|
prolog_canonical_source(Source, Src) :-
|
|
var(Source), !,
|
|
Src = Source.
|