CoreComposeImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Louis Monier December 17, 1985 2:11:24 pm PST
Barth, December 6, 1985 6:29:49 pm PST
Bertrand Serlet November 19, 1985 11:13:34 pm PST
DIRECTORY AMBridge, AMModel, AMModelBridge, AMTypes, Core, CoreClasses, CoreCompose, CoreContext, CoreOps, CoreProperties, CoreSequence, InterpreterOps, PPLeaves, PPTree, PrincOpsUtils, RefTab, Rope;
CoreComposeImpl: CEDAR PROGRAM
IMPORTS AMBridge, AMModelBridge, CoreClasses, CoreContext, CoreOps, CoreProperties, CoreSequence, InterpreterOps, PrincOpsUtils, RefTab, Rope
EXPORTS CoreCompose =
BEGIN OPEN CoreCompose;
Tree: TYPE = InterpreterOps.Tree;
Node: TYPE = REF PPTree.Node;
Wire: TYPE = Core.Wire;
CompositeContext: TYPE = REF CompositeContextRec;
CompositeContextRec: TYPE = RECORD[
context: Context,
cedarContext: AMModel.Context];
Context
GetRef: PUBLIC PROC [context: Context, name: ROPE] RETURNS [ref: REF] = {
RETURN [CoreContext.Eval[context, name]];};
GetAtom: PUBLIC PROC [context: Context, name: ROPE] RETURNS [ATOM] = {
RETURN[NARROW[CoreContext.Eval[context, name]]];};
GetRope: PUBLIC PROC [context: Context, name: ROPE] RETURNS [ROPE] = {
RETURN[NARROW[CoreContext.Eval[context, name]]];};
GetInt: PUBLIC PROC [context: Context, name: ROPE] RETURNS [INT] = {
RETURN[NARROW[CoreContext.Eval[context, name], REF INT]^];};
GetReal: PUBLIC PROC [context: Context, name: ROPE] RETURNS [REAL] = {
RETURN[NARROW[CoreContext.Eval[context, name], REF REAL]^];};
GetBool: PUBLIC PROC [context: Context, name: ROPE] RETURNS [BOOL] = {
RETURN[NARROW[CoreContext.Eval[context, name], REF BOOL]^];};
PushRef: PUBLIC PROC [context: Context, name: ROPE, val: REF] = {
CoreContext.Store[context, name, val]};
PushAtom: PUBLIC PROC [context: Context, name: ROPE, val: ATOM] = {
CoreContext.Store[context, name, val]};
PushRope: PUBLIC PROC [context: Context, name: ROPE, val: ROPE] = {
CoreContext.Store[context, name, val]};
PushInt: PUBLIC PROC [context: Context, name: ROPE, val: INT] = {
CoreContext.Store[context, name, NEW[INT ← val]]};
PushReal: PUBLIC PROC [context: Context, name: ROPE, val: REAL] = {
CoreContext.Store[context, name, NEW[REAL ← val]]};
PushBool: PUBLIC PROC [context: Context, name: ROPE, val: BOOL] = {
CoreContext.Store[context, name, NEW[BOOL ← val]]};
Cells
CreateTransistor: PUBLIC PROC [name: ROPE ← NIL, type: TransistorType ← nE, length: NAT ← 2, width: NAT ← 4] RETURNS [cellType: CellType] = {
trRec: CoreClasses.TransistorRec ← [
type: type,
length: length,
width: width];
cellType ← CoreClasses.CreateTransistor[trRec];
};
CreateSequenceCell: PUBLIC PROC [name: ROPE, baseCell: CellType, count: NAT, sequencePorts: ROPE ← NIL] RETURNS [cellType: CellType] = {
node: Node ← NIL; n: INT ← 0;
tree: Tree;
seqCell: CoreSequence.SequenceCellType;
IF sequencePorts#NIL THEN {
tree ← Parse[sequencePorts];
WITH tree SELECT FROM
ident: PPLeaves.HTIndex => {  -- one wire in list
seqCell ← NEW[CoreSequence.SequenceCellTypeRec[1]];
seqCell.sequence[0] ← CoreOps.GetWireIndex[
baseCell.public, InterpreterOps.TreeToName[tree]];
};
node: Node => {
n ← node.sonLimit-1;
seqCell ← NEW[CoreSequence.SequenceCellTypeRec[n]];
FOR i: INT IN [0..n) DO -- hope we will not go in there if n=0
seqCell.sequence[i] ← CoreOps.GetWireIndex[
baseCell.public,
InterpreterOps.TreeToName[Nth[node, i+1]]];
ENDLOOP;
};
ENDCASE => ERROR;
}
ELSE seqCell ← NEW [CoreSequence.SequenceCellTypeRec[0]];
seqCell.base ← baseCell;
seqCell.count ← count;
cellType ← CoreSequence.Create[name: name, args: seqCell];
};
CreateRecordCell: PUBLIC PROC [name: ROPE, public: Wire, onlyInternal: Wire ← NIL, instances: InstanceList ← NIL, context: Context ← NIL] RETURNS [cellType: CellType] = TRUSTED {
cedarContext: AMModel.Context ← AMModelBridge.ContextForFrame[
AMBridge.TVForFrame[PrincOpsUtils.GetReturnFrame[]]];
cc: CompositeContext ← NEW [CompositeContextRec ← [context, cedarContext]];
internal: Wire ← WireUnion[public, onlyInternal];
recordCellType: CoreClasses.RecordCellType;
cellType ← CoreClasses.CreateRecordCell[
public: public,
internal: internal,
instances: ToCoreClassesInsts[instances, internal, cc],
name: name
];
recordCellType ← NARROW[cellType.data];
internal ← NEW[Core.WireRec[ recordCellType.internal.size+recordCellType.size+1]];
FOR int: NAT IN [0..recordCellType.internal.size) DO
internal[int] ← recordCellType.internal[int];
ENDLOOP;
FOR inst: NAT IN [0..recordCellType.size) DO
internal[inst+recordCellType.internal.size] ← recordCellType[inst].actual;
ENDLOOP;
internal[internal.size-1] ← cellType.public;
recordCellType.internal ← internal;
};
Instances
-- Light-weight instances (with binding specified through a rope) to CoreClasses instances
ToCoreClassesInsts: PROC [insts: InstanceList, internal: Wire, cc: CompositeContext] RETURNS [instances: LIST OF CoreClasses.CellInstance ← NIL] = {
newList: InstanceList ← NIL;
-- preserve the ordering of instances
FOR l: InstanceList ← insts, l.rest WHILE l#NIL DO newList ← CONS[l.first, newList] ENDLOOP;
FOR l: InstanceList ← newList, l.rest WHILE l#NIL DO
instances ← CONS[MakeInst[l.first.actual, l.first.type, internal, cc], instances];
ENDLOOP;
};
-- rope is a list of bindings "a:x, b:M[3].b, c: T[16,8]"
MakeInst: PROC [rope: ROPE, ct: CellType, internal: Wire, cc: CompositeContext] RETURNS [inst: CoreClasses.CellInstance] = {
inst ← NEW[CoreClasses.CellInstanceRec ← [
actual: EvalListOfBinding[Parse[rope], ct.public, internal, cc].wire, type: ct]];
IF NOT CoreOps.Conform[inst.actual, ct.public] THEN ERROR;
};
Wires
WireUnion: PROC [w1, w2: Wire] RETURNS [union: Wire] = {
IF w1=NIL THEN RETURN [w2];
IF w2=NIL THEN RETURN [w1];
union ← CoreOps.CreateWire[size: w1.size+w2.size];
FOR i: INT IN [0..w1.size) DO union[i] ← w1[i] ENDLOOP;
FOR i: INT IN [0..w2.size) DO union[i+w1.size] ← w2[i] ENDLOOP;
};
CreateSequenceWire: PROC [wire: Wire, n: INT] RETURNS [seq: Wire] = {
comp: LIST OF Wire ← NIL;
IF wire=NIL THEN wire ← CoreOps.CreateWire[];
FOR i: INT IN [0..n) DO comp ← CONS [CoreOps.CopyWire[wire], comp]; ENDLOOP;
seq ← CoreOps.CreateSequenceWire[elements: comp];
};
-- Return a public or internal wire
CreateWires: PUBLIC PROC [rope: ROPE, context: Context ← NIL] RETURNS [wire: Wire] = TRUSTED {
cedarContext: AMModel.Context ← AMModelBridge.ContextForFrame[
AMBridge.TVForFrame[PrincOpsUtils.GetReturnFrame[]]];
cc: CompositeContext ← NEW [CompositeContextRec ← [context, cedarContext]];
justAWire: Wire ← Eval[Parse[rope], NIL, cc].compWire;
wire ← IF CoreOps.GetWireName[justAWire]#NIL THEN CoreOps.WiresToWire[LIST [justAWire]] ELSE justAWire;
};
-- top level only
FindNamedWire: PROC [name: ROPE, public: Wire] RETURNS [wire: Wire] = {
RETURN [public[CoreOps.GetWireIndex[public, name]]];
};
Parser and Evaluators
-- Evaluator for Actual Wires
-- The tree is of type list, unless there is only one binding, . . .
-- Parse a list of "formal:actual", check that formal is in ct.public, return actual
-- Completes by implicit binding (same names)
EvalListOfBinding: PROC [tree: Tree, public, internal: Wire, cc: CompositeContext] RETURNS [wire: Wire] = {
comp: LIST OF Wire ← NIL;
refTab: RefTab.Ref ← RefTab.Create[];
IF tree#NIL THEN {
WITH tree SELECT FROM
node: Node => {
formal, actual: Wire;
IF node.name=list THEN  -- list of bindings
{FOR i: INT IN [1..node.sonLimit) DO
[formal, actual] ← EvalActBinding[Nth[node, i], public, internal, cc];
[] ← RefTab.Store[refTab, formal, actual];
ENDLOOP;
}
ELSE {   -- single binding
[formal, actual] ← EvalActBinding[tree, public, internal, cc];
[] ← RefTab.Store[refTab, formal, actual];};
};
ENDCASE => ERROR};
-- now implicit binding
FOR i: INT IN [0..public.size) DO
subW: Wire ← public[i];
IF ~RefTab.Fetch[refTab, subW].found THEN [] ← RefTab.Store[
refTab,
subW,
FindNamedWire[CoreOps.GetWireName[subW], internal]];
ENDLOOP;
comp ← VisitTopWire[public, refTab];
wire ← CoreOps.WiresToWire[CoreOps.Reverse[comp]];
};
VisitTopWire: PROC [wire: Wire, refTab: RefTab.Ref] RETURNS [lw: LIST OF Wire ← NIL] = {
FOR i: INT IN [0..wire.size) DO
lw ← CONS[NARROW[RefTab.Fetch[refTab, wire[i]].val], lw];
ENDLOOP;
};
EvalActBinding: PROC [tree: Tree, public, internal: Wire, cc: CompositeContext] RETURNS [formal, actual: Wire] = {
WITH tree SELECT FROM
node: Node => {
IF node.name#item THEN ERROR;  -- must be an item formal:actual
formal ← FindFormal[Left[node], public]; -- a public wire of small cell
actual ← EvalActual[Right[node], NIL, internal, cc].compWire; -- an internal of record cell
};
ENDCASE => ERROR;
};
EvalActual: PROC [tree: Tree, wire: Wire ← NIL, internal: Wire, cc: CompositeContext] RETURNS [leftTree: Tree ← NIL, compWire: Wire] = {
IF tree=NIL THEN RETURN[NIL, wire];
WITH tree SELECT FROM
ident: PPLeaves.HTIndex => {  -- find the wire with this name
wire ← FindNamedWire[ident.name, internal];
RETURN[NIL, wire]};
const: PPLeaves.LTIndex => {ERROR}; -- constant?
node: Node => { -- node
l: Tree ← Left[node];
r: Tree ← Right[node];
SELECT node.name FROM
dot => { -- field selection
field: ROPE ← InterpreterOps.TreeToName[r];
compWire ← FindNamedWire[field, EvalActual[l, wire, internal, cc].compWire];
};
apply => {  -- array indexing, subrange or record constructor
IF l=NIL THEN { -- record constructor
comp: LIST OF Wire ← NIL;
list: Node ← NARROW[r]; -- a list
IF list.name#list THEN ERROR; -- check that it is a list
FOR i: INT IN [1..list.sonLimit) DO
comp ← CONS[EvalActual[Nth[NARROW[list], i], NIL, internal, cc].compWire, comp];
ENDLOOP;
compWire ← CoreOps.WiresToWire[CoreOps.Reverse[comp]]
}
ELSE {
Added by BS November 9, 1985 11:17:16 pm PST, SANS RIEN Y BITER
WITH r SELECT FROM
right: Node   => {
SELECT right.name FROM
list => {   -- subrange
start, length: INT;
comp: LIST OF Wire ← NIL;
[start, length] ← EvalSubrange[r, cc];
FOR i: INT IN [start..start+length) DO
comp ← CONS[EvalActual[l, wire, internal, cc].compWire[i], comp];
ENDLOOP;
compWire ← CoreOps.WiresToWire[CoreOps.Reverse[comp]]
};
ENDCASE => {  -- array indexing
n: INT ← EvalToInt[r, cc];
compWire ← EvalActual[l, wire, internal, cc].compWire[n];
};
};
right: PPLeaves.HTIndex  => {
SELECT right.name FROM
ENDCASE => {  -- array indexing
n: INT ← EvalToInt[r, cc];
compWire ← EvalActual[l, wire, internal, cc].compWire[n];
};
};
ENDCASE => ERROR
};
};
ENDCASE => ERROR;
};
ENDCASE => ERROR;
};
FindFormal: PROC [tree: Tree, public: Wire] RETURNS [formal: Wire] = {
WITH tree SELECT FROM
ident: PPLeaves.HTIndex => {formal ← FindNamedWire[ident.name, public]};
ENDCASE => ERROR;
};
-- Evaluator for Public and Internal Wires
Eval: PROC [tree: Tree, wire: Wire ← NIL, cc: CompositeContext] RETURNS [leftTree: Tree ← NIL, compWire: Wire] = {
IF tree=NIL THEN RETURN[NIL, wire];
WITH tree SELECT FROM
ident: PPLeaves.HTIndex => {  -- name
IF wire=NIL THEN wire ← CoreOps.CreateWire[name: ident.name]
ELSE CoreProperties.PutWireProp[wire, CoreOps.nameProp, ident.name];
RETURN [NIL, wire]};
const: PPLeaves.LTIndex => {ERROR}; -- what is a constant doing here?
node: Node => { -- node
l: Tree ← Left[node];
r: Tree ← Right[node];
SELECT node.name FROM
apply => {
[leftTree, compWire] ← Eval[l, Eval[r, wire, cc].compWire, cc];
RETURN[leftTree, compWire]};
list => { -- record wire
comp: LIST OF Wire ← NIL;
IF wire#NIL THEN ERROR; -- record has nothing on the right
FOR i: INT IN [1..node.sonLimit) DO
comp ← CONS[Eval[Nth[node, i], NIL, cc].compWire, comp];
ENDLOOP;
compWire ← CoreOps.WiresToWire[CoreOps.Reverse[comp]];
};
item => { -- sequence spec
SELECT TRUE FROM
Rope.Equal[InterpreterOps.TreeToName[l], "seq", FALSE] => {
compWire ← CreateSequenceWire[wire, EvalToInt[r, cc]];
};
Rope.Equal[InterpreterOps.TreeToName[l], "enum", FALSE] => {
IF wire#NIL THEN ERROR; -- enum has nothing on the right
};
ENDCASE => ERROR;
};
ENDCASE => ERROR;
};
ENDCASE => ERROR;
};
};
-- Parser and tree browsing primitives
-- Given a rope, return the parse tree rooted as a list, or NIL if rope=NIL
Parse: PROC [rope: ROPE] RETURNS [parseTree: Tree] = {
node: Node;
IF rope=NIL THEN RETURN[NIL];
parseTree ← InterpreterOps.ParseExpr[Rope.Cat["&fake ← [", rope, "]"]];
node ← NARROW[parseTree];
node ← NARROW[Right[node]];  -- remove "&fake ← "
RETURN[Right[node]];  -- remove "[ ]"
};
Left: PROC [node: Node] RETURNS [Tree] = {RETURN[node[1]]};
Right: PROC [node: Node] RETURNS [Tree] = {RETURN[node[2]]};
Nth: PROC [node: Node, i: INT] RETURNS [Tree] = {
IF i IN [1..node.sonLimit) THEN RETURN[node.son[i]] ELSE RETURN[NIL]};
EvalToInt: PROC [parseTree: Tree, cc: CompositeContext] RETURNS [n: INT] = TRUSTED {
tv: AMTypes.TV ← InterpreterOps.Eval[
head: InterpreterOps.NewEvalHead[
context: cc.cedarContext,
specials: cc.context], -- put the symbol table from the context here
tree: parseTree];
n ← AMBridge.TVToLI[tv];
};
EvalSubrange: PROC [tree: Tree, cc: CompositeContext] RETURNS [start, length: INT] = {
start ← EvalAndCheck[Left[NARROW[tree]], "start", cc];
length ← EvalAndCheck[Right[NARROW[tree]], "len", cc];
};
EvalAndCheck: PROC [tree: Tree, rope: ROPE, cc: CompositeContext] RETURNS [n: INT] = {
IF ~Rope.Equal[InterpreterOps.TreeToName[Left[NARROW[tree]]], rope, FALSE] THEN ERROR;
n ← EvalToInt[Right[NARROW[tree]], cc];
};
END.