ListsImpl.mesa
Copyright Ó 1992 by Xerox Corporation. All rights reserved.
Theimer, May 17, 1989 3:56:05 pm PDT
Changed by Theimer on May 20, 1989 6:42:37 pm PDT
Last changed by Theimer on July 25, 1989 0:26:26 am PDT
Hopcroft July 26, 1989 10:20:37 am PDT
Last tweaked by Mike Spreitzer January 9, 1992 10:33 am PST
DIRECTORY
CCTypes USING [BreakPrintType, CCError, CCErrorCase, CCTypeProcs, CreateCedarType, SelectIdField, GetProcDataFromType, LR, ExtractIdField, GetIndirectType, CheckConformance, ConformanceCheck, GetProcDataFromGroundType],
CirioTypes USING[CompilerContext, Type, TypedCode, Node],
CedarCode USING [BreakShowNode, Code, ConcatCode, CreateCedarNode, OperationsBody, GetDataFromNode, GetTypeOfNode, ShowNode, LoadThroughIndirectNode, CodeToCoerce, CodeToLoadThroughIndirect, Operator, CodeToStoreUnpopped, CodeToLoadContentsOfAMNode, CodeToDoApply, StoreThroughIndirectNode],
CirioSyntacticOperations USING [ParseTree, CompileForRHS],
IO,
Lists USING [ListNodeInfo],
Rope;
ListsImpl: CEDAR PROGRAM
IMPORTS CCTypes, CedarCode, CirioSyntacticOperations, IO
EXPORTS Lists
= BEGIN OPEN CCTypes;
CC: TYPE = CirioTypes.CompilerContext;
Code: TYPE = CedarCode.Code;
Type: TYPE = CirioTypes.Type;
TypedCode: TYPE = CirioTypes.TypedCode;
Node: TYPE = CirioTypes.Node;
CCE: ERROR[case: CCTypes.CCErrorCase, msg: Rope.ROPE ← NIL] ← CCTypes.CCError;
Operator: TYPE = CedarCode.Operator;
Type operations.
ListTypeInfo: TYPE = REF ListTypeInfoBody;
ListTypeInfoBody: TYPE = RECORD [
listStructType: Type,
listElementType: Type,
getNewList: PROC [listType: Type, data: REF ANY, cc: CC] RETURNS [Node],
data: REF ANY];
CreateListType: PUBLIC PROC [listStructType: Type, listElementType: Type, getNewList: PROC [listType: Type, data: REF ANY, cc: CC] RETURNS [Node], procData: REF ANY, cc: CC] RETURNS [Type] = {
info: ListTypeInfo ← NEW [ListTypeInfoBody ← [listStructType, listElementType, getNewList, procData]];
type: Type ← CCTypes.CreateCedarType[$list, ListTypeCCTypeProcs, IndirectListTypeCCTypeProcs, cc, info];
RETURN [type];
};
ListTypeCCTypeProcs: REF CCTypes.CCTypeProcs ← NEW[CCTypes.CCTypeProcs ←[
checkConformance: ListCCTypesCheckConformance,
operand: ListCCTypesOperand,
typeOp: ListCCTypesTypeOp,
applyOperand: ListCCTypesApplyOperand,
apply: ListCCTypesApply,
extractIdField: ListCCTypesExtractIdField,
printType: ListCCTypesPrintType]];
ListCCTypesCheckConformance: PROC[valType, varType: Type, cc: CC, procData: REF ANY] RETURNS[CCTypes.ConformanceCheck] =
BEGIN
valInfo: ListTypeInfo ← NARROW[procData];
WITH CCTypes.GetProcDataFromGroundType[varType, cc] SELECT FROM
varInfo: ListTypeInfo => RETURN [CCTypes.CheckConformance[valInfo.listStructType, varInfo.listStructType, cc]];
ENDCASE => RETURN[no];
END;
ListCCTypesOperand: PROC [op: Operator, lr: CCTypes.LR, tc: TypedCode, cc: CC, procData: REF ANY] RETURNS [TypedCode] =
BEGIN
SELECT op FROM
$dot , $extractId => RETURN[tc];
ENDCASE => CCE[operation]; -- client error, invalid operation
END;
ListCCTypesTypeOp: PROC[op: Operator, type: Type, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
info: ListTypeInfo ← NARROW[procData];
node: Node ← info.getNewList[type, info.data, cc];
RETURN [[CedarCode.CodeToLoadContentsOfAMNode[node], type]];
END;
ListCCTypesApplyOperand: PROC[operatorType: Type, operand: CirioSyntacticOperations.ParseTree, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
info: ListTypeInfo ← NARROW[procData];
RETURN[CirioSyntacticOperations.CompileForRHS[operand, info.listStructType, cc]];
END;
ListCCTypesApply: PROC[operator: TypedCode, operand: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
info: ListTypeInfo ← NARROW[procData];
code: Code ← CedarCode.ConcatCode[operator.code, CedarCode.ConcatCode[operand.code, CedarCode.CodeToDoApply[operator.type, operand.type]]];
RETURN [[code, operator.type]];
END;
ListCCTypesExtractIdField: PROC[id: Rope.ROPE, fieldContext: Type, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
info: ListTypeInfo ← NARROW[procData];
code: Code ← CedarCode.CodeToCoerce[fieldContext, info.listStructType];
code1: Code ← CedarCode.ConcatCode[code, CedarCode.CodeToLoadThroughIndirect[CCTypes.GetIndirectType[info.listStructType]]];
tc: TypedCode ← CCTypes.ExtractIdField[id, info.listStructType, cc];
code2: Code ← CedarCode.ConcatCode[code1, tc.code];
RETURN [[code2, tc.type]];
END;
IndirectListTypeCCTypeProcs: REF CCTypes.CCTypeProcs ← NEW[CCTypes.CCTypeProcs ←[
operand: IndirectListCCTypesOperand,
store: ListCCTypesStore,
selectIdField: ListCCTypesSelectIdField,
printType: ListCCTypesPrintType]];
IndirectListCCTypesOperand: PROC[op: Operator, lr: CCTypes.LR, tc: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
BEGIN
SELECT op FROM
$selectId, $address => RETURN[tc];
ENDCASE => CCE[operation]; -- client error; invalid operation
END;
ListCCTypesStore: 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;
ListCCTypesSelectIdField: PROC[id: Rope.ROPE, fieldIndirectContext: Type, cc: CC, procData: REF ANY] RETURNS[TypedCode] = {
info: ListTypeInfo ← NARROW[procData];
code: Code ← CedarCode.CodeToCoerce[fieldIndirectContext, info.listStructType];
tc: TypedCode ← CCTypes.SelectIdField[id, CCTypes.GetIndirectType[info.listStructType], cc];
code1: Code ← CedarCode.ConcatCode[code, tc.code];
RETURN [[code1, tc.type]];
};
ListCCTypesPrintType: PROC [to: IO.STREAM, type: Type, printDepth: INT, printWidth: INT, cc: CC, procData: REF ANY] = {
info: ListTypeInfo ← NARROW[procData];
to.PutRope["LIST OF"];
CCTypes.BreakPrintType[to, info.listElementType, printDepth-1, printWidth, cc, " "];
RETURN};
Node operations.
CreateListIndirectNode: PUBLIC PROC [type: Type, info: REF ANY] RETURNS [Node] = {
RETURN [CedarCode.CreateCedarNode[ListIndirectOps, type, info]];
};
ListIndirectOps: REF CedarCode.OperationsBody ← NEW[CedarCode.OperationsBody ←[
coerce: ListIndirectCoerce,
unaryOp: ListIndirectUnaryOp,
store: ListIndirectStore,
load: ListIndirectLoad,
show: ListIndirectShow,
apply: ListApply
]];
ListIndirectCoerce: PROC [sourceType, targetType: Type, node: Node, cc: CC] RETURNS [Node] =
BEGIN
info: Lists.ListNodeInfo ← NARROW[CedarCode.GetDataFromNode[node]];
RETURN [info.getListStruct[targetType, cc, info.data]];
END;
ListIndirectUnaryOp: PROC [op: CedarCode.Operator, type: CirioTypes.Type, node: CirioTypes.Node, cc: CC] RETURNS [CirioTypes.Node] =
BEGIN
indirectNodeData: Lists.ListNodeInfo ← NARROW[CedarCode.GetDataFromNode[node]];
RETURN[indirectNodeData.getPointer[indirectNodeData.data, cc]];
END;
ListIndirectStore: PROC[valType: Type, valNode: Node, indirectType: Type, indirectNode: Node, cc: CC] =
BEGIN
info: Lists.ListNodeInfo ← NARROW[CedarCode.GetDataFromNode[indirectNode]];
info.storeList[valNode, cc, info.data];
END;
ListIndirectLoad: PROC [indirectType: Type, indirectNode: Node, cc: CC] RETURNS [Node] = {
info: Lists.ListNodeInfo ← NARROW[CedarCode.GetDataFromNode[indirectNode]];
listIndirectType: Type ← CedarCode.GetTypeOfNode[indirectNode];
RETURN [CreateListNode[listIndirectType, DeferedLoadListProcs, info]];
};
ListIndirectShow: PROC [to: IO.STREAM, node: Node, depth: INT, width: INT, cc: CC] = {
info: Lists.ListNodeInfo ← NARROW[CedarCode.GetDataFromNode[node]];
node1: Node ← CreateListNode[CedarCode.GetTypeOfNode[node], DeferedLoadListProcs, info];
to.PutRope["^["];
CedarCode.ShowNode[to, node1, depth, width, cc];
to.PutChar[']];
RETURN};
ListApply: PROC [operatorType: Type, operandType: Type, operator: Node, operand: Node, cc: CC] RETURNS [Node] =
BEGIN
info: Lists.ListNodeInfo ← NARROW[CedarCode.GetDataFromNode[operator]];
typeInfo: ListTypeInfo ← NARROW[CCTypes.GetProcDataFromType[operatorType]];
structNode: Node ← info.getListStruct[typeInfo.listStructType, cc, info.data];
CedarCode.StoreThroughIndirectNode[operandType, operand, CCTypes.GetIndirectType[typeInfo.listStructType], structNode, cc];
RETURN [CreateListNode[operatorType, DeferedLoadListProcs, info]];
END;
DeferedLoadListProcs: REF ListNodeProcs ← NEW[ListNodeProcs ← [coerceToStruct: DeferedLoadCoerceToStruct, extractElement: DeferedLoadListExtractElement, getRepresentation: DeferedLoadGetRepresentation]];
DeferedLoadCoerceToStruct: PROC [listStructType: Type, cc: CC, data: REF ANY] RETURNS [Node] =
BEGIN
info: Lists.ListNodeInfo ← NARROW[data];
RETURN [info.getListStruct[listStructType, cc, info.data]];
END;
DeferedLoadListExtractElement: PROC [index: CARD, listElementType: Type, cc: CC, data: REF ANY] RETURNS [Node] =
BEGIN
info: Lists.ListNodeInfo ← NARROW[data];
indirectElement: Node ← info.getListElements[index, listElementType, cc, info.data];
indirectElementType: Type;
IF indirectElement = NIL THEN RETURN [NIL];
indirectElementType ← CedarCode.GetTypeOfNode[indirectElement];
RETURN [CedarCode.LoadThroughIndirectNode[indirectElementType, indirectElement, cc]];
END;
DeferedLoadGetRepresentation: PROC [data: REF ANY] RETURNS [REF ANY] =
BEGIN
info: Lists.ListNodeInfo ← NARROW[data];
RETURN [info.data];
END;
ListData: TYPE = RECORD [
procs: REF ListNodeProcs,
data: REF ANY];
ListNodeProcs: TYPE = RECORD [
coerceToStruct: PROC [listStructType: Type, cc: CC, data: REF ANY] RETURNS [Node],
extractElement: PROC [index: CARD, listElementType: Type, cc: CC, data: REF ANY] RETURNS [Node],
getRepresentation: PROC [data: REF ANY] RETURNS [REF ANY]];
CreateListNode: PROC [listType: Type, procs: REF ListNodeProcs, data: REF ANY] RETURNS [Node] =
BEGIN
info: REF ListData ← NEW [ListData ← [procs, data]];
RETURN [CedarCode.CreateCedarNode[ListOps, listType, info]];
END;
ListOps: REF CedarCode.OperationsBody ← NEW[CedarCode.OperationsBody ←[
coerce: ListCoerce,
show: ListShow,
getNodeRepresentation: ListGetNodeRepresentation
]];
ListCoerce: PROC [sourceType, targetType: Type, node: Node, cc: CC] RETURNS [Node] =
BEGIN
info: REF ListData ← NARROW[CedarCode.GetDataFromNode[node]];
RETURN [info.procs.coerceToStruct[targetType, cc, info.data]];
END;
ListShow: PROC [to: IO.STREAM, node: Node, depth: INT, width: INT, cc: CC] = {
info: REF ListData ← NARROW[CedarCode.GetDataFromNode[node]];
listType: Type ← CedarCode.GetTypeOfNode[node];
listTypeInfo: ListTypeInfo ← NARROW[CCTypes.GetProcDataFromType[listType]];
elementNode: Node;
i: INT ← 0;
to.PutRope["LIST["];
DO
elementNode ← info.procs.extractElement[i, listTypeInfo.listElementType, cc, info.data];
IF elementNode = NIL THEN EXIT
ELSE i ← i + 1;
IF i>1 THEN to.PutChar[',];
CedarCode.BreakShowNode[to, elementNode, depth-1, width, cc, IF i>1 THEN " " ELSE NIL];
ENDLOOP;
to.PutChar[']];
RETURN};
ListGetNodeRepresentation: PROC[node: Node, cc: CC] RETURNS[REF ANY] =
BEGIN
info: REF ListData ← NARROW[CedarCode.GetDataFromNode[node]];
RETURN [info.procs.getRepresentation[info.data]];
END;
END.