[Cyan]<Cedar6.0>Interpreter>RecordSearchImpl.mesa!4

RecordSearchImpl.mesa

Russ Atkinson (RRA) March 11, 1986 7:20:34 am PST

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;

RecordSearch: PUBLIC PROC [record: TV, name: ROPE] RETURNS [tv: TV ← NIL] = TRUSTED {

record represents a tv from which (somehow) one can get to a record type or instance.

lastFrame: TV ← NIL; -- indicate that we have not encountered any frames

type: Type;

IF record = NIL THEN RETURN[NIL];

type ← AMTypes.UnderType[AMTypes.TVType[record]];

SELECT AMTypes.TypeClass[type] FROM

ref, list, pointer, longPointer, basePointer => {

automatic dereferencing of refs to records

record ← AMTypes.Referent[record];

LOOP};

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: TV ← NIL;

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

};

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: BOOL ← FALSE;

FOR armIndex: INT IN [1..AMTypes.NValues[domain]] DO

armType: Type

← AMTypes.UnderType[AMTypes.IndexToType[lastType, armIndex

! AMTypes.Error => LOOP]];

tag: TV ← NIL;

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;

};

globalFrame => {record ← AMTypes.Globals[lastFrame ← record]; LOOP};

localFrame => RETURN[LocalFrameSearch[record, name]];

ENDCASE => RETURN[NIL];

ENDLOOP;

RETURN[NIL];

};

SearchArgsAndRtns: PROC [lf: TV, name: ROPE] RETURNS [tv: TV ← NIL] = TRUSTED {

this routine searches args and rtns for the given frame

procType, recType: Type;

class: Class;

procTV: TV ← NIL;

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;

};

LocalFrameSearch: PROC [lf: TV, name: ROPE] RETURNS [tv: TV ← NIL] = 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: TV ← NIL;

... search all of the enclosing bodies

IF lf # NIL THEN DO

rec: TV ← NIL;

tv ← RecordSearch[AMTypes.Locals[lf], name];

IF tv # NIL THEN RETURN[tv];

rec ← AMTypes.EnclosingBody[lf];

SELECT TRUE FROM

rec = NIL => {

No more enclosing bodies. So we try for the arguments, then the global frame.

IF NOT EqualLocalFrames[lf, lastFH] THEN tv ← SearchArgsAndRtns[lf, name];

IF tv # NIL THEN RETURN;

rec ← AMTypes.GlobalParent[lf];

IF rec = NIL THEN RETURN [NIL];

RETURN[RecordSearch[rec, name]];

};

NOT EqualLocalFrames[lf, rec] => {

level change! need to search args & rtns of the frame we are leaving

lastFH ← lf;

tv ← SearchArgsAndRtns[lf, name];

IF tv # NIL THEN RETURN[tv];

};

ENDCASE;

lf ← rec;

ENDLOOP;

};

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.