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. V 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 by the time we get here left should a procedure type Procedure literals Κς–(cedarcode) style•NewlineDelimiter ™codešœ™Kšœ Οeœ7™BKšœ(™(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˜