static int
put_write_options(term_t opts_in, write_options *options)
{ GET_LD
term_t newlist = PL_new_term_ref();
term_t precopt = PL_new_term_ref();
fid_t fid = PL_open_foreign_frame();
term_t head = PL_new_term_ref();
term_t tail = PL_copy_term_ref(opts_in);
term_t newhead = PL_new_term_ref();
term_t newtail = PL_copy_term_ref(newlist);
int rc = TRUE;
while(rc && PL_get_list(tail, head, tail))
{ if ( !PL_is_functor(head, FUNCTOR_priority1) )
rc = ( PL_unify_list(newtail, newhead, newtail) &&
PL_unify(newhead, head) );
}
if ( rc )
{ rc = ( PL_unify_list(newtail, head, newtail) &&
PL_unify_functor(head, FUNCTOR_priority1) &&
PL_get_arg(1, head, precopt) &&
PL_unify_nil(newtail) );
}
if ( rc )
{ options->write_options = newlist;
options->prec_opt = precopt;
}
PL_close_foreign_frame(fid);
return rc;
}
word
pl_dwim_predicate(term_t pred, term_t dwim, control_t h)
{ GET_LD
functor_t fdef;
Module module = (Module) NULL;
Procedure proc;
Symbol symb;
term_t head = PL_new_term_ref();
TableEnum e;
if ( ForeignControl(h) == FRG_CUTTED )
{ e = ForeignContextPtr(h);
freeTableEnum(e);
succeed;
}
if ( !PL_strip_module(pred, &module, head) )
fail;
if ( !PL_get_functor(head, &fdef) )
fail; /* silent: leave errors for later */
if ( ForeignControl(h) == FRG_FIRST_CALL )
e = newTableEnum(module->procedures);
else
e = ForeignContextPtr(h);
while( (symb = advanceTableEnum(e)) )
{ Definition def;
char *name;
proc = symb->value;
def = proc->definition;
name = stringAtom(def->functor->name);
if ( dwimMatch(stringAtom(nameFunctor(fdef)), name) &&
isDefinedProcedure(proc) &&
(name[0] != '$' || SYSTEM_MODE) )
{ if ( !PL_unify_functor(dwim, def->functor->functor) )
continue;
ForeignRedoPtr(e);
}
}
freeTableEnum(e);
fail;
}
foreign_t pl_reportViolation(term_t RuleT, term_t MsgT, term_t CulpritsT) {
// FIXME: all 'return FALSE' should be PL_warning'
const char *Rule;
if ( !PL_get_atom_chars(RuleT, (char **) &Rule)) return FALSE;
const char *Msg;
if ( !PL_get_atom_chars(MsgT, (char **) &Msg)) return FALSE;
// atom_t StmtA = PL_new_atom("stmt");
// functor_t StmtF = PL_new_functor(StmtA, 1);
atom_t NamedDeclA = PL_new_atom("NamedDecl");
functor_t NamedDeclF = PL_new_functor(NamedDeclA, 2);
// functor_t SortF;
// if ( !PL_get_functor(LocT, &SortF)) return FALSE;
// term_t ElemT = PL_new_term_ref();
// if ( !PL_get_arg(1, LocT, ElemT)) return FALSE;
// SourceLocation SL;
// if ( PL_unify_functor(LocT, StmtF)) {
// Stmt *S;
// if ( !PL_get_pointer(ElemT, (void **) &S)) return FALSE;
// SL = S->getLocStart();
// }
// // FIXME: same for Decl and other elems.
const CompilerInstance &CI = getCompilationInfo()->getCompilerInstance();
DiagnosticsEngine &DE = CI.getDiagnostics();
Twine MsgWithRule = Twine(Rule) + Twine(": ") + Twine(Msg);
unsigned DiagId = DE.getCustomDiagID(DiagnosticsEngine::Warning,
MsgWithRule.str());
DiagnosticBuilder DB = DE.Report(DiagId);
term_t HeadT = PL_new_term_ref();
term_t ListT = PL_copy_term_ref(CulpritsT); // copy as we need to write
while(PL_get_list(ListT, HeadT, ListT)) {
term_t ElemT = PL_new_term_ref();
if ( !PL_get_arg(1, HeadT, ElemT)) return FALSE;
if ( PL_unify_functor(HeadT, NamedDeclF)) {
const NamedDecl *ND;
if ( !PL_get_pointer(ElemT, (void **) &ND)) return FALSE;
DB << ND->getDeclName();
continue;
}
// FIXME: same for Type and other elems
}
DB.~DiagnosticBuilder(); // Emits the diagnostic
ListT = PL_copy_term_ref(CulpritsT);
while(PL_get_list(ListT, HeadT, ListT)) {
functor_t SortF;
if ( !PL_get_functor(HeadT, &SortF)) return FALSE;
term_t ElemT = PL_new_term_ref();
if ( !PL_get_arg(1, HeadT, ElemT)) return FALSE;
term_t MsgT = PL_new_term_ref();
if ( !PL_get_arg(2, HeadT, MsgT)) return FALSE;
const char *Msg;
if ( !PL_get_atom_chars(MsgT, (char **) &Msg)) return FALSE;
if ( PL_unify_functor(HeadT, NamedDeclF)) {
const NamedDecl *ND;
if ( !PL_get_pointer(ElemT, (void **) &ND)) return FALSE;
DiagId = DE.getCustomDiagID(DiagnosticsEngine::Note, Msg);
DiagnosticBuilder DB = DE.Report(ND->getLocStart(), DiagId);
DB << ND->getDeclName();
DB.~DiagnosticBuilder(); // Emits the diagnostic
continue;
}
// FIXME: same for Type and other elems
}
return TRUE;
}
static int unify_value(term_t t, clingo_symbol_t v) {
// NOTE: the clingo_symbol_* functions below only fail
// if applied to the wrong type
// they do not allocate
switch (clingo_symbol_type(v)) {
case clingo_symbol_type_number: {
int number;
clingo_symbol_number(v, &number);
return PL_unify_integer(t, number);
}
case clingo_symbol_type_string: {
char const *str;
clingo_symbol_string(v, &str);
return PL_unify_chars(t, PL_STRING | REP_UTF8, (size_t)-1, str);
}
case clingo_symbol_type_infimum: {
return PL_unify_term(t, PL_FUNCTOR, FUNCTOR_hash1, PL_ATOM, ATOM_inf);
}
case clingo_symbol_type_supremum: {
return PL_unify_term(t, PL_FUNCTOR, FUNCTOR_hash1, PL_ATOM, ATOM_sup);
}
case clingo_symbol_type_function: {
// FIXME: functions can have signs represented as -f(x) in gringo
char const *str;
clingo_symbol_t const *args;
size_t size;
int rc;
clingo_symbol_name(v, &str);
clingo_symbol_arguments(v, &args, &size);
if (size == 0) {
if (!(rc =
PL_unify_chars(t, PL_ATOM | REP_UTF8, (size_t)-1, str))) {
goto out_function;
}
} else {
clingo_symbol_t const *it, *ie;
atom_t name;
term_t arg;
int i;
name = PL_new_atom(str);
if (!(rc = PL_unify_functor(t, PL_new_functor(name, size)))) {
goto out_function;
}
PL_unregister_atom(name);
arg = PL_new_term_ref();
for (i = 1, it = args, ie = it + size; it != ie; ++it, i++) {
_PL_get_arg(i, t, arg);
if (!unify_value(arg, *it)) {
goto out_function;
}
}
}
out_function:
return rc;
}
default:
assert(FALSE);
return FALSE;
}
}
