write
This commit is contained in:
parent
e96aea3340
commit
ee12fea7cd
132
C/errors.c
132
C/errors.c
@ -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);
|
||||
}
|
||||
|
@ -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
104
C/write.c
@ -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;
|
||||
}
|
||||
|
@ -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) :-
|
||||
!,
|
||||
|
@ -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) ).
|
||||
|
||||
|
Reference in New Issue
Block a user