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

write

This commit is contained in:
Vítor Santos Costa 2019-05-25 01:19:20 +01:00
parent e96aea3340
commit ee12fea7cd
5 changed files with 139 additions and 101 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

132
C/errors.c
View File

@ -1250,30 +1250,25 @@ static Int is_atom(USES_REGS1) {
}
static Int must_be_callable(USES_REGS1) {
Term G = Deref(ARG1);
Term mod = CurrentModule;
Term G = Yap_StripModule(Deref(ARG1), &mod);
// 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;
}
if (!IsAtomTerm(tm)) {
Yap_ThrowError(TYPE_ERROR_CALLABLE, G, NULL);
return false;
}
G = ArgOfTerm(2, G);
} else {
if (IsVarTerm(mod)) {
Yap_ThrowError(INSTANTIATION_ERROR, G, NULL);
return false;
} else if (!IsAtomTerm(mod)) {
Yap_ThrowError(TYPE_ERROR_ATOM, mod, NULL);
return false;
}
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);
}else {
return true;
}
} else if (IsPairTerm(G) || IsAtomTerm(G)) {
@ -1282,8 +1277,7 @@ static Int must_be_callable(USES_REGS1) {
Yap_ThrowError(TYPE_ERROR_CALLABLE, G, NULL);
return false;
}
}
return false;
return true;
}
/**
@ -1301,51 +1295,51 @@ static Int must_be_callable(USES_REGS1) {
* (mod:a)/n as valid.
*/
static Int get_predicate_indicator(USES_REGS1) {
Term G = Deref(ARG1);
// Term Context = Deref(ARG2);
Term mod = CurrentModule;
Term G = Deref(ARG1);
// Term Context = Deref(ARG2);
Term mod = CurrentModule;
G = Yap_YapStripModule(G, &mod);
if (IsVarTerm(G)) {
Yap_ThrowError(INSTANTIATION_ERROR, G, NULL);
}
if (!IsVarTerm(mod) && !IsAtomTerm(mod)) {
Yap_Error(TYPE_ERROR_ATOM, G, NULL);
G = Yap_YapStripModule(G, &mod);
if (IsVarTerm(G)) {
Yap_ThrowError(INSTANTIATION_ERROR, G, NULL);
}
if (!IsVarTerm(mod) && !IsAtomTerm(mod)) {
Yap_Error(TYPE_ERROR_ATOM, G, NULL);
return false;
}
if (IsApplTerm(G)) {
Functor f = FunctorOfTerm(G);
if (IsExtensionFunctor(f)) {
Yap_ThrowError(TYPE_ERROR_PREDICATE_INDICATOR, G, NULL);
}
if (f == FunctorSlash || f == FunctorDoubleSlash) {
Term name = ArgOfTerm(1, G), arity = ArgOfTerm(2, G);
name = Yap_YapStripModule(name, &mod);
if (IsVarTerm(name)) {
Yap_ThrowError(INSTANTIATION_ERROR, name, NULL);
} else if (!IsAtomTerm(name)) {
Yap_ThrowError(TYPE_ERROR_ATOM, name, NULL);
}
if (IsVarTerm(arity)) {
Yap_ThrowError(INSTANTIATION_ERROR, arity, NULL);
} else if (!IsIntegerTerm(arity)) {
Yap_ThrowError(TYPE_ERROR_INTEGER, arity, NULL);
} else {
Int ar = IntegerOfTerm(arity);
if (ar < 0) {
Yap_ThrowError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, arity, NULL);
}
if (f == FunctorDoubleSlash) {
arity = MkIntegerTerm(ar + 2);
}
return Yap_unify(mod, ARG2) &&
Yap_unify(name, ARG3) &&
Yap_unify(arity, ARG4);
}
}
}
Yap_ThrowError(TYPE_ERROR_PREDICATE_INDICATOR, G, NULL);
return false;
}
if (IsApplTerm(G)) {
Functor f = FunctorOfTerm(G);
if (IsExtensionFunctor(f)) {
Yap_ThrowError(TYPE_ERROR_PREDICATE_INDICATOR, G, NULL);
}
if (f == FunctorSlash || f == FunctorDoubleSlash) {
Term name = ArgOfTerm(1,G), arity = ArgOfTerm(2,G);
name = Yap_YapStripModule (name, &mod);
if (IsVarTerm(name)) {
Yap_ThrowError(INSTANTIATION_ERROR, name, NULL);
} else if (!IsAtomTerm(name)) {
Yap_ThrowError(TYPE_ERROR_ATOM, name, NULL);
}
if (IsVarTerm(arity)) {
Yap_ThrowError(INSTANTIATION_ERROR, arity, NULL);
} else if (!IsIntegerTerm(arity)) {
Yap_ThrowError(TYPE_ERROR_INTEGER, arity, NULL);
} else {
Int ar = IntegerOfTerm(arity);
if (ar < 0) {
Yap_ThrowError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, arity, NULL);
}
if ( f == FunctorDoubleSlash) {
arity = MkIntegerTerm(ar+2);
}
return Yap_unify(mod, ARG2) &&
Yap_unify(name, ARG3) &&
Yap_unify(arity, ARG4);
}
}
}
Yap_ThrowError(TYPE_ERROR_PREDICATE_INDICATOR, G, NULL);
return false;
}
void Yap_InitErrorPreds(void) {
@ -1360,7 +1354,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("must_be_callable", 1, must_be_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);
}

1
C/stdpreds.c
View File

