void WPScene::resetRootLayer(WPLayer * layer)
{
while (_layerArray -> count()) {
WPLayer * layer = (WPLayer *)_layerArray -> getLastObject();
_layerArray -> removeLastObject();
this -> removeChild(layer, true);
}
pushLayer(layer);
}
bool isJokey(refObject type)
{ bool found;
struct
{ refFrame link;
int count;
refObject labeler; } f;
// JOKING. Traverse OBJECT and set FOUND to TRUE if we visit a joker. We use a
// layer LABELER to avoid being trapped inside circular structures.
void joking(refObject term)
{ if (term != nil && isPair(term) && ! gotKey(toss, toss, f.labeler, term))
{ setKey(f.labeler, term, nil, nil);
switch (toHook(car(term)))
{ case arraysHook:
case jokerHook:
case tuplesHook:
{ found = true;
break; }
case referHook:
case rowHook:
{ if (! isForwarded(term))
{ joking(cadr(term)); }
break; }
default:
{ while (! found && term != nil)
{ joking(car(term));
term = cdr(term); }
break; }}}}
// Assume TYPE has no jokers, then try to falsify this assumption.
push(f, 1);
found = false;
f.labeler = pushLayer(nil, plainInfo);
joking(type);
pop();
destroyLayer(f.labeler);
return found; }
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 initLayer()
{ plainLayer = pushLayer(nil, plainInfo);
skolemLayer = pushLayer(nil, skolemInfo);
layers = pushLayer(nil, equateInfo); }