
    <<CoreOpsImpl.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Barth, November 5, 1985 3:27:40 pm PST>>
        <<Spreitzer, November 7, 1985 5:20:45 pm PST>>
        <<Bertrand Serlet November 13, 1985 3:29:16 pm PST>>
        <<Frank Bowers January 10, 1986 12:52:33 pm PST>>
        <<>>
    DIRECTORY AMBridge, AMTypes, Core, CoreOps, CoreProperties, IO, PrintTV, Rope;

    CoreOpsImpl: CEDAR PROGRAM
        IMPORTS AMBridge, CoreProperties, IO, PrintTV, Rope
        EXPORTS CoreOps = 
        BEGIN OPEN Core, CoreOps;
<<Names>>
    nameProp: PUBLIC ATOM _ CoreProperties.RegisterProperty[$CoreName, CoreProperties.Props[[CoreProperties.propCopy, 
    CoreProperties.PropDoCopy]]];
<<Cell Classes>>
    printClassProcProp: PUBLIC ATOM _ CoreProperties.RegisterProperty[$CorePrintClassProc];
<<Cell Types>>
    CreateCellType: PUBLIC PROC [class: CellClass, public: WireSequence, data: REF ANY _ NIL, name: ROPE _ NIL, props: Properties _ 
    NIL]  RETURNS [cellType: CellType] = {
        cellType _ NEW [CellTypeRec _ [class: class, public: public, data: data, properties: props]];
        CoreProperties.PutCellTypeProp[cellType, nameProp, name];
        };

    GetCellTypeName: PUBLIC PROC [cellType: CellType] RETURNS [name: ROPE _ NIL] = {
        name _ NARROW [CoreProperties.GetCellTypeProp[cellType, nameProp]];
        };

    recastCacheProp: ATOM _ CoreProperties.RegisterProperty[$CoreRecastCache];
    Recast: PUBLIC RecastProc = {
        value: REF _ CoreProperties.GetProp[me.properties, recastCacheProp];
        IF value#NIL THEN RETURN [NARROW[value]];
        new _ me.class.recast[me];
        me.properties _ CoreProperties.PutProp[me.properties, recastCacheProp, new];
        };

    PrintCellType: PUBLIC PROC [cellType: CellType, out: STREAM, depth: NAT _ 0] = {
        classProc: REF PrintClassProc;
        IO.PutF[out, "\n\nCell type: %g", IO.rope[GetCellTypeName[cellType]]];
        IO.PutF[out, ", Cell class: %g", IO.rope[cellType.class.name]];
        IO.PutRope[out, "\nPublic wire:"];
        PrintWireSequence[cellType.public, out, depth+1];
        IF (classProc _ NARROW[CoreProperties.GetProp[from: cellType.class.properties, prop: printClassProcProp]]) # NIL THEN 
        classProc[cellType.data, out];
    CoreProperties.PrintProperties[props: cellType.properties, out: out];
    };

    PrintIndent: PUBLIC PROC [depth: NAT, out: STREAM] = {
        IO.PutChar[out, IO.CR];
        FOR i: NAT IN [0..depth) DO
            IO.PutRope[out, "  "];
            ENDLOOP;
        };
