diogo
/
yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'master' of ssh://git.code.sf.net/p/yap/yap-6.3

This commit is contained in:
Vítor Santos Costa 2014-01-17 09:39:49 +00:00
parent ccccf71ae1 2c8fcc6698
commit e1201fc468
13 changed files with 74 additions and 98 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
C/c_interface.c
View File

@ -2859,7 +2859,7 @@ YAP_Read(IOSTREAM *inp)
BACKUP_MACHINE_REGS();
tokstart = LOCAL_tokptr = LOCAL_toktide = Yap_tokenizer(inp, FALSE, &tpos);
tokstart = LOCAL_tokptr = LOCAL_toktide = Yap_tokenizer(inp, FALSE, &tpos, &rd);
if (LOCAL_ErrorMessage)
{
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);

2
C/iopreds.c
View File

@ -504,7 +504,7 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
old_H = H;
LOCAL_Comments = TermNil;
LOCAL_CommentsNextChar = LOCAL_CommentsTail = NULL;
tokstart = LOCAL_tokptr = LOCAL_toktide = Yap_tokenizer(inp_stream, store_comments, &tpos);
tokstart = LOCAL_tokptr = LOCAL_toktide = Yap_tokenizer(inp_stream, store_comments, &tpos, rd);
if (LOCAL_Error_TYPE != YAP_NO_ERROR && seekable) {
H = old_H;
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);

9
C/scanner.c
View File

@ -820,7 +820,7 @@ ch_to_wide(char *base, char *charp)
{ charp = _PL__utf8_put_char(charp, ch); } }
TokEntry *
Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp)
Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp, void *rd0)
{
GET_LD
TokEntry *t, *l, *p;
@ -829,6 +829,7 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp)
int ch;
wchar_t *wcharp;
struct qq_struct_t *cur_qq = NULL;
struct read_data_t *rd = rd0;
LOCAL_ErrorMessage = NULL;
LOCAL_Error_Size = 0;
@ -843,7 +844,7 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp)
ch = getchr(inp_stream);
}
*tposp = Yap_StreamPosition(inp_stream);
Yap_setCurrentSourceLocation(&inp_stream);
Yap_setCurrentSourceLocation( rd );
LOCAL_StartLine = inp_stream->posbuf.lineno;
do {
wchar_t och;
@ -907,7 +908,7 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp)
}
CHECK_SPACE();
*tposp = Yap_StreamPosition(inp_stream);
Yap_setCurrentSourceLocation(&inp_stream);
Yap_setCurrentSourceLocation( rd );
}
goto restart;
} else {
@ -1230,7 +1231,7 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp)
}
CHECK_SPACE();
*tposp = Yap_StreamPosition(inp_stream);
Yap_setCurrentSourceLocation(&inp_stream);
Yap_setCurrentSourceLocation( rd );
}
}
goto restart;

2
H/pl-shared.h
View File

@ -264,7 +264,7 @@ getUnknownModule(module_t m);
COMMON(int) debugmode(debug_type new, debug_type *old);
COMMON(int) tracemode(debug_type new, debug_type *old);
COMMON(void) Yap_setCurrentSourceLocation(IOSTREAM **s);
COMMON(void) Yap_setCurrentSourceLocation( void *rd );
extern int raiseSignal(PL_local_data_t *ld, int sig);

2
H/pl-yap.h
View File

@ -34,7 +34,7 @@ extern Int Yap_GetCurrentPredArity(void);
extern term_t Yap_fetch_module_for_format(term_t args, Term *modp);
extern IOENC Yap_DefaultEncoding(void);
extern void Yap_SetDefaultEncoding(IOENC);
extern void Yap_setCurrentSourceLocation(IOSTREAM **s);
extern void Yap_setCurrentSourceLocation( void *rd );
extern void *Yap_GetStreamHandle(Atom at);
extern atom_t codeToAtom(int chrcode);

2
H/yapio.h
View File

@ -240,7 +240,7 @@ Term Yap_Variables(VarEntry *,Term);
Term Yap_Singletons(VarEntry *,Term);
/* routines in scanner.c */
TokEntry *Yap_tokenizer(struct io_stream *, int, Term *);
TokEntry *Yap_tokenizer(struct io_stream *, int, Term *, void *rd);
void Yap_clean_tokenizer(TokEntry *, VarEntry *, VarEntry *,Term);
Term Yap_scan_num(struct io_stream *);
char *Yap_AllocScannerMemory(unsigned int);

