<> <> <> <> <> DIRECTORY Rope USING[Equal, ROPE], SaffronContextPrivateTypes USING [ AccessValNode, ContextTreeNode, InterfaceTGN, InterfaceTGNBody, LocalContextNode, TypeGraphNodeNode, VisibleNames ], SaffronGenericDef USING [ IdNode ], SaffronErrorHandling USING [InternalError]; SaffronEnvironmentsImpl: CEDAR PROGRAM IMPORTS Rope, SaffronErrorHandling ~ { OPEN SaffronContextPrivateTypes, SaffronGenericDef; <> <> EnvironmentNode: TYPE ~ REF EnvironmentNodeBody; EnvironmentNodeBody: TYPE ~ RECORD [ interfaces: RopeNames ]; <> CreateEmptyEnvironment: PUBLIC PROC RETURNS [EnvironmentNode] ~ { RETURN[NEW [EnvironmentNodeBody _ [CreateEmptyRopeNames[]] ]]; }; <> AddInterfaceToEnvironment: PUBLIC PROC [env: EnvironmentNode, fileName: Rope.ROPE, ifc: InterfaceNode] RETURNS [EnvironmentNode] ~ { RecordRopeName[env.interfaces, fileName, ifc]; RETURN[env]; }; LookupInterfaceInEnv: PUBLIC PROC [env: EnvironmentNode, fileName: Rope.ROPE] RETURNS [InterfaceNode] ~ { RETURN[NARROW[LookupRopeName[env.interfaces, fileName]]]; }; IsInterfaceInEnv: PROC [env: EnvironmentNode, fileName: Rope.ROPE] RETURNS [BOOLEAN] ~ { RETURN[LookupRopeName[env.interfaces, fileName] # NIL]; }; <> <> <<>> <> <<>> InterfaceNode: TYPE ~ REF InterfaceNodeBody; InterfaceNodeBody: TYPE ~ RECORD [ entries: VisibleNames ]; <> <> CreateInterfaceFromContextTree: PUBLIC PROC [ct: ContextTreeNode, ns: NameSequenceNode] RETURNS [in: InterfaceNode] ~ { entries: VisibleNames _ CreateEmptyVisibleNames[]; typeNames: VisibleNames _ ct.rib.lc.lvtn; -- herein lies the crock EnterOneName: PROC [name: IdNode, access: AccessValNode, value: REF ANY] ~ { tgn: TypeGraphNodeNode _ NARROW[value]; -- check RecordVisibleName[entries, name, access, tgn]; }; GenVisibleNames[typeNames, EnterOneName]; RETURN[NEW [InterfaceNodeBody _ [entries]]]; }; <> GenInterfaceEntries: PROC [in: InterfaceNode, for: PROC [name: IdNode, access: AccessValNode, tgn: TypeGraphNodeNode] ] ~ { SeeOne: PROC [name: IdNode, access: AccessValNode, value: REF ANY] ~ { for[name, access, NARROW[value]]; }; GenVisibleNames[in.entries, SeeOne]; }; LookupInterfaceEntry: PUBLIC PROC [in: InterfaceNode, name: IdNode] RETURNS [access: AccessValNode, tgn: TypeGraphNodeNode] ~ { value: REF ANY; [access, value] _ LookupVisibleName[in.entries, name]; RETURN[access, NARROW[value]]; }; <> <<>> CreateEmptyInterfaceTGN: PUBLIC PROC [lc: LocalContextNode] RETURNS [lcp: LocalContextNode, tgn: TypeGraphNodeNode] ~ { body: InterfaceTGN _ NEW [InterfaceTGNBody _ [FALSE, CreateEmptyVisibleNames[] ]]; RETURN[lc, CreateTGN[lc, body]]; }; <> AddTGNToInterfaceTGN: PUBLIC PROC [lc: LocalContextNode, if: TypeGraphNodeNode, name: IdNode, access: AccessValNode, entryTgn: TypeGraphNodeNode] RETURNS [lcp: LocalContextNode] ~ { iftgn: InterfaceTGN _ NARROW[if.body]; RecordVisibleName[iftgn.typeNames, name, access, entryTgn]; RETURN[lc]; }; CreateInterfaceTGNFromInterface: PUBLIC PROC [lc: LocalContextNode, if: InterfaceNode] RETURNS [lcp: LocalContextNode, tgn: TypeGraphNodeNode] ~ { AddOne: PROC [name: IdNode, access: AccessValNode, tgn: TypeGraphNodeNode] ~ { [] _ AddTGNToInterfaceTGN[lc, tgn, name, access, tgn]; }; tgn _ CreateEmptyInterfaceTGN[lc].tgn; GenInterfaceEntries[if, AddOne]; RETURN[lc, tgn]; }; ExportLocallyVisibleTGN: PUBLIC PROC[lc: LocalContextNode, name: IdNode] RETURNS[AccessValNode, TypeGraphNodeNode] = BEGIN ratgn: REF ANY; access: AccessValNode; [access, ratgn] _ LookupVisibleName[lc.lvtn, name]; IF ratgn # NIL THEN RETURN[access, NARROW[ratgn]]; ERROR SaffronErrorHandling.InternalError["SaffronEnvironmentsImpl.ExportLocallyVisibleTGN"]; END; <> NameSequenceNode: TYPE = LIST OF IdNode; EmptyNameSequence: PUBLIC PROC RETURNS[NameSequenceNode] = {RETURN[NIL]}; InsertNameOnNameSequence: PUBLIC PROC[name: IdNode, ns: NameSequenceNode] RETURNS[NameSequenceNode] = {RETURN[CONS[name, ns]]}; <> RopeNames: TYPE = REF RopeNamesBody; RopeNamesBody: TYPE = RECORD[ first: RNCell]; RNCell: TYPE = REF RNCellBody; RNCellBody: TYPE = RECORD[ name: Rope.ROPE, value: REF ANY, next: RNCell]; CreateEmptyRopeNames: PROC RETURNS[rns: RopeNames] = BEGIN rns _ NEW[RopeNamesBody _ [NIL]]; RETURN[rns]; END; RecordRopeName: PROC[rns: RopeNames, name: Rope.ROPE, val: REF ANY] = BEGIN newCell: RNCell _ NEW[RNCellBody_[name, val, rns.first]]; IF (LookupRopeName[rns, name] # NIL) THEN ERROR SaffronErrorHandling.InternalError["SaffronEnvironmentsImpl.RecordRopeName"]; rns.first _ newCell; END; LookupRopeName: PROC[rns: RopeNames, name: Rope.ROPE] RETURNS[REF ANY] = BEGIN cell: RNCell _ rns.first; WHILE cell # NIL DO IF Rope.Equal[cell.name, name] THEN RETURN[cell.value]; cell _ cell.next; ENDLOOP; RETURN[NIL]; END; <> <> <<>> CreateEmptyVisibleNames: PROC RETURNS [VisibleNames]; RecordVisibleName: PROC [vn: VisibleNames, name: IdNode, access: AccessValNode, value: REF ANY]; LookupVisibleName: PROC [vn: VisibleNames, name: IdNode] RETURNS [access: AccessValNode, value: REF ANY]; GenVisibleNames: PROC [vn: VisibleNames, for: PROC [name: IdNode, access: AccessValNode, value: REF ANY] ]; CreateTGN: PROC [lc: LocalContextNode, body: REF ANY] RETURNS [tgn: TypeGraphNodeNode]; }.