CedarOtherPureTypesImpl.mesa
Copyright Ó 1991 by Xerox Corporation. All rights reserved.
Sturgis, February 7, 1990 12:05:46 pm PST
Last changed by Theimer on July 16, 1989 4:21:30 pm PDT
Hopcroft July 26, 1989 10:41:50 am PDT
Last tweaked by Mike Spreitzer on January 9, 1992 6:50 pm PST
Laurie Horton, September 13, 1991 11:31 am PDT
DIRECTORY
AmpersandContext USING[MakeNodeFromNode],
CedarCode USING[Code, ConcatCode, CodeToMakeAMNode, CodeToDoBinaryOp, CodeToDoUnaryOp, CodeToDoUnpopedCond, CodeToLoadContentsOfAMNode, CodeToLoadThroughIndirect, CodeToPop, CodeToStoreUnpopped, CreateCedarNode, GetDataFromNode, GetNodeRepresentation, GetTypeOfNode, NullCode, OperationsBody, Operator],
CCTypes USING[BinaryTargetTypes, CCError, CCErrorCase, CCTypeProcs, ConformanceCheck, CreateCedarType, GetAnyTargetType, GetBooleanType, GetCharType, GetGroundTypeClass, GetIndirectType, GetNodeType, GetProcDataFromGroundType, GetProcDataFromType, GetRopeType, GetRTargetType, GetTypeRepresentation, GetWrongType, LoadIdVal, LR, SetBooleanType, SetCharType, sia],
CedarNumericTypes USING[CreateNumericNode, CreateNumericType, GetDescriptorFromCedarNumericType, NumericDescriptor],
CedarOtherPureTypes USING[EnumeratedTypeProcs, RopeInfo, TransparentNodeInfo, TransparentTypeInfo],
CirioSyntacticOperations USING[ParseTree],
CirioTypes USING[BasicTypeInfo, Code, CompilerContext, Mem, Node, Type, TypeClass, TypedCode, TypeIsntNil],
Convert USING[RopeFromChar],
IO,
Rope,
StructuredStreams;
CedarOtherPureTypesImpl: CEDAR PROGRAM
IMPORTS AmpersandContext, CCTypes, CedarCode, CedarNumericTypes, CirioTypes, Convert, IO, Rope, StructuredStreams
EXPORTS CedarOtherPureTypes
= BEGIN OPEN CCTypes, CedarCode, CirioTypes, SS:StructuredStreams;
ROPE: TYPE ~ Rope.ROPE;
CC: TYPE = CompilerContext;
CCE: ERROR[case: CCTypes.CCErrorCase, msg: Rope.ROPE ← NIL] ← CCTypes.CCError;
CreateBooleanType: PUBLIC PROC[cc: CC, bti: BasicTypeInfo] RETURNS[Type] = {
nominal: Type ← CCTypes.GetBooleanType[cc];
IF nominal = NIL THEN CCTypes.SetBooleanType[cc,
nominal ← CreateCedarType[$Boolean, BooleanCCTypeProcs, BooleanIndirectTypeProcs, cc, bti]];
RETURN[nominal]};
BooleanIndirectTypeProcs: REF CCTypeProcs ← NEW[CCTypeProcs ←[
createIndirectNode: BooleanCreateIndirect,
getBitSize: BooleanBitSize
]];
BooleanCCTypeProcs: REF CCTypeProcs ← NEW[CCTypeProcs ←[
checkConformance: BooleanCheckConformance,
binaryOperandTypes: BooleanBinaryOperandTypes,
operand: BooleanOperand,
coerceToType: BooleanCoerceToType,
binaryOp: BooleanTypeBinaryOp,
unaryOp: BooleanTypeUnaryOp,
printType: BooleanPrintType
]];
BooleanCreateIndirect: PROC [cc: CC, procData: REF ANY, indirectType, targetType: Type, mem: Mem] RETURNS [Node] ~ {
bti: BasicTypeInfo ~ NARROW[procData];
RETURN bti.createIndirectNode[bti, cc, indirectType, targetType, mem]};
BooleanBitSize: PROC [indirectType, targetType: Type, cc: CC, procData: REF ANY] RETURNS [CARD] ~ {
bti: BasicTypeInfo ~ NARROW[procData];
RETURN bti.getBitSize[bti, cc, indirectType, targetType]};
valType was the control parameter
BooleanCheckConformance: PROC[valType, varType: Type, cc: CC, procData: REF ANY] RETURNS[CCTypes.ConformanceCheck] =
{IF GetGroundTypeClass[varType, cc] = $Boolean THEN RETURN[yes] ELSE RETURN[no]};
By the time we get here, the left operand type is Boolean and both operands are suitable for the given op. Therefore, the right operand should also be Boolean or amnode
BooleanBinaryOperandTypes: PROC[op: Operator, left, right: Type, cc: CC, procData: REF ANY] RETURNS[BinaryTargetTypes] =
BEGIN
rightClass: TypeClass ← GetGroundTypeClass[right, cc];
SELECT rightClass FROM
$wrong, $amnode => RETURN[[right, right]];
$Boolean =>
SELECT op FROM
$assign => CCE[cirioError]; -- shouldn't happen
ENDCASE => RETURN[[right, right]];
ENDCASE => CCE[cirioError]; -- shouldn't happen
END;
tc.type is Boolean
BooleanOperand: PROC[op: Operator, lr: LR, tc: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
SELECT op FROM
$plus, $minus, $div, $mult, $mod, $le, $lt, $eq, $gt, $ge, $max, $min =>
RETURN[[tc.code, GetWrongType[cc]]];
$and, $or, $not => RETURN[tc];
ENDCASE => CCE[cirioError]; -- shouldn't happen
END;
tc.type is Boolean
BooleanCoerceToType: PROC[targetType: Type, tc: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
targetClass: TypeClass ← GetGroundTypeClass[targetType, cc];
SELECT targetClass FROM
$wrong => RETURN[[tc.code, GetWrongType[cc]]];
$amnode =>
RETURN[[ConcatCode[tc.code, CodeToMakeAMNode[tc.type]], GetNodeType[cc]]];
$Boolean => RETURN[tc];
ENDCASE => CCE[cirioError]; -- shouldn't happen (or can it occur due to a client type error?)
END;
BooleanTypeBinaryOp: PROC[op: Operator, left, right: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN -- assumes that both arguments have Boolean type
code: Code ← SELECT op FROM
$and =>
CodeToDoUnpopedCond[
left.code,
ConcatCode[CodeToPop[1], right.code],
NullCode[]],
$or =>
CodeToDoUnpopedCond[
left.code,
NullCode[],
ConcatCode[CodeToPop[1], right.code]],
ENDCASE => CCE[cirioError]; -- shouldn't happen
RETURN[[code, left.type]];
END;
BooleanTypeUnaryOp: PROC[op: Operator, arg: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
RETURN[[ConcatCode[
arg.code,
CodeToDoUnaryOp[op, arg.type]], arg.type]];
END;
BooleanPrintType: PROC [to: IO.STREAM, type: Type, printDepth: INT, printWidth: INT, cc: CC, procData: REF ANY]
= {to.PutRope["BOOLEAN"]};
Char type
CreateCharType: PUBLIC PROC[cc: CC, bti: BasicTypeInfo] RETURNS[Type] = {
nominal: Type ← CCTypes.GetCharType[cc];
IF nominal = NIL THEN CCTypes.SetCharType[cc,
nominal ← CreateCedarType[$char, CharCCTypeProcs, CharIndirectProcs, cc, bti]];
RETURN[nominal]};
CharIndirectProcs: REF CCTypeProcs ← NEW[CCTypeProcs ←[
createIndirectNode: CharCreateIndirect,
getBitSize: CharBitSize
]];
CharCCTypeProcs: REF CCTypeProcs ← NEW[CCTypeProcs ←[
checkConformance: CharCheckConformance,
binaryOperandTypes: CharBinaryOperandTypes,
operand: CharOperand,
binaryOp: CharTypeBinaryOp,
printType: CharPrintType
]];
CharCreateIndirect: PROC [cc: CC, procData: REF ANY, indirectType, targetType: Type, mem: Mem] RETURNS [Node] ~ {
bti: BasicTypeInfo ~ NARROW[procData];
RETURN bti.createIndirectNode[bti, cc, indirectType, targetType, mem]};
CharBitSize: PROC [indirectType, targetType: Type, cc: CC, procData: REF ANY] RETURNS [CARD] ~ {
bti: BasicTypeInfo ~ NARROW[procData];
RETURN bti.getBitSize[bti, cc, indirectType, targetType]};
valType was the control parameter
CharCheckConformance: PROC[valType, varType: Type, cc: CC, procData: REF ANY] RETURNS[CCTypes.ConformanceCheck] =
{IF GetGroundTypeClass[varType, cc] = $char THEN RETURN[yes] ELSE RETURN[no]};
By the time we get here, the left operand type is Char and both operands are suitable for the given op. Therefore, the right operand should also be Char or amnode
CharBinaryOperandTypes: PROC[op: Operator, left, right: Type, cc: CC, procData: REF ANY] RETURNS[BinaryTargetTypes] =
BEGIN
rightClass: TypeClass ← GetGroundTypeClass[right, cc];
SELECT rightClass FROM
$wrong, $amnode => RETURN[[right, right]];
$numeric =>
SELECT op FROM
$plus, $minus =>
BEGIN
descriptor: REF CedarNumericTypes.NumericDescriptor ← CedarNumericTypes.GetDescriptorFromCedarNumericType[right, cc];
WITH descriptor SELECT FROM
signed: REF signed CedarNumericTypes.NumericDescriptor =>
BEGIN
IF signed.nBits > 16 THEN CCE[operation];
RETURN[[left, right]];
END;
unsigned: REF unsigned CedarNumericTypes.NumericDescriptor =>
BEGIN
IF unsigned.nBits > 16 THEN CCE[operation];
RETURN[[left, right]];
END;
ENDCASE => CCE[operation];
END;
ENDCASE => CCE[operation];
$char =>
SELECT op FROM
$minus => RETURN[[left, right]];
ENDCASE => CCE[operation];
ENDCASE => CCE[operation];
END;
tc.type is Char
CharOperand: PROC[op: Operator, lr: LR, tc: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
SELECT op FROM
$plus =>
IF lr = left THEN RETURN[tc] ELSE CCE[operation];
$minus =>
IF lr = left OR lr = right THEN RETURN[tc] ELSE CCE[operation];
ENDCASE => CCE[operation];
END;
CharTypeBinaryOp: PROC[op: Operator, left, right: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
code: Code ← ConcatCode[
left.code,
ConcatCode[
right.code,
CodeToDoBinaryOp[op, left.type, right.type]]];
type: Type;
SELECT op FROM
$plus => type ← left.type;
$minus =>
BEGIN
rightClass: TypeClass ← GetGroundTypeClass[right.type, cc];
SELECT rightClass FROM
$numeric => type ← left.type;
$char => type ← CedarNumericTypes.CreateNumericType[[16, signed[full[]]], cc, NIL];
ENDCASE => CCE[cirioError];
END;
ENDCASE => CCE[cirioError];
RETURN[[code, type]];
END;
CharPrintType: PROC [to: IO.STREAM, type: Type, printDepth: INT, printWidth: INT, cc: CC, procData: REF ANY]
= {to.PutRope["CHAR"]};
Unknown Type
We offer the following for unknown types. The idea is to permit the printing out of data structures that contain values with unknown types. That is, we should be able to manipulate the remainder of the data structure. We invent the type: UnknownType. So long as we never try to do anything significant with such a value, we should be alright. These public procedures are exported to CCTypes.
CreateUnknownType: PUBLIC PROC[cc: CC, explanation: ROPE ← NIL] RETURNS[Type]
= {RETURN[CreateCedarType[$unknown, UnknownCCTypeProcs, IndirectUnknownCCTypeProcs, cc, explanation]]};
IndirectUnknownCCTypeProcs: REF CCTypes.CCTypeProcs ← NEW[CCTypes.CCTypeProcs ←[
createIndirectNode: IndirectCreate]];
UnknownCCTypeProcs: REF CCTypes.CCTypeProcs ← NEW[CCTypes.CCTypeProcs ←[
printType: PrintUnknownType]];
PrintUnknownType: PROC [to: IO.STREAM, type: Type, printDepth: INT, printWidth: INT, cc: CC, procData: REF ANY] ~ {
explanation: ROPE ~ NARROW[CCTypes.GetProcDataFromType[type]];
to.PutRope["<unknown type"];
IF explanation#NIL THEN {
SS.Bp[to, lookLeft, CCTypes.sia, " "];
to.PutF["(%g)", [rope[explanation]] ]};
to.PutChar['>];
RETURN};
IndirectCreate: PROC [cc: CC, procData: REF ANY, indirectType, targetType: Type, mem: Mem] RETURNS [Node] ~ {
explanation: ROPE ~ NARROW[procData];
RETURN CreateIndirectToAnUnknownType[targetType, explanation, cc]};
TransparentTypeInfo: TYPE ~ CedarOtherPureTypes.TransparentTypeInfo;
CreateTransparentType: PUBLIC PROC[cc: CC, tti: TransparentTypeInfo] RETURNS[Type]
~ {RETURN[CreateCedarType[$transparent, TransparentCCTypeProcs, IndirectTransparentCCTypeProcs, cc, tti]]};
TransparentCCTypeProcs: REF CCTypes.CCTypeProcs ← NEW[CCTypes.CCTypeProcs ←[
printType: PrintTransparentType]];
IndirectTransparentCCTypeProcs: REF CCTypes.CCTypeProcs ← NEW[CCTypes.CCTypeProcs ←[
createIndirectNode: TransparentCreateIndirect,
getBitSize: TransparentBitSize,
load: TransparentTypeLoad,
store: TransparentTypeStore,
printType: PrintTransparentType]];
TransparentCreateIndirect: PROC [cc: CC, procData: REF ANY, indirectType, targetType: Type, mem: Mem] RETURNS [Node] ~ {
tti: TransparentTypeInfo ~ NARROW[procData];
RETURN tti.createIndirectNode[tti, cc, indirectType, targetType, mem]};
TransparentBitSize: PROC[indirectType, targetType: Type, cc: CC, procData: REF ANY] RETURNS[CARD] ~ {
tti: TransparentTypeInfo ~ NARROW[procData];
RETURN[tti.bits]};
TransparentTypeLoad: PROC[indirect: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] ~ {
code: Code ← ConcatCode[
indirect.code,
CodeToLoadThroughIndirect[indirect.type]];
type: Type ← GetRTargetType[indirect.type, cc];
RETURN[[code, type]]};
TransparentTypeStore: PROC[value, indirect: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] ~ {
code: Code ← ConcatCode[
indirect.code,
ConcatCode[
value.code,
CodeToStoreUnpopped[indirect.type, value.type]]];
RETURN[[code, value.type]]};
PrintTransparentType: PROC [to: IO.STREAM, type: Type, printDepth: INT, printWidth: INT, cc: CC, procData: REF ANY] ~ {
tti: TransparentTypeInfo ~ NARROW[CCTypes.GetProcDataFromType[type]];
SELECT printDepth FROM
>2 => to.PutF["<transparent %g, %g bits>", [rope[tti.intro]], [integer[tti.bits]] ];
ENDCASE => to.PutF["<%g-bit transparent>", [integer[tti.bits]] ]};
Enumerated Types
EnumeratedTypeDescriptor: TYPE = RECORD[
nValues: INT,
bottomIndex: INT,
topIndex: INT,
procs: REF EnumeratedTypeProcs,
procsData: REF ANY];
index belongs to [0..nValues)
EnumeratedTypeProcs: TYPE = CedarOtherPureTypes.EnumeratedTypeProcs;
CreateEnumeratedType: PUBLIC PROC[nValues: INT, procs: REF EnumeratedTypeProcs, procsData: REF ANY, cc: CC] RETURNS[Type] =
BEGIN
desc: REF EnumeratedTypeDescriptor ← NEW[EnumeratedTypeDescriptor ← [nValues, 0, nValues-1, procs, procsData]];
RETURN[CCTypes.CreateCedarType[$enumerated, EnumeratedCCTypeProcs, IndirectEnumeratedCCTypeProcs, cc, desc]];
END;
CreateEnumeratedSubtype: PUBLIC PROC[baseType: Type, bottomIndex, topIndex: INT, cc: CC] RETURNS[Type] =
BEGIN
baseDesc: REF EnumeratedTypeDescriptor ← NARROW[GetProcDataFromGroundType[baseType, cc]];
desc: REF EnumeratedTypeDescriptor ← NEW[EnumeratedTypeDescriptor ← [baseDesc.nValues, bottomIndex, topIndex, baseDesc.procs, baseDesc.procsData]];
IF bottomIndex < baseDesc.bottomIndex THEN CCE[cirioError];
IF topIndex > baseDesc.topIndex THEN CCE[cirioError];
RETURN[CCTypes.CreateCedarType[$enumerated, EnumeratedCCTypeProcs, NIL, cc, desc]];
END;
EnumeratedCCTypeProcs: REF CCTypeProcs ← NEW[CCTypeProcs ← [
checkConformance: EnumeratedCheckConformance,
binaryOperandTypes: EnumeratedBinaryOperandTypes,
asIndexSet: EnumeratedAsIndexSet,
operand: EnumeratedOperand,
coerceToType: EnumeratedCoerceToType,
binaryOp: EnumeratedBinaryOp,
unaryOp: EnumeratedUnaryOp,
loadIdVal: EnumeratedLoadIdVal,
getNElements: EnumeratedGetNElements,
getTypeRepresentation: EnumeratedGetTypeRepresentation,
printType: EnumeratedPrintType
]];
IndirectEnumeratedCCTypeProcs: REF CCTypeProcs ← NEW[CCTypeProcs ← [
createIndirectNode: EnumeratedCreateIndirect,
getBitSize: EnumeratedBitSize,
printType: EnumeratedPrintType
]];
EnumeratedCreateIndirect: PROC [cc: CC, procData: REF ANY, indirectType, targetType: Type, mem: Mem] RETURNS [Node] ~ {
desc: REF EnumeratedTypeDescriptor ~ NARROW[procData];
RETURN desc.procs.createIndirectNode[desc.procsData, cc, indirectType, targetType, mem]};
EnumeratedBitSize: PROC[indirectType, targetType: Type, cc: CC, procData: REF ANY] RETURNS[CARD] ~ {
desc: REF EnumeratedTypeDescriptor ~ NARROW[procData];
RETURN desc.procs.getBitSize[desc.procsData, cc, indirectType, targetType]};
valType was the control parameter
EnumeratedCheckConformance: PROC[valType, varType: Type, cc: CC, procData: REF ANY] RETURNS[CCTypes.ConformanceCheck] =
BEGIN
valDesc: REF EnumeratedTypeDescriptor ← NARROW[procData];
WITH GetProcDataFromGroundType[varType, cc] SELECT FROM
varDesc: REF EnumeratedTypeDescriptor =>
RETURN[IF valDesc.procs.comparePaint[valDesc.procsData, varDesc.procs.getPaint[varDesc.procsData]] THEN yes ELSE no];
ENDCASE => RETURN[no];
END;
By the time we get here, the left operand type is enumerated and both operands are suitable for the given op. Therefore, the right operand should also be enumerated or amnode
EnumeratedBinaryOperandTypes: PROC[op: Operator, left, right: Type, cc: CC, procData: REF ANY] RETURNS[BinaryTargetTypes] =
BEGIN
rightClass: TypeClass ← GetGroundTypeClass[right, cc];
SELECT rightClass FROM
$wrong, $amnode => RETURN[[right, right]];
$enumerated =>
SELECT op FROM
$assign => CCE[cirioError]; -- shouldn't happen
ENDCASE => RETURN[[right, right]];
ENDCASE => CCE[cirioError]; -- shouldn't happen
END;
EnumeratedAsIndexSet: PROC[type: Type, cc: CC, procData: REF ANY] RETURNS[Type] = {RETURN[type]};
tc.type is Enumerated
EnumeratedOperand: PROC[op: Operator, lr: LR, tc: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
SELECT op FROM
$plus, $minus, $div, $mult, $mod, $and, $or, $not =>
RETURN[[tc.code, GetWrongType[cc]]];
$le, $lt, $eq, $gt, $ge, $max, $min => RETURN[tc];
ENDCASE => CCE[cirioError]; -- shouldn't happen
END;
tc.type is Enumerated
EnumeratedCoerceToType: PROC[targetType: Type, tc: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
targetClass: TypeClass ← GetGroundTypeClass[targetType, cc];
SELECT targetClass FROM
$wrong => RETURN[[tc.code, GetWrongType[cc]]];
$amnode =>
RETURN[[ConcatCode[tc.code, CodeToMakeAMNode[tc.type]], GetNodeType[cc]]];
$enumerated => RETURN[tc];
ENDCASE => CCE[cirioError]; -- shouldn't happen (or can it occur due to a client type error?)
END;
EnumeratedBinaryOp: PROC[op: Operator, left, right: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN -- assumes that both arguments have enumerated type and that the operator is a relation
code: Code ← CedarCode.ConcatCode[
left.code,
CedarCode.ConcatCode[
right.code,
CedarCode.CodeToDoBinaryOp[op, left.type, right.type]]];
RETURN[[code, CCTypes.GetBooleanType[cc]]];
END;
EnumeratedUnaryOp: PROC[op: Operator, arg: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN -- such operations as succ and pred.
RETURN[[ConcatCode[
arg.code,
CodeToDoUnaryOp[op, arg.type]], arg.type]];
END;
we look to see if the id is one of the values of the enumerated type, otherwise we fall back on the default code.
EnumeratedLoadIdVal: PROC[id: Rope.ROPE, targetType: Type, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
desc: REF EnumeratedTypeDescriptor ← NARROW[procData];
I forsee trouble. The targetType might not be appropriate. I have to rethink my default mechanism. For this case, I could hide the Type in the desc, but that would create cycles. (Probably I already have cycles).
FOR I: INT IN [desc.bottomIndex..desc.topIndex] DO
IF Rope.Equal[id, desc.procs.indexToId[I, desc.procsData]] THEN
BEGIN
node: Node ← CreateEnumeratedTypeNode[targetType, id, cc];
code: CirioTypes.Code ← CedarCode.CodeToLoadContentsOfAMNode[node];
RETURN[[code, targetType]];
END;
ENDLOOP;
the id was not an element of the enumerated type, so fall back on default mechanism.
RETURN[CCTypes.LoadIdVal[id, targetType, cc, CCTypes.GetAnyTargetType[cc]]];
END;
EnumeratedGetNElements: PROC [type: Type, cc: CC, procData: REF ANY] RETURNS [CARD] =
BEGIN
desc: REF EnumeratedTypeDescriptor ← NARROW[procData];
RETURN [desc.nValues];
END;
EnumeratedGetTypeRepresentation: PROC[type: Type, cc: CC, procData: REF ANY] RETURNS[REF ANY] =
BEGIN
desc: REF EnumeratedTypeDescriptor ← NARROW[procData];
RETURN[desc.procsData];
END;
EnumeratedPrintType: PROC [to: IO.STREAM, type: Type, printDepth, printWidth: INT, cc: CC, procData: REF ANY] = {
desc: REF EnumeratedTypeDescriptor ← NARROW[procData];
to.PutChar['{];
FOR i: INT IN [0 .. desc.topIndex-desc.bottomIndex] DO
IF i>0 THEN {to.PutChar[',]; SS.Bp[to, lookLeft, CCTypes.sia, " "]};
IF i>printWidth THEN {to.PutRope["..."]; EXIT};
to.PutRope[desc.procs.indexToId[desc.bottomIndex+i, desc.procsData]];
ENDLOOP;
to.PutChar['}];
RETURN};
Rope Types
CreateRopeType: PUBLIC PROC[cc: CC, bti: BasicTypeInfo] RETURNS[Type] =
BEGIN
nominal: Type ← CCTypes.GetRopeType[cc];
IF nominal # NIL THEN RETURN[nominal];
RETURN[CreateCedarType[$rope, RopeCCTypeProcs, IndirectRopeCCTypeProcs, cc, bti]];
END;
At the moment we permit no operations. Perhaps later we want apply, so that we can do rope[10] to read the 10'th character in the rope? Does the current Cedar debuger supply that operation?
RopeCCTypeProcs: REF CCTypeProcs ← NEW[CCTypeProcs ←[
printType: RopePrintType
]];
IndirectRopeCCTypeProcs: REF CCTypeProcs ← NEW[CCTypeProcs ←[
createIndirectNode: RopeCreateIndirect,
getBitSize: RopeBitSize,
printType: RopePrintType
]];
RopeCreateIndirect: PROC [cc: CC, procData: REF ANY, indirectType, targetType: Type, mem: Mem] RETURNS [Node] ~ {
bti: BasicTypeInfo ~ NARROW[procData];
RETURN bti.createIndirectNode[bti, cc, indirectType, targetType, mem]};
RopeBitSize: PROC[indirectType, targetType: Type, cc: CC, procData: REF ANY] RETURNS[CARD] ~ {
bti: BasicTypeInfo ~ NARROW[procData];
RETURN bti.getBitSize[bti, cc, indirectType, targetType]};
RopePrintType: PROC [to: IO.STREAM, type: Type, printDepth: INT, printWidth: INT, cc: CC, procData: REF ANY]
= {to.PutRope["ROPE"]};
Boolean Nodes
CreateBooleanNode: PUBLIC PROC[val: BOOLEAN, cc: CC] RETURNS[Node] =
{RETURN[CreateCedarNode[BooleanOps, CCTypes.GetBooleanType[cc], NEW[BOOLEAN ← val]]]};
BooleanOps: REF OperationsBody ← NEW[OperationsBody ←[
makeAMNode: BooleanMakeAMNode,
examineBoolean: BooleanExamineBoolean,
coerce: BooleanCoerce,
binaryOp: BooleanBinaryOp,
unaryOp: BooleanUnaryOp,
show: BooleanShow,
getNodeRepresentation: BooleanGetNodeRepresentation
]];
BooleanMakeAMNode: PROC[sourceType: Type, node: Node, cc: CC] RETURNS[Node] =
{RETURN[AmpersandContext.MakeNodeFromNode[node, cc]]};
BooleanExamineBoolean: PROC[node: Node, cc: CC] RETURNS[BOOLEAN] =
{RETURN[NARROW[CedarCode.GetDataFromNode[node], REF BOOLEAN]^]};
BooleanCoerce: PROC[sourceType, targetType: Type, node: Node, cc: CC] RETURNS[Node] =
{CCE[cirioError]}; -- shouldn't happen
THIS IS ALL WRONG. THE GENERATED CODE should do a test and avoid evaluating the second argument if the first argument determines the answer.!!!!
BooleanBinaryOp: PROC[op: Operator, leftType, rightType: Type, leftNode, rightNode: Node, cc: CC] RETURNS[Node] =
BEGIN -- can assume that both operands are Boolean
left: REF BOOLEAN ← NARROW[CedarCode.GetDataFromNode[leftNode]];
right: REF BOOLEAN ← NARROW[CedarCode.GetDataFromNode[rightNode]];
result: BOOLEAN ← SELECT op FROM
$and => left^ AND right^,
$or => left^ OR right^,
ENDCASE => CCE[cirioError]; -- shouldn't happen
CCE[cirioError]; -- this code should not be called
RETURN[CreateBooleanNode[result, cc]];
END;
BooleanUnaryOp: PROC[op: Operator, type: Type, node: Node, cc: CC] RETURNS[Node] =
BEGIN
arg: REF BOOLEAN ← NARROW[CedarCode.GetDataFromNode[node]];
SELECT op FROM
$not => RETURN[CreateBooleanNode[NOT arg^, cc]];
ENDCASE => CCE[cirioError]; -- shouldn't happen
END;
BooleanShow: PROC[to: IO.STREAM, node: Node, depth: INT, width: INT, cc: CC]
= {to.PutRope[IF NARROW[CedarCode.GetDataFromNode[node], REF BOOLEAN]^ THEN "TRUE" ELSE "FALSE"]};
BooleanGetNodeRepresentation: PROC[node: Node, cc: CC] RETURNS[REF ANY] =
{RETURN[CedarCode.GetDataFromNode[node]]};
Char nodes
CreateCharNode: PUBLIC PROC[val: CHAR, cc: CC] RETURNS[Node] =
{RETURN[CreateCedarNode[CharOps, CCTypes.GetCharType[cc], NEW[CHAR ← val]]]};
CharOps: REF OperationsBody ← NEW[OperationsBody ←[
makeAMNode: CharMakeAMNode,
binaryOp: CharBinaryOp,
show: CharShow,
getNodeRepresentation: CharGetRepresentation
]];
CharMakeAMNode: PROC[sourceType: Type, node: Node, cc: CC] RETURNS[Node] =
{RETURN[AmpersandContext.MakeNodeFromNode[node, cc]]};
There are three possibilities: char+numeric, char-numeric, and char-char.
CharBinaryOp: PROC[op: Operator, leftType, rightType: Type, leftNode, rightNode: Node, cc: CC] RETURNS[Node] =
BEGIN -- we will do the computation in INT and then convert back to char at end
leftChar: REF CHAR ← NARROW[CedarCode.GetNodeRepresentation[leftNode, cc]];
leftVal: INT ← ORD[leftChar^];
rightNodeType: Type ← CedarCode.GetTypeOfNode[rightNode];
RightValAsNumeric: PROC RETURNS[INT] =
BEGIN
rightDescriptor: REF CedarNumericTypes.NumericDescriptor ← CedarNumericTypes.GetDescriptorFromCedarNumericType[rightNodeType, cc];
WITH rightDescriptor SELECT FROM
signed: REF signed CedarNumericTypes.NumericDescriptor =>
BEGIN
rightVal: REF INT ← NARROW[CedarCode.GetNodeRepresentation[rightNode, cc]];
RETURN[rightVal^];
END;
unsigned: REF unsigned CedarNumericTypes.NumericDescriptor =>
BEGIN
rightVal: REF CARD ← NARROW[CedarCode.GetNodeRepresentation[rightNode, cc]];
lastInt: CARD ← LAST[INT];
IF rightVal^ > lastInt THEN CCE[cirioError]; -- it was supposed to be a small numeric, and we are supposed to have checked that.
RETURN[rightVal^];
END;
ENDCASE => CCE[cirioError];
END;
ModifiedChar: PROC[mod: INT] RETURNS[Node] =
BEGIN
newVal: INT ← leftVal+mod;
IF newVal < 0 OR newVal > 377B THEN CCE[operation, "bounds fault"];
RETURN[CreateCharNode[VAL[INTEGER[newVal]], cc]];
END;
SELECT op FROM
$plus =>
BEGIN -- GetGroundTypeClass[rightNodeType] must be $numeric and small.
rightVal: INT ← RightValAsNumeric[];
RETURN[ModifiedChar[rightVal]];
END;
$minus =>
BEGIN
rightClass: TypeClass ← GetGroundTypeClass[rightNodeType, cc];
SELECT rightClass FROM
$numeric =>
BEGIN
rightVal: INT ← RightValAsNumeric[];
RETURN[ModifiedChar[-rightVal]];
END;
$char =>
BEGIN
rightChar: REF CHAR ← NARROW[CedarCode.GetNodeRepresentation[rightNode, cc]];
rightVal: INT ← ORD[rightChar^];
resultVal: INT ← leftVal-rightVal; -- always will be inbounds
resultType: Type ← CedarNumericTypes.CreateNumericType[[16, signed[full[]]], cc, NIL];
RETURN[CedarNumericTypes.CreateNumericNode[resultType, NEW[INT←resultVal]]];
END;
ENDCASE => CCE[cirioError];
END;
ENDCASE => CCE[cirioError];
END;
CharShow: PROC[to: IO.STREAM, node: Node, depth: INT, width: INT, cc: CC] = {
val: CHAR ← NARROW[CedarCode.GetDataFromNode[node], REF CHAR]^;
to.PutRope[Convert.RopeFromChar[val]];
};
CharGetRepresentation: PROC[node: Node, cc: CC] RETURNS[REF ANY] =
{RETURN[CedarCode.GetDataFromNode[node]]};
Unknown Type Nodes, and Indirects thereto
CreateUnknownTypeNode: PUBLIC PROC[type: Type, explanation: ROPE, cc: CC] RETURNS[CirioTypes.Node] =
{RETURN[CedarCode.CreateCedarNode[UnknownTypeNodeOps, type, explanation]]};
CreateIndirectToAnUnknownType: PUBLIC PROC[type: Type, explanation: ROPE, cc: CC] RETURNS[CirioTypes.Node] =
{RETURN[CedarCode.CreateCedarNode[IndirectToUnknownTypeNodeOps, CCTypes.GetIndirectType[type], explanation]]};
IndirectToUnknownTypeNodeOps: REF CedarCode.OperationsBody ← NEW[CedarCode.OperationsBody←[
load: UnknownIndirectLoad,
show: UnknownShow]];
UnknownIndirectLoad: PROC[indirectType: Type, indirectNode: CirioTypes.Node, cc: CC] RETURNS[CirioTypes.Node] =
BEGIN
explanation: ROPE ~ NARROW[CedarCode.GetDataFromNode[indirectNode]];
RETURN[CedarCode.CreateCedarNode [UnknownTypeNodeOps, CCTypes.GetRTargetType [CedarCode.GetTypeOfNode [indirectNode], cc], Rope.Cat["<loaded ", explanation, ">"]]];
END;
UnknownTypeNodeOps: REF CedarCode.OperationsBody ← NEW[CedarCode.OperationsBody←[
show: UnknownShow]];
UnknownShow: PROC[to: IO.STREAM, node: CirioTypes.Node, depth, width: INT, cc: CC] = {
explanation: ROPE ~ NARROW[CedarCode.GetDataFromNode[node]];
IF depth < 3 THEN {to.PutRope["??"]; RETURN};
to.PutRope["<node of unknown type"];
SS.Bp[to, lookLeft, CCTypes.sia, " "];
to.PutF["(%g)>", [rope[explanation]] ];
RETURN};
Transparent Type Nodes
TransparentNodeInfo: TYPE ~ CedarOtherPureTypes.TransparentNodeInfo;
CreateTransparentTypeNode: PUBLIC PROC[type: Type, tni: TransparentNodeInfo, cc: CC] RETURNS[CirioTypes.Node] = {
RETURN[CedarCode.CreateCedarNode[TransparentTypeNodeOps, type, tni]]};
TransparentTypeNodeOps: REF CedarCode.OperationsBody ← NEW[CedarCode.OperationsBody←[
show: TransparentShow,
getNodeRepresentation: TransparentGetNodeRepresentation]];
TransparentShow: PROC[to: IO.STREAM, node: CirioTypes.Node, depth: INT, width: INT, cc: CC] = {
tni: TransparentNodeInfo ~ NARROW[CedarCode.GetDataFromNode[node]];
len: INT ~ MIN[tni.val.Length, width];
to.PutChar['<];
IF depth>2 THEN {
type: Type ~ GetTypeOfNode[node];
tti: TransparentTypeInfo ~ NARROW[GetTypeRepresentation[type, cc]];
to.PutRope[tti.intro]; to.PutChar[' ]};
IF tni.lpad#0 OR tni.rpad#0 THEN to.PutF["(lpad=%g, rpad=%g) ", [integer[tni.lpad]], [integer[tni.rpad]] ];
FOR i: INT IN [0..len) DO to.PutF["%02x", [cardinal[tni.val.InlineFetch[i].ORD]] ] ENDLOOP;
to.PutChar['>];
RETURN};
TransparentGetNodeRepresentation: PROC[node: Node, cc: CC] RETURNS[REF ANY]
~ {RETURN CedarCode.GetDataFromNode[node]};
Enumerated Type Nodes
EnumeratedNodeInfo: TYPE = REF EnumeratedNodeInfoBody;
EnumeratedNodeInfoBody: TYPE = RECORD[
type: Type,
id: Rope.ROPE,
index: CARD];
CreateEnumeratedTypeNode: PUBLIC PROC[type: Type, id: Rope.ROPE, cc: CC] RETURNS[CirioTypes.Node] =
BEGIN
desc: REF EnumeratedTypeDescriptor ← NARROW[GetProcDataFromGroundType[type, cc]];
index: CARD ← desc.procs.idToIndex[id, desc.procsData];
RETURN[CedarCode.CreateCedarNode[EnumeratedOps, type, NEW[EnumeratedNodeInfoBody ← [type, id, index]]]];
END;
CreateEnumeratedTypeNodeFromIndex: PUBLIC PROC[type: Type, index: CARD, cc: CC] RETURNS[CirioTypes.Node] =
BEGIN
desc: REF EnumeratedTypeDescriptor ← NARROW[GetProcDataFromGroundType[type, cc]];
id: Rope.ROPE ← desc.procs.indexToId[index, desc.procsData];
RETURN[CedarCode.CreateCedarNode[EnumeratedOps, type, NEW[EnumeratedNodeInfoBody ← [type, id, index]]]];
END;
EnumeratedOps: REF CedarCode.OperationsBody ← NEW[CedarCode.OperationsBody ←[
binaryOp: EnumeratedBinaryNodeOp,
asIndex: EnumeratedAsIndex,
show: EnumeratedShow,
getNodeRepresentation: EnumeratedGetNodeRepresentation
]];
EnumeratedBinaryNodeOp: PROC[op: Operator, leftType, rightType: Type, leftNode, rightNode: Node, cc: CC] RETURNS[Node] =
BEGIN -- should only be relations
linfo: EnumeratedNodeInfo ← NARROW[CedarCode.GetDataFromNode[leftNode]];
rinfo: EnumeratedNodeInfo ← NARROW[CedarCode.GetDataFromNode[rightNode]];
li: CARD ← linfo.index;
ri: CARD ← rinfo.index;
newBoolean: BOOLEAN ← SELECT op FROM
$lt => li < ri,
$le => li <= ri,
$eq => li = ri,
$ne => li # ri,
$ge => li >= ri,
$gt => li > ri,
ENDCASE => CCE[cirioError];
RETURN[CreateBooleanNode[newBoolean, cc]];
END;
(I suspect that we still have to implemented subrange enumerated types. If so, we will have to make some modifications here.)
EnumeratedAsIndex: PROC[type: Type, node: Node, cc: CC] RETURNS[CARD] =
BEGIN
info: EnumeratedNodeInfo ← NARROW[CedarCode.GetDataFromNode[node]];
RETURN[info.index];
END;
EnumeratedShow: PROC[to: IO.STREAM, node: CirioTypes.Node, depth: INT, width: INT, cc: CC] = {
info: EnumeratedNodeInfo ← NARROW[CedarCode.GetDataFromNode[node]];
to.PutRope[info.id];
RETURN};
EnumeratedGetNodeRepresentation: PROC[node: Node, cc: CC] RETURNS[REF ANY] =
BEGIN
info: EnumeratedNodeInfo ← NARROW[CedarCode.GetDataFromNode[node]];
RETURN[NEW[CARD ← info.index]];
END;
Parse Tree types
Nodes of this type will be created when we have a node applied to a parse tree (as opposed to a procedure applied to a parse tree or an array applied to a parse tree).
CreateParseTreeType: PUBLIC PROC[cc: CC] RETURNS[Type] =
BEGIN
RETURN[CCTypes.CreateCedarType[$parseTree, ParseTreeCCTypeProcs, NIL, cc]];
END;
ParseTreeCCTypeProcs: REF CCTypeProcs ← NEW[CCTypeProcs ← [
]];
Parse Tree Nodes
PTNData: TYPE = RECORD[tree: CirioSyntacticOperations.ParseTree];
CreateParseTreeNode: PUBLIC PROC[parseTree: CirioSyntacticOperations.ParseTree, cc: CC] RETURNS[Node] =
{RETURN[CedarCode.CreateCedarNode[ParseTreeOps, CCTypes.GetNodeType[cc], NEW[PTNData ← [parseTree]]]]};
ParseTreeOps: REF CedarCode.OperationsBody ← NEW[CedarCode.OperationsBody ←[
examineParseTree: ParseTreeExamineParseTree,
show: ParseTreeShow
]];
ParseTreeExamineParseTree: PROC[node: Node, cc: CC] RETURNS[CirioSyntacticOperations.ParseTree] =
{RETURN[NARROW[CedarCode.GetDataFromNode[node], REF PTNData].tree]};
ParseTreeShow: PROC[to: IO.STREAM, node: CirioTypes.Node, depth: INT, width: INT, cc: CC] = {to.PutRope["parseTree"]};
Rope Nodes
RopeInfo: TYPE ~ CedarOtherPureTypes.RopeInfo;
CreateRopeNode: PUBLIC PROC[val: Rope.ROPE, cc: CC, addr: REF ANY ← NIL] RETURNS[Node] =
{RETURN[CreateCedarNode[RopeOps, CCTypes.GetRopeType[cc].TypeIsntNil[cc], NEW [RopeInfo ← [val, addr]] ]]};
RopeOps: REF OperationsBody ← NEW[OperationsBody ←[
show: RopeShow,
getNodeRepresentation: RopeGetRepresentation
]];
RopeShow: PROC[to: IO.STREAM, node: Node, depth, width: INT, cc: CC] = {
info: REF RopeInfo ← NARROW[CedarCode.GetDataFromNode[node]];
width ← width * 10; -- For ropes we interprete the printing width to be longer since characters have a very small width compared to other types.
to.PutF["\"%q%g\"", [rope[info.val.Substr[0, width]]], [rope[IF info.val.Length[] > width THEN "..." ELSE NIL]] ];
RETURN};
RopeGetRepresentation: PROC[node: Node, cc: CC] RETURNS[REF ANY] =
BEGIN
info: REF RopeInfo ← NARROW[CedarCode.GetDataFromNode[node]];
RETURN[info];
END;
END..