
    <<BooleImpl.mesa>>
    <<Copyright © 1985 by Xerox Corporation.  All rights reversed.>>
    <<Created by Bertrand Serlet July 31, 1985 3:03:17 pm PDT>>
    <<Bertrand Serlet May 7, 1986 9:56:28 pm PDT>>
        <<Louis Monier June 3, 1986 7:28:32 pm PDT>>
        <<Barth, May 22, 1986 5:42:30 pm PDT>>
        <<>>
    DIRECTORY  Core, Boole, CoreOps, CoreProperties, Rope, RopeList, TerminalIO;

    BooleImpl: CEDAR PROGRAM
        IMPORTS CoreOps, CoreProperties, Rope, RopeList, TerminalIO
        EXPORTS Boole = 
        BEGIN 
        OPEN Boole;
<<Types and Utilities>>
    coreBoolProcsProp: ATOM = CoreProperties.RegisterProperty[$CoreBoolProcs];
        <<Properties on classes known by CoreBool hang on atom coreBoolProcsProp.  they are of type CoreBoolProcs.>>
    CoreBoolProcs: TYPE = REF CoreBoolProcsRec;
    CoreBoolProcsRec: TYPE = RECORD [
        eval: EvalProc,
        toRope: ToRopeProc,
        findVar: FindVarProc];
<<Expression Classes>>
    <<Constants>>
        constantClass: Core.CellClass _ NEW [Core.CellClassRec _ [name: "BooleConstant"]];
        ConstantData: TYPE = REF ConstantDataRec;
        ConstantDataRec: TYPE = RECORD [value: BOOL];
    <<>>
    <<Alps>>
        alpsClass: Core.CellClass _ NEW [Core.CellClassRec _ [name: "BooleAlps"]];
        AlpsData: TYPE = REF AlpsDataRec;
        AlpsDataRec: TYPE = RECORD [var: ROPE, thenExpr, elseExpr: Expression];
            <<The invariant is that none of thenExpr and elseExpr contains variable var.  The order of variables in thenExpr and elseExpr might 
            be different>>
    <<>>
    <<Negation>>
        notClass: Core.CellClass _ NEW [Core.CellClassRec _ [name: "BooleNot"]];
    <<data field of the CellType contains the Expression being negated.>>
<<Constants>>
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"];
<<Binary Operators >>
    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] = {
        <<It is assumed that none of expr1 and expr2 are constants>>
        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]]
        ];
        };
<<Operators returning Expressions>>
    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] = {
        IF Equal[then, else] THEN RETURN [then];
        result _ Or2[And2[cond, then], And2[Not[cond], else]];
        };
<<Private EvalProcs>>
    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];
        };
<<Private ToRopeProcs>>
    ConstantToRope: ToRopeProc = {
    constantData: ConstantData _ NARROW [expr.data];
    RETURN [IF constantData.value THEN "1" ELSE "0"];
        };

    AlpsToRope: ToRopeProc = {
    alpsData: AlpsData _ NARROW [expr.data];
        case: ATOM _ Case[alpsData.thenExpr, alpsData.elseExpr];
        SELECT case FROM
            $Case10            => RETURN [alpsData.var];
            $Case01            => RETURN [Rope.Cat["Not[", alpsData.var, "]"]];
            $Case1X, $Case0X, $CaseX1, $CaseX0, $CaseXY    => RETURN [Rope.Cat[
                Rope.Cat["If[", alpsData.var, ", "], 
                ToRope[alpsData.thenExpr, deep-1],
                ", ", 
                ToRope[alpsData.elseExpr, deep-1],
                "]"]];
            ENDCASE            => ERROR;
        };

    NotToRope: ToRopeProc = {
    notData: Expression _ NARROW [expr.data];
        RETURN [Rope.Cat["Not[", ToRope[notData, deep-1], "]"]];
        };
<<Private FindVarProcs>>
    ConstantFindVar: FindVarProc = {RETURN [NIL]};

    AlpsFindVar: FindVarProc = {
    alpsData: AlpsData _ NARROW [expr.data];
        RETURN [alpsData.var];
        };

    NotFindVar: FindVarProc = {
    notData: Expression _ NARROW [expr.data];
        RETURN [FindVar[notData]];
        };
<<Public operations>>
    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]];
};

