LocalContext
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
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
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, "]"];
};
ContextTreeList
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] ]];
};