DIRECTORY
CCTypes USING[Apply, ApplyOperand, BinaryOp, BinaryOperandTypes, BinaryTargetTypes, CCError, CCErrorCase, CoerceToType, Conforms, Constructor, ExtractIdField, GetBooleanType, GetAnyTargetType, GetRTargetType, GetIndirectType, Index, IndexOperand, Load, LoadIdVal, NAryOp, NAryOperandType, Operand, Operator, PairConstructor, SelectIdField, Storable, Store, TypeOp, TypeOp2, TypeOp2OperandType, UnaryOp],
CedarCode USING[ConcatCode, CodeToLoadContentsOfAMNode, CodeToLoadGlobalFrame, CodeToPop, CopyCode, GetTypeOfNode, NullCode],
CedarCodeExtras USING [CodeToDoPoppedCond],
CCirioSyntacticOperations,
CirioSyntacticOperations USING[NameArgPair, ParseTreeFunctions],
CirioTypes USING[Code, CompilerContext, Node, Type, TypedCode],
RefTypes USING[CreateNilRefNode],
Rope USING[ROPE];

CirioSyntacticOperationsImpl: CEDAR PROGRAM
IMPORTS CCTypes, CedarCode, CedarCodeExtras, RefTypes
EXPORTS CCirioSyntacticOperations, CirioSyntacticOperations, CirioTypes, CedarCode
= BEGIN OPEN CCTypes, CirioTypes;

CCE: ERROR[case: CCTypes.CCErrorCase _ syntax, msg: Rope.ROPE _ NIL] _ CCTypes.CCError;
ParseTree: TYPE = REF ParseTreeBody;
ParseTreeBody: PUBLIC TYPE = RECORD[
functions: REF ParseTreeFunctions,
data: REF ANY];

ParseTreeFunctions: TYPE = CirioSyntacticOperations.ParseTreeFunctions;

CreateParseTree: PUBLIC PROC[functions: REF ParseTreeFunctions, data: REF ANY] RETURNS[ParseTree] =
{RETURN[NEW[ParseTreeBody_[functions, data]]]};

NilParseTree: PUBLIC PROC [tree: ParseTree] RETURNS [BOOLEAN] =
{RETURN [tree.data = NIL]};

CompileForRHS: PUBLIC PROC[tree: ParseTree, nominalTarget: CirioTypes.Type, cc: CompilerContext] RETURNS[TypedCode] =
{RETURN[tree.functions.compileForRHS[tree, nominalTarget, cc, tree.data]]};

CompileForLHS: PUBLIC PROC[tree: ParseTree, cc: CompilerContext] RETURNS[TypedCode] =
{RETURN[tree.functions.compileForLHS[tree, cc, tree.data]]};

CompileAsFieldExtraction: PUBLIC PROC[tree: ParseTree, fieldContext: CirioTypes.Type, cc: CompilerContext] RETURNS[TypedCode] =
{RETURN[tree.functions.compileAsFieldExtraction[tree, fieldContext, cc, tree.data]]};

CompileAsFieldSelection: PUBLIC PROC[tree: ParseTree, fieldIndirectContext: CirioTypes.Type, cc: CompilerContext] RETURNS[TypedCode] =
{RETURN[tree.functions.compileAsFieldExtraction[tree, fieldIndirectContext, cc, tree.data]]};

ShowParseTree: PUBLIC PROC [tree: ParseTree, cc: CompilerContext] RETURNS [Rope.ROPE] = {RETURN [tree.functions.showParseTree[tree, cc, tree.data]]};




RHSBinaryOp: PUBLIC PROC[op: Operator, left, right: ParseTree, cc: CompilerContext] RETURNS[TypedCode] =
BEGIN
leftTC: TypedCode _ CompileForRHS[left, GetAnyTargetType[cc], cc];
rightTC: TypedCode _ CompileForRHS[right, leftTC.type, cc];
tc1: TypedCode _ Operand[op, left, leftTC, cc];
tc2: TypedCode _ Operand[op, right, rightTC, cc];
targetTypes: BinaryTargetTypes _ BinaryOperandTypes[op, tc1.type, tc2.type, cc];
tc3: TypedCode _ CoerceToType[targetTypes.tLeft, tc1, cc];
tc4: TypedCode _ CoerceToType[targetTypes.tRight, tc2, cc];
RETURN[BinaryOp[op, tc3, tc4, cc]]; 
END;