<<Creation of Wires>>
    CreateAtomWire: PUBLIC PROC [name: ROPE _ NIL, props: Properties _ NIL] RETURNS [wire: Wire] = {
        wire _ NEW [WireRec _ [properties: props]];
        CoreProperties.PutWireProp[wire, nameProp, name];
        };
    CreateRecordWire: PUBLIC PROC [components: LIST OF Wire, name: ROPE _ NIL, props: Properties _ NIL] RETURNS [wire: Wire] = {
        wire _ NEW [WireRec _ [
            elements: WiresToWireSequence[components],
            properties: props]];
        CoreProperties.PutWireProp[wire, nameProp, name];
        };
    CreateBasicSequenceWire: PUBLIC PROC [length: NAT, name: ROPE _ NIL, props: Properties _ NIL] RETURNS [wire: Wire] = {
        wire _ NEW [WireRec _ [elements: NEW [WireSequenceRec[length]], properties:  props]];
        CoreProperties.PutWireProp[wire, nameProp, name];
        CoreProperties.PutWireProp[wire, sequenceProp, sequenceProp];
        FOR i: NAT IN [0 .. length) DO
            wire.elements[i] _ CreateAtomWire[];
            ENDLOOP;
        };
    CreateSequenceWire: PUBLIC PROC [components: LIST OF Wire, name: ROPE _ NIL, props: Properties _ NIL] RETURNS [wire: Wire] = {
        DifferentStructure: EachWirePairProc = {};
        wire _ NEW [WireRec _ [
            elements: WiresToWireSequence[components],
            properties:  props]];
        CoreProperties.PutWireProp[wire, nameProp, name];
        CoreProperties.PutWireProp[wire, sequenceProp, sequenceProp];
        FOR w: NAT IN [1 .. wire.elements.size) DO
            IF VisitWirePair[wire.elements[0], wire.elements[w], DifferentStructure] THEN ERROR;
            ENDLOOP;
        };

    SubrangeWire: PUBLIC PROC [wire: Wire, start, length: NAT, name: ROPE _ NIL, props: Properties _ NIL] RETURNS [sub: Wire] = {
        sub _ CreateBasicSequenceWire[length, name, props];
        FOR i: NAT IN [0 .. length) DO
            sub.elements[i] _ wire.elements[start+i];
            ENDLOOP;
        };

    WiresToWireSequence: PUBLIC PROC [wires: LIST OF Wire] RETURNS [wireSeq: WireSequence] = {
        fieldCount: NAT _ 0;
        FOR c: LIST OF Wire _ wires, c.rest UNTIL c=NIL DO
            fieldCount _ fieldCount + 1;
            ENDLOOP;
        wireSeq _ NEW [WireSequenceRec[fieldCount]];
        fieldCount _ 0;
        FOR c: LIST OF Wire _ wires, c.rest UNTIL c=NIL DO
            wireSeq[fieldCount] _ c.first;
            fieldCount _ fieldCount + 1;
            ENDLOOP;
        };
    WireSequenceToWire: PUBLIC PROC [wireSeq: WireSequence] RETURNS [wire: Wire] = {
    wire _ NEW [WireRec _ [elements: wireSeq]];
        };

    CopyWire: PUBLIC PROC [wire: Wire] RETURNS [new: Wire] = {
    new _ NEW [WireRec _ [properties: CoreProperties.CopyProps[propList: wire.properties]]];
    IF wire.elements#NIL THEN new.elements _ CopyWireSequence[wire.elements];
        };
    CopyWireSequence: PUBLIC PROC [wireSeq: WireSequence] RETURNS [newSeq: WireSequence] = {
    newSeq _ NEW [WireSequenceRec[wireSeq.size]];
    FOR i: NAT IN [0..wireSeq.size) DO newSeq[i] _ CopyWire[wireSeq[i]] ENDLOOP;
        };

    sequenceProp: PUBLIC ATOM _ CoreProperties.RegisterProperty[$CoreSequence, CoreProperties.Props[[CoreProperties.propCopy, 
    CoreProperties.PropDoCopy]]];
<<Enumerating Wires>>
VisitWire: PUBLIC PROC [wire: Wire, eachWire: EachWireProc] RETURNS [quit: BOOL] = {
subWires: BOOL;
[subWires, quit] _ eachWire[wire];
IF NOT quit AND subWires AND wire.elements#NIL THEN quit _ VisitWireSequence[wire.elements, eachWire];
};
VisitWireSequence: PUBLIC PROC [wireSeq: WireSequence, eachWire: EachWireProc] RETURNS [quit: BOOL] = {
quit _ FALSE;
FOR i: NAT IN [0 .. wireSeq.size) DO
IF VisitWire[wireSeq[i], eachWire] THEN RETURN [TRUE];
ENDLOOP;
};
    VisitWirePair: PROC [wire1, wire2: Wire, eachWirePair: EachWirePairProc] RETURNS [quit: BOOL] = {
    subWires: BOOL;
    [subWires, quit] _ eachWirePair[wire1, wire2];
    IF wire1 = NIL THEN RETURN;
    IF quit OR ~subWires OR wire1 = NIL OR (wire1.elements=NIL AND wire2.elements=NIL) THEN RETURN;
    IF wire1.elements=NIL OR wire2.elements=NIL THEN RETURN [TRUE]; -- wires do not conform
    quit _ VisitBinding[wire1.elements, wire2.elements, eachWirePair];
    };

    VisitBinding: PUBLIC PROC [actual, public: WireSequence, eachWirePair: EachWirePairProc] RETURNS [quit: BOOL] = {
    IF actual.size#public.size THEN RETURN [TRUE]; -- wires do not conform
    FOR i: NAT IN [0 .. actual.size) DO
    IF VisitWirePair[actual[i], public[i], eachWirePair] THEN RETURN [TRUE];
    ENDLOOP;
    quit _ FALSE;
    };

    Conform: PUBLIC PROC [actual, public: WireSequence] RETURNS [BOOL] = {
        EachWirePair: EachWirePairProc = {};
        RETURN [NOT VisitBinding[actual, public, EachWirePair]];
        };
