
    <<BEImpl.mesa>>
        <<Copyright © 1986 by Xerox Corporation.  All rights reserved.>>
        <<Last Edited by: Louis Monier September 17, 1986 7:24:40 pm PDT>>
        <<>>
    DIRECTORY  BE, HashTable, IO, Rope;

    BEImpl: CEDAR PROGRAM
        IMPORTS HashTable, IO, Rope
        EXPORTS BE = 
        BEGIN OPEN BE;
<<Expression Types and Constants>>
    ROPE: TYPE = Rope.ROPE;

true: PUBLIC Expression _ NEW [BOOL _ TRUE];
false: PUBLIC Expression _ NEW [BOOL _ FALSE];
unknown: PUBLIC Expression _ NEW [NAT _ LAST[NAT]];

opsTable: HashTable.Table _ HashTable.Create[];
<<Creation Operator>>
    <<-- Flushes the NILs>>
    CreateListOpr: PROC [opr: Operator, exprs: LIST OF Expression _ NIL] RETURNS [result: Expression] = {
        node: Node;
        count: NAT _ 0;
        FOR exprList: LIST OF Expression _ exprs, exprList.rest UNTIL exprList=NIL DO
            IF exprList.first#NIL THEN count _ count + 1;
            ENDLOOP;
        node _ NEW [NodeRec[count]];
        node.op _ opr;
        count _ 0;
        FOR exprList: LIST OF Expression _ exprs, exprList.rest UNTIL exprList=NIL DO
            IF exprList.first#NIL THEN {node[count] _ exprs.first; count _ count + 1};
            ENDLOOP;
        result _ node;
        };
<<Operators returning Expressions (general)>>
    Not: PUBLIC PROC [expr: Expression] RETURNS [Expression] = {
        RETURN [CreateListOpr[notOpr, LIST[expr]]]};

    AndList: PUBLIC PROC [exprs: LIST OF Expression] RETURNS [Expression] = {
        RETURN [CreateListOpr[andOpr, exprs]]};
    And: PUBLIC PROC [e1, e2, e3, e4, e5: Expression _ NIL] RETURNS [Expression] ={
        RETURN [AndList[LIST[e1, e2, e3, e4, e5]]]};

    OrList: PUBLIC PROC [exprs: LIST OF Expression] RETURNS [Expression] = {
        RETURN [CreateListOpr[orOpr, exprs]]};
    Or: PUBLIC PROC [e1, e2, e3, e4, e5: Expression _ NIL] RETURNS [Expression] = {
        RETURN [OrList[LIST[e1, e2, e3, e4, e5]]]};

    XorList: PUBLIC PROC [exprs: LIST OF Expression] RETURNS [Expression] = {
        RETURN [CreateListOpr[xorOpr, exprs]]};
    Xor: PUBLIC PROC [e1, e2, e3, e4, e5: Expression _ NIL] RETURNS [Expression] = {
        RETURN [XorList[LIST[e1, e2, e3, e4, e5]]]};

    NandList: PUBLIC PROC [exprs: LIST OF Expression] RETURNS [Expression] = {
        RETURN [CreateListOpr[nandOpr, exprs]]};
    Nand: PUBLIC PROC [e1, e2, e3, e4, e5: Expression _ NIL] RETURNS [Expression] = {
        RETURN [NandList[LIST[e1, e2, e3, e4, e5]]]};

    NorList: PUBLIC PROC [exprs: LIST OF Expression] RETURNS [Expression] = {
        RETURN [CreateListOpr[norOpr, exprs]]};
    Nor: PUBLIC PROC [e1, e2, e3, e4, e5: Expression _ NIL] RETURNS [Expression] = {
        RETURN [NorList[LIST[e1, e2, e3, e4, e5]]]};

    If: PUBLIC PROC [cond, then, else: Expression] RETURNS [Expression] = {
        RETURN [CreateListOpr[ifOpr, LIST[cond, then, else]]];
        };
<<Public operations>>
    FullEval: PUBLIC PROC [expr: Expression, evalVar: EvalVar] RETURNS [Expression] = {
        WITH expr SELECT FROM
            node: Node => RETURN[node.op.evalProc[node, evalVar]];
            ENDCASE => RETURN [evalVar[expr]];
        };

