Пример #1
0
refObject skolemize(refObject layer, refObject type)
{ struct
  { refFrame  link;
    int       count;
    refObject first;
    refObject labeler;
    refObject last;
    refObject layer;
    refObject next;
    refObject type; } f0;

//  IS SKOLEMIZABLE. Test if TYPE, which is ground in LAYER, can be the base of
//  a Skolem type. It can be, if it has a subtype that's different from itself.
//  For example, OBJ has an infinite number of such subtypes but INT0 has none.
//  The WHILE loop helps simulate tail recursions.

  bool isSkolemizable(refObject layer, refObject type)
  { while (true)
    { if (isName(type))
      { getKey(r(layer), r(type), layer, type); }
      else

//  Visit a type. If LABELER says we've been here before, then return false. If
//  we haven't, then record TYPE in LABELER so we won't come here again.

      if (isPair(type))
      { if (gotKey(toss, toss, f0.labeler, type))
        { return false; }
        else
        { refObject pars;
          setKey(f0.labeler, type, nil, nil);
          switch (toHook(car(type)))

//  Visit a trivially Skolemizable type. An ALTS, FORM, or GEN type can have an
//  ALTS type as a subtype. A REF or ROW type can have NULL as a subtype.

          { case altsHook:
            case arraysHook:
            case formHook:
            case genHook:
            case jokerHook:
            case referHook:
            case rowHook:
            case skoHook:
            case tuplesHook:
            { return true; }

//  Visit a type that is trivially not Skolemizable.

            case cellHook:
            case char0Hook:
            case char1Hook:
            case int0Hook:
            case int1Hook:
            case int2Hook:
            case listHook:
            case nullHook:
            case real0Hook:
            case real1Hook:
            case strTypeHook:
            case symHook:
            case voidHook:
            { return false; }

//  Visit an ARRAY type. It's Skolemizable if its base type is.

            case arrayHook:
            { type = caddr(type);
              break; }

//  Visit a PROC type. It's Skolemizable if (1) it has a Skolemizable parameter
//  type, (2) it has the missing name NO NAME as a parameter name, (3) it has a
//  Skolemizable yield type.

            case procHook:
            { type = cdr(type);
              pars = car(type);
              while (pars != nil)
              { pars = cdr(pars);
                if (car(pars) == noName)
                { return true; }
                else
                { pars = cdr(pars); }}
              pars = car(type);
              while (pars != nil)
              { if (isSkolemizable(layer, car(pars)))
                { return true; }
                else
                { pars = cddr(pars); }}
              type = cadr(type);
              break; }

//  Visit a TUPLE type. It's Skolemizable if it has a Skolemizable slot type or
//  if it has the missing name NO NAME as a slot name.

            case tupleHook:
            { pars = cdr(type);
              while (pars != nil)
              { pars = cdr(pars);
                if (car(pars) == noName)
                { return true; }
                else
                { pars = cdr(pars); }}
              pars = cdr(type);
              while (pars != nil)
              { if (isSkolemizable(layer, car(pars)))
                { return true; }
                else
                { pars = cddr(pars); }}
              return false; }

//  Visit a prefix type. It's Skolemizable if its base type is.

            case typeHook:
            case varHook:
            { type = cadr(type);
              break; }

//  Visit an illegal type. We should never get here.

            default:
            { fail("Got ?%s(...) in isSkolemizable!", hookTo(car(type))); }}}}

//  Visit an illegal object. We should never get here either.

      else
      { fail("Got bad type in isSkolemizable!"); }}}

//  Lost? This is SKOLEMIZE's body. These identities show what's going on.
//
//    S(type T B)  =>  T S(B)
//    S(U)         =>  ?sko(U)
//    S(V)         =>  V
//
//  Here S(X) is the Skolem type for type X. T is a series of zero or more TYPE
//  prefixes. B is a type, U is a type with at least one subtype different from
//  itself, and V is a type with no subtypes different from itself.

  push(f0, 6);
  f0.labeler = pushLayer(nil, plainInfo);
  f0.layer = layer;
  f0.type = type;
  while (isName(f0.type))
  { getKey(r(f0.layer), r(f0.type), f0.layer, f0.type); }
  if (isCar(f0.type, typeHook))
  { f0.type = cadr(f0.type);
    if (isSkolemizable(f0.layer, f0.type))
    { if (isCar(f0.type, typeHook))
      { f0.first = f0.last = makePair(hooks[typeHook], nil);
        f0.type = cadr(f0.type);
        while (isCar(f0.type, typeHook))
        { f0.next = makePair(hooks[typeHook], nil);
          cdr(f0.last) = makePair(f0.next, nil);
          f0.last = f0.next;
          f0.type = cadr(f0.type); }
        f0.next = makePrefix(skoHook, f0.type);
        cdr(f0.last) = makePair(f0.next, nil); }
      else
      { f0.first = makePrefix(skoHook, f0.type); }}
    else
    { f0.first = makePair(car(f0.type), cdr(f0.type)); }}
  else
  { fail("Type type expected in skolemize!"); }
  pop();
  destroyLayer(f0.labeler);
  return f0.first; }
Пример #2
0
void writingObject(refBuffer buffer, refObject object)
{ if (object == nil)
  { writeFormat(buffer, "[Nil]"); }
  else
  { switch (tag(object))
    { case cellTag:
      { writeFormat(buffer, "[Cell %X]", object);
        return; }
      case characterTag:
      { writeCharacter(buffer, toCharacter(object));
        return; }
      case evenBinderTag:
      { writeFormat(buffer, "[EvenBinder %X]", object);
        return; }
      case hookTag:
      { writeFormat(buffer, "?%s", hookTo(object));
        return; }
      case hunkTag:
      { writeFormat(buffer, "[Hunk %X]", object);
        return; }
      case integerTag:
      { writeFormat(buffer, "%i", toInteger(object));
        return; }
      case jokerTag:
      { writeFormat(buffer, "[%s]", jokerTo(object));
        return; }
      case leftBinderTag:
      { writeFormat(buffer, "[LeftBinder %X]", object);
        return; }
      case markedTag:
      { writeFormat(buffer, "[...]");
        return; }
      case matchTag:
      { writeFormat(buffer, "[Match %X]", object);
        return; }
      case nameTag:
      { writeVisibleName(buffer, object);
        return; }
      case pairTag:
      { refObject pairs = object;
        tag(object) = markedTag;
        writeChar(buffer, '(');
        writingObject(buffer, car(pairs));
        pairs = cdr(pairs);
        while (pairs != nil)
        { writeBlank(buffer);
          writingObject(buffer, car(pairs));
          pairs = cdr(pairs); }
        writeChar(buffer, ')');
        tag(object) = pairTag;
        return; }
      case realTag:
      { writeFormat(buffer, "%.17E", toReal(object));
        return; }
      case rightBinderTag:
      { writeFormat(buffer, "[RightBinder %X]", object);
        return; }
      case stringTag:
      { writeQuotedString(buffer, toRefString(object));
        return; }
      default:
      { writeFormat(buffer, "[Tag%i %X]", tag(object), object);
        return; }}}}