<> <> DIRECTORY Rope, Convert, MathExpr, MathDisplayExpr, MathConstructors, AlgebraClasses, ASASStructures, ASVariables, ASExpressions, ASInts, ASMatrices, ASSets.mesa, ASVectors, ASSequences, VariableASSequences, ASPolynomials, ASEnvironment, ASEvaluator; ASEvaluatorImpl: CEDAR PROGRAM IMPORTS MathExpr, MathDisplayExpr, MathConstructors, Convert, AlgebraClasses, ASASStructures, ASVariables, ASExpressions, ASInts, ASMatrices, ASSets.mesa, ASSequences, VariableASSequences, ASPolynomials, ASEnvironment EXPORTS ASEvaluator = BEGIN OPEN AC: AlgebraClasses, SEQ: ASSequences, MAT: ASMatrices, POL: ASPolynomials, ENV: ASEnvironment; <> ROPE: TYPE ~ Rope.ROPE; Object: TYPE ~ AlgebraClasses.Object; Method: TYPE ~ AlgebraClasses.Method; TaggedMathExpr: TYPE ~ MathExpr.TaggedMathExpr; Argument: TYPE ~ MathExpr.Argument; EXPR: TYPE ~ MathExpr.EXPR; AtomEXPR: TYPE ~ MathExpr.AtomEXPR; CompoundEXPR: TYPE ~ MathExpr.CompoundEXPR; MatrixEXPR: TYPE ~ MathExpr.MatrixEXPR; MeddleExprs: AC.Object ~ ASExpressions.MeddleExprs; <> LookupMethodInStructure: PROC [methodSelector: ATOM, structure: Object] RETURNS[Method] ~ AlgebraClasses.LookupMethodInStructure; LookupMethodInAllASASStructures: PROC [methodSelector: ATOM] RETURNS[method: Method, structure: Object] ~ AlgebraClasses.LookupMethodInAllASASStructures; ApplyFromExprMethod: PROC [method: Method, in: EXPR, structure: Object] RETURNS[Object] ~ AlgebraClasses.ApplyFromExprMethod; ApplyNoLkpNoRecastRef: PROC [method: Method, argList: LIST OF Object] RETURNS[value: REF] ~ AlgebraClasses.ApplyNoLkpNoRecastRef; ApplyNoLkpNoRecastObject: PROC [method: Method, argList: LIST OF Object] RETURNS[value: Object] ~ AlgebraClasses.ApplyNoLkpNoRecastObject; GetMethodAndRecastArgs: PROC [methodSelector: ATOM, structure: Object, inArgs: LIST OF Object] RETURNS [ok: BOOL, method: Method, outArgs: LIST OF Object _ NIL] ~ AlgebraClasses.GetMethodAndRecastArgs; ApplyLkpNoRecastExpr: PROC [methodSelector: ATOM, structure: Object, argList: LIST OF Object] RETURNS[value: EXPR] ~ AlgebraClasses.ApplyLkpNoRecastExpr; ApplyPredNoLkpNoRecast: PROC [method: Method, argList: LIST OF Object] RETURNS[BOOL] ~ AlgebraClasses.ApplyPredNoLkpNoRecast; <> <<>> IsExprs: AC.UnaryPredicate ~ ASExpressions.IsExprs; <> EvalAtom: PROC [a: AtomEXPR, quote: BOOL _ FALSE, sourceStructureForMethod: Object _ NIL] RETURNS [result: Object] ~ { <> method: Method; structure: Object; IF a.class.name=$variable AND NOT quote THEN { -- if this is an unquoted variable with an assigned value, return that value. value: EXPR _ ENV.LookupVariable[Convert.AtomFromRope[a.value] ]; IF value#NIL THEN RETURN[Eval[value] ]; -- do one Eval and return }; method _ IF sourceStructureForMethod # NIL THEN LookupMethodInStructure[a.class.name, sourceStructureForMethod] ELSE NIL; -- try to find method a.class.name, i.e. a constructor named a.class.name, in sourceStructureForMethod; there may or may not be such. structure _ IF method#NIL THEN sourceStructureForMethod ELSE NIL; IF method = NIL THEN [method, structure] _ LookupMethodInAllASASStructures[a.class.name]; -- look for it anywhere IF method # NIL THEN { result _ AC.ApplyFromRopeMethod[method, a.value, structure]; -- a constructor that works on an atom is assumed to be FromRopeOp RETURN[result]; }; <> [method, structure] _ LookupMethodInAllASASStructures[$fromExpr]; -- we assume that we find this method in the Structure "ASExpressions", i.e. general expressions RETURN[ ApplyFromExprMethod[method, a, structure] ]; }; VariableName: PROC [var: EXPR] RETURNS [ROPE] ~ { WITH var SELECT FROM a: AtomEXPR => RETURN[a.value]; c: CompoundEXPR => { methodName: ATOM _ c.class.name; SELECT methodName FROM -- a functional variable whose EXPR representation is a CompoundEXPR must be a VARIABLE decorated with either subscript, superscript, hat, prime $subscript, $superscript, $hat, $prime => { -- args assumed to be atoms atomName: ROPE _ MathDisplayExpr.ASRopeFromDisplayExpr[MathDisplayExpr.DisplayExprFromExpr[c] ]; -- makes a variable name like "aSuperb" RETURN[atomName]; }; ENDCASE => ERROR; }; ENDCASE => ERROR; }; EvalVariable: PROC [var: EXPR, quote: BOOL _ FALSE, sourceStructureForMethod: Object _ NIL] RETURNS [result: Object] ~ { <> WITH var SELECT FROM a: AtomEXPR => RETURN[EvalAtom[a, quote, sourceStructureForMethod] ]; c: CompoundEXPR => { methodName: ATOM _ c.class.name; SELECT methodName FROM -- a functional variable whose EXPR representation is a CompoundEXPR must be a decorated VARIABLE $subscript, $superscript, $hat, $prime => { -- args assumed to be atoms atomName: ROPE _ VariableName[c]; tempAtom: AtomEXPR _ NARROW[MathConstructors.MakeVariable[atomName] ]; RETURN[EvalAtom[tempAtom, quote, sourceStructureForMethod] ]; }; ENDCASE => ERROR; }; ENDCASE => ERROR; }; Eval: PUBLIC PROC[expr: EXPR, sourceStructureForMethod: Object _ NIL] RETURNS[result: Object] ~ { <> ok: BOOL; outArgs, outArgsPointer: LIST OF Object; argObject: Object; argObjects, argObjectsPointer: LIST OF Object _ NIL; -- cons up list of argument subexprs WITH expr SELECT FROM a: AtomEXPR => RETURN[EvalAtom[a, FALSE, sourceStructureForMethod] ]; c: CompoundEXPR => { methodName: ATOM _ c.class.name; method, toExprMethod: Method; argStructure, argLubStructure, structure: Object; outExpr: EXPR; newSubExprs, trailer: LIST OF TaggedMathExpr _ NIL; isVarThisArg: BOOL; variableArgPresent: BOOL; fArg: Object; fName, varName: ROPE; <> SELECT methodName FROM $subscript, $superscript, $hat, $prime => RETURN[EvalVariable[expr, FALSE, sourceStructureForMethod] ]; ENDCASE; <> IF methodName=$quote THEN { argExpr: EXPR _ MathExpr.GetTaggedExpr[c.class.arguments.first.name, c.subExprs].expression; RETURN[ASExpressions.FromExpr[argExpr, ASExpressions.MeddleExprs] ]; }; <> IF methodName=$assign THEN { lhsArg, rhsArg: Object; rhsExpr: EXPR; lhsArg _ EvalVariable[ var: NARROW[MathExpr.GetTaggedExpr[c.class.arguments.first.name, c.subExprs].expression], quote: TRUE, -- don't evaluate variable being assigned to sourceStructureForMethod: NIL ]; -- left hand side is expected to be a functional variable varName _ NARROW[lhsArg.data]; rhsArg _ Eval[MathExpr.GetTaggedExpr[c.class.arguments.rest.first.name, c.subExprs].expression]; toExprMethod _ AC.LookupMethodInStructure[$toExpr, rhsArg.class]; rhsExpr _ NARROW[AC.ApplyNoLkpNoRecastRef[toExprMethod, LIST[rhsArg] ] ]; ENV.InstallVariable[Convert.AtomFromRope[varName], rhsExpr]; RETURN[rhsArg]; }; <> FOR l: LIST OF Argument _ c.class.arguments, l.rest UNTIL l = NIL DO argObject: Object _ Eval[MathExpr.GetTaggedExpr[l.first.name, c.subExprs].expression]; IF argObjects = NIL THEN argObjects _ argObjectsPointer _ LIST[argObject] ELSE argObjectsPointer _ argObjectsPointer.rest _ LIST[argObject]; ENDLOOP; <> SELECT methodName FROM $nullaryFunction, $unaryFunction, $binaryFunction, $ternaryFunction, $quaternaryFunction => { fArg _ argObjects.first; fName _ NARROW[fArg.data]; argObjects _ argObjects.rest; methodName _ Convert.AtomFromRope[fName]; }; ENDCASE; <> IF sourceStructureForMethod # NIL THEN { [ok, method, outArgs] _ GetMethodAndRecastArgs[methodName, sourceStructureForMethod, argObjects]; IF ok THEN RETURN[NARROW[ApplyNoLkpNoRecastRef[method, outArgs] ] ]; }; <> FOR l: LIST OF Object _ argObjects, l.rest UNTIL l = NIL DO argObject _ l.first; [ok, method, outArgs] _ GetMethodAndRecastArgs[methodName, argObject.class, argObjects]; IF ok THEN RETURN[ApplyNoLkpNoRecastObject[method, outArgs] ]; ENDLOOP; <> IF argObjects # NIL THEN { variableArgPresent _ isVarThisArg _ ASSets.mesa.IsVariable[argObjects.first]; IF isVarThisArg THEN argLubStructure _ argStructure _ SimplePolyStructureForVar[argObjects.first] ELSE argLubStructure _ argStructure _ argObjects.first.class; FOR l: LIST OF Object _ argObjects.rest, l.rest UNTIL l = NIL DO argObject _ l.first; isVarThisArg _ ASSets.mesa.IsVariable[argObject]; variableArgPresent _ variableArgPresent OR isVarThisArg; IF isVarThisArg THEN argStructure _ SimplePolyStructureForVar[argObject] ELSE argStructure _ argObject.class; argLubStructure _ BinaryStructureLUB[argLubStructure, argStructure]; ENDLOOP; [ok, method, outArgs] _ GetMethodAndRecastArgs[methodName, argLubStructure, argObjects]; IF ok THEN RETURN[ApplyNoLkpNoRecastObject[method, outArgs] ]; <> IF variableArgPresent THEN { argLubStructure _ argObjects.first.class; FOR l: LIST OF Object _ argObjects.rest, l.rest UNTIL l = NIL DO argObject _ l.first; argLubStructure _ BinaryStructureLUB[argLubStructure, argObject.class]; ENDLOOP; [ok, method, outArgs] _ GetMethodAndRecastArgs[methodName, argLubStructure, argObjects]; IF ok THEN RETURN[ApplyNoLkpNoRecastObject[method, outArgs] ]; }; }; <<>> <> [method, structure] _ LookupMethodInAllASASStructures[methodName]; IF method # NIL THEN { [ok, method, outArgs] _ GetMethodAndRecastArgs[methodName, structure, argObjects]; -- the Exprs recast proc will ToExpr the evaluated args IF ok THEN RETURN[ApplyNoLkpNoRecastObject[method, outArgs] ]; }; <> <<>> <> SELECT c.class.name FROM $nullaryFunction, $unaryFunction, $binaryFunction, $ternaryFunction, $quaternaryFunction => argObjects _ CONS[fArg, argObjects]; ENDCASE; <> FOR l: LIST OF Argument _ c.class.arguments, l.rest UNTIL l = NIL DO taggedExpr: TaggedMathExpr _ MathExpr.GetTaggedExpr[l.first.name, c.subExprs]; argObject: Object _ argObjects.first; taggedExpr.expression _ ApplyLkpNoRecastExpr[$toExpr, argObject.class, LIST[argObject] ]; IF newSubExprs = NIL THEN newSubExprs _ trailer _ LIST[taggedExpr] ELSE trailer _ trailer.rest _ LIST[taggedExpr]; argObjects _ argObjects.rest; ENDLOOP; outExpr _ MathExpr.MakeCompoundExpr[c.class.name, newSubExprs]; -- use c.class.name instead of methodName since latter will have been reset if function [method, structure] _ LookupMethodInAllASASStructures[$expressionStructure]; -- avoid having to explicitly name the Structure GeneralASExpressions RETURN[NEW[AC.ObjectRec _ [ flavor: StructureElement, class: structure, data: outExpr ] ] ]; }; m: MatrixEXPR => { className: ATOM _ m.class.name; elementStructure, matrixStructure, structure: Object _ NIL; matrixStructureConstructorMethod, vectorStructureConstructorMethod, sequenceStructureConstructorMethod: Method; matrixStructureConstructor: REF AC.MatrixStructureConstructor; vectorStructureConstructor: REF AC.VectorStructureConstructor; sequenceStructureConstructor: REF AC.SequenceStructureConstructor; recastMethod, matrixMethod: Method; isVarThisArg: BOOL; argStructure: Object; argObject: Object; <> FOR l: LIST OF TaggedMathExpr _ m.elements, l.rest UNTIL l = NIL DO argObject _ Eval[l.first.expression]; isVarThisArg _ ASSets.mesa.IsVariable[argObject]; IF isVarThisArg THEN argStructure _ SimplePolyStructureForVar[argObject] ELSE argStructure _ argObject.class; elementStructure _ BinaryStructureLUB[elementStructure, argStructure]; IF argObjects = NIL THEN argObjects _ argObjectsPointer _ LIST[argObject] ELSE argObjectsPointer _ argObjectsPointer.rest _ LIST[argObject]; ENDLOOP; <> SELECT className FROM $point => RETURN[argObject]; ENDCASE; <<>> <> recastMethod _ LookupMethodInStructure[$recast, elementStructure]; outArgs _ outArgsPointer _ NIL; FOR l: LIST OF Object _ argObjects, l.rest UNTIL l = NIL DO recastArg: Object _ ApplyNoLkpNoRecastObject[recastMethod, LIST[l.first, elementStructure] ]; IF outArgs = NIL THEN outArgs _ outArgsPointer _ LIST[recastArg] ELSE outArgsPointer _ outArgsPointer.rest _ LIST[recastArg]; ENDLOOP; <> SELECT className FROM $set => { [sequenceStructureConstructorMethod, structure] _ LookupMethodInAllASASStructures[$makeFamilyOfASSets.mesaStructure]; sequenceStructureConstructor _ NARROW[sequenceStructureConstructorMethod.value]; matrixStructure _ sequenceStructureConstructor^[elementStructure]; matrixMethod _ LookupMethodInStructure[$set, matrixStructure]; }; $sequence => { row: BOOL _ IF m.nRows = 1 THEN TRUE ELSE FALSE; [sequenceStructureConstructorMethod, structure] _ LookupMethodInAllASASStructures[$makeSequenceStructure]; sequenceStructureConstructor _ NARROW[sequenceStructureConstructorMethod.value]; matrixStructure _ sequenceStructureConstructor^[elementStructure, row]; matrixMethod _ LookupMethodInStructure[$sequence, matrixStructure]; }; $vector => { row: BOOL _ IF m.nRows = 1 THEN TRUE ELSE FALSE; dimension: NAT _ IF row THEN m.nCols ELSE m.nRows; [vectorStructureConstructorMethod, structure] _ LookupMethodInAllASASStructures[$makeVectorStructure]; vectorStructureConstructor _ NARROW[vectorStructureConstructorMethod.value]; matrixStructure _ vectorStructureConstructor^[elementStructure, dimension, row]; matrixMethod _ LookupMethodInStructure[$vector, matrixStructure]; }; $matrix => { [matrixStructureConstructorMethod, structure] _ LookupMethodInAllASASStructures[$makeMatrixStructure]; matrixStructureConstructor _ NARROW[matrixStructureConstructorMethod.value]; matrixStructure _ matrixStructureConstructor^[elementStructure, m.nRows, m.nCols]; matrixMethod _ LookupMethodInStructure[$matrix, matrixStructure]; }; ENDCASE => ERROR; RETURN[ApplyNoLkpNoRecastObject[matrixMethod, CONS[matrixStructure, outArgs] ] ]; -- make Structure arg the first Arg here; this is what Apply procs expect }; ENDCASE => ERROR; }; SimplePolyStructureForVar: PUBLIC AC.UnaryOp ~ { <> coeffRing: AC.Object _ ASInts.ASInts; one: AC.Object _ ASInts.One[ASInts.ASInts]; variableSeq: VariableASSequences.VariableSequence; variable: Object _ ASSets.mesa.UnderlyingSetUniverseEltFromSSSElt[arg]; variableSeq _ SEQ.MakeSequence[LIST[variable], VariableASSequences.VariableASSequences]; RETURN[POL.MakePolynomialStructure[ASInts.ASInts, variableSeq] ]; }; SimpleBinaryStructureLUB: PUBLIC AC.BinaryStructureLUBOp ~ { canRecastMethod: Method; canRecast: BOOL; <> IF firstStructure = NIL THEN RETURN[secondStructure]; IF secondStructure = NIL THEN RETURN[firstStructure]; IF IsExprs[firstStructure] OR IsExprs[secondStructure] THEN RETURN[MeddleExprs]; IF AC.StructureEqual[firstStructure, secondStructure] THEN RETURN[firstStructure]; <> canRecastMethod _ LookupMethodInStructure[$canRecast, firstStructure]; canRecast _ApplyPredNoLkpNoRecast[canRecastMethod, LIST[secondStructure, firstStructure] ]; IF canRecast THEN RETURN[firstStructure]; <> canRecastMethod _ LookupMethodInStructure[$canRecast, secondStructure]; canRecast _ApplyPredNoLkpNoRecast[canRecastMethod, LIST[firstStructure, secondStructure] ]; IF canRecast THEN RETURN[secondStructure]; RETURN[NIL]; -- give up }; BinaryStructureLUB: PUBLIC AC.BinaryStructureLUBOp ~ { <> firstArgGround, firstArgMatrix, firstArgPolynomial: BOOL; secondArgGround, secondArgMatrix, secondArgPolynomial: BOOL; lub: AC.Object; <> lub _ SimpleBinaryStructureLUB[firstStructure, secondStructure]; IF lub#NIL THEN RETURN[lub]; firstArgGround _ AC.LookupMethodInStructure[$groundStructure, firstStructure]#NIL; firstArgMatrix _ ( AC.LookupMethodInStructure[$matrixStructure, firstStructure]#NIL ); firstArgPolynomial _ ( AC.LookupMethodInStructure[$polynomialStructure, firstStructure]#NIL ); secondArgGround _ ( AC.LookupMethodInStructure[$groundStructure, secondStructure]#NIL ); secondArgMatrix _ ( AC.LookupMethodInStructure[$matrixStructure, secondStructure]#NIL ); secondArgPolynomial _ ( AC.LookupMethodInStructure[$polynomialStructure, secondStructure]#NIL ); IF firstArgGround AND secondArgGround THEN RETURN[MeddleExprs]; -- SimpleBinaryStructureLUB failed <<>> IF firstArgPolynomial THEN { baseCoeffLub: Object; firstData: ASPolynomials.PolynomialRingData _ NARROW[firstStructure.data]; baseCoeffRing: Object _ firstData.baseCoeffRing; SELECT TRUE FROM secondArgGround => { baseCoeffLub _ BinaryStructureLUB[baseCoeffRing, secondStructure]; RETURN[ASPolynomials.MakePolynomialStructure[baseCoeffLub, firstData.allASVariables] ]; }; secondArgPolynomial => { secondData: ASPolynomials.PolynomialRingData _ NARROW[secondStructure.data]; mergedAllVariableList: VariableASSequences.VariableSequence; baseCoeffLub _ BinaryStructureLUB[baseCoeffRing, secondData.baseCoeffRing]; mergedAllVariableList _ VariableASSequences.MergeVariableASSequences[firstData.allASVariables, secondData.allASVariables]; RETURN[ASPolynomials.MakePolynomialStructure[baseCoeffLub, mergedAllVariableList] ]; }; secondArgMatrix => { matrixStructureData: MAT.MatrixStructureData _ NARROW[secondStructure.data]; elementStructure: Object _ matrixStructureData.elementStructure; lub: Object; <> IF ASExpressions.IsExprs[elementStructure] THEN RETURN[secondStructure]; IF ASExpressions.IsExprs[baseCoeffRing] THEN RETURN[firstStructure]; <> lub _ BinaryStructureLUB[firstStructure, elementStructure]; IF NOT ASExpressions.IsExprs[lub] THEN RETURN[MAT.MakeMatrixStructure[lub, matrixStructureData.nRows, matrixStructureData.nCols] ]; <> baseCoeffLub _ BinaryStructureLUB[baseCoeffRing, secondStructure]; IF NOT ASExpressions.IsExprs[baseCoeffLub] THEN RETURN[POL.MakePolynomialStructure[baseCoeffLub, firstData.allASVariables] ]; <> RETURN[MAT.MakeMatrixStructure[MeddleExprs, matrixStructureData.nRows, matrixStructureData.nCols] ]; }; ENDCASE; }; IF secondArgPolynomial THEN { baseCoeffLub: Object; secondData: ASPolynomials.PolynomialRingData _ NARROW[secondStructure.data]; baseCoeffRing: Object _ secondData.baseCoeffRing; SELECT TRUE FROM firstArgGround => { baseCoeffLub _ BinaryStructureLUB[firstStructure, baseCoeffRing]; RETURN[ASPolynomials.MakePolynomialStructure[baseCoeffLub, secondData.allASVariables] ]; }; firstArgMatrix => { matrixStructureData: MAT.MatrixStructureData _ NARROW[firstStructure.data]; elementStructure: Object _ matrixStructureData.elementStructure; lub: Object; <> IF ASExpressions.IsExprs[elementStructure] THEN RETURN[firstStructure]; IF ASExpressions.IsExprs[baseCoeffRing] THEN RETURN[secondStructure]; <> lub _ BinaryStructureLUB[elementStructure, secondStructure]; IF NOT ASExpressions.IsExprs[lub] THEN RETURN[MAT.MakeMatrixStructure[lub, matrixStructureData.nRows, matrixStructureData.nCols] ]; <> baseCoeffLub _ BinaryStructureLUB[firstStructure, baseCoeffRing]; IF NOT ASExpressions.IsExprs[baseCoeffLub] THEN RETURN[POL.MakePolynomialStructure[baseCoeffLub, secondData.allASVariables] ]; <> RETURN[MAT.MakeMatrixStructure[MeddleExprs, matrixStructureData.nRows, matrixStructureData.nCols] ]; }; ENDCASE; }; IF firstArgMatrix THEN { elementLub: Object; matrixStructureData: MAT.MatrixStructureData _ NARROW[firstStructure.data]; elementStructure: Object _ matrixStructureData.elementStructure; SELECT TRUE FROM secondArgGround => { elementLub _ BinaryStructureLUB[elementStructure, secondStructure]; RETURN[MAT.MakeMatrixStructure[elementLub, matrixStructureData.nRows, matrixStructureData.nCols] ]; }; secondArgMatrix => { secondMatrixStructureData: MAT.MatrixStructureData _ NARROW[secondStructure.data]; secondElementStructure: Object _ secondMatrixStructureData.elementStructure; lub: Object; IF matrixStructureData.nRows#secondMatrixStructureData.nRows THEN RETURN[MeddleExprs]; IF matrixStructureData.nCols#secondMatrixStructureData.nCols THEN RETURN[MeddleExprs]; <> IF ASExpressions.IsExprs[elementStructure] THEN RETURN[firstStructure]; IF ASExpressions.IsExprs[secondElementStructure] THEN RETURN[secondStructure]; <> lub _ BinaryStructureLUB[elementStructure, secondElementStructure]; RETURN[MAT.MakeMatrixStructure[lub, matrixStructureData.nRows, matrixStructureData.nCols] ]; }; ENDCASE; }; IF secondArgMatrix THEN { elementLub: Object; matrixStructureData: MAT.MatrixStructureData _ NARROW[secondStructure.data]; elementStructure: Object _ matrixStructureData.elementStructure; SELECT TRUE FROM firstArgGround => { elementLub _ BinaryStructureLUB[firstStructure, elementStructure]; RETURN[MAT.MakeMatrixStructure[elementLub, matrixStructureData.nRows, matrixStructureData.nCols] ]; }; ENDCASE; }; RETURN[MeddleExprs]; -- Catchall; currently (4/27/87) never should reach here }; KillAll: PUBLIC AC.TrueNullaryOp ~ { <> ASEnvironment.ResetASEnvironment[]; RETURN[ASVariables.FromRope["done"] ]; }; KillVariable: PUBLIC AlgebraClasses.UnaryOp ~ { <> argStructure: Object _ arg.class; argExpr: EXPR _ NARROW[AC.ApplyLkpNoRecastRef[$toExpr, argStructure, LIST[arg] ] ]; ASEnvironment.RemoveVariable[Convert.AtomFromRope[VariableName[argExpr] ] ]; RETURN[ASVariables.FromRope["done"] ]; }; <> SquareMatrixFromFunction: PUBLIC AlgebraClasses.QuaternaryOp ~ { <> funExpr: EXPR _ NARROW[AC.ApplyLkpNoRecastRef[$toExpr, firstArg.class, LIST[firstArg] ] ]; rowIndexExpr: EXPR _ NARROW[AC.ApplyLkpNoRecastRef[$toExpr, secondArg.class, LIST[secondArg] ] ]; colIndexExpr: EXPR _ NARROW[AC.ApplyLkpNoRecastRef[$toExpr, thirdArg.class, LIST[thirdArg] ] ]; size: NAT _ ASInts.ToINT[fourthArg]; matrixStructure: Object _ ASMatrices.MakeMatrixStructure[ASExpressions.MeddleExprs, size, size]; elements, trailer: LIST OF Object _ NIL; i, j: NAT _ 1; FOR i IN [1..size] DO [] _ Eval[MathExpr.MakeCompoundExpr[$assign, LIST[ [$lhs, rowIndexExpr], [$rhs, MathConstructors.MakeInt[Convert.RopeFromInt[i]]] ] ] ]; FOR j IN [1..size] DO element, elementExprObject: Object; elementExpr: EXPR; [] _ Eval[MathExpr.MakeCompoundExpr[$assign, LIST[ [$lhs, colIndexExpr], [$rhs, MathConstructors.MakeInt[Convert.RopeFromInt[j]]] ] ] ]; element _ Eval[funExpr]; elementExpr _ NARROW[AC.ApplyLkpNoRecastRef[$toExpr, element.class, LIST[element] ] ]; elementExprObject _ ASExpressions.FromExpr[elementExpr, ASExpressions.MeddleExprs]; IF elements=NIL THEN elements _ trailer _ LIST[elementExprObject] ELSE trailer _ trailer.rest _ LIST[elementExprObject]; ENDLOOP; ENDLOOP; RETURN[ASMatrices.MakeMatrix[elements, matrixStructure] ]; }; MatrixFromRowSequence: PUBLIC AlgebraClasses.UnaryOp ~ { <> rowSequenceData: ASSequences.SequenceData _ NARROW[arg.data]; nRows: NAT _ rowSequenceData.lengthPlus1 - 1; firstRow: Object _ rowSequenceData[1]; firstRowStructureData: ASVectors.VectorStructureData _ NARROW[firstRow.class.data]; nCols: NAT _ firstRowStructureData.dimension; matrixStructure: Object _ ASMatrices.MakeMatrixStructure[ASExpressions.MeddleExprs, nRows, nCols]; elements, trailer: LIST OF Object _ NIL; FOR i:NAT IN [1..nRows] DO row: Object _ rowSequenceData[i]; rowData: ASVectors.VectorData _ NARROW[row.data]; FOR j:NAT IN [1..nCols] DO funExpr: EXPR _ NARROW[AC.ApplyLkpNoRecastRef[$toExpr, rowData[j].class, LIST[rowData[j]] ] ]; element: Object _ Eval[funExpr]; elementExpr: EXPR _ NARROW[AC.ApplyLkpNoRecastRef[$toExpr, element.class, LIST[element] ] ]; elementExprObject: Object _ ASExpressions.FromExpr[elementExpr, ASExpressions.MeddleExprs]; IF elements=NIL THEN elements _ trailer _ LIST[elementExprObject] ELSE trailer _ trailer.rest _ LIST[elementExprObject]; ENDLOOP; ENDLOOP; RETURN[ASMatrices.MakeMatrix[elements, matrixStructure] ]; }; <<>> SequenceFromIteration: PUBLIC AlgebraClasses.QuaternaryOp ~ { <> funExpr: EXPR _ NARROW[AC.ApplyLkpNoRecastRef[$toExpr, firstArg.class, LIST[firstArg] ] ]; variableExpr: EXPR _ NARROW[AC.ApplyLkpNoRecastRef[$toExpr, secondArg.class, LIST[secondArg] ] ]; start: NAT _ ASInts.ToINT[thirdArg]; finish: NAT _ ASInts.ToINT[fourthArg]; sequenceStructure: Object _ ASSequences.MakeSequenceStructure[elementStructure: ASExpressions.MeddleExprs, row: TRUE]; elements, trailer: LIST OF Object _ NIL; FOR i: NAT IN [start..finish] DO element, elementExprObject: Object; elementExpr: EXPR; [] _ Eval[MathExpr.MakeCompoundExpr[$assign, LIST[ [$lhs, variableExpr], [$rhs, MathConstructors.MakeInt[Convert.RopeFromInt[i]]] ] ] ]; element _ Eval[funExpr]; elementExpr _ NARROW[AC.ApplyLkpNoRecastRef[$toExpr, element.class, LIST[element] ] ]; elementExprObject _ ASExpressions.FromExpr[elementExpr, ASExpressions.MeddleExprs]; IF elements=NIL THEN elements _ trailer _ LIST[elementExprObject] ELSE trailer _ trailer.rest _ LIST[elementExprObject]; ENDLOOP; RETURN[ASSequences.MakeSequence[elements, sequenceStructure] ]; }; <<>> Iteration: PUBLIC AlgebraClasses.QuaternaryOp ~ { <> funExpr: EXPR _ NARROW[AC.ApplyLkpNoRecastRef[$toExpr, firstArg.class, LIST[firstArg] ] ]; variableExpr: EXPR _ NARROW[AC.ApplyLkpNoRecastRef[$toExpr, secondArg.class, LIST[secondArg] ] ]; start: NAT _ ASInts.ToINT[thirdArg]; finish: NAT _ ASInts.ToINT[fourthArg]; element: Object; FOR i: NAT IN [start..finish] DO [] _ Eval[MathExpr.MakeCompoundExpr[$assign, LIST[ [$lhs, variableExpr], [$rhs, MathConstructors.MakeInt[Convert.RopeFromInt[i]]] ] ] ]; element _ Eval[funExpr]; ENDLOOP; RETURN[element]; }; <> killVariableMethod: Method _ AC.MakeMethod[UnaryOp, TRUE, NEW[AC.UnaryOp _ KillVariable], NIL, "killVariable"]; killAllMethod: Method _ AC.MakeMethod[TrueNullaryOp, TRUE, NEW[AC.TrueNullaryOp _ KillAll], NIL, "killAll"]; squareMatrixFromFunctionMethod: Method _ AC.MakeMethod[QuaternaryOp, TRUE, NEW[AC.QuaternaryOp _ SquareMatrixFromFunction], NIL, "squareMatrixFromFunction"]; iterationMethod: Method _ AC.MakeMethod[QuaternaryOp, TRUE, NEW[AC.QuaternaryOp _ Iteration], NIL, "iteration"]; sequenceFromIterationMethod: Method _ AC.MakeMethod[QuaternaryOp, TRUE, NEW[AC.QuaternaryOp _ SequenceFromIteration], NIL, "sequenceFromIteration"]; matrixFromRowSequenceMethod: Method _ AC.MakeMethod[UnaryOp, TRUE, NEW[AC.UnaryOp _ MatrixFromRowSequence], NIL, "matrixFromRowSequenceMethod"]; AC.AddMethodToClass[$killVariable, killVariableMethod, ASASStructures.ASASStructuresClass]; AC.AddMethodToClass[$killAll, killAllMethod, ASASStructures.ASASStructuresClass]; AC.AddMethodToClass[$squareMatrixFromFunction, squareMatrixFromFunctionMethod, ASASStructures.ASASStructuresClass]; AC.AddMethodToClass[$squareMatrixFunction, squareMatrixFromFunctionMethod, ASASStructures.ASASStructuresClass]; AC.AddMethodToClass[$sMFF, squareMatrixFromFunctionMethod, ASASStructures.ASASStructuresClass]; AC.AddMethodToClass[$iteration, iterationMethod, ASASStructures.ASASStructuresClass]; AC.AddMethodToClass[$it, iterationMethod, ASASStructures.ASASStructuresClass]; AC.AddMethodToClass[$sequenceFromIteration, sequenceFromIterationMethod, ASASStructures.ASASStructuresClass]; AC.AddMethodToClass[$sFI, sequenceFromIterationMethod, ASASStructures.ASASStructuresClass]; AC.AddMethodToClass[$matrixFromRowSequence, matrixFromRowSequenceMethod, ASASStructures.ASASStructuresClass]; AC.AddMethodToClass[$mFRS, matrixFromRowSequenceMethod, ASASStructures.ASASStructuresClass]; AC.InstallStructure[ASExpressions.MeddleExprs]; -- do it now so methods from other structures found first by LookupMethodInAllASASStructures END.