ProceduresImpl.mesa
Copyright Ó 1990, 1992 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.