ProceduresImpl.mesa
Copyright Ó 1990 by Xerox Corporation. All rights reserved.
Sturgis, January 27, 1989 4:03:27 pm PST
Last changed by Theimer on May 25, 1989 10:35:35 pm PDT
Hopcroft July 26, 1989 11:02:56 am PDT
Spreitze, January 9, 1992 11:08 am PST
DIRECTORY
CCTypes USING[BinaryTargetTypes, BreakPrintType, CCError, CCErrorCase, CCTypeProcs, CheckConformance, ConformanceCheck, CreateCedarType, GetProcDataFromGroundType, LR],
CirioSyntacticOperations USING[CompileForRHS, ParseTree],
CirioTypes USING[BasicTypeInfo, CompilerContext, Mem, Node, Type, TypedCode],
CedarCode USING[Code, CodeToDoApply, ConcatCode, CreateCedarNode, GetDataFromNode, OperationsBody, Operator],
IO,
Procedures USING[ProcedureNodeInfo, ProcLiteral],
Rope;
ProceduresImpl:
CEDAR
PROGRAM
IMPORTS CCTypes, CedarCode, CirioSyntacticOperations, IO
EXPORTS Procedures
= BEGIN OPEN CSO: CirioSyntacticOperations;
CC: TYPE = CirioTypes.CompilerContext;
Code: TYPE = CedarCode.Code;
Type: TYPE = CirioTypes.Type;
TypedCode: TYPE = CirioTypes.TypedCode;
BasicTypeInfo: TYPE = CirioTypes.BasicTypeInfo;
Mem: TYPE = CirioTypes.Mem;
Node: TYPE = CirioTypes.Node;
CCE: ERROR[case: CCTypes.CCErrorCase, msg: Rope.ROPE ← NIL] ← CCTypes.CCError;
Operator: TYPE = CedarCode.Operator;
ProcedureTypeInfo: TYPE = REF ProcedureTypeInfoBody;
ProcedureTypeInfoBody:
TYPE =
RECORD[
args: Type,
results: Type,
self: Type,
bti: BasicTypeInfo];
CreateProcedureType:
PUBLIC
PROC[args, results: Type, cc:
CC, bti: BasicTypeInfo]
RETURNS[Type] =
BEGIN
pti: ProcedureTypeInfo ← NEW[ProcedureTypeInfoBody ← [args, results, NIL, bti]];
type: Type ← pti.self ← CCTypes.CreateCedarType[$procedure, ProcedureTypeCCTypeProcs, IndirectProcedureTypeCCTypeProcs, cc, pti];
RETURN[type];
END;
ProcedureTypeCCTypeProcs:
REF CCTypes.CCTypeProcs ←
NEW[CCTypes.CCTypeProcs ←[
checkConformance: ProcedureCCTypesCheckConformance,
binaryOperandTypes: ProcedureCCTypesBinaryOperandTypes,
operand: ProcedureCCTypesOperand,
applyOperand: ProcedureCCTypesApplyOperand,
apply: ProcedureCCTypesApply,
getTypeRepresentation: ProcedureGetTypeRep,
printType: ProcedureCCTypesPrintType]];
IndirectProcedureTypeCCTypeProcs:
REF CCTypes.CCTypeProcs ←
NEW[CCTypes.CCTypeProcs ←[
createIndirectNode: ProcedureCreateIndirect,
getBitSize: ProcedureBitSize,
printType: ProcedureCCTypesPrintType]];
ProcedureCreateIndirect:
PROC [cc:
CC, procData:
REF
ANY, indirectType, targetType: Type, mem: Mem]
RETURNS [Node] ~ {
valInfo: ProcedureTypeInfo ← NARROW[procData];
RETURN valInfo.bti.createIndirectNode[valInfo.bti, cc, indirectType, targetType, mem]};
ProcedureBitSize:
PROC[indirectType, targetType: Type, cc:
CC, procData:
REF
ANY]
RETURNS[
CARD] ~ {
valInfo: ProcedureTypeInfo ← NARROW[procData];
RETURN valInfo.bti.getBitSize[valInfo.bti, cc, indirectType, targetType]};
ProcedureCCTypesCheckConformance:
PROC[valType, varType: Type, cc:
CC, procData:
REF
ANY]
RETURNS[CCTypes.ConformanceCheck]
=
BEGIN
valInfo: ProcedureTypeInfo ← NARROW[procData];
WITH CCTypes.GetProcDataFromGroundType[varType, cc]
SELECT
FROM
varInfo: ProcedureTypeInfo =>
BEGIN
argCheck: CCTypes.ConformanceCheck ← CCTypes.CheckConformance[varInfo.args, valInfo.args, cc];
resultCheck: CCTypes.ConformanceCheck;
IF argCheck = no THEN RETURN[no];
resultCheck ← CCTypes.CheckConformance[valInfo.results, varInfo.results, cc];
IF resultCheck = no THEN RETURN[no];
IF resultCheck = dontKnow OR argCheck = dontKnow THEN RETURN[dontKnow];
RETURN[yes];
END;
ENDCASE => RETURN[no];
END;
by the time we get here left should a procedure type
ProcedureCCTypesBinaryOperandTypes:
PROC[op: Operator, left, right: Type, cc:
CC, procData:
REF
ANY]
RETURNS[CCTypes.BinaryTargetTypes] =
BEGIN
info: ProcedureTypeInfo ← NARROW[procData];
RETURN[[info.self, info.args]];
END;
ProcedureCCTypesOperand:
PROC[op: Operator, lr: CCTypes.
LR, tc: TypedCode, cc:
CC, procData:
REF
ANY]
RETURNS[TypedCode] =
BEGIN
info: ProcedureTypeInfo ← NARROW[procData];
SELECT op
FROM
$apply =>
SELECT lr
FROM
left => RETURN[tc];
ENDCASE => CCE[operation];
ENDCASE => CCE[operation];
END;
ProcedureCCTypesApplyOperand:
PROC[operatorType: Type, operand: CirioSyntacticOperations.ParseTree, cc:
CC, procData:
REF
ANY]
RETURNS[TypedCode] =
BEGIN
info: ProcedureTypeInfo ← NARROW[procData];
RETURN[CSO.CompileForRHS[operand, info.args, cc]];
END;
ProcedureCCTypesApply:
PROC[operator: TypedCode, operand: TypedCode, cc:
CC, procData:
REF
ANY]
RETURNS[TypedCode] =
BEGIN
info: ProcedureTypeInfo ← NARROW[procData];
code: Code ← CedarCode.ConcatCode[
operator.code,
CedarCode.ConcatCode[
operand.code,
CedarCode.CodeToDoApply[operator.type, operand.type]]];
type: Type ← info.results;
RETURN[[code, type]];
END;
ProcedureGetTypeRep:
PROC[type: Type, cc:
CC, procData:
REF
ANY]
RETURNS[
REF
ANY] ~ {
info: ProcedureTypeInfo ← NARROW[procData];
RETURN[info.bti]};
ProcedureCCTypesPrintType:
PROC [to:
IO.
STREAM, type: Type, printDepth:
INT, printWidth:
INT, cc:
CC, procData:
REF
ANY] = {
info: ProcedureTypeInfo ← NARROW[procData];
to.PutRope["PROC"];
CCTypes.BreakPrintType[to, info.args, printDepth-1, printWidth, cc, " "];
to.PutRope[" RETURNS"];
CCTypes.BreakPrintType[to, info.results, printDepth-1, printWidth, cc, " "];
RETURN};
CreateProcedureNode:
PUBLIC
PROC[type: Type, info: Procedures.ProcedureNodeInfo]
RETURNS[Node] =
BEGIN
RETURN[CedarCode.CreateCedarNode[ProcedureOps, type, info]];
END;
ProcedureOps:
REF CedarCode.OperationsBody ←
NEW[CedarCode.OperationsBody ←[
apply: ProcedureApply,
show: ProcedureShow,
getNodeRepresentation: ProcedureGetNodeRepresentation
]];
ProcedureApply:
PROC[operatorType: Type, operandType: Type, operator: Node, operand: Node, cc:
CC]
RETURNS[Node] =
BEGIN
procData: Procedures.ProcedureNodeInfo ← NARROW[CedarCode.GetDataFromNode[operator]];
RETURN[procData.call[operand, cc, procData.data]];
END;
ProcedureShow:
PROC[to:
IO.
STREAM, node: Node, depth:
INT, width:
INT, cc:
CC] = {
procData: Procedures.ProcedureNodeInfo ← NARROW[CedarCode.GetDataFromNode[node]];
procData.show[to, procData.data, depth, width]};
ProcedureGetNodeRepresentation:
PROC[node: Node, cc:
CC]
RETURNS[
REF
ANY] =
BEGIN
procData: Procedures.ProcedureNodeInfo ← NARROW[CedarCode.GetDataFromNode[node]];
RETURN[procData];
END;
Procedure literals
CreateProcLiteralType:
PUBLIC PROC [proc: Procedures.ProcLiteral, cc:
CC]
RETURNS [Type] =
BEGIN
RETURN [proc.procType];
END;
CreateProcLiteralNode:
PUBLIC PROC [proc: Procedures.ProcLiteral, cc:
CC]
RETURNS [Node] =
BEGIN
RETURN [CreateProcedureNode[proc.procType, proc.procNodeInfo]];
END;
END.