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
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;
We begin with the objectized ParseTree implementation
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]]};
Following are the general syntactic operations
RHSBinaryOp:
PUBLIC
PROC[op: Operator, left, right: ParseTree, cc: CompilerContext]
RETURNS[TypedCode] =
op one of: plus, minus, div, mult, mod, le, lt, eq, gt, ge, and, or
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] =
op one of: max, min
assumes that args is NOT empty
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] =
op one of: size, bits, bytes, units, words, first, last
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]]};
why is this different from dot? similar questions apply to LHSFieldIdentifier.
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]];
RHSIdentifier:
PUBLIC
PROC[id: Rope.
ROPE, targetType: Type, cc: CompilerContext]
RETURNS[TypedCode] =
{RETURN[LoadIdVal[id, targetType, cc]]};
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.
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;
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.
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;
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.
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..