<<>> <> <> <> <> <> <> <> DIRECTORY CCTypes USING[ApplyOperand, BinaryTargetTypes, BreakPrintType, CCError, CCErrorCase, CCTypeProcs, CheckConformance, CheckFamilyInclusion, CoerceToType, ConformanceCheck, ContainsVariance, CreateCedarType, GetGroundTypeClass, GetIndirectType, GetNilRefType, GetNodeType, GetNVariants, GetProcDataFromGroundType, GetProcDataFromType, GetRefAnyType, GetRTargetType, GetTargetTypeOfIndirect, Index, IsAnIndirect, IsASingleton, Load, LR, Operand, Operator, SelectIdField, UnaryOp], CedarCode USING[CodeToExtractField, CodeToLoadContentsOfAMNode, CodeToDoUnaryOp, CodeToLoadThroughIndirect, CodeToStoreUnpopped, ConcatCode, CreateCedarNode, ExtractFieldFromNode, ForceNodeIn, GetDataFromNode, GetTypeOfNode, LoadThroughIndirectNode, OperationsBody, SelectFieldFromNode, ShowNode, StoreThroughIndirectNode], CedarOtherPureTypes USING[CreateParseTreeNode], CirioSyntacticOperations USING[ParseTree], CirioTypes USING[BasicTypeInfo, Code, CompilerContext, Mem, Node, Type, TypedCode, TypeClass], IO, PointerTypes USING [CreatePointerType], RefTypes USING[RefNodeInfo], Rope; RefTypesImpl: CEDAR PROGRAM IMPORTS CCTypes, CedarCode, CedarOtherPureTypes, IO, PointerTypes, Rope EXPORTS RefTypes = BEGIN CC: TYPE = CirioTypes.CompilerContext; BasicTypeInfo: TYPE = CirioTypes.BasicTypeInfo; Type: TYPE = CirioTypes.Type; TypedCode: TYPE = CirioTypes.TypedCode; Code: TYPE = CirioTypes.Code; Mem: TYPE = CirioTypes.Mem; Node: TYPE = CirioTypes.Node; CCE: ERROR[case: CCTypes.CCErrorCase, msg: Rope.ROPE _ NIL] _ CCTypes.CCError; <> <> <> <> <> <> <> <> <> <> <<>> <> <<>> <> <> <> <> <<>> <> <<>> <> <<>> <> <<>> <> <<>> <<>> <> <<>> <> <> <<>> <> <> <<>> <> <> <> <<>> <> <> <<>> <> <<>> <> <<>> <> <<>> <> <<>> <> <<>> RefTargetTypeInfo: TYPE = REF RefTargetTypeInfoBody; RefTargetTypeInfoBody: TYPE = RECORD[ containsVarianceIsKnown: RTTCVKnown, containsVariance: BOOLEAN, self: Type, indirect: Type, bodyType: Type, -- NIL for a REF ANY target type, T for a REF T target. codeForBodyType: INT]; RTTCVKnown: TYPE = {no, deciding, yes}; CreateRefTargetType: PROC[bodyType: Type, codeForBodyType: INT, cc: CC] RETURNS[Type] = BEGIN rttInfo: RefTargetTypeInfo _ NEW[RefTargetTypeInfoBody_[ no, FALSE, -- any value will do, it will be ignored NIL, NIL, bodyType, codeForBodyType]]; type: Type _ rttInfo.self _ CCTypes.CreateCedarType[$refTargetType, RefTargetTypeCCTypeProcs, IndirectRefTargetTypeCCTypeProcs, cc, rttInfo]; RETURN[type]; END; SetRefTargetTypeContainsVariance: PROC[rttInfo: RefTargetTypeInfo, cc: CC] = BEGIN SELECT rttInfo.containsVarianceIsKnown FROM no => BEGIN rttInfo.containsVarianceIsKnown _ deciding; rttInfo.containsVariance _ (rttInfo.bodyType = NIL) OR CCTypes.ContainsVariance[rttInfo.bodyType, cc]; rttInfo.containsVarianceIsKnown _ yes; END; deciding => CCE[cirioError]; yes => RETURN; ENDCASE => CCE[cirioError]; END; RefTargetTypeCCTypeProcs: REF CCTypes.CCTypeProcs _ NEW[CCTypes.CCTypeProcs _[ checkConformance: RTTCCTypesCheckConformance, checkFamilyInclusion: RTTCCTypesCheckFamilyInclusion, isASingleton: RTTCCTypesIsASingleton, getNVariants: RTTCCTypesGetNVariants]]; RTTCCTypesCheckConformance: PROC[valType, varType: Type, cc: CC, procData: REF ANY] RETURNS[CCTypes.ConformanceCheck] = BEGIN valInfo: RefTargetTypeInfo _ NARROW[procData]; IF valInfo.containsVarianceIsKnown # yes THEN SetRefTargetTypeContainsVariance[valInfo, cc]; WITH CCTypes.GetProcDataFromGroundType[varType, cc] SELECT FROM varInfo: RefTargetTypeInfo => BEGIN IF varInfo.containsVarianceIsKnown # yes THEN SetRefTargetTypeContainsVariance[varInfo, cc]; IF varInfo.bodyType = NIL THEN RETURN[yes]; RETURN[CCTypes.CheckConformance[valInfo.bodyType, varInfo.bodyType, cc]]; END; ENDCASE => RETURN[no]; END; RTTCCTypesCheckFamilyInclusion: PROC[valType, varType: Type, cc: CC, procData: REF ANY] RETURNS[BOOLEAN] = BEGIN valInfo: RefTargetTypeInfo _ NARROW[procData]; IF valInfo.containsVarianceIsKnown # yes THEN SetRefTargetTypeContainsVariance[valInfo, cc]; WITH CCTypes.GetProcDataFromGroundType[varType, cc] SELECT FROM varInfo: RefTargetTypeInfo => BEGIN IF varInfo.containsVarianceIsKnown # yes THEN SetRefTargetTypeContainsVariance[varInfo, cc]; IF varInfo.bodyType = NIL THEN RETURN[TRUE]; IF valInfo.codeForBodyType # varInfo.codeForBodyType THEN RETURN[FALSE]; IF NOT CCTypes.CheckFamilyInclusion[valInfo.bodyType, varInfo.bodyType, cc] THEN CCE[cirioError, "ref target types found with equal typecodes and unequal body types"]; -- if the body type codes agree then the families should bloody well be equal. RETURN[TRUE]; END; ENDCASE => RETURN[FALSE]; END; RTTCCTypesIsASingleton: PROC[type: Type, cc: CC, procData: REF ANY] RETURNS[BOOLEAN] = BEGIN valInfo: RefTargetTypeInfo _ NARROW[procData]; IF valInfo.bodyType = NIL THEN RETURN[FALSE]; -- RTT(ANY) RETURN[CCTypes.IsASingleton[valInfo.bodyType, cc]]; END; <> RTTCCTypesGetNVariants: PROC[type: Type, cc: CC, procData: REF ANY] RETURNS[INT] = BEGIN info: RefTargetTypeInfo _ NARROW[procData]; IF info.containsVarianceIsKnown # yes THEN SetRefTargetTypeContainsVariance[info, cc]; RETURN[CCTypes.GetNVariants[info.bodyType, cc]]; END; <<>> <> <<>> <> <<>> IndirectRefTargetTypeCCTypeProcs: REF CCTypes.CCTypeProcs _ NEW[CCTypes.CCTypeProcs _[ store: IRTTCCTypesStore, load: IRTTCCTypesLoad]]; <> IRTTCCTypesStore: PROC[value: TypedCode, indirect: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] = BEGIN info: RefTargetTypeInfo _ NARROW[procData]; IF info.containsVariance THEN CCE[operation, "attempt to store into a variant record field"]; -- client error, attempt to store into a (possibly nested) variant record field or target of a REF ANY. (We shall eventually have to allow this for initialization.) <> BEGIN code: Code _ CedarCode.ConcatCode[ indirect.code, CedarCode.ConcatCode[ value.code, CedarCode.CodeToStoreUnpopped[indirect.type, value.type]]]; RETURN[[code, value.type]]; END; END; <> IRTTCCTypesLoad: PROC[indirect: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] = BEGIN code: Code _ CedarCode.ConcatCode[ indirect.code, CedarCode.CodeToLoadThroughIndirect[indirect.type]]; type: Type _ CCTypes.GetRTargetType[indirect.type, cc]; RETURN[[code, type]]; END; <> <<>> RefInfo: TYPE = REF RefInfoBody; RefInfoBody: TYPE = RECORD[ made: BOOL _ FALSE, <> target: Type, -- target = NIL is used for NIL REF. bti: BasicTypeInfo]; <> <> <<>> CreateRefAnyType: PUBLIC PROC[cc: CC, bti: BasicTypeInfo] RETURNS[Type] = { nominal: Type _ CCTypes.GetRefAnyType[cc]; IF nominal # NIL THEN RETURN[nominal]; {refInfo: RefInfo _ NEW[RefInfoBody_[TRUE, CreateRefTargetType[NIL, 0, cc], bti]]; -- the zero code here is meaningless type: Type _ CCTypes.CreateCedarType[$refAny, RefTypeCCTypeProcs, IndirectRefTypeCCTypeProcs, cc, refInfo]; RETURN[type]}}; CreateRefType: PUBLIC PROC[cc: CC, bti: BasicTypeInfo] RETURNS[Type] = { refInfo: RefInfo _ NEW[RefInfoBody_[FALSE, NIL, bti]]; type: Type _ CCTypes.CreateCedarType[$ref, RefTypeCCTypeProcs, IndirectRefTypeCCTypeProcs, cc, refInfo]; RETURN[type]}; SetReferent: PUBLIC PROC [refType, clientTargetType: Type, codeForClientTargetType: INT, cc: CC] ~ { refInfo: RefInfo ~ NARROW[CCTypes.GetProcDataFromType[refType]]; IF refInfo.made THEN CCE[cirioError, "Re-SetReferent"]; refInfo.target _ CreateRefTargetType[clientTargetType, codeForClientTargetType, cc]; refInfo.made _ TRUE; RETURN}; CreateNilRefType: PUBLIC PROC[cc: CC] RETURNS[Type] = BEGIN nominal: Type _ CCTypes.GetNilRefType[cc]; IF nominal # NIL THEN RETURN[nominal]; BEGIN refInfo: RefInfo _ NEW[RefInfoBody_[TRUE, NIL]]; type: Type _ CCTypes.CreateCedarType[$nilRef, NilRefTypeCCTypeProcs, IndirectNilRefTypeCCTypeProcs, cc, refInfo]; RETURN[type]; END; END; RefTypeCCTypeProcs: REF CCTypes.CCTypeProcs _ NEW[CCTypes.CCTypeProcs _[ checkConformance: RefCCTypesCheckConformance, binaryOperandTypes: RefCCTypesBinaryOperandTypes, getRTargetType: RefCCTypesGetRTargetType, operand: RefCCTypesOperand, indexOperand: RefCCTypesIndexOperand, coerceToType: RefCCTypesCoerceToType, unaryOp: RefCCTypesUnaryOp, selectIdField: RefCCTypesSelectIdField, index: RefCCTypesIndex, printType: RefCCTypesPrintType]]; RefCCTypesCheckConformance: PROC[valType, varType: Type, cc: CC, procData: REF ANY] RETURNS[CCTypes.ConformanceCheck] = BEGIN valInfo: RefInfo _ NARROW[procData]; WITH CCTypes.GetProcDataFromGroundType[varType, cc] SELECT FROM varInfo: RefInfo => BEGIN IF varInfo.target = NIL THEN RETURN[no]; -- var is NIL REF, we are not. RETURN[CCTypes.CheckConformance[CCTypes.GetIndirectType[valInfo.target], CCTypes.GetIndirectType[varInfo.target], cc]]; END; ENDCASE => RETURN[no]; END; RefCCTypesBinaryOperandTypes: PROC[op: CCTypes.Operator, left, right: Type, cc: CC, procData: REF ANY] RETURNS[CCTypes.BinaryTargetTypes] = BEGIN leftInfo: RefInfo _ NARROW[procData]; leftTargetTypeInfo: RefTargetTypeInfo _ NARROW[CCTypes.GetProcDataFromGroundType[leftInfo.target, cc]]; SELECT op FROM $assign => <> <> RETURN[[CCTypes.GetIndirectType[leftTargetTypeInfo.bodyType], leftTargetTypeInfo.bodyType]]; $eq, $ne, $lt, $gt, $le, $ge => RETURN [[left, left]]; ENDCASE => CCE[cirioError]; END; <<>> <> RefCCTypesGetRTargetType: PROC[type: Type, cc: CC, procData: REF ANY] RETURNS[Type] = BEGIN refTypeInfo: RefInfo _ NARROW[procData]; refTargetTypeInfo: RefTargetTypeInfo _ NARROW[CCTypes.GetProcDataFromGroundType[refTypeInfo.target, cc]]; RETURN[refTargetTypeInfo.bodyType]; END; RefCCTypesOperand: PROC[op: CCTypes.Operator, lr: CCTypes.LR, tc: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] = BEGIN refTypeInfo: RefInfo _ NARROW[procData]; refTargetTypeInfo: RefTargetTypeInfo _ NARROW[CCTypes.GetProcDataFromGroundType[refTypeInfo.target, cc]]; IF refTargetTypeInfo.bodyType = NIL THEN -- we are dealing with a REF ANY <> <> RETURN[CCTypes.CoerceToType[CCTypes.GetNodeType[cc], tc, cc]] ELSE -- we are not dealing with a REF ANY SELECT op FROM $selectId, $uparrow, $index, $leftSideuparrow => RETURN[tc]; $dot, $extractId, $apply => -- try dereferencing first BEGIN tc1: TypedCode _ CCTypes.UnaryOp[$uparrow, tc, cc]; RETURN[CCTypes.Operand[op, lr, tc1, cc]]; END; $eq, $ne, $lt, $gt, $le, $ge => RETURN [tc]; ENDCASE => CCE[operation]; -- client error, invalid operation END; RefCCTypesIndexOperand: PROC[operatorType: Type, operand: CirioSyntacticOperations.ParseTree, cc: CC, procData: REF ANY] RETURNS[TypedCode] = BEGIN refTypeInfo: RefInfo _ NARROW[procData]; refTargetTypeInfo: RefTargetTypeInfo _ NARROW[CCTypes.GetProcDataFromGroundType[refTypeInfo.target, cc]]; IF refTargetTypeInfo.bodyType = NIL THEN -- we are dealing with a REF ANY <> <> BEGIN node: Node _ CedarOtherPureTypes.CreateParseTreeNode[operand, cc]; code: CirioTypes.Code _ CedarCode.CodeToLoadContentsOfAMNode[node]; type: Type _ CCTypes.GetNodeType[cc]; RETURN[[code, type]]; END ELSE -- we are not dealing with a REF ANY <> RETURN[CCTypes.ApplyOperand[refTargetTypeInfo.bodyType, operand, cc]]; END; <> <> <> RefCCTypesCoerceToType: PROC[targetType: Type, tc: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] = BEGIN refTypeInfo: RefInfo _ NARROW[procData]; refTargetTypeInfo: RefTargetTypeInfo _ NARROW[CCTypes.GetProcDataFromGroundType[refTypeInfo.target, cc]]; bodyType: Type _ refTargetTypeInfo.bodyType; IF bodyType = NIL THEN <> <> <> CCE[typeConformity] ELSE BEGIN code1: Code _ CedarCode.ConcatCode[ tc.code, CedarCode.CodeToExtractField["&indirectToBody", tc.type]]; type1: Type _ CCTypes.GetIndirectType[bodyType]; RETURN[CCTypes.CoerceToType[targetType, [code1, type1], cc]]; END; END; RefCCTypesUnaryOp: PROC[op: CCTypes.Operator, arg: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] = BEGIN refTypeInfo: RefInfo _ NARROW[procData]; refTargetTypeInfo: RefTargetTypeInfo _ NARROW[CCTypes.GetProcDataFromGroundType[refTypeInfo.target, cc]]; bodyType: Type _ refTargetTypeInfo.bodyType; code1: Code _ CedarCode.CodeToExtractField["&indirectToBody", arg.type]; SELECT op FROM $leftSideuparrow => BEGIN code: Code _ CedarCode.ConcatCode[ arg.code, code1]; type: Type _ CCTypes.GetIndirectType[bodyType]; RETURN[[code, type]]; END; $uparrow => BEGIN code2: Code _ CedarCode.CodeToLoadThroughIndirect[CCTypes.GetIndirectType[bodyType]]; code: Code _ CedarCode.ConcatCode[ arg.code, CedarCode.ConcatCode[ code1, code2]]; RETURN[[code, bodyType]]; END; ENDCASE => CCE[typeConformity]; -- client type error END; <> RefCCTypesSelectIdField: PROC[id: Rope.ROPE, fieldIndirectContext: Type, cc: CC, procData: REF ANY] RETURNS[TypedCode] = BEGIN refTypeInfo: RefInfo _ NARROW[procData]; refTargetTypeInfo: RefTargetTypeInfo _ NARROW[CCTypes.GetProcDataFromGroundType[refTypeInfo.target, cc]]; bodyType: Type _ refTargetTypeInfo.bodyType; code1: Code _ CedarCode.CodeToExtractField["&indirectToBody", fieldIndirectContext]; type1: Type _ CCTypes.GetIndirectType[bodyType]; tc2: TypedCode _ CCTypes.SelectIdField[id, type1, cc]; code: Code _ CedarCode.ConcatCode[code1, tc2.code]; RETURN[[code, tc2.type]]; END; RefCCTypesIndex: PROC[operator: TypedCode, operand: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] = BEGIN refTypeInfo: RefInfo _ NARROW[procData]; refTargetTypeInfo: RefTargetTypeInfo _ NARROW[CCTypes.GetProcDataFromGroundType[refTypeInfo.target, cc]]; bodyType: Type _ refTargetTypeInfo.bodyType; code1: Code _ CedarCode.ConcatCode[ operator.code, CedarCode.CodeToExtractField["&indirectToBody", operator.type]]; type1: Type _ CCTypes.GetIndirectType[bodyType]; tc1: TypedCode _ [code1, type1]; RETURN[CCTypes.Index[tc1, operand, cc]]; END; RefCCTypesPrintType: PROC [to: IO.STREAM, type: Type, printDepth: INT, printWidth: INT, cc: CC, procData: REF ANY] = { refTypeInfo: RefInfo _ NARROW[procData]; refTargetTypeInfo: RefTargetTypeInfo _ NARROW[CCTypes.GetProcDataFromGroundType[refTypeInfo.target, cc]]; bodyType: Type _ refTargetTypeInfo.bodyType; refTypeClass: CirioTypes.TypeClass _ CCTypes.GetGroundTypeClass[type, cc]; IF refTypeClass = $refAny THEN to.PutRope["REF ANY"] ELSE { to.PutRope["REF"]; CCTypes.BreakPrintType[to, bodyType, printDepth-1, printWidth, cc, " "]; }; }; NilRefTypeCCTypeProcs: REF CCTypes.CCTypeProcs _ NEW[CCTypes.CCTypeProcs _[ checkConformance: NilRefCCTypesCheckConformance]]; NilRefCCTypesCheckConformance: PROC[valType, varType: Type, cc: CC, procData: REF ANY] RETURNS[CCTypes.ConformanceCheck] = BEGIN valInfo: RefInfo _ NARROW[procData]; WITH CCTypes.GetProcDataFromGroundType[varType, cc] SELECT FROM varInfo: RefInfo => RETURN[yes]; -- NIL REF conforms to all REF types. ENDCASE => RETURN[no]; END; IndirectRefTypeCCTypeProcs: REF CCTypes.CCTypeProcs _ NEW[CCTypes.CCTypeProcs _[ createIndirectNode: RefCreateIndirect, getBitSize: RefBitSize, operand: IRefCCTypesOperand, unaryOp: IRefCCTypesUnaryOp, store: IRefCCTypesStore, load: IRefCCTypesLoad, printType: RefCCTypesPrintType]]; IndirectNilRefTypeCCTypeProcs: REF CCTypes.CCTypeProcs _ NEW[CCTypes.CCTypeProcs _[ store: INilRefCCTypesStore, load: INilRefCCTypesLoad]]; <> RefCreateIndirect: PROC [cc: CC, procData: REF ANY, indirectType, targetType: Type, mem: Mem] RETURNS [Node] ~ { refInfo: RefInfo _ NARROW[procData]; IF refInfo.bti=NIL THEN CCE[cirioError, "CreateIndirect[bti-less Type]"]; RETURN refInfo.bti.createIndirectNode[refInfo.bti, cc, indirectType, targetType, mem]}; RefBitSize: PROC[indirectType, targetType: Type, cc: CC, procData: REF ANY] RETURNS[CARD] ~ { refInfo: RefInfo _ NARROW[procData]; IF refInfo.bti=NIL THEN CCE[cirioError, "GetBitSize[bti-less Type]"]; RETURN refInfo.bti.getBitSize[refInfo.bti, cc, indirectType, targetType]}; IRefCCTypesOperand: PROC[op: CCTypes.Operator, lr: CCTypes.LR, tc: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] = BEGIN SELECT op FROM $selectId, $index, $leftSideuparrow => -- try dereferencing first BEGIN tc1: TypedCode _ CCTypes.Load[tc, cc]; RETURN[CCTypes.Operand[op, lr, tc1, cc]]; END; $address => RETURN[tc]; ENDCASE => CCE[operation]; -- client error, invalid operation END; <> IRefCCTypesUnaryOp: PROC[op: CCTypes.Operator, arg: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] = BEGIN SELECT op FROM $address => BEGIN code: CirioTypes.Code _ CedarCode.ConcatCode[ arg.code, CedarCode.CodeToDoUnaryOp[op, arg.type]]; ptrType: Type _ PointerTypes.CreatePointerType[CCTypes.GetTargetTypeOfIndirect[arg.type], cc, NIL--same reasons as always (see default)--]; RETURN [[code, ptrType]]; END; ENDCASE => CCE[cirioError]; END; IRefCCTypesStore: PROC[value: TypedCode, indirect: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] = BEGIN code: Code _ CedarCode.ConcatCode[ indirect.code, CedarCode.ConcatCode[ value.code, CedarCode.CodeToStoreUnpopped[indirect.type, value.type]]]; RETURN[[code, value.type]]; END; IRefCCTypesLoad: PROC[indirect: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] = BEGIN code: Code _ CedarCode.ConcatCode[ indirect.code, CedarCode.CodeToLoadThroughIndirect[indirect.type]]; type: Type _ CCTypes.GetRTargetType[indirect.type, cc]; RETURN[[code, type]]; END; INilRefCCTypesStore: PROC[value: TypedCode, indirect: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] = BEGIN code: Code _ CedarCode.ConcatCode[ indirect.code, CedarCode.ConcatCode[ value.code, CedarCode.CodeToStoreUnpopped[indirect.type, value.type]]]; RETURN[[code, value.type]]; END; INilRefCCTypesLoad: PROC[indirect: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] = BEGIN code: Code _ CedarCode.ConcatCode[ indirect.code, CedarCode.CodeToLoadThroughIndirect[indirect.type]]; type: Type _ CCTypes.GetRTargetType[indirect.type, cc]; RETURN[[code, type]]; END; <> <<>> <> <> <> <<>> RefNodeData: TYPE = RECORD[ indirectToRefTarget: Node, info: RefTypes.RefNodeInfo]; <> <> CreateRefNode: PUBLIC PROC[type: Type, info: RefTypes.RefNodeInfo, cc: CC] RETURNS[Node] = { IF NOT CCTypes.IsAnIndirect[CedarCode.GetTypeOfNode[info.indirectToClientTarget], cc] THEN CCE[cirioError, "RefTypesImpl.CreateRefNode given a non-indirect target node"]; {indirectToRefTarget: Node _ CreateIndirectRefTargetNode[info.clientTargetType, info.codeForClientTargetType, info.indirectToClientTarget, cc]; actualRefType: Type _ CreateRefType[cc, NIL--MJS, May 22, 1991: Hypothesis: this is OK 'case it'll never be needed--]; data: REF RefNodeData _ NEW[RefNodeData_[indirectToRefTarget, info]]; SetReferent[actualRefType, info.clientTargetType, info.codeForClientTargetType, cc]; RETURN[CedarCode.CreateCedarNode[RefNodeOps, actualRefType, data]]; }}; CreateNilRefNode: PUBLIC PROC[cc: CC] RETURNS[Node] = {RETURN[CedarCode.CreateCedarNode[NilRefNodeOps, CreateNilRefType[cc], NIL]]}; RefNodeOps: REF CedarCode.OperationsBody _ NEW[CedarCode.OperationsBody_[ getCurrentType: RefNodeGetCurrentType, extractField: RefNodeExtractField, show: RefNodeShow, getNodeRepresentation: RefNodeGetRepresentation]]; <> RefNodeGetCurrentType: PROC[node: Node, cc: CC] RETURNS[Type] = {RETURN[CedarCode.GetTypeOfNode[node]]}; <<>> RefNodeExtractField: PROC[id: Rope.ROPE, type: Type, node: Node, cc: CC] RETURNS[Node] = BEGIN data: REF RefNodeData _ NARROW[CedarCode.GetDataFromNode[node]]; SELECT TRUE FROM Rope.Equal[id, "&indirectToBody"] => BEGIN RETURN[CedarCode.SelectFieldFromNode["&body", CedarCode.GetTypeOfNode[data.indirectToRefTarget], data.indirectToRefTarget, cc]]; END; ENDCASE => CCE[cirioError]; -- shouldn't happen END; RefNodeShow: PROC[to: IO.STREAM, node: Node, depth: INT, width: INT, cc: CC] = { data: REF RefNodeData _ NARROW[CedarCode.GetDataFromNode[node]]; refType: Type _ CedarCode.GetTypeOfNode[node]; refTypeInfo: RefInfo _ NARROW[CCTypes.GetProcDataFromGroundType[refType, cc]]; target: Node _ CedarCode.LoadThroughIndirectNode[CCTypes.GetIndirectType[refTypeInfo.target], data.indirectToRefTarget, cc]; to.PutChar['^]; CedarCode.ShowNode[to, target, depth, width, cc]; RETURN}; RefNodeGetRepresentation: PROC[node: Node, cc: CC] RETURNS[REF ANY] = BEGIN data: REF RefNodeData _ NARROW[CedarCode.GetDataFromNode[node]]; RETURN[data.info]; END; NilRefNodeOps: REF CedarCode.OperationsBody _ NEW[CedarCode.OperationsBody_[ getCurrentType: NilRefNodeGetCurrentType, extractField: NilRefNodeExtractField, show: NilRefNodeShow, getNodeRepresentation: NilRefNodeGetRepresentation]]; NilRefNodeGetCurrentType: PROC[node: Node, cc: CC] RETURNS[Type] = {CCE[cirioError]}; <> NilRefNodeExtractField: PROC[id: Rope.ROPE, type: Type, node: Node, cc: CC] RETURNS[Node] = {CCE[operation, "NIL fault"]}; <> NilRefNodeShow: PROC[to: IO.STREAM, node: Node, depth: INT, width: INT, cc: CC] = {to.PutRope["NIL"]}; NilRefNodeGetRepresentation: PROC[node: Node, cc: CC] RETURNS[REF ANY] = {RETURN[NIL]}; <> <> IRefTargetData: TYPE = RECORD[ bodyType: Type, indirectToBody: Node]; CreateIndirectRefTargetNode: PROC[bodyType: Type, codeForBodyType: INT, indirectToBody: Node, cc: CC] RETURNS[Node] = BEGIN irtData: REF IRefTargetData _ NEW[IRefTargetData_[bodyType, indirectToBody]]; refTargetType: Type _ CreateRefTargetType[bodyType, codeForBodyType, cc]; node: Node _ CedarCode.CreateCedarNode[IndirectRTOps, CCTypes.GetIndirectType[refTargetType], irtData]; RETURN[node]; END; IndirectRTOps: REF CedarCode.OperationsBody _ NEW[CedarCode.OperationsBody_[ getCurrentType: IndirectRTGetCurrentType, store: IndirectRTStore, load: IndirectRTLoad, selectField: IndirectRTSelectField, show: IndirectRTShow]]; <. I am not sure what is intended here.>> IndirectRTGetCurrentType: PROC[node: Node, cc: CC] RETURNS[Type] = BEGIN irtData: REF IRefTargetData _ NARROW[CedarCode.GetDataFromNode[node]]; RETURN[CCTypes.GetIndirectType[irtData.bodyType]]; END; <> IndirectRTStore: PROC[valType: Type, valNode: Node, indirectType: Type, indirectNode: Node, cc: CC] = BEGIN indirectData: REF IRefTargetData _ NARROW[CedarCode.GetDataFromNode[indirectNode]]; indirectBody: Node _ CedarCode.SelectFieldFromNode["&body", indirectType, indirectNode, cc]; indirectBodyType: Type _ CedarCode.GetTypeOfNode[indirectBody]; valBody: Node _ CedarCode.ExtractFieldFromNode["&body", valType, valNode, cc]; valBodyType: Type _ CedarCode.GetTypeOfNode[valBody]; CedarCode.StoreThroughIndirectNode[valBodyType, valBody, indirectBodyType, indirectBody, cc]; END; IndirectRTLoad: PROC[indirectType: Type, indirectNode: Node, cc: CC] RETURNS[Node] = BEGIN -- note: indirectType is compile time, and does not know the actual type. valType: Type _ CCTypes.GetRTargetType[CedarCode.GetTypeOfNode[indirectNode], cc]; data: REF IRefTargetData _ NARROW[CedarCode.GetDataFromNode[indirectNode]]; RETURN[CreateRTNode[valType, DelayedLoadExtractBody, data, cc, FALSE]]; END; IndirectRTSelectField: PROC[id: Rope.ROPE, indirectType: Type, indirectNode: Node, cc: CC] RETURNS[Node] = BEGIN data: REF IRefTargetData _ NARROW[CedarCode.GetDataFromNode[indirectNode]]; SELECT TRUE FROM Rope.Equal[id, "&body"] => RETURN[data.indirectToBody]; ENDCASE => CCE[cirioError]; -- shouldn't happen END; IndirectRTShow: PROC[to: IO.STREAM, node: Node, depth: INT, width: INT, cc: CC] = { to.PutChar['^]; IF depth = 0 THEN {to.PutRope["..."]; RETURN}; { irtType: Type _ CedarCode.GetTypeOfNode[node]; rt: Node _ CedarCode.LoadThroughIndirectNode[irtType, node, cc]; CedarCode.ShowNode[to, rt, depth, width, cc]; RETURN}}; DelayedLoadExtractBody: PROC[procData: REF ANY, cc: CC] RETURNS[Node] = BEGIN data: REF IRefTargetData _ NARROW[procData]; indirectBody: Node _ data.indirectToBody; indirectBodyType: Type _ CedarCode.GetTypeOfNode[indirectBody]; RETURN[CedarCode.LoadThroughIndirectNode[indirectBodyType, indirectBody, cc]]; END; <> RTData: TYPE = RECORD[ type: Type, alreadyIn: BOOLEAN, extractBody: PROC[procData: REF ANY, cc: CC] RETURNS[Node], procData: REF ANY]; CreateRTNode: PROC[type: Type, extractBody: PROC[procData: REF ANY, cc: CC] RETURNS[Node], procData: REF ANY, cc: CC, alreadyIn: BOOLEAN] RETURNS[Node] = BEGIN rtData: REF RTData _ NEW[RTData_[type, alreadyIn, extractBody, procData]]; node: Node _ CedarCode.CreateCedarNode[RTOps, type, rtData]; RETURN[node]; END; RTOps: REF CedarCode.OperationsBody _ NEW[CedarCode.OperationsBody_[ forceIn: RTForceIn, extractField: RTExtractField, show: RTShow]]; RTForceIn: PROC[type: Type, node: Node, cc: CC] RETURNS[Node] = BEGIN rtData: REF RTData _ NARROW[CedarCode.GetDataFromNode[node]]; IF rtData.alreadyIn THEN RETURN[node] ELSE BEGIN nominalBody: Node _ rtData.extractBody[rtData.procData, cc]; bodyType: Type _ CedarCode.GetTypeOfNode[nominalBody]; body: Node _ CedarCode.ForceNodeIn[bodyType, nominalBody, cc]; RETURN[ConstructRTNode[type, body, cc]]; END; END; RTExtractField: PROC[id: Rope.ROPE, type: Type, node: Node, cc: CC] RETURNS[Node] = BEGIN rtData: REF RTData _ NARROW[CedarCode.GetDataFromNode[node]]; SELECT TRUE FROM Rope.Equal[id, "&body"] => RETURN[rtData.extractBody[rtData.procData, cc]]; ENDCASE => CCE[cirioError]; -- shouldn't happen END; RTShow: PROC[to: IO.STREAM, node: Node, depth: INT, width: INT, cc: CC] = { rtData: REF RTData _ NARROW[CedarCode.GetDataFromNode[node]]; body: Node _ rtData.extractBody[rtData.procData, cc]; CedarCode.ShowNode[to, body, depth, width, cc]}; <> CRTNodeData: TYPE = RECORD[ body: Node]; ConstructRTNode: PROC[type: Type, body: Node, cc: CC] RETURNS[Node] = BEGIN data: REF CRTNodeData _ NEW[CRTNodeData_[body]]; RETURN[CreateRTNode[type, CRTNodeExtractBody, data, cc, TRUE]]; END; CRTNodeExtractBody: PROC[procData: REF ANY, cc: CC] RETURNS[Node] = BEGIN data: REF CRTNodeData _ NARROW[procData]; RETURN[NARROW[data.body]]; END; END..