Esempio n. 1
0
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;
}