DIRECTORY CedarBaseType USING [PrintTypeIndex, TypeIndex], CedarBaseValue USING [PrintValue, Value], IO USING [int, PutF, rope, STREAM], Rope USING [ROPE], SaffronATDef USING [DeclarationNode], SaffronGenericDef USING [idNode], SymTab USING [Create, EachPairAction, Fetch, Insert, Pairs, Ref, Replace, Val], CedarBaseContext; CedarBaseContextImpl: CEDAR PROGRAM IMPORTS CedarBaseType, CedarBaseValue, IO, SymTab EXPORTS CedarBaseContext ~ { LocalContext: TYPE ~ REF LocalContextRep; LocalContextRep: PUBLIC TYPE ~ RECORD [ table: SymTab.Ref -- map from ropes to Descriptor ]; CreateLocalContext: PUBLIC PROC [] RETURNS [LocalContext] ~ { table: SymTab.Ref ~ SymTab.Create[]; localContext: LocalContext ~ NEW[LocalContextRep _ [table: table]]; RETURN [localContext]; }; InsertContext: PUBLIC PROC [localContext: LocalContext, id: SaffronGenericDef.idNode, descriptor: Descriptor] RETURNS [LocalContext, BOOL] ~ { ok: BOOL _ SymTab.Insert[localContext.table, id.text, descriptor]; RETURN [localContext, ok]; }; LocalLookup: PUBLIC PROC [localContext: LocalContext, id: SaffronGenericDef.idNode] RETURNS [Descriptor] ~ { found: BOOL; ref: SymTab.Val; [found, ref] _ SymTab.Fetch[localContext.table, id.text]; IF ( found ) THEN RETURN [NARROW[ref]] ELSE RETURN [BuildUndefinedDescriptor[]]; }; PrintLocalContext: PUBLIC PROC [localContext: LocalContext, s: IO.STREAM] RETURNS [BOOL] ~ { PrintName: SymTab.EachPairAction ~ { name: Rope.ROPE ~ NARROW[key]; descriptor: Descriptor ~ NARROW[val]; IO.PutF[s, "%g: ", IO.rope[name]]; PrintDescriptor[descriptor, s]; IO.PutF[s, "\n"]; }; IO.PutF[s, "\nLOCAL CONTEXT\n\n"]; [] _ SymTab.Pairs[localContext.table, PrintName]; IO.PutF[s, "\n\n"]; RETURN [TRUE]; }; ReplaceContext: PUBLIC PROC [localContext: LocalContext, id: SaffronGenericDef.idNode, descriptor: Descriptor] RETURNS [LocalContext, BOOL] ~ { ok: BOOL _ SymTab.Replace[localContext.table, id.text, descriptor]; RETURN [localContext, ok]; }; XLocalContext: PUBLIC PROC [x: LocalContext] RETURNS [LocalContext] ~ { RETURN[x]; }; RibContext: TYPE ~ REF RibContextRep; RibContextRep: PUBLIC TYPE ~ RECORD [ SELECT kind: * FROM empty => [], nonEmpty => [first: LocalContext, rest: RibContext] ENDCASE ]; CreateRibContext: PUBLIC PROC [] RETURNS [RibContext] ~ { RETURN [NEW[RibContextRep _ [empty[]] ]]; }; ExtendRibContext: PUBLIC PROC [ribContext: RibContext, localContext: LocalContext] RETURNS [RibContext] ~ { RETURN [NEW[RibContextRep _ [nonEmpty[localContext, ribContext]] ]]; }; Lookup: PUBLIC PROC [ribContext: RibContext, localContext: LocalContext, id: SaffronGenericDef.idNode] RETURNS [Descriptor] ~ { descriptor: Descriptor _ LocalLookup[localContext, id]; IF IsUndefinedDescriptor[descriptor] THEN RETURN [RibLookup[ribContext, id]] ELSE RETURN [descriptor]; }; RibLookup: PUBLIC PROC [ribContext: RibContext, id: SaffronGenericDef.idNode] RETURNS [Descriptor] ~ { WITH ribContext SELECT FROM ribContext: REF RibContextRep.empty => { RETURN [BuildUndefinedDescriptor[]]; }; ribContext: REF RibContextRep.nonEmpty => { descriptor: Descriptor _ LocalLookup[ribContext.first, id]; IF IsUndefinedDescriptor[descriptor] THEN RETURN [RibLookup[ribContext.rest, id]] ELSE RETURN [descriptor]; }; ENDCASE => ERROR; }; Descriptor: TYPE ~ REF DescriptorRep; DescriptorRep: PUBLIC TYPE ~ RECORD [ SELECT kind: * FROM inaccessible => [], suspended => [decl: REF], type => [typeIndex: CedarBaseType.TypeIndex], undefined => [], value => [value: CedarBaseValue.Value] ENDCASE ]; InaccessibleDescriptor: TYPE ~ REF inaccessible DescriptorRep; SuspendedDescriptor: TYPE ~ REF suspended DescriptorRep; TypeDescriptor: TYPE ~ REF type DescriptorRep; UndefinedDescriptor: TYPE ~ REF undefined DescriptorRep; ValueDescriptor: TYPE ~ REF value DescriptorRep; BuildInaccessibleDescriptor: PUBLIC PROC [] RETURNS [Descriptor] ~ { RETURN [NEW[DescriptorRep _ [inaccessible[]] ]]; }; BuildSuspendedDescriptor: PUBLIC PROC [decl: REF] RETURNS [Descriptor] ~ { RETURN [NEW[DescriptorRep _ [suspended[decl]] ]]; }; BuildTypeDescriptor: PUBLIC PROC [typeIndex: CedarBaseType.TypeIndex] RETURNS [Descriptor] ~ { RETURN [NEW[DescriptorRep _ [type[typeIndex]] ]]; }; BuildUndefinedDescriptor: PUBLIC PROC [] RETURNS [Descriptor] ~ { RETURN [NEW[DescriptorRep _ [undefined[]] ]]; }; BuildValueDescriptor: PUBLIC PROC [value: CedarBaseValue.Value] RETURNS [Descriptor] ~ { RETURN [NEW[DescriptorRep _ [value[value]] ]]; }; DescriptorGetDecl: PUBLIC PROC [descriptor: Descriptor] RETURNS [REF] ~ { WITH descriptor SELECT FROM descriptor: SuspendedDescriptor => RETURN [descriptor.decl]; ENDCASE => ERROR; }; GetType: PUBLIC PROC [descriptor: Descriptor] RETURNS [CedarBaseType.TypeIndex] ~ { WITH descriptor SELECT FROM descriptor: TypeDescriptor => RETURN [descriptor.typeIndex]; ENDCASE => ERROR; }; GetValue: PUBLIC PROC [descriptor: Descriptor] RETURNS [CedarBaseValue.Value] ~ { WITH descriptor SELECT FROM descriptor: ValueDescriptor => RETURN [descriptor.value]; ENDCASE => ERROR; }; IsInaccessibleDescriptor: PUBLIC PROC [descriptor: Descriptor] RETURNS [BOOL] ~ { RETURN [( descriptor.kind = inaccessible )]; }; IsSuspendedDescriptor: PUBLIC PROC [descriptor: Descriptor] RETURNS [BOOL] ~ { RETURN [( descriptor.kind = suspended )]; }; IsTypeDescriptor: PUBLIC PROC [descriptor: Descriptor] RETURNS [BOOL] ~ { RETURN [( descriptor.kind = type )]; }; IsUndefinedDescriptor: PUBLIC PROC [descriptor: Descriptor] RETURNS [BOOL] ~ { RETURN [( descriptor.kind = undefined )]; }; IsValueDescriptor: PUBLIC PROC [descriptor: Descriptor] RETURNS [BOOL] ~ { RETURN [( descriptor.kind = value )]; }; PrintDescriptor: PROC [descriptor: Descriptor, s: IO.STREAM] ~ { WITH descriptor SELECT FROM descriptor: InaccessibleDescriptor => PrintInaccessibleDescriptor[descriptor, s]; descriptor: SuspendedDescriptor => PrintSuspendedDescriptor[descriptor, s]; descriptor: TypeDescriptor => PrintTypeDescriptor[descriptor, s]; descriptor: UndefinedDescriptor => PrintUndefinedDescriptor[descriptor, s]; descriptor: ValueDescriptor => PrintValueDescriptor[descriptor, s]; ENDCASE; }; PrintInaccessibleDescriptor: PROC [descriptor: InaccessibleDescriptor, s: IO.STREAM] ~ { IO.PutF[s, "inaccessible"]; }; PrintSuspendedDescriptor: PROC [descriptor: SuspendedDescriptor, s: IO.STREAM] ~ { decl: SaffronATDef.DeclarationNode ~ NARROW[descriptor.decl]; IO.PutF[s, "suspended[%g..%g]", IO.int[decl.position], IO.int[decl.position+decl.length-1] ]; }; PrintTypeDescriptor: PROC [descriptor: TypeDescriptor, s: IO.STREAM] ~ { IO.PutF[s, "type["]; [] _ CedarBaseType.PrintTypeIndex[descriptor.typeIndex, s]; IO.PutF[s, "]"]; }; PrintUndefinedDescriptor: PROC [descriptor: UndefinedDescriptor, s: IO.STREAM] ~ { IO.PutF[s, "undefined"]; }; PrintValueDescriptor: PROC [descriptor: ValueDescriptor, s: IO.STREAM] ~ { IO.PutF[s, "value["]; CedarBaseValue.PrintValue[descriptor.value, s]; IO.PutF[s, "]"]; }; ContextTree: TYPE ~ REF ContextTreeRep; ContextTreeRep: PUBLIC TYPE ~ RECORD [ ribContext: RibContext, children: ContextTreeList ]; BuildContextTree: PUBLIC PROC [ribContext: RibContext, children: ContextTreeList] RETURNS [ContextTree] ~ { RETURN [NEW[ContextTreeRep _ [ribContext, children] ]]; }; ContextTreeList: TYPE ~ REF ContextTreeListRep; ContextTreeListRep: PUBLIC TYPE ~ RECORD [ first: ContextTreeListSeq, last: ContextTreeListSeq ]; ContextTreeListSeq: TYPE ~ REF ContextTreeListSeqRep; ContextTreeListSeqRep: TYPE ~ RECORD [ item: ContextTree, next: ContextTreeListSeq ]; BuildEmptyContextTreeList: PUBLIC PROC [] RETURNS [ContextTreeList] ~ { RETURN [NEW[ContextTreeListRep _ [first: NIL, last: NIL] ]]; }; }... ٍCedarBaseContextImpl.Mesa Copyright س 1987 by Xerox Corporation. All rights reserved. Shoup, August 4, 1986 6:25:18 pm PDT Bill Jackson (bj) April 16, 1987 1:58:41 am PDT LocalContext RibContext Descriptor ContextTree ContextTreeList ‌ت ى– "cedar" styleکcodeڑœ™K™Kڑœ‌œ‌œک8Kڑœ‌œ‌œک/Kڑœ‌œ‌œک8Kڑœ‌œ‌œک1Kکڑ‍œ‌œ‌œ‌œکDKڑ‌œ‌œ%ک0KڑœکKک—ڑ ‍œ‌œ‌œ‌œ‌œکJKڑ‌œ‌œ&ک1KڑœکKک—ڑ‍œ‌œ‌œ%‌œک^Kڑ‌œ‌œ&ک1KڑœکKک—ڑ‍œ‌œ‌œ‌œکAKڑ‌œ‌œ"ک-KڑœکKک—ڑ‍œ‌œ‌œ‌œکXKڑ‌œ‌œ#ک.KڑœکKک—Kکڑ ‍œ‌œ‌œ‌œ‌œکIڑ‌œ‌œ‌کKڑœ"‌œک