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

Browse Source
This commit is contained in:
Vítor Santos Costa 2014-01-17 09:39:49 +00:00
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(); 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) if (LOCAL_ErrorMessage)
{ {
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments); 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; old_H = H;
LOCAL_Comments = TermNil; LOCAL_Comments = TermNil;
LOCAL_CommentsNextChar = LOCAL_CommentsTail = NULL; 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) { if (LOCAL_Error_TYPE != YAP_NO_ERROR && seekable) {
H = old_H; H = old_H;
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments); 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); } } { charp = _PL__utf8_put_char(charp, ch); } }
TokEntry * 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 GET_LD
TokEntry *t, *l, *p; TokEntry *t, *l, *p;
@ -829,6 +829,7 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp)
int ch; int ch;
wchar_t *wcharp; wchar_t *wcharp;
struct qq_struct_t *cur_qq = NULL; struct qq_struct_t *cur_qq = NULL;
struct read_data_t *rd = rd0;
LOCAL_ErrorMessage = NULL; LOCAL_ErrorMessage = NULL;
LOCAL_Error_Size = 0; LOCAL_Error_Size = 0;
@ -843,7 +844,7 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp)
ch = getchr(inp_stream); ch = getchr(inp_stream);
} }
*tposp = Yap_StreamPosition(inp_stream); *tposp = Yap_StreamPosition(inp_stream);
Yap_setCurrentSourceLocation(&inp_stream); Yap_setCurrentSourceLocation( rd );
LOCAL_StartLine = inp_stream->posbuf.lineno; LOCAL_StartLine = inp_stream->posbuf.lineno;
do { do {
wchar_t och; wchar_t och;
@ -907,7 +908,7 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp)
} }
CHECK_SPACE(); CHECK_SPACE();
*tposp = Yap_StreamPosition(inp_stream); *tposp = Yap_StreamPosition(inp_stream);
Yap_setCurrentSourceLocation(&inp_stream); Yap_setCurrentSourceLocation( rd );
} }
goto restart; goto restart;
} else { } else {
@ -1230,7 +1231,7 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp)
} }
CHECK_SPACE(); CHECK_SPACE();
*tposp = Yap_StreamPosition(inp_stream); *tposp = Yap_StreamPosition(inp_stream);
Yap_setCurrentSourceLocation(&inp_stream); Yap_setCurrentSourceLocation( rd );
} }
} }
goto restart; 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) debugmode(debug_type new, debug_type *old);
COMMON(int) tracemode(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); 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 term_t Yap_fetch_module_for_format(term_t args, Term *modp);
extern IOENC Yap_DefaultEncoding(void); extern IOENC Yap_DefaultEncoding(void);
extern void Yap_SetDefaultEncoding(IOENC); extern void Yap_SetDefaultEncoding(IOENC);
extern void Yap_setCurrentSourceLocation(IOSTREAM **s); extern void Yap_setCurrentSourceLocation( void *rd );
extern void *Yap_GetStreamHandle(Atom at); extern void *Yap_GetStreamHandle(Atom at);
extern atom_t codeToAtom(int chrcode); 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); Term Yap_Singletons(VarEntry *,Term);
/* routines in scanner.c */ /* 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); void Yap_clean_tokenizer(TokEntry *, VarEntry *, VarEntry *,Term);
Term Yap_scan_num(struct io_stream *); Term Yap_scan_num(struct io_stream *);
char *Yap_AllocScannerMemory(unsigned int); 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) init_read_data(ReadData _PL_rd, IOSTREAM *in ARG_LD)
{ CACHE_REGS { CACHE_REGS
memset(_PL_rd, 0, sizeof(*_PL_rd)); /* optimise! */ memset(_PL_rd, 0, sizeof(*_PL_rd)); /* optimise! */
_PL_rd->magic = RD_MAGIC; _PL_rd->magic = RD_MAGIC;
_PL_rd->varnames = 0; _PL_rd->varnames = 0;
_PL_rd->module = Yap_GetModuleEntry(CurrentModule); _PL_rd->module = Yap_GetModuleEntry(CurrentModule);
@ -356,14 +356,10 @@ addToBuffer(int c, ReadData _PL_rd)
#if __YAP_PROLOG__ #if __YAP_PROLOG__
void void
Yap_setCurrentSourceLocation(IOSTREAM ** rd) Yap_setCurrentSourceLocation( void *rd )
{ {
GET_LD GET_LD
if (*rd) { setCurrentSourceLocation(rd PASS_LD);
read_data rdt;
rdt._rb.stream = *rd;
setCurrentSourceLocation(&rdt PASS_LD);
}
} }
#endif #endif

12
pl/boot.yap
View File