PutExpr: PUBLIC PROC [out: IO.STREAM, expr: Expression, deep: INT _ LAST [INT], putRefAny: PROC [IO.STREAM, Variable] _ NIL] = {
    Var: PROC [var: Variable] = {
        WITH var SELECT FROM
            <<constant: Constant    => ERROR;>>
            rope: ROPE        => out.PutRope[Rope.Cat["""", rope, """"]];
            text: REF TEXT    => out.PutRope[Rope.Cat["""", Rope.FromRefText[text], """"]];
            refInt: REF INT    => out.Put[IO.rope["Int["], IO.int[refInt^], IO.rope["]"]];
            ENDCASE        => {
                out.PutRope["Var["]; 
                IF putRefAny=NIL THEN out.Put1[IO.refAny[var]] ELSE putRefAny[out, var];
                out.PutRope["]"];
                };
        };
    IF deep<0 THEN out.PutRope[" ... "];
    WITH expr SELECT FROM
        <<constant: Constant    => out.PutRope[IF constant.value THEN "1" ELSE "0"];>>
        node: Node    => {
            out.PutF["%g %g [", IO.rope[node.op.name], IO.int[node.size]]; 
            FOR i: NAT IN [0..node.size) DO
                IF i>0 THEN out.PutRope[", "]; 
                PutExpr[out, node[i], deep-1, putRefAny]; 
                ENDLOOP;
            out.PutRope["]"];
            };
        ENDCASE        => Var[expr];
};

GetExpr: PUBLIC PROC [in: IO.STREAM, getRefAny: PROC [IO.STREAM] RETURNS [Variable] _ NIL] RETURNS [expr: Expression] = {
tokenKind: IO.TokenKind; token: ROPE;
[tokenKind, token] _ IO.GetCedarTokenRope[in];
SELECT TRUE FROM
Rope.Equal[token, "0"]         => RETURN [false];
Rope.Equal[token, "1"]         => RETURN [true];
Rope.Equal[token, "Int"]    => {
IF NOT Rope.Equal[IO.GetCedarTokenRope[in].token, "["] THEN ERROR;
expr _ NEW [INT _ IO.GetInt[in]];
IF NOT Rope.Equal[IO.GetCedarTokenRope[in].token, "]"] THEN ERROR;
};
Rope.Equal[token, "Var"]    => {
IF NOT Rope.Equal[IO.GetCedarTokenRope[in].token, "["] THEN ERROR;
expr _ getRefAny[in];
IF NOT Rope.Equal[IO.GetCedarTokenRope[in].token, "]"] THEN ERROR;
};
tokenKind=tokenROPE        => expr _ Rope.Substr[token, 1, Rope.Length[token]-2];
ENDCASE                        => {
    node: Node;
    operator: Operator;
    n: NAT;
    operator _ NARROW[HashTable.Fetch[opsTable, token].value];
    n _ IO.GetInt[in];
IF NOT Rope.Equal[IO.GetCedarTokenRope[in].token, "["] THEN ERROR;
    node _ NEW[NodeRec[n]];
    node.op _ operator;
    FOR i: NAT IN [0..n) DO
    IF i>0 AND NOT Rope.Equal[IO.GetCedarTokenRope[in].token, ","] THEN ERROR;
        node[i] _ GetExpr[in, getRefAny];
        ENDLOOP;
IF NOT Rope.Equal[IO.GetCedarTokenRope[in].token, "]"] THEN ERROR;
    expr _ node;
};
};

ToRope: PUBLIC PROC [expr: Expression, deep: INT _ 5] RETURNS [ROPE] = {
out: IO.STREAM _ IO.ROS[];
PutExpr[out, expr, deep];
RETURN [IO.RopeFromROS[out]];
};

FromRope: PUBLIC PROC [rope: Rope.ROPE] RETURNS [Expression] = {
RETURN [GetExpr[IO.RIS[rope]]];
};

    <<-- Defining the usual operators>>
    AnalyzeArgs: PROC [node: Node, evalVar: EvalVar] RETURNS [allZeros, allOnes, oneZero, oneOne, oneX: BOOL] ~ {
        allZeros _ TRUE;
        allOnes _ TRUE;
        oneZero _ oneOne _ oneX _ FALSE;
        FOR i: NAT IN [0..node.size) DO
            node[i] _ FullEval[node[i], evalVar];
            IF node[i]=false THEN oneZero _ TRUE;
            IF node[i]=true THEN oneOne _ TRUE;
            allZeros _ allZeros AND (node[i]=false);
            allOnes _ allOnes AND (node[i]=true);
            oneX _ node[i]=unknown;
            ENDLOOP;
        };
    Bogus: EvalProc = {RETURN[NIL]};
    <<-- Not[X]=X>>
    NotEval: EvalProc = {
        node: Node _ NARROW[expr, Node];
        allZeros, allOnes, oneZero, oneOne, oneX: BOOL;
        [allZeros, allOnes, oneZero, oneOne, oneX] _ AnalyzeArgs[node, evalVar];
        IF node.size#1 THEN ERROR;        -- only one argument!
        RETURN [SELECT TRUE FROM
            oneX => unknown,
            oneOne => false,
            oneZero => true,
            ENDCASE => expr
            ];
        };
    <<-- And[0, ...]=0>>
    <<-- And[1, 1, 1, ...]=1>>
    AndEval: EvalProc = {
        node: Node _ NARROW[expr, Node];
        allZeros, allOnes, oneZero, oneOne, oneX: BOOL;
        [allZeros, allOnes, oneZero, oneOne, oneX] _ AnalyzeArgs[node, evalVar];
        IF oneX THEN RETURN[unknown];
        IF oneZero THEN RETURN[false];
        IF allOnes THEN RETURN[true];
        RETURN[expr];
        };
    <<-- Or[1, ...]=1>>
    <<-- Or[0, 0, 0, ...]=0>>
    OrEval: EvalProc = {
        node: Node _ NARROW[expr, Node];
        allZeros, allOnes, oneZero, oneOne, oneX: BOOL;
        [allZeros, allOnes, oneZero, oneOne, oneX] _ AnalyzeArgs[node, evalVar];
        IF oneX THEN RETURN[unknown];
        IF oneOne THEN RETURN[true];
        IF allZeros THEN RETURN[false];
        RETURN[expr];
        };
    <<-- Nand[0, ...]=1>>
    <<-- Nand[1, 1, 1, ...]=0>>
    NandEval: EvalProc = {
        node: Node _ NARROW[expr, Node];
        allZeros, allOnes, oneZero, oneOne, oneX: BOOL;
        [allZeros, allOnes, oneZero, oneOne, oneX] _ AnalyzeArgs[node, evalVar];
        IF oneX THEN RETURN[unknown];
        IF oneZero THEN RETURN[true];
        IF allOnes THEN RETURN[false];
        RETURN[expr];
        };
    <<-- Nor[1, ...]=0>>
    <<-- Nor[0, 0, 0, ...]=1>>
    NorEval: EvalProc = {
        node: Node _ NARROW[expr, Node];
        allZeros, allOnes, oneZero, oneOne, oneX: BOOL;
        [allZeros, allOnes, oneZero, oneOne, oneX] _ AnalyzeArgs[node, evalVar];
        IF oneX THEN RETURN[unknown];
        IF oneOne THEN RETURN[false];
        IF allZeros THEN RETURN[true];
        RETURN[expr];
        };
    <<-- Xor[0, 1]=Xor[1, 0]=1>>
    <<-- Xor[0, 0]=Xor[1, 1]=0>>
    XorEval: EvalProc = {
        node: Node _ NARROW[expr, Node];
        allZeros, allOnes, oneZero, oneOne, oneX: BOOL;
        IF node.size#2 THEN ERROR;        -- exactly two arguments!
        [allZeros, allOnes, oneZero, oneOne, oneX] _ AnalyzeArgs[node, evalVar];
        SELECT TRUE FROM
            oneX => RETURN[unknown];
            allZeros OR allOnes => RETURN[false];
            oneZero AND oneOne => RETURN[true];
            ENDCASE => RETURN[expr];
        };
    <<-- XNor[0, 1]=XNor[1, 0]=0>>
    <<-- XNor[0, 0]=XNor[1, 1]=1>>
    XNorEval: EvalProc = {
        node: Node _ NARROW[expr, Node];
        allZeros, allOnes, oneZero, oneOne, oneX: BOOL;
        IF node.size#2 THEN ERROR;        -- exactly two arguments!
        [allZeros, allOnes, oneZero, oneOne, oneX] _ AnalyzeArgs[node, evalVar];
        SELECT TRUE FROM
            oneX => RETURN[unknown];
            allZeros OR allOnes => RETURN[true];
            oneZero AND oneOne => RETURN[false];
            ENDCASE => RETURN[expr];
        };
    <<-- IF[0, 1]=XNor[1, 0]=0>>
    <<-- XNor[0, 0]=XNor[1, 1]=1>>
    IfEval: EvalProc = {
        node: Node _ NARROW[expr, Node];
        IF node.size#3 THEN ERROR;        -- exactly three arguments!
        node[0] _ FullEval[node[0], evalVar];
        node[1] _ FullEval[node[1], evalVar];
        node[2] _ FullEval[node[2], evalVar];
        IF node[0]=unknown OR node[1]=unknown OR node[2]=unknown THEN RETURN[unknown];
        IF node[0]=true THEN RETURN[node[1]];
        IF node[0]=false THEN RETURN[node[2]];
        RETURN[expr];
        };

    RegisterOp: PUBLIC PROC [name: ROPE, evalProc: EvalProc] RETURNS [op: Operator] ~ {
        op _ NEW[OperatorRec _ [name: name, evalProc: evalProc]];
        [] _ HashTable.Store[opsTable, name, op];
        };

notOpr: PUBLIC Operator _ RegisterOp[name: "Not", evalProc: NotEval];
andOpr: PUBLIC Operator _ RegisterOp[name: "And", evalProc: AndEval];
orOpr: PUBLIC Operator _ RegisterOp[name: "Or", evalProc: OrEval];
nandOpr: PUBLIC Operator _ RegisterOp[name: "Nand", evalProc: NandEval];
norOpr: PUBLIC Operator _ RegisterOp[name: "Nor", evalProc: NorEval];
xorOpr: PUBLIC Operator _ RegisterOp[name: "Xor", evalProc: XorEval];
xnorOpr: PUBLIC Operator _ RegisterOp[name: "XNor", evalProc: XNorEval];
ifOpr: PUBLIC Operator _ RegisterOp[name: "If", evalProc: IfEval];

    END.