<> <> <> <<>> DIRECTORY AMBridge, AMModel, AMTypes, Atom, Core, CoreClasses, CoreCompose, CoreOps, CoreSequence, InterpreterOps, PPLeaves, PPTree, RefTab, Rope, SymTab, WorldVM; CoreComposeImpl: CEDAR PROGRAM IMPORTS AMBridge, AMModel, Atom, CoreClasses, CoreOps, CoreSequence, InterpreterOps, RefTab, Rope, SymTab, WorldVM EXPORTS CoreCompose = BEGIN OPEN CoreCompose; ref: ATOM =$CtxREF; atom: ATOM =$CtxATOM; rope: ATOM =$CtxROPE; int: ATOM =$CtxINT; real: ATOM =$CtxREAL; bool: ATOM =$CtxBOOL; stMark: ATOM =$CtxStackMark; procMark: ATOM =$CtxprocMark; <<>> Tree: TYPE = InterpreterOps.Tree; Node: TYPE = REF PPTree.Node; Wire: TYPE = Core.Wire; <> CheckTypeVal: PROC [lit: PropertyLiteral] = { type: ATOM _ WITH lit.val SELECT FROM a: ATOM => atom, r: ROPE => rope, i: REF INT => int, r: REF REAL => real, r: REF => ref, ENDCASE => ERROR; CheckTypeProp[lit.key, type]; }; CheckTypeProp: PROC [prop, type: ATOM] = { IF ~RefTab.Fetch[propTable, prop].val=type THEN ERROR}; -- prop reg. with another type <<>> <<-- The properties are older as we move towards the end of the list>> <<-- and this is how the scoping mechanism works>> FetchRef: PROC [context: CContext, prop: ATOM] RETURNS [found: BOOL _ FALSE, ref: REF _ NIL] = { FOR l: Stack _ context.stack, l.rest WHILE l#NIL DO IF l.first.key=prop THEN RETURN[TRUE, l.first.val]; ENDLOOP; }; GetRef: PUBLIC PROC [context: CContext, prop: ATOM] RETURNS [REF] = { FOR l: Stack _ context.stack, l.rest WHILE l#NIL DO IF l.first.key=prop THEN RETURN[l.first.val]; ENDLOOP; ERROR; -- prop not found }; GetAtom: PUBLIC PROC [context: CContext, prop: ATOM] RETURNS [ATOM] = { CheckTypeProp[prop, atom]; RETURN[NARROW[GetRef[context, prop]]];}; GetRope: PUBLIC PROC [context: CContext, prop: ATOM] RETURNS [ROPE] = { CheckTypeProp[prop, rope]; RETURN[NARROW[GetRef[context, prop]]];}; GetInt: PUBLIC PROC [context: CContext, prop: ATOM] RETURNS [INT] = { CheckTypeProp[prop, int]; RETURN[NARROW[GetRef[context, prop], REF INT]^];}; GetReal: PUBLIC PROC [context: CContext, prop: ATOM] RETURNS [REAL] = { CheckTypeProp[prop, real]; RETURN[NARROW[GetRef[context, prop], REF REAL]^];}; GetBool: PUBLIC PROC [context: CContext, prop: ATOM] RETURNS [BOOL] = { CheckTypeProp[prop, bool]; RETURN[NARROW[GetRef[context, prop], REF BOOL]^];}; PushRef: PUBLIC PROC [context: CContext, prop: ATOM, val: REF] = TRUSTED{ context.stack _ CONS[[prop, val], context.stack]; [] _ SymTab.Store[context.tab, Atom.GetPName[prop], AMBridge.TVForReferent[val]]}; PushAtom: PUBLIC PROC [context: CContext, prop: ATOM, val: ATOM] = TRUSTED{ context.stack _ CONS[[prop, val], context.stack]; [] _ SymTab.Store[context.tab, Atom.GetPName[prop], AMBridge.TVForATOM[val]]}; PushRope: PUBLIC PROC [context: CContext, prop: ATOM, val: ROPE] = TRUSTED{ context.stack _ CONS[[prop, val], context.stack]; [] _ SymTab.Store[context.tab, Atom.GetPName[prop], AMBridge.TVForROPE[val]]}; PushInt: PUBLIC PROC [context: CContext, prop: ATOM, val: INT] = TRUSTED{ PushRef[context, prop, NEW[INT _ val]]}; PushReal: PUBLIC PROC [context: CContext, prop: ATOM, val: REAL] = TRUSTED{ PushRef[context, prop, NEW[REAL _ val]]}; PushBool: PUBLIC PROC [context: CContext, prop: ATOM, val: BOOL] = TRUSTED{ PushRef[context, prop, NEW[BOOL _ val]]}; RegisterProperty: PROC [prop, type: ATOM] = { [] _ RefTab.Store[propTable, prop, type]}; FetchPropertyType: PROC [prop: ATOM] RETURNS [type: ATOM] = { type _ NARROW[RefTab.Fetch[propTable, prop].val]}; RegisterRefProperty: PUBLIC PROC [prop: ATOM] = {RegisterProperty[prop, ref]}; RegisterAtomProperty: PUBLIC PROC [prop: ATOM] = {RegisterProperty[prop, atom]}; RegisterRopeProperty: PUBLIC PROC [prop: ATOM] = {RegisterProperty[prop, rope]}; RegisterIntProperty: PUBLIC PROC [prop: ATOM] = {RegisterProperty[prop, int]}; RegisterRealProperty: PUBLIC PROC [prop: ATOM] = {RegisterProperty[prop, real]}; RegisterBoolProperty: PUBLIC PROC [prop: ATOM] = {RegisterProperty[prop, bool]}; CreateContext: PUBLIC PROC [init: CContext _ NIL, props: PropertyLiterals _ NIL] RETURNS [CContext] = { new: CContext _ init; IF new=NIL THEN new _ NEW[ContextRec _ [tab: SymTab.Create[ ]]]; FOR l: PropertyLiterals _ props, l.rest WHILE l#NIL DO lit: PropertyLiteral _ l.first; CheckTypeVal[lit]; PushRef[new, lit.key, lit.val]; ENDLOOP; RETURN[new]; }; MarkContext: PUBLIC PROC [context: CContext, mark: ATOM] = { context.stack _ CONS[[stMark, mark], context.stack]}; Equal: PROC [lit1, lit2: PropertyLiteral] RETURNS [BOOL] = { RETURN[lit1.key=lit2.key AND lit1.val=lit2.val]; }; PopLit: PROC [context: CContext] RETURNS [lit: PropertyLiteral] = TRUSTED{ older: REF; found: BOOL; IF context.stack=NIL THEN ERROR; -- empty stack lit _ context.stack.first; context.stack _ context.stack.rest; [found, older] _ FetchRef[context, lit.key]; -- found in stack IF found THEN [] _ SymTab.Store[context.tab, Atom.GetPName[lit.key], AMBridge.TVForReferent[NEW[REF _ older]]] ELSE [] _ SymTab.Delete[context.tab, Atom.GetPName[lit.key]]; }; PopContext: PUBLIC PROC [context: CContext, mark: ATOM] = { lit: PropertyLiteral _ PopLit[context]; goal: PropertyLiteral _ [stMark, mark]; UNTIL Equal[lit, goal] DO -- mark is the last one popped lit _ PopLit[context]; ENDLOOP; }; RegisterStructureProc: PUBLIC PROC [name: ROPE, proc: StructureProc] RETURNS [ROPE] = { val: REF StructureProc _ NEW[StructureProc _ proc]; ok: BOOL _ SymTab.Store[structProcTable, name, val]; -- larger table! <> RETURN[name]}; <<>> CreateStructure: PUBLIC PROC [name: ROPE, context: CContext] RETURNS [ct: Core.CellType] = { val: REF; found: BOOL; proc: StructureProc; [found, val] _ SymTab.Fetch[structProcTable, name]; IF ~found THEN ERROR; -- proc not registered: should we return NIL? proc _ NARROW[val, REF StructureProc]^; MarkContext[context, procMark]; ct _ proc[context]; PopContext[context, procMark]; }; <> CreateTransistor: PUBLIC PROC [name: ROPE _ NIL, type: TransistorType _ nE, length: NAT _ 2, width: NAT _ 4] RETURNS [cellType: Core.CellType] = { trRec: CoreClasses.TransistorRec _ [ type: type, length: length, width: width]; cellType _ CoreClasses.TransistorCreate[trRec]; }; CreateSequenceCell: PUBLIC PROC [name: ROPE, baseCell: Core.CellType, count: NAT, sequencePorts: ROPE _ NIL] RETURNS [cellType: Core.CellType] = { node: Node _ NIL; n: INT _ 0; seqCell: CoreSequence.SequenceCellType; IF sequencePorts#NIL THEN {node _ NARROW[Parse[sequencePorts]]; n _ node.sonLimit-1}; seqCell _ NEW[CoreSequence.SequenceCellTypeRec[n]]; seqCell.base _ baseCell; seqCell.count _ count; FOR i: INT IN [0..n) DO -- hope we will not go in there if n=0 seqCell.sequence[i] _ FindIndexWire[ InterpreterOps.TreeToName[Nth[node, i+1]], baseCell.public]; ENDLOOP; cellType _ CoreSequence.Create[name: name, args: seqCell]; }; CreateRecordCell: PUBLIC PROC [name: ROPE, public: Wire, onlyInternal: Wire _ NIL, instances: InstanceList _ NIL, context: Context] RETURNS [cellType: Core.CellType] = { internalWire: Wire _ WireUnion[public, onlyInternal]; recCell: CoreClasses.RecordCellType _ NEW[CoreClasses.RecordCellTypeRec _ [ internal: internalWire, instances: ToCoreClassesInsts[instances, internalWire, context]]]; cellType _ NEW[Core.CellTypeRec _ [ name: name, class: CoreClasses.recordCellClass, public: public, data: recCell]]; }; <> <<-- Light-weight instances (with binding specified through a rope) to CoreClasses instances>> ToCoreClassesInsts: PROC [insts: InstanceList, internal: Wire, context: Context] RETURNS [instances: CoreClasses.CellInstanceList _ 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, context], instances]; ENDLOOP; }; <<-- rope is a list of bindings "a:x, b:M[3].b, c: T[16,8]">> MakeInst: PROC [rope: ROPE, ct: Core.CellType, internal: Wire, context: Context] RETURNS [inst: CoreClasses.CellInstance] = { inst _ NEW[CoreClasses.CellInstanceRec _ [ actual: EvalListOfBinding[Parse[rope], ct.public, internal, context].wire, type: ct]]}; <> -- w1.structure=record and w2.structure=record WireUnion: PROC [w1, w2: Wire] RETURNS [union: Wire] = { size1: INT; IF w1=NIL THEN RETURN[w2]; IF w2=NIL THEN RETURN[w1]; union _ NEW[Core.WireRec _ w1^]; size1 _ w1.elements.size; union.elements _ NEW[Core.WireSequenceRec[size1+w2.elements.size]]; FOR i: INT IN [0..w1.elements.size) DO union.elements[i] _ w1.elements[i] ENDLOOP; FOR i: INT IN [0..w2.elements.size) DO union.elements[i+size1] _ w2.elements[i] ENDLOOP; }; CreateSequenceWire: PROC [wire: Wire, n: INT] RETURNS [seq: Wire] = { comp: LIST OF Wire _ NIL; IF wire=NIL THEN wire _ CoreOps.CreateAtomWire[]; FOR i: INT IN [0..n) DO comp _ CONS[CoreOps.CopyWire[wire], comp]; ENDLOOP; seq _ CoreOps.CreateSequenceWire[components: comp]; }; <<>> <<-- Return a public or internal wire>> CreateWires: PUBLIC PROC [context: CContext, rope: ROPE] RETURNS [wire: Wire] = { wire _ Eval[Parse[rope], NIL, context].compWire; <<-- A public wire should be a record>> IF wire.structure#record THEN wire _ CoreOps.CreateRecordWire[components: LIST[wire]]; }; <<-- top level only>> FindNamedWire: PROC [name: ROPE, public: Wire] RETURNS [wire: Wire] = { RETURN[public.elements[FindIndexWire[name, public]]]}; FindIndexWire: PROC [name: ROPE, public: Wire] RETURNS [INT _ -1] = { FOR i: INT IN [0..public.elements.size) DO IF Rope.Equal[name, public.elements[i].name] THEN RETURN[i]; ENDLOOP; }; <> <<-- 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.publicWire, return actual>> <<-- Completes by implicit binding (same names)>> EvalListOfBinding: PROC [tree: Tree, public, internal: Wire, context: Context] 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, context]; [] _ RefTab.Store[refTab, formal, actual]; ENDLOOP; } ELSE { -- single binding [formal, actual] _ EvalActBinding[tree, public, internal, context]; [] _ RefTab.Store[refTab, formal, actual];}; }; ENDCASE => ERROR}; <<-- now implicit binding>> FOR i: INT IN [0..public.elements.size) DO subW: Wire _ public.elements[i]; IF ~RefTab.Fetch[refTab, subW].found THEN [] _ RefTab.Store[ refTab, subW, FindNamedWire[subW.name, internal]]; ENDLOOP; comp _ VisitTopWire[public, refTab]; wire _ CoreOps.CreateRecordWire[components: RevLOW[comp]]; }; VisitTopWire: PROC [wire: Wire, refTab: RefTab.Ref] RETURNS [lw: LIST OF Wire _ NIL] = { FOR i: INT IN [0..wire.elements.size) DO lw _ CONS[NARROW[RefTab.Fetch[refTab, wire.elements[i]].val], lw]; ENDLOOP; }; EvalActBinding: PROC [tree: Tree, public, internal: Wire, context: Context] 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, context].compWire; -- an internal of record cell }; ENDCASE => ERROR; }; EvalActual: PROC [tree: Tree, wire: Wire _ NIL, internal: Wire, context: Context] 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, context].compWire]; }; apply => { -- array indexing or subrange right: Node _ NARROW[r]; SELECT right.name FROM list => { -- subrange start, length: INT; comp: LIST OF Wire _ NIL; [start, length] _ EvalSubrange[r, context]; FOR i: INT IN [start..start+length) DO comp _ CONS[EvalActual[l, wire, internal, context].compWire.elements[i], comp]; ENDLOOP; compWire _ CoreOps.CreateRecordWire[components: RevLOW[comp]] }; ENDCASE => { -- array indexing n: INT _ EvalToInt[r, context]; compWire _ EvalActual[l, wire, internal, context].compWire.elements[n]; }; }; 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, context: Context] 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.CreateAtomWire[ident.name] ELSE wire.name _ 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, context].compWire, context]; 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, context].compWire, comp]; ENDLOOP; compWire _ CoreOps.CreateRecordWire[components: RevLOW[comp]]; }; item => { -- sequence spec SELECT TRUE FROM Rope.Equal[InterpreterOps.TreeToName[l], "SEQ"] => { compWire _ CreateSequenceWire[wire, EvalToInt[r, context]]; }; Rope.Equal[InterpreterOps.TreeToName[l], "ENUM"] => { 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, context: Context] RETURNS [n: INT] = TRUSTED { tv: AMTypes.TV _ InterpreterOps.Eval[ head: InterpreterOps.NewEvalHead[ context: AMModel.RootContext[WorldVM.LocalWorld[ ]], specials: context.tab], -- put the symbol table from the context here tree: parseTree]; n _ AMBridge.TVToLI[tv]; }; EvalSubrange: PROC [tree: Tree, context: Context] RETURNS [start, length: INT] = { start _ EvalAndCheck[Left[NARROW[tree]], "ST", context]; length _ EvalAndCheck[Right[NARROW[tree]], "LEN", context]; }; EvalAndCheck: PROC [tree: Tree, rope: ROPE, context: Context] RETURNS [n: INT] = { IF ~Rope.Equal[InterpreterOps.TreeToName[Left[NARROW[tree]]], rope, FALSE] THEN ERROR; n _ EvalToInt[Right[NARROW[tree]], context]; }; RevLOW: PROC [wires: LIST OF Wire] RETURNS [seriw: LIST OF Wire _ NIL] = { FOR l: LIST OF Wire _ wires, l.rest WHILE l#NIL DO seriw _ CONS[l.first, seriw]; ENDLOOP; }; propTable: RefTab.Ref _ RefTab.Create[]; structProcTable: SymTab.Ref _ SymTab.Create[]; <> END.