Ejemplo n.º 1
0
Scheme_Object *scheme_chaperone_vector_ref(Scheme_Object *o, int i)
{
    if (!SCHEME_NP_CHAPERONEP(o)) {
        return SCHEME_VEC_ELS(o)[i];
    } else {
        Scheme_Chaperone *px = (Scheme_Chaperone *)o;
        Scheme_Object *a[3], *red, *orig;

#ifdef DO_STACK_CHECK
        {
# include "mzstkchk.h"
            return chaperone_vector_ref_overflow(o, i);
        }
#endif

        orig = scheme_chaperone_vector_ref(px->prev, i);

        if (SCHEME_VECTORP(px->redirects)) {
            /* chaperone was on property accessors */
            return orig;
        }

        a[0] = px->prev;
        a[1] = scheme_make_integer(i);
        a[2] = orig;
        red = SCHEME_CAR(px->redirects);
        o = _scheme_apply(red, 3, a);

        if (!(SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_IMPERSONATOR))
            if (!scheme_chaperone_of(o, orig))
                scheme_wrong_chaperoned("vector-ref", "result", orig, o);

        return o;
    }
}
Ejemplo n.º 2
0
Scheme_Object *scheme_chaperone_vector_ref2(Scheme_Object *o, int i, Scheme_Object *outermost)
{
  if (!SCHEME_NP_CHAPERONEP(o)) {
    return SCHEME_VEC_ELS(o)[i];
  } else {
    Scheme_Chaperone *px = (Scheme_Chaperone *)o;
    Scheme_Object *a[4], *red, *orig;

#ifdef DO_STACK_CHECK
    {
# include "mzstkchk.h"
      return chaperone_vector_ref_overflow(o, i);
    }
#endif

    if(SCHEME_FALSEP(px->redirects)) {
      /* unsafe chaperones */
      return scheme_chaperone_vector_ref2(px->val, i, outermost);
    }

    orig = scheme_chaperone_vector_ref2(px->prev, i, outermost);

    if (SCHEME_REDIRECTS_PROP_ONLY_VECTORP(px->redirects)) {
      /* chaperone was on property accessors */
      /* or vector chaperone is property only */
      return orig;
    }
    red = SCHEME_CAR(px->redirects);

    if (SCHEME_CHAPERONE_FLAGS(px) & SCHEME_VEC_CHAPERONE_STAR) {
      a[0] = outermost;
      a[1] = px->prev;
      a[2] = scheme_make_integer(i);
      a[3] = orig;
      o = _scheme_apply(red, 4, a);
    }
    else {
      a[0] = px->prev;
      a[1] = scheme_make_integer(i);
      a[2] = orig;
      o = _scheme_apply(red, 3, a);
    }

    if (!(SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_IMPERSONATOR))
      if (!scheme_chaperone_of(o, orig))
        scheme_wrong_chaperoned("vector-ref", "result", orig, o);

    return o;
  }
}
Ejemplo n.º 3
0
Archivo: vector.c Proyecto: 4z3/racket
Scheme_Object *scheme_chaperone_vector_ref(Scheme_Object *o, int i)
{
  if (!SCHEME_NP_CHAPERONEP(o)) {
    return SCHEME_VEC_ELS(o)[i];
  } else {
    Scheme_Chaperone *px = (Scheme_Chaperone *)o;
    Scheme_Object *a[3], *red, *orig;

#ifdef DO_STACK_CHECK
    {
# include "mzstkchk.h"
      return chaperone_vector_ref_overflow(o, i);
    }
#endif

    orig = scheme_chaperone_vector_ref(px->prev, i);

    if (SCHEME_VECTORP(px->redirects)) {
      /* chaperone was on property accessors */
      return orig;
    }

    a[0] = px->prev;
    a[1] = scheme_make_integer(i);
    a[2] = orig;
    red = SCHEME_CAR(px->redirects);
    o = _scheme_apply(red, 3, a);

    if (!(SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_IMPERSONATOR))
      if (!scheme_chaperone_of(o, orig))
        scheme_raise_exn(MZEXN_FAIL_CONTRACT,
                         "vector-ref: chaperone produced a result: %V that is not a chaperone of the original result: %V",
                         o, 
                         orig);

    return o;
  }
}