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


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