use SWI opts for read

os/pl-prologflag.c

@@ -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);

os/pl-read.c

@@ -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
+  } else {
-  { if ( rd.has_exception && reportReadError(&rd) )
+    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("read_term",		  3, read_term,		  PL_FA_ISO)
-  PRED_DEF("swi_read_term",		  2, 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

packages/real

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

pl/boot.yap

@@ -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),
+       read_term(Stream, T, [module(Mod), variable_names(V), term_position(Pos), syntax_errors(dec10),  comments( ReadComments ) ]).
-       (nonvar(Err) ->
-        print_message(error,Err), fail
-       ;
-        true
-       ).
 
 '$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) :-
+'$enter_command'(Stream,Mod,Status) :-
-	'$read_vars'(Stream,Command,_,Pos,Vars, '|: ', no),
+	'$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) :-
+'$enter_command_with_hook'(Stream,Mod,Status) :-
-	'$read_vars'(Stream,Command,_,Pos,Vars, '|: ', Comments),
+	'$read_vars'(Stream,Command,Mod,Pos,Vars, '|: ', Comments),
 	( prolog:comment_hook(Comments,Pos,Command) -> true ; true ),
 	'$command'(Command,Vars,Pos,Status).
 

pl/yio.yap

@@ -131,92 +131,11 @@ exists(F) :-
 /* Term IO	*/
 
 read(T) :-
-	'$read'(false,T,_,_,_,Err,_),
+	read_term(T, []).
-	(nonvar(Err) ->
-	    print_message(error,Err), fail
-	    ;
-	    true
-	).
 
 read(Stream,T) :-
-	'$read'(false,T,_,_,_,Err,_,Stream),
+	read_term(Stream, T, []).
-	(nonvar(Err) ->
-	    print_message(error,Err), fail
-	    ;
-	    true
-	).
 
-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