RecordSearchImpl.mesa
Russ Atkinson, July 6, 1983 8:56 pm
Paul Rovner, October 31, 1983 5:12 pm
DIRECTORY
AMBridge USING
[FHFromTV, GetWorld, Loophole, RemoteFHFromTV, TVToLC],
AMMiniModel USING [GetInterfaceRecordFromType],
AMTypes USING
[Argument, Class, Domain, EnclosingBody, Error, GlobalParent, Globals, IndexToDefaultInitialValue, IndexToName, IndexToTV, IndexToType, IsComputed, IsInterface, IsOverlaid, Locals, NameToIndex, NComponents, New, NValues, Procedure, Range, Referent, Result, Signal, Tag, TV, TVSize, TVToType, TVType, TypeClass, UnderClass, UnderType, Variant],
InterpreterPrivate USING [],
Rope USING [Equal, ROPE, Size],
SafeStorage USING [nullType, Type],
WorldVM USING [LocalWorld, World];
RecordSearchImpl: CEDAR PROGRAM
IMPORTS AMBridge, AMMiniModel, AMTypes, Rope, WorldVM
EXPORTS InterpreterPrivate
= BEGIN OPEN AMTypes, Rope, SafeStorage;
World: TYPE = WorldVM.World;
record represents a tv from which (somehow) one can get to a record type or instance.
RecordSearch: PUBLIC PROC [record: TV, name: ROPE] RETURNS [tv: TVNIL] = TRUSTED {
lastFrame: TVNIL; -- indicate that we have not encountered any frames
DO
type: Type;
IF record = NIL THEN RETURN[NIL];
type ← AMTypes.UnderType[AMTypes.TVType[record]];
SELECT AMTypes.TypeClass[type] FROM
ref, list, pointer, longPointer => {record ← AMTypes.Referent[record]; LOOP};
automatic dereferencing of refs to records
type => {
If this thing is a type, then we try to get the value associated with its named component. Of course, this only works for record and structure types, but that is good enough. Other classes of type will get an AMTypes.Error somewhere, and we will exit, behaving as though there were no such component.
ENABLE AMTypes.Error => EXIT;
typeValue: Type ← AMTypes.TVToType[record];
index: NAT ← AMTypes.NameToIndex[typeValue, name];
IF index = 0 THEN RETURN[NIL] -- no such component
ELSE { --There is a component of this name, so try to get its value...
world: WorldVM.World = AMBridge.GetWorld[record];
instance: TVNIL;
First, try to get an IR using the Runtime Model...
IF AMTypes.IsInterface[typeValue]
THEN instance ← AMMiniModel.GetInterfaceRecordFromType[typeValue, world
! AMTypes.Error => CONTINUE];
IF instance # NIL
THEN tv ← AMTypes.IndexToTV[instance, index] -- use the instance
ELSE tv ← AMTypes.IndexToDefaultInitialValue[typeValue, index];
There is no instance, so use the default value for the component
IF tv = NIL THEN {
Last chance: try to instantiate the type and pull out the value this way...
record ← AMTypes.New[type: typeValue, world: world];
tv ← AMTypes.IndexToTV[record, index];
};
IF AMTypes.TVSize[tv] <= 2 AND AMBridge.TVToLC[tv] = 0 THEN {
This could be an unbound procedure. If so, then we return NIL, which should result in it being undefined. I wish that we could do something else here. This case usually results from not having the implementing module loaded or from not having the interface exported to the top level.
elemType: Type ← AMTypes.IndexToType[typeValue, index];
SELECT AMTypes.UnderClass[elemType] FROM
procedure, error, signal, program, port => RETURN[NIL];
ENDCASE;
};
We now have a valid TV in hand, so return it...
RETURN[tv];
}; -- end IF index # 0 THEN
}; -- end case type
record, structure => {
n: NAT ← AMTypes.NComponents[type];
lastType, domain: Type ← nullType;
lastClass: Class ← nil;
overlaid: BOOL ← FALSE;
index: NAT ← 0;
IF n = 0 THEN EXIT;
{ENABLE AMTypes.Error => GOTO dontWorry;
lastType ← AMTypes.IndexToType[type, n];
lastType ← AMTypes.UnderType[lastType];
lastClass ← AMTypes.TypeClass[lastType];
EXITS dontWorry => {}
};
IF n = 1 AND AMTypes.IndexToName[type, 1].Size[] = 0 AND lastClass # union
THEN {record ← AMTypes.IndexToTV[record, 1]; LOOP};
an unnamed record component gets auto-selected IF it is not a union
index ← AMTypes.NameToIndex[type, name ! AMTypes.Error => CONTINUE];
IF index # 0 THEN RETURN[AMTypes.IndexToTV[record, index]];
if name does not match this could be a variant record that needs the variant bound
SELECT lastClass FROM
union => {
domain ← AMTypes.UnderType[AMTypes.Domain[lastType]];
IF AMTypes.TypeClass[domain] # enumerated THEN RETURN[NIL];
overlaid ← AMTypes.IsOverlaid[lastType] OR AMTypes.IsComputed[lastType];
};
sequence => IF AMTypes.IsComputed[lastType] THEN RETURN[NIL];
maybe want named tag
ENDCASE => RETURN[NIL];
IF NOT overlaid AND name.Equal[AMTypes.IndexToName[lastType, 0]]
oh, we want the tag!
THEN RETURN[AMTypes.Tag[AMTypes.IndexToTV[record, n]]];
IF lastClass = sequence THEN RETURN[NIL];
IF overlaid
THEN {
we have to treat overlaid variant records as somewhat funny beasts
found: BOOLFALSE;
FOR armIndex: INT IN [1..AMTypes.NValues[domain]] DO
armType: Type
← AMTypes.UnderType[AMTypes.IndexToType[lastType, armIndex
         ! AMTypes.Error => LOOP]];
tag: TVNIL;
index: NAT ← 0;
index ← AMTypes.NameToIndex[armType, name
! AMTypes.Error => CONTINUE];
IF index # 0 THEN {
we found it! force AMTypes to assume the "right" type
record ← AMBridge.Loophole[record, armType];
found ← TRUE;
EXIT;
};
ENDLOOP;
IF found THEN LOOP ELSE RETURN[NIL];
}
ELSE {
record ← AMTypes.Variant[AMTypes.IndexToTV[record, n]]; -- get last element
LOOP;
};
}; -- end case record, structure
globalFrame => {record ← AMTypes.Globals[lastFrame ← record]; LOOP};
localFrame => RETURN[LocalFrameSearch[record, name]];
ENDCASE => RETURN[NIL];
ENDLOOP;
RETURN[NIL];
}; -- end RecordSearch
SearchArgsAndRtns: PROC [lf: TV, name: ROPE] RETURNS [tv: TVNIL] = TRUSTED {
this routine searches args and rtns for the given frame
procType, recType: Type;
class: Class;
procTV: TVNIL;
n: CARDINAL ← 0;
index: CARDINAL ← 0;
IF AMTypes.UnderClass[AMTypes.TVType[lf]] # localFrame THEN ERROR;
procTV ← AMTypes.Procedure[lf ! AMTypes.Error => IF reason = typeFault THEN CONTINUE];
IF procTV = NIL THEN procTV ← AMTypes.Signal[lf];
procType ← AMTypes.UnderType[TVType[procTV]];
class ← AMTypes.TypeClass[procType];
SELECT class FROM
procedure, signal, error, program, port => {
recType ← AMTypes.UnderType[AMTypes.Domain[procType]];
IF recType # nullType AND (n ← AMTypes.NComponents[recType]) # 0
THEN {
index ← AMTypes.NameToIndex[recType, name
! AMTypes.Error => IF reason = badName THEN CONTINUE];
IF index # 0 THEN {tv ← AMTypes.Argument[lf, index]; RETURN};
};
SELECT class FROM
procedure, signal => {
recType ← AMTypes.UnderType[AMTypes.Range[procType]];
IF recType # nullType AND (n ← AMTypes.NComponents[recType]) # 0
THEN {
index ← AMTypes.NameToIndex[recType, name
! AMTypes.Error => IF reason = badName THEN CONTINUE];
IF index # 0 THEN {tv ← AMTypes.Result[lf, index]; RETURN};
};
};
ENDCASE;
};
ENDCASE;
}; -- end SearchArgsAndRtns
LocalFrameSearch: PROC [lf: TV, name: ROPE]
RETURNS [tv: TVNIL] = TRUSTED {
... searches the given local frame for the given name. The search will include all levels of variables, including those in statically enclosing local frames and the global frame.
lastFH: TVNIL;
... search all of the enclosing bodies
WHILE lf # NIL DO
rec: TVNIL;
tv ← RecordSearch[AMTypes.Locals[lf], name];
IF tv # NIL THEN RETURN[tv];
rec ← AMTypes.EnclosingBody[lf];
IF rec = NIL THEN {
rec ← AMTypes.GlobalParent[lf];
IF rec = NIL THEN EXIT;
tv ← RecordSearch[rec, name];
IF tv = NIL THEN EXIT;
RETURN[tv];
}
ELSE IF NOT EqualLocalFrames[lf, rec] THEN {
level change! need to search args & rtns
lastFH ← lf;
tv ← SearchArgsAndRtns[lf, name];
IF tv # NIL THEN RETURN[tv];
};
lf ← rec;
ENDLOOP;
... search arguments and results
IF NOT EqualLocalFrames[lf, lastFH] THEN RETURN[SearchArgsAndRtns[lf, name]];
};
EqualLocalFrames: PROC [lf1,lf2: TV] RETURNS [BOOL] = TRUSTED {
IF lf1 = lf2 THEN RETURN [TRUE];
IF lf1 # NIL AND lf2 # NIL THEN {
w1: WorldVM.World ← AMBridge.GetWorld[lf1];
IF w1 # AMBridge.GetWorld[lf2] THEN RETURN [FALSE];
IF w1 = WorldVM.LocalWorld[]
THEN RETURN [AMBridge.FHFromTV[lf1] = AMBridge.FHFromTV[lf2]]
ELSE RETURN [AMBridge.RemoteFHFromTV[lf1] = AMBridge.RemoteFHFromTV[lf2]];
};
RETURN [FALSE];
};
END.