<<>> <> <> <> <> <> <> <> <> <<>> DIRECTORY AmpersandContext USING[CreateAmpersandContextType, CreateNodeType], Basics USING[BITXOR, HighHalf, LowHalf], CCTypes USING[BinaryTargetTypes, CCError, CCErrorCase, CCTypeProcs, CheckConformance, ConformanceCheck, Conforms, CreateFrameNodeForSelf, IdFieldCase, IsAnIndirect, LoadIdField, LR, Operator, SelectIdField, GetScopeIndex, GetTargetTypeOfIndirect, LocalCedarTargetWorld], CedarCode USING[CodeToGetNameContext, CodeToLoadNameScope, CodeToLoadThroughIndirect, CodeToMakeAMNode, CodeToSelectField, CodeToStoreUnpopped, CodeToDoUnaryOp, ConcatCode, CreateCedarNode, ExtractFieldFromNode, GetDataFromNode, GetTypeOfNode, LoadThroughIndirectNode, OperationsBody, Operator, SelectFieldFromNode, StoreThroughIndirectNode, AdvanceNameScope, ShowNode], CedarNumericTypes, CirioSyntacticOperations USING[NameArgPair, ParseTree], CirioTypes USING[bitsPerAu, bitsPerPtr, BitAddr, BitStretch, CirioAddress, CirioAddressBody, Code, CompilerContext, CompilerContextBody, Mem, Nat, Node, PtrReg, Type, TypeBody, TypeClass, TypedCode, unspecdBA, zeroBA], IO, RefTypes USING[CreateNilRefType], PointerTypes USING[CreatePointerType, CreateNilPointerType], RefTab USING[Create, Fetch, Key, Ref, Store], Rope USING[Fetch, ROPE, Cat], StructuredStreams; CCTypesImpl: CEDAR PROGRAM IMPORTS AmpersandContext, Basics, CCTypes, CedarCode, CedarNumericTypes, IO, RefTab, RefTypes, PointerTypes, Rope, StructuredStreams EXPORTS CCTypes, CirioTypes SHARES CirioTypes = BEGIN OPEN SS:StructuredStreams; CCE: ERROR[case: CCTypes.CCErrorCase, msg: Rope.ROPE _ NIL] _ CCTypes.CCError; Nat: TYPE = CirioTypes.Nat; ROPE: TYPE = Rope.ROPE; BitAddr: TYPE = CirioTypes.BitAddr; BitStretch: TYPE = CirioTypes.BitStretch; PtrReg: TYPE = CirioTypes.PtrReg; Mem: TYPE = CirioTypes.Mem; Node: TYPE = CirioTypes.Node; TypedCode: TYPE = CirioTypes.TypedCode; Operator: TYPE = CCTypes.Operator; CC: TYPE = CirioTypes.CompilerContext; unspecdBA: BitAddr ~ CirioTypes.unspecdBA; zeroBA: BitAddr ~ CirioTypes.zeroBA; bitsPerAu: Nat ~ CirioTypes.bitsPerAu; bitsPerPtr: Nat ~ CirioTypes.bitsPerPtr; CompilerTypeContext: TYPE = REF CompilerTypeContextBody; CompilerTypeContextBody: PUBLIC TYPE = RECORD[ finalDefaultType: Type, wrongType: Type, nodeType: Type, booleanType: Type, charType: Type, ropeType: Type, anyTargetType: Type, refAnyType: Type, nilRefType: Type, ampersandContextType: Type, ampersandVarType: Type, emptyType: Type, conformingTypePairs: RefTab.Ref, conformanceTestDepth: INT, nilPointerType: Type, localCedarTargetWorld: CCTypes.LocalCedarTargetWorld, cirioAddressType: Type, cedarNumericTypes: RefTab.Ref ]; CreateCedarCompilerContext: PUBLIC PROC RETURNS[CirioTypes.CompilerContext] = BEGIN ctc: CompilerTypeContext _ NEW[CompilerTypeContextBody]; tempCC: CirioTypes.CompilerContext _ NEW[CirioTypes.CompilerContextBody_[ctc:ctc]]; ctc.finalDefaultType _ NIL; ctc.finalDefaultType _ CreateCedarType[$finalDefault, FinalDefaultTypeTypeProcs, DefaultIndirectTypeProcs, tempCC]; -- note that cc.finalDefaultType = NIL during this call, so that the defaults placed in cc.finalDefaultType will be NIL ctc.wrongType _ CreateCedarType[$wrong, NIL, NIL, tempCC]; ctc.nodeType _ AmpersandContext.CreateNodeType[tempCC]; ctc.booleanType _ NIL; --filled in by target world ctc.charType _ NIL; --filled in by target world ctc.ropeType _ NIL; --filled in by target world ctc.anyTargetType _ CreateAnyTargetType[tempCC]; ctc.refAnyType _ NIL; --filled in by target world ctc.nilRefType _ RefTypes.CreateNilRefType[tempCC]; ctc.nilPointerType _ PointerTypes.CreateNilPointerType[tempCC]; ctc.ampersandContextType _ AmpersandContext.CreateAmpersandContextType[tempCC]; ctc.ampersandVarType _ GetIndirectType[ctc.nodeType]; ctc.emptyType _ CreateEmptyType[tempCC]; ctc.conformingTypePairs _ RefTab.Create[equal: EqualTypePairs, hash: HashTypePairs]; ctc.conformanceTestDepth _ 0; ctc.localCedarTargetWorld _ NIL; ctc.cirioAddressType _ NIL; ctc.cedarNumericTypes _ RefTab.Create[equal: EqualND, hash: HashND]; RETURN[NEW[CirioTypes.CompilerContextBody_[ ctc: ctc, moduleScope: NIL, nameScope: NIL]]]; END; Type: TYPE = REF TypeBody; TypeBody: TYPE = CirioTypes.TypeBody; <<(An indirect type will have indirectType=NIL and targetType#NIL. A direct type will have indirectType#NIL and targetType=NIL.)>> <<>> <<(TypeBody is exported to CirioTypes)>> CreateCedarType: PUBLIC PROC[class: CirioTypes.TypeClass, typeOps, indirectTypeOps: REF CCTypes.CCTypeProcs, cc: CC, procData: REF ANY _ NIL, defaultType: Type _ NIL] RETURNS[Type] = BEGIN adt: Type _ IF defaultType # NIL THEN defaultType ELSE cc.ctc.finalDefaultType; dt: Type _ NEW[TypeBody_[class, typeOps, procData, adt, NIL, NIL]]; it: Type _ NEW[TypeBody_[class, indirectTypeOps, procData, IF adt=NIL THEN NIL ELSE adt.indirectType, NIL, NIL]]; dt.indirectType _ it; it.targetType _ dt; RETURN[dt]; END; <<13-Dec-90 MJS: I surveyed all calls on CreateCedarType, and found that only definition types (created in DefinitionsImpl) supply a non-nil defaultType.>> <<16-Dec-91 MJS: DeferringTypes now also supply non-nil defaultTypes.>> TypeIsntNil: PUBLIC PROC [t: Type, cc: CC] RETURNS [Type] ~ { IF t=NIL THEN CCError[cirioError, "some special type isn't defined yet"]; RETURN[t]}; IsIndirectType: PUBLIC PROC [type: Type] RETURNS [BOOLEAN] = BEGIN IF type.indirectType = NIL THEN RETURN [TRUE] ELSE RETURN [FALSE]; END; GetTargetTypeOfIndirect: PUBLIC PROC[indirectType: Type] RETURNS[Type] = BEGIN IF indirectType.targetType = NIL THEN CCError[cirioError]; RETURN[indirectType.targetType]; END; GetIndirectType: PUBLIC PROC[targetType: Type] RETURNS[Type] = BEGIN IF targetType.indirectType = NIL THEN CCError[cirioError]; RETURN[targetType.indirectType]; END; GetTypeClass: PUBLIC PROC[type: Type] RETURNS[CirioTypes.TypeClass] = { IF type.class # $defer THEN RETURN[type.class]; RETURN GetTypeClass[type.defaultType]}; <> GetProcDataFromType: PUBLIC PROC[type: Type] RETURNS[REF ANY] = { IF type.class # $defer THEN RETURN[type.procData]; RETURN GetProcDataFromType[type.defaultType]}; GetDefaultTypeFromType: PUBLIC PROC[type: Type] RETURNS[Type] = { IF type.class # $defer THEN RETURN[type.defaultType]; RETURN GetDefaultTypeFromType[type.defaultType]}; <<>> <<>> GetGroundTypeClass: PUBLIC PROC [type: Type, cc: CC] RETURNS [CirioTypes.TypeClass] = { groundType: Type _ GetGroundType[type, cc, NIL]; RETURN GetTypeClass[groundType]}; GetProcDataFromGroundType: PUBLIC PROC[type: Type, cc: CC] RETURNS[REF ANY] = { groundType: Type _ GetGroundType[type, cc, NIL]; RETURN GetProcDataFromType[groundType]}; <> FinalDefaultTypeTypeProcs: REF CCTypes.CCTypeProcs _ NEW[CCTypes.CCTypeProcs _[ checkConformance: FinalDefaultCheckConformance, checkFamilyInclusion: FinalDefaultCheckFamilyInclusion, isASingleton: FinalDefaultIsASingleton, storable: FinalDefaultStorable, isAnIndirect: FinalDefaultIsAnIndirect, containsVariance: FinalDefaultContainsVariance, getNVariants: FinalDefaultGetNVariants, coerceToType: FinalDefaultCoerceToType, binaryOperandTypes: FinalDefaultBinaryOperandTypes, loadIdVal: FinalDefaultLoadIdVal, getTypeRepresentation: FinalDefaultGetTypeRepresentation, getGroundType: FinalDefaultGetGroundType, printType: FinalDefaultPrintType]]; <> FinalDefaultCheckConformance: PROC[valType, varType: Type, cc: CC, procData: REF ANY] RETURNS[CCTypes.ConformanceCheck] = {RETURN[IF valType = varType THEN yes ELSE no]}; <> <> <> <> FinalDefaultCheckFamilyInclusion: PROC[valType, varType: Type, cc: CC, procData: REF ANY] RETURNS[BOOLEAN] = {RETURN[IsASingleton[varType, cc] AND Conforms[valType, varType, cc] AND Conforms[varType, valType, cc]]}; FinalDefaultIsASingleton: PROC[type: Type, cc: CC, procData: REF ANY] RETURNS[BOOLEAN] = {RETURN[TRUE]}; FinalDefaultStorable: PROC[valType, indirectType: Type, cc: CC, procData: REF ANY] RETURNS[BOOLEAN] = {RETURN[Conforms[valType, GetLTargetType[indirectType, cc], cc]]}; FinalDefaultIsAnIndirect: PROC[type: Type, cc: CC, procData: REF ANY] RETURNS[BOOLEAN] = {RETURN[FALSE]}; FinalDefaultContainsVariance: PROC[type: Type, cc: CC, procData: REF ANY] RETURNS[BOOLEAN] = {RETURN[FALSE]}; FinalDefaultGetNVariants: PROC[type: Type, cc: CC, procData: REF ANY] RETURNS[INT] = {RETURN[0]}; <> FinalDefaultCoerceToType: PROC[targetType: Type, tc: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] = BEGIN IF CCTypes.Conforms[tc.type, targetType, cc] THEN RETURN[tc] ELSE CCError[operation, "can not coerce to an appropriate type for the given operation"]; END; FinalDefaultBinaryOperandTypes: PROC[op: CedarCode.Operator, left, right: Type, cc: CC, procData: REF ANY] RETURNS[CCTypes.BinaryTargetTypes] = BEGIN rightClass: CirioTypes.TypeClass _ GetGroundTypeClass[right, cc]; SELECT rightClass FROM $wrong, $amnode => RETURN[[right, right]]; ENDCASE => RETURN[[left, right]]; END; <> <<[WARNING: at least when loading frame name scopes, a run time type check should be made. This corresponds to handling union types. Therefore, some of this code will migrate out to the Type object routines?] >> FinalDefaultLoadIdVal: PROC[id: ROPE, targetType: Type, cc: CC, procData: REF ANY] RETURNS[TypedCode] = BEGIN actualNameScope: Node _ cc.nameScope; load: TypedCode _ CCTypes.LoadIdField[id, CedarCode.GetTypeOfNode[actualNameScope], cc]; value: TypedCode _ [ CedarCode.ConcatCode[ CedarCode.CodeToLoadNameScope[], load.code], load.type]; RETURN[value]; END; FinalDefaultGetTypeRepresentation: PROC [type: Type, cc: CC, procData: REF ANY] RETURNS[REF ANY] = {RETURN[type.procData]}; FinalDefaultGetGroundType: PROC [type: Type, cc: CC, procData: REF ANY] RETURNS [Type] = { RETURN [type]; }; FinalDefaultPrintType: PROC [to: IO.STREAM, type: Type, printDepth: INT, printWidth: INT, cc: CC, procData: REF ANY]= { to.PutRope[""]; RETURN}; DefaultIndirectPrintType: PROC [to: IO.STREAM, type: Type, printDepth: INT, printWidth: INT, cc: CC, procData: REF ANY] = { to.PutRope["VAR "]; PrintType[to, GetTargetTypeOfIndirect[type], printDepth-(IF brave THEN 0 ELSE 1), printWidth, cc]; RETURN}; brave: BOOL _ FALSE; CreateAnyTargetType: PROC[cc: CC] RETURNS[Type] = {RETURN[CreateCedarType[$anyTarget, AnyTargetTypeProcs, NIL, cc, NIL]]}; <> AnyTargetTypeProcs: REF CCTypes.CCTypeProcs _ NEW[CCTypes.CCTypeProcs _[ ]]; DefaultIndirectTypeProcs: REF CCTypes.CCTypeProcs _ NEW[CCTypes.CCTypeProcs _[ checkConformance: DefaultIndirectTypeCheckConformance, binaryOperandTypes: DefaultIndirectTypeBinaryOperandTypes, isAnIndirect: DefaultIndirectTypeIsAnIndirect, getRTargetType: DefaultIndirectGetRTargetType, getLTargetType: DefaultIndirectGetLTargetType, operand: DefaultIndirectOperand, coerceToType: DefaultIndirectTypeCoerceToType, unaryOp: DefaultIndirectUnaryOp, store: DefaultIndirectTypeStore, load: DefaultIndirectTypeLoad, getGroundType: FinalDefaultGetGroundType, printType: DefaultIndirectPrintType]]; <> <> DefaultIndirectTypeCheckConformance: PROC[valType, varType: Type, cc: CC, procData: REF ANY] RETURNS[CCTypes.ConformanceCheck] = BEGIN IF NOT CCTypes.IsAnIndirect[varType, cc] THEN RETURN[no] ELSE BEGIN nominalValTarget: Type _ GetRTargetType[valType, cc]; nominalVarTarget: Type _ GetRTargetType[varType, cc]; <> <<>> IF IsASingleton[nominalValTarget, cc] AND IsASingleton[nominalVarTarget, cc] THEN BEGIN conforms1: CCTypes.ConformanceCheck; conforms2: CCTypes.ConformanceCheck; conforms1 _ CCTypes.CheckConformance[nominalValTarget, nominalVarTarget, cc]; IF conforms1 = no THEN RETURN[no]; conforms2 _ CCTypes.CheckConformance[nominalVarTarget, nominalValTarget, cc]; IF conforms2 = no THEN RETURN[no]; IF conforms1 = yes AND conforms2 = yes THEN RETURN[yes]; RETURN[dontKnow]; END ELSE IF CheckFamilyInclusion[nominalValTarget, nominalVarTarget, cc] THEN RETURN[yes] ELSE RETURN[no]; END; END; DefaultIndirectTypeBinaryOperandTypes: PROC[op: CedarCode.Operator, left, right: Type, cc: CC, procData: REF ANY] RETURNS[CCTypes.BinaryTargetTypes] = BEGIN rightClass: CirioTypes.TypeClass _ GetGroundTypeClass[right, cc]; IF rightClass = $wrong OR rightClass = $amnode THEN RETURN[[right, right]]; SELECT op FROM $assign => BEGIN target: Type _ GetRTargetType[left, cc]; IF CCTypes.Conforms[right, target, cc] THEN RETURN[[left, right]] ELSE RETURN[[left, target]]; END; ENDCASE => CCError[typeConformity]; END; DefaultIndirectTypeIsAnIndirect: PROC[type: Type, cc: CC, procData: REF ANY] RETURNS[BOOLEAN] = {RETURN[TRUE]}; DefaultIndirectGetRTargetType: PROC[type: Type, cc: CC, procData: REF ANY] RETURNS[Type] = {RETURN[GetTargetTypeOfIndirect[type]]}; DefaultIndirectGetLTargetType: PROC[type: Type, cc: CC, procData: REF ANY] RETURNS[Type] = BEGIN nominalTarget: Type _ GetTargetTypeOfIndirect[type]; IF IsASingleton[nominalTarget, cc] THEN RETURN[nominalTarget] ELSE RETURN[cc.ctc.emptyType]; END; DefaultIndirectOperand: PROC[op: CedarCode.Operator, lr: CCTypes.LR, tc: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] = BEGIN SELECT op FROM $address => RETURN[tc]; ENDCASE => CCE[operation, "illegal operation"]; -- client error, illegal operation END; <> DefaultIndirectTypeCoerceToType: PROC[targetType: Type, tc: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] = BEGIN IF CCTypes.Conforms[tc.type, targetType, cc] THEN RETURN[tc]; IF GetGroundTypeClass[targetType, cc] = $amnode THEN RETURN[[CedarCode.ConcatCode[tc.code, CedarCode.CodeToMakeAMNode[tc.type]], GetNodeType[cc]]]; CCError[operation, "can not coerce to an appropriate type for given operation"]; END; DefaultIndirectUnaryOp: 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[GetTargetTypeOfIndirect[arg.type], cc, NIL--it's OK to give a NIL bti because the resultant pointer Type will never be asked to CreateIndirectNode or GetBitSize--]; RETURN [[code, ptrType]]; END; ENDCASE => CCE[cirioError]; END; DefaultIndirectTypeStore: PROC[value: TypedCode, indirect: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] = BEGIN code: CirioTypes.Code _ CedarCode.ConcatCode[ indirect.code, CedarCode.ConcatCode[ value.code, CedarCode.CodeToStoreUnpopped[indirect.type, value.type]]]; type: Type _ value.type; <> RETURN[[code, type]]; END; DefaultIndirectTypeLoad: PROC[indirect: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] = BEGIN code: CirioTypes.Code _ CedarCode.ConcatCode[ indirect.code, CedarCode.CodeToLoadThroughIndirect[indirect.type]]; type: Type _ GetRTargetType[indirect.type, cc]; RETURN[[code, type]]; END; <> EmptyData: TYPE = RECORD[fillEmpty: INTEGER]; CreateEmptyType: PROC[cc: CC] RETURNS[Type] = {RETURN[CreateCedarType[$empty, EmptyTypeTypeProcs, EmptyTypeIndirectTypeProcs, cc, NEW[EmptyData_[0]]]]}; EmptyTypeTypeProcs: REF CCTypes.CCTypeProcs _ NEW[CCTypes.CCTypeProcs _[]]; EmptyTypeIndirectTypeProcs: REF CCTypes.CCTypeProcs _ NEW[CCTypes.CCTypeProcs _[]]; <> CCError: PUBLIC ERROR[case: CCTypes.CCErrorCase, msg: ROPE _ NIL] = CODE; GetCedarNumericType: PUBLIC PROC[desc: CedarNumericTypes.NumericDescriptor, cc: CC, insist: BOOL] RETURNS[Type] ~ { ctc: CompilerTypeContext ~ cc.ctc; rnd: REF CedarNumericTypes.NumericDescriptor ~ NEW[CedarNumericTypes.NumericDescriptor _ desc]; t: Type _ NARROW[ctc.cedarNumericTypes.Fetch[rnd].val]; IF insist AND t=NIL THEN { ndr: ROPE ~ CedarNumericTypes.NDFormat[desc]; CCError[cirioError, "fetching undefined numeric type"]}; RETURN[t]}; SetCedarNumericType: PUBLIC PROC[cc: CC, desc: CedarNumericTypes.NumericDescriptor, t: Type] ~ { rnd: REF CedarNumericTypes.NumericDescriptor ~ NEW[CedarNumericTypes.NumericDescriptor _ desc]; news: BOOL _ cc.ctc.cedarNumericTypes.Store[rnd, t]; [] _ GetCedarNumericType[desc, cc, TRUE]; RETURN}; EqualND: PROC [key1, key2: REF ANY] RETURNS [BOOL] ~ { r1: REF CedarNumericTypes.NumericDescriptor ~ NARROW[key1]; r2: REF CedarNumericTypes.NumericDescriptor ~ NARROW[key2]; RETURN CedarNumericTypes.NDEqual[r1^, r2^]}; HashND: PROC [key: REF ANY] RETURNS [CARDINAL] ~ { rnd: REF CedarNumericTypes.NumericDescriptor ~ NARROW[key]; RETURN CedarNumericTypes.NDHash[rnd^]}; GetWrongType: PUBLIC PROC[cc: CC] RETURNS[Type] = {RETURN[cc.ctc.wrongType]}; GetNodeType: PUBLIC PROC[cc: CC] RETURNS[Type] = {RETURN[cc.ctc.nodeType]}; GetBooleanType: PUBLIC PROC[cc: CC] RETURNS[Type] = {RETURN[cc.ctc.booleanType]}; SetBooleanType: PUBLIC PROC[cc: CC, t: Type] = {cc.ctc.booleanType _ t}; GetCharType: PUBLIC PROC[cc: CC] RETURNS[Type] = {RETURN[cc.ctc.charType]}; SetCharType: PUBLIC PROC[cc: CC, t: Type] = {cc.ctc.charType _ t}; GetRopeType: PUBLIC PROC[cc: CC] RETURNS[Type] = {RETURN[cc.ctc.ropeType]}; SetRopeType: PUBLIC PROC[cc: CC, t: Type] = {cc.ctc.ropeType _ t}; GetAnyTargetType: PUBLIC PROC[cc: CC] RETURNS[Type] = {RETURN[cc.ctc.anyTargetType]}; GetRefAnyType: PUBLIC PROC[cc: CC] RETURNS[Type] = {RETURN[cc.ctc.refAnyType]}; SetRefAnyType: PUBLIC PROC[cc: CC, t: Type] = {cc.ctc.refAnyType _ t}; GetNilRefType: PUBLIC PROC[cc: CC] RETURNS[Type] = {RETURN[cc.ctc.nilRefType]}; GetNilPointerType: PUBLIC PROC[cc: CC] RETURNS[Type] = {RETURN[cc.ctc.nilPointerType]}; SetNilPointerType: PUBLIC PROC[cc: CC, t: Type] = {cc.ctc.nilPointerType _ t}; GetAmpersandContextType: PUBLIC PROC[cc: CC] RETURNS[Type] = {RETURN[cc.ctc.ampersandContextType]}; GetAmpersandVarType: PUBLIC PROC[cc: CC] RETURNS[Type] = {RETURN[cc.ctc.ampersandVarType]}; GetNameScopeType: PUBLIC PROC[cc: CC] RETURNS[Type] = {RETURN[CedarCode.GetTypeOfNode[cc.nameScope]]}; <> <> <<(1) do a full scale strongly connected components algorithm. The components are connected together as an acyclic graph. We can now do a depth first walk over the graph. Any component that contains a node marked as knownNotToConform gets all of its nodes marked as knownNotToConform. Any component containing no such node, and from which there is no reachable component containing any such node, can have all of its components marked as knownToConform>> <<(2) Have checkConformity return three cases: yes, dontKnow, and no. Never return yes unless we have explored all reachable nodes. return dontKnow whenever we bump into an onStack node. If any subnode returns no, then we mark our current node as knownNotToConform and return no. If all subnodes return yes, then mark our current node as knownToConform and return yes. If some subnode returns dontKnow, then don't mark our current node, and return dontKnow. If we return from the top level with dontKnow, then we are safe in marking that top level node as knownToConform, and returning yes. (In effect here, we know that when we return from the top level node we have explored its entire strongly connected component. We dont know this when we return from any other node.)>> <<(3) like 2, except that when we find ourselves marking the top level node as knownToConform, then revisit all reachable nodes and mark them as knownToConform. (This is Demer's proposed scheme.)>> <<>> <> <<>> CheckConformity: PROC[valType, varType: CirioTypes.Type, continueCheck: PROC RETURNS[CCTypes.ConformanceCheck], cc: CC] RETURNS[CCTypes.ConformanceCheck] = BEGIN pair: TypePair _ NEW[TypePairBody_[valType, varType]]; markRef: REF PairMark _ NARROW[RefTab.Fetch[cc.ctc.conformingTypePairs, pair].val]; IF markRef = NIL THEN BEGIN markRef _ NEW[PairMark _ notKnown]; IF NOT RefTab.Store[cc.ctc.conformingTypePairs, pair, markRef] THEN CCError[cirioError]; END; IF markRef^ = currentlyUnderTest THEN BEGIN IF cc.ctc.conformanceTestDepth = 0 THEN CCError[cirioError]; -- shouldn't happen RETURN[dontKnow]; END; IF markRef^ = notKnown THEN BEGIN result: CCTypes.ConformanceCheck; markRef^ _ currentlyUnderTest; cc.ctc.conformanceTestDepth _ cc.ctc.conformanceTestDepth+1; result _ continueCheck[ !UNWIND => BEGIN -- uh oh, we had better clean up cc.ctc.conformanceTestDepth _ cc.ctc.conformanceTestDepth-1; IF markRef^ # currentlyUnderTest THEN ERROR; -- I don't even want to think about this possibility! markRef^ _ notKnown; END]; cc.ctc.conformanceTestDepth _ cc.ctc.conformanceTestDepth-1; IF markRef^ # currentlyUnderTest THEN CCError[cirioError]; markRef^ _ SELECT result FROM yes => knownToConform, no => knownNotToConform, dontKnow => IF cc.ctc.conformanceTestDepth = 0 THEN knownToConform ELSE notKnown, ENDCASE => CCError[cirioError]; IF result = dontKnow AND cc.ctc.conformanceTestDepth = 0 THEN result _ yes; RETURN[result]; END; RETURN[SELECT markRef^ FROM knownToConform => yes, knownNotToConform => no, ENDCASE => CCError[cirioError]]; END; PairMark: TYPE = {currentlyUnderTest, knownToConform, knownNotToConform, notKnown}; TypePair: TYPE = REF TypePairBody; TypePairBody: TYPE = RECORD[valType, varType: CirioTypes.Type]; EqualTypePairs: PROC[key1, key2: RefTab.Key] RETURNS[BOOL] = BEGIN pair1: TypePair _ NARROW[key1]; pair2: TypePair _ NARROW[key2]; RETURN[(pair1.valType = pair2.valType) AND (pair1.varType = pair2.varType)]; END; HashTypePairs: PROC[key: RefTab.Key] RETURNS[CARDINAL] = BEGIN pair: TypePair _ NARROW[key]; RETURN[Basics.BITXOR[ Basics.BITXOR[ Basics.HighHalf[LOOPHOLE[pair.valType, CARD32]], Basics.LowHalf[LOOPHOLE[pair.valType, CARD32]]], Basics.BITXOR[ Basics.HighHalf[LOOPHOLE[pair.varType, CARD32]], Basics.LowHalf[LOOPHOLE[pair.varType, CARD32]]]]]; END; <> TryStandardCoercion: PUBLIC PROC[targetType: CirioTypes.Type, tc: TypedCode, continueCoerce: PROC RETURNS[TypedCode], cc: CC] RETURNS[TypedCode] = BEGIN IF CCTypes.Conforms[tc.type, targetType, cc] THEN RETURN[tc] ELSE BEGIN targetClass: CirioTypes.TypeClass _ GetGroundTypeClass[targetType, cc]; SELECT targetClass FROM $wrong => RETURN[[tc.code, GetWrongType[cc]]]; $amnode => RETURN[[CedarCode.ConcatCode[tc.code, CedarCode.CodeToMakeAMNode[tc.type]], GetNodeType[cc]]]; ENDCASE => BEGIN newtc: TypedCode _ continueCoerce[]; IF NOT CCTypes.Conforms[newtc.type, targetType, cc] THEN CCE[cirioError]; RETURN[newtc]; END; END; END; <> <<>> RegisterLocalCedarTargetWorld: PUBLIC PROC[lctw: CCTypes.LocalCedarTargetWorld, cc: CC] = BEGIN IF cc.ctc.localCedarTargetWorld # NIL THEN CCE[cirioError]; cc.ctc.localCedarTargetWorld _ lctw; BEGIN address: CirioTypes.CirioAddress _ NEW[CirioTypes.CirioAddressBody_[NIL, NIL, NIL, NIL, NIL]]; cirioAddressType: CirioTypes.Type _ InnerGetTypeForCirioAddress[address, cc]; cc.ctc.cirioAddressType _ cirioAddressType; END; END; <> InnerGetTypeForCirioAddress: PROC[dum: CirioTypes.CirioAddress, cc: CC] RETURNS[CirioTypes.Type] = BEGIN indirectFrameForSelf: CirioTypes.Node _ CCTypes.CreateFrameNodeForSelf[cc]; indirectTypeForSelf: CirioTypes.Type _ CedarCode.GetTypeOfNode[indirectFrameForSelf]; indirectArgs: CirioTypes.Node _ CedarCode.SelectFieldFromNode["&args", indirectTypeForSelf, indirectFrameForSelf, cc]; indirectTypeForArgs: CirioTypes.Type _ CedarCode.GetTypeOfNode[indirectArgs]; indirectDum: CirioTypes.Node _ CedarCode.SelectFieldFromNode["dum", indirectTypeForArgs, indirectArgs, cc]; indirectDumType: CirioTypes.Type _ CedarCode.GetTypeOfNode[indirectDum]; dumType: CirioTypes.Type _ CCTypes.GetTargetTypeOfIndirect[indirectDumType]; RETURN[dumType] END; <> OldRegisterLocalCedarTargetWorld: PUBLIC PROC[lctw: CCTypes.LocalCedarTargetWorld, cc: CC] = BEGIN IF cc.ctc.localCedarTargetWorld # NIL THEN CCE[cirioError]; cc.ctc.localCedarTargetWorld _ lctw; BEGIN dummyCirioAddessNode: Node _ CreateNodeFromRefAny[NEW[CirioTypes.CirioAddress_NIL], cc]; cirioAddressType: Type _ CedarCode.GetTypeOfNode[dummyCirioAddessNode]; cc.ctc.cirioAddressType _ cirioAddressType; END; END; CreateNodeFromRefAny: PUBLIC PROC[refAny: REF ANY, cc: CC] RETURNS[Node] = BEGIN IF cc.ctc.localCedarTargetWorld = NIL THEN CCE[cirioError]; RETURN[cc.ctc.localCedarTargetWorld.createNodeFromRefAny[refAny, cc.ctc.localCedarTargetWorld, cc]]; END; CreateFrameNodeForSelf: PUBLIC PROC[cc: CC] RETURNS[Node] = BEGIN ourselves: Node _ cc.ctc.localCedarTargetWorld.createFrameNodeForSelf[cc.ctc.localCedarTargetWorld, cc]; ourType: Type _ CedarCode.GetTypeOfNode[ourselves]; RETURN[CedarCode.ExtractFieldFromNode["&caller", ourType, ourselves, cc]]; END; GetCirioAddressType: PUBLIC PROC[cc: CC] RETURNS[Type] = {IF cc.ctc.cirioAddressType = NIL THEN CCError[cirioError] ELSE RETURN[cc.ctc.cirioAddressType]}; <> Conforms: PUBLIC PROC[valType, varType: Type, cc: CC, oc: Type _ NIL] RETURNS[BOOLEAN] = BEGIN result: CCTypes.ConformanceCheck _ CheckConformance[valType, varType, cc, oc]; IF result = dontKnow THEN CCE[cirioError]; RETURN[result = yes]; END; CheckConformance: PUBLIC PROC[valType, varType: Type, cc: CC, oc: Type _ NIL] RETURNS[CCTypes.ConformanceCheck] = { ConformsInner: PROC RETURNS[CCTypes.ConformanceCheck] = {RETURN[CheckConformanceMain[valType, varType, cc, oc]]}; ans: CCTypes.ConformanceCheck ~ CheckConformity[valType, varType, ConformsInner, cc]; IF ans=no THEN someNotConform _ TRUE; RETURN [ans]}; someNotConform: BOOL _ FALSE; <> <> CheckConformanceMain: PROC[valType, varType: Type, cc: CC, oc: Type _ NIL] RETURNS[CCTypes.ConformanceCheck] = BEGIN groundValType: Type _ GetGroundType[valType, cc, oc]; groundVarType: Type _ GetGroundType[varType, cc, oc]; ct: Type _ IF oc # NIL THEN oc ELSE valType; IF ct.procs = NIL OR ct.procs.checkConformance = NIL THEN {IF ct.defaultType = NIL THEN CCE[cirioError, "some type can't check conformance"] ELSE RETURN[CheckConformanceMain[groundValType, groundVarType, cc, ct.defaultType]]} ELSE RETURN[ct.procs.checkConformance[groundValType, groundVarType, cc, ct.procData]] END; <> <> CheckFamilyInclusion: PUBLIC PROC[valType, varType: Type, cc: CC, oc: Type _ NIL] RETURNS[BOOLEAN] = BEGIN groundValType: Type _ GetGroundType[valType, cc, oc]; groundVarType: Type _ GetGroundType[varType, cc, oc]; ct: Type _ IF oc # NIL THEN oc ELSE valType; IF ct.procs = NIL OR ct.procs.checkFamilyInclusion = NIL THEN {IF ct.defaultType = NIL THEN CCE[cirioError] ELSE RETURN[CheckFamilyInclusion[groundValType, groundVarType, cc, ct.defaultType]]} ELSE { ans: BOOL ~ ct.procs.checkFamilyInclusion[groundValType, groundVarType, cc, ct.procData]; IF NOT ans THEN someFamilyNotIncluded _ TRUE; RETURN [ans]}; END; someFamilyNotIncluded: BOOL _ FALSE; IsASingleton: PUBLIC PROC[type: Type, cc: CC, oc: Type _ NIL] RETURNS[BOOLEAN] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE type; IF ct.procs = NIL OR ct.procs.isASingleton = NIL THEN {IF ct.defaultType = NIL THEN CCE[cirioError] ELSE RETURN[IsASingleton[type, cc, ct.defaultType]]} ELSE RETURN[ct.procs.isASingleton[type, cc, ct.procData]] END; Storable: PUBLIC PROC[valType, indirectType: Type, cc: CC, oc: Type _ NIL] RETURNS[BOOLEAN] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE valType; IF ct.procs = NIL OR ct.procs.storable = NIL THEN {IF ct.defaultType = NIL THEN CCE[cirioError] ELSE RETURN[Storable[valType, indirectType, cc, ct.defaultType]]} ELSE RETURN[ct.procs.storable[valType, indirectType, cc, ct.procData]] END; <<>> BinaryOperandTypes: PUBLIC PROC[op: Operator, left, right: Type, cc: CC, oc: Type] RETURNS[CCTypes.BinaryTargetTypes] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE left; IF ct.procs = NIL OR ct.procs.binaryOperandTypes = NIL THEN {IF ct.defaultType = NIL THEN CCE[operation] ELSE RETURN[BinaryOperandTypes[op, left, right, cc, ct.defaultType]]} ELSE RETURN[ct.procs.binaryOperandTypes[op, left, right, cc, ct.procData]] END; IsAnIndirect: PUBLIC PROC[type: Type, cc: CC, oc: Type] RETURNS[BOOLEAN] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE type; IF ct.procs = NIL OR ct.procs.isAnIndirect = NIL THEN {IF ct.defaultType = NIL THEN CCE[operation] ELSE RETURN[IsAnIndirect[type, cc, ct.defaultType]]} ELSE RETURN[ct.procs.isAnIndirect[type, cc, ct.procData]]; END; GetRTargetType: PUBLIC PROC[type: Type, cc: CC, oc: Type _ NIL] RETURNS[Type] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE type; IF ct.procs = NIL OR ct.procs.getRTargetType = NIL THEN {IF ct.defaultType = NIL THEN CCE[operation] ELSE RETURN[GetRTargetType[type, cc, ct.defaultType]]} ELSE RETURN[ct.procs.getRTargetType[type, cc, ct.procData]]; END; GetLTargetType: PUBLIC PROC[type: Type, cc: CC, oc: Type _ NIL] RETURNS[Type] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE type; IF ct.procs = NIL OR ct.procs.getLTargetType = NIL THEN {IF ct.defaultType = NIL THEN CCE[operation] ELSE RETURN[GetLTargetType[type, cc, ct.defaultType]]} ELSE RETURN[ct.procs.getLTargetType[type, cc, ct.procData]]; END; GetFieldsType: PUBLIC PROC[rcdType: Type, cc: CC, oc: Type] RETURNS[Type] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE rcdType; IF ct.procs = NIL OR ct.procs.getFieldsType = NIL THEN {IF ct.defaultType = NIL THEN CCE[operation] ELSE RETURN[GetFieldsType[rcdType, cc, ct.defaultType]]} ELSE RETURN[ct.procs.getFieldsType[rcdType, cc, ct.procData]]; END; GetRefType: PUBLIC PROC[rhs: Type, cc: CC, oc: Type] RETURNS[Type] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE rhs; IF ct.procs = NIL OR ct.procs.getRefType = NIL THEN {IF ct.defaultType = NIL THEN CCE[operation] ELSE RETURN[GetRefType[rhs, cc, ct.defaultType]]} ELSE RETURN[ct.procs.getRefType[rhs, cc, ct.procData]]; END; HasIdField: PUBLIC PROC[id: ROPE, fieldContext: Type, cc: CC, oc: Type _ NIL] RETURNS[CCTypes.IdFieldCase] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE fieldContext; IF ct.procs = NIL OR ct.procs.hasIdField = NIL THEN {IF ct.defaultType = NIL THEN CCE[operation] ELSE RETURN[HasIdField[id, fieldContext, cc, ct.defaultType]]} ELSE RETURN[ct.procs.hasIdField[id, fieldContext, cc, ct.procData]]; END; ContainsVariance: PUBLIC PROC[type: Type, cc: CC, oc: Type _ NIL] RETURNS[BOOLEAN] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE type; IF ct.procs = NIL OR ct.procs.containsVariance = NIL THEN {IF ct.defaultType = NIL THEN CCE[operation] ELSE RETURN[ContainsVariance[type, cc, ct.defaultType]]} ELSE RETURN[ct.procs.containsVariance[type, cc, ct.procData]]; END; GetNVariants: PUBLIC PROC[type: Type, cc: CC, oc: Type _ NIL] RETURNS[INT] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE type; IF ct.procs = NIL OR ct.procs.getNVariants = NIL THEN {IF ct.defaultType = NIL THEN CCE[operation] ELSE RETURN[GetNVariants[type, cc, ct.defaultType]]} ELSE RETURN[ct.procs.getNVariants[type, cc, ct.procData]]; END; AsIndexSet: PUBLIC PROC[type: Type, cc: CC, oc: Type] RETURNS[Type] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE type; IF ct.procs = NIL OR ct.procs.asIndexSet = NIL THEN {IF ct.defaultType = NIL THEN CCE[operation] ELSE RETURN[AsIndexSet[type, cc, ct.defaultType]]} ELSE RETURN[ct.procs.asIndexSet[type, cc, ct.procData]]; END; Operand: PUBLIC PROC[op: Operator, lr: CCTypes.LR, tc: TypedCode, cc: CC, oc: Type] RETURNS[TypedCode] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE tc.type; IF ct.procs = NIL OR ct.procs.operand = NIL THEN {IF ct.defaultType = NIL THEN CCE[operation, IO.PutFR["Unable to determine operand type for op %g and TYPE %g", [atom[op]], [rope[FmtType[tc.type, 2, 16, cc]]] ]] ELSE RETURN[Operand[op, lr, tc, cc, ct.defaultType]]} ELSE RETURN[ct.procs.operand[op, lr, tc, cc, ct.procData]]; END; ApplyOperand: PUBLIC PROC[operatorType: Type, operand: CirioSyntacticOperations.ParseTree, cc: CC, oc: Type _ NIL] RETURNS[TypedCode] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE operatorType; IF ct.procs = NIL OR ct.procs.applyOperand = NIL THEN {IF ct.defaultType = NIL THEN CCE[operation] ELSE RETURN[ApplyOperand[operatorType, operand, cc, ct.defaultType]]} ELSE RETURN[ct.procs.applyOperand[operatorType, operand, cc, ct.procData]]; END; IndexOperand: PUBLIC PROC[operatorType: Type, operand: CirioSyntacticOperations.ParseTree, cc: CC, oc: Type _ NIL] RETURNS[TypedCode] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE operatorType; IF ct.procs = NIL OR ct.procs.indexOperand = NIL THEN {IF ct.defaultType = NIL THEN CCE[operation] ELSE RETURN[IndexOperand[operatorType, operand, cc, ct.defaultType]]} ELSE RETURN[ct.procs.indexOperand[operatorType, operand, cc, ct.procData]]; END; CoerceToType: PUBLIC PROC[targetType: Type, tc: TypedCode, cc: CC, oc: Type] RETURNS[TypedCode] = BEGIN CoerceToTypeInner: PROC RETURNS[TypedCode] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE tc.type; IF ct.procs = NIL OR ct.procs.coerceToType = NIL THEN {IF ct.defaultType = NIL THEN CCE[operation, IO.PutFR["Unable to coerce TYPE %g to %g", [rope[FmtType[tc.type, 3, 16, cc]]], [rope[FmtType[targetType, 3, 16, cc]]] ]] ELSE RETURN[CoerceToType[targetType, tc, cc, ct.defaultType]]} ELSE RETURN[ct.procs.coerceToType[targetType, tc, cc, ct.procData]]; END; RETURN[TryStandardCoercion[targetType, tc, CoerceToTypeInner, cc]]; END; BinaryOp: PUBLIC PROC[op: Operator, left, right: TypedCode, cc: CC, oc: Type] RETURNS[TypedCode] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE left.type; IF ct.procs = NIL OR ct.procs.binaryOp = NIL THEN {IF ct.defaultType = NIL THEN CCE[operation, IO.PutFR["Binary operation %g not implemented for TYPE %g", [atom[op]], [rope[FmtType[left.type, 2, 10, cc]]] ]] ELSE RETURN[BinaryOp[op, left, right, cc, ct.defaultType]]} ELSE RETURN[ct.procs.binaryOp[op, left, right, cc, ct.procData]]; END; UnaryOp: PUBLIC PROC[op: Operator, arg: TypedCode, cc: CC, oc: Type] RETURNS[TypedCode] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE arg.type; IF ct.procs = NIL OR ct.procs.unaryOp = NIL THEN {IF ct.defaultType = NIL THEN CCE[operation, IO.PutFR["Unary operation %g not implemented for TYPE %g", [atom[op]], [rope[FmtType[arg.type, 2, 10, cc]]] ]] ELSE RETURN[UnaryOp[op, arg, cc, ct.defaultType]]} ELSE RETURN[ct.procs.unaryOp[op, arg, cc, ct.procData]]; END; NAryOperandType: PUBLIC PROC[op: Operator, typeSoFar, nextType: Type, cc: CC, oc: Type] RETURNS[Type] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE typeSoFar; IF ct.procs = NIL OR ct.procs.nAryOperandType = NIL THEN {IF ct.defaultType = NIL THEN CCE[operation] ELSE RETURN[NAryOperandType[op, typeSoFar, nextType, cc, ct.defaultType]]} ELSE RETURN[ct.procs.nAryOperandType[op, typeSoFar, nextType, cc, ct.procData]]; END; NAryOp: PUBLIC PROC[op: Operator, args: LIST OF TypedCode, cc: CC, oc: Type] RETURNS[TypedCode] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE args.first.type; IF ct.procs = NIL OR ct.procs.nAryOp = NIL THEN {IF ct.defaultType = NIL THEN CCE[operation] ELSE RETURN[NAryOp[op, args, cc, ct.defaultType]]} ELSE RETURN[ct.procs.nAryOp[op, args, cc, ct.procData]]; END; TypeOp: PUBLIC PROC[op: Operator, type: Type, cc: CC, oc: Type] RETURNS[TypedCode] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE type; IF ct.procs = NIL OR ct.procs.typeOp = NIL THEN {IF ct.defaultType = NIL THEN CCE[operation] ELSE RETURN[TypeOp[op, type, cc, ct]]} ELSE RETURN[ct.procs.typeOp[op, type, cc, ct.procData]]; END; TypeOp2OperandType: PUBLIC PROC[op: Operator, type: Type, cc: CC, oc: Type] RETURNS[Type] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE type; IF ct.procs = NIL OR ct.procs.typeOp2OperandType = NIL THEN {IF ct.defaultType = NIL THEN CCE[operation] ELSE RETURN[TypeOp2OperandType[op, type, cc, ct.defaultType]]} ELSE RETURN[ct.procs.typeOp2OperandType[op, type, cc, ct.procData]]; END; TypeOp2: PUBLIC PROC[op: Operator, type: Type, arg: TypedCode, cc: CC, oc: Type] RETURNS[TypedCode] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE type; IF ct.procs = NIL OR ct.procs.typeOp2 = NIL THEN {IF ct.defaultType = NIL THEN CCE[operation] ELSE RETURN[TypeOp2[op, type, arg, cc, ct.defaultType]]} ELSE RETURN[ct.procs.typeOp2[op, type, arg, cc, ct]]; END; Constructor: PUBLIC PROC[list: LIST OF CirioSyntacticOperations.ParseTree, targetType: Type, cc: CC, oc: Type] RETURNS[TypedCode] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE targetType; IF ct.procs = NIL OR ct.procs.constructor = NIL THEN {IF ct.defaultType = NIL THEN CCE[operation] ELSE RETURN[Constructor[list, targetType, cc, ct.defaultType]]} ELSE RETURN[ct.procs.constructor[list, targetType, cc, ct.procData]]; END; PairConstructor: PUBLIC PROC[list: LIST OF CirioSyntacticOperations.NameArgPair, targetType: Type, cc: CC, oc: Type] RETURNS[TypedCode] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE targetType; IF ct.procs = NIL OR ct.procs.pairConstructor = NIL THEN {IF ct.defaultType = NIL THEN CCE[operation] ELSE RETURN[PairConstructor[list, targetType, cc, ct.defaultType]]} ELSE RETURN[ct.procs.pairConstructor[list, targetType, cc, ct.procData]]; END; Store: PUBLIC PROC[value: TypedCode, indirect: TypedCode, cc: CC, oc: Type] RETURNS[TypedCode] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE indirect.type; IF ct.procs = NIL OR ct.procs.store = NIL THEN {IF ct.defaultType = NIL THEN CCE[operation] ELSE RETURN[Store[value, indirect, cc, ct.defaultType]]} ELSE RETURN[ct.procs.store[value, indirect, cc, ct.procData]]; END; Load: PUBLIC PROC[indirect: TypedCode, cc: CC, oc: Type] RETURNS[TypedCode] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE indirect.type; IF ct.procs = NIL OR ct.procs.load = NIL THEN {IF ct.defaultType = NIL THEN CCE[operation] ELSE RETURN[Load[indirect, cc, ct.defaultType]]} ELSE RETURN[ct.procs.load[indirect, cc, ct.procData]]; END; ExtractIdField: PUBLIC PROC[id: ROPE, fieldContext: Type, cc: CC, oc: Type] RETURNS[TypedCode] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE fieldContext; IF ct.procs = NIL OR ct.procs.extractIdField = NIL THEN {IF ct.defaultType = NIL THEN CCE[operation] ELSE RETURN[ExtractIdField[id, fieldContext, cc, ct.defaultType]]} ELSE RETURN[ct.procs.extractIdField[id, fieldContext, cc, ct.procData]]; END; LoadIdVal: PUBLIC PROC[id: ROPE, targetType: Type, cc: CC, oc: Type] RETURNS[TypedCode] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE targetType; IF ct.procs = NIL OR ct.procs.loadIdVal = NIL THEN {IF ct.defaultType = NIL THEN CCE[operation] ELSE RETURN[LoadIdVal[id, targetType, cc, ct.defaultType]]} ELSE RETURN[ct.procs.loadIdVal[id, targetType, cc, ct.procData]]; END; SelectIdField: PUBLIC PROC[id: ROPE, fieldIndirectContext: Type, cc: CC, oc: Type] RETURNS[TypedCode] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE fieldIndirectContext; IF ct.procs = NIL OR ct.procs.selectIdField = NIL THEN {IF ct.defaultType = NIL THEN CCE[operation] ELSE RETURN[SelectIdField[id, fieldIndirectContext, cc, ct.defaultType]]} ELSE RETURN[ct.procs.selectIdField[id, fieldIndirectContext, cc, ct.procData]]; END; LoadIdField: PUBLIC PROC[id: ROPE, fieldIndirectContext: Type, cc: CC, oc: Type] RETURNS[TypedCode] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE fieldIndirectContext; IF ct.procs = NIL OR ct.procs.loadIdField = NIL THEN {IF ct.defaultType = NIL THEN CCE[operation] ELSE RETURN[LoadIdField[id, fieldIndirectContext, cc, ct.defaultType]]} ELSE RETURN[ct.procs.loadIdField[id, fieldIndirectContext, cc, ct.procData]]; END; Apply: PUBLIC PROC[operator: TypedCode, operand: TypedCode, cc: CC, oc: Type _ NIL] RETURNS[TypedCode] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE operator.type; IF ct.procs = NIL OR ct.procs.apply = NIL THEN {IF ct.defaultType = NIL THEN CCE[operation] ELSE RETURN[Apply[operator, operand, cc, ct.defaultType]]} ELSE RETURN[ct.procs.apply[operator, operand, cc, ct.procData]]; END; Index: PUBLIC PROC[operator: TypedCode, operand: TypedCode, cc: CC, oc: Type _ NIL] RETURNS[TypedCode] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE operator.type; IF ct.procs = NIL OR ct.procs.index = NIL THEN {IF ct.defaultType = NIL THEN CCE[operation] ELSE RETURN[Index[operator, operand, cc, ct.defaultType]]} ELSE RETURN[ct.procs.index[operator, operand, cc, ct.procData]]; END; GetTypeRepresentation: PUBLIC PROC[type: Type, cc: CC, oc: Type _ NIL] RETURNS[REF ANY] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE type; IF ct.procs = NIL OR ct.procs.getTypeRepresentation = NIL THEN {IF ct.defaultType = NIL THEN CCE[operation] ELSE RETURN[GetTypeRepresentation[type, cc, ct.defaultType]]} ELSE RETURN[ct.procs.getTypeRepresentation[type, cc, ct.procData]]; END; GetNElements: PUBLIC PROC[type: Type, cc: CC, oc: Type _ NIL] RETURNS[CARD] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE type; IF ct.procs = NIL OR ct.procs.getNElements = NIL THEN {IF ct.defaultType = NIL THEN CCE[operation, "some Type doesn't know how to getNElements"] ELSE RETURN[GetNElements[type, cc, ct.defaultType]]} ELSE RETURN[ct.procs.getNElements[type, cc, ct.procData]]; END; GetScopeIndex: PUBLIC PROC [type: Type, cc: CC, oc: Type _ NIL] RETURNS [CARD] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE type; IF ct.procs = NIL OR ct.procs.getScopeIndex = NIL THEN {IF ct.defaultType = NIL THEN CCE[operation] ELSE RETURN[GetScopeIndex[type, cc, ct.defaultType]]} ELSE RETURN[ct.procs.getScopeIndex[type, cc, ct.procData]]; END; GetGroundType: PUBLIC PROC[type: Type, cc: CC, oc: Type _ NIL] RETURNS[Type] = BEGIN ct: Type _ IF oc # NIL THEN oc ELSE type; IF ct.procs = NIL OR ct.procs.getGroundType = NIL THEN {IF ct.defaultType = NIL THEN CCE[operation] ELSE RETURN[GetGroundType[type, cc, ct.defaultType]]} ELSE RETURN[ct.procs.getGroundType[type, cc, ct.procData]]; END; FmtType: PROC [type: Type, printDepth: INT, printWidth: INT, cc: CC, oc: Type _ NIL] RETURNS [ans: ROPE] = { ENABLE CCE => {ans _ "??"; CONTINUE}; buf1: IO.STREAM ~ IO.ROS[]; PrintType[buf1, type, printDepth, printWidth, cc, oc]; RETURN [buf1.RopeFromROS]}; PrintType: PUBLIC PROC[to: IO.STREAM, type: Type, printDepth, printWidth: INT, cc: CC, oc: Type _ NIL] = { ct: Type _ IF oc # NIL THEN oc ELSE type; IF printDepth<0 THEN {to.PutRope[".."]; RETURN}; IF ct.procs = NIL OR ct.procs.printType = NIL THEN {IF ct.defaultType = NIL THEN CCE[cirioError, IO.PutFR["a type of class %g doesn't know how to print itself", [atom[type.class]] ]] ELSE PrintType[to, type, printDepth, printWidth, cc, ct.defaultType]} ELSE ct.procs.printType[to, type, printDepth, printWidth, cc, ct.procData]; }; sia: PUBLIC INT _ 3; DoObject: PUBLIC PROC [to: IO.STREAM, printit: PROC] ~ { SS.Begin[to]; printit[!UNWIND => SS.End[to]]; SS.End[to]; RETURN}; BreakObject: PUBLIC PROC [to: IO.STREAM, printit: PROC, sep: ROPE _ NIL] ~ { SS.Bp[to, lookLeft, sia, sep]; DoObject[to, printit]; RETURN}; PrintTypeBracketed: PUBLIC PROC[to: IO.STREAM, type: Type, printDepth: INT, printWidth: INT, cc: CC, oc: Type _ NIL] = { SS.Begin[to]; PrintType[to, type, printDepth, printWidth, cc, oc !UNWIND => SS.End[to]]; SS.End[to]; RETURN}; BreakPrintType: PUBLIC PROC[to: IO.STREAM, type: Type, printDepth, printWidth: INT, cc: CC, sep: ROPE _ NIL, oc: Type _ NIL] = { InnerPrint: PROC ~ {PrintType[to, type, printDepth, printWidth, cc, oc]}; BreakObject[to, InnerPrint, sep]}; GetIndirectCreateNode: PUBLIC PROC[targetType: Type, mem: Mem, cc: CC] RETURNS[Node] ~ { indirectType: Type ~ GetIndirectType[targetType]; RETURN CreateIndirectNode[indirectType, mem, cc]}; CreateIndirectNode: PUBLIC PROC[indirectType: Type, mem: Mem, cc: CC, oc: Type _ NIL] RETURNS[Node] ~ { ct: Type _ IF oc # NIL THEN oc ELSE indirectType; IF ct.procs#NIL AND ct.procs.createIndirectNode#NIL THEN { targetType: Type ~ GetTargetTypeOfIndirect[indirectType]; RETURN ct.procs.createIndirectNode[cc, ct.procData, indirectType, targetType, mem]}; IF ct.defaultType=NIL THEN CCE[cirioError, "some type doesn't know how to create an indirect node"]; RETURN CreateIndirectNode[indirectType, mem, cc, ct.defaultType]}; GetBitSize: PUBLIC PROC[indirectType: Type, cc: CC, oc: Type _ NIL] RETURNS[CARD] ~ { ct: Type _ IF oc # NIL THEN oc ELSE indirectType; IF ct.procs#NIL AND ct.procs.getBitSize#NIL THEN { targetType: Type ~ GetTargetTypeOfIndirect[indirectType]; RETURN ct.procs.getBitSize[indirectType, targetType, cc, ct.procData]}; IF ct.defaultType=NIL THEN { asRope: ROPE _ FmtType[indirectType, 3, 32, cc]; CCE[cirioError, Rope.Cat["some type doesn't know how to compute its bit size (", asRope, ")"]]}; RETURN GetBitSize[indirectType, cc, ct.defaultType]}; <> <> CompoundNameScopeInfo: TYPE = REF CompoundNameScopeInfoBody; MaxNumberOfTWContext: CARDINAL = 16; CompoundNameScopeInfoBody: TYPE = RECORD[ ampersandContext1: Node, ampersandContext2: Node, scopeIndex: CARDINAL, targetWorldContexts: ARRAY [1..MaxNumberOfTWContext] OF Node]; <> <<>> <> <> <<>> <> CreateCompoundNameScope: PUBLIC PROC[ampersandContext1, ampersandContext2, targetWorldContext: Node, cc: CC] RETURNS[Node] = BEGIN contextType: Type _ CedarCode.GetTypeOfNode[targetWorldContext]; scopeIndex: CARDINAL _ CCTypes.GetScopeIndex[contextType, cc]; info: CompoundNameScopeInfo _ NEW[CompoundNameScopeInfoBody]; type: Type _ CreateCedarType[$compoundNameScope, NIL, CompoundNameScopeTypeOps, cc, info]; node: Node _ CedarCode.CreateCedarNode[CompoundNameScopeNodeOps, GetIndirectType[type], info]; info.ampersandContext1 _ ampersandContext1; info.ampersandContext2 _ ampersandContext2; IF scopeIndex > MaxNumberOfTWContext THEN CCE[cirioError] ELSE info.scopeIndex _ scopeIndex; info.targetWorldContexts[scopeIndex] _ targetWorldContext; FOR i: CARDINAL DECREASING IN [1..scopeIndex) DO info.targetWorldContexts[i] _ CedarCode.AdvanceNameScope[info.targetWorldContexts[i+1], cc]; ENDLOOP; RETURN[node]; END; CompoundNameScopeTypeOps: REF CCTypes.CCTypeProcs _ NEW[CCTypes.CCTypeProcs _[ selectIdField: CompoundNameScopeSelectIdField, loadIdField: CompoundNameScopeLoadIdField]]; CompoundNameScopeSelectIdField: PROC[id: ROPE, fieldIndirectContext: Type, cc: CC, procData: REF ANY] RETURNS[TypedCode] = BEGIN info: CompoundNameScopeInfo _ NARROW[procData]; SELECT Rope.Fetch[id, 0] FROM '&, '_ => {-- we are expected to look into the ampersand contexts <> <<(AmpersandVars always contain Nodes)>> code: CirioTypes.Code _ CedarCode.CodeToSelectField[id, GetAmpersandContextType[cc]]; type: Type _ GetAmpersandVarType[cc]; RETURN[[ CedarCode.ConcatCode[ CedarCode.CodeToGetNameContext[0], code], type]]}; ENDCASE => {-- we are expected to look into the targetWorldContext <> type: Type _ CedarCode.GetTypeOfNode[info.targetWorldContexts[info.scopeIndex]]; select: TypedCode _ CCTypes.SelectIdField[id, type, cc]; RETURN [select]}; END; CompoundNameScopeLoadIdField: PROC[id: ROPE, fieldIndirectContext: Type, cc: CC, procData: REF ANY] RETURNS[TypedCode] = BEGIN info: CompoundNameScopeInfo _ NARROW[procData]; SELECT Rope.Fetch[id, 0] FROM '&, '_ => {-- we are expected to look into the ampersand contexts <> <<(AmpersandVars always contain Nodes)>> varType: Type _ GetAmpersandVarType[cc]; code: CirioTypes.Code _ CedarCode.ConcatCode[ CedarCode.CodeToSelectField[id, GetAmpersandContextType[cc]], CedarCode.CodeToLoadThroughIndirect[varType]]; RETURN[[code, GetTargetTypeOfIndirect[varType]]]}; ENDCASE => {-- we are expected to look into the targetWorldContext <> type: Type _ CedarCode.GetTypeOfNode[info.targetWorldContexts[info.scopeIndex]]; load: TypedCode _ CCTypes.LoadIdField[id, type, cc]; RETURN [load]}; END; CompoundNameScopeNodeOps: REF CedarCode.OperationsBody _ NEW[CedarCode.OperationsBody_[ getNameContext: CompoundNameScopeGetNameContext, selectField: CompoundNameScopeSelectField, show: CompoundNameScopeShow]]; CompoundNameScopeGetNameContext: PROC [scopeIndex: CARDINAL, node: Node, cc: CC] RETURNS [Node] = BEGIN nsInfo: CompoundNameScopeInfo _ NARROW[CedarCode.GetDataFromNode[node]]; IF scopeIndex = 0 THEN RETURN [node] ELSE RETURN [nsInfo.targetWorldContexts[scopeIndex]]; END; CompoundNameScopeSelectField: PROC[id: ROPE, indirectType: Type, indirectNode: Node, cc: CC] RETURNS[Node] = BEGIN <> nsInfo: CompoundNameScopeInfo _ NARROW[CedarCode.GetDataFromNode[indirectNode]]; indirectData: DoubleAmpersandIndirectInfo _ NEW[DoubleAmpersandIndirectInfoBody_[ id, nsInfo]]; RETURN[CedarCode.CreateCedarNode[DoubleAmpersandVarOps, GetAmpersandVarType[cc], indirectData]]; END; CompoundNameScopeShow: PROC[to: IO.STREAM, node: Node, depth: INT, width: INT, cc: CC] = { nsInfo: CompoundNameScopeInfo _ NARROW[CedarCode.GetDataFromNode[node]]; DoPair: PROC [intro: ROPE, n: Node] ~ { to.PutRope[intro]; CedarCode.ShowNode[to, n, depth-1, width, cc]; SS.Bp[to, always, 0]; RETURN}; to.PutChar['{]; DoPair["AmpersandContext1: ", nsInfo.ampersandContext1]; DoPair["AmpersandContext2: ", nsInfo.ampersandContext2]; DoPair["Target World Context: ", nsInfo.targetWorldContexts[nsInfo.scopeIndex] ]; to.PutChar['}]; RETURN}; DoubleAmpersandIndirectInfo: TYPE = REF DoubleAmpersandIndirectInfoBody; DoubleAmpersandIndirectInfoBody: TYPE = RECORD[ id: ROPE, nsInfo: CompoundNameScopeInfo]; DoubleAmpersandVarOps: REF CedarCode.OperationsBody _ NEW[CedarCode.OperationsBody_[ store: StoreToDoubleAmpersandVar, load: LoadFromDoubleAmpersandVar]]; <> StoreToDoubleAmpersandVar: PROC[valType: Type, valNode: Node, indirectType: Type, indirectNode: Node, cc: CC] = BEGIN indirectData: DoubleAmpersandIndirectInfo _ NARROW[CedarCode.GetDataFromNode[indirectNode]]; ampersand2: Node _ indirectData.nsInfo.ampersandContext2; ampersand2Type: Type _ CedarCode.GetTypeOfNode[ampersand2]; var: Node _ CedarCode.SelectFieldFromNode[indirectData.id, ampersand2Type, ampersand2, cc]; varType: Type _ CedarCode.GetTypeOfNode[var]; CedarCode.StoreThroughIndirectNode[valType, valNode, varType, var, cc]; END; <> <> LoadFromDoubleAmpersandVar: PROC[indirectType: Type, indirectNode: Node, cc: CC] RETURNS[Node] = BEGIN indirectData: DoubleAmpersandIndirectInfo _ NARROW[CedarCode.GetDataFromNode[indirectNode]]; ampersand1: Node _ indirectData.nsInfo.ampersandContext1; ampersand1Type: Type _ CedarCode.GetTypeOfNode[ampersand1]; var1: Node _ CedarCode.SelectFieldFromNode[indirectData.id, ampersand1Type, ampersand1, cc]; var1Type: Type _ CedarCode.GetTypeOfNode[var1]; val1: Node _ NIL; <<>> <> val1 _ CedarCode.LoadThroughIndirectNode[var1Type, var1, cc ! CCE => IF case = operation THEN {val1 _ NIL; CONTINUE}]; IF val1 # NIL THEN RETURN[val1]; <> BEGIN ampersand2: Node _ indirectData.nsInfo.ampersandContext2; ampersand2Type: Type _ CedarCode.GetTypeOfNode[ampersand2]; var2: Node _ CedarCode.SelectFieldFromNode[indirectData.id, ampersand2Type, ampersand2, cc]; var2Type: Type _ CedarCode.GetTypeOfNode[var2]; val2: Node _ CedarCode.LoadThroughIndirectNode[var2Type, var2, cc]; RETURN[val2]; END; END; END..