RHSUnaryOp: PUBLIC PROC[op: Operator, arg: ParseTree, cc: CompilerContext] RETURNS[TypedCode] ~ {
argTC: TypedCode _ SELECT op FROM
$address => CompileForLHS[arg, cc],
ENDCASE => CompileForRHS[arg, GetAnyTargetType[cc], cc];
RETURN AddUnaryOp[argTC, op, cc]};

AddUnaryOp: PUBLIC PROC [argTC: TypedCode, op: Operator, cc: CompilerContext] RETURNS [TypedCode] ~ {
tc1: TypedCode ~ Operand[op, unary, argTC, cc];
RETURN[UnaryOp[op, tc1, cc]]};

RHSnAryOp: PUBLIC PROC[op: Operator, args: LIST OF ParseTree, cc: CompilerContext] RETURNS[TypedCode] =
BEGIN
tcs1: LIST OF TypedCode _ NIL;
tcs1Last: LIST OF TypedCode _ NIL;
tType: Type;
argCode: LIST OF TypedCode _ NIL;
lastArgCode: LIST OF TypedCode _ NIL;


FOR lpt: LIST OF ParseTree _ args, lpt.rest WHILE lpt # NIL DO
tc: TypedCode _ CompileForRHS[lpt.first, GetAnyTargetType[cc], cc];
tc1: TypedCode _ Operand[op, nary, tc, cc];
tc1Cell: LIST OF TypedCode _ LIST[tc1];
IF tcs1 = NIL THEN tcs1 _ tc1Cell ELSE tcs1Last.rest _ tc1Cell;
tcs1Last _ tc1Cell;
ENDLOOP;

tType _ NAryOperandType[op, tcs1.first.type, tcs1.first.type, cc];

FOR ltc: LIST OF TypedCode _ tcs1.rest, ltc.rest WHILE ltc # NIL DO
tType _ NAryOperandType[op, tType, ltc.first.type, cc];
ENDLOOP;

FOR ltc: LIST OF TypedCode _ tcs1, ltc.rest WHILE ltc # NIL DO
argtc: TypedCode _ CoerceToType[tType, ltc.first, cc];
cell: LIST OF TypedCode _ LIST[argtc];
IF argCode = NIL THEN argCode _ cell ELSE lastArgCode.rest _ cell;
lastArgCode _ cell;
ENDLOOP;

RETURN[NAryOp[op, argCode, cc]];
END;

RHSTypeOp: PUBLIC PROC[op: Operator, type: Type, cc: CompilerContext] RETURNS[TypedCode] =
BEGIN
RETURN[TypeOp[op, type, cc]];
END;

RHSTypeOp2: PUBLIC PROC[op: Operator, type: Type, param: ParseTree, cc: CompilerContext] RETURNS[TypedCode] =
BEGIN
eType: Type _ TypeOp2OperandType[op, type, cc];
paramTC: TypedCode _ CompileForRHS[param, eType, cc];
tc1: TypedCode _ CoerceToType[eType, paramTC, cc];
RETURN[TypeOp2[op, type, tc1, cc]];
END;

RHSAssignment: PUBLIC PROC[left, right: ParseTree, cc: CompilerContext] RETURNS[TypedCode] =
BEGIN
ltc1: TypedCode _ CompileForLHS[left, cc];
storageType: Type _ CCTypes.GetRTargetType[ltc1.type, cc];
rtc1: TypedCode _ CompileForRHS[right, storageType, cc];
targetTypes: BinaryTargetTypes _ BinaryOperandTypes[$assign, ltc1.type, rtc1.type, cc];
ltc2: TypedCode _ CoerceToType[targetTypes.tLeft, ltc1, cc];
rtc2: TypedCode _ CoerceToType[targetTypes.tRight, rtc1, cc];
IF NOT Storable[rtc2.type, ltc2.type, cc] THEN CCE[cirioError, "not storable"];
RETURN[Store[rtc2, ltc2, cc]];
END;

