AtomsImpl.mesa
Created by Theimer: August 4, 1989 10:05:46 pm PDT
Last changed by Theimer on August 7, 1989 1:19:02 pm PDT
Spreitze, January 8, 1992 1:13 pm PST
DIRECTORY
Atoms,
CCTypes USING [CCError, CCErrorCase, CCTypeProcs, CheckConformance, ConformanceCheck, CreateCedarType, ExtractIdField, GetIndirectType, GetProcDataFromGroundType, GetProcDataFromType, LR, Operator, SelectIdField],
CirioTypes USING [BasicTypeInfo, CompilerContext, Mem, Node, Type, TypedCode],
CedarCode USING [Code, CreateCedarNode, OperationsBody, GetDataFromNode, GetTypeOfNode, Operator, LoadThroughIndirectNode, ShowNode, ExtractFieldFromNode, CodeToLoadThroughIndirect, ConcatCode],
IO,
RefTypes USING [CreateNilRefNode],
Rope USING[ROPE];
AtomsImpl: CEDAR PROGRAM
IMPORTS CCTypes, CedarCode, IO, RefTypes
EXPORTS Atoms
= BEGIN OPEN CCTypes;
CC: TYPE = CirioTypes.CompilerContext;
Code: TYPE = CedarCode.Code;
BasicTypeInfo: TYPE = CirioTypes.BasicTypeInfo;
Type: TYPE = CirioTypes.Type;
TypedCode: TYPE = CirioTypes.TypedCode;
Mem: TYPE = CirioTypes.Mem;
Node: TYPE = CirioTypes.Node;
CCE: ERROR[case: CCTypes.CCErrorCase, msg: Rope.ROPE ← NIL] ← CCTypes.CCError;
Operator: TYPE = CedarCode.Operator;
Type operations
AtomTypeInfo: TYPE = REF AtomTypeInfoBody;
AtomTypeInfoBody: TYPE = RECORD [
recType: Type,
bti: BasicTypeInfo];
CreateAtomType: PUBLIC PROC [cc: CC, bti: BasicTypeInfo] RETURNS [Type] = {
info: AtomTypeInfo ← NEW [AtomTypeInfoBody ← [NIL, bti]];
RETURN [CCTypes.CreateCedarType[$atom, AtomTypeCCTypeProcs, IndirectAtomTypeCCTypeProcs, cc, info]]};
SetAtomRecType: PUBLIC PROC [atomType, recType: Type, cc: CC] ~ {
info: AtomTypeInfo ~ NARROW[CCTypes.GetProcDataFromType[atomType]];
IF info.recType#NIL THEN CCE[cirioError, "Re-SetAtomRecType"];
info.recType ← recType;
RETURN};
AtomTypeCCTypeProcs: REF CCTypes.CCTypeProcs ← NEW[CCTypes.CCTypeProcs ←[
checkConformance: AtomCCTypesCheckConformance,
operand: AtomCCTypesOperand,
unaryOp: AtomCCTypesUnaryOp,
extractIdField: AtomCCTypesExtractIdField,
getTypeRepresentation: AtomGetTypeRep,
printType: AtomCCTypesPrintType]];
AtomCCTypesCheckConformance: PROC[valType, varType: Type, cc: CC, procData: REF ANY] RETURNS[CCTypes.ConformanceCheck] =
BEGIN
valInfo: AtomTypeInfo ← NARROW[procData];
WITH CCTypes.GetProcDataFromGroundType[varType, cc] SELECT FROM
varInfo: AtomTypeInfo => RETURN [CCTypes.CheckConformance[valInfo.recType, varInfo.recType, cc]];
ENDCASE => RETURN[no];
END;
AtomCCTypesOperand: PROC [op: Operator, lr: CCTypes.LR, tc: TypedCode, cc: CC, procData: REF ANY] RETURNS [TypedCode] =
BEGIN
SELECT op FROM
$dot , $extractId, $uparrow => RETURN[tc];
ENDCASE => CCE[operation]; -- client error, invalid operation
END;
AtomCCTypesUnaryOp: PROC[op: CCTypes.Operator, arg: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
info: AtomTypeInfo ← NARROW[procData];
SELECT op FROM
$uparrow => BEGIN
code2: Code ← CedarCode.CodeToLoadThroughIndirect[CCTypes.GetIndirectType[info.recType]];
code: Code ← CedarCode.ConcatCode[arg.code, code2];
RETURN[[code, info.recType]];
END;
ENDCASE => CCE[typeConformity]; -- client type error
END;
AtomCCTypesExtractIdField: PROC[id: Rope.ROPE, fieldContext: Type, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
info: AtomTypeInfo ← NARROW[procData];
tc: TypedCode ← CCTypes.ExtractIdField[id, info.recType, cc];
code2: Code ← CedarCode.ConcatCode[code1, tc.code];
RETURN [[code2, tc.type]];
RETURN [tc];
END;
IndirectAtomTypeCCTypeProcs: REF CCTypes.CCTypeProcs ← NEW[CCTypes.CCTypeProcs ←[
createIndirectNode: AtomCreateIndirect,
getBitSize: AtomBitSize,
operand: IndirectAtomCCTypesOperand,
selectIdField: AtomCCTypesSelectIdField,
printType: AtomCCTypesPrintType]];
AtomCreateIndirect: PROC [cc: CC, procData: REF ANY, indirectType, targetType: Type, mem: Mem] RETURNS [Node] ~ {
info: AtomTypeInfo ← NARROW[procData];
RETURN info.bti.createIndirectNode[info.bti, cc, indirectType, targetType, mem]};
AtomBitSize: PROC[indirectType, targetType: Type, cc: CC, procData: REF ANY] RETURNS[CARD] ~ {
info: AtomTypeInfo ← NARROW[procData];
RETURN info.bti.getBitSize[info.bti, cc, indirectType, targetType]};
IndirectAtomCCTypesOperand: PROC[op: Operator, lr: CCTypes.LR, tc: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
SELECT op FROM
$selectId, $address => RETURN[tc];
ENDCASE => CCE[operation]; -- client error; invalid operation
END;
AtomCCTypesSelectIdField: PROC[id: Rope.ROPE, fieldIndirectContext: Type, cc: CC, procData: REF ANY] RETURNS[TypedCode] = {
info: AtomTypeInfo ← NARROW[procData];
tc: TypedCode ← CCTypes.SelectIdField[id, CCTypes.GetIndirectType[info.recType], cc];
RETURN [tc];
};
AtomGetTypeRep: PROC[type: Type, cc: CC, procData: REF ANY] RETURNS[REF ANY] ~ {
info: AtomTypeInfo ← NARROW[procData];
RETURN[info.bti]};
AtomCCTypesPrintType: PROC [to: IO.STREAM, type: Type, printDepth: INT, printWidth: INT, cc: CC, procData: REF ANY] = {
info: AtomTypeInfo ← NARROW[procData];
to.PutRope["ATOM"]};
Node operations.
CreateAtomNode: PUBLIC PROC [type: Type, info: Atoms.AtomNodeInfo, cc: CC] RETURNS [Node] = {
RETURN [CedarCode.CreateCedarNode[AtomOps, type, info]];
};
AtomOps: REF CedarCode.OperationsBody ← NEW[CedarCode.OperationsBody ←[
load: AtomLoad,
extractField: AtomExtractField,
show: AtomShow,
getNodeRepresentation: AtomNodeGetRepresentation
]];
AtomLoad: PROC [indirectType: Type, indirectNode: Node, cc: CC] RETURNS [Node] = {
info: Atoms.AtomNodeInfo ← NARROW[CedarCode.GetDataFromNode[indirectNode]];
RETURN [CedarCode.LoadThroughIndirectNode[CCTypes.GetIndirectType[info.atomRecType], info.atomRecNode, cc]];
};
AtomExtractField: PROC[id: Rope.ROPE, type: Type, node: Node, cc: CC] RETURNS[Node] =
BEGIN
info: Atoms.AtomNodeInfo ← NARROW[CedarCode.GetDataFromNode[node]];
rec: Node ← CedarCode.LoadThroughIndirectNode[CCTypes.GetIndirectType[info.atomRecType], info.atomRecNode, cc];
RETURN [CedarCode.ExtractFieldFromNode[id, info.atomRecType, rec, cc]];
END;
AtomShow: PROC [to: IO.STREAM, node: Node, depth: INT, width: INT, cc: CC] = {
info: Atoms.AtomNodeInfo ← NARROW[CedarCode.GetDataFromNode[node]];
rec: Node ← CedarCode.LoadThroughIndirectNode[CCTypes.GetIndirectType[info.atomRecType], info.atomRecNode, cc];
recType: Type ← CedarCode.GetTypeOfNode[rec];
pName: Node ← CedarCode.ExtractFieldFromNode["pName", recType, rec, cc];
to.PutChar['$];
CedarCode.ShowNode[to, pName, depth, width, cc];
RETURN};
AtomNodeGetRepresentation: PROC[node: Node, cc: CC] RETURNS[REF ANY] =
BEGIN
data: Atoms.AtomNodeInfo ← NARROW[CedarCode.GetDataFromNode[node]];
RETURN[data];
END;
CreateNilAtomNode: PUBLIC PROC [type: Type, cc: CC] RETURNS [Node] =
BEGIN
RETURN [CedarCode.CreateCedarNode[NilAtomOps, type, NIL]];
END;
NilAtomOps: REF CedarCode.OperationsBody ← NEW[CedarCode.OperationsBody ←[
load: NilAtomLoad,
show: NilAtomShow
]];
NilAtomLoad: PROC [indirectType: Type, indirectNode: Node, cc: CC] RETURNS [Node] = {
RETURN [RefTypes.CreateNilRefNode[cc]];
};
NilAtomShow: PROC [to: IO.STREAM, node: Node, depth: INT, width: INT, cc: CC]
= {to.PutRope["NIL"]};
END.