@ -1574,7 +1574,6 @@ void Yap_InitCPreds(void) {
Yap_InitCmpPreds();
Yap_InitCoroutPreds();
Yap_InitDBPreds();
Yap_InitErrorPreds();
Yap_InitExecFs();
Yap_InitGlobals();
Yap_InitInlines();

104
C/write.c
View File

@ -77,25 +77,9 @@ typedef struct write_globs {
UInt last_atom_minus;
UInt MaxDepth, MaxArgs;
wtype lw;
CELL *visited, *visited0, *visited_max;
CELL *visited, *visited0, *visited_top;
} 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
@ -426,6 +410,51 @@ static void wrputref(CODEADDR ref, int Quote_illegal,
lastw = alphanum;
}
static inline bool was_visited(Term t, wglbs *wg, Term *ta ) {
Term *tp;
if (IsApplTerm(t)) {
if (IsExtensionFunctor(FunctorOfTerm(t)))
return false;
tp = RepAppl(t);
}
else if (IsPairTerm(t)) tp = RepPair(t);
else return false;
if (IsAtomTerm(*tp)) {
CELL *pt= (CELL*)AtomOfTerm(*tp);
if (pt >= wg->visited0 &&
pt < wg->visited) {
int depth = (wg->visited+1)-tp;
wrputs(" @( ", wg->stream);
wrputn(depth, wg);
wrputs( " ) ", wg->stream);
return true;
}
}
wg->visited[0] = *tp;
*tp = MkAtomTerm( (Atom)wg->visited );
wg++;
return false;
}
static inline Term visited_indirection(Term t, wglbs *wg ) {
Term *tp = (CELL *)AtomOfTerm(t);
if (tp >= wg->visited0
&& (CELL *) *tp < wg->visited_top)
return *tp;
return 0;
}
static inline void done_visiting(Term t, wglbs *wg) {
Term *tp;
if (IsApplTerm(t)) tp = RepAppl(t);
else if (IsPairTerm(t)) tp = RepPair(t);
else return;
*tp = *--wg->visited;
}
/* writes a blob (default) */
static int wrputblob(AtomEntry *ref, int Quote_illegal,
struct write_globs *wglb) {
@ -748,13 +777,14 @@ static void write_list(Term t, int direction, int depth,
struct rewind_term nrwt;
nrwt.parent = rwt;
nrwt.u_sd.s.ptr = 0;
if (is_visited(t, wglb)) {
wrputs(".."wglb->stream);
Term hot;
if (was_visited(t, wglb, &hot)) {
return;
}
if (1) {
PROTECT(t, writeTerm(HeadOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt));
bool loop = true;
while (loop) {
loop = false;
PROTECT(t, writeTerm(hot, 999, depth + 1, FALSE, wglb, &nrwt));
ti = TailOfTerm(t);
if (IsVarTerm(ti))
break;
@ -806,18 +836,27 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
if (IsVarTerm(t)) {
write_var((CELL *)t, wglb, &nrwt);
} else if (IsIntTerm(t)) {
wrputn((Int)IntOfTerm(t), wglb);
} else if (IsAtomTerm(t)) {
Term tn;
if ((tn = visited_indirection(t, wglb))!=0) {
writeTerm(tn,p,depth,rinfixarg,wglb,rwt);
return;
}
putAtom(AtomOfTerm(t), wglb->Quote_illegal, wglb);
} else if (IsPairTerm(t)) {
if (wglb->Ignore_ops) {
wrputs("'.'(", wglb->stream);
lastw = separator;
Term hot;
if ((was_visited(t, wglb, &hot))) {
return;
}
PROTECT(t, writeTerm(HeadOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt));
PROTECT(t, writeTerm(hot, 999, depth + 1, FALSE, wglb, &nrwt));
wrputs(",", wglb->stream);
writeTerm(TailOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt);
done_visiting(t, wglb);
wrclose_bracket(wglb, TRUE);
return;
}
@ -897,7 +936,12 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
return;
}
}
if (!wglb->Ignore_ops && Arity == 1 && Yap_IsPrefixOp(atom, &op, &rp)) {
Term argf;
if (was_visited(t, wglb, &argf)) {
return;
}
if (!wglb->Ignore_ops && Arity == 1 && Yap_IsPrefixOp(atom, &op, &rp)) {
Term tright = ArgOfTerm(1, t);
int bracket_right = !IsVarTerm(tright) && IsAtomTerm(tright) &&
Yap_IsOp(AtomOfTerm(tright));
@ -1029,6 +1073,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
if (k == -1) {
wrputc('_', wglb->stream);
lastw = alphanum;
done_visiting(t, wglb);
return;
} else {
wrputc((k % 26) + 'A', wglb->stream);
@ -1100,6 +1145,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt);
wrclose_bracket(wglb, TRUE);
}
done_visiting(t, wglb);
}
}
@ -1132,9 +1178,9 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
if ((flags & Handle_cyclics_f) ){
// tp = Yap_CyclesInTerm(t PASS_REGS);
wglb.visited = M̀alloc(1024*sizeof(CELL)),
wglb.visited0 = visited,
wglb.visitedt_top = visited+1024;
wglb.visited = Malloc(1024*sizeof(CELL)),
wglb.visited0 = wglb.visited,
wglb.visited_top = wglb.visited+1024;
} else {
tp = t;
}

2
pl/arith.yap
View File

@ -133,7 +133,7 @@ do_c_built_in(G1, M1, H, OUT) :-
do_c_built_in('$do_error'( Error, Goal), M, Head,
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) :-
!,

1
pl/error.yap
View File

@ -335,7 +335,6 @@ must_be_instantiated(X, Comment) :-
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 ), must_be_callable(X) ).
inline(must_be_atom( X ), is_atom(X) ).
inline(must_be_module( X ), is_atom(X) ).