CoreCreateImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Barth, September 26, 1985 2:19:39 pm PDT
DIRECTORY Core, CoreCreate, CoreOps, CoreProperties, CoreRecord, CoreSequence, IO, Rope;
CoreCreateImpl: CEDAR PROGRAM
IMPORTS CoreOps, CoreProperties, CoreRecord, CoreSequence, IO, Rope
EXPORTS CoreCreate =
BEGIN OPEN Core, CoreCreate;
CreateError: PUBLIC SIGNAL [type: CreateErrorType, message: ROPE] = CODE;
Cells
CreateRecordCell: PUBLIC PROC [design: Design, name: ROPE, attribute: Attribute ← [NIL, NIL], attributes: Attributes ← NIL] RETURNS [cell: CellType] = {
recCell: CoreRecord.RecordCellType ← NEW[CoreRecord.RecordCellTypeRec ← [
internalWire: NEW[WireRec ← [
structure: record,
elements: NEW[WireSequenceRec[0]]]]]];
cell ← NEW[CellTypeRec ← [
name: name,
class: CoreRecord.recordCellClass,
publicWire: NEW[WireRec ← [
structure: record,
elements: NEW[WireSequenceRec[0]]]],
data: recCell,
properties: InsertAttributes[attribute: attribute, attributes: attributes]]];
IF name=NIL THEN SIGNAL CreateError[type: MissingParameter, message: "no name given for CreateRecordCell call"];
IF CoreOps.FetchCellType[design: design, name: name]#NIL THEN SIGNAL CreateError[type: DuplicateName, message: name];
CoreOps.InsertCellType[design: design, cellType: cell];
};
CreateSequenceCell: PUBLIC PROC [design: Design, name: ROPE, baseCell: CellType, count: NAT, sequencePorts: RopeList ← NIL, attribute: Attribute ← [NIL, NIL], attributes: Attributes ← NIL] RETURNS [cell: CellType] = {
sequenceCount: NAT ← 0;
seqCell: CoreSequence.SequenceCellType;
FOR rList: RopeList ← sequencePorts, rList.rest UNTIL rList=NIL DO
sequenceCount ← sequenceCount + 1;
ENDLOOP;
seqCell ← NEW[CoreSequence.SequenceCellTypeRec[sequenceCount]];
seqCell.base ← baseCell;
seqCell.count ← count;
sequenceCount ← 0;
FOR rList: RopeList ← sequencePorts, rList.rest UNTIL rList=NIL DO
FOR base: NAT IN [0..baseCell.publicWire.elements.size) DO
IF Rope.Equal[baseCell.publicWire.elements[base].name, rList.first] THEN {
seqCell.sequence[sequenceCount] ← base;
EXIT;
};
REPEAT
FINISHED => ERROR;
ENDLOOP;
sequenceCount ← sequenceCount + 1;
ENDLOOP;
cell ← CoreSequence.Create[design: design, name: name, args: seqCell];
cell.properties ← InsertAttributes[attribute: attribute, attributes: attributes];
IF name=NIL THEN SIGNAL CreateError[type: MissingParameter, message: "no name given for CreateSequenceCell call"];
IF CoreOps.FetchCellType[design: design, name: name]#NIL THEN SIGNAL CreateError[type: DuplicateName, message: name];
CoreOps.InsertCellType[design: design, cellType: cell];
};
CreateIdentityCell: PUBLIC PROC [design: Design, name: ROPE, baseCell: CellType, attribute: Attribute ← [NIL, NIL], attributes: Attributes ← NIL] RETURNS [cell: CellType] = {
IF name=NIL THEN SIGNAL CreateError[type: MissingParameter, message: "no name given for CreateIdentityCell call"];
IF CoreOps.FetchCellType[design: design, name: name]#NIL THEN SIGNAL CreateError[type: DuplicateName, message: name];
cell ← CoreOps.Identity[cellType: baseCell, name: name];
cell.properties ← InsertAttributes[attribute: attribute, attributes: attributes];
CoreOps.InsertCellType[design: design, cellType: cell];
};
FetchCell: PUBLIC PROC [design: Design, name: ROPE] RETURNS [cell: CellType] = {
IF name=NIL OR design=NIL THEN SIGNAL CreateError[type: MissingParameter, message: "no name or design given for FetchCellType call"];
cell ← CoreOps.FetchCellType[design: design, name: name];
};
CreateCellInstance: PUBLIC PROC [design: Design, in: CellType, type: CellType, bind: ROPENIL, bindings: RopeList ← NIL, name: ROPENIL, attribute: Attribute ← [NIL, NIL], attributes: Attributes ← NIL] RETURNS [instance: CellInstance] = {
PeekTokenType: PROC RETURNS [tokenKind: IO.TokenKind] = {
pos: INTIO.GetIndex[s];
tokenKind ← IO.GetCedarTokenRope[s].tokenKind;
IO.SetIndex[s, pos];
};
Complain: PROC [prefix: ROPE] RETURNS [complaint: ROPE] = {
complaint ← IO.PutFR["%g in cell type %g while binding instance of %g", IO.rope[prefix], IO.rope[in.name], IO.rope[type.name]]
};
IDError: PROC = {
SIGNAL CreateError[type: BadBinding, message: Complain[IO.PutFR["field parse failed during parse of %g", IO.rope[bind]]]];
};
GetBreakChar: PROC RETURNS [b: CHAR] ={
tokenKind: IO.TokenKind;
token: ROPE;
[tokenKind: tokenKind, token: token] ← IO.GetCedarTokenRope[s];
IF tokenKind # tokenSINGLE THEN SIGNAL CreateError[type: BadBinding, message: Complain[IO.PutFR["parsed %g when expecting break character", IO.rope[token]]]];
b ← Rope.Fetch[base: token, index: 0];
};
ParseSelector: PROC RETURNS [actualWire: Wire, finalChar: CHAR] = {
actualWire ← into.internalWire;
SELECT PeekTokenType[] FROM
tokenID => {
actualWire ← ParseField[actualWire ! IO.Error => GOTO idError];
DO
SELECT (finalChar ← GetBreakChar[! IO.EndOfStream => EXIT]) FROM
'[ => {
CheckIndex: PROC [index: INT] = {
IF index>= actualWire.elements.size OR index<0 THEN SIGNAL CreateError[type: BadBinding, message: Complain[IO.PutFR["index larger than element count or less than zero during parse of %g", IO.rope[formal]]]];
};
index: INTIO.GetInt[s];
IF actualWire.structure # sequence OR actualWire.elements = NIL THEN SIGNAL CreateError[type: BadBinding, message: Complain[IO.PutFR["cannot index during parse of %g", IO.rope[formal]]]];
CheckIndex[index];
SELECT PeekTokenType[] FROM
tokenDOUBLE => {
open: INT;
construct: Wire;
IF NOT Rope.Equal["..", IO.GetCedarTokenRope[s].token] THEN SIGNAL CreateError[type: BadBinding, message: Complain[IO.PutFR["expected .. during parse of %g", IO.rope[formal]]]];
open ← IO.GetInt[s];
IF GetBreakChar[] # ') THEN SIGNAL CreateError[type: BadBinding, message: Complain[IO.PutFR["expected ) during parse of %g", IO.rope[formal]]]];
CheckIndex[open-1];
construct ← NEW[WireRec ← [
structure: sequence,
elements: NEW[WireSequenceRec[open-index]]]];
FOR i: INT IN [index..open) DO
construct.elements[i-index] ← actualWire.elements[i];
ENDLOOP;
actualWire ← construct;
};
tokenSINGLE => {
IF GetBreakChar[] # '] THEN SIGNAL CreateError[type: BadBinding, message: Complain[IO.PutFR["expected ] during parse of %g", IO.rope[formal]]]];
actualWire ← actualWire.elements[index];
};
ENDCASE => SIGNAL CreateError[type: BadBinding, message: Complain[IO.PutFR["illegal token in selector during parse of %g", IO.rope[formal]]]];
};
'. => actualWire ← ParseField[actualWire ! IO.Error => GOTO idError];
', => EXIT;
'] => EXIT;
ENDCASE => SIGNAL CreateError[type: BadBinding, message: Complain[IO.PutFR["illegal character in selector during parse of %g", IO.rope[formal]]]];
ENDLOOP;
EXITS
idError => IDError[];
};
tokenSINGLE => {
construct: Wire;
IF GetBreakChar[] # '[ THEN SIGNAL CreateError[type: BadBinding, message: Complain[IO.PutFR["expected [ during parse of %g", IO.rope[formal]]]];
construct ← NEW[WireRec ← [
structure: record,
elements: NEW[WireSequenceRec[0]]]];
DO
fc: CHAR;
newElements: WireSequence ← NEW[WireSequenceRec[construct.elements.size+1]];
FOR i: NAT IN [0..construct.elements.size) DO
newElements[i] ← construct.elements[i]
ENDLOOP;
construct.elements ← newElements;
[construct.elements[construct.elements.size-1], fc] ← ParseSelector[];
IF fc='] THEN EXIT;
ENDLOOP;
IF GetBreakChar[! IO.EndOfStream => CONTINUE]#', THEN SIGNAL CreateError[type: BadBinding, message: Complain[IO.PutFR[", must follow constructor during parse of %g", IO.rope[formal]]]];
actualWire ← construct;
};
ENDCASE => SIGNAL CreateError[type: BadBinding, message: Complain[IO.PutFR["illegal token in selector during parse of %g", IO.rope[formal]]]];
};
ParseField: PROC [context: Wire] RETURNS [actualWire: Wire] = {
actual: ROPEIO.GetID[s];
IF context.structure # record OR context.elements = NIL THEN SIGNAL CreateError[type: BadBinding, message: "cannot field select"];
FOR i: NAT IN [0..context.elements.size) DO
IF Rope.Equal[context.elements[i].name, actual] THEN {
actualWire ← context.elements[i];
EXIT;
};
REPEAT
FINISHED => SIGNAL CreateError[type: BadBinding, message: Complain[IO.PutFR["cannot find field %g", IO.rope[actual]]]];
ENDLOOP;
};
into: CoreRecord.RecordCellType;
formal: ROPE;
s: IO.STREAM;
IF design=NIL OR in=NIL OR type=NIL THEN SIGNAL CreateError[MissingParameter, NIL];
IF in.data=NIL THEN SIGNAL CreateError[NotRecordCell, NIL];
IF NOT ISTYPE[in.data, CoreRecord.RecordCellType] THEN SIGNAL CreateError[NotRecordCell, NIL];
into ← NARROW[in.data];
IF bindings=NIL THEN bindings ← LIST[bind];
FOR bindList: RopeList ← bindings, bindList.rest UNTIL bindList=NIL DO
bind ← bindList.first;
s ← IO.RIS[bind];
instance ← NEW[CoreRecord.CellInstanceRec ← [
name: name,
actualWire: NEW[WireRec ← [
structure: record,
elements: NEW[WireSequenceRec[type.publicWire.elements.size]]]],
type: type,
properties: InsertAttributes[attribute: attribute, attributes: attributes]]];
into.instances ← CONS[instance, into.instances];
DO
actualWire: Wire;
fc: CHAR;
formal ← IO.GetID[s ! IO.EndOfStream => EXIT; IO.Error => GOTO idError];
IF GetBreakChar[] # ': THEN SIGNAL CreateError[type: BadBinding, message: Complain[IO.PutFR[": must follow formal %g", IO.rope[formal]]]];
[actualWire, fc] ← ParseSelector[! IO.EndOfStream => GOTO unexpectedEnd];
FOR i:NAT IN [0..type.publicWire.elements.size) DO
IF Rope.Equal[type.publicWire.elements[i].name, formal] THEN {
instance.actualWire.elements[i] ← actualWire;
EXIT;
};
REPEAT
FINISHED => SIGNAL CreateError[type: BadBinding, message: Complain[IO.PutFR["cannot find formal %g", IO.rope[formal]]]];
ENDLOOP;
REPEAT
idError => IDError[];
unexpectedEnd => SIGNAL CreateError[type: BadBinding, message: Complain[IO.PutFR["unexpected end of binding rope during parse of %g", IO.rope[formal]]]];
ENDLOOP;
FOR act:NAT IN [0..instance.actualWire.elements.size) DO
IF instance.actualWire.elements[act]=NIL THEN {
FOR int:NAT IN [0..into.internalWire.elements.size) DO
IF Rope.Equal[type.publicWire.elements[act].name, into.internalWire.elements[int].name] THEN {
instance.actualWire.elements[act] ← into.internalWire.elements[int];
EXIT;
};
REPEAT
FINISHED => SIGNAL CreateError[type: BadBinding, message: Complain[IO.PutFR["cannot bind formal %g", IO.rope[type.publicWire.elements[act].name]]]];
ENDLOOP;
};
IF NOT CoreRecord.Conform[instance.actualWire.elements[act], type.publicWire.elements[act]] THEN SIGNAL CreateError[type: BadBinding, message: Complain[IO.PutFR["actual does not match formal %g", IO.rope[type.publicWire.elements[act].name]]]];
ENDLOOP;
ENDLOOP;
};
Wires
CreateWireSequenceType: PUBLIC PROC [design: Design, name: ROPENIL, count: NAT, base: Wire ← NIL, attribute: Attribute ← [NIL, NIL], attributes: Attributes ← NIL] RETURNS [wire: Wire] = {
wire ← NEW[WireRec ← [
name: name,
structure: sequence,
elements: NEW[WireSequenceRec[count]],
properties: InsertAttributes[attributes: attributes]]];
IF base=NIL THEN base ← CoreOps.CreateAtomWire[];
FOR i: NAT IN [0..count) DO
wire.elements[i] ← base;
ENDLOOP;
};
CreateWireRecordType: PUBLIC PROC [design: Design, name: ROPENIL, components: LIST OF Wire, attribute: Attribute ← [NIL, NIL], attributes: Attributes ← NIL] RETURNS [wire: Wire] = {
wire ← CoreOps.CreateRecordWire[name: name, components: components];
wire.properties ← InsertAttributes[attributes: attributes];
};
CreateWireType: PUBLIC PROC [design: Design, name: ROPENIL, attribute: Attribute ← [NIL, NIL], attributes: Attributes ← NIL] RETURNS [wire: Wire] = {
wire ← CoreOps.CreateAtomWire[name: name];
wire.properties ← InsertAttributes[attributes: attributes];
};
CreateWire: PUBLIC PROC [design: Design, in: CellType, name: ROPENIL, names: RopeList ← NIL, type: Wire ← NIL, attribute: Attribute ← [NIL, NIL], attributes: Attributes ← NIL] RETURNS [wire: Wire] = {
IF names=NIL THEN names ← LIST[name];
FOR nameList: RopeList ← names, nameList.rest UNTIL nameList=NIL DO
wire ← ReallyCreateWire[design: design, in: in, name: nameList.first, type: type, attributes: attributes];
ENDLOOP;
};
ReallyCreateWire: PROC [design: Design, in: CellType, name: ROPENIL, type: Wire ← NIL, attributes: Attributes ← NIL] RETURNS [newWire: Wire] = {
recCell: CoreRecord.RecordCellType ← NARROW[in.data];
intWire: Wire ← recCell.internalWire;
newWireSeq: WireSequence ← NEW[WireSequenceRec[intWire.elements.size+1]];
FOR i: NAT IN [0..intWire.elements.size) DO
newWireSeq[i] ← intWire.elements[i];
ENDLOOP;
newWire ← IF type= NIL THEN CoreOps.CreateAtomWire[name: name] ELSE CoreOps.CopyWire[wire: type];
newWire.name ← name;
newWire.properties ← InsertAttributes[attributes: attributes];
IF type#NIL THEN newWire.properties ← CoreProperties.AppendProps[winner: newWire.properties, loser: type.properties];
newWireSeq[intWire.elements.size] ← newWire;
intWire.elements ← newWireSeq;
};
CreatePublicWire: PUBLIC PROC [design: Design, on: CellType, name: ROPENIL, names: RopeList ← NIL, type: Wire ← NIL, attribute: Attribute ← [NIL, NIL], attributes: Attributes ← NIL] RETURNS [wire: Wire] = {
IF names=NIL THEN names ← LIST[name];
FOR nameList: RopeList ← names, nameList.rest UNTIL nameList=NIL DO
pubWire: Wire ← on.publicWire;
newWireSeq: WireSequence ← NEW[WireSequenceRec[pubWire.elements.size+1]];
wire ← ReallyCreateWire[design: design, in: on, name: nameList.first, type: type, attributes: attributes];
FOR i: NAT IN [0..pubWire.elements.size) DO
newWireSeq[i] ← pubWire.elements[i];
ENDLOOP;
newWireSeq[pubWire.elements.size] ← wire;
pubWire.elements ← newWireSeq;
ENDLOOP;
};
Attributes
PutAttributeOnCell: PUBLIC PROC [design: Design, on: CellType, attribute: Attribute ← [NIL, NIL], attributes: Attributes ← NIL] = {
on.properties ← InsertAttributes[attribute: attribute, attributes: attributes, properties: on.properties];
};
InsertAttributes: PROC [attribute: Attribute ← [NIL, NIL], attributes: Attributes, properties: Properties ← NIL] RETURNS [newProperties: Properties] = {
newProperties ← properties;
newProperties ← CoreProperties.PutProp[on: newProperties, prop: attribute.key, value: attribute.val];
FOR att: Attributes ← attributes, att.rest UNTIL att=NIL DO
newProperties ← CoreProperties.PutProp[on: newProperties, prop: att.first.key, value: att.first.val];
ENDLOOP;
};
END.