<> <> <> <> <> <<>> 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]; <> 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]]}; <> 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; }; <> <<-- 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; }; <> 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]]]; }; <> <<-- 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 { <> 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.