<> <> <> DIRECTORY MathRules USING [AtomBoxProc, AtomPaintProc, CompoundBoxProc, CompositionProc, Size, AtomToASRopeProc], MathBox, MathTypes USING [Style, FormatClass], MathDB USING [LookupAtomClass, LookupCompoundClass, LookupMatrixClass, notFound], Vector USING [VEC], Rope USING [ROPE, Cat, Equal, FromChar], Convert USING [RopeFromAtom, RopeFromInt, RopeFromRope], IO USING [STREAM, RIS, GetChar, PeekChar, SkipWhitespace, GetRopeLiteral, GetAtom, GetCard, Error, EndOfStream], MathExpr; MathExprImpl: CEDAR PROGRAM IMPORTS MathDB, Rope, Convert, IO EXPORTS MathExpr ~ BEGIN <> ROPE: TYPE ~ Rope.ROPE; VEC: TYPE ~ Vector.VEC; BOX: TYPE ~ MathBox.BOX; Style: TYPE ~ MathTypes.Style; AtomBoxProc: TYPE ~ MathRules.AtomBoxProc; AtomPaintProc: TYPE ~ MathRules.AtomPaintProc; AtomToASRopeProc: TYPE ~ MathRules.AtomToASRopeProc; CompoundBoxProc: TYPE ~ MathRules.CompoundBoxProc; CompositionProc: TYPE ~ MathRules.CompositionProc; Size: TYPE ~ MathRules.Size; TaggedMathExpr: TYPE ~ MathExpr.TaggedMathExpr; ExprFlavors: TYPE ~ MathExpr.ExprFlavors; AtomClass: TYPE ~ MathExpr.AtomClass; AtomClassRep: TYPE ~ MathExpr.AtomClassRep; AtomFlavor: TYPE ~ MathExpr.AtomFlavor; CompoundClass: TYPE ~ MathExpr.CompoundClass; CompoundClassRep: TYPE ~ MathExpr.CompoundClassRep; MatrixClass: TYPE ~ MathExpr.MatrixClass; MatrixClassRep: TYPE ~ MathExpr.MatrixClassRep; FormatClass: TYPE ~ MathTypes.FormatClass; Argument: TYPE ~ MathExpr.Argument; Symbol: TYPE ~ MathExpr.Symbol; <> EXPR: TYPE ~ MathExpr.EXPR; MathExprRep: TYPE ~ MathExpr.MathExprRep; AtomEXPR: TYPE ~ MathExpr.AtomEXPR; CompoundEXPR: TYPE ~ MathExpr.CompoundEXPR; MatrixEXPR: TYPE ~ MathExpr.MatrixEXPR; <> <> <> <> <> < [>> <> <> <<],>> < [>> <> <> <<],>> < [>> <> <> <> <<],>> <> <<];>> <<>> <> <> <> <<>> <> <> <> <> <> <<>> <> MakeArgument: PUBLIC PROC[name: ATOM, aliases: LIST OF ATOM, size: Size] RETURNS[Argument] ~ { <> RETURN[[name: name, aliases: aliases, size: size]]; }; <<>> MakeSymbol: PUBLIC PROC[name: ATOM, aliases: LIST OF ATOM, size: Size, value: EXPR] RETURNS[Symbol] ~ { <> RETURN[[name: name, aliases: aliases, size: size, value: value]]; }; MakeAtomClass: PUBLIC PROC[name: ATOM, formatClass: FormatClass, flavor: AtomFlavor, style: Style, boxRule: AtomBoxProc, paintRule: AtomPaintProc, cvtASRule, cvtReduceRule, cvtSMPRule, cvtOtherRule: AtomToASRopeProc _ NIL] RETURNS[AtomClass] ~ { <> RETURN[NEW[AtomClassRep _ [name: name, formatClass: formatClass, flavor: flavor, style: style, boxRule: boxRule, paintRule: paintRule, cvtASRope: cvtASRule, cvtReduceRope: cvtReduceRule, cvtSMPRope: cvtSMPRule, cvtOtherRope: cvtOtherRule]]]; }; MakeCompoundClass: PUBLIC PROC[name: ATOM, formatClass: FormatClass, description: ROPE, args: LIST OF Argument, syms: LIST OF Symbol, boxRule: CompoundBoxProc, compBox: CompositionProc, cvtAS, cvtReduce, cvtSMP, cvtOther: ROPE _ NIL] RETURNS[CompoundClass] ~ { <> RETURN[NEW[CompoundClassRep _ [name: name, formatClass: formatClass, description: description, arguments: args, symbols: syms, boxRule: boxRule, compBox: compBox, cvtAS: cvtAS, cvtReduce: cvtReduce, cvtSMP: cvtSMP, cvtOther: cvtOther]]]; }; MakeMatrixClass: PUBLIC PROC[name: ATOM, formatClass: FormatClass, openSym, closeSym, space: EXPR] RETURNS[MatrixClass] ~ { <> RETURN[NEW[MatrixClassRep _ [name: name, formatClass: formatClass, space: space, openSym: openSym, closeSym: closeSym]]]; }; <> MakeAtomicExpr: PUBLIC PROC[class: ATOM, value: ROPE] RETURNS[EXPR] ~ { <> << SIGNALS badAtomClass if class is unrecognized>> <> atomClass: AtomClass _ MathDB.LookupAtomClass[class ! MathDB.notFound => {ERROR badAtomClass}]; RETURN[NEW[atom MathExprRep _ [atom[class: atomClass, value: value]]]]; }; MakeCompoundExpr: PUBLIC PROC[class: ATOM, args: LIST OF TaggedMathExpr] RETURNS[EXPR] ~ { <> << SIGNALS badCompoundClass if class is unrecognized>> << SIGNALS badExprs if exprs has the wrong number or wrong type of elements>> <<>> <> validExprs: LIST OF TaggedMathExpr _ NIL; <> compClass: CompoundClass _ MathDB.LookupCompoundClass[class ! MathDB.notFound => {ERROR badCompoundClass}]; <> <> FOR l: LIST OF Argument _ compClass.arguments, l.rest UNTIL l = NIL DO validExprs _ CONS[GetTaggedExpr[l.first.name, args ! exprNotFound => {ERROR badExprs[l.first.name]}], validExprs]; ENDLOOP; FOR l: LIST OF Symbol _ compClass.symbols, l.rest UNTIL l = NIL DO validExprs _ CONS[[l.first.name, l.first.value], validExprs]; ENDLOOP; <> RETURN[NEW[compound MathExprRep _ [compound[class: compClass, subExprs: validExprs]]]]; }; MakeMatrixExpr: PUBLIC PROC[class: ATOM, nRows, nCols: NAT, elements: LIST OF TaggedMathExpr] RETURNS[EXPR] ~ { <> << SIGNALS badMatrixClass if class is unrecognized>> << SIGNALS badMatrixSize if nRows or nCols is invalid>> << SIGNALS badMatrix if rows has the wrong number or wrong type of elements>> matrixClass: MatrixClass _ MathDB.LookupMatrixClass[class ! MathDB.notFound => {ERROR badMatrixClass}]; RETURN[NEW[matrix MathExprRep _ [matrix[class: matrixClass, nRows: nRows, nCols: nCols, elements: elements]]]]; }; <> RopeFromExpr: PUBLIC PROC[expr: EXPR] RETURNS[ROPE] ~ { <> << by ExprFromRope[].>> <<>> WITH expr SELECT FROM a: AtomEXPR => { RETURN[Rope.Cat["(ATOM ", Convert.RopeFromAtom[a.class.name], " ", Convert.RopeFromRope[a.value], ")"]]; }; c: CompoundEXPR => { className: ROPE _ Convert.RopeFromAtom[c.class.name]; ropeVal: ROPE _ Rope.Cat["(CMPD ", className, " "]; -- return value FOR l: LIST OF Argument _ c.class.arguments, l.rest UNTIL l = NIL DO argName: ROPE _ Convert.RopeFromAtom[l.first.name]; argRope: ROPE _ RopeFromExpr[GetTaggedExpr[l.first.name, c.subExprs].expression]; ropeVal _ Rope.Cat[ropeVal, "{", argName, " "]; ropeVal _ Rope.Cat[ropeVal, argRope, "}"]; IF l.rest # NIL THEN ropeVal _ Rope.Cat[ropeVal, " "]; ENDLOOP; ropeVal _ Rope.Cat[ropeVal, ")"]; RETURN[ropeVal]; }; m: MatrixEXPR => { className: ROPE _ Convert.RopeFromAtom[m.class.name]; nRowsRope: ROPE _ Convert.RopeFromInt[m.nRows]; nColsRope: ROPE _ Convert.RopeFromInt[m.nCols]; ropeVal: ROPE _ Rope.Cat["(MTRX ", className, " [", nRowsRope]; ropeVal _ Rope.Cat[ropeVal, " ", nColsRope, "] "]; FOR l: LIST OF TaggedMathExpr _ m.elements, l.rest UNTIL l = NIL DO eltTag: ROPE _ Convert.RopeFromAtom[l.first.id]; eltRope: ROPE _ RopeFromExpr[l.first.expression]; ropeVal _ Rope.Cat[ropeVal, "{", eltTag, " "]; ropeVal _ Rope.Cat[ropeVal, eltRope, "}"]; IF l.rest # NIL THEN ropeVal _ Rope.Cat[ropeVal, " "]; ENDLOOP; ropeVal _ Rope.Cat[ropeVal, ")"]; RETURN[ropeVal]; }; ENDCASE => ERROR; }; ExprFromRope: PUBLIC PROC[r: ROPE] RETURNS[EXPR] ~ { <> << SIGNALS parseError if r is malformed.>> expr: EXPR _ ExprFromStream[IO.RIS[r] ! parseError => {ERROR parseError}]; RETURN[expr]; }; ExprFromStream: PUBLIC PROC[stream: IO.STREAM] RETURNS[EXPR] ~ { <> << SIGNALS parseError if stream is malformed.>> <<>> <> c: CHAR; -- one char buffer exprFlavor: ROPE _ ""; -- MTRX, CMPD, or ATOM class: ATOM; -- class name (atom, matrix, or compound) <> { ENABLE IO.Error, IO.EndOfStream, badAtomClass, badCompoundClass, badMatrixClass => { ERROR parseError; }; [] _ IO.SkipWhitespace[stream]; <> c _ IO.GetChar[stream]; IF c # '( THEN ERROR parseError; <> FOR i:NAT IN [1..4] DO exprFlavor _ Rope.Cat[exprFlavor, Rope.FromChar[IO.GetChar[stream]]]; ENDLOOP; SELECT TRUE FROM Rope.Equal[exprFlavor, "ATOM", FALSE] => { <> value: ROPE _ NIL; -- atom value <> [] _ IO.SkipWhitespace[stream]; class _ IO.GetAtom[stream]; -- get atom class name [] _ IO.SkipWhitespace[stream]; value _ IO.GetRopeLiteral[stream]; -- get atom value [] _ IO.SkipWhitespace[stream]; c _ IO.GetChar[stream]; IF c # ') THEN ERROR parseError; -- read closing paren RETURN[MakeAtomicExpr[class, value]]; }; Rope.Equal[exprFlavor, "CMPD", FALSE] => { <> argExprs: LIST OF TaggedMathExpr _ NIL; -- cons up list of argument subexprs argName: ATOM; -- current argument identifier argExpr: EXPR _ NIL; done: BOOL _ FALSE; <> [] _ IO.SkipWhitespace[stream]; class _ IO.GetAtom[stream]; -- get compound class name [] _ IO.SkipWhitespace[stream]; <> <<>> WHILE ~done DO c _ IO.GetChar[stream]; IF c # '{ THEN ERROR parseError; -- get argument open brace [] _ IO.SkipWhitespace[stream]; argName _ IO.GetAtom[stream]; -- get argument name [] _ IO.SkipWhitespace[stream]; <> argExpr _ ExprFromStream[stream ! parseError => {ERROR parseError}]; argExprs _ CONS[[argName, argExpr], argExprs]; -- add to list of arguments [] _ IO.SkipWhitespace[stream]; c _ IO.GetChar[stream]; IF c # '} THEN ERROR parseError; -- get argument close brace [] _ IO.SkipWhitespace[stream]; c _ IO.PeekChar[stream]; IF c = ') THEN done _ TRUE; -- done reading arguments if next char is rparen ENDLOOP; c _ IO.GetChar[stream]; -- read the ') IF c # ') THEN ERROR parseError; -- I'm paranoid RETURN[MakeCompoundExpr[class, argExprs]]; }; Rope.Equal[exprFlavor, "MTRX", FALSE] => { <> nRows, nCols: NAT _ 0; element: EXPR _ NIL; eltName: ATOM; elements, elementsPtr: LIST OF TaggedMathExpr _ NIL; done: BOOL _ FALSE; <> [] _ IO.SkipWhitespace[stream]; class _ IO.GetAtom[stream]; -- get matrix class name [] _ IO.SkipWhitespace[stream]; <> c _ IO.GetChar[stream]; IF c # '[ THEN ERROR parseError; -- get matrix size open bracket [] _ IO.SkipWhitespace[stream]; nRows _ IO.GetCard[stream]; -- get #rows [] _ IO.SkipWhitespace[stream]; nCols _ IO.GetCard[stream]; -- get #cols [] _ IO.SkipWhitespace[stream]; c _ IO.GetChar[stream]; IF c # '] THEN ERROR parseError; -- get matrix size closed bracket [] _ IO.SkipWhitespace[stream]; <> WHILE ~done DO c _ IO.GetChar[stream]; IF c # '{ THEN ERROR parseError; -- get element open brace [] _ IO.SkipWhitespace[stream]; eltName _ IO.GetAtom[stream]; -- get element name [] _ IO.SkipWhitespace[stream]; <> < {ERROR parseError}];>> <> <> element _ ExprFromStream[stream ! parseError => {ERROR parseError}]; IF elements=NIL THEN elements _ elementsPtr _ LIST[[eltName, element]] ELSE elementsPtr _ elementsPtr.rest _ LIST[[eltName, element]]; [] _ IO.SkipWhitespace[stream]; c _ IO.GetChar[stream]; IF c # '} THEN ERROR parseError; -- get element close brace [] _ IO.SkipWhitespace[stream]; c _ IO.PeekChar[stream]; IF c = ') THEN done _ TRUE; -- done reading elements if next char is rparen ENDLOOP; c _ IO.GetChar[stream]; -- read the ') IF c # ') THEN ERROR parseError; -- I'm paranoid RETURN[MakeMatrixExpr[class, nRows, nCols, elements]]; }; ENDCASE => ERROR parseError; }; -- end of enable scope }; <> GetType: PUBLIC PROC[expr: EXPR] RETURNS[ExprFlavors] ~ { <> << Returns compound if expr is a CompoundEXPR>> WITH expr SELECT FROM a: AtomEXPR => RETURN[atom]; c: CompoundEXPR => RETURN[compound]; m: MatrixEXPR => RETURN[matrix]; ENDCASE => ERROR; }; <<>> GetAtomClass: PUBLIC PROC[expr: AtomEXPR] RETURNS[AtomClass] ~ { <> RETURN[expr.class]; }; GetAtomExpr: PUBLIC PROC[expr: EXPR] RETURNS[AtomEXPR] ~ { <> << Otherwise SIGNALS wrongExprType>> WITH expr SELECT FROM a: AtomEXPR => RETURN[a]; c: CompoundEXPR => ERROR wrongExprType; m: MatrixEXPR => ERROR wrongExprType; ENDCASE => ERROR; }; <<>> GetValue: PUBLIC PROC[expr: AtomEXPR] RETURNS[ROPE] ~ { <> RETURN[expr.value]; }; GetCompoundClass: PUBLIC PROC[expr: CompoundEXPR] RETURNS[CompoundClass] ~ { <> RETURN[expr.class]; }; GetCompoundExpr: PUBLIC PROC[expr: EXPR] RETURNS[CompoundEXPR] ~ { <> << Otherwise SIGNALS wrongExprType>> WITH expr SELECT FROM a: AtomEXPR => ERROR wrongExprType; c: CompoundEXPR => RETURN[c]; m: MatrixEXPR => ERROR wrongExprType; ENDCASE => ERROR; }; GetMatrixExpr: PUBLIC PROC[expr: EXPR] RETURNS[MatrixEXPR] ~ { <> << Otherwise SIGNALS wrongExprType>> WITH expr SELECT FROM a: AtomEXPR => ERROR wrongExprType; c: CompoundEXPR => ERROR wrongExprType; m: MatrixEXPR => RETURN[m]; ENDCASE => ERROR; }; GetSubExprs: PUBLIC PROC[expr: CompoundEXPR] RETURNS[LIST OF TaggedMathExpr] ~ { <> RETURN[expr.subExprs]; }; GetMatrixElements: PUBLIC PROC[expr: MatrixEXPR] RETURNS[LIST OF TaggedMathExpr] ~ { <> RETURN[expr.elements]; }; GetMatrixSize: PUBLIC PROC[expr: MatrixEXPR] RETURNS[NAT, NAT] ~ { <> RETURN[expr.nRows, expr.nCols]; }; GetMatrixClass: PUBLIC PROC[expr: MatrixEXPR] RETURNS[MatrixClass] ~ { <> RETURN[expr.class]; }; <> GetTaggedExpr: PUBLIC PROC[tag: ATOM, exprs: LIST OF TaggedMathExpr] RETURNS[TaggedMathExpr] ~ { <> << SIGNALS exprNotFound if no association exists.>> <<>> <> FOR l: LIST OF TaggedMathExpr _ exprs, l.rest UNTIL l = NIL DO IF l.first.id = tag THEN RETURN[l.first]; ENDLOOP; <> ERROR exprNotFound; }; <> badAtomClass: PUBLIC ERROR = CODE; badCompoundClass: PUBLIC ERROR = CODE; badMatrixClass: PUBLIC ERROR = CODE; badExprs: PUBLIC ERROR[reason: ATOM] = CODE; exprNotFound: PUBLIC ERROR = CODE; wrongExprType: PUBLIC ERROR = CODE; parseError: PUBLIC ERROR = CODE; END.