<> <> <

>

    DIRECTORY
        Basics,
        Rope,
        Convert,
        List USING [AList, Assoc, PutAssoc],
        MathExpr USING [AtomClass, CompoundClass, MatrixClass],
        MathDB;


    MathDBImpl: CEDAR PROGRAM 
        IMPORTS List, Convert
        EXPORTS MathDB ~

        BEGIN

< >

    AtomClass: TYPE ~ MathExpr.AtomClass;
    CompoundClass: TYPE ~ MathExpr.CompoundClass;
    MatrixClass: TYPE ~ MathExpr.MatrixClass;
    ROPE: TYPE ~ Rope.ROPE;
    AList: TYPE ~ List.AList;

< >
    GlobalAtomClasses: List.AList _ NIL;
    GlobalCompoundClasses: List.AList _ NIL;
    GlobalMatrixClasses: List.AList _ NIL;
< >
    AtomClassNames: PUBLIC LIST OF ATOM _ NIL;
    CompoundClassNames: PUBLIC LIST OF ATOM _ NIL;
    MatrixClassNames: PUBLIC LIST OF ATOM _ NIL;
< >
    ResetAtomClasses: PUBLIC PROC[] ~ {
        < >
        GlobalAtomClasses _ NIL;
        AtomClassNames _ NIL;
        };

    ResetCompoundClasses: PUBLIC PROC[] ~ {
        < >
        GlobalCompoundClasses _ NIL;
        CompoundClassNames _ NIL;
        };

    ResetMatrixClasses: PUBLIC PROC[] ~ {
        < >
        GlobalMatrixClasses _ NIL;
        MatrixClassNames _ NIL;
        };

    InstallAtomClass: PUBLIC PROC[class: AtomClass] ~ {
        < >
        <<>>
        < >
        GlobalAtomClasses _ List.PutAssoc[key: class.name, val: class, aList: GlobalAtomClasses];

        < >
        AtomClassNames _ CONS[class.name, AtomClassNames];
        };

    InstallCompoundClass: PUBLIC PROC[class: CompoundClass] ~ {
        < >
        <<>>
        < >
        GlobalCompoundClasses _ List.PutAssoc[key: class.name, val: class, aList: GlobalCompoundClasses];

        < >
        CompoundClassNames _ CONS[class.name, CompoundClassNames];
        };

    InstallMatrixClass: PUBLIC PROC[class: MatrixClass] ~ {
        < >
        <<>>
        < >
        GlobalMatrixClasses _ List.PutAssoc[key: class.name, val: class, aList: GlobalMatrixClasses];

        < >
        MatrixClassNames _ CONS[class.name, MatrixClassNames];
        };


    LookupAtomClass: PUBLIC PROC[name: ATOM] RETURNS[AtomClass] ~ {
        < >
        <<          SIGNALS notFound if no association exists>>
        <<>>
        atomClass: AtomClass _ NARROW[List.Assoc[key: name, aList: GlobalAtomClasses]];
        IF atomClass = NIL THEN ERROR notFound;
        RETURN[atomClass];
        };

    LookupCompoundClass: PUBLIC PROC[name: ATOM] RETURNS[CompoundClass] ~ {
        < >
        <<          SIGNALS notFound if no association exists>>
        <<>>
        compoundClass: CompoundClass _ NARROW[List.Assoc[key: name, aList: GlobalCompoundClasses]];
        IF compoundClass = NIL THEN ERROR notFound;
        RETURN[compoundClass];
        };

    LookupMatrixClass: PUBLIC PROC[name: ATOM] RETURNS[MatrixClass] ~ {
        < >
        <<          SIGNALS notFound if no association exists>>
        <<>>
        matrixClass: MatrixClass _ NARROW[List.Assoc[key: name, aList: GlobalMatrixClasses]];
        IF matrixClass = NIL THEN ERROR notFound;
        RETURN[matrixClass];
        };


    DescriptionFromName: PUBLIC PROC[className: ATOM] RETURNS[ROPE]~ {
        < >
        a: AtomClass;
        c: CompoundClass;
        m: MatrixClass;
        a _ LookupAtomClass[className ! notFound => CONTINUE];
        IF a#NIL THEN RETURN[Convert.RopeFromAtom[from: className, quote: FALSE] ];
        c _ LookupCompoundClass[className ! notFound => CONTINUE];
        IF c#NIL THEN RETURN[c.description];
        m _ LookupMatrixClass[className ! notFound => CONTINUE];
        IF m#NIL THEN RETURN[Convert.RopeFromAtom[from: className, quote: FALSE] ];
        ERROR notFound;
        };

    DescriptionsFromNames: PUBLIC PROC [in: LIST OF ATOM] RETURNS[LIST OF ROPE] ~ {
        < >
    out, out2: LIST OF ROPE;
    IF in = NIL THEN RETURN[NIL];
    out _ out2 _ LIST[DescriptionFromName[in.first] ];
    FOR l: LIST OF ATOM _ in.rest, l.rest UNTIL l=NIL DO
    out2 _ out2.rest _ LIST[DescriptionFromName[l.first] ];
    ENDLOOP;
    RETURN[out];
    };