RHSBinOpAssignment: PUBLIC PROC[op: Operator, left, right: ParseTree, cc: CompilerContext] RETURNS[TypedCode] =
BEGIN
ltc1l: TypedCode _ CompileForLHS[left, cc];
ltc1r: TypedCode _ Load[[CedarCode.CopyCode[ltc1l.code], ltc1l.type], cc];
storageType: Type _ CCTypes.GetRTargetType[ltc1l.type, cc];
rtc1: TypedCode _ CompileForRHS[right, storageType, cc];
tcOpL1: TypedCode ~ Operand[op, left, ltc1r, cc];
tcOpR1: TypedCode ~ Operand[op, right, rtc1, cc];
opTypes: BinaryTargetTypes _ BinaryOperandTypes[op, tcOpL1.type, tcOpR1.type, cc];
ltc2r: TypedCode _ CoerceToType[opTypes.tLeft, ltc1r, cc];
rtc2: TypedCode _ CoerceToType[opTypes.tRight, rtc1, cc];
otc1: TypedCode _ BinaryOp[op, ltc2r, rtc2, cc];
asgnTypes: BinaryTargetTypes _ BinaryOperandTypes[$assign, ltc1l.type, otc1.type, cc];
ltc2l: TypedCode _ CoerceToType[asgnTypes.tLeft, ltc1l, cc];
otc2: TypedCode _ CoerceToType[asgnTypes.tRight, otc1, cc];
IF NOT Storable[rtc2.type, ltc2l.type, cc] THEN CCE[cirioError];
RETURN[Store[otc2, ltc2l, cc]];
END;

RHSDot: PUBLIC PROC[left, right: ParseTree, cc: CompilerContext] RETURNS[TypedCode] =
BEGIN
leftTC: TypedCode _ CompileForRHS[left, GetAnyTargetType[cc], cc];
tc1: TypedCode _ Operand[$dot, unary, leftTC, cc];
rightTC: TypedCode _ CompileAsFieldExtraction[right, tc1.type, cc];
RETURN[[CedarCode.ConcatCode[tc1.code, rightTC.code], rightTC.type]];
END;

RHSApply: PUBLIC PROC[left, right: ParseTree, cc: CompilerContext] RETURNS[TypedCode] =
BEGIN
leftTC: TypedCode _ CompileForRHS[left, GetAnyTargetType[cc], cc];
ltc1: TypedCode _ Operand[$apply, left, leftTC, cc];
rtc1: TypedCode _ ApplyOperand[ltc1.type, right, cc];
RETURN[Apply[ltc1, rtc1, cc]];
END;

RHSCons: PUBLIC PROC [list: ParseTree, targetType: Type, cc: CompilerContext] RETURNS [TypedCode] =
BEGIN
ltc: TypedCode _ TypeOp[$cons, targetType, cc];
rtc: TypedCode _ ApplyOperand[targetType, list, cc];
RETURN [Apply[ltc, rtc, cc]];
END;

RHSConstructor: PUBLIC PROC[list: LIST OF ParseTree, targetType: Type, cc: CompilerContext] RETURNS[TypedCode] =
{RETURN[CCTypes.Constructor[list, targetType, cc]]};

RHSPairConstructor: PUBLIC PROC[list: LIST OF CirioSyntacticOperations.NameArgPair, targetType: Type, cc: CompilerContext] RETURNS[TypedCode] =
{RETURN[CCTypes.PairConstructor[list, targetType, cc]]};

