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

wr

This commit is contained in:
Vitor Santos Costa 2019-05-24 15:26:21 +01:00
parent db7047249c
commit e96aea3340
10 changed files with 80 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
C/errors.c
View File

@ -1249,41 +1249,41 @@ static Int is_atom(USES_REGS1) {
return IsAtomTerm(t); return IsAtomTerm(t);
} }
static Int is_callable(USES_REGS1) { static Int must_be_callable(USES_REGS1) {
Term G = Deref(ARG1); Term G = Deref(ARG1);
// Term Context = Deref(ARG2); // Term Context = Deref(ARG2);
while (true) { while (true) {
if (IsVarTerm(G)) { if (IsVarTerm(G)) {
//Yap_ThrowError(INSTANTIATION_ERROR, G, NULL); Yap_ThrowError(INSTANTIATION_ERROR, G, NULL);
return false; return false;
}
if (IsApplTerm(G)) {
Functor f = FunctorOfTerm(G);
if (IsExtensionFunctor(f)) {
Yap_ThrowError(TYPE_ERROR_CALLABLE, G, NULL);
}
if (f == FunctorModule) {
Term tm = ArgOfTerm(1, G);
if (IsVarTerm(tm)) {
Yap_ThrowError(INSTANTIATION_ERROR, G, NULL);
return false;
} }
if (!IsAtomTerm(tm)) { if (IsApplTerm(G)) {
Yap_ThrowError(TYPE_ERROR_CALLABLE, G, NULL); Functor f = FunctorOfTerm(G);
return false; if (IsExtensionFunctor(f)) {
Yap_ThrowError(TYPE_ERROR_CALLABLE, G, NULL);
}
if (f == FunctorModule) {
Term tm = ArgOfTerm(1, G);
if (IsVarTerm(tm)) {
Yap_ThrowError(INSTANTIATION_ERROR, G, NULL);
return false;
}
if (!IsAtomTerm(tm)) {
Yap_ThrowError(TYPE_ERROR_CALLABLE, G, NULL);
return false;
}
G = ArgOfTerm(2, G);
} else {
return true;
}
} else if (IsPairTerm(G) || IsAtomTerm(G)) {
return true;
} else {
Yap_ThrowError(TYPE_ERROR_CALLABLE, G, NULL);
return false;
} }
G = ArgOfTerm(2, G);
} else {
return true;
}
} else if (IsPairTerm(G) || IsAtomTerm(G)) {
return true;
} else {
Yap_ThrowError(TYPE_ERROR_CALLABLE, G, NULL);
return false;
} }
} return false;
return false;
} }
/** /**
@ -1360,7 +1360,7 @@ void Yap_InitErrorPreds(void) {
Yap_InitCPred("$drop_exception", 1, drop_exception, 0); Yap_InitCPred("$drop_exception", 1, drop_exception, 0);
Yap_InitCPred("$close_error", 0, close_error, HiddenPredFlag); Yap_InitCPred("$close_error", 0, close_error, HiddenPredFlag);
Yap_InitCPred("is_boolean", 1, is_boolean, TestPredFlag); Yap_InitCPred("is_boolean", 1, is_boolean, TestPredFlag);
Yap_InitCPred("is_callable", 1, is_callable, TestPredFlag); Yap_InitCPred("must_be_callable", 1, must_be_callable, TestPredFlag);
Yap_InitCPred("is_atom", 1, is_atom, TestPredFlag); Yap_InitCPred("is_atom", 1, is_atom, TestPredFlag);
Yap_InitCPred("get_predicate_indicator", 4, get_predicate_indicator, 0); Yap_InitCPred("get_predicate_indicator", 4, get_predicate_indicator, 0);
} }

2
C/exec.c
View File

@ -1203,7 +1203,7 @@ static Int do_term_expansion(USES_REGS1) {
return complete_ge(false, omod, sl, creeping); return complete_ge(false, omod, sl, creeping);
} }
static Int execute0(USES_REGS1) { /* '$execute0'(Goal,Mod) */ static Int execute0(USES_REGS1) { /* '$execute0'(Goal,Mod) */
Term t = Deref(ARG1), t0 = t; Term t = Deref(ARG1), t0 = t;
Term mod = Deref(ARG2); Term mod = Deref(ARG2);
unsigned int arity; unsigned int arity;

3
C/globals.c
View File

@ -332,9 +332,6 @@ CELL *Yap_GetFromArena(Term *arenap, UInt cells, UInt arity) {
static Term CloseArena(cell_space_t *region, Term arena, static Term CloseArena(cell_space_t *region, Term arena,
UInt old_size USES_REGS) { UInt old_size USES_REGS) {
UInt new_size; UInt new_size;
if (HR == region->oH)
return 0;
new_size = old_size - (HR - RepAppl(arena)); new_size = old_size - (HR - RepAppl(arena));
arena = CreateNewArena(HR, new_size); arena = CreateNewArena(HR, new_size);
exit_cell_space( region ); exit_cell_space( region );

27
C/write.c
View File

@ -77,8 +77,25 @@ typedef struct write_globs {
UInt last_atom_minus; UInt last_atom_minus;
UInt MaxDepth, MaxArgs; UInt MaxDepth, MaxArgs;
wtype lw; wtype lw;
CELL *visited, *visited0, *visited_max;
} wglbs; } wglbs;
static inline bool was_visited(Term t, wglbs *wg) {
if (IsApplTerm(t)) tp = RepAppl(tp);
else if (IsPairTerm(t)) tp = RepPair(t);
else return false;
bool rc = IsVarTerm(t) && (CELL *) t >= wg->visited0
&& (CELL *) t < wg->visited_max;
wg->visited = *t;
*t = wg->visited++;
}}
static inline void done_visit(Term *t, wglbs *wg) {
*t = *--wg->visited++;
}
#define lastw wglb->lw #define lastw wglb->lw
#define last_minus wglb->last_atom_minus #define last_minus wglb->last_atom_minus
@ -732,7 +749,10 @@ static void write_list(Term t, int direction, int depth,
nrwt.parent = rwt; nrwt.parent = rwt;
nrwt.u_sd.s.ptr = 0; nrwt.u_sd.s.ptr = 0;
while (1) { if (is_visited(t, wglb)) {
wrputs(".."wglb->stream);
}
if (1) {
PROTECT(t, writeTerm(HeadOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt)); PROTECT(t, writeTerm(HeadOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt));
ti = TailOfTerm(t); ti = TailOfTerm(t);
@ -1111,7 +1131,10 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
Term tp; Term tp;
if ((flags & Handle_cyclics_f) ){ if ((flags & Handle_cyclics_f) ){
tp = Yap_CyclesInTerm(t PASS_REGS); // tp = Yap_CyclesInTerm(t PASS_REGS);
wglb.visited = M̀alloc(1024*sizeof(CELL)),
wglb.visited0 = visited,
wglb.visitedt_top = visited+1024;
} else { } else {
tp = t; tp = t;
} }

5
pl/arith.yap
View File

@ -131,9 +131,10 @@ do_c_built_in(G1, M1, H, OUT) :-
var(M1), !, var(M1), !,
do_c_built_metacall(G1, M1, H, OUT). do_c_built_metacall(G1, M1, H, OUT).
do_c_built_in('$do_error'( Error, Goal), M, Head, do_c_built_in('$do_error'( Error, Goal), M, Head,
throw(error(Error,M:(Head :- Goal))) throw(error(Error,[errorGoal=Goal, errorCaller=Head,prologPredFile=File,prologPredLine=Line,
prologPredModule=M,prologPredName=Name,prologPredArity=Ar])))
) :- ) :-
!. !,source_location(File, Line).
do_c_built_in(system_error( Error, Goal), M, Head, ErrorG) :- do_c_built_in(system_error( Error, Goal), M, Head, ErrorG) :-
!, !,
do_c_built_in('$do_error'( Error, Goal), M, Head, ErrorG). do_c_built_in('$do_error'( Error, Goal), M, Head, ErrorG).

15
pl/error.yap
View File

@ -24,8 +24,8 @@
instantiation_error/1, % +Term instantiation_error/1, % +Term
representation_error/1, % +Reason representation_error/1, % +Reason
is_of_type/2, % +Type, +Term is_of_type/2, % +Type, +Term
is_callable/1, must_be_callable/1,
is_callable/2 must_be_callable/2
]), []) . ]), []) .
/** /**
@ -108,7 +108,7 @@ must_be(Type, X, Comment) :-
must_be_of_type(callable, X) :- must_be_of_type(callable, X) :-
!, !,
is_callable(X). must_be_callable(X).
must_be_of_type(atom, X) :- must_be_of_type(atom, X) :-
!, !,
is_atom(X). is_atom(X).
@ -129,7 +129,7 @@ must_be_of_type(predicate_indicator, X, Comment) :-
is_predicate_indicator(X, Comment). is_predicate_indicator(X, Comment).
must_be_of_type(callable, X, _Comment) :- must_be_of_type(callable, X, _Comment) :-
!, !,
is_callable(X). must_be_callable(X).
must_be_of_type(Type, X, _Comment) :- must_be_of_type(Type, X, _Comment) :-
( has_type(Type, X) ( has_type(Type, X)
-> true -> true
@ -332,16 +332,11 @@ must_be_instantiated(X) :-
must_be_instantiated(X, Comment) :- must_be_instantiated(X, Comment) :-
( var(X) -> instantiation_error(X, Comment) ; true). ( var(X) -> instantiation_error(X, Comment) ; true).
must_be_callable(X) :-
is_callable(X).
inline(must_be_of_type( atom, X ), is_atom(X) ). inline(must_be_of_type( atom, X ), is_atom(X) ).
inline(must_be_of_type( module, X ), is_atom(X) ). inline(must_be_of_type( module, X ), is_atom(X) ).
inline(must_be_of_type( callable, X ), is_callable(X) ). inline(must_be_of_type( callable, X ), must_be_callable(X) ).
inline(must_be_atom( X ), is_atom(X) ). inline(must_be_atom( X ), is_atom(X) ).
inline(must_be_module( X ), is_atom(X) ). inline(must_be_module( X ), is_atom(X) ).
inline(must_be_callable( X ), is_callable(X) ).
inline(is_callable( X,_ ), is_callable(X) ).
%% @} %% @}

2
pl/imports.yap
View File

@ -77,7 +77,7 @@ fail.
% %
'$get_undefined_predicate'(ImportingMod:G, ExportingMod:G0) :- '$get_undefined_predicate'(ImportingMod:G, ExportingMod:G0) :-
is_callable( ImportingMod:G ), must_be_callable( ImportingMod:G ),
'$predicate_definition'(ImportingMod:G,[], ExportingMod:G0), '$predicate_definition'(ImportingMod:G,[], ExportingMod:G0),
ImportingMod:G \= ExportingMod:G0, ImportingMod:G \= ExportingMod:G0,
!. !.

2
pl/preddyns.yap
View File

@ -247,7 +247,7 @@ Retract all the clauses whose head matches the goal _G_. Goal
*/ */
retractall(V) :- retractall(V) :-
'$yap_strip_module'(V,M,P), '$yap_strip_module'(V,M,P),
is_callable(M:P), must_be_callable(M:P),
'$retractall'(P,M). '$retractall'(P,M).
'$retractall'(T,M) :- '$retractall'(T,M) :-

10
pl/threads.yap
View File

@ -162,7 +162,7 @@ Create a new Prolog detached thread using default options. See thread_create/3.
*/ */
thread_create(Goal) :- thread_create(Goal) :-
G0 = thread_create(Goal), G0 = thread_create(Goal),
is_callable(Goal), must_be_callable(Goal),
'$thread_options'([detached(true)], [], Stack, Trail, System, Detached, AtExit, G0), '$thread_options'([detached(true)], [], Stack, Trail, System, Detached, AtExit, G0),
'$thread_new_tid'(Id), '$thread_new_tid'(Id),
% '$erase_thread_info'(Id), % this should not be here % '$erase_thread_info'(Id), % this should not be here
@ -184,7 +184,7 @@ Create a new Prolog thread using default options. See thread_create/3.
*/ */
thread_create(Goal, Id) :- thread_create(Goal, Id) :-
G0 = thread_create(Goal, Id), G0 = thread_create(Goal, Id),
is_callable(Goal), must_be_callable(Goal),
( nonvar(Id) -> '$do_error'(uninstantiation_error(Id),G0) ; true ), ( nonvar(Id) -> '$do_error'(uninstantiation_error(Id),G0) ; true ),
'$thread_options'([], [], Stack, Trail, System, Detached, AtExit, G0), '$thread_options'([], [], Stack, Trail, System, Detached, AtExit, G0),
'$thread_new_tid'(Id), '$thread_new_tid'(Id),
@ -243,7 +243,7 @@ data from their stacks.
*/ */
thread_create(Goal, Id, Options) :- thread_create(Goal, Id, Options) :-
G0 = thread_create(Goal, Id, Options), G0 = thread_create(Goal, Id, Options),
is_callable(Goal), must_be_callable(Goal),
( nonvar(Id) -> '$do_error'(uninstantiation_error(Id),G0) ; true ), ( nonvar(Id) -> '$do_error'(uninstantiation_error(Id),G0) ; true ),
'$thread_options'(Options, Alias, Stack, Trail, System, Detached, AtExit, G0), '$thread_options'(Options, Alias, Stack, Trail, System, Detached, AtExit, G0),
'$thread_new_tid'(Id), '$thread_new_tid'(Id),
@ -564,7 +564,7 @@ using instead the `at_exit/1` option of thread_create/3.
*/ */
thread_at_exit(Goal) :- thread_at_exit(Goal) :-
is_callable(Goal), must_be_callable(Goal),
'$thread_self'(Id0), '$thread_self'(Id0),
recordz('$thread_exit_hook',[Id0|Goal],_). recordz('$thread_exit_hook',[Id0|Goal],_).
@ -1284,7 +1284,7 @@ thread_sleep(Time) :-
thread_signal(Id, Goal) :- thread_signal(Id, Goal) :-
'$check_thread_or_alias'(Id, thread_signal(Id, Goal)), '$check_thread_or_alias'(Id, thread_signal(Id, Goal)),
is_callable(Goal), must_be_callable(Goal),
'$thread_id_alias'(Id0, Id), '$thread_id_alias'(Id0, Id),
( recorded('$thread_signal', [Id0| _], R), erase(R), fail ( recorded('$thread_signal', [Id0| _], R), erase(R), fail
; true ; true

13
pl/top.yap
View File

@ -598,12 +598,11 @@ write_query_answer( Bindings ) :-
'$iso_check_goal'(G,G0), '$iso_check_goal'(G,G0),
'$call'(G, CP, G0, M). '$call'(G, CP, G0, M).
'$call'(M:_,_,G0,_) :- var(M), !,
'$do_error'(instantiation_error,call(G0)).
'$call'(M:G,CP,G0,_M0) :- !, '$call'(M:G,CP,G0,_M0) :- !,
'$expand_meta_call'(M:G, [], NG), expand_goal(M:G, NG),
'$yap_strip_module'(NG,NM,NC), must_be_callable(NG),
'$yap_strip_module'(NG,NM,NC),
'$call'(NC,CP,G0,NM). '$call'(NC,CP,G0,NM).
'$call'((X,Y),CP,G0,M) :- !, '$call'((X,Y),CP,G0,M) :- !,
'$call'(X,CP,G0,M), '$call'(X,CP,G0,M),
@ -812,11 +811,11 @@ gated_call(Setup, Goal, Catcher, Cleanup) :-
!, !,
'$yap_strip_module'(M1:MH,M,H), '$yap_strip_module'(M1:MH,M,H),
( M == M1 -> B = B0 ; B = M1:B0), ( M == M1 -> B = B0 ; B = M1:B0),
is_callable(M:H). must_be_callable(M:H).
'$check_head_and_body'(MH, M, H, true, _XsP) :- '$check_head_and_body'(MH, M, H, true, _XsP) :-
'$yap_strip_module'(MH,M,H), '$yap_strip_module'(MH,M,H),
is_callable(M:H). must_be_callable(M:H).
% term expansion % term expansion
% %
% return two arguments: Expanded0 is the term after "USER" expansion. % return two arguments: Expanded0 is the term after "USER" expansion.