10
os/pl-read.c
View File

@ -20,7 +20,7 @@ void
init_read_data(ReadData _PL_rd, IOSTREAM *in ARG_LD)
{ CACHE_REGS
memset(_PL_rd, 0, sizeof(*_PL_rd)); /* optimise! */
_PL_rd->magic = RD_MAGIC;
_PL_rd->varnames = 0;
_PL_rd->module = Yap_GetModuleEntry(CurrentModule);
@ -356,14 +356,10 @@ addToBuffer(int c, ReadData _PL_rd)
#if __YAP_PROLOG__
void
Yap_setCurrentSourceLocation(IOSTREAM ** rd)
Yap_setCurrentSourceLocation( void *rd )
{
GET_LD
if (*rd) {
read_data rdt;
rdt._rb.stream = *rd;
setCurrentSourceLocation(&rdt PASS_LD);
}
setCurrentSourceLocation(rd PASS_LD);
}
#endif

12
pl/boot.yap
View File

@ -1069,7 +1069,17 @@ bootstrap(F) :-
!.
'$enter_command'(Stream,Mod,Status) :-
read_term(Stream, Command, [module(Mod), variable_names(Vars), term_position(Pos), syntax_errors(dec10), process_comment(true) ]),
read_term(Stream, Command, [module(Mod), variable_names(Vars), term_position(Pos), syntax_errors(dec10), process_comment(true), singletons( Singletons ) ]),
( Singletons == []
->
true
;
get_value('$syntaxchecksinglevar',on)
->
'$sv_warning'(Singletons, Command )
;
true
),
'$command'(Command,Vars,Pos,Status).
'$abort_loop'(Stream) :-

68
pl/checker.yap
View File

@ -141,22 +141,18 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
'$init_style_check'(_).
% style checker proper..
'$check_term'(T, _, VL,P,_) :-
get_value('$syntaxchecksinglevar',on),
'$singletons_in_clause'(T, VL, Sv),
Sv = [_|_],
'$sv_warning'(Sv,T),
fail.
'$check_term'(_, T, _,P,M) :-
get_value('$syntaxcheckdiscontiguous',on),
'$xtract_head'(T,M,NM,_,F,A),
strip_module(T, M, T1),
'$pred_arity'( T1, Name, Arity ),
% should always fail
'$handle_discontiguous'(F,A,NM),
'$handle_discontiguous'(Name, Arity, M),
fail.
'$check_term'(_, T,_,P,M) :-
get_value('$syntaxcheckmultiple',on),
'$xtract_head'(T,M,NM,_,F,A),
'$handle_multiple'(F,A,NM),
strip_module(T, M, T1),
'$pred_arity'( T1, Name, Arity ),
'$handle_multiple'( Name , Arity, M),
fail.
'$check_term'(_, T,_,_,M) :-
(
@ -167,7 +163,8 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
get_value('$syntaxcheckmultiple',on)
),
source_location( File, _ ),
'$xtract_head'(T,M,NM,_,F,A),
strip_module(T, M, T1),
'$pred_arity'( T1, Name, Arity ),
\+ (
% allow duplicates if we are not the last predicate to have
% been asserted.
@ -178,48 +175,19 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
fail.
'$check_term'(_,_,_,_,_).
%
% output a list of singleton variables...
%
'$singletons_in_clause'(T, VL, Sv) :-
% first check which variables are not singleton
'$non_singletons_in_term'(T, [], V2L),
% bound them
'$ground_vars'(V2L),
% the remainder which do not start by _ are our target!
'$sv_list'(VL, Sv).
'$ground_vars'([]).
'$ground_vars'([ground|V2L]) :-
'$ground_vars'(V2L).
'$sv_list'([],[]).
'$sv_list'([(_=V)|T],L) :- nonvar(V), !,
'$sv_list'(T,L).
'$sv_list'([(X=_)|T], L) :-
atom_concat('_',_,X), !,
'$sv_list'(T,L).
'$sv_list'([(Name=_)|T], [Name|L]) :-
'$sv_list'(T,L).
'$sv_warning'([], _) :- !.
'$sv_warning'(SVs, T) :-
'$current_module'(OM),
'$xtract_head'(T, OM, M, H, Name, Arity),
'$sv_warning'(SVs, T) :-
strip_module(T, M, T1),
'$pred_arity'( T1, Name, Arity ),
print_message(warning,singletons(SVs,(M:Name/Arity))).
'$xtract_head'(V,M,M,V,call,1) :- var(V), !.
'$xtract_head'((H:-_),OM,M,NH,Name,Arity) :- !,
'$xtract_head'(H,OM,M,NH,Name,Arity).
'$xtract_head'((H,_),OM,M,H1,Name,Arity) :- !,
'$xtract_head'(H,OM,M,H1,Name,Arity).
'$xtract_head'((H-->_),OM,M,HL,Name,Arity) :- !,
'$xtract_head'(H,M,OM,_,Name,A1),
Arity is A1+2,
functor(HL,Name,Arity).
'$xtract_head'(M:H,_,NM,NH,Name,Arity) :- !,
'$xtract_head'(H,M,NM,NH,Name,Arity).
'$xtract_head'(H,M,M,H,Name,Arity) :-
'$pred_arity'(V,M,M,V,call,1) :- var(V), !.
'$pred_arity'((H:-_),Name,Arity) :- !,
functor(H,Name,Arity).
'$pred_arity'((H-->_),Name,Arity) :- !,
functor(HL,Name,1),
Arity is A1+2.
'$pred_arity'(H,Name,Arity) :-
functor(H,Name,Arity).
% check if a predicate is discontiguous.

23
pl/consult.yap
View File

@ -257,12 +257,14 @@ load_files(Files,Opts) :-
'$file_loaded'(Stream, Mod, Imports, TOpts), !,
'$lf_opt'('$options', TOpts, Opts),
'$lf_opt'('$location', TOpts, ParentF:Line),
'$loaded'(Stream, UserFile, Mod, ParentF, Line, not_loaded, _File, _Dir, Opts).
'$loaded'(Stream, UserFile, Mod, ParentF, Line, not_loaded, _File, _Dir, Opts),
'$reexport'( TOpts, UserFile, Imports, Mod ).
'$start_lf'(changed, Mod, Stream, TOpts, UserFile, Imports) :-
'$file_unchanged'(Stream, Mod, Imports, TOpts), !,
'$lf_opt'('$options', TOpts, Opts),
'$lf_opt'('$location', TOpts, ParentF:Line),
'$loaded'(Stream, UserFile, Mod, ParentF, Line, changed, _File, _Dir, Opts).
'$loaded'(Stream, UserFile, Mod, ParentF, Line, changed, _File, _Dir, Opts),
'$reexport'( TOpts, UserFile, Imports, Mod ).
'$start_lf'(_, Mod, Stream, TOpts, File, _) :-
'$do_lf'(Mod, Stream, File, TOpts).
@ -392,13 +394,7 @@ use_module(M,F,Is) :-
% ( File = '/Users/vsc/Yap/bins/threads/share/Yap/error.pl' -> start_low_level_trace ; stop_low_level_trace ),
'$lf_opt'(imports, TOpts, Imports),
'$import_to_current_module'(File, ContextModule, Imports, _, TOpts),
'$lf_opt'(reexport, TOpts, Reexport),
( Reexport == false -> true ;
'$lf_opt'('$parent_topts', TOpts, OldTOpts),
'$lf_opt'('$context_module', OldTOpts, OldContextModule),
'$import_to_current_module'(File, OldContextModule, Imports, _, TOpts),
'$extend_exports'(ContextModule, Imports)
),
'$reexport'( TOpts, File, Imports, ContextModule ),
( LC == 0 -> prompt(_,' |: ') ; true),
'$exec_initialisation_goals',
% format( 'O=~w~n', [Mod=UserFile] ),
@ -582,6 +578,15 @@ initialization(G,OPT) :-
print_message(Verbosity, loaded(included, Y, Mod, T, H)),
nb_setval('$included_file',OY).
'$reexport'( TOpts, File, Imports, ContextModule ) :-
'$lf_opt'(reexport, TOpts, Reexport),
( Reexport == false -> true ;
'$lf_opt'('$parent_topts', TOpts, OldTOpts),
'$lf_opt'('$context_module', OldTOpts, OldContextModule),
'$import_to_current_module'(File, OldContextModule, Imports, _, TOpts),
'$extend_exports'(ContextModule, Imports)
).
'$do_startup_reconsult'(X) :-
( '$access_yap_flags'(15, 0) ->
'$system_catch'(load_files(X, [silent(true)]), Module, Error, '$Error'(Error))

7
pl/errors.yap
View File

@ -275,11 +275,12 @@ print_message(_, Term) :-
'$print_system_message'(_, banner, _) :-
current_prolog_flag(verbose, silent), !.
'$print_system_message'(Term, Level, Lines) :-
'$messages':prefix(Level, LinePrefix, Stream, Prefix),
'$messages':file_location(Prefix, LinesF, Lines), !,
( Level == error -> Term \= error(syntax_error(_), _) ; Level == warning ),
'$messages':prefix(Level, LinePrefix, Stream, LinesF, Lines2),
'$messages':file_location(Lines2, Lines), !,
flush_output(user_output),
flush_output(user_error),
print_message_lines(Stream, LinePrefix, LinesF).
print_message_lines(Stream, LinePrefix, [nl|LinesF]).
'$print_system_message'(Error, Level, Lines) :-
flush_output(user_output),
flush_output(user_error),

4
pl/init.yap
View File

@ -234,10 +234,6 @@ user:prolog_file_type(A, executable) :-
:- dynamic file_search_path/2.
:- multifile generate_message_hook/3.
:- dynamic generate_message_hook/3.
:- multifile swi:swi_predicate_table/4.
:- multifile user:message_hook/3.

29
pl/messages.yap
View File

@ -24,18 +24,17 @@
:- multifile prolog:message/3.
file_location(Prefix) -->
{
prolog_load_context(file, FileName)
},
{ '$start_line'(LN) },
file_position(FileName,LN,Prefix),
:- multifile user:generate_message_hook/3.
file_location -->
{ source_location(FileName, LN) },
file_position(FileName,LN),
[ nl ].
file_position(user_input,LN,MsgCodes) -->
[ '~a (user_input:~d).' - [MsgCodes,LN] ].
file_position(FileName,LN,MsgCodes) -->
[ '~a (~a:~d).' - [MsgCodes,FileName,LN] ].
file_position(user_input,LN) -->
[ 'at line ~d in user_input,' - [LN] ].
file_position(FileName,LN) -->
[ 'at line ~d in ~a,' - [LN,FileName] ].
translate_message(Term) -->
@ -155,7 +154,7 @@ system_message(no_match(P)) -->
[ 'No matching predicate for ~w.' - [P] ].
system_message(leash([A|B])) -->
[ 'Leashing set to ~w.' - [[A|B]] ].
system_message(singletons([SV],P)) -->
system_message(singletons([SV=_],P)) -->
[ 'Singleton variable ~s in ~q.' - [SV,P] ].
system_message(singletons(SVs,P)) -->
[ 'Singleton variables ~s in ~q.' - [SVsL, P] ],
@ -443,8 +442,8 @@ object_name(unsigned_byte, 'unsigned byte').
object_name(unsigned_char, 'unsigned char').
object_name(variable, 'unbound variable').
svs([A]) --> !, { atom_codes(A, H) }, H.
svs([A|L]) -->
svs([A=_]) --> !, { atom_codes(A, H) }, H.
svs([A=_|L]) -->
{ atom_codes(A, H) },
H,
", ",
@ -499,7 +498,7 @@ syntax_error_token(A) --> !,
% Quintus/SICStus/SWI compatibility predicate to print message lines
% using a prefix.
prolog:print_message_lines(_, _, []) :- !.
prolog:print_message_lines(S, _, []) :- !.
prolog:print_message_lines(S, P, [at_same_line|Lines]) :- !,
print_message_line(S, Lines, Rest),
prolog:print_message_lines(S, P, Rest).
@ -512,7 +511,7 @@ prolog:print_message_lines(S, kind(Kind), Lines) :- !,
],
AllLines),
print_message_lines(S, Prefix, AllLines).
prolog:print_message_lines(S, P-Opts, Lines) :- !,
prolog:print_message_lines(S, P-Opts, Lines) :-
atom(P), !,
atom_concat('~N', P, Prefix),
format(S, Prefix, Opts),