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; } }