DIRECTORY
Rope USING [ROPE],
SaffronBaseDef USING [AccessValConst, FieldNode, FieldType, LookupNameInContextRib, TypeGraphNodeNode],
SaffronContext USING [CreateRootContextRib],
SaffronContextPrivateTypes USING [AccessValNodeBody, ContextRibNodeBody, LocalContextNodeBody, TypeGraphNodeListNodeBody, TypeGraphNodeNodeBody],
SaffronGenericDef USING [IdNode, IdNodeBody],
SaffronTargetArchitecture USING [TargetArchitecture];
SaffronCompilerStateImpl:
CEDAR
PROGRAM
IMPORTS SaffronBaseDef, SaffronContext
EXPORTS SaffronBaseDef
~ BEGIN
OPEN BD: SaffronBaseDef, GEN: SaffronGenericDef, PT: SaffronContextPrivateTypes;
TargetArchitecture: TYPE = SaffronTargetArchitecture.TargetArchitecture;
AccessValNode: TYPE = REF AccessValNodeBody;
AccessValNodeBody: PUBLIC TYPE = PT.AccessValNodeBody;
ContextRibNode: TYPE = REF ContextRibNodeBody;
ContextRibNodeBody: PUBLIC TYPE = PT.ContextRibNodeBody;
LocalContextNode: TYPE = REF LocalContextNodeBody;
LocalContextNodeBody: PUBLIC TYPE = PT.LocalContextNodeBody;
TypeGraphNodeListNode: TYPE = REF TypeGraphNodeListNodeBody;
TypeGraphNodeListNodeBody: PUBLIC TYPE = PT.TypeGraphNodeListNodeBody;
TypeGraphNodeNode: TYPE = REF TypeGraphNodeNodeBody;
TypeGraphNodeNodeBody: PUBLIC TYPE = PT.TypeGraphNodeNodeBody;
CompilerStateNode: TYPE ~ REF CompilerStateNodeBody;
CompilerStateNodeBody:
PUBLIC TYPE ~
RECORD [
targetArchitecture: TargetArchitecture, -- description of the target machine
defaultAccess: AccessValNode, -- default access of current module
options: Rope.ROPE, -- command line options
top: TypeGraphNodeNode ← NIL,
bottom: TypeGraphNodeNode ← NIL,
rootContextRib: ContextRibNode
];
The following procedures are defined in SaffronBaseDef:
FakeDamageCompilerState:
PUBLIC PROC [cs: CompilerStateNode]
RETURNS [CompilerStateNode] ~ {
RETURN[cs]};
MakeCompilerState:
PUBLIC
PROC [targetArchitecture: TargetArchitecture, options: Rope.
ROPE]
RETURNS [CompilerStateNode] =
BEGIN
top, bottom: TypeGraphNodeNode;
rootContextRib: ContextRibNode;
[rootContextRib, top, bottom] ← SaffronContext.CreateRootContextRib[targetArchitecture];
RETURN [
NEW[CompilerStateNodeBody ←
[targetArchitecture, options, top, bottom, rootContextRib]]];
END;
GetRootContextRib:
PUBLIC
PROC [cs: CompilerStateNode]
RETURNS [ContextRibNode] =
BEGIN
RETURN[cs.rootContextRib];
END;
GetTargetArchitecture:
PUBLIC PROC [cs: CompilerStateNode]
RETURNS [TargetArchitecture] ~ {
RETURN[cs.targetArchitecture]};
GetIntrinsicAtomType:
PUBLIC PROC [cs: CompilerStateNode]
RETURNS [TypeGraphNodeNode] ~ {
RETURN[GetIntrinsicType[cs, "ATOM"]];
};
GetIntrinsicBooleanType:
PUBLIC PROC [cs: CompilerStateNode]
RETURNS [TypeGraphNodeNode] ~ {
RETURN[GetIntrinsicType[cs, "BOOLEAN"]];
};
GetIntrinsicCharacterType:
PUBLIC PROC [cs: CompilerStateNode]
RETURNS [TypeGraphNodeNode] ~ {
RETURN[GetIntrinsicType[cs, "CHARACTER"]];
};
GetIntrinsicIntegerTypes:
PUBLIC PROC [cs: CompilerStateNode]
RETURNS [TypeGraphNodeListNode] ~ {
RETURN[
NEW[TypeGraphNodeListNodeBody ←
LIST[
GetIntrinsicType[cs, "CARD64"],
GetIntrinsicType[cs, "INT64"]
]]];
};
GetIntrinsicRealTypes:
PUBLIC PROC [cs: CompilerStateNode]
RETURNS [TypeGraphNodeListNode] ~ {
RETURN[
NEW[TypeGraphNodeListNodeBody ←
LIST[
GetIntrinsicType[cs, "REAL"]
]]];
};
GetIntrinsicType:
PROC [cs: CompilerStateNode, name: Rope.
ROPE]
RETURNS [TypeGraphNodeNode] =
BEGIN
field: BD.FieldNode ← BD.LookupNameInContextRib[IdNodeFromRope[name], cs.rootContextRib];
RETURN[BD.FieldType[field]];
END;
GetTop: PUBLIC PROC [cs: CompilerStateNode] RETURNS [TypeGraphNodeNode] ~ {RETURN[cs.top]};
GetBottom: PUBLIC PROC [cs: CompilerStateNode] RETURNS [TypeGraphNodeNode] ~ {RETURN[cs.bottom]};
GetDefaultAccess: PUBLIC PROC [cs: CompilerStateNode] RETURNS [AccessValNode] ~ {RETURN[BD.AccessValConst["public"]]};
THIS IS CROCKED! IT WILL EVENTUALLY GO AWAY!
SetDefaultAccess: PUBLIC PROC [cs: CompilerStateNode, access: AccessValNode] RETURNS [CompilerStateNode] ~ {cs.defaultAccess ← access; RETURN[cs]};
The following procedures are defined in SaffronCompilerState:
SetIntrinsicAtomType: PUBLIC PROC [cs: CompilerStateNode, type: TypeGraphNodeNode] ~ {cs.intrinsicAtomType ← type};
SetIntrinsicBooleanType: PUBLIC PROC [cs: CompilerStateNode, type: TypeGraphNodeNode] ~ {cs.intrinsicBooleanType ← type};
SetIntrinsicCharacterType: PUBLIC PROC [cs: CompilerStateNode, type: TypeGraphNodeNode] ~ {cs.intrinsicCharacterType ← type};
SetIntrinsicIntegerTypes: PUBLIC PROC [cs: CompilerStateNode, types: TypeGraphNodeListNode] ~ {cs.intrinsicIntegerTypes ← types};
SetIntrinsicRealTypes: PUBLIC PROC [cs: CompilerStateNode, types: TypeGraphNodeListNode] ~ {cs.intrinsicRealTypes ← types};
SetTopAndBottom: PUBLIC PROC [cs: CompilerStateNode, top, bottom: TypeGraphNodeNode] ~ {cs.top ← top; cs.bottom ← bottom};
IdNodeFromRope:
PROC [r: Rope.
ROPE]
RETURNS [
GEN.IdNode] =
BEGIN
RETURN [NEW[GEN.IdNodeBody ← [r, 0, 0]]];
END;