RHSFieldIdentifier: PUBLIC PROC[id: Rope.ROPE, fieldContext: Type, cc: CompilerContext] RETURNS[TypedCode] =
BEGIN
tc1: TypedCode _ Operand[$extractId, unary, [CedarCode.NullCode[], fieldContext], cc];
tc2: TypedCode _ ExtractIdField[id, tc1.type, cc];
code: Code _ CedarCode.ConcatCode[tc1.code, tc2.code];
RETURN[[code, tc2.type]];
END;
RHSIdentifier: PUBLIC PROC[id: Rope.ROPE, targetType: Type, cc: CompilerContext] RETURNS[TypedCode] =
{RETURN[LoadIdVal[id, targetType, cc]]};

RHSNil: PUBLIC PROC[pointerType: Type, cc: CompilerContext] RETURNS[TypedCode] =
{RETURN[RHSLiteral[RefTypes.CreateNilRefNode[cc], cc]]};

RHSLiteral: PUBLIC PROC[literalValue: CirioTypes.Node, cc: CompilerContext] RETURNS[TypedCode] =
BEGIN
code: CirioTypes.Code _ CedarCode.CodeToLoadContentsOfAMNode[literalValue];
type: Type _ CedarCode.GetTypeOfNode[literalValue];
RETURN[[code, type]];
END;

RHSGlobalFrame: PUBLIC PROC [name: Rope.ROPE, nToSkip: INT, cc: CompilerContext] RETURNS[TypedCode] ~ {
code: CirioTypes.Code _ CedarCode.CodeToLoadGlobalFrame[name, nToSkip];
type: Type _ CCTypes.GetBooleanType[cc];
RETURN [[code, type]]};

RHSComma: PUBLIC PROC [left, right: ParseTree, cc: CompilerContext] RETURNS [TypedCode] ~ 
BEGIN
leftTC: TypedCode _ CompileForRHS[left, GetAnyTargetType[cc], cc];
rightTC: TypedCode _  CompileForRHS[right, GetAnyTargetType[cc], cc];
RETURN[[CedarCode.ConcatCode[CedarCode.ConcatCode[leftTC.code, CedarCode.CodeToPop[1]], rightTC.code], rightTC.type]];
END;

RHSCond: PUBLIC PROC [test, trueCase, falseCase: ParseTree, cc: CompilerContext] RETURNS [TypedCode] ~ {
testTC: TypedCode ~ CompileForRHS[test, GetAnyTargetType[cc], cc];
trueCaseTC: TypedCode ~ CompileForRHS[trueCase, GetAnyTargetType[cc], cc];
falseCaseTC: TypedCode ~ CompileForRHS[falseCase, trueCaseTC.type, cc];
bogon1: Type ~ GetIndirectType[falseCaseTC.type];
IF NOT Conforms[trueCaseTC.type, bogon1, cc] THEN CCE[unimplemented, "if-then-else only implemented for conforming TRUE-case and FALSE-case TYPEs"];
RETURN [[CedarCodeExtras.CodeToDoPoppedCond[testTC.code, trueCaseTC.code, falseCaseTC.code], trueCaseTC.type]]};

LHSFieldIdentifier: PUBLIC PROC[id: Rope.ROPE, fieldIndirectContext: Type, cc: CompilerContext] RETURNS[TypedCode] =
{RETURN[SelectIdField[id, fieldIndirectContext, cc]]};

LHSIdentifier: PUBLIC PROC[id: Rope.ROPE, cc: CompilerContext] RETURNS[TypedCode] =
BEGIN
nameScopeNode: CirioTypes.Node _ cc.nameScope;
nameScope: TypedCode _ [
code: CedarCode.CodeToLoadContentsOfAMNode[nameScopeNode],
type: CedarCode.GetTypeOfNode[nameScopeNode]];
select: TypedCode _ SelectIdField[id, nameScope.type, cc];
RETURN[
[CedarCode.ConcatCode[
nameScope.code,
select.code],
select.type]];
END;

LHSDot: PUBLIC PROC[left: ParseTree, id: Rope.ROPE, cc: CompilerContext] RETURNS[TypedCode] =
BEGIN
firstIndirect: TypedCode _ CompileForLHS[left, cc];
tc2: TypedCode _ Operand[$selectId, unary, firstIndirect, cc];
finalIndirect: TypedCode _ SelectIdField[id, tc2.type, cc];
RETURN[
[CedarCode.ConcatCode[
firstIndirect.code,
finalIndirect.code],
finalIndirect.type]];
END;

