<<>>
    <<AtomsImpl.mesa>>
        <<Created by Theimer: August 4, 1989 10:05:46 pm PDT>>
        <<Last changed by Theimer on August 7, 1989 1:19:02 pm PDT>>
        <<Spreitze, January 8, 1992 1:13 pm PST>>


    DIRECTORY
        Atoms,
        CCTypes USING [CCError, CCErrorCase, CCTypeProcs, CheckConformance, ConformanceCheck, CreateCedarType, ExtractIdField, 
        GetIndirectType, GetProcDataFromGroundType, GetProcDataFromType, LR, Operator, SelectIdField],
        CirioTypes USING [BasicTypeInfo, CompilerContext, Mem, Node, Type, TypedCode],
        CedarCode USING [Code, CreateCedarNode, OperationsBody, GetDataFromNode, GetTypeOfNode, Operator, LoadThroughIndirectNode, 
        ShowNode, ExtractFieldFromNode, CodeToLoadThroughIndirect, ConcatCode],
        IO,
        RefTypes USING [CreateNilRefNode],
        Rope USING[ROPE];


    AtomsImpl: CEDAR PROGRAM
        IMPORTS CCTypes, CedarCode, IO, RefTypes
        EXPORTS Atoms
    = BEGIN OPEN CCTypes;

        CC: TYPE = CirioTypes.CompilerContext;
        Code: TYPE = CedarCode.Code;
        BasicTypeInfo: TYPE = CirioTypes.BasicTypeInfo;
        Type: TYPE = CirioTypes.Type;
        TypedCode: TYPE = CirioTypes.TypedCode;
        Mem: TYPE = CirioTypes.Mem;
        Node: TYPE = CirioTypes.Node;
        CCE: ERROR[case: CCTypes.CCErrorCase, msg: Rope.ROPE _ NIL] _ CCTypes.CCError;
        Operator: TYPE = CedarCode.Operator;

        <<Type operations>>
        <<>>
        AtomTypeInfo: TYPE = REF AtomTypeInfoBody;
        AtomTypeInfoBody: TYPE = RECORD [
            recType: Type,
            bti: BasicTypeInfo];

        CreateAtomType: PUBLIC PROC [cc: CC, bti: BasicTypeInfo] RETURNS [Type] = {
            info: AtomTypeInfo _  NEW [AtomTypeInfoBody _ [NIL, bti]];
            RETURN [CCTypes.CreateCedarType[$atom, AtomTypeCCTypeProcs, IndirectAtomTypeCCTypeProcs, cc, info]]};

        SetAtomRecType: PUBLIC PROC [atomType, recType: Type, cc: CC] ~ {
            info: AtomTypeInfo ~ NARROW[CCTypes.GetProcDataFromType[atomType]];
            IF info.recType#NIL THEN CCE[cirioError, "Re-SetAtomRecType"];
            info.recType _ recType;
            RETURN};

        AtomTypeCCTypeProcs: REF CCTypes.CCTypeProcs _ NEW[CCTypes.CCTypeProcs _[
            checkConformance: AtomCCTypesCheckConformance,
            operand: AtomCCTypesOperand,
            unaryOp: AtomCCTypesUnaryOp,
            extractIdField: AtomCCTypesExtractIdField,
            getTypeRepresentation: AtomGetTypeRep,
            printType: AtomCCTypesPrintType]];

        AtomCCTypesCheckConformance: PROC[valType, varType: Type, cc: CC, procData: REF ANY] RETURNS[CCTypes.ConformanceCheck] =
            BEGIN
            valInfo: AtomTypeInfo _ NARROW[procData];
            WITH CCTypes.GetProcDataFromGroundType[varType, cc] SELECT FROM
                varInfo: AtomTypeInfo => RETURN [CCTypes.CheckConformance[valInfo.recType, varInfo.recType, cc]];
                ENDCASE => RETURN[no];
            END;

        AtomCCTypesOperand: PROC [op: Operator, lr: CCTypes.LR, tc: TypedCode, cc: CC, procData: REF ANY] RETURNS [TypedCode] =
            BEGIN
            SELECT op FROM
                $dot , $extractId, $uparrow => RETURN[tc];
                ENDCASE => CCE[operation]; -- client error, invalid operation
            END;

        AtomCCTypesUnaryOp: PROC[op: CCTypes.Operator, arg: TypedCode, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
            BEGIN
            info: AtomTypeInfo _ NARROW[procData];
            SELECT op FROM
                $uparrow => BEGIN
                    code2: Code _ CedarCode.CodeToLoadThroughIndirect[CCTypes.GetIndirectType[info.recType]];
                    code: Code _ CedarCode.ConcatCode[arg.code, code2];
                    RETURN[[code, info.recType]];
                    END;
                ENDCASE => CCE[typeConformity]; -- client type error
            END;

        AtomCCTypesExtractIdField: PROC[id: Rope.ROPE, fieldContext: Type, cc: CC, procData: REF ANY] RETURNS[TypedCode] =
            BEGIN
            info: AtomTypeInfo _ NARROW[procData];
            tc: TypedCode _ CCTypes.ExtractIdField[id, info.recType, cc];
            <<code2: Code _ CedarCode.ConcatCode[code1, tc.code];>>
            <<RETURN [[code2, tc.type]];>>
            RETURN [tc];
            END;

        IndirectAtomTypeCCTypeProcs: REF CCTypes.CCTypeProcs _ NEW[CCTypes.CCTypeProcs _[
            createIndirectNode: AtomCreateIndirect,
            getBitSize: AtomBitSize,
            operand: IndirectAtomCCTypesOperand,
            selectIdField: AtomCCTypesSelectIdField,
            printType: AtomCCTypesPrintType]];

        AtomCreateIndirect: PROC [cc: CC, procData: REF ANY, indirectType, targetType: Type, mem: Mem] RETURNS [Node] ~ {
            info: AtomTypeInfo _ NARROW[procData];
            RETURN info.bti.createIndirectNode[info.bti, cc, indirectType, targetType, mem]};

        AtomBitSize: PROC[indirectType, targetType: Type, cc: CC, procData: REF ANY] RETURNS[CARD] ~ {
            info: AtomTypeInfo _ NARROW[procData];
            RETURN info.bti.getBitSize[info.bti, cc, indirectType, targetType]};

        IndirectAtomCCTypesOperand: 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;

        AtomCCTypesSelectIdField: PROC[id: Rope.ROPE, fieldIndirectContext: Type, cc: CC, procData: REF ANY] RETURNS[TypedCode] = {
            info: AtomTypeInfo _ NARROW[procData];
            tc: TypedCode _ CCTypes.SelectIdField[id, CCTypes.GetIndirectType[info.recType], cc];
            RETURN [tc];
            };

        AtomGetTypeRep: PROC[type: Type, cc: CC, procData: REF ANY] RETURNS[REF ANY] ~ {
            info: AtomTypeInfo _ NARROW[procData];
            RETURN[info.bti]};

        AtomCCTypesPrintType: PROC [to: IO.STREAM, type: Type, printDepth: INT, printWidth: INT, cc: CC, procData: REF ANY] = {
            info: AtomTypeInfo _ NARROW[procData];
            to.PutRope["ATOM"]};


        <<Node operations. >>
        <<>>
        CreateAtomNode: PUBLIC PROC [type: Type, info: Atoms.AtomNodeInfo, cc: CC] RETURNS [Node] = {
            RETURN [CedarCode.CreateCedarNode[AtomOps, type, info]];
            };

        AtomOps: REF CedarCode.OperationsBody _ NEW[CedarCode.OperationsBody _[
            load: AtomLoad,
            extractField: AtomExtractField,
            show: AtomShow,
            getNodeRepresentation: AtomNodeGetRepresentation
            ]];

        AtomLoad: PROC [indirectType: Type, indirectNode: Node, cc: CC] RETURNS [Node] = {
            info: Atoms.AtomNodeInfo _ NARROW[CedarCode.GetDataFromNode[indirectNode]];
            RETURN [CedarCode.LoadThroughIndirectNode[CCTypes.GetIndirectType[info.atomRecType], info.atomRecNode, cc]];
            };

        AtomExtractField: PROC[id: Rope.ROPE, type: Type, node: Node, cc: CC] RETURNS[Node] =
            BEGIN
            info: Atoms.AtomNodeInfo _ NARROW[CedarCode.GetDataFromNode[node]];
            rec: Node _ CedarCode.LoadThroughIndirectNode[CCTypes.GetIndirectType[info.atomRecType], info.atomRecNode, cc];
            RETURN [CedarCode.ExtractFieldFromNode[id, info.atomRecType, rec, cc]];
            END;

        AtomShow: PROC [to: IO.STREAM, node: Node, depth: INT, width: INT, cc: CC] = {
            info: Atoms.AtomNodeInfo _ NARROW[CedarCode.GetDataFromNode[node]];
            rec: Node _ CedarCode.LoadThroughIndirectNode[CCTypes.GetIndirectType[info.atomRecType], info.atomRecNode, cc];
            recType: Type _ CedarCode.GetTypeOfNode[rec];
            pName: Node _ CedarCode.ExtractFieldFromNode["pName", recType, rec, cc];
            to.PutChar['$];
            CedarCode.ShowNode[to, pName, depth, width, cc];
            RETURN};

        AtomNodeGetRepresentation: PROC[node: Node, cc: CC] RETURNS[REF ANY] =
            BEGIN
            data: Atoms.AtomNodeInfo _ NARROW[CedarCode.GetDataFromNode[node]];
            RETURN[data];
            END;


        CreateNilAtomNode: PUBLIC PROC [type: Type, cc: CC] RETURNS [Node] =
            BEGIN
            RETURN [CedarCode.CreateCedarNode[NilAtomOps, type, NIL]];
            END;

        NilAtomOps: REF CedarCode.OperationsBody _ NEW[CedarCode.OperationsBody _[
            load: NilAtomLoad,
            show: NilAtomShow
            ]];

        NilAtomLoad: PROC [indirectType: Type, indirectNode: Node, cc: CC] RETURNS [Node] = {
            RETURN [RefTypes.CreateNilRefNode[cc]];
            };

        NilAtomShow: PROC [to: IO.STREAM, node: Node, depth: INT, width: INT, cc: CC]
            = {to.PutRope["NIL"]};

    END.