<> <> <> <> <<>> DIRECTORY Core, CoreBoole, CoreOps, CoreProperties, Rope, RopeList, TerminalIO; CoreBooleImpl: CEDAR PROGRAM IMPORTS CoreOps, CoreProperties, Rope, RopeList, TerminalIO EXPORTS CoreBoole = BEGIN OPEN CoreBoole; <> coreBoolProcsProp: ATOM = CoreProperties.RegisterProperty[$CoreBoolProcs]; <> CoreBoolProcs: TYPE = REF CoreBoolProcsRec; CoreBoolProcsRec: TYPE = RECORD [ eval: EvalProc, toRope: ToRopeProc, findVar: FindVarProc]; <> <> constantClass: Core.CellClass _ NEW [Core.CellClassRec _ [name: "CoreBooleConstant"]]; ConstantData: TYPE = REF ConstantDataRec; ConstantDataRec: TYPE = RECORD [value: BOOL]; <<>> <> alpsClass: Core.CellClass _ NEW [Core.CellClassRec _ [name: "CoreBooleAlps"]]; AlpsData: TYPE = REF AlpsDataRec; AlpsDataRec: TYPE = RECORD [var: ROPE, thenExpr, elseExpr: Expression]; <> <<>> <> notClass: Core.CellClass _ NEW [Core.CellClassRec _ [name: "CoreBooleNot"]]; <> <> true: PUBLIC Expression _ CoreOps.CreateCellType[class: constantClass, public: CoreOps.CreateWires[0], data: NEW [ConstantDataRec _ [TRUE]], name: "True"]; false: PUBLIC Expression _ CoreOps.CreateCellType[class: constantClass, public: CoreOps.CreateWires[0], data: NEW [ConstantDataRec _ [FALSE]], name: "False"]; <> Op2Proc: TYPE = PROC [expr1, expr2: Expression] RETURNS [result: Expression]; And2: Op2Proc = { result _ SELECT TRUE FROM expr1=false => false, expr2=false => false, expr1=true => expr2, expr2=true => expr1, ENDCASE => Op2[And2, expr1, expr2]; }; Or2: Op2Proc = { result _ SELECT TRUE FROM expr1=false => expr2, expr2=false => expr1, expr1=true => true, expr2=true => true, ENDCASE => Op2[Or2, expr1, expr2]; }; Xor2: Op2Proc = { result _ SELECT TRUE FROM expr1=false => expr2, expr2=false => expr1, expr1=true => Not[expr2], expr2=true => Not[expr1], ENDCASE => Op2[Xor2, expr1, expr2]; }; Op2: PROC [op: Op2Proc, expr1, expr2: Expression] RETURNS [result: Expression] = { <> var: ROPE _ FindVar[expr1]; expr1True, expr1False, expr2True, expr2False: Expression; IF var=NIL THEN ERROR; [expr1True, expr1False] _ Eval[var, expr1]; [expr2True, expr2False] _ Eval[var, expr2]; result _ CreateAlps[var, op[expr1True, expr2True], op[expr1False, expr2False]]; }; CreateAlps: PROC [var: ROPE, thenExpr, elseExpr: Expression] RETURNS [result: Expression] = { UnionWire: PROC [wire: Core.Wire] = { FOR i: NAT IN [0 .. wire.size) DO subwire: Core.Wire _ wire[i]; subName: ROPE _ CoreOps.GetShortWireName[subwire]; IF subName=NIL OR subwire.size#0 THEN { TerminalIO.WriteF["Incorrect wire structure or wire name\n"]; -- subwire ERROR; }; IF ~RopeList.Memb[lropes, subName] THEN lropes _ CONS [subName, lropes]; ENDLOOP; }; lropes: LIST OF ROPE _ LIST [var]; IF FindVarInExpr[var, thenExpr] OR FindVarInExpr[var, elseExpr] THEN { TerminalIO.WriteF["Incorrect Alps formation\n"]; -- var ERROR; }; IF Equal[thenExpr, elseExpr] THEN RETURN [thenExpr]; UnionWire[thenExpr.public]; UnionWire[elseExpr.public]; result _ CoreOps.CreateCellType[ class: alpsClass, public: WireFromRopes[lropes], data: NEW [AlpsDataRec _ [var: var, thenExpr: thenExpr, elseExpr: elseExpr]] ]; }; <> Var: PUBLIC PROC [var: ROPE] RETURNS [result: Expression] = { result _ CreateAlps[var, true, false]; }; Not: PUBLIC PROC [expr: Expression] RETURNS [result: Expression] = { result _ SELECT TRUE FROM expr=true => false, expr=false => true, expr.class=notClass => NARROW [expr.data], ENDCASE => CoreOps.CreateCellType[class: notClass, data: expr, public: CoreOps.CopyWire[expr.public]]; }; And: PUBLIC PROC [expr1, expr2, expr3, expr4, expr5: Expression _ true] RETURNS [result: Expression] = { result _ AndList[LIST [expr1, expr2, expr3, expr4, expr5]]; }; Or: PUBLIC PROC [expr1, expr2, expr3, expr4, expr5: Expression _ false] RETURNS [result: Expression] = { result _ OrList[LIST [expr1, expr2, expr3, expr4, expr5]]; }; Xor: PUBLIC PROC [expr1, expr2, expr3, expr4, expr5: Expression _ false] RETURNS [result: Expression] = { result _ XorList[LIST [expr1, expr2, expr3, expr4, expr5]]; }; Nand: PUBLIC PROC [expr1, expr2, expr3, expr4, expr5: Expression _ true] RETURNS [result: Expression] = { result _ NandList[LIST [expr1, expr2, expr3, expr4, expr5]]; }; Nor: PUBLIC PROC [expr1, expr2, expr3, expr4, expr5: Expression _ false] RETURNS [result: Expression] = { result _ NorList[LIST [expr1, expr2, expr3, expr4, expr5]]; }; AndList: PUBLIC PROC [exprs: LIST OF Expression] RETURNS [result: Expression] = { result _ true; WHILE exprs#NIL DO result _ And2[result, exprs.first]; exprs _ exprs.rest ENDLOOP; }; OrList: PUBLIC PROC [exprs: LIST OF Expression] RETURNS [result: Expression] = { result _ false; WHILE exprs#NIL DO result _ Or2[result, exprs.first]; exprs _ exprs.rest ENDLOOP; }; XorList: PUBLIC PROC [exprs: LIST OF Expression] RETURNS [result: Expression] = { result _ false; WHILE exprs#NIL DO result _ Xor2[result, exprs.first]; exprs _ exprs.rest ENDLOOP; }; NandList: PUBLIC PROC [exprs: LIST OF Expression] RETURNS [result: Expression] = { result _ Not[AndList[exprs]]; }; NorList: PUBLIC PROC [exprs: LIST OF Expression] RETURNS [result: Expression] = { result _ Not[OrList[exprs]]; }; If: PUBLIC PROC [cond, then, else: Expression] RETURNS [result: Expression] = { result _ Or2[And2[cond, then], And2[Not[cond], else]]; }; <> AlpsEval: EvalProc = { alpsData: AlpsData _ NARROW [expr.data]; thenExprTrue, thenExprFalse, elseExprTrue, elseExprFalse: Expression; IF Rope.Equal[alpsData.var, var] THEN RETURN [alpsData.thenExpr, alpsData.elseExpr]; [thenExprTrue, thenExprFalse] _ Eval[var, alpsData.thenExpr]; [elseExprTrue, elseExprFalse] _ Eval[var, alpsData.elseExpr]; whenTrue _ CreateAlps[alpsData.var, thenExprTrue, elseExprTrue]; whenFalse _ CreateAlps[alpsData.var, thenExprFalse, elseExprFalse]; }; NotEval: EvalProc = { notData: Expression _ NARROW [expr.data]; [whenTrue, whenFalse] _ Eval[var, notData]; whenTrue _ Not[whenTrue]; whenFalse _ Not[whenFalse]; }; <> ConstantToRope: ToRopeProc = { constantData: ConstantData _ NARROW [expr.data]; RETURN [IF constantData.value THEN "true" ELSE "false"]; }; AlpsToRope: ToRopeProc = { alpsData: AlpsData _ NARROW [expr.data]; RETURN [Rope.Cat[ Rope.Cat["If[Var[", alpsData.var, "], "], ToRope[alpsData.thenExpr, deep-1], ", ", ToRope[alpsData.elseExpr, deep-1], "]"]]; }; NotToRope: ToRopeProc = { notData: Expression _ NARROW [expr.data]; RETURN [Rope.Cat["Not[", ToRope[notData, deep-1], "]"]]; }; <> ConstantFindVar: FindVarProc = {RETURN [NIL]}; AlpsFindVar: FindVarProc = { alpsData: AlpsData _ NARROW [expr.data]; RETURN [alpsData.var]; }; NotFindVar: FindVarProc = { notData: Expression _ NARROW [expr.data]; RETURN [FindVar[notData]]; }; <> Eval: PUBLIC EvalProc = { procs: CoreBoolProcs _ NARROW [CoreProperties.GetProp[expr.class.properties, coreBoolProcsProp]]; IF ~FindVarInExpr[var, expr] THEN RETURN [expr, expr]; [whenTrue, whenFalse] _ procs.eval[var, expr]; }; ToRope: PUBLIC ToRopeProc = { procs: CoreBoolProcs _ NARROW [CoreProperties.GetProp[expr.class.properties, coreBoolProcsProp]]; IF deep<0 THEN RETURN[" ... "]; RETURN [procs.toRope[expr, deep]]; }; FindVar: PUBLIC FindVarProc = { procs: CoreBoolProcs _ NARROW [CoreProperties.GetProp[expr.class.properties, coreBoolProcsProp]]; var _ procs.findVar[expr]; }; Equal: PUBLIC PROC [expr1, expr2: Expression] RETURNS [BOOL] = { IF expr1=expr2 THEN RETURN [TRUE]; IF expr1.class=constantClass OR expr2.class=constantClass THEN RETURN [FALSE]; BEGIN var: ROPE _ FindVar[expr1]; expr1True, expr1False, expr2True, expr2False: Expression; IF var=NIL THEN { TerminalIO.WriteF["Expression has no Wire\n"]; -- expr1 ERROR; }; IF ~FindVarInExpr[var, expr2] THEN RETURN [FALSE]; [expr1True, expr1False] _ Eval[var, expr1]; [expr2True, expr2False] _ Eval[var, expr2]; RETURN [Equal[expr1True, expr2True] AND Equal[expr1False, expr2False]] END; }; <> WireFromRopes: PROC [lropes: LIST OF ROPE] RETURNS [wire: Core.Wire] = { size: NAT _ RopeList.Length[lropes]; wire _ CoreOps.CreateWires[size: size]; FOR i: NAT IN [0 .. size) DO wire[i] _ CoreOps.CreateWire[name: lropes.first]; lropes _ lropes.rest; ENDLOOP; }; <> FindVarInExpr: PROC [var: ROPE, expr: Expression] RETURNS [found: BOOL _ FALSE] = { public: Core.Wire _ expr.public; FOR i: NAT IN [0 .. public.size) DO IF Rope.Equal[var, CoreOps.GetShortWireName[public[i]]] THEN RETURN [TRUE]; ENDLOOP; }; <> CoreProperties.PutCellClassProp[constantClass, coreBoolProcsProp, NEW [CoreBoolProcsRec _ [toRope: ConstantToRope, findVar: ConstantFindVar]]]; CoreProperties.PutCellClassProp[alpsClass, coreBoolProcsProp, NEW [CoreBoolProcsRec _ [eval: AlpsEval, toRope: AlpsToRope, findVar: AlpsFindVar]]]; CoreProperties.PutCellClassProp[notClass, coreBoolProcsProp, NEW [CoreBoolProcsRec _ [eval: NotEval, toRope: NotToRope, findVar: NotFindVar]]]; END.