FromRope: PUBLIC PROC [er: ROPE] RETURNS [expr: Expression] = {
RecurseFromRope: PROC RETURNS [e: Expression] = {
SELECT Rope.Fetch[er, p] FROM
'0 => {p _ p + 1; e _ false};
'1 => {p _ p + 1; e _ true};
    'N => IF Rope.Fetch[er, p+1]='o AND Rope.Fetch[er, p+2]='t AND Rope.Fetch[er, p+3]='[ THEN {
    p _ p + 4;
    e _ Not[RecurseFromRope[]];
    IF Rope.Fetch[er, p]#'] THEN ERROR;
    p _ p + 1;
    };
'I => IF Rope.Fetch[er, p+1]='f AND Rope.Fetch[er, p+2]='[ THEN {
cond, then, else: Expression _ NIL;
p _ p + 3;
cond _ RecurseFromRope[];
IF Rope.Fetch[er, p]#', OR Rope.Fetch[er, p+1]#'  THEN ERROR;
p _ p + 2;
then _ RecurseFromRope[];
IF Rope.Fetch[er, p]#', OR Rope.Fetch[er, p+1]#'  THEN ERROR;
p _ p + 2;
else _ RecurseFromRope[];
IF Rope.Fetch[er, p]#'] THEN ERROR;
p _ p + 1;
e _ If[cond, then, else];
};
ENDCASE => {
start: INT _ p;
    brackets: INT _ 0;
    WHILE Rope.Fetch[er, p]#', AND NOT (Rope.Fetch[er, p]='] AND brackets=0) DO
        IF Rope.Fetch[er, p]='[ THEN brackets _ brackets + 1;
        IF Rope.Fetch[er, p]='] THEN brackets _ brackets - 1;
        p _ p + 1;
        IF p>= size THEN EXIT;
        ENDLOOP;
    e _ Var[Rope.Substr[er, start, p-start]];
};
};
p: INT _ 0;
size: INT _ Rope.Length[er];
expr _ RecurseFromRope[];
};

    FindVar: PUBLIC FindVarProc = {
        procs: CoreBoolProcs _ NARROW [CoreProperties.GetProp[expr.class.properties, coreBoolProcsProp]];
    var _ procs.findVar[expr];
    };

    Equal: PUBLIC PROC [expr1, expr2: Expression] RETURNS [BOOL] = {
        neg: BOOL _ TRUE;
        IF expr1=expr2 THEN RETURN [TRUE];
        IF expr1.class=notClass THEN {neg _ ~neg; expr1 _ Not[expr1]};
        IF expr2.class=notClass THEN {neg _ ~neg; expr2 _ Not[expr2]};
        IF expr1.class=constantClass AND expr2.class=constantClass THEN RETURN [(expr1=expr2)=neg];
        IF expr1.class=constantClass OR expr2.class=constantClass THEN RETURN [FALSE];
        IF expr1.class#alpsClass OR expr2.class#alpsClass THEN ERROR;
        IF ~FindVarInExpr[FindVar[expr1], expr2] THEN RETURN [FALSE];
        IF ~FindVarInExpr[FindVar[expr2], expr1] THEN RETURN [FALSE];
        BEGIN
            var: ROPE _ FindVar[expr1];
            expr1True, expr1False, expr2True, expr2False: Expression;
            IF var=NIL THEN ERROR; -- expr1 has no Wire
            [expr1True, expr1False] _ Eval[var, expr1];
            [expr2True, expr2False] _ Eval[var, expr2];
            IF NOT neg THEN {expr2True _ Not[expr2True]; expr2False _ Not[expr2False]};
            RETURN [Equal[expr1True, expr2True] AND Equal[expr1False, expr2False]]
            END;
        };
<<Private operations>>
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;
};

    <<Can only be used as an hint: if var is present, this does not imply that this variable is really significant>>
    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;
        };
<<Private operations that depend on the representation>>
Case: PUBLIC PROC [whenTrue, whenFalse: Expression] RETURNS [case: ATOM] = {
case _ SELECT TRUE FROM
Equal[whenTrue, true] AND Equal[whenFalse, true]        => $Case11,
Equal[whenTrue, false] AND Equal[whenFalse, false]        => $Case00,
Equal[whenTrue, true] AND Equal[whenFalse, false]        => $Case10,
Equal[whenTrue, false] AND Equal[whenFalse, true]        => $Case01,
Equal[whenTrue, true]                                         => $Case1X,        
Equal[whenTrue, false]                                         => $Case0X,        
Equal[whenFalse, true]                                         => $CaseX1,        
Equal[whenFalse, false]                                         => $CaseX0,
Equal[whenTrue, whenFalse]                                 => $CaseXX,
ENDCASE                                                            => $CaseXY;
};
<<Initialization>>
    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.