@ -1069,7 +1069,17 @@ bootstrap(F) :-
!. !.
'$enter_command'(Stream,Mod,Status) :- '$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). '$command'(Command,Vars,Pos,Status).
'$abort_loop'(Stream) :- '$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'(_). '$init_style_check'(_).
% style checker proper.. % 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) :- '$check_term'(_, T, _,P,M) :-
get_value('$syntaxcheckdiscontiguous',on), get_value('$syntaxcheckdiscontiguous',on),
'$xtract_head'(T,M,NM,_,F,A), strip_module(T, M, T1),
'$pred_arity'( T1, Name, Arity ),
% should always fail % should always fail
'$handle_discontiguous'(F,A,NM), '$handle_discontiguous'(Name, Arity, M),
fail. fail.
'$check_term'(_, T,_,P,M) :- '$check_term'(_, T,_,P,M) :-
get_value('$syntaxcheckmultiple',on), get_value('$syntaxcheckmultiple',on),
'$xtract_head'(T,M,NM,_,F,A), strip_module(T, M, T1),
'$handle_multiple'(F,A,NM), '$pred_arity'( T1, Name, Arity ),
'$handle_multiple'( Name , Arity, M),
fail. fail.
'$check_term'(_, T,_,_,M) :- '$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) get_value('$syntaxcheckmultiple',on)
), ),
source_location( File, _ ), 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 % allow duplicates if we are not the last predicate to have
% been asserted. % been asserted.
@ -178,48 +175,19 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
fail. fail.
'$check_term'(_,_,_,_,_). '$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'([], _) :- !.
'$sv_warning'(SVs, T) :- '$sv_warning'(SVs, T) :-
'$current_module'(OM), strip_module(T, M, T1),
'$xtract_head'(T, OM, M, H, Name, Arity), '$pred_arity'( T1, Name, Arity ),
print_message(warning,singletons(SVs,(M:Name/Arity))). print_message(warning,singletons(SVs,(M:Name/Arity))).
'$xtract_head'(V,M,M,V,call,1) :- var(V), !. '$pred_arity'(V,M,M,V,call,1) :- var(V), !.
'$xtract_head'((H:-_),OM,M,NH,Name,Arity) :- !, '$pred_arity'((H:-_),Name,Arity) :- !,
'$xtract_head'(H,OM,M,NH,Name,Arity). functor(H,Name,Arity).
'$xtract_head'((H,_),OM,M,H1,Name,Arity) :- !, '$pred_arity'((H-->_),Name,Arity) :- !,
'$xtract_head'(H,OM,M,H1,Name,Arity). functor(HL,Name,1),
'$xtract_head'((H-->_),OM,M,HL,Name,Arity) :- !, Arity is A1+2.
'$xtract_head'(H,M,OM,_,Name,A1), '$pred_arity'(H,Name,Arity) :-
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) :-
functor(H,Name,Arity). functor(H,Name,Arity).
% check if a predicate is discontiguous. % 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), !, '$file_loaded'(Stream, Mod, Imports, TOpts), !,
'$lf_opt'('$options', TOpts, Opts), '$lf_opt'('$options', TOpts, Opts),
'$lf_opt'('$location', TOpts, ParentF:Line), '$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) :- '$start_lf'(changed, Mod, Stream, TOpts, UserFile, Imports) :-
'$file_unchanged'(Stream, Mod, Imports, TOpts), !, '$file_unchanged'(Stream, Mod, Imports, TOpts), !,
'$lf_opt'('$options', TOpts, Opts), '$lf_opt'('$options', TOpts, Opts),
'$lf_opt'('$location', TOpts, ParentF:Line), '$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, _) :- '$start_lf'(_, Mod, Stream, TOpts, File, _) :-
'$do_lf'(Mod, Stream, File, TOpts). '$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 ), % ( File = '/Users/vsc/Yap/bins/threads/share/Yap/error.pl' -> start_low_level_trace ; stop_low_level_trace ),
'$lf_opt'(imports, TOpts, Imports), '$lf_opt'(imports, TOpts, Imports),
'$import_to_current_module'(File, ContextModule, Imports, _, TOpts), '$import_to_current_module'(File, ContextModule, Imports, _, TOpts),
'$lf_opt'(reexport, TOpts, Reexport), '$reexport'( TOpts, File, Imports, ContextModule ),
( 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)
),
( LC == 0 -> prompt(_,' |: ') ; true), ( LC == 0 -> prompt(_,' |: ') ; true),
'$exec_initialisation_goals', '$exec_initialisation_goals',
% format( 'O=~w~n', [Mod=UserFile] ), % format( 'O=~w~n', [Mod=UserFile] ),
@ -582,6 +578,15 @@ initialization(G,OPT) :-
print_message(Verbosity, loaded(included, Y, Mod, T, H)), print_message(Verbosity, loaded(included, Y, Mod, T, H)),
nb_setval('$included_file',OY). 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) :- '$do_startup_reconsult'(X) :-
( '$access_yap_flags'(15, 0) -> ( '$access_yap_flags'(15, 0) ->
'$system_catch'(load_files(X, [silent(true)]), Module, Error, '$Error'(Error)) '$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, _) :- '$print_system_message'(_, banner, _) :-
current_prolog_flag(verbose, silent), !. current_prolog_flag(verbose, silent), !.
'$print_system_message'(Term, Level, Lines) :- '$print_system_message'(Term, Level, Lines) :-
'$messages':prefix(Level, LinePrefix, Stream, Prefix), ( Level == error -> Term \= error(syntax_error(_), _) ; Level == warning ),
'$messages':file_location(Prefix, LinesF, Lines), !, '$messages':prefix(Level, LinePrefix, Stream, LinesF, Lines2),
'$messages':file_location(Lines2, Lines), !,
flush_output(user_output), flush_output(user_output),
flush_output(user_error), flush_output(user_error),
print_message_lines(Stream, LinePrefix, LinesF). print_message_lines(Stream, LinePrefix, [nl|LinesF]).
'$print_system_message'(Error, Level, Lines) :- '$print_system_message'(Error, Level, Lines) :-
flush_output(user_output), flush_output(user_output),
flush_output(user_error), 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. :- dynamic file_search_path/2.
:- multifile generate_message_hook/3.
:- dynamic generate_message_hook/3.
:- multifile swi:swi_predicate_table/4. :- multifile swi:swi_predicate_table/4.
:- multifile user:message_hook/3. :- multifile user:message_hook/3.

29
pl/messages.yap
View File

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