word pl_current_functor(term_t name, term_t arity, control_t h) { GET_LD atom_t nm = 0; size_t index; int i, last=FALSE; int ar; fid_t fid; switch( ForeignControl(h) ) { case FRG_FIRST_CALL: if ( PL_get_atom(name, &nm) && PL_get_integer(arity, &ar) ) return isCurrentFunctor(nm, ar) ? TRUE : FALSE; if ( !(PL_is_integer(arity) || PL_is_variable(arity)) ) return PL_error("current_functor", 2, NULL, ERR_DOMAIN, ATOM_integer, arity); if ( !(PL_is_atom(name) || PL_is_variable(name)) ) return PL_error("current_functor", 2, NULL, ERR_DOMAIN, ATOM_atom, name); index = 1; break; case FRG_REDO: PL_get_atom(name, &nm); index = ForeignContextInt(h); break; case FRG_CUTTED: default: succeed; } fid = PL_open_foreign_frame(); LOCK(); for(i=MSB(index); !last; i++) { size_t upto = (size_t)2<<i; FunctorDef *b = GD->functors.array.blocks[i]; if ( upto >= GD->functors.highest ) { upto = GD->functors.highest; last = TRUE; } for(; index<upto; index++) { FunctorDef fd = b[index]; if ( fd && fd->arity > 0 && (!nm || nm == fd->name) ) { if ( PL_unify_atom(name, fd->name) && PL_unify_integer(arity, fd->arity) ) { UNLOCK(); ForeignRedoInt(index+1); } else { PL_rewind_foreign_frame(fid); } } } } UNLOCK(); return FALSE; }
/******************** * pl_fact_exists ********************/ static foreign_t pl_fact_exists(term_t pl_name, term_t pl_fields, term_t pl_list, control_t handle) { context_t *ctx; char *name, factname[64]; fid_t frame; term_t pl_values; OhmFact *f; switch (PL_foreign_control(handle)) { case PL_FIRST_CALL: if (!PL_is_list(pl_fields) || /*!PL_is_list(pl_list) ||*/ !PL_get_chars(pl_name, &name, CVT_ALL)) PL_fail; strncpy(factname, name, sizeof(factname)); factname[sizeof(factname)-1] = '\0'; if ((ctx = malloc(sizeof(*ctx))) == NULL) PL_fail; memset(ctx, 0, sizeof(*ctx)); if (get_field_names(ctx, pl_fields) != 0) { free(ctx); PL_fail; } ctx->store = ohm_fact_store_get_fact_store(); ctx->facts = ohm_fact_store_get_facts_by_name(ctx->store, factname); break; case PL_REDO: ctx = PL_foreign_context_address(handle); break; case PL_CUTTED: ctx = PL_foreign_context_address(handle); goto nomore; default: PL_fail; } /* XXX TODO: shouldn't we discard the frame here instead of closing them */ frame = PL_open_foreign_frame(); while (ctx->facts != NULL) { f = (OhmFact *)ctx->facts->data; ctx->facts = g_slist_next(ctx->facts); if (!fact_values(ctx, f, &pl_values) && PL_unify(pl_list, pl_values)) { PL_close_foreign_frame(frame); /* PL_discard_foreign_frame ??? */ PL_retry_address(ctx); } PL_rewind_foreign_frame(frame); } PL_close_foreign_frame(frame); /* PL_discard_foreign_frame ??? */ nomore: if (ctx->fields) free(ctx->fields); free(ctx); PL_fail; }