-- CoreMXCode.mesa
DIRECTORY Atom, Convert, Core, CoreClasses, CoreOps, Rope, Scheme;
CoreMXCode: CEDAR PROGRAM
IMPORTS Atom, Convert, CoreClasses, CoreOps, Scheme
= BEGIN OPEN Scheme;
  SymbolFromRope: PROC [Rope.ROPE] RETURNS [Symbol] ~ Atom.MakeAtom;
  RopeFromSymbol: PROC [Symbol] RETURNS [Rope.ROPE] ~ Atom.GetPName;
  TheCellType: PROC [a: Any] RETURNS [Core.CellType] = {
    WITH a SELECT FROM
      a: Core.CellType => RETURN [a];
      ENDCASE => Complain[a, "not a Core.CellType"];
    };
  TheCellClass: PROC [a: Any] RETURNS [Core.CellClass] = {
    WITH a SELECT FROM
      a: Core.CellClass => RETURN [a];
      ENDCASE => Complain[a, "not a Core.CellClass"];
    };
  TheWire: PROC [a: Any] RETURNS [Core.Wire] = {
    WITH a SELECT FROM
      a: Core.Wire => RETURN [a];
      ENDCASE => Complain[a, "not a Core.Wire"];
    };
  TheProperties: PROC [a: Any] RETURNS [Core.Properties] = {
    WITH a SELECT FROM
      a: Core.Properties => RETURN [a];
      ENDCASE => Complain[a, "not a Core.Properties"];
    };
  CorePrim: PROC [SELF: Primitive, ARG1,ARG2,ARG3: Any, REST: ProperList] RETURNS [result: Any ← unspecified] = {
    POP: PROC RETURNS [a: Any ← undefined] = {
      IF REST#NIL THEN {a ← REST.car; REST ← NARROW[REST.cdr]}};
    DATA: Pair ~ NARROW[SELF.data];
    env: Environment ~ NARROW[DATA.cdr];
    SELECT NAT[NARROW[DATA.car, REF INT]↑] FROM
      15 => {
        cellType: Any ← ARG1;
        result ← StringFromRope[CoreOps.GetCellTypeName[TheCellType[cellType]]];
        };
      14 => {
        cellType: Any ← ARG1;
        result ← CoreOps.ToBasic[TheCellType[cellType]];
        };
      13 => {
        cellType: Any ← ARG1;
        result ← TheCellType[cellType].properties;
        };
      12 => {
        cellType: Any ← ARG1;
        result ← TheCellType[cellType].data;
        };
      11 => {
        cellType: Any ← ARG1;
        result ← TheCellType[cellType].public;
        };
      10 => {
        cellType: Any ← ARG1;
        result ← TheCellType[cellType].class;
        };
      9 => {
        result ← CoreClasses.transistorCellClass;
        };
      8 => {
        result ← CoreClasses.recordCellClass;
        };
      7 => {
        cellClass: Any ← ARG1;
        result ← TheCellClass[cellClass].properties;
        };
      6 => {
        cellClass: Any ← ARG1;
        result ← StringFromRope[TheCellClass[cellClass].name];
        };
      5 => {
        wire: Any ← ARG1;
        result ← StringFromRope[CoreOps.GetShortWireName[TheWire[wire]]];
        };
      4 => {
        wire: Any ← ARG1;
        child: Any ← ARG2;
        result ← TheWire[wire].elements[TheINT[child]];
        };
      3 => {
        wire: Any ← ARG1;
        result ← MakeFixnum[TheWire[wire].size];
        };
      2 => {
        wire: Any ← ARG1;
        result ← TheWire[wire].properties;
        };
      1 => {
        size: Any ← ARG1;
        name: Any ← ARG2;
        props: Any ← ARG3;
        result ← CoreOps.CreateWires[TheINT[size], IF name#undefined THEN TheROPE[name] ELSE NIL, IF props#undefined THEN TheProperties[props] ELSE NIL];
        };
      0 => {
        int: Any ← ARG1;
        result ← StringFromRope[Convert.RopeFromCard[TheINT[int]]];
        };
      ENDCASE => ERROR
    };
    
  CoreInit: PROC [env: Environment] = {
    DefinePrimitive[name: "cell-type-name", nArgs: 1, proc: CorePrim, doc: "(cell-type) name of cell type", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[15], env]];
    DefinePrimitive[name: "cell-type-to-basic", nArgs: 1, proc: CorePrim, doc: "(cell-type) maximal recast of cell-type", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[14], env]];
    DefinePrimitive[name: "cell-type-properties", nArgs: 1, proc: CorePrim, doc: "(cell-type) cellType.properties", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[13], env]];
    DefinePrimitive[name: "cell-type-data", nArgs: 1, proc: CorePrim, doc: "(cell-type) cellType.data", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[12], env]];
    DefinePrimitive[name: "cell-type-public", nArgs: 1, proc: CorePrim, doc: "(cell-type) cellType.public", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[11], env]];
    DefinePrimitive[name: "cell-type-class", nArgs: 1, proc: CorePrim, doc: "(cell-type) cellType.class", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[10], env]];
    DefinePrimitive[name: "transistor-cell-class", nArgs: 0, proc: CorePrim, doc: "() transistor cell class", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[9], env]];
    DefinePrimitive[name: "record-cell-class", nArgs: 0, proc: CorePrim, doc: "() record cell class", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[8], env]];
    DefinePrimitive[name: "cell-class-properties", nArgs: 1, proc: CorePrim, doc: "(cell-class) cellClass.properties", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[7], env]];
    DefinePrimitive[name: "cell-class-name", nArgs: 1, proc: CorePrim, doc: "(cell-class) cellClass.name", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[6], env]];
    DefinePrimitive[name: "wire-name-short", nArgs: 1, proc: CorePrim, doc: "(wire) short wire name", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[5], env]];
    DefinePrimitive[name: "wire-child", nArgs: 2, proc: CorePrim, doc: "(wire child) wire.elements[child]", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[4], env]];
    DefinePrimitive[name: "wire-size", nArgs: 1, proc: CorePrim, doc: "(wire) wire.size", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[3], env]];
    DefinePrimitive[name: "wire-props", nArgs: 1, proc: CorePrim, doc: "(wire) wire.properties", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[2], env]];
    DefinePrimitive[name: "create-wires", nArgs: 3, proc: CorePrim, doc: "(size [ name ] [ props ]) create a wire", env: env, optional: 2, dotted: FALSE, data: Cons[MakeFixnum[1], env]];
    DefinePrimitive[name: "int-to-string", nArgs: 1, proc: CorePrim, doc: "(int) convert int to string", env: env, optional: 0, dotted: FALSE, data: Cons[MakeFixnum[0], env]];
    };
    
  RegisterInit[CoreInit];
END.