From 661b5958f7e3ba090917e01e4a61418b00d07586 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Per=20=C3=96stlund?= Date: Tue, 11 Sep 2018 13:28:35 +0200 Subject: [PATCH] [NF] Improve evaluation of some external functions. - Implement evaluation of Lapack functions. - Fix typo of ModelicaStrings_compare. Belonging to [master]: - OpenModelica/OMCompiler#2641 --- Compiler/NFFrontEnd/NFEvalFunction.mo | 62 ++- Compiler/NFFrontEnd/NFEvalFunctionExt.mo | 575 +++++++++++++++++++++++ Compiler/NFFrontEnd/NFExpression.mo | 80 ++++ Compiler/boot/LoadCompilerSources.mos | 1 + 4 files changed, 711 insertions(+), 7 deletions(-) create mode 100644 Compiler/NFFrontEnd/NFEvalFunctionExt.mo diff --git a/Compiler/NFFrontEnd/NFEvalFunction.mo b/Compiler/NFFrontEnd/NFEvalFunction.mo index 71c4bc3d37b..7137d1bcb56 100644 --- a/Compiler/NFFrontEnd/NFEvalFunction.mo +++ b/Compiler/NFFrontEnd/NFEvalFunction.mo @@ -55,6 +55,7 @@ import System; import NFTyping.ExpOrigin; import SCode; import NFPrefixes.Variability; +import EvalFunctionExt = NFEvalFunctionExt; encapsulated package ReplTree import BaseAvlTree; @@ -149,8 +150,9 @@ protected String name, lang; ComponentRef output_ref; Option ann; + list ext_args; algorithm - Sections.EXTERNAL(name = name, outputRef = output_ref, language = lang, ann = ann) := + Sections.EXTERNAL(name = name, args = ext_args, outputRef = output_ref, language = lang, ann = ann) := Class.getSections(InstNode.getClass(fn.node)); if lang == "builtin" then @@ -158,13 +160,19 @@ algorithm result := Ceval.evalBuiltinCall(fn, args, NFCeval.EvalTarget.IGNORE_ERRORS()); elseif isKnownExternalFunc(name, ann) then // External functions that we know how to evaluate without generating code. + // TODO: Move this to EvalFunctionExt and unify evaluateKnownExternal and + // evaluateExternal2. This requires handling of outputRef though. result := evaluateKnownExternal(name, args); else - // External functions that we would need to generate code for and execute. - Error.assertion(false, getInstanceName() + - " failed on " + Absyn.pathString(fn.path) + - ", evaluation of userdefined external functions not yet implemented", sourceInfo()); - fail(); + try + result := evaluateExternal2(name, fn, args, ext_args); + else + // External functions that we would need to generate code for and execute. + Error.assertion(false, getInstanceName() + + " failed on " + Absyn.pathString(fn.path) + + ", evaluation of userdefined external functions not yet implemented", sourceInfo()); + fail(); + end try; end if; end evaluateExternal; @@ -452,6 +460,7 @@ algorithm assignVariable(lhsExp, Ceval.evalExp(rhsExp)); end evaluateAssignment; +public function assignVariable input Expression variable; input Expression value; @@ -493,6 +502,7 @@ algorithm end match; end assignVariable; +protected function assignSubscriptedVariable input Mutable variable; input list subscripts; @@ -878,7 +888,7 @@ algorithm then Expression.INTEGER(0); - case ("ModelicaString_compare", {Expression.STRING(s1), Expression.STRING(s2), Expression.BOOLEAN(b)}) + case ("ModelicaStrings_compare", {Expression.STRING(s1), Expression.STRING(s2), Expression.BOOLEAN(b)}) algorithm i := ModelicaExternalC.Strings_compare(s1, s2, b); then @@ -943,5 +953,43 @@ algorithm end match; end evaluateOpenModelicaRegex; +function evaluateExternal2 + input String name; + input Function fn; + input list args; + input list extArgs; + output Expression result; +protected + ReplTree.Tree repl; + list ext_args; +algorithm + repl := createReplacements(fn, args); + ext_args := list(Expression.map(e, function applyReplacements2(repl = repl)) for e in extArgs); + evaluateExternal3(name, ext_args); + result := createResult(repl, fn.outputs); +end evaluateExternal2; + +function evaluateExternal3 + input String name; + input list args; +algorithm + () := match name + case "dgeev" algorithm EvalFunctionExt.Lapack_dgeev(args); then (); + case "dgegv" algorithm EvalFunctionExt.Lapack_dgegv(args); then (); + case "dgels" algorithm EvalFunctionExt.Lapack_dgels(args); then (); + case "dgelsx" algorithm EvalFunctionExt.Lapack_dgelsx(args); then (); + case "dgesv" algorithm EvalFunctionExt.Lapack_dgesv(args); then (); + case "dgglse" algorithm EvalFunctionExt.Lapack_dgglse(args); then (); + case "dgtsv" algorithm EvalFunctionExt.Lapack_dgtsv(args); then (); + case "dgbsv" algorithm EvalFunctionExt.Lapack_dgtsv(args); then (); + case "dgesvd" algorithm EvalFunctionExt.Lapack_dgesvd(args); then (); + case "dgetrf" algorithm EvalFunctionExt.Lapack_dgetrf(args); then (); + case "dgetrs" algorithm EvalFunctionExt.Lapack_dgetrs(args); then (); + case "dgetri" algorithm EvalFunctionExt.Lapack_dgetri(args); then (); + case "dgeqpf" algorithm EvalFunctionExt.Lapack_dgeqpf(args); then (); + case "dorgqr" algorithm EvalFunctionExt.Lapack_dorgqr(args); then (); + end match; +end evaluateExternal3; + annotation(__OpenModelica_Interface="frontend"); end NFEvalFunction; diff --git a/Compiler/NFFrontEnd/NFEvalFunctionExt.mo b/Compiler/NFFrontEnd/NFEvalFunctionExt.mo new file mode 100644 index 00000000000..95262838242 --- /dev/null +++ b/Compiler/NFFrontEnd/NFEvalFunctionExt.mo @@ -0,0 +1,575 @@ +/* + * This file is part of OpenModelica. + * + * Copyright (c) 1998-2014, Open Source Modelica Consortium (OSMC), + * c/o Linköpings universitet, Department of Computer and Information Science, + * SE-58183 Linköping, Sweden. + * + * All rights reserved. + * + * THIS PROGRAM IS PROVIDED UNDER THE TERMS OF GPL VERSION 3 LICENSE OR + * THIS OSMC PUBLIC LICENSE (OSMC-PL) VERSION 1.2. + * ANY USE, REPRODUCTION OR DISTRIBUTION OF THIS PROGRAM CONSTITUTES + * RECIPIENT'S ACCEPTANCE OF THE OSMC PUBLIC LICENSE OR THE GPL VERSION 3, + * ACCORDING TO RECIPIENTS CHOICE. + * + * The OpenModelica software and the Open Source Modelica + * Consortium (OSMC) Public License (OSMC-PL) are obtained + * from OSMC, either from the above address, + * from the URLs: http://www.ida.liu.se/projects/OpenModelica or + * http://www.openmodelica.org, and in the OpenModelica distribution. + * GNU version 3 is obtained from: http://www.gnu.org/copyleft/gpl.html. + * + * This program is distributed WITHOUT ANY WARRANTY; without + * even the implied warranty of MERCHANTABILITY or FITNESS + * FOR A PARTICULAR PURPOSE, EXCEPT AS EXPRESSLY SET FORTH + * IN THE BY RECIPIENT SELECTED SUBSIDIARY LICENSE CONDITIONS OF OSMC-PL. + * + * See the full OSMC Public License conditions for more details. + * + */ + +encapsulated package NFEvalFunctionExt + +import Expression = NFExpression; + +protected +import EvalFunction = NFEvalFunction; +import NFEvalFunction.assignVariable; +import Ceval = NFCeval; +import Type = NFType; +import Lapack; + +public + +function Lapack_dgeev + input list args; +protected + Expression jobvl, jobvr, n, a, lda, ldvl, ldvr, work, lwork, wr, wi, vl, vr, info; + Integer INFO, LDA, LDVL, LDVR, LWORK, N; + String JOBVL, JOBVR; + list> A, VL, VR; + list WORK, WR, WI; +algorithm + {jobvl, jobvr, n, a, lda, wr, wi, vl, ldvl, vr, ldvr, work, lwork, info} := args; + + JOBVL := evaluateExtStringArg(jobvl); + JOBVR := evaluateExtStringArg(jobvr); + N := evaluateExtIntArg(n); + A := evaluateExtRealMatrixArg(a); + LDA := evaluateExtIntArg(lda); + LDVL := evaluateExtIntArg(ldvl); + LDVR := evaluateExtIntArg(ldvr); + WORK := evaluateExtRealArrayArg(work); + LWORK := evaluateExtIntArg(lwork); + + (A, WR, WI, VL, VR, WORK, INFO) := + Lapack.dgeev(JOBVL, JOBVR, N, A, LDA, LDVL, LDVR, WORK, LWORK); + + assignVariableExt(a, Expression.makeRealMatrix(A)); + assignVariable(wr, Expression.makeRealArray(WR)); + assignVariable(wi, Expression.makeRealArray(WI)); + assignVariableExt(vl, Expression.makeRealMatrix(VL)); + assignVariableExt(vr, Expression.makeRealMatrix(VR)); + assignVariable(work, Expression.makeRealArray(WORK)); + assignVariable(info, Expression.makeInteger(INFO)); +end Lapack_dgeev; + +function Lapack_dgegv + input list args; +protected + Expression jobvl, jobvr, n, a, lda, b, ldb, alphar, alphai; + Expression beta, vl, ldvl, vr, ldvr, work, lwork, info; + String JOBVL, JOBVR; + Integer N, LDA, LDB, LDVL, LDVR, LWORK, INFO; + list> A, B, VL, VR; + list WORK, ALPHAR, ALPHAI, BETA; +algorithm + {jobvl, jobvr, n, a, lda, b, ldb, alphar, alphai, + beta, vl, ldvl, vr, ldvr, work, lwork, info} := args; + + JOBVL := evaluateExtStringArg(jobvl); + JOBVR := evaluateExtStringArg(jobvr); + N := evaluateExtIntArg(n); + A := evaluateExtRealMatrixArg(a); + LDA := evaluateExtIntArg(lda); + B := evaluateExtRealMatrixArg(b); + LDB := evaluateExtIntArg(ldb); + LDVL := evaluateExtIntArg(ldvl); + LDVR := evaluateExtIntArg(ldvr); + WORK := evaluateExtRealArrayArg(work); + LWORK := evaluateExtIntArg(lwork); + + (ALPHAR, ALPHAI, BETA, VL, VR, WORK, INFO) := + Lapack.dgegv(JOBVL, JOBVR, N, A, LDA, B, LDB, LDVL, LDVR, WORK, LWORK); + + assignVariable(alphar, Expression.makeRealArray(ALPHAR)); + assignVariable(alphai, Expression.makeRealArray(ALPHAI)); + assignVariable(beta, Expression.makeRealArray(BETA)); + assignVariableExt(vl, Expression.makeRealMatrix(VL)); + assignVariableExt(vr, Expression.makeRealMatrix(VR)); + assignVariable(work, Expression.makeRealArray(WORK)); + assignVariable(info, Expression.makeInteger(INFO)); +end Lapack_dgegv; + +function Lapack_dgels + input list args; +protected + Expression trans, m, n, nrhs, a, lda, b, ldb, work, lwork, info; + String TRANS; + Integer M, N, NRHS, LDA, LDB, LWORK, INFO; + list> A, B; + list WORK; +algorithm + {trans, m, n, nrhs, a, lda, b, ldb, work, lwork, info} := args; + + TRANS := evaluateExtStringArg(trans); + M := evaluateExtIntArg(m); + N := evaluateExtIntArg(n); + NRHS := evaluateExtIntArg(nrhs); + A := evaluateExtRealMatrixArg(a); + LDA := evaluateExtIntArg(lda); + B := evaluateExtRealMatrixArg(b); + LDB := evaluateExtIntArg(ldb); + WORK := evaluateExtRealArrayArg(work); + LWORK := evaluateExtIntArg(lwork); + + (A, B, WORK, INFO) := + Lapack.dgels(TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK); + + assignVariableExt(a, Expression.makeRealMatrix(A)); + assignVariableExt(b, Expression.makeRealMatrix(B)); + assignVariable(work, Expression.makeRealArray(WORK)); + assignVariable(info, Expression.makeInteger(INFO)); +end Lapack_dgels; + +function Lapack_dgelsx + input list args; +protected + Expression m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank, work, info; + Integer M, N, NRHS, LDA, LDB, RANK, INFO; + list> A, B; + list JPVT; + Real RCOND; + list WORK; +algorithm + if listLength(args) == 12 then + {m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank, work, info} := args; + else + // Some older versions of the MSL calls dgelsx with an extra lwork argument. + {m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank, work, _, info} := args; + end if; + + M := evaluateExtIntArg(m); + N := evaluateExtIntArg(n); + NRHS := evaluateExtIntArg(nrhs); + A := evaluateExtRealMatrixArg(a); + LDA := evaluateExtIntArg(lda); + B := evaluateExtRealMatrixArg(b); + LDB := evaluateExtIntArg(ldb); + JPVT := evaluateExtIntArrayArg(jpvt); + RCOND := evaluateExtRealArg(rcond); + WORK := evaluateExtRealArrayArg(work); + + (A, B, JPVT, RANK, INFO) := + Lapack.dgelsx(M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, WORK); + + assignVariableExt(a, Expression.makeRealMatrix(A)); + assignVariableExt(b, Expression.makeRealMatrix(B)); + assignVariable(jpvt, Expression.makeIntegerArray(JPVT)); + assignVariable(rank, Expression.makeInteger(RANK)); + assignVariable(info, Expression.makeInteger(INFO)); +end Lapack_dgelsx; + +function Lapack_dgesv + input list args; +protected + Expression n, nrhs, a, lda, ipiv, b, ldb, info; + Integer N, NRHS, LDA, LDB, INFO; + list> A, B; + list IPIV; +algorithm + {n, nrhs, a, lda, ipiv, b, ldb, info} := args; + + N := evaluateExtIntArg(n); + NRHS := evaluateExtIntArg(nrhs); + A := evaluateExtRealMatrixArg(a); + LDA := evaluateExtIntArg(lda); + B := evaluateExtRealMatrixArg(b); + LDB := evaluateExtIntArg(ldb); + + (A, IPIV, B, INFO) := + Lapack.dgesv(N, NRHS, A, LDA, B, LDB); + + assignVariableExt(a, Expression.makeRealMatrix(A)); + assignVariable(ipiv, Expression.makeIntegerArray(IPIV)); + assignVariableExt(b, Expression.makeRealMatrix(B)); + assignVariable(info, Expression.makeInteger(INFO)); +end Lapack_dgesv; + +function Lapack_dgglse + input list args; +protected + Expression m, n, p, a, lda, b, ldb, c, d, x, work, lwork, info; + Integer M, N, P, LDA, LDB, LWORK, INFO; + list> A, B; + list C, D, WORK, X; +algorithm + {m, n, p, a, lda, b, ldb, c, d, x, work, lwork, info} := args; + + M := evaluateExtIntArg(m); + N := evaluateExtIntArg(n); + P := evaluateExtIntArg(p); + A := evaluateExtRealMatrixArg(a); + LDA := evaluateExtIntArg(lda); + B := evaluateExtRealMatrixArg(b); + LDB := evaluateExtIntArg(ldb); + C := evaluateExtRealArrayArg(c); + D := evaluateExtRealArrayArg(d); + WORK := evaluateExtRealArrayArg(work); + LWORK := evaluateExtIntArg(lwork); + + (A, B, C, D, X, WORK, INFO) := + Lapack.dgglse(M, N, P, A, LDA, B, LDB, C, D, WORK, LWORK); + + assignVariableExt(a, Expression.makeRealMatrix(A)); + assignVariableExt(b, Expression.makeRealMatrix(B)); + assignVariable(c, Expression.makeRealArray(C)); + assignVariable(d, Expression.makeRealArray(D)); + assignVariable(x, Expression.makeRealArray(X)); + assignVariable(work, Expression.makeRealArray(WORK)); + assignVariable(info, Expression.makeInteger(INFO)); +end Lapack_dgglse; + +function Lapack_dgtsv + input list args; +protected + Expression n, nrhs, dl, d, du, b, ldb, info; + Integer N, NRHS, LDB, INFO; + list DL, D, DU; + list> B; +algorithm + {n, nrhs, dl, d, du, b, ldb, info} := args; + + N := evaluateExtIntArg(n); + NRHS := evaluateExtIntArg(nrhs); + DL := evaluateExtRealArrayArg(dl); + D := evaluateExtRealArrayArg(d); + DU := evaluateExtRealArrayArg(du); + B := evaluateExtRealMatrixArg(b); + LDB := evaluateExtIntArg(ldb); + + (DL, D, DU, B, INFO) := + Lapack.dgtsv(N, NRHS, DL, D, DU, B, LDB); + + assignVariable(dl, Expression.makeRealArray(DL)); + assignVariable(d, Expression.makeRealArray(D)); + assignVariable(du, Expression.makeRealArray(DU)); + assignVariableExt(b, Expression.makeRealMatrix(B)); + assignVariable(info, Expression.makeInteger(INFO)); +end Lapack_dgtsv; + +function Lapack_dgbsv + input list args; +protected + Expression n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info; + Integer N, KL, KU, NRHS, LDAB, LDB, INFO; + list> AB, B; + list IPIV; +algorithm + {n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info} := args; + + N := evaluateExtIntArg(n); + KL := evaluateExtIntArg(kl); + KU := evaluateExtIntArg(ku); + NRHS := evaluateExtIntArg(nrhs); + AB := evaluateExtRealMatrixArg(ab); + LDAB := evaluateExtIntArg(ldab); + B := evaluateExtRealMatrixArg(b); + LDB := evaluateExtIntArg(ldb); + + (AB, IPIV, B, INFO) := + Lapack.dgbsv(N, KL, KU, NRHS, AB, LDAB, B, LDB); + + assignVariableExt(ab, Expression.makeRealMatrix(AB)); + assignVariable(ipiv, Expression.makeIntegerArray(IPIV)); + assignVariableExt(b, Expression.makeRealMatrix(B)); + assignVariable(info, Expression.makeInteger(INFO)); +end Lapack_dgbsv; + +function Lapack_dgesvd + input list args; +protected + Expression jobu, jobvt, m, n, a, lda, s, u, ldu, vt, ldvt, work, lwork, info; + String JOBU, JOBVT; + Integer M, N, LDA, LDU, LDVT, LWORK, INFO; + list> A, U, VT; + list S, WORK; +algorithm + {jobu, jobvt, m, n, a, lda, s, u, ldu, vt, ldvt, work, lwork, info} := args; + + JOBU := evaluateExtStringArg(jobu); + JOBVT := evaluateExtStringArg(jobvt); + M := evaluateExtIntArg(m); + N := evaluateExtIntArg(n); + A := evaluateExtRealMatrixArg(a); + LDA := evaluateExtIntArg(lda); + LDU := evaluateExtIntArg(ldu); + LDVT := evaluateExtIntArg(ldvt); + WORK := evaluateExtRealArrayArg(work); + LWORK := evaluateExtIntArg(lwork); + + (A, S, U, VT, WORK, INFO) := + Lapack.dgesvd(JOBU, JOBVT, M, N, A, LDA, LDU, LDVT, WORK, LWORK); + + assignVariableExt(a, Expression.makeRealMatrix(A)); + assignVariable(s, Expression.makeRealArray(S)); + assignVariableExt(u, Expression.makeRealMatrix(U)); + assignVariableExt(vt, Expression.makeRealMatrix(VT)); + assignVariable(work, Expression.makeRealArray(WORK)); + assignVariable(info, Expression.makeInteger(INFO)); +end Lapack_dgesvd; + +function Lapack_dgetrf + input list args; +protected + Expression m, n, a, lda, ipiv, info; + Integer M, N, LDA, INFO; + list> A; + list IPIV; +algorithm + {m, n, a, lda, ipiv, info} := args; + + M := evaluateExtIntArg(m); + N := evaluateExtIntArg(n); + A := evaluateExtRealMatrixArg(a); + LDA := evaluateExtIntArg(lda); + + (A, IPIV, INFO) := + Lapack.dgetrf(M, N, A, LDA); + + assignVariableExt(a, Expression.makeRealMatrix(A)); + assignVariable(ipiv, Expression.makeIntegerArray(IPIV)); + assignVariable(info, Expression.makeInteger(INFO)); +end Lapack_dgetrf; + +function Lapack_dgetrs + input list args; +protected + Expression trans, n, nrhs, a, lda, ipiv, b, ldb, info; + String TRANS; + Integer N, NRHS, LDA, LDB, INFO; + list> A, B; + list IPIV; +algorithm + {trans, n, nrhs, a, lda, ipiv, b, ldb, info} := args; + + TRANS := evaluateExtStringArg(trans); + N := evaluateExtIntArg(n); + NRHS := evaluateExtIntArg(nrhs); + A := evaluateExtRealMatrixArg(a); + LDA := evaluateExtIntArg(lda); + IPIV := evaluateExtIntArrayArg(ipiv); + B := evaluateExtRealMatrixArg(b); + LDB := evaluateExtIntArg(ldb); + + (B, INFO) := + Lapack.dgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB); + + assignVariableExt(b, Expression.makeRealMatrix(B)); + assignVariable(info, Expression.makeInteger(INFO)); +end Lapack_dgetrs; + +function Lapack_dgetri + input list args; +protected + Expression n, a, lda, ipiv, work, lwork, info; + Integer N, LDA, LWORK, INFO; + list> A; + list IPIV; + list WORK; +algorithm + {n, a, lda, ipiv, work, lwork, info} := args; + + N := evaluateExtIntArg(n); + A := evaluateExtRealMatrixArg(a); + LDA := evaluateExtIntArg(lda); + IPIV := evaluateExtIntArrayArg(ipiv); + WORK := evaluateExtRealArrayArg(work); + LWORK := evaluateExtIntArg(lwork); + + (A, WORK, INFO) := + Lapack.dgetri(N, A, LDA, IPIV, WORK, LWORK); + + assignVariableExt(a, Expression.makeRealMatrix(A)); + assignVariable(work, Expression.makeRealArray(WORK)); + assignVariable(info, Expression.makeInteger(INFO)); +end Lapack_dgetri; + +function Lapack_dgeqpf + input list args; +protected + Expression m, n, a, lda, jpvt, tau, work, info; + Integer M, N, LDA, INFO; + list> A; + list JPVT; + list WORK, TAU; +algorithm + {m, n, a, lda, jpvt, tau, work, info} := args; + + M := evaluateExtIntArg(m); + N := evaluateExtIntArg(n); + A := evaluateExtRealMatrixArg(a); + LDA := evaluateExtIntArg(lda); + JPVT := evaluateExtIntArrayArg(jpvt); + WORK := evaluateExtRealArrayArg(work); + + (A, JPVT, TAU, INFO) := + Lapack.dgeqpf(M, N, A, LDA, JPVT, WORK); + + assignVariableExt(a, Expression.makeRealMatrix(A)); + assignVariable(jpvt, Expression.makeIntegerArray(JPVT)); + assignVariable(tau, Expression.makeRealArray(TAU)); + assignVariable(info, Expression.makeInteger(INFO)); +end Lapack_dgeqpf; + +function Lapack_dorgqr + input list args; +protected + Expression m, n, k, a, lda, tau, work, lwork, info; + Integer M, N, K, LDA, LWORK, INFO; + list> A; + list TAU, WORK; +algorithm + {m, n, k, a, lda, tau, work, lwork, info} := args; + + M := evaluateExtIntArg(m); + N := evaluateExtIntArg(n); + K := evaluateExtIntArg(k); + A := evaluateExtRealMatrixArg(a); + LDA := evaluateExtIntArg(lda); + TAU := evaluateExtRealArrayArg(tau); + WORK := evaluateExtRealArrayArg(work); + LWORK := evaluateExtIntArg(lwork); + + (A, WORK, INFO) := + Lapack.dorgqr(M, N, K, A, LDA, TAU, WORK, LWORK); + + assignVariableExt(a, Expression.makeRealMatrix(A)); + assignVariable(work, Expression.makeRealArray(WORK)); + assignVariable(info, Expression.makeInteger(INFO)); +end Lapack_dorgqr; + +protected +function evaluateExtIntArg + input Expression arg; + output Integer value = getExtIntValue(Ceval.evalExp(arg)); +end evaluateExtIntArg; + +function getExtIntValue + input Expression exp; + output Integer value; +algorithm + value := match exp + case Expression.INTEGER() then exp.value; + case Expression.EMPTY() then 0; + end match; +end getExtIntValue; + +function evaluateExtRealArg + input Expression arg; + output Real value = getExtRealValue(Ceval.evalExp(arg)); +end evaluateExtRealArg; + +function getExtRealValue + input Expression exp; + output Real value; +algorithm + value := match exp + case Expression.REAL() then exp.value; + case Expression.EMPTY() then 0.0; + end match; +end getExtRealValue; + +function evaluateExtStringArg + input Expression arg; + output String value = getExtStringValue(Ceval.evalExp(arg)); +end evaluateExtStringArg; + +function getExtStringValue + input Expression exp; + output String value; +algorithm + value := match exp + case Expression.STRING() then exp.value; + case Expression.EMPTY() then ""; + end match; +end getExtStringValue; + +function evaluateExtIntArrayArg + input Expression arg; + output list value; +protected + list expl; +algorithm + expl := Expression.arrayElements(Ceval.evalExp(arg)); + value := list(getExtIntValue(e) for e in expl); +end evaluateExtIntArrayArg; + +function evaluateExtRealArrayArg + input Expression arg; + output list value; +protected + list expl; +algorithm + expl := Expression.arrayElements(Ceval.evalExp(arg)); + value := list(getExtRealValue(e) for e in expl); +end evaluateExtRealArrayArg; + +function evaluateExtRealMatrixArg + input Expression arg; + output list> value; +protected + list expl; + Type ty; +algorithm + Expression.ARRAY(ty = ty, elements = expl) := Ceval.evalExp(arg); + + // Some external functions don't make a difference between vectors and + // matrices, so if the argument is a vector we convert it into a matrix. + value := match Type.dimensionCount(ty) + case 1 + then list({getExtRealValue(e)} for e in expl); + case 2 + then list(list(getExtRealValue(e) for e in Expression.arrayElements(row)) + for row in expl); + end match; +end evaluateExtRealMatrixArg; + +function assignVariableExt + "Some external functions doesn't differentiate between vector and matrices, so + we might get back a Nx1 matrix when expecting a vector. In that case it needs + to be converted back into a vector before assigning the variable. Otherwise + this function just calls assignVariable, so it's only needed for matrix + arguments." + input Expression variable; + input Expression value; +protected + Expression exp; +algorithm + exp := match (Expression.typeOf(variable), value) + // Vector variable, matrix value => convert value to vector. + case (Type.ARRAY(dimensions = {_}), + Expression.ARRAY(ty = Type.ARRAY(dimensions = {_, _}))) + then Expression.ARRAY(Type.unliftArray(value.ty), + list(Expression.arrayScalarElement(e) for e in value.elements)); + + else value; + end match; + + assignVariable(variable, exp); +end assignVariableExt; + +annotation(__OpenModelica_Interface="frontend"); +end NFEvalFunctionExt; + diff --git a/Compiler/NFFrontEnd/NFExpression.mo b/Compiler/NFFrontEnd/NFExpression.mo index 15d466bd25e..436bbbc4f12 100644 --- a/Compiler/NFFrontEnd/NFExpression.mo +++ b/Compiler/NFFrontEnd/NFExpression.mo @@ -662,6 +662,11 @@ public end match; end realValue; + function makeReal + input Real value; + output Expression exp = REAL(value); + end makeReal; + function integerValue input Expression exp; output Integer value; @@ -669,6 +674,45 @@ public INTEGER(value=value) := exp; end integerValue; + function makeInteger + input Integer value; + output Expression exp = INTEGER(value); + end makeInteger; + + function makeIntegerArray + input list values; + output Expression exp; + algorithm + exp := ARRAY(Type.ARRAY(Type.INTEGER(), {Dimension.fromInteger(listLength(values))}), + list(INTEGER(v) for v in values)); + end makeIntegerArray; + + function makeRealArray + input list values; + output Expression exp; + algorithm + exp := ARRAY(Type.ARRAY(Type.REAL(), {Dimension.fromInteger(listLength(values))}), + list(REAL(v) for v in values)); + end makeRealArray; + + function makeRealMatrix + input list> values; + output Expression exp; + protected + Type ty; + list expl; + algorithm + if listEmpty(values) then + ty := Type.ARRAY(Type.REAL(), {Dimension.fromInteger(0), Dimension.UNKNOWN()}); + exp := ARRAY(ty, {}); + else + ty := Type.ARRAY(Type.REAL(), {Dimension.fromInteger(listLength(listHead(values)))}); + expl := list(ARRAY(ty, list(REAL(v) for v in row)) for row in values); + ty := Type.liftArrayLeft(ty, Dimension.fromInteger(listLength(expl))); + exp := ARRAY(ty, expl); + end if; + end makeRealMatrix; + function applySubscripts "Subscripts an expression with the given list of subscripts." input list subscripts; @@ -3113,6 +3157,13 @@ public end match; end arrayScalarElements_impl; + function arrayScalarElement + input Expression arrayExp; + output Expression scalarExp; + algorithm + ARRAY(elements = {scalarExp}) := arrayExp; + end arrayScalarElement; + function hasArrayCall "Returns true if the given expression contains a function call that returns an array, otherwise false." @@ -3460,5 +3511,34 @@ public end match; end tupleElement; + function splitRecord + input Expression recordExp; + output list recordFields; + algorithm + recordFields := match recordExp + local + InstNode cls; + array comps; + ComponentRef cr, field_cr; + Type ty; + + case RECORD() then recordExp.elements; + + case CREF(ty = Type.COMPLEX(cls = cls), cref = cr) + algorithm + comps := ClassTree.getComponents(Class.classTree(InstNode.getClass(cls))); + recordFields := {}; + + for i in arrayLength(comps):-1:1 loop + ty := InstNode.getType(comps[i]); + field_cr := ComponentRef.prefixCref(comps[i], ty, {}, cr); + recordFields := CREF(ty, field_cr) :: recordFields; + end for; + then + recordFields; + + end match; + end splitRecord; + annotation(__OpenModelica_Interface="frontend"); end NFExpression; diff --git a/Compiler/boot/LoadCompilerSources.mos b/Compiler/boot/LoadCompilerSources.mos index ffe51926c61..9f0df8d9dbd 100644 --- a/Compiler/boot/LoadCompilerSources.mos +++ b/Compiler/boot/LoadCompilerSources.mos @@ -308,6 +308,7 @@ if true then /* Suppress output */ "../NFFrontEnd/NFDimension.mo", "../NFFrontEnd/NFEquation.mo", "../NFFrontEnd/NFEvalFunction.mo", + "../NFFrontEnd/NFEvalFunctionExt.mo", "../NFFrontEnd/NFExpandExp.mo", "../NFFrontEnd/NFExpression.mo", "../NFFrontEnd/NFExpressionIterator.mo",