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

fix read_term to handle new notation.

Browse Source
This commit is contained in:
Vitor Santos Costa 2012-10-09 17:19:39 +01:00
parent 48f07ad338
commit 474b7a19e7
1 changed files with 12 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
pl/yio.yap
View File

@ -185,8 +185,7 @@ read_term(Stream, T, Options) :-
'$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), _, VL, _) :-
'$read_term_non_anonymous'(VL, Vars).
'$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).
@ -197,30 +196,24 @@ read_term(Stream, T, Options) :-
'$postprocess_read_terms_option'(module(_), _, _, _).
%'$postprocess_read_terms_option'(cycles(Val), _, _).
'$read_term_non_anonymous'([], []).
'$read_term_non_anonymous'([[S|V]|VL], [Name=V|Vars]) :-
atom_codes(Name,S),
'$read_term_non_anonymous'(VL, Vars).
% problem is what to do about _ singletons.
% no need to do ordering, the two lists already come ordered.
'$fetch_singleton_names'([], _, []).
'$fetch_singleton_names'([_|_], [], []) :- !.
'$fetch_singleton_names'([V1|Ss], [[Na|V2]|Ns], ONs) :-
'$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], [[_|V2]|Ns], NSs) :-
V1 @> V2, !,
'$fetch_singleton_names'([V1|Ss], Ns, NSs).
'$fetch_singleton_names'([_V1|Ss], Ns, NSs) :-
% V1 @> V2,
'$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'([95|_],_,NSs,NSs) :- !.
'$add_singleton_if_no_underscore'(Na,V2,NSs,[(Name=V2)|NSs]) :-
atom_codes(Name, Na).
'$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