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

fix nb_getval to handle exceptions.

Browse Source
This commit is contained in:
Vitor Santos Costa 2010-03-01 22:32:40 +00:00
parent 0546df7ac3
commit 233926ea00
4 changed files with 52 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
C/globals.c
View File

@ -1286,8 +1286,7 @@ p_nb_getval(void)
} }
ge = FindGlobalEntry(AtomOfTerm(t)); ge = FindGlobalEntry(AtomOfTerm(t));
if (!ge) { if (!ge) {
Yap_Error(EXISTENCE_ERROR_VARIABLE,t,"nb_getval"); return Yap_unify(TermNil, ARG3);
return FALSE;
} }
READ_LOCK(ge->GRWLock); READ_LOCK(ge->GRWLock);
to = ge->global; to = ge->global;
@ -2636,11 +2635,10 @@ void Yap_InitGlobals(void)
Yap_InitCPred("$allocate_arena", 2, p_allocate_arena, 0); Yap_InitCPred("$allocate_arena", 2, p_allocate_arena, 0);
Yap_InitCPred("arena_size", 1, p_default_arena_size, 0); Yap_InitCPred("arena_size", 1, p_default_arena_size, 0);
Yap_InitCPred("b_setval", 2, p_b_setval, SafePredFlag); Yap_InitCPred("b_setval", 2, p_b_setval, SafePredFlag);
Yap_InitCPred("b_getval", 2, p_nb_getval, SafePredFlag);
Yap_InitCPred("nb_setval", 2, p_nb_setval, 0L); Yap_InitCPred("nb_setval", 2, p_nb_setval, 0L);
Yap_InitCPred("nb_set_shared_val", 2, p_nb_set_shared_val, 0L); Yap_InitCPred("nb_set_shared_val", 2, p_nb_set_shared_val, 0L);
Yap_InitCPred("nb_linkval", 2, p_nb_linkval, 0L); Yap_InitCPred("nb_linkval", 2, p_nb_linkval, 0L);
Yap_InitCPred("nb_getval", 2, p_nb_getval, SafePredFlag); Yap_InitCPred("$nb_getval", 3, p_nb_getval, SafePredFlag);
Yap_InitCPred("nb_setarg", 3, p_nb_setarg, 0L); Yap_InitCPred("nb_setarg", 3, p_nb_setarg, 0L);
Yap_InitCPred("nb_set_shared_arg", 3, p_nb_set_shared_arg, 0L); Yap_InitCPred("nb_set_shared_arg", 3, p_nb_set_shared_arg, 0L);
Yap_InitCPred("nb_linkarg", 3, p_nb_linkarg, 0L); Yap_InitCPred("nb_linkarg", 3, p_nb_linkarg, 0L);

31
pl/boot.yap
View File

@ -161,10 +161,10 @@ true :- true.
'$system_catch'('$do_yes_no'((G->true),user),user,Error,user:'$Error'(Error)), '$system_catch'('$do_yes_no'((G->true),user),user,Error,user:'$Error'(Error)),
fail. fail.
'$enter_top_level' :- '$enter_top_level' :-
nb_getval('$break',BreakLevel), '$nb_getval'('$break',BreakLevel,fail),
'$debug_on'(DBON), '$debug_on'(DBON),
( (
nb_getval('$trace',on) '$nb_getval'('$trace', on, fail)
-> ->
TraceDebug = trace TraceDebug = trace
; ;
@ -349,7 +349,7 @@ true :- true.
'$do_error'(type_error(callable,R),meta_call(Source)). '$do_error'(type_error(callable,R),meta_call(Source)).
'$execute_command'(end_of_file,_,_,_,_) :- !. '$execute_command'(end_of_file,_,_,_,_) :- !.
'$execute_command'(Command,_,_,_,_) :- '$execute_command'(Command,_,_,_,_) :-
nb_getval('$if_skip_mode',skip), '$nb_getval'('$if_skip_mode', skip, fail),
\+ '$if_directive'(Command), \+ '$if_directive'(Command),
!. !.
'$execute_command'((:-G),_,_,Option,_) :- !, '$execute_command'((:-G),_,_,Option,_) :- !,
@ -1296,3 +1296,28 @@ throw(Ball) :-
'$run_at_thread_start'. '$run_at_thread_start'.
nb_getval(GlobalVariable, Val) :-
'$nb_getval'(GlobalVariable, Val, Error),
(var(Error)
->
true
;
'$getval_exception'(GlobalVariable, Val, nb_getval(GlobalVariable, Val)) ->
nb_getval(GlobalVariable, Val)
;
'$do_error'(existence_error(variable, GlobalVariable),nb_getval(GlobalVariable, Val))
).
b_getval(GlobalVariable, Val) :-
'$nb_getval'(GlobalVariable, Val, Error),
(var(Error)
->
true
;
'$getval_exception'(GlobalVariable, Val, b_getval(GlobalVariable, Val)) ->
true
;
'$do_error'(existence_error(variable, GlobalVariable),b_getval(GlobalVariable, Val))
).

2
pl/init.yap
View File

@ -202,6 +202,8 @@ yap_hacks:cut_by(CP) :- '$$cut_by'(CP).
:- multifile user:portray_message/2. :- multifile user:portray_message/2.
:- multifile user:exception/3.
file_search_path(library, Dir) :- file_search_path(library, Dir) :-
library_directory(Dir). library_directory(Dir).
file_search_path(commons, Dir) :- file_search_path(commons, Dir) :-

20
pl/utils.yap
View File

@ -580,3 +580,23 @@ nb_current(GlobalVariable, Val) :-
'$nb_current'(GlobalVariable), '$nb_current'(GlobalVariable),
nb_getval(GlobalVariable, Val). nb_getval(GlobalVariable, Val).
'$getval_exception'(GlobalVariable, Val, Caller) :-
user:exception(undefined_global_variable, GlobalVariable, Action),
!,
(
Action == fail
->
fail
;
Action == retry
->
b_getval(GlobalVariable, Val)
;
Action == error
->
'$do_error'(existence_error(variable, GlobalVariable),Caller)
;
'$do_error'(type_error(atom, Action),Caller)
).