WalkCedarParseTreesImpl.mesa
Copyright Ó 1990 by Xerox Corporation. All rights reserved.
Sturgis: March 5, 1989 4:07:45 pm PST
Last changed by Theimer on August 9, 1989 11:58:43 pm PDT
Hopcroft July 26, 1989 10:21:00 am PDT
Spreitze, May 27, 1991 7:16 pm PDT
DIRECTORY
CCTypes USING[CCError, CCErrorCase, GetAnyTargetType, GetCharType, GetIndirectType, GetRopeType, GetTargetTypeOfIndirect, Operator],
CedarCode,
CedarNumericTypes USING[CreateNumericNode, CreateNumericType],
CedarOtherPureTypes USING[CreateCharNode, CreateRopeNode],
CirioSyntacticOperations USING[CompileForRHS, CreateParseTree, ParseTree, ParseTreeFunctions, LHSapply, LHSDot, LHSFieldIdentifier, LHSIdentifier, LHSuparrow, NameArgPair, RHSApply, RHSCons, RHSAssignment, RHSBinaryOp, RHSConstructor, RHSDot, RHSFieldIdentifier, RHSIdentifier, RHSLiteral, RHSnAryOp, RHSNil, RHSPairConstructor, RHSUnaryOp],
CirioTypes USING[CompilerContext, Node, Type, TypedCode],
IO USING [PutFR, int, real, card, char],
PPLeaves USING[HTIndex, LTIndex],
PPTree USING[Link, Node, NodeName],
Procedures USING [ProcLiteral, CreateProcLiteralType, CreateProcLiteralNode],
Rope USING[Equal, Fetch, ROPE, Cat],
Types,
WalkCedarParseTrees USING[];
WalkCedarParseTreesImpl:
CEDAR
PROGRAM
IMPORTS CCTypes, CedarCode, CedarNumericTypes, CedarOtherPureTypes, CirioSyntacticOperations, IO, Procedures, Rope, Types
EXPORTS WalkCedarParseTrees
= BEGIN OPEN CSO: CirioSyntacticOperations;
Type: TYPE = CirioTypes.Type;
TypedCode: TYPE = CirioTypes.TypedCode;
CompilerContext: TYPE = CirioTypes.CompilerContext;
Operator: TYPE = CCTypes.Operator;
CC: TYPE = CirioTypes.CompilerContext;
CCError: ERROR[case: CCTypes.CCErrorCase ← syntax, msg: Rope.ROPE ← NIL] ← CCTypes.CCError;
CreatePPTreeParseTree:
PUBLIC
PROC[tree: PPTree.Link, cc: CompilerContext]
RETURNS[
CSO.ParseTree] =
{RETURN[CSO.CreateParseTree[PTF, tree]]};
PTF:
REF
CSO.ParseTreeFunctions ←
NEW[
CSO.ParseTreeFunctions←[
CompileCedarPTExpForRHS,
CompileCedarPTExpForLHS,
CompileCedarPTExpAsFieldExtraction,
CompileCedarPTExpAsFieldSelection,
CompileCedarPTExpShowParseTree]];
CompileCedarPTExpForLHS:
PROC[tree:
CSO.ParseTree, cc: CompilerContext, data:
REF
ANY]
RETURNS[TypedCode] =
BEGIN
pptree: PPTree.Link ← NARROW[data];
WITH pptree
SELECT
FROM
hti: PPLeaves.HTIndex =>
RETURN[
CSO.LHSIdentifier[hti.name, cc]];
we have an identifier in hand
node:
REF PPTree.Node =>
BEGIN
kind: PPTree.NodeName = node.name;
nSons: CARDINAL ← node.sonLimit - 1;
son1: PPTree.Link ← IF nSons > 0 THEN node.son[1] ELSE NIL;
son2: PPTree.Link ← IF nSons > 1 THEN node.son[2] ELSE NIL;
left: CSO.ParseTree ← CreatePPTreeParseTree[son1, cc];
SELECT node.name
FROM
dot =>
BEGIN
WITH son2
SELECT
FROM
hti: PPLeaves.HTIndex => RETURN[CSO.LHSDot[left, hti.name, cc]];
ENDCASE => CCError[]; -- bad syntax?
END;
uparrow =>
RETURN[CSO.LHSuparrow[left, cc]];
apply => RETURN CompileApply[son1, son2, cc, left];
ENDCASE => CCError[unimplemented]; -- we havn't implemented all the possibilities
END;
ENDCASE => CCError[unimplemented];
END;
CompileCedarPTExpForRHS:
PROC[tree:
CSO.ParseTree, nominalTarget: Type, cc: CompilerContext, data:
REF
ANY]
RETURNS[TypedCode] =
BEGIN
pptree: PPTree.Link ← NARROW[data];
WITH pptree
SELECT
FROM
node: REF PPTree.Node => RETURN [EvalNode[node, nominalTarget, cc]];
hti: PPLeaves.HTIndex => RETURN[CSO.RHSIdentifier[hti.name, nominalTarget, cc]];
lti: PPLeaves.LTIndex =>
-- we have a literal in hand
BEGIN
WITH lti.value
SELECT
FROM
int:
REF
INT =>
BEGIN -- because the parser returns a negative int when it should return a large CARD we have to make a test
IF int^ >= 0
THEN
RETURN[
CSO.RHSLiteral[CreateNodeFromLiteral[int, cc], cc]]
ELSE
BEGIN
assume that the first char is either a digit or a sign
SELECT Rope.Fetch[lti.literal, 0]
FROM
'+, '0, '1, '2, '3, '4, '5, '6, '7, '8, '9 =>
-- client intended a large CARD
RETURN[
CSO.RHSLiteral[CreateNodeFromLiteral[
NEW[
CARD32←
LOOPHOLE[int^]], cc], cc]];
I probably could have avoided the loophole by appropriate arithmetic, first in the INT32 domain and then in the CARD32 domain. However, the correctness of that arithmetic is just as dependent on representations as is the use of LOOPHOLE.
'- => {RETURN[CSO.RHSLiteral[CreateNodeFromLiteral[int, cc], cc]]};
ENDCASE => CCError[cirioError]; -- my assumption wasn't true
END;
END;
card: REF CARD => RETURN [CSO.RHSLiteral[CreateNodeFromLiteral[card, cc], cc]];
real: REF REAL => RETURN[CSO.RHSLiteral[CreateNodeFromLiteral[real, cc], cc]];
rope: REF Rope.ROPE => RETURN[CSO.RHSLiteral[CreateNodeFromLiteral[rope, cc], cc]];
proc: REF Procedures.ProcLiteral => RETURN [CSO.RHSLiteral[CreateNodeFromLiteral[proc, cc], cc]];
ENDCASE => CCError[unimplemented, "unimplemented literal encountered"];
END;
ENDCASE => CCError[unimplemented, "unimplemented type encountered"];
END;
EvalNode:
PROC[node:
REF PPTree.Node, nominalTarget: Type, cc: CompilerContext]
RETURNS[TypedCode] =
BEGIN
kind: PPTree.NodeName = node.name;
nSons: CARDINAL ← node.sonLimit - 1;
son1: PPTree.Link ← IF nSons > 0 THEN node.son[1] ELSE NIL;
son2: PPTree.Link ← IF nSons > 1 THEN node.son[2] ELSE NIL;
SELECT kind
FROM
-- only expression types, extremly few of them
or, and, not, relE, relN, relL, relGE, relG, relLE,
plus, uminus, minus, times, div, mod, uparrow =>
-- unary or binary operator
BEGIN
SELECT nSons
FROM
1 =>
-- unary operator
BEGIN
op: Operator ←
SELECT kind
FROM
not => $not,
uminus => $minus,
plus => $plus,
uparrow => $uparrow,
ENDCASE => CCError[unimplemented];
arg: CSO.ParseTree ← CreatePPTreeParseTree[son1, cc];
RETURN[CSO.RHSUnaryOp[op, arg, cc]];
END;
2 =>
-- binary operator
BEGIN
op: Operator ←
SELECT kind
FROM
-- IS THIS LIST COMPLETE?
or => $or,
and => $and,
relE => $eq,
relN => $ne,
relL => $lt,
relG => $gt,
relGE => $ge,
relLE => $le,
plus => $plus,
minus => $minus,
times => $mult,
div => $div,
mod => $mod,
ENDCASE => CCError[cirioError];
left: CSO.ParseTree ← CreatePPTreeParseTree[son1, cc];
right: CSO.ParseTree ← CreatePPTreeParseTree[son2, cc];
RETURN[CSO.RHSBinaryOp[op, left, right, cc]];
END;
ENDCASE => CCError[cirioError]; -- shouldn't happen
mwconst =>
BEGIN
IF nSons # 1 THEN CCError[cirioError]; -- shouldn't happen
RETURN[CompileCedarPTExpForRHS[NIL, nominalTarget, cc, son1]];
END;
max, min =>
BEGIN
list: REF PPTree.Node ← NARROW[son1];
argList: LIST OF CSO.ParseTree ← BuildArgList[list, cc];
op: Operator ←
SELECT kind
FROM
max => $max,
min => $min,
ENDCASE => CCError[cirioError]; -- shouldn't happen
IF nSons # 1 THEN CCError[cirioError]; -- shouldn't happen
IF list.name # list THEN CCError[cirioError]; -- shouldn't happen
RETURN[CSO.RHSnAryOp[op, argList, cc]];
END;
assignx, dot =>
BEGIN
left: CSO.ParseTree ← CreatePPTreeParseTree[son1, cc];
right: CSO.ParseTree ← CreatePPTreeParseTree[son2, cc];
IF nSons # 2 THEN CCError[cirioError];
SELECT kind
FROM
assignx => RETURN[CSO.RHSAssignment[left, right, cc]];
dot => RETURN[CSO.RHSDot[left, right, cc]];
ENDCASE => CCError[cirioError];
END;
apply =>
BEGIN
IF nSons # 2 THEN CCError[cirioError];
IF son1 =
NIL
THEN
BEGIN -- simply a record constructor (or array constructor?)
list: REF PPTree.Node ← NARROW[son2];
nItems: INT ← list.sonLimit-1;
IF nItems = 0
THEN
RETURN[CSO.RHSConstructor[NIL, nominalTarget, cc]];
At this point we must decide whether we are dealing with a name:arg pair list, or simply a list of args
WITH list.son[1]
SELECT
FROM
node:
REF PPTree.Node =>
BEGIN
SELECT
NARROW[list.son[1],
REF PPTree.Node].name
FROM
item => RETURN[CSO.RHSPairConstructor[BuildNameArgPairList[list, cc], nominalTarget, cc]];
ENDCASE => RETURN[CSO.RHSConstructor[BuildArgList[list, cc], nominalTarget, cc]];
END;
ENDCASE => RETURN[CSO.RHSConstructor[BuildArgList[list, cc], nominalTarget, cc]];
END
ELSE RETURN CompileApply[son1, son2, cc, right];
END;
list =>
BEGIN -- presumably a list of arguments to a procedure or an index to an array
we must decide whether we are dealing with a name:arg pair list, or simply a list of args
this code matches that in apply where son1 = nil, perhaps there is a way to combine them?
IF node.sonLimit = 1
THEN
-- the list is empty
RETURN[CSO.RHSConstructor[BuildArgList[node, cc], nominalTarget, cc]];
WITH node.son[1]
SELECT
FROM
son1Node:
REF PPTree.Node =>
BEGIN
SELECT
NARROW[node.son[1],
REF PPTree.Node].name
FROM
item => RETURN[CSO.RHSPairConstructor[BuildNameArgPairList[node, cc], nominalTarget, cc]];
ENDCASE => RETURN[CSO.RHSConstructor[BuildArgList[node, cc], nominalTarget, cc]];
END;
ENDCASE => RETURN[CSO.RHSConstructor[BuildArgList[node, cc], nominalTarget, cc]];
END;
clit =>
BEGIN
WITH son1
SELECT
FROM
lti: PPLeaves.LTIndex =>
-- we have a literal in hand
WITH lti.value
SELECT
FROM
char: REF CHAR => RETURN[CSO.RHSLiteral[CreateNodeFromLiteral[char, cc], cc]];
ENDCASE => CCError[cirioError];
ENDCASE => CCError[cirioError];
END;
nil => RETURN[CSO.RHSNil[nominalTarget, cc]];
cons =>
BEGIN
IF (nSons # 2) OR (son1 # NIL) THEN CCError[cirioError];
WITH son2
SELECT
FROM
node:
REF PPTree.Node =>
BEGIN
list: CSO.ParseTree ← CreatePPTreeParseTree[node, cc];
RETURN[CSO.RHSCons[list, nominalTarget, cc]];
END;
ENDCASE => CCError[cirioError];
END;
addr =>
BEGIN
arg: CSO.ParseTree ← CreatePPTreeParseTree[son1, cc];
IF nSons # 1 THEN CCError[cirioError]; -- shouldn't happen
RETURN[CSO.RHSUnaryOp[$address, arg, cc]];
END;
ENDCASE => CCError[unimplemented, "unimplemented pptree node encountered"];
END;
CompileApply:
PROC [son1, son2: PPTree.Link, cc:
CC, side: {left, right}]
RETURNS [TypedCode] ~ {
WITH son1
SELECT
FROM
hti: PPLeaves.HTIndex =>
IF hti.name.Equal["GLOBALVARS"]
THEN {
name: Rope.ROPE ← NIL;
nToSkip: INT ← 0;
gf: CirioTypes.Node ← NIL;
gft: CirioTypes.Type;
litTc: TypedCode;
IF son2#
NIL
THEN
WITH son2
SELECT
FROM
node:
REF PPTree.Node =>
SELECT node.name
FROM
list => {
IF node.sonLimit < 2 OR node.sonLimit > 3 THEN CCError[operation, "GLOBALVARS[] must be given a program name, maybe a number to skip, and no more"];
WITH node.son[1]
SELECT
FROM
hti2: PPLeaves.HTIndex => name ← hti2.name;
ENDCASE => ERROR CCError[operation, "The first argument to GLOBALVARS[] must be a literal program name"];
IF node.sonLimit>2
THEN
WITH node.son[2]
SELECT
FROM
lti: PPLeaves.LTIndex =>
WITH lti.value
SELECT
FROM
ri: REF INT => nToSkip ← ri^;
rc: REF CARD => IF rc^ < INT.LAST THEN nToSkip ← rc^ ELSE ERROR CCError[operation, "The second argument to GLOBALVARS[] must be a literal integer (in [0..INT.LAST])"];
ENDCASE => ERROR CCError[operation, "The second, literal, argument to GLOBALVARS[] must be a literal number"];
ENDCASE => ERROR CCError[operation, "The second argument to GLOBALVARS[] must be a literal integer"];
};
ENDCASE => ERROR CCError[operation, "The arguments to GLOBALVARS must be a list or identifier"];
hti2: PPLeaves.HTIndex => name ← hti2.name;
ENDCASE => ERROR CCError[operation, "GLOBALVARS[] must be given a literal program name"]
ELSE ERROR CCError[operation, "GLOBALVARS[] must be given a literal program name (and maybe a number to skip)"];
IF cc.moduleScope=NIL THEN CCError[operation, "current compiler context cannot fetch global frames"];
gf ← cc.moduleScope.GetModule[cc.moduleScope, name, nToSkip];
IF gf=NIL THEN CCError[operation, IO.PutFR["can't get global vars for module %g skip %g", [rope[name]], [integer[nToSkip]] ]];
gft ← CedarCode.GetTypeOfNode[gf];
litTc ← CSO.RHSLiteral[gf, cc];
SELECT side
FROM
left => RETURN [litTc];
right => RETURN[[code: CedarCode.ConcatCode[litTc.code, CedarCode.CodeToLoadThroughIndirect[gft]], type: CCTypes.GetTargetTypeOfIndirect[gft]]];
ENDCASE => ERROR;
}
ELSE
IF hti.name.Equal["EXPRTYPE"]
THEN {
tt: CirioTypes.Type ~ Types.CreateTypeType[cc];
tit: CirioTypes.Type ~ CCTypes.GetIndirectType[tt];
subjPT: CSO.ParseTree;
subjTC: TypedCode;
tni: Types.TypeIndirectNodeInfo;
tn: CirioTypes.Node;
SELECT side
FROM
left => CCError[operation, "EXPRTYPE expressions do not yield left-hand sides"];
right => NULL;
ENDCASE => ERROR;
IF son2=NIL THEN CCError[operation, "EXPRTYPE must be given an argument"];
subjPT ← CreatePPTreeParseTree[son2, cc];
subjTC ← CSO.CompileForRHS[subjPT, CCTypes.GetAnyTargetType[cc], cc];
tni ← NEW [Types.TypeIndirectNodeInfoBody ← [GetDefType, subjTC.type]];
tn ← Types.CreateTypeIndirectNode[tit, tni];
RETURN[CSO.RHSLiteral[tn, cc]];
};
ENDCASE => NULL;
{left: CSO.ParseTree;
left ← CreatePPTreeParseTree[son1, cc];
SELECT side
FROM
left => RETURN[CSO.LHSapply[left, AlwaysLookLikeList[son2, cc], cc]];
right => RETURN[CSO.RHSApply[left, AlwaysLookLikeList[son2, cc], cc]];
ENDCASE => ERROR;
}};
GetDefType:
PROC [data:
REF
ANY]
RETURNS [CirioTypes.Type]
~ {RETURN [NARROW[data]]};
AlwaysLookLikeList:
PROC[presumedList: PPTree.Link, cc:
CC]
RETURNS[
CSO.ParseTree] =
BEGIN
IF presumedList #
NIL
THEN
WITH presumedList
SELECT
FROM
node:
REF PPTree.Node =>
SELECT node.name
FROM
list => RETURN[CreatePPTreeParseTree[presumedList, cc]];
ENDCASE => NULL;
ENDCASE => NULL;
ok, we have to encase it in a list
BEGIN
listSize: INT ← IF presumedList = NIL THEN 0 ELSE 1;
listNode: REF PPTree.Node ← NEW[PPTree.Node[listSize]];
listNode.name ← list;
IF listSize = 1 THEN listNode.son[1] ← presumedList;
RETURN[CreatePPTreeParseTree[listNode, cc]];
END;
END;
CompileCedarPTExpAsFieldExtraction:
PROC[tree:
CSO.ParseTree, fieldContext: CirioTypes.Type, cc: CompilerContext, data:
REF
ANY]
RETURNS[TypedCode] =
BEGIN
pptree: PPTree.Link ← NARROW[data];
WITH pptree
SELECT
FROM
hti: PPLeaves.HTIndex =>
RETURN[
CSO.RHSFieldIdentifier[hti.name, fieldContext, cc]];
we have an identifier in hand
ENDCASE => CCError[cirioError];
END;
CompileCedarPTExpAsFieldSelection:
PROC[tree:
CSO.ParseTree, fieldIndirectContext: CirioTypes.Type, cc: CompilerContext, data:
REF
ANY]
RETURNS[TypedCode] =
BEGIN
pptree: PPTree.Link ← NARROW[data];
WITH pptree
SELECT
FROM
hti: PPLeaves.HTIndex =>
RETURN[
CSO.LHSFieldIdentifier[hti.name, fieldIndirectContext, cc]];
we have an identifier in hand
ENDCASE => CCError[cirioError];
END;
CompileCedarPTExpShowParseTree:
PROC [tree:
CSO.ParseTree, cc: CompilerContext, data:
REF
ANY]
RETURNS [Rope.
ROPE] =
BEGIN
pptree: PPTree.Link ← NARROW[data];
innerShowParseTree:
PROC [pptree: PPTree.Link, nestingLevel:
CARDINAL]
RETURNS [Rope.
ROPE] =
BEGIN
blanks: Rope.ROPE ← NIL;
ptNode: Rope.ROPE;
THROUGH [1..nestingLevel]
DO
blanks ← Rope.Cat[blanks, " "];
ENDLOOP;
IF pptree =
NIL THEN
ptNode ← "NIL"
ELSE
WITH pptree
SELECT
FROM
node:
REF PPTree.Node =>
BEGIN
nameRef: REF ANY ← NEW [PPTree.NodeName ← node.name];
name: Rope.ROPE ← IO.PutFR["%g", IO.refAny[nameRef]];
name: Rope.ROPE ← NodeNameRopes[node.name];
info: Rope.ROPE ← IO.PutFR[", info: %g\n", IO.card[node.info]];
sons: Rope.ROPE ← NIL;
name ← Rope.Cat[name, " attr: ["];
name ← Rope.Cat[name, IF node.attr[1] THEN "TRUE" ELSE "FALSE"];
name ← Rope.Cat[name, IF node.attr[2] THEN ", TRUE" ELSE ", FALSE"];
name ← Rope.Cat[name, IF node.attr[3] THEN ", TRUE]" ELSE ", FALSE]"];
name ← Rope.Cat[name, info];
FOR i:
CARDINAL
IN [1..node.sonLimit-1]
DO
sons ← Rope.Cat[sons, innerShowParseTree[node.son[i], nestingLevel+1]];
ENDLOOP;
ptNode ← Rope.Cat[name, sons];
END;
hti: PPLeaves.HTIndex =>
BEGIN
index: Rope.ROPE ← IO.PutFR[" index: %g", IO.int[hti.index]];
ptNode ← Rope.Cat[hti.name, index];
END;
lti: PPLeaves.LTIndex =>
BEGIN
index: Rope.ROPE ← IO.PutFR[" index: %g", IO.int[lti.index]];
WITH lti.value
SELECT
FROM
int: REF INT => ptNode ← IO.PutFR["%g", IO.int[int^]];
real: REF REAL => ptNode ← IO.PutFR["%g", IO.real[real^]];
char: REF CHAR => ptNode ← IO.PutFR["%g", IO.char[char^]];
rope: REF Rope.ROPE => ptNode ← rope^;
proc: REF Procedures.ProcLiteral => ptNode ← "PROC. LITERAL";
ENDCASE => CCError[unimplemented, "unimplemented literal encountered"];
ptNode ← Rope.Cat[ptNode, index, ", literal: ", lti.literal];
END;
ENDCASE => CCError[unimplemented, "unimplemented type encountered"];
RETURN [Rope.Cat[blanks, ptNode, "\n"]];
END;
RETURN [innerShowParseTree[pptree, 0]];
END;
BuildArgList:
PROC[list:
REF PPTree.Node, cc: CompilerContext]
RETURNS[
LIST
OF
CSO.ParseTree] =
BEGIN
nElements: CARDINAL ← list.sonLimit - 1;
argList: LIST OF CSO.ParseTree ← NIL;
IF list.name # list THEN CCError[cirioError]; -- shouldn't happen
FOR
I:
INT
DECREASING
IN [1..nElements]
DO
pt: CSO.ParseTree ← CreatePPTreeParseTree[list.son[I], cc];
argList ← CONS[pt, argList];
ENDLOOP;
RETURN[argList];
END;
BuildNameArgPairList:
PROC[list:
REF PPTree.Node, cc: CompilerContext]
RETURNS[
LIST
OF
CSO.NameArgPair] =
BEGIN
nPairs: CARDINAL ← list.sonLimit - 1;
pairList: LIST OF CSO.NameArgPair ← NIL;
IF list.name # list THEN CCError[cirioError]; -- shouldn't happen
FOR
I:
INT
DECREASING
IN [1..nPairs]
DO
pair: REF PPTree.Node ← NARROW[list.son[I]];
id: Rope.ROPE ← PPTreeAsId[pair.son[1]];
arg: PPTree.Link ← pair.son[2];
argt: CSO.ParseTree ← CreatePPTreeParseTree[arg, cc];
IF pair.name # item THEN CCError[cirioError]; -- shouldn't happen
pairList ← CONS[[id, argt], pairList];
ENDLOOP;
RETURN[pairList];
END;
PPTreeAsId:
PROC[pptree: PPTree.Link]
RETURNS[Rope.
ROPE] =
BEGIN
WITH pptree
SELECT
FROM
hti: PPLeaves.HTIndex => RETURN[hti.name];
ENDCASE => CCError[cirioError]; -- shouldn't happen
END;
in PPTrees a literal is represented as a REF to the value. (So we can avoid interpreting the textual value of the literal.)
CreateNodeFromLiteral:
PROC[literal:
REF
ANY, cc:
CC]
RETURNS[CirioTypes.Node] =
BEGIN
type: Type ← CreateCedarLiteralType[literal, cc];
WITH literal
SELECT
FROM
lit: REF REAL => RETURN[CedarNumericTypes.CreateNumericNode[type, literal]];
lit: REF INT => RETURN[CedarNumericTypes.CreateNumericNode[type, literal]];
lit: REF CARD => RETURN[CedarNumericTypes.CreateNumericNode[type, literal]];
lit: REF CHAR => RETURN[CedarOtherPureTypes.CreateCharNode[lit^, cc]];
lit: REF Rope.ROPE => RETURN[CedarOtherPureTypes.CreateRopeNode[lit^, cc]];
lit: REF Procedures.ProcLiteral => RETURN [Procedures.CreateProcLiteralNode[lit^, cc]];
ENDCASE => CCError[unimplemented] -- we havn't implemented many as yet
END;
CreateCedarLiteralType:
PROC[literal:
REF
ANY, cc:
CC]
RETURNS[CirioTypes.Type] =
BEGIN
WITH literal
SELECT
FROM
real:
REF
REAL =>
RETURN[CedarNumericTypes.CreateNumericType[[32, real[]], cc, NIL]];
int:
REF
INT =>
IF (int^ <
FIRST[
INT16])
OR (int^ >
LAST[
INT16])
THEN
RETURN[CedarNumericTypes.CreateNumericType[[32, signed[full[]]], cc, NIL]]
ELSE
RETURN[CedarNumericTypes.CreateNumericType[[16, signed[full[]]], cc, NIL]];
card:
REF
CARD =>
BEGIN
IF card^ <=
CARD32[
LAST[
INT32]]
THEN
RETURN [CedarNumericTypes.CreateNumericType[[16, unsigned[full[]]], cc, NIL]]
ELSE
RETURN[CedarNumericTypes.CreateNumericType[[32, unsigned[full[]]], cc, NIL]];
END;
char:
REF
CHAR => {
t: CirioTypes.Type ~ CCTypes.GetCharType[cc];
IF cc=NIL THEN CCError[cirioError, "CHAR type not defined yet"];
RETURN[t]};
rope:
REF Rope.
ROPE => {
t: CirioTypes.Type ~ CCTypes.GetRopeType[cc];
IF t=NIL THEN CCError[cirioError, "ROPE type not defined yet"];
RETURN[t]};
proc:
REF Procedures.ProcLiteral =>
RETURN [Procedures.CreateProcLiteralType[proc^, cc]];
ENDCASE => CCError[unimplemented]; -- we havn't implemented many as yet
END;
NodeNameRopes:
ARRAY PPTree.NodeName
OF Rope.
ROPE ~ [ list: "list", item: "item", decl: "decl", typedecl: "typedecl",
basicTC: "basicTC", enumeratedTC: "enumeratedTC", recordTC: "recordTC", monitoredTC: "monitoredTC", variantTC: "variantTC",
refTC: "refTC", pointerTC: "pointerTC", listTC: "listTC", arrayTC: "arrayTC", arraydescTC: "arraydescTC", sequenceTC: "sequenceTC",
procTC: "procTC", processTC: "processTC", portTC: "portTC", signalTC: "signalTC", errorTC: "errorTC", programTC: "programTC",
anyTC: "anyTC", definitionTC: "definitionTC", unionTC: "unionTC", relativeTC: "relativeTC",
subrangeTC: "subrangeTC", longTC: "longTC", opaqueTC: "opaqueTC", zoneTC: "zoneTC", linkTC: "linkTC", spareTC: "spareTC",
implicitTC: "implicitTC", frameTC: "frameTC", discrimTC: "discrimTC",
entry: "entry", internal: "internal",
unit: "unit", diritem: "diritem", module: "module", body: "body", inline: "inline", lambda: "lambda", block: "block", assign: "assign", extract: "extract",
if: "if",
case: "case", casetest: "casetest", caseswitch: "caseswitch",
bind: "bind",
do: "do", forseq: "forseq", upthru: "upthru", downthru: "downthru",
return: "return", result: "result",
goto: "goto", exit: "exit", loop: "loop",
free: "free",
resume: "resume", reject: "reject", continue: "continue", retry: "retry", catchmark: "catchmark",
restart: "restart", stop: "stop",
lock: "lock", wait: "wait", notify: "notify", broadcast: "broadcast", unlock: "unlock",
null: "null",
label: "label",
open: "open",
enable: "enable", catch: "catch",
dst: "dst", lst: "lst", lstf: "lstf",
syscall: "syscall", spareS1: "spareS1", spareS2: "spareS2", spareS3: "spareS3",
subst: "subst", call: "call", portcall: "portcall", signal: "signal", error: "error", syserror: "syserror", xerror: "xerror",
start: "start", join: "join", apply: "apply",
callx: "callx", portcallx: "portcallx", signalx: "signalx", errorx: "errorx", syserrorx: "syserrorx", startx: "startx", fork: "fork", joinx: "joinx",
index: "index", dindex: "dindex", seqindex: "seqindex", reloc: "reloc",
construct: "construct", union: "union", rowcons: "rowcons", sequence: "sequence", listcons: "listcons",
substx: "substx",
ifx: "ifx", casex: "casex", bindx: "bindx",
assignx: "assignx", extractx: "extractx",
or: "or", and: "and",
relE: "relE", relN: "relN", relL: "relL", relGE: "relGE", relG: "relG", relLE: "relLE", in: "in", notin: "notin",
plus: "plus", minus: "minus", times: "times", div: "div", mod: "mod",
dot: "dot", cdot: "cdot", dollar: "dollar",
create: "create",
not: "not",
uminus: "uminus",
addr: "addr",
uparrow: "uparrow",
min: "min", max: "max", lengthen: "lengthen", abs: "abs", all: "all",
size: "size", first: "first", last: "last", pred: "pred", succ: "succ",
arraydesc: "arraydesc", length: "length", base: "base",
loophole: "loophole",
nil: "nil",
new: "new",
void: "void",
clit: "clit", llit: "llit",
cast: "cast", check: "check", float: "float", pad: "pad", chop: "chop", safen: "safen",
syscallx: "syscallx", narrow: "narrow", istype: "istype",
openx: "openx",
mwconst: "mwconst", cons: "cons",
atom: "atom", typecode: "typecode",
stringinit: "stringinit", textlit: "textlit", signalinit: "signalinit", procinit: "procinit",
intOO: "intOO", intOC: "intOC", intCO: "intCO", intCC: "intCC",
thread: "thread",
none: "none",
exlist: "exlist",
initlist: "initlist",
ditem: "ditem",
self: "self",
mergecons: "mergecons"];
END..