
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;

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;


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.
   P  
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
by the time we get here left should a procedure type
Procedure literals
 ‌تع  •NewlineDelimiter
™ codeڑœ™K™<Kڑœ(™(K™7K™&K™&—Kک ڑدk	ک	Kڑœ‌œ—‌œک¨Kڑœ‌œک9Kڑœ‌œ=کMKڑœ
‌œ^کmKڑ‌œکKڑœ‌œ!ک1Kڑœک—Kک ڑدnœ‌œ‌کKڑ‌œ/‌ک8Kڑ‌œک—Kڑœ‌œ‌ک+Kک Kڑ‌œ‌œک&Kڑœ‌œکKڑœ‌œکKڑœ‌œک'Kڑœ‌œک/Kڑœ‌œکKڑœ‌œکKڑ‌œ‌œ&‌œ‌œکNKڑœ
‌œک$Kک Kڑœ‌œ‌œک4ڑœ‌œ‌œک%KکKکKکKڑœکKک —ڑ
‍œ‌œ‌œ‌œ‌œکaKڑ‌کKڑœ‌œ)‌œکPKڑœپکپKڑ‌œکKڑ‌œک—Kک ڑ‍œ‌œ‌œکNKک3Kک7Kک!Kک+KکKڑœ+ک+Kک'—Kک ڑ‍ œ‌œ‌œکVKک,KکKک'—Kک ڑ‍œ‌œ‌œ‌œ‌œ,‌œکvKڑœ‌œک.Kڑ‌œQکW—Kک ڑ‍œ‌œ%‌œ‌œ‌œ‌œ‌œکcKڑœ‌œک.Kڑ‌œDکJ—Kک ڑ‍ œ‌œ‌œ‌œ‌œ‌œک{کKڑ‌کKڑœ‌œک.ڑ‌œ0‌œ‌ک?کKڑ‌کKک^Kک&Kڑ‌œ‌œ‌œک!KکMKڑ‌œ‌œ‌œک$Kڑ‌œ‌œ‌œ‌œکGKڑ‌œکKڑ‌œک—Kڑ‌œ‌œک—Kڑ‌œک——ک Kڑœ4™4—ڑ‍"œ‌œ&‌œ‌œ‌œ‌œک‰Kڑ‌کKڑœ‌œک+Kڑ‌œکKڑ‌œک—Kک ڑ‍œ‌œ‌œ‌œ‌œ‌œ‌œکzKڑ‌کKڑœ‌œک+ڑ‌œ‌کک	ڑ‌œ‌کKڑœ‌œکKڑ‌œ‌œک——Kڑ‌œ‌œک—Kڑ‌œک—Kک ڑ‍œ‌œF‌œ‌œ‌œ‌œک“Kڑ‌کKڑœ‌œک+Kڑ‌œ‌œ(ک2Kڑ‌œک—Kک ڑ‍œ‌œ.‌œ‌œ‌œ‌œکtKڑ‌کKڑœ‌œک+ک"KککKکKک7——KکKڑ‌œکKڑ‌œک—Kک ڑ‍œ‌œ‌œ‌œ‌œ‌œ‌œ‌œکUKڑœ‌œک+Kڑ‌œک—Kک ڑ‍œ‌œ‌œ‌œ‌œ‌œ‌œ‌œ‌œک|Kڑœ‌œک+KکKڑœIکIKڑœکKڑœLکLKڑ‌œک—Kک Kک ڑ‍œ‌œ‌œ1‌œک`Kڑ‌کKڑ‌œ6ک<Kڑ‌œک—Kک ڑ‍œ‌œ‌œکLKکKکKڑœ5ک5Kک—Kک ڑ‍œ‌œK‌œ‌œکrKڑ‌کKڑœ)‌œ&کUKڑ‌œ,ک2Kڑ‌œک—Kک ڑ‍œ‌œ‌œ‌œ‌œ	‌œ‌œکRKڑœ)‌œ"کQKڑœ0ک0—Kک ڑ‍œ‌œ‌œ‌œ‌œ‌œکKKڑ‌کKڑœ)‌œ"کQKڑ‌œکKڑ‌œک—Kک Kک K™Kک ڑ‍œ‌œ$‌œ‌œ	کZKڑ‌کKڑ‌œکKڑ‌œک—Kک ڑ	ذbnدbœ‌œ$‌œ‌œ	کZKڑ‌کKڑ‌œ9ک?Kڑ‌œک—Kک Kڑ‌œک— …—    B   l  