< >
    GlobalOperatorTable: List.AList _ NIL;
< >
    ResetOperatorTable: PUBLIC PROC[] ~ {
        GlobalOperatorTable _ NIL;
        };

    AddOperator: PUBLIC PROC[class: CompoundClass, familyName: ATOM] ~ {
        < >
        family: LIST OF REF _ NARROW[List.Assoc[key: familyName, aList: GlobalOperatorTable]];
        IF family=NIL THEN {
            GlobalOperatorTable _ List.PutAssoc[key: familyName, val: LIST[class.name], aList: GlobalOperatorTable];
            RETURN
            };
        family _ CONS[class.name, family]; -- maybe should put at end
        GlobalOperatorTable _ List.PutAssoc[key: familyName, val: family, aList: GlobalOperatorTable];
        };

    OpFamiliesNames: PUBLIC PROC[] RETURNS[LIST OF ATOM]~ {
        < >
        names: LIST OF ATOM _ NIL;
        FOR l:List.AList _ GlobalOperatorTable, l.rest UNTIL l = NIL DO
            names _ CONS[NARROW[l.first.key], names];
            ENDLOOP;
        RETURN[names];
        };

    OpFamilyNames: PUBLIC PROC[familyName: ATOM] RETURNS[LIST OF ATOM]~ {
        < >
        <<          SIGNALS notFound if no association exists>>
        family: LIST OF REF _ NARROW[List.Assoc[key: familyName, aList: GlobalOperatorTable]];
        names: LIST OF ATOM _ NIL;
        IF family=NIL THEN ERROR notFound;
        FOR l:LIST OF REF _ family, l.rest UNTIL l = NIL DO
            names _ CONS[NARROW[l.first], names];
            ENDLOOP;
        RETURN[names];
        };
< >
    CompareOps: PUBLIC PROC[op1, op2: ATOM] RETURNS[Basics.Comparison]~ {
        < >
        SELECT op1 FROM
            $sum, $difference => SELECT op2 FROM
                $sum, $difference => RETURN[equal];
                $negation => RETURN[less];
                $product, $fraction, $pow => RETURN[less];
                $dDx, $partialDeriv => RETURN[less];
                ENDCASE => RETURN[equal];
            $negation => SELECT op2 FROM
                $sum, $difference => RETURN[greater];
                $negation => RETURN[equal];
                $product, $fraction => RETURN[equal];
                $pow => RETURN[less];
                $dDx, $partialDeriv => RETURN[less];
                ENDCASE => RETURN[equal];
            $product, $fraction => SELECT op2 FROM
                $sum, $difference => RETURN[greater];
                $negation => RETURN[equal];
                $product, $fraction => RETURN[equal];
                $pow => RETURN[less];
                $dDx, $partialDeriv => RETURN[less];
                ENDCASE => RETURN[equal];
            ENDCASE => RETURN[equal];
        };
< >
    RopesFromAtoms: PUBLIC PROC [in: LIST OF ATOM] RETURNS[LIST OF ROPE] ~ {
    < >
    out, out2: LIST OF ROPE;
    IF in = NIL THEN RETURN[NIL];
    out _ out2 _ LIST[Convert.RopeFromAtom[from: in.first, quote: FALSE] ];
    FOR l: LIST OF ATOM _ in.rest, l.rest UNTIL l=NIL DO
    out2 _ out2.rest _ LIST[Convert.RopeFromAtom[from: l.first, quote: FALSE] ];
    ENDLOOP;
    RETURN[out];
    };
    <<>>
    KillAssoc: PUBLIC PROC [key: REF ANY, aList: AList] RETURNS[AList]~ {
        < >
        l, l1: AList _ NIL;
            l _ aList;
            UNTIL l = NIL DO
                IF l.first.key = key THEN {
                    IF l1 = NIL THEN RETURN[l.rest]; -- ref was first object on list
                    l1.rest _ l.rest;
                    RETURN[aList];
                    };
                l1 _ l;
                l _ l.rest;
                ENDLOOP;
            RETURN [aList]; -- not found
            };
< >
    notFound: PUBLIC ERROR = CODE;

< >
    ResetAtomClasses[];
    ResetCompoundClasses[];
    ResetMatrixClasses[];
    ResetOperatorTable[];



    END.