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