<<Naming of Wires (temporary)>>
    GetWireName: PUBLIC PROC [wire: Wire] RETURNS [name: ROPE _ NIL] = {
        name _ NARROW [CoreProperties.GetWireProp[wire, nameProp]];
        };

    FullNameWire: PROC [wire: Wire, name: ROPE _ NIL, prop: ATOM _ publicFullName] = {
        wire.properties _ CoreProperties.PutProp[on: wire.properties, prop: prop, value: name];
    IF wire.elements#NIL THEN FullNameWireSequence[wire.elements, name, prop, CoreProperties.GetWireProp[wire, sequenceProp]#NIL];
        };
    FullNameWireSequence: PUBLIC PROC [wireSeq: WireSequence, name: ROPE _ NIL, prop: ATOM _ publicFullName, isSequence: BOOL _ FALSE] 
    = {
    FOR i: NAT IN [0 .. wireSeq.size) DO
        new: ROPE _ IF isSequence 
            THEN IO.PutFR["%g[%g]", IO.rope[name], IO.int[i]] 
            ELSE IF GetWireName[wireSeq[i]]#NIL 
                THEN Rope.Cat[name, ".", GetWireName[wireSeq[i]]] 
                ELSE Rope.Cat[name, ".?"];
    FullNameWire[wire: wireSeq[i], name: new, prop: prop];
    ENDLOOP;
        };

    nameClassWireProcProp: PUBLIC ATOM _ CoreProperties.RegisterProperty[$CoreClassWireNameProc];
    publicFullName: PUBLIC ATOM _ CoreProperties.RegisterProperty[$CorePublicWireFullName];
<<Printing of Wires (temporary)>>
    PrintWire: PUBLIC PROC [wire: Wire, out: STREAM, depth: NAT _ 0] = {
        name: ROPE _ GetWireName[wire];
        PrintIndent[depth, out];
        IO.PutF[out, "%g", IF name=NIL THEN IO.rope["<no name>"] ELSE IO.rope[name]];
        IF wire.elements#NIL THEN IO.PutF[out, ", %g elements", IO.int[wire.elements.size]];
        CoreProperties.PrintProperties[props: wire.properties, out: out, depth: depth+1];
        IF wire.elements#NIL THEN PrintWireSequence[wire.elements, out, depth + 1];
        };
    PrintWireSequence: PUBLIC PROC [wireSeq: WireSequence, out: STREAM, depth: NAT _ 0] = {
        FOR i: NAT IN [0 .. wireSeq.size) DO
            PrintWire[wireSeq[i], out, depth+1];
            ENDLOOP;
        };
<<Operations on LIST OF Wires>>
    Reverse: PUBLIC PROC [wires: LIST OF Wire] RETURNS [revWires: LIST OF Wire _ NIL] = {
    WHILE wires#NIL DO revWires _ CONS [wires.first, revWires]; wires _ wires.rest ENDLOOP;
    };
    Delete: PUBLIC PROC [wires: LIST OF Wire, wire: Wire] RETURNS [newWires: LIST OF Wire _ NIL] = {
    WHILE wires#NIL DO
    IF wires.first#wire THEN newWires _ CONS [wires.first, newWires];
    wires _ wires.rest;
    ENDLOOP;
    };
Member: PUBLIC PROC [wires: LIST OF Wire, wire: Wire] RETURNS [BOOL] = {
WHILE wires#NIL DO IF wires.first=wire THEN RETURN [TRUE]; wires _ wires.rest ENDLOOP;
RETURN [FALSE];
};
<<Printing of Core Values (not yet functional)>>
    <<BS: There is something in the interpreter (or in my understanding of it) that prevents using PrintTV now, but that's the hope>>

    InternalPrintCellType: PrintTV.TVPrintProc = {
        <<[tv: TV, data: REF ANY, stream: STREAM, depth: INT _ 4, width: INT _ 32, verbose: BOOL _ FALSE] RETURNS [useOld: BOOL _ FALSE]>>
        cellType: CellType;
        ref: REF READONLY ANY;
        TRUSTED {ref _ AMBridge.SomeRefFromTV[tv]};
        cellType _ NARROW [ref, REF READONLY CellType]^;
        stream.PutF["{CellType - class: %g, public: ", IO.rope[cellType.class.name]];
        Print[ref: cellType.public, stream: stream, depth: depth-1, width: width, verbose: verbose];
        stream.PutF[", data: "];
        Print[ref: cellType.data, stream: stream, depth: depth-1, width: width, verbose: verbose];
        stream.PutF[", properties: "];
        Print[ref: cellType.properties, stream: stream, depth: depth-1, width: width, verbose: verbose];
        stream.PutF["}"];
    };

    Print: PROC [ref: REF ANY, stream: STREAM, depth: INT _ 4, width: INT _ 32, verbose: BOOL _ FALSE] = {
        tv: AMTypes.TV;
        TRUSTED {tv _ AMBridge.TVForReferent[NEW [REF _ ref]]};
        PrintTV.Print[tv, stream, depth, width, verbose];
        };

    <<PrintTV.RegisterTVPrintProc[CODE[CellType], InternalPrintCellType];>>

    END.