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

first pass at a decent implementation of PL_error (#95)

Browse Source 
- basically copy SWI code.
This commit is contained in:
Vitor Santos Costa
2009-05-30 12:52:23 -05:00
parent f61aee4a83
commit d6ed058157
7 changed files with 301 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

214
library/yap2swi/yap2swi.c
View File

@@ -23,6 +23,9 @@
#if HAVE_MATH_H
#include <math.h>
#endif
#if HAVE_ERRNO_H
#include <errno.h>
#endif
#define PL_KERNEL 1
@@ -890,10 +893,217 @@ X_API int PL_raise_exception(term_t exception)
return 0;
}
#define ATOM_instantiation_error AtomToSWIAtom(AtomInstantiationError)
#define ATOM_max_files AtomToSWIAtom(AtomMaxFiles)
#define ATOM_no_memory AtomToSWIAtom(AtomNoMemory)
#define ATOM_procedure AtomToSWIAtom(AtomProcedure)
#define ATOM_system_error AtomToSWIAtom(AtomSystemError)
#define ATOM_variable AtomToSWIAtom(AtomVariable)
#define FUNCTOR_error2 FunctorToSWIFunctor(FunctorError)
#define FUNCTOR_context2 FunctorToSWIFunctor(FunctorContext2)
#define FUNCTOR_divide2 FunctorToSWIFunctor(FunctorSlash)
#define FUNCTOR_domain_error2 FunctorToSWIFunctor(FunctorDomainError)
#define FUNCTOR_existence_error2 FunctorToSWIFunctor(FunctorExistenceError)
#define FUNCTOR_evaluation_error1 FunctorToSWIFunctor(FunctorEvaluationError)
#define FUNCTOR_not_implemented2 FunctorToSWIFunctor(FunctorNotImplemented)
#define FUNCTOR_permission_error3 FunctorToSWIFunctor(FunctorPermissionError)
#define FUNCTOR_representation_error1 FunctorToSWIFunctor(FunctorRepresentationError)
#define FUNCTOR_resource_error1 FunctorToSWIFunctor(FunctorResourceError)
#define FUNCTOR_timeout_error2 FunctorToSWIFunctor(FunctorTimeoutError)
#define FUNCTOR_type_error2 FunctorToSWIFunctor(FunctorTypeError)
X_API int PL_error(const char *pred, int arity, const char *msg, int id, ...)
{
Yap_Error(id,TermNil,NULL);
return 0;
term_t formal, swi, predterm, msgterm, except;
va_list args;
formal = PL_new_term_ref();
swi = PL_new_term_ref();
predterm = PL_new_term_ref();
msgterm = PL_new_term_ref();
except = PL_new_term_ref();
/* This would really require having pl-error.c, but we'll make do so as */
va_start(args, id);
switch(id) {
case ERR_INSTANTIATION:
err_instantiation:
PL_unify_atom(formal, ATOM_instantiation_error);
break;
case ERR_TYPE: /* ERR_INSTANTIATION if var(actual) */
{ atom_t expected = va_arg(args, atom_t);
term_t actual = va_arg(args, term_t);
if ( PL_is_variable(actual) && expected != ATOM_variable )
goto err_instantiation;
PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_type_error2,
PL_ATOM, expected,
PL_TERM, actual);
break;
}
case ERR_DOMAIN: /* ERR_INSTANTIATION if var(arg) */
{ atom_t domain = va_arg(args, atom_t);
term_t arg = va_arg(args, term_t);
if ( PL_is_variable(arg) )
goto err_instantiation;
PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_domain_error2,
PL_ATOM, domain,
PL_TERM, arg);
break;
}
case ERR_REPRESENTATION:
{ atom_t what = va_arg(args, atom_t);
PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_representation_error1,
PL_ATOM, what);
break;
}
case ERR_NOT_IMPLEMENTED_PROC:
{ const char *name = va_arg(args, const char *);
int arity = va_arg(args, int);
PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_not_implemented2,
PL_ATOM, ATOM_procedure,
PL_FUNCTOR, FUNCTOR_divide2,
PL_CHARS, name,
PL_INT, arity);
break;
}
case ERR_EXISTENCE:
{ atom_t type = va_arg(args, atom_t);
term_t obj = va_arg(args, term_t);
PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_existence_error2,
PL_ATOM, type,
PL_TERM, obj);
break;
}
case ERR_PERMISSION:
{ atom_t type = va_arg(args, atom_t);
atom_t op = va_arg(args, atom_t);
term_t obj = va_arg(args, term_t);
PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_permission_error3,
PL_ATOM, type,
PL_ATOM, op,
PL_TERM, obj);
break;
}
case ERR_SYSCALL:
{ const char *op = va_arg(args, const char *);
if ( !msg )
msg = op;
switch(errno)
{ case ENOMEM:
PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_resource_error1,
PL_ATOM, ATOM_no_memory);
break;
default:
PL_unify_atom(formal, ATOM_system_error);
break;
}
break;
}
case ERR_TIMEOUT:
{ atom_t op = va_arg(args, atom_t);
term_t obj = va_arg(args, term_t);
PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_timeout_error2,
PL_ATOM, op,
PL_TERM, obj);
break;
}
case ERR_FILE_OPERATION:
{ atom_t action = va_arg(args, atom_t);
atom_t type = va_arg(args, atom_t);
term_t file = va_arg(args, term_t);
switch(errno)
{ case EACCES:
PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_permission_error3,
PL_ATOM, action,
PL_ATOM, type,
PL_TERM, file);
break;
case EMFILE:
case ENFILE:
PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_resource_error1,
PL_ATOM, ATOM_max_files);
break;
#ifdef EPIPE
case EPIPE:
if ( !msg )
msg = "Broken pipe";
/*FALLTHROUGH*/
#endif
default: /* what about the other cases? */
PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_existence_error2,
PL_ATOM, type,
PL_TERM, file);
break;
}
break;
}
case ERR_NOMEM:
{ PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_resource_error1,
PL_ATOM, ATOM_no_memory);
break;
}
case ERR_EVALUATION:
{ atom_t what = va_arg(args, atom_t);
PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_evaluation_error1,
PL_ATOM, what);
break;
}
default:
fprintf(stderr, "unimplemented SWI error %d\n",id);
goto err_instantiation;
}
va_end(args);
if ( pred )
{ PL_unify_term(predterm,
PL_FUNCTOR, FUNCTOR_divide2,
PL_CHARS, pred,
PL_INT, arity);
}
if ( msg )
{
PL_put_atom_chars(msgterm, msg);
}
PL_unify_term(swi,
PL_FUNCTOR, FUNCTOR_context2,
PL_TERM, predterm,
PL_TERM, msgterm);
PL_unify_term(except,
PL_FUNCTOR, FUNCTOR_error2,
PL_TERM, formal,
PL_TERM, swi);
return PL_raise_exception(except);
}
/* begin PL_unify_* functions =============================*/