<> <> <> 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 { <> lastFrame: TV _ NIL; -- 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, basePointer => { <> record _ AMTypes.Referent[record]; LOOP}; type => { <> 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 { <> world: WorldVM.World = AMBridge.GetWorld[record]; instance: TV _ NIL; <> 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]; <> IF tv = NIL THEN { <> record _ AMTypes.New[type: typeValue, world: world]; tv _ AMTypes.IndexToTV[record, index]; }; IF AMTypes.TVSize[tv] <= 2 AND AMBridge.TVToLC[tv] = 0 THEN { <> elemType: Type _ AMTypes.IndexToType[typeValue, index]; SELECT AMTypes.UnderClass[elemType] FROM procedure, error, signal, program, port => RETURN[NIL]; ENDCASE; }; <> 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}; <> index _ AMTypes.NameToIndex[type, name ! AMTypes.Error => CONTINUE]; IF index # 0 THEN RETURN[AMTypes.IndexToTV[record, index]]; <<>> <> 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]; <> ENDCASE => RETURN[NIL]; IF NOT overlaid AND name.Equal[AMTypes.IndexToName[lastType, 0]] <> THEN RETURN[AMTypes.Tag[AMTypes.IndexToTV[record, n]]]; IF lastClass = sequence THEN RETURN[NIL]; IF overlaid THEN { <> 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 { <> 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 { <> 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 => { <> 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] => { <> 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.