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

use SWI opts for read

Browse Source
This commit is contained in:
Vitor Santos Costa 2013-11-20 22:30:49 +00:00
parent d75e6b56e5
commit 6d773a3189
5 changed files with 49 additions and 104 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
os/pl-prologflag.c
View File

@ -1005,6 +1005,7 @@ pl_prolog_flag5(term_t key, term_t value,
}
fid = PL_open_foreign_frame();
LOCK();
for(;;)
{ while( (s=advanceTableEnum(e->table_enum)) )
@ -1032,7 +1033,6 @@ pl_prolog_flag5(term_t key, term_t value,
#endif
PL_rewind_foreign_frame(fid);
}
if ( e->scope == ATOM_local )
{ e->scope = ATOM_global;
freeTableEnum(e->table_enum);

43
os/pl-read.c
View File

@ -24,9 +24,14 @@ init_read_data(ReadData _PL_rd, IOSTREAM *in ARG_LD)
_PL_rd->magic = RD_MAGIC;
_PL_rd->varnames = 0;
_PL_rd->module = Yap_GetModuleEntry(CurrentModule);
_PL_rd->exception = PL_new_term_ref();
rb.stream = in;
_PL_rd->has_exception = 0;
_PL_rd->exception = 0;
_PL_rd->module = MODULE_parse;
_PL_rd->flags = _PL_rd->module->flags; /* change for options! */
_PL_rd->styleCheck = debugstatus.styleCheck;
_PL_rd->on_error = ATOM_error;
_PL_rd->backquoted_string = truePrologFlag(PLFLAG_BACKQUOTED_STRING);
}
static void
@ -1207,6 +1212,8 @@ retry:
&rd.quasi_quotations,
#endif
&rd.cycles) ) {
PL_discard_foreign_frame(fid);
free_read_data(&rd);
return FALSE;
}
@ -1231,8 +1238,10 @@ retry:
rd.comments = PL_copy_term_ref(tcomments);
rval = read_term(term, &rd PASS_LD);
if ( Sferror(s) )
if ( Sferror(s) ) {
free_read_data(&rd);
return FALSE;
}
if ( rval )
{ if ( tpos )
@ -1241,23 +1250,43 @@ retry:
{ if ( !PL_unify_nil(rd.comments) )
rval = FALSE;
}
} else
{ if ( rd.has_exception && reportReadError(&rd) )
} else {
if ( rd.has_exception && reportReadError(&rd) )
{ PL_rewind_foreign_frame(fid);
free_read_data(&rd);
goto retry;
}
}
free_read_data(&rd);
return rval;
}
/** read_term(+Stream, -Term, +Options) is det.
*/
static
PRED_IMPL("read_term", 3, read_term, PL_FA_ISO)
{ PRED_LD
IOSTREAM *s;
if ( getTextInputStream(A1, &s) )
{ if ( read_term_from_stream(s, A2, A3 PASS_LD) )
return PL_release_stream(s);
if ( Sferror(s) )
return streamStatus(s);
PL_release_stream(s);
return FALSE;
}
return FALSE;
}
/** read_term(-Term, +Options) is det.
*/
static
PRED_IMPL("read_term", 2, read_term, PL_FA_ISO)
{ PRED_LD
@ -1376,8 +1405,8 @@ PL_chars_to_term(const char *s, term_t t)
*******************************/
BeginPredDefs(read)
PRED_DEF("swi_read_term", 3, read_term, PL_FA_ISO)
PRED_DEF("swi_read_term", 2, read_term, PL_FA_ISO)
PRED_DEF("read_term", 3, read_term, PL_FA_ISO)
PRED_DEF("read_term", 2, read_term, PL_FA_ISO)
PRED_DEF("atom_to_term", 3, atom_to_term, 0)
PRED_DEF("term_to_atom", 2, term_to_atom, 0)
#ifdef O_QUASIQUOTATIONS

2
packages/real

@ -1 +1 @@
Subproject commit 9ff05eaf6a47d856f0e43c14ddb105f2bedcbafb
Subproject commit f60caaf8b2134b6a64e4923b2a471cdcd8026c2f

21
pl/boot.yap
View File

@ -1022,13 +1022,10 @@ bootstrap(F) :-
!,
close(Stream).
'$read_vars'(Stream, T, Mod, Pos, V, _Prompt, false) :- !,
read_term(Stream, T, [ /* module(Mod), */ variable_names(V), term_position(Pos), syntax_errors(dec10) ]).
'$read_vars'(Stream, T, Mod, Pos, V, _Prompt, ReadComments) :-
'$read'(true, T, Mod, V, Pos, Err, ReadComments, Stream),
(nonvar(Err) ->
print_message(error,Err), fail
;
true
).
read_term(Stream, T, [module(Mod), variable_names(V), term_position(Pos), syntax_errors(dec10), comments( ReadComments ) ]).
'$loop'(Stream,exo) :-
prolog_flag(agc_margin,Old,0),
@ -1059,7 +1056,7 @@ bootstrap(F) :-
repeat,
prompt1('| '), prompt(_,'| '),
'$current_module'(OldModule),
'$system_catch'('$enter_command'(Stream,Status), OldModule, Error,
'$system_catch'('$enter_command'(Stream,OldModule,Status), OldModule, Error,
user:'$LoopError'(Error, Status)),
!.
% support comment hook
@ -1067,17 +1064,17 @@ bootstrap(F) :-
repeat,
prompt1('| '), prompt(_,'| '),
'$current_module'(OldModule),
'$system_catch'('$enter_command_with_hook'(Stream,Status), OldModule, Error,
'$system_catch'('$enter_command_with_hook'(Stream,OldModule,Status), OldModule, Error,
user:'$LoopError'(Error, Status)),
!.
'$enter_command'(Stream,Status) :-
'$read_vars'(Stream,Command,_,Pos,Vars, '|: ', no),
'$enter_command'(Stream,Mod,Status) :-
'$read_vars'(Stream,Command,Mod,Pos,Vars, '|: ', false),
'$command'(Command,Vars,Pos,Status).
% support SWI hook in a separate predicate, to avoid slow down standard consult.
'$enter_command_with_hook'(Stream,Status) :-
'$read_vars'(Stream,Command,_,Pos,Vars, '|: ', Comments),
'$enter_command_with_hook'(Stream,Mod,Status) :-
'$read_vars'(Stream,Command,Mod,Pos,Vars, '|: ', Comments),
( prolog:comment_hook(Comments,Pos,Command) -> true ; true ),
'$command'(Command,Vars,Pos,Status).

85
pl/yio.yap
View File

@ -131,92 +131,11 @@ exists(F) :-
/* Term IO */
read(T) :-
'$read'(false,T,_,_,_,Err,_),
(nonvar(Err) ->
print_message(error,Err), fail
;
true
).
read_term(T, []).
read(Stream,T) :-
'$read'(false,T,_,_,_,Err,_,Stream),
(nonvar(Err) ->
print_message(error,Err), fail
;
true
).
read_term(Stream, T, []).
read_term(T, Options) :-
'$check_io_opts'(Options,read_term(T, Options)),
current_input(S),
'$preprocess_read_terms_options'(Options,Module,DoComments),
'$read_vars'(S,T,Module,Pos,VL,'|: ',DoComments),
'$postprocess_read_terms_options'(Options, T, VL, Pos).
read_term(Stream, T, Options) :-
'$check_io_opts'(Options,read_term(T, Options)),
'$preprocess_read_terms_options'(Options,Module,DoComments),
'$read_vars'(Stream,T,Module,Pos,VL,'|: ',DoComments),
'$postprocess_read_terms_options'(Options, T, VL, Pos).
%
% support flags to read
%
'$preprocess_read_terms_options'([], _, no).
'$preprocess_read_terms_options'([syntax_errors(NewVal)|L], Mod, DoComments) :- !,
'$get_read_error_handler'(OldVal),
set_value('$read_term_error_handler', OldVal),
'$set_read_error_handler'(NewVal),
'$preprocess_read_terms_options'(L,Mod, DoComments).
'$preprocess_read_terms_options'([module(Mod)|L], Mod, DoComments) :- !,
'$preprocess_read_terms_options'(L, Mod, DoComments).
'$preprocess_read_terms_options'([comments(Val)|L], Mod, Val) :- !,
'$preprocess_read_terms_options'(L, Mod, _).
'$preprocess_read_terms_options'([_|L],Mod, DoComments) :-
'$preprocess_read_terms_options'(L,Mod, DoComments).
'$postprocess_read_terms_options'([], _, _, _).
'$postprocess_read_terms_options'([H|Tail], T, VL, Pos) :- !,
'$postprocess_read_terms_option'(H, T, VL, Pos),
'$postprocess_read_terms_options_list'(Tail, T, VL, Pos).
'$postprocess_read_terms_options_list'([], _, _, _).
'$postprocess_read_terms_options_list'([H|Tail], T, VL, Pos) :-
'$postprocess_read_terms_option'(H, T, VL, Pos),
'$postprocess_read_terms_options_list'(Tail, T, VL, Pos).
'$postprocess_read_terms_option'(syntax_errors(_), _, _, _) :-
get_value('$read_term_error_handler', OldVal),
'$set_read_error_handler'(OldVal).
'$postprocess_read_terms_option'(variable_names(Vars), _, Vars, _).
'$postprocess_read_terms_option'(singletons(Val), T, VL, _) :-
'$singletons_in_term'(T, Val1),
'$fetch_singleton_names'(Val1,VL,Val).
'$postprocess_read_terms_option'(variables(Val), T, _, _) :-
'$variables_in_term'(T, [], Val).
'$postprocess_read_terms_option'(comments(_), _, _, _).
'$postprocess_read_terms_option'(term_position(Pos), _, _, Pos).
'$postprocess_read_terms_option'(module(_), _, _, _).
%'$postprocess_read_terms_option'(cycles(Val), _, _).
% problem is what to do about _ singletons.
% no need to do ordering, the two lists already come ordered.
'$fetch_singleton_names'([], _, []) :- !.
'$fetch_singleton_names'([V1|Ss], [(Na=V2)|Ns], ONs) :-
V1 == V2, !,
'$add_singleton_if_no_underscore'(Na,V2,NSs,ONs),
'$fetch_singleton_names'(Ss, Ns, NSs).
'$fetch_singleton_names'([V1|Ss], [N=V2|Ns], NSs) :-
V1 @< V2, !,
'$fetch_singleton_names'(Ss, [N=V2|Ns], NSs).
'$fetch_singleton_names'(_Ss, [], []).
'$fetch_singleton_names'(Ss, [_|Ns], NSs) :-
% V1 @> V2, !,
'$fetch_singleton_names'(Ss, Ns, NSs).
'$add_singleton_if_no_underscore'(Name, _, NSs, NSs) :-
atom_codes(Name, [C|_]), C == 0'_ , !. %'
'$add_singleton_if_no_underscore'(Name, V2, NSs, [(Name=V2)|NSs]).
/* meaning of flags for '$write' is
1 quote illegal atoms