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;


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};


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.
  l  
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

Type operations.
Node operations. 


‌ت
ى  •NewlineDelimiter
™ ڑœ™J™<J™$Icode™1K™7K™&K™;—J™ ڑدk	ک	Kڑœ‌œj‌œbکغJڑœ‌œ)ک9Kڑœ
‌œ”ک£Kڑœ‌œک:Kڑ‌œکKڑœ‌œکKڑœک—Kک Kک ڑذln	œ‌کKڑ‌œ/‌ک8Kڑ‌œک—ڑœ‌
œ	کKک Jڑ‌œ‌œک&Kڑœ‌œکJڑœ‌œکKڑœ‌œک'Kڑœ‌œکJڑ‌œ‌œ&‌œ‌œکNJڑœ
‌œک$Jک Jک J™Kک Kڑœ‌œ‌œک*ڑœ‌œ‌œک!KکKڑœکKڑœ‌œ‌œ‌œ‌œ‌œکHKڑœ‌œ‌œک—Kک ڑدnœ‌œ;‌œ‌œ‌œ‌œ‌œ‌œ‌œ‌œ‌œکہKڑœ‌œMکgKڑœhکhKڑ‌œکKک—Kک ڑدb‌ œ‌œکIKک.KکKکKک&KکKڑœ*ک*Kڑœ"ک"—Jک ڑ ںœ‌œ‌œ‌œ‌œ‌œکxKڑ‌کKڑœ‌œک)ڑ‌œ0‌œ‌ک?Kڑœ‌œPکoKڑ‌œ‌œک—Kڑ‌œک—Kک ڑ œ‌œ‌œ‌œ‌œ‌œ‌œکwKڑ‌کڑ‌œ‌کJڑœ‌œک Jڑ‌œ‌œدc"ک=—Kڑ‌œک—Jک ڑ ںœ‌œ‌œ‌œ‌œ‌œکaKڑ‌کKڑœ‌œک&Kڑœ2ک2Kڑ‌œ6ک<Kڑ‌œک—Jک ڑ ںœ‌œF‌œ‌œ‌œ‌œکژJڑ‌کKڑœ‌œک&Jڑ‌œKکQJڑ‌œک—Jک ڑ ںœ‌œ.‌œ‌œ‌œ‌œکoKڑ‌کKڑœ‌œک&Kک‹Kڑ‌œکKڑ‌œک—Jک ڑ ںœ‌œ
‌œ‌œ‌œ‌œ‌œکrKڑ‌کKڑœ‌œک&KڑœGکGKڑœ|ک|KکDKک3Kڑ‌œکKڑ‌œک—Kک ڑ ‌ œ‌œکQKک$KکKک(Kڑœ"ک"—Jک ڑ ںœ‌œ‌œ‌œ‌œ‌œ‌œک}Kڑ‌کڑ‌œ‌کJڑœ‌œک"Jڑ‌œ‌œ،"ک=—Kڑ‌œک—Jک ڑ ںœ‌œ,‌œ‌œ‌œ‌œکmKڑ‌کک"JککJکJک;——Jڑ‌œکKڑ‌œک—Jک ڑ ںœ‌œ
‌œ"‌œ‌œ‌œ‌œ‌ک{Kڑœ‌œک&KڑœOکOKڑœ\ک\Kک2Kڑ‌œکKڑ‌œک—Kک ڑذbnœ‌œ‌œ‌œ‌œ‌œ‌œ‌œ‌œکwKڑœ‌œک&KڑœکKڑœTکTKڑ‌œک—Kک Kک K™K™ ڑ
ںœ‌œ‌œ‌œ‌œکRKڑ‌œ:ک@Kک—Kک ڑ œ‌œ‌œکOKکKکKکKڑœکKکKکJک—Jک ڑ œ‌œ0‌œ‌œ	ک\Kڑ‌کKڑœ‌œ"کCKڑ‌œ1ک7Kڑ‌œک—J™ ڑ	ں œ‌œL‌œ‌œک„Kڑ‌کKڑœ'‌œ"کOKڑ‌œ9ک?Kڑ‌œک—Kک ڑںœ‌œK‌œکgKڑ‌کKڑœ‌œ*کKKک'Kڑ‌œک—Kک ڑںœ‌œ.‌œ‌œکZKڑœ‌œ*کKKک?Kڑ‌œ@کFKک—Kک ڑ¢œ‌œ‌œ‌œ‌œ	‌œ‌œکVKڑœ‌œ"کCKڑœXکXKڑœکKڑœ0ک0KڑœکKڑ‌œک—Kک ڑں	œ‌œL‌œ‌œ	کoKڑ‌کKڑœ‌œ&کGKڑœ‌œ,کKKکNKڑœ{ک{Kڑ‌œ<کBKڑ‌œک—Kک Kک Kڑ œ‌œ‌œ‍کثKک ڑ œ‌œ‌œ‌œ‌œ‌œ	ک^Kڑ‌کKڑœ‌œک(Kڑ‌œ5ک;Kڑ‌œک—Kک ڑ œ‌œ	‌œ‌œ‌œ‌œ‌œ	کpKڑ‌کKڑœ‌œک(KکTKڑœکKڑ‌œ‌œ‌œ‌œک+Kڑœ?ک?Kڑ‌œOکUKڑ‌œک—Kک ڑ ںœ‌œ‌œ‌œ‌œ‌œ‌œکFKڑ‌کKڑœ‌œک(Kڑ‌œکKڑ‌œک—Kک ڑœ
‌œ‌œکKڑœ‌œکKڑœ‌œ‌œک—Kک ڑœ‌œ‌œکKڑœ‌œ‌œ‌œ‌œ‌œکRKڑœ‌œ	‌œ‌œ‌œ‌œ‌œک`Kڑœ‌œ‌œ‌œ‌œ‌œ‌œک;—Kک ڑںœ‌œ‌œ‌œ‌œ‌œ	ک_Kڑ‌کKڑœ‌œ‌œک5Kڑ‌œ6ک<Kڑ‌œک—Kک ڑ œ‌œ‌œکGKکKکKک0Jک—Jک ڑ 
œ‌œ0‌œ‌œ	کTKڑ‌کKڑœ‌œ‌œ"ک=Kڑ‌œ8ک>Kڑ‌œک—Kک ڑ¢œ‌œ‌œ‌œ‌œ	‌œ‌œکNKڑœ‌œ‌œ"ک=Kڑœ/ک/Kڑœ‌œ(کKKکKڑœ‌œکKکڑ‌کKڑœXکXKڑ‌œ‌œ‌œ‌کKڑ‌œکKڑ‌œ‌œکKڑ	œ=‌œ‌œ‌œ‌œکWKڑ‌œک—KکKڑ‌œک—Jک ڑںœ‌œ‌œ‌œ‌œ‌œکFKڑ‌کKڑœ‌œ‌œ"ک=Kڑ‌œ+ک1Kڑ‌œک—K™ —Kڑ‌œک— …—    )j  5آ  