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

wr

Browse Source
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);
}
static Int is_callable(USES_REGS1) {
Term G = Deref(ARG1);
// Term Context = Deref(ARG2);
while (true) {
if (IsVarTerm(G)) {
//Yap_ThrowError(INSTANTIATION_ERROR, G, NULL);
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;
static Int must_be_callable(USES_REGS1) {
Term G = Deref(ARG1);
// Term Context = Deref(ARG2);
while (true) {
if (IsVarTerm(G)) {
Yap_ThrowError(INSTANTIATION_ERROR, G, NULL);
return false;
}
if (!IsAtomTerm(tm)) {
Yap_ThrowError(TYPE_ERROR_CALLABLE, G, NULL);
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)) {
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("$close_error", 0, close_error, HiddenPredFlag);
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("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);
}
static Int execute0(USES_REGS1) { /* '$execute0'(Goal,Mod) */
static Int execute0(USES_REGS1) { /* '$execute0'(Goal,Mod) */
Term t = Deref(ARG1), t0 = t;
Term mod = Deref(ARG2);
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,
UInt old_size USES_REGS) {
UInt new_size;
if (HR == region->oH)
return 0;
new_size = old_size - (HR - RepAppl(arena));
arena = CreateNewArena(HR, new_size);
exit_cell_space( region );

27
C/write.c
View File

@ -77,8 +77,25 @@ typedef struct write_globs {
UInt last_atom_minus;
UInt MaxDepth, MaxArgs;
wtype lw;
CELL *visited, *visited0, *visited_max;
} 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 last_minus wglb->last_atom_minus
@ -732,7 +749,10 @@ static void write_list(Term t, int direction, int depth,
nrwt.parent = rwt;
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));
ti = TailOfTerm(t);
@ -1111,7 +1131,10 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
Term tp;
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 {
tp = t;
}

5
pl/arith.yap
View File

@ -131,9 +131,10 @@ do_c_built_in(G1, M1, H, OUT) :-
var(M1), !,
do_c_built_metacall(G1, M1, H, OUT).
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('$do_error'( Error, Goal), M, Head, ErrorG).

15
pl/error.yap
View File

@ -24,8 +24,8 @@
instantiation_error/1, % +Term
representation_error/1, % +Reason
is_of_type/2, % +Type, +Term
is_callable/1,
is_callable/2
must_be_callable/1,
must_be_callable/2
]), []) .
/**
@ -108,7 +108,7 @@ must_be(Type, X, Comment) :-
must_be_of_type(callable, X) :-
!,
is_callable(X).
must_be_callable(X).
must_be_of_type(atom, X) :-
!,
is_atom(X).
@ -129,7 +129,7 @@ must_be_of_type(predicate_indicator, X, Comment) :-
is_predicate_indicator(X, Comment).
must_be_of_type(callable, X, _Comment) :-
!,
is_callable(X).
must_be_callable(X).
must_be_of_type(Type, X, _Comment) :-
( has_type(Type, X)
-> true
@ -332,16 +332,11 @@ must_be_instantiated(X) :-
must_be_instantiated(X, Comment) :-
( 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( 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_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) :-
is_callable( ImportingMod:G ),
must_be_callable( ImportingMod:G ),
'$predicate_definition'(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) :-
'$yap_strip_module'(V,M,P),
is_callable(M:P),
must_be_callable(M:P),
'$retractall'(P,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) :-
G0 = thread_create(Goal),
is_callable(Goal),
must_be_callable(Goal),
'$thread_options'([detached(true)], [], Stack, Trail, System, Detached, AtExit, G0),
'$thread_new_tid'(Id),
% '$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) :-
G0 = thread_create(Goal, Id),
is_callable(Goal),
must_be_callable(Goal),
( nonvar(Id) -> '$do_error'(uninstantiation_error(Id),G0) ; true ),
'$thread_options'([], [], Stack, Trail, System, Detached, AtExit, G0),
'$thread_new_tid'(Id),
@ -243,7 +243,7 @@ data from their stacks.
*/
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 ),
'$thread_options'(Options, Alias, Stack, Trail, System, Detached, AtExit, G0),
'$thread_new_tid'(Id),
@ -564,7 +564,7 @@ using instead the `at_exit/1` option of thread_create/3.
*/
thread_at_exit(Goal) :-
is_callable(Goal),
must_be_callable(Goal),
'$thread_self'(Id0),
recordz('$thread_exit_hook',[Id0|Goal],_).
@ -1284,7 +1284,7 @@ thread_sleep(Time) :-
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),
( recorded('$thread_signal', [Id0| _], R), erase(R), fail
; true

13
pl/top.yap
View File

@ -598,12 +598,11 @@ write_query_answer( Bindings ) :-
'$iso_check_goal'(G,G0),
'$call'(G, CP, G0, M).
'$call'(M:_,_,G0,_) :- var(M), !,
'$do_error'(instantiation_error,call(G0)).
'$call'(M:G,CP,G0,_M0) :- !,
'$expand_meta_call'(M:G, [], NG),
'$yap_strip_module'(NG,NM,NC),
expand_goal(M:G, NG),
must_be_callable(NG),
'$yap_strip_module'(NG,NM,NC),
'$call'(NC,CP,G0,NM).
'$call'((X,Y),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),
( 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) :-
'$yap_strip_module'(MH,M,H),
is_callable(M:H).
must_be_callable(M:H).
% term expansion
%
% return two arguments: Expanded0 is the term after "USER" expansion.