LHSuparrow: PUBLIC PROC[left: ParseTree, cc: CompilerContext] RETURNS[TypedCode] =
BEGIN
firstIndirect: TypedCode _ CompileForLHS[left, cc];
tc2: TypedCode _ Operand[$leftSideuparrow, unary, firstIndirect, cc];
finalIndirect: TypedCode _ UnaryOp[$leftSideuparrow, tc2, cc];
RETURN[finalIndirect];
END;

LHSapply: PUBLIC PROC[left, right: ParseTree, cc: CompilerContext] RETURNS[TypedCode] =
BEGIN
firstIndirect: TypedCode _ CompileForLHS[left, cc];
ltc2: TypedCode _ Operand[$index, left, firstIndirect, cc];
rtc1: TypedCode _ IndexOperand[ltc2.type, right, cc];
finalIndirect: TypedCode _ Index[ltc2, rtc1, cc];
RETURN[finalIndirect];
END;



END..
*
CirioSyntacticOperationsImpl.mesa
Copyright Σ 1990 by Xerox Corporation.  All rights reserved.
Sturgis, March 5, 1989 4:13:52 pm PST
Last changed by Theimer on August 9, 1989 11:58:40 pm PDT
Hopcroft July 26, 1989 11:02:10 am PDT
Last tweaked by Mike Spreitzer on May 3, 1991 2:17 pm PDT

Started: November 5, 1988 3:31:32 pm PST
Sturgis: November 5, 1988 3:51:33 pm PST


We begin with the objectized ParseTree implementation

Following are the general syntactic operations
op one of: plus, minus, div, mult, mod, le, lt, eq, gt, ge, and, or
op one of: max, min
assumes that args is NOT empty
op one of: size, bits, bytes, units, words, first, last
why is this different from dot?  similar questions apply to LHSFieldIdentifier.

We choose an implementation which is insensitive to the pointer type, now that we have a NIL REF TYPE.  The old implementation depended on a Type Proc called LoadNil, which was specific to each pointer type.
We assume that firstIndirect produces an indirect to a pointer style value (e.g., a ref, a pointer, ...).  In this case, finalIndirect produces an indirect through which to store a value.
We assume that firstIndirect produces an indirect to a pointer style value (e.g., a ref, a pointer, ...).  In this case, finalIndirect produces an indirect through which to store a value.
Κ
•NewlineDelimiter

™
codeš
œ!™!K™<Kš
œ%™%K™9K™&K™9—K™Kš
œ(™(Kš
œ(™(K™š
Οk	˜	Kšœœ†˜“Kšœ
œn˜}Kšœœ˜+Kš
œ˜Kšœœ"˜@Kšœœ/˜?Kšœ	œ˜!Kšœœ
œ˜—K˜šΟnœœ
˜+Kšœ.˜5KšœK˜R—Kšœœ
œ˜!K˜Kšœœ/œœ˜WK™Kš
œ5™5K™Kšœœœ˜$šœœ
œœ
˜$Kšœœ˜"Kšœœ
œ˜—K˜Kšœœ/˜GK˜šžœœ
œœœ
œœ
˜cKšœ
œ
œ$˜/—K˜š
žœœ
œœœ˜?Kšœ
œœ˜—K˜šž
œœ
œGœ
˜uKšœ
œD˜K—K˜šž
œœ
œ'œ
˜UKšœ
œ5˜<—K˜šžœœ
œFœ
˜Kšœ
œN˜U—K˜šžœœ
œNœ
˜†
Kšœ
œV˜]—K˜Kš
ž
œœ(œœœ6˜•
K˜K˜K˜Kš
œ.™.K˜šžœœ
œ<œ
˜hKš
œC™CKš
˜K˜BK˜;K˜/K˜1K˜PK˜:K˜;Kšœ˜$Kšœ
˜—K˜šž
œœ
œ4œ˜ašœœ˜!K˜#Kšœ1˜8—Kšœ˜"—K˜šž
œœ
œ7œ˜eK˜/Kšœ˜—K˜šž	œœ
œœ
œ!œ
˜gKš
œ™Kš
œ™Kš
˜Kšœœ
œ
œ
˜Kšœ
œ
œ
œ
˜"K˜Kšœ	œ
œ
œ
˜!Kšœ
œ
œ
œ
˜%K˜K˜šœœ
œœœ
˜>K˜CK˜+Kšœ	œ
œ
œ˜'Kšœœ
œœ˜?K˜Kšœ
˜—K˜K˜BK˜šœœ
œ!œœ
˜CK˜7Kšœ
˜—K˜šœœ
œœœ
˜>K˜6Kšœœ
œ
œ˜&Kšœœ
œœ˜BK˜Kšœ
˜—K˜Kšœ˜ Kšœ
˜—K˜šž	œœ
œ0œ
˜ZKš
œ7™7Kš
˜Kšœ˜Kšœ
˜—K˜šž
œœ
œBœ
˜mKš
˜K˜/K˜5K˜2Kšœ˜#Kšœ
˜—K˜šž
œœ
œ.œ
˜\Kš
˜K˜*K˜:K˜8K˜WK˜<K˜=Kšœ
œ$œ
œ˜OKšœ˜Kšœ
˜—K˜šžœœ
œ<œ
˜oKš
˜K˜+Kš
œJ˜JK˜;K˜8K˜1K˜1K˜RK˜:K˜9Kš
œ0˜0Kš
œV˜VK˜<K˜;Kšœ
œ%œ
œ
˜@Kšœ˜Kšœ
˜—K˜šžœœ
œ.œ
˜UKš
˜K˜BK˜2K˜CKšœ?˜EKšœ
˜—K˜šžœœ
œ.œ
˜WKš
˜K˜BK˜4K˜5Kšœ˜Kšœ
˜—K˜šžœœ:œ˜cKš
˜K˜/Kš
œ4˜4Kšœ˜Kšœ
˜—K˜šžœœ
œœ
œ3œ
˜pKšœ
œ-˜4—K˜šžœœ
œœ
œNœ
˜
Kšœ
œ1˜8—˜Kš
œO™O—š
žœœ
œ
œ+œ
˜lKš
˜K˜VK˜2K˜6Kšœ˜šœ
˜K™——š
ž
œœ
œ
œ)œ
˜eKšœ
œ!˜(—˜Kš
œΟ
™Ο
—šžœœ
œ)œ
˜PKšœ
œ1˜8K˜—šž
œœ
œ5œ
˜`Kš
˜K˜KK˜3Kšœ˜Kšœ
˜—K˜šžœœ
œ
œœœ˜gKš
œG˜GKš
œ(˜(Kšœ˜—K˜šžœœ
œ/œ˜ZKš
˜Kš
œB˜BKš
œE˜EKšœp˜vKšœ
˜—K˜šžœœ
œ=œ˜hKš
œB˜BKš
œJ˜JKš
œG˜GKš
œ1˜1Kšœ
œ'œ
œ_˜”
Kšœj˜p—K˜š
žœœ
œ
œ3œ
˜tKšœ
œ/˜6K˜—š
ž
œœ
œ
œœ
˜SKš
˜K˜.˜K˜:K˜.—K˜:šœ
˜˜K˜K˜
—K˜—Kšœ
˜—˜Kš
œ»
™»
—š
žœœ
œœœ
˜]Kš
˜K˜3K˜>K˜;šœ
˜˜K˜K˜—K˜—Kšœ
˜—˜Kš
œ»
™»
—šž
œœ
œ'œ
˜RKš
˜K˜3K˜EK˜>Kšœ˜Kšœ
˜—K˜šžœœ
œ.œ
˜WKš
˜K˜3K˜;K˜5K˜1Kšœ˜Kšœ
˜—K˜K˜K˜Kšœ˜—…—-V<‹