diff --git a/LICENSE.md b/LICENSE.md index cc357e9..669ffe7 100644 --- a/LICENSE.md +++ b/LICENSE.md @@ -1,14 +1,14 @@ -Copyright (c) 2000- Markus Mottl -Copyright (c) 2000- Christophe Troestler - -Copyright (c) 2000-2012 Egbert Ammicht -Copyright (c) 2000-2012 Patrick Cousot -Copyright (c) 2000-2012 Sam Ehrlichman -Copyright (c) 2000-2012 Jane Street Capital LLC -Copyright (c) 2000-2012 Florent Hoareau -Copyright (c) 2000-2012 Liam Stewart -Copyright (c) 2000-2012 Oleg Trott -Copyright (c) 2000-2012 Martin Willensdorfer +Copyright © 2000- Markus Mottl +Copyright © 2000- Christophe Troestler + +Copyright © 2000-2012 Egbert Ammicht +Copyright © 2000-2012 Patrick Cousot +Copyright © 2000-2012 Sam Ehrlichman +Copyright © 2000-2012 Jane Street Capital LLC +Copyright © 2000-2012 Florent Hoareau +Copyright © 2000-2012 Liam Stewart +Copyright © 2000-2012 Oleg Trott +Copyright © 2000-2012 Martin Willensdorfer The Library is distributed under the terms of the GNU Lesser General Public License version 2.1 (included below). @@ -22,7 +22,7 @@ requirements listed in clause 6 of the GNU Lesser General Public License. By "a publicly distributed version of the Library", we mean either the unmodified Library as distributed by the authors, or a modified version of the Library that is distributed under the conditions defined in clause -2 of the GNU Lesser General Public License. This exception does not +3 of the GNU Lesser General Public License. This exception does not however invalidate any other reasons why the executable file might be covered by the GNU Lesser General Public License. diff --git a/dune b/dune index 9ebc4da..5620e30 100644 --- a/dune +++ b/dune @@ -1,7 +1,9 @@ (env - (dev - (flags (:standard -w -9 -principal)) - (c_flags - (:standard -Wall -pedantic -Wno-strict-prototypes -Wextra -Wunused))) - (release (ocamlopt_flags (:standard -O3))) -) + (dev + (flags + (:standard -w -9 -principal)) + (c_flags + (:standard -Wall -pedantic -Wno-strict-prototypes -Wextra -Wunused))) + (release + (ocamlopt_flags + (:standard -O3)))) diff --git a/examples/blas.ml b/examples/blas.ml index 4aefd84..0ee7428 100644 --- a/examples/blas.ml +++ b/examples/blas.ml @@ -1,32 +1,27 @@ (* File: blas.ml - Copyright (C) 2004- + Copyright © 2004- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl email: markus.mottl@gmail.com WWW: http://www.ocaml.info - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://www.umh.ac.be/math/an/ + Christophe Troestler email: Christophe.Troestler@umons.ac.be WWW: + http://www.umh.ac.be/math/an/ - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) open Format - open Lacaml.D open Lacaml.Io @@ -53,18 +48,8 @@ let () = printf "y <- x@\n@\n"; printf "y = @[%a@]@\n@\n" pp_rfvec (copy ~y x); - let a = - Mat.of_array - [| - [| 2.; 3. |]; - [| 1.; -5. |]; - |] in - let b = - Mat.of_array - [| - [| 4.; 3.; 6. |]; - [| 1.; -2.; 3. |]; - |] in + let a = Mat.of_array [| [| 2.; 3. |]; [| 1.; -5. |] |] in + let b = Mat.of_array [| [| 4.; 3.; 6. |]; [| 1.; -2.; 3. |] |] in let c = gemm ~transa:`T a b in diff --git a/examples/dune b/examples/dune index a006d23..1dbb601 100644 --- a/examples/dune +++ b/examples/dune @@ -1,28 +1,6 @@ (executables - (names - blas - eig - gbsv - lin_eq - lin_eq_comp - lin_reg - nag_gbsv - nag_gesv - nag_gtsv - nag_pbsv - nag_posv - nag_ppsv - nag_ptsv - nag_spsv - nag_sysv - qr - sbev - sbgv - schur_complex - schur_real - shuffle - svd - ) - (libraries lacaml) - (modes byte exe) -) + (names blas eig gbsv lin_eq lin_eq_comp lin_reg nag_gbsv nag_gesv nag_gtsv + nag_pbsv nag_posv nag_ppsv nag_ptsv nag_spsv nag_sysv qr sbev sbgv + schur_complex schur_real shuffle svd) + (libraries lacaml) + (modes byte exe)) diff --git a/examples/eig.ml b/examples/eig.ml index f0a770b..9ac578b 100644 --- a/examples/eig.ml +++ b/examples/eig.ml @@ -1,36 +1,29 @@ (* File: eig.ml - Copyright (C) 2004- + Copyright © 2004- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl email: markus.mottl@gmail.com WWW: http://www.ocaml.info - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://www.umh.ac.be/math/an/ + Christophe Troestler email: Christophe.Troestler@umons.ac.be WWW: + http://www.umh.ac.be/math/an/ - Oleg Trott - email: ot14@columbia.edu - WWW: http://www.columbia.edu/~ot14 + Oleg Trott email: ot14@columbia.edu WWW: http://www.columbia.edu/~ot14 - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) open Format - open Lacaml.Io (* SYEV DEMO *) @@ -45,11 +38,12 @@ let () = printf "@[<2>Symmetric real matrix A =@\n@\n@[%a@]@]@\n@\n" pp_fmat a; let w = syev a_copy in - printf "\ - @[<2>Eigenvalues: W = @[%a@]@]@\n@\n\ - ----------------------------------------------------------------------@\n\ - @\n" pp_rfvec w - + printf + "@[<2>Eigenvalues: W = @[%a@]@]@\n\ + @\n\ + ----------------------------------------------------------------------@\n\ + @\n" + pp_rfvec w (* GEEV DEMO *) @@ -64,8 +58,9 @@ let () = done; (* All unperturbed eigenvalues are zero *) - a.{n, 1} <- 1e-5; (* perturbation, try this: n >> 1 *) + a.{n, 1} <- 1e-5; + (* perturbation, try this: n >> 1 *) let a_copy = lacpy a in printf "@[<2>General real matrix A =@\n@\n@[%a@]@]@\n@\n" pp_fmat a; @@ -75,11 +70,14 @@ let () = printf "@[<2>Eigenvalues: WR =@\n@\n@[%a@]@]@\n@\n" pp_rfvec wr; printf "@[<2>Eigenvalues: WI =@\n@\n@[%a@]@]@\n@\n" pp_rfvec wi; - printf "\ - @[<2>Matrix VR =@\n@\n@[%a@]@]@\n@\n\ - ----------------------------------------------------------------------@\n\ - @\n" pp_fmat right - + printf + "@[<2>Matrix VR =@\n\ + @\n\ + @[%a@]@]@\n\ + @\n\ + ----------------------------------------------------------------------@\n\ + @\n" + pp_fmat right (* CGEEV DEMO *) @@ -88,10 +86,9 @@ let () = let n = 3 in let a = - Mat.random - ~re_from:(-500.) ~re_range:1000. - ~im_from:(-500.) ~im_range:1000. - n n in + Mat.random ~re_from:(-500.) ~re_range:1000. ~im_from:(-500.) ~im_range:1000. + n n + in let a_copy = lacpy a in printf "@[<2>General complex matrix A =@\n@\n@[%a@]@]@\n@\n" pp_cmat a; diff --git a/examples/gbsv.ml b/examples/gbsv.ml index b19c69f..c82684a 100644 --- a/examples/gbsv.ml +++ b/examples/gbsv.ml @@ -1,36 +1,29 @@ (* File: lin_eq.ml - Copyright (C) 2004- + Copyright © 2004- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl email: markus.mottl@gmail.com WWW: http://www.ocaml.info - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://www.umh.ac.be/math/an/ + Christophe Troestler email: Christophe.Troestler@umons.ac.be WWW: + http://www.umh.ac.be/math/an/ - Oleg Trott - email: ot14@columbia.edu - WWW: http://www.columbia.edu/~ot14 + Oleg Trott email: ot14@columbia.edu WWW: http://www.columbia.edu/~ot14 - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) open Format - open Lacaml.D open Lacaml.Io @@ -38,7 +31,7 @@ let () = let n = 10 in let kl = 2 and ku = 1 in let row = 2 in - let ab = Mat.random ~from:(-500.) ~range:1000. (2 * kl + ku + row) n in + let ab = Mat.random ~from:(-500.) ~range:1000. ((2 * kl) + ku + row) n in let b = Vec.random n in let sol = copy b in gbsv (lacpy ab) kl ku ~abr:row (Mat.from_col_vec sol); diff --git a/examples/lin_eq.ml b/examples/lin_eq.ml index 0333014..6469788 100644 --- a/examples/lin_eq.ml +++ b/examples/lin_eq.ml @@ -1,37 +1,30 @@ (* File: lin_eq.ml - Copyright (C) 2004- + Copyright © 2004- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl email: markus.mottl@gmail.com WWW: http://www.ocaml.info - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://www.umh.ac.be/math/an/ + Christophe Troestler email: Christophe.Troestler@umons.ac.be WWW: + http://www.umh.ac.be/math/an/ - Oleg Trott - email: ot14@columbia.edu - WWW: http://www.columbia.edu/~ot14 + Oleg Trott email: ot14@columbia.edu WWW: http://www.columbia.edu/~ot14 - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) open Format open Bigarray - open Lacaml.D open Lacaml.Io @@ -60,20 +53,22 @@ let () = gbsv a_copy kl ku b_copy; let sol = Mat.col b_copy 1 in let a' = Mat.create (kl + ku + 1) n in - (* [a'] is the real band matrix of the system, the first [kl] - rows of [a] are ignored. *) + (* [a'] is the real band matrix of the system, the first [kl] rows of [a] are + ignored. *) for i = 1 to kl + ku + 1 do for j = 1 to n do - a'.{i,j} <- a.{kl + i, j} - done; + a'.{i, j} <- a.{kl + i, j} + done done; printf "@[<2>Matrix A with band (kl = 1, ku = 2):@\n@\n"; printf "Sol: X = @[%a@]@\n" pp_rfvec sol; printf " A X = %a@]@\n@\n" pp_rfvec (gbmv a' kl ku sol); for i = 1 to n do - a.{1, i} <- 1.; (* 1 upper diag => kd = 1 *) - a.{2, i} <- 4.; (* main diag *) + a.{1, i} <- 1.; + (* 1 upper diag => kd = 1 *) + a.{2, i} <- 4. + (* main diag *) (* the other rows of [a] are irrelevant *) done; Array2.blit a a_copy; @@ -83,4 +78,4 @@ let () = let sol = Mat.col b_copy 1 in printf "@[<2>Symmetric positive definite matrix (not displayed):@\n@\n"; printf "Sol: X = @[%a@]@\n" pp_rfvec sol; - printf " A X = %a@]@\n" pp_rfvec (sbmv a ~k:kd sol); + printf " A X = %a@]@\n" pp_rfvec (sbmv a ~k:kd sol) diff --git a/examples/lin_eq_comp.ml b/examples/lin_eq_comp.ml index a5c6542..2e4bfa6 100644 --- a/examples/lin_eq_comp.ml +++ b/examples/lin_eq_comp.ml @@ -1,48 +1,36 @@ (* File: lin_eq_comp.ml - Copyright (C) 2004- + Copyright © 2004- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl email: markus.mottl@gmail.com WWW: http://www.ocaml.info - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://www.umh.ac.be/math/an/ + Christophe Troestler email: Christophe.Troestler@umons.ac.be WWW: + http://www.umh.ac.be/math/an/ - Oleg Trott - email: ot14@columbia.edu - WWW: http://www.columbia.edu/~ot14 + Oleg Trott email: ot14@columbia.edu WWW: http://www.columbia.edu/~ot14 - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) open Format - open Lacaml.D open Lacaml.Io let pp_space ppf = pp_print_string ppf " " let () = - let ar = - [| - [| 1.; 2.; 2.; |]; - [| 4.; 4.; 2.; |]; - [| 5.; 6.; 4.; |]; - |] in + let ar = [| [| 1.; 2.; 2. |]; [| 4.; 4.; 2. |]; [| 5.; 6.; 4. |] |] in let a = Mat.of_array ar in printf "@[<2>General matrix A = @[%a@]@]@\n@\n" pp_fmat a; @@ -75,13 +63,9 @@ let () = printf "rcond(A,O) = %g@\n" rcondO; printf "rcond(A,I) = %g@\n@\n" rcondI; - let b_ar = - [| - [| 21.; 32.; 41.; |]; - [| 32.; 54.; 71.; |]; - [| 41.; 71.; 94.; |]; - |] in + [| [| 21.; 32.; 41. |]; [| 32.; 54.; 71. |]; [| 41.; 71.; 94. |] |] + in let b = Mat.of_array b_ar in diff --git a/examples/lin_reg.ml b/examples/lin_reg.ml index 63ecc94..1752f30 100644 --- a/examples/lin_reg.ml +++ b/examples/lin_reg.ml @@ -1,28 +1,24 @@ (* File: lin_reg.ml - Copyright (C) 2001-2005 + Copyright © 2001-2005 - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl email: markus.mottl@gmail.com WWW: http://www.ocaml.info - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) open Format - open Lacaml.D open Lacaml.Io @@ -41,47 +37,34 @@ let () = for j = 1 to n do let randf = Random.float 200.0 -. 100.0 in - v_ref := !v_ref +. float j *. randf; + v_ref := !v_ref +. (float j *. randf); data_mat.{i, j} <- randf; - data_mat_copy.{i, j} <- randf; + data_mat_copy.{i, j} <- randf done; let v = !v_ref in res_mat.{i, 1} <- v; - res_mat_copy.{i, 1} <- v; + res_mat_copy.{i, 1} <- v done; printf - "\ - @[<2>Predictor variables:\n\ - @\n\ - %a@]\n\ - @\n\ - @[<2>Response variable:\n\ - @\n\ - %a@]@\n\ - @\n" - pp_fmat data_mat - pp_rfvec (Mat.col res_mat 1); + "@[<2>Predictor variables:\n\ + @\n\ + %a@]\n\ + @\n\ + @[<2>Response variable:\n\ + @\n\ + %a@]@\n\ + @\n" + pp_fmat data_mat pp_rfvec (Mat.col res_mat 1); let rank = gelsd data_mat res_mat in - printf - "\ - @[<2>Regression weights:\n\ - @\n\ - %a@]\n\ - @\n\ - Rank: %d@\n@\n" - pp_rfvec (Mat.col res_mat 1) - rank; + printf "@[<2>Regression weights:\n@\n%a@]\n@\nRank: %d@\n@\n" pp_rfvec + (Mat.col res_mat 1) rank; let y = gemv data_mat_copy (Mat.col res_mat 1) in let b = Mat.col res_mat_copy 1 in - printf - "\ - @[<2>Check result (must be close to 0):\n\ - @\n\ - %a@]@\n" - pp_rfvec (Vec.sub y b) + printf "@[<2>Check result (must be close to 0):\n@\n%a@]@\n" pp_rfvec + (Vec.sub y b) diff --git a/examples/nag_gbsv.ml b/examples/nag_gbsv.ml index 79c719b..70d81a6 100644 --- a/examples/nag_gbsv.ml +++ b/examples/nag_gbsv.ml @@ -1,51 +1,55 @@ (* File: nag_gbsv.ml - Copyright (C) 2013- + Copyright © 2013- - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://www.umh.ac.be/math/an/ + Christophe Troestler email: Christophe.Troestler@umons.ac.be WWW: + http://www.umh.ac.be/math/an/ - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) (* Example from http://www.nag.com/lapack-ex/node3.html *) open Format open Lacaml.D open Lacaml.Io -let a = Mat.of_array [| [| -0.23; 2.54; -3.66; 0. |]; - [| -6.98; 2.46; -2.73; -2.13 |]; - [| 0.; 2.56; 2.46; 4.07 |]; - [| 0.; 0.; -4.78; -3.82 |] |] -let kl = 1 and ku = 2 +let a = + Mat.of_array + [| + [| -0.23; 2.54; -3.66; 0. |]; + [| -6.98; 2.46; -2.73; -2.13 |]; + [| 0.; 2.56; 2.46; 4.07 |]; + [| 0.; 0.; -4.78; -3.82 |]; + |] -let b = Vec.of_array [| 4.42; 27.13; -6.14; 10.50 |] +let kl = 1 +and ku = 2 + +let b = Vec.of_array [| 4.42; 27.13; -6.14; 10.50 |] let () = (* The matrix [ab] must possess enough rows to hols its factorization. *) - let ab = Mat.create (2 * kl + ku + 1) (Mat.dim2 a) in - (* The initial matrix [a] must be stored in rows [lk+1] to - [2*kl+ku+1], in band storage. *) + let ab = Mat.create ((2 * kl) + ku + 1) (Mat.dim2 a) in + (* The initial matrix [a] must be stored in rows [lk+1] to [2*kl+ku+1], in + band storage. *) let n = Mat.dim2 a in for j = 1 to n do for i = max 1 (j - ku) to min n (j + kl) do - ab.{kl+ku+1+i-j, j} <- a.{i,j} - done; + ab.{kl + ku + 1 + i - j, j} <- a.{i, j} + done done; (* Solve [a * x = b]. Solution in [x] (which must hold the RHS initially). *) let x = copy b in gbsv ab kl ku (Mat.from_col_vec x); - printf "Solution: X = @[%a@]@\n" pp_rfvec x; + printf "Solution: X = @[%a@]@\n" pp_rfvec x diff --git a/examples/nag_gesv.ml b/examples/nag_gesv.ml index 2331ec6..7f4d6ea 100644 --- a/examples/nag_gesv.ml +++ b/examples/nag_gesv.ml @@ -1,37 +1,39 @@ (* File: nag_gesv.ml - Copyright (C) 2013- + Copyright © 2013- - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://www.umh.ac.be/math/an/ + Christophe Troestler email: Christophe.Troestler@umons.ac.be WWW: + http://www.umh.ac.be/math/an/ - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) (* Example from http://www.nag.com/lapack-ex/node5.html *) open Format open Lacaml.D open Lacaml.Io -let a = Mat.of_array [| [| 1.80; 2.88; 2.05; -0.89 |]; - [| 5.25; -2.95; -0.95; -3.80 |]; - [| 1.58; -2.69; -2.90; -1.04 |]; - [|-1.11; -0.66; -0.59; 0.80 |] |] +let a = + Mat.of_array + [| + [| 1.80; 2.88; 2.05; -0.89 |]; + [| 5.25; -2.95; -0.95; -3.80 |]; + [| 1.58; -2.69; -2.90; -1.04 |]; + [| -1.11; -0.66; -0.59; 0.80 |]; + |] -let b = Vec.of_array [| 9.52; 24.35; 0.77; -6.22 |] +let b = Vec.of_array [| 9.52; 24.35; 0.77; -6.22 |] let () = (* Solves [a * x = b]. Solution in [x] which must initially hold [b]. *) @@ -41,4 +43,4 @@ let () = (* Print solution and details of factorisation. *) printf "Solution: X = @[%a@]@\n" pp_rfvec x; printf "Details of factorization: @[%a@]@\n" pp_fmat a; - printf "Pivot indices: @[%a@]@\n" pp_rivec ipiv; + printf "Pivot indices: @[%a@]@\n" pp_rivec ipiv diff --git a/examples/nag_gtsv.ml b/examples/nag_gtsv.ml index 87558d2..521ab07 100644 --- a/examples/nag_gtsv.ml +++ b/examples/nag_gtsv.ml @@ -1,25 +1,23 @@ (* File: nag_gtsv.ml - Copyright (C) 2013- + Copyright © 2013- - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://www.umh.ac.be/math/an/ + Christophe Troestler email: Christophe.Troestler@umons.ac.be WWW: + http://www.umh.ac.be/math/an/ - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) (* Example from http://www.nag.com/lapack-ex/node7.html *) open Format @@ -27,11 +25,10 @@ open Lacaml.D open Lacaml.Io (* Tridiagonal matrix. Upper, main, and lower diagonals. *) -let du = Vec.of_array [| 2.1; -1.0; 1.9; 8.0 |] -let d = Vec.of_array [| 3.0; 2.3; -5.0; -0.9; 7.1 |] -let dl = Vec.of_array [| 3.4; 3.6; 7.0; -6.0 |] - -let b= Vec.of_array [| 2.7; -0.5; 2.6; 0.6; 2.7 |] +let du = Vec.of_array [| 2.1; -1.0; 1.9; 8.0 |] +let d = Vec.of_array [| 3.0; 2.3; -5.0; -0.9; 7.1 |] +let dl = Vec.of_array [| 3.4; 3.6; 7.0; -6.0 |] +let b = Vec.of_array [| 2.7; -0.5; 2.6; 0.6; 2.7 |] let () = let x = copy b in diff --git a/examples/nag_pbsv.ml b/examples/nag_pbsv.ml index 1cc1794..317338f 100644 --- a/examples/nag_pbsv.ml +++ b/examples/nag_pbsv.ml @@ -1,43 +1,39 @@ (* File: nag_pbsv.ml - Copyright (C) 2013- + Copyright © 2013- - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://www.umh.ac.be/math/an/ + Christophe Troestler email: Christophe.Troestler@umons.ac.be WWW: + http://www.umh.ac.be/math/an/ - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) (* Example from http://www.nag.com/lapack-ex/node9.html *) open Format open Lacaml.D open Lacaml.Io -(* Symmetric positive definite band matrix. Only the upper triangle - of the matrix is stored (default behavior of [pbsv]). Each line - correspond to a diagonal, the columns being the same as the - original matrix. *) -let ab = Mat.of_array [| [| nan; 2.68; -2.39; -2.22 |]; - [| 5.49; 5.63; 2.60; 5.17 |] |] +(* Symmetric positive definite band matrix. Only the upper triangle of the + matrix is stored (default behavior of [pbsv]). Each line correspond to a + diagonal, the columns being the same as the original matrix. *) +let ab = + Mat.of_array [| [| nan; 2.68; -2.39; -2.22 |]; [| 5.49; 5.63; 2.60; 5.17 |] |] -let b = Vec.of_array [| 22.09; 9.31; -5.24; 11.83 |] +let b = Vec.of_array [| 22.09; 9.31; -5.24; 11.83 |] let () = let x = copy b in pbsv ab (Mat.from_col_vec x); printf "Solution: X = @[%a@]@\n" pp_rfvec x; - printf "Cholesky factor U (each line is a diagonal):@\n @[%a@]@\n" - pp_fmat ab + printf "Cholesky factor U (each line is a diagonal):@\n @[%a@]@\n" pp_fmat ab diff --git a/examples/nag_posv.ml b/examples/nag_posv.ml index 91e1472..6b69f21 100644 --- a/examples/nag_posv.ml +++ b/examples/nag_posv.ml @@ -1,39 +1,41 @@ (* File: nag_posv.ml - Copyright (C) 2013- + Copyright © 2013- - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://www.umh.ac.be/math/an/ + Christophe Troestler email: Christophe.Troestler@umons.ac.be WWW: + http://www.umh.ac.be/math/an/ - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) (* Example from http://www.nag.com/lapack-ex/node11.html *) open Format open Lacaml.D open Lacaml.Io -(* Symmetric positive definite matrix. By default, [posv] only uses - the upper triangular part of the matrix. *) -let a = Mat.of_array [| [| 4.16; -3.12; 0.56; -0.10 |]; - [| nan; 5.03; -0.83; 1.18 |]; - [| nan; nan; 0.76; 0.34 |]; - [| nan; nan; nan; 1.18 |] |] - -let b = Vec.of_array [| 8.70; -13.35; 1.89; -4.14 |] +(* Symmetric positive definite matrix. By default, [posv] only uses the upper + triangular part of the matrix. *) +let a = + Mat.of_array + [| + [| 4.16; -3.12; 0.56; -0.10 |]; + [| nan; 5.03; -0.83; 1.18 |]; + [| nan; nan; 0.76; 0.34 |]; + [| nan; nan; nan; 1.18 |]; + |] + +let b = Vec.of_array [| 8.70; -13.35; 1.89; -4.14 |] let () = let x = copy b in diff --git a/examples/nag_ppsv.ml b/examples/nag_ppsv.ml index 2e97866..5aeffeb 100644 --- a/examples/nag_ppsv.ml +++ b/examples/nag_ppsv.ml @@ -1,53 +1,63 @@ (* File: nag_ppsv.ml - Copyright (C) 2013- + Copyright © 2013- - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://www.umh.ac.be/math/an/ + Christophe Troestler email: Christophe.Troestler@umons.ac.be WWW: + http://www.umh.ac.be/math/an/ - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) (* Example from http://www.nag.com/lapack-ex/node13.html *) open Format open Lacaml.D open Lacaml.Io -(* Symmetric positive definite matrix stored in packed format. Only - the upper triangle is stored (default for [ppsv]). *) -let ap = Vec.of_array [| 4.16; (* col 1 *) - -3.12; 5.03; (* col 2 *) - 0.56; -0.83; 0.76; (* col 3 *) - -0.10; 1.18; 0.34; 1.18 (* col 4 *) |] - -let b = Vec.of_array [| 8.70; -13.35; 1.89; -4.14 |] - +(* Symmetric positive definite matrix stored in packed format. Only the upper + triangle is stored (default for [ppsv]). *) +let ap = + Vec.of_array + [| + 4.16; + (* col 1 *) + -3.12; + 5.03; + (* col 2 *) + 0.56; + -0.83; + 0.76; + (* col 3 *) + -0.10; + 1.18; + 0.34; + 1.18 (* col 4 *); + |] + +let b = Vec.of_array [| 8.70; -13.35; 1.89; -4.14 |] let () = let x = copy b in ppsv ap (Mat.from_col_vec x); printf "Solution: X = @[%a@]@\n" pp_rfvec x; (* Store [ap] in a full matrix for display. *) - let n = truncate(sqrt(float(2 * Vec.dim ap))) in + let n = truncate (sqrt (float (2 * Vec.dim ap))) in let a = Mat.make n n nan in for j = 1 to n do for i = 1 to j do - a.{i,j} <- ap.{i + ((j-1) * j) / 2} - done; + a.{i, j} <- ap.{i + ((j - 1) * j / 2)} + done done; (* Print the matrix but not the NaN. *) - pp_float_el_default := (fun fm x -> if (x: float) = x then fprintf fm "%G" x); + (pp_float_el_default := fun fm x -> if (x : float) = x then fprintf fm "%G" x); printf "Cholesky factor U: @[%a@]@\n" pp_fmat a diff --git a/examples/nag_ptsv.ml b/examples/nag_ptsv.ml index 5b22b2c..a555bc9 100644 --- a/examples/nag_ptsv.ml +++ b/examples/nag_ptsv.ml @@ -1,37 +1,34 @@ (* File: nag_ptsv.ml - Copyright (C) 2013- + Copyright © 2013- - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://www.umh.ac.be/math/an/ + Christophe Troestler email: Christophe.Troestler@umons.ac.be WWW: + http://www.umh.ac.be/math/an/ - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) (* Example from http://www.nag.com/lapack-ex/node15.html *) open Format open Lacaml.D open Lacaml.Io -(* Symmetric positive definite tridiagonal matrix. [d] is the - diagonal and [e] the sub-diagonal. *) -let d = Vec.of_array [| 4.0; 10.0; 29.0; 25.0; 5.0 |] -let e = Vec.of_array [| -2.0; -6.0; 15.0; 8.0 |] - -let b = Vec.of_array [| 6.0; 9.0; 2.0; 14.0; 7.0 |] +(* Symmetric positive definite tridiagonal matrix. [d] is the diagonal and [e] + the sub-diagonal. *) +let d = Vec.of_array [| 4.0; 10.0; 29.0; 25.0; 5.0 |] +let e = Vec.of_array [| -2.0; -6.0; 15.0; 8.0 |] +let b = Vec.of_array [| 6.0; 9.0; 2.0; 14.0; 7.0 |] let () = let x = copy b in diff --git a/examples/nag_spsv.ml b/examples/nag_spsv.ml index 24156fc..7f336e2 100644 --- a/examples/nag_spsv.ml +++ b/examples/nag_spsv.ml @@ -1,56 +1,67 @@ (* File: nag_spsv.ml - Copyright (C) 2013- + Copyright © 2013- - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://www.umh.ac.be/math/an/ + Christophe Troestler email: Christophe.Troestler@umons.ac.be WWW: + http://www.umh.ac.be/math/an/ - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) (* Example from http://www.nag.com/lapack-ex/node17.html *) open Format open Lacaml.D open Lacaml.Io -(* Symmetric matrix stored in packed format. Only the upper triangle - is used by default by [spsv]. *) -let ap = Vec.of_array [| -1.81; (* col 1 *) - 2.06; 1.15; (* col 2 *) - 0.63; 1.87; -0.21; (* col 3 *) - -1.15; 4.20; 3.87; 2.07 (* col 4 *) |] - -let b = Vec.of_array [| 0.96; 6.07; 8.38; 9.50 |] +(* Symmetric matrix stored in packed format. Only the upper triangle is used by + default by [spsv]. *) +let ap = + Vec.of_array + [| + -1.81; + (* col 1 *) + 2.06; + 1.15; + (* col 2 *) + 0.63; + 1.87; + -0.21; + (* col 3 *) + -1.15; + 4.20; + 3.87; + 2.07 (* col 4 *); + |] +let b = Vec.of_array [| 0.96; 6.07; 8.38; 9.50 |] let () = let x = copy b in - let n = truncate(sqrt(float(2 * Vec.dim ap))) in + let n = truncate (sqrt (float (2 * Vec.dim ap))) in let ipiv = Lacaml.Common.create_int32_vec n in - spsv ap (Mat.from_col_vec x) ~ipiv; (* [ipiv] is optional *) + spsv ap (Mat.from_col_vec x) ~ipiv; + (* [ipiv] is optional *) printf "Solution: X = @[%a@]@\n" pp_rfvec x; (* Store [ap] in a full matrix for display. *) let a = Mat.make n n nan in for j = 1 to n do for i = 1 to j do - a.{i,j} <- ap.{i + ((j-1) * j) / 2} - done; + a.{i, j} <- ap.{i + ((j - 1) * j / 2)} + done done; (* Print the matrix but not the NaN. *) - pp_float_el_default := (fun fm x -> if (x: float) = x then fprintf fm "%G" x); + (pp_float_el_default := fun fm x -> if (x : float) = x then fprintf fm "%G" x); printf "Details of the factorization: @[%a@]@\n" pp_fmat a; printf "Pivot indices: @[%a@]@\n" pp_rivec ipiv diff --git a/examples/nag_sysv.ml b/examples/nag_sysv.ml index 5b20c8a..ca22986 100644 --- a/examples/nag_sysv.ml +++ b/examples/nag_sysv.ml @@ -1,46 +1,49 @@ (* File: nag_sysv.ml - Copyright (C) 2013- + Copyright © 2013- - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://www.umh.ac.be/math/an/ + Christophe Troestler email: Christophe.Troestler@umons.ac.be WWW: + http://www.umh.ac.be/math/an/ - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) (* Example from http://www.nag.com/lapack-ex/node19.html *) open Format open Lacaml.D open Lacaml.Io -(* Symmetric matrix. [sysv] only reference the upper triangle by default. *) -let a = Mat.of_array [| [| -1.81; 2.06; 0.63; -1.15 |]; - [| nan; 1.15; 1.87; 4.20 |]; - [| nan; nan; -0.21; 3.87 |]; - [| nan; nan; nan; 2.07 |] |] +(* Symmetric matrix. [sysv] only reference the upper triangle by default. *) +let a = + Mat.of_array + [| + [| -1.81; 2.06; 0.63; -1.15 |]; + [| nan; 1.15; 1.87; 4.20 |]; + [| nan; nan; -0.21; 3.87 |]; + [| nan; nan; nan; 2.07 |]; + |] -let b = Vec.of_array [| 0.96; 6.07; 8.38; 9.50 |] +let b = Vec.of_array [| 0.96; 6.07; 8.38; 9.50 |] let () = let x = copy b in let ipiv = Lacaml.Common.create_int32_vec (Mat.dim1 a) in - sysv a (Mat.from_col_vec x) ~ipiv; (* [ipiv] is optional *) + sysv a (Mat.from_col_vec x) ~ipiv; + (* [ipiv] is optional *) printf "Solution: X = @[%a@]@\n" pp_rfvec x; (* Print the matrix but not the NaN entries. *) - pp_float_el_default := (fun fm x -> if (x: float) = x then fprintf fm "%G" x); + (pp_float_el_default := fun fm x -> if (x : float) = x then fprintf fm "%G" x); printf "Details of the factorization: @[%a@]@\n" pp_fmat a; printf "Pivot indices: @[%a@]@\n" pp_rivec ipiv diff --git a/examples/qr.ml b/examples/qr.ml index d8e0608..803a89a 100644 --- a/examples/qr.ml +++ b/examples/qr.ml @@ -1,28 +1,24 @@ (* File: qr.ml - Copyright (C) 2009- + Copyright © 2009- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl email: markus.mottl@gmail.com WWW: http://www.ocaml.info - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) open Format - open Lacaml.D let () = diff --git a/examples/run_examples.sh b/examples/run_examples.sh index 6ae867b..c9add8f 100755 --- a/examples/run_examples.sh +++ b/examples/run_examples.sh @@ -1,12 +1,12 @@ -#!/bin/bash +#!/usr/bin/env bash -set -e +set -eu -dune build `echo *.ml | sed -e 's/.ml/.exe/g'` +dune build "${@/%.ml/.exe}" for file in *.ml; do - ex=`basename $file .ml` + ex=$(basename "$file" .ml) exexec=$ex.exe - echo TESTING $dir/$ex ================================================== - ../_build/default/examples/$dir/$exexec + echo TESTING "$ex" ================================================== + ../_build/default/examples/"$exexec" done diff --git a/examples/sbev.ml b/examples/sbev.ml index dafbf8d..68290e6 100644 --- a/examples/sbev.ml +++ b/examples/sbev.ml @@ -1,37 +1,39 @@ (* File: sbev.ml - Copyright (C) 2011- + Copyright © 2011- - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umons.ac.be/an/ + Christophe Troestler email: Christophe.Troestler@umons.ac.be WWW: + http://math.umons.ac.be/an/ - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) (** Example based on http://www.nag.co.uk/lapack-ex/node61.html *) open Format - open Lacaml.D open Lacaml.Io -let a = Mat.of_array - [| [| nan; nan; 3.; 4.; 5. |]; - [| nan; 2.; 3.; 4.; 5. |]; (* above diag *) - [| 1.; 2.; 3.; 4.; 5. |] |] (* diag *) +let a = + Mat.of_array + [| + [| nan; nan; 3.; 4.; 5. |]; + [| nan; 2.; 3.; 4.; 5. |]; + (* above diag *) + [| 1.; 2.; 3.; 4.; 5. |]; + |] +(* diag *) let () = let z = Mat.create 5 5 in diff --git a/examples/sbgv.ml b/examples/sbgv.ml index eb0d14d..c74536e 100644 --- a/examples/sbgv.ml +++ b/examples/sbgv.ml @@ -1,38 +1,42 @@ (* File: eig.ml - Copyright (C) 2010- + Copyright © 2010- - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umons.ac.be/an/ + Christophe Troestler email: Christophe.Troestler@umons.ac.be WWW: + http://math.umons.ac.be/an/ - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) (** Example based on http://www.nag.co.uk/lapack-ex/node97.html *) open Format - open Lacaml.D open Lacaml.Io -let a = Mat.of_array [| [| nan; nan; 0.42; 0.63 |]; - [| nan; 0.39; 0.79; 0.48 |]; (* above diag *) - [| 0.24; -0.11; -0.25; -0.03 |] |] (* diag *) -let b = Mat.of_array [| [| nan; 0.95; -0.29; -0.33 |]; - [| 2.07; 1.69; 0.65; 1.17 |] |] +let a = + Mat.of_array + [| + [| nan; nan; 0.42; 0.63 |]; + [| nan; 0.39; 0.79; 0.48 |]; + (* above diag *) + [| 0.24; -0.11; -0.25; -0.03 |]; + |] +(* diag *) + +let b = + Mat.of_array [| [| nan; 0.95; -0.29; -0.33 |]; [| 2.07; 1.69; 0.65; 1.17 |] |] let () = let eig = sbgv a b in diff --git a/examples/schur_complex.ml b/examples/schur_complex.ml index d052f34..4753f04 100644 --- a/examples/schur_complex.ml +++ b/examples/schur_complex.ml @@ -1,29 +1,24 @@ (* File: schur.ml - Copyright (C) 2015- + Copyright © 2015- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl email: markus.mottl@gmail.com WWW: http://www.ocaml.info - Florent Hoareau - email: h.florent@gmail.com - WWW: none + Florent Hoareau email: h.florent@gmail.com WWW: none - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) open Format open Lacaml.Io @@ -35,9 +30,8 @@ let () = let n = 5 in let a = - Mat.random - ~re_from:(-500.) ~re_range:1000. - ~im_from:(-500.) ~im_range:1000. n n + Mat.random ~re_from:(-500.) ~re_range:1000. ~im_from:(-500.) ~im_range:1000. + n n in let a_res = lacpy a in diff --git a/examples/schur_real.ml b/examples/schur_real.ml index 161537f..8ac756b 100644 --- a/examples/schur_real.ml +++ b/examples/schur_real.ml @@ -1,29 +1,24 @@ (* File: schur.ml - Copyright (C) 2015- - - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info - - Florent Hoareau - email: h.florent@gmail.com - WWW: none - - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. - - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + Copyright © 2015- + + Markus Mottl email: markus.mottl@gmail.com WWW: http://www.ocaml.info + + Florent Hoareau email: h.florent@gmail.com WWW: none + + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. + + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. + + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) open Format open Lacaml.Io diff --git a/examples/shuffle.ml b/examples/shuffle.ml index aeeaa73..b910aed 100644 --- a/examples/shuffle.ml +++ b/examples/shuffle.ml @@ -1,5 +1,4 @@ open Format - open Lacaml.D open Lacaml.Io open Bigarray @@ -23,8 +22,8 @@ let shuffle n = arr let to_vec arr = - Array1.of_array int32 fortran_layout ( - Array.map (fun i -> Int32.of_int (i + 1)) arr) + Array1.of_array int32 fortran_layout + (Array.map (fun i -> Int32.of_int (i + 1)) arr) let () = let r = 10 in @@ -35,7 +34,12 @@ let () = laswp m ipiv; printf "After: m = @[%a@]@\n@\n" pp_fmat m; let m = Mat.random 3 r in - let k = to_vec (let a = reordered r in a.(3) <- 3; a) in + let k = + to_vec + (let a = reordered r in + a.(3) <- 3; + a) + in (* [forward = false] may segfault on my platform - probably a vendor library bug *) let forward = true in @@ -44,4 +48,4 @@ let () = (if forward then "forward" else "backward") pp_ivec k; lapmt ~forward m k; - printf "After: m = @[%a@]@\n@\n" pp_fmat m; + printf "After: m = @[%a@]@\n@\n" pp_fmat m diff --git a/examples/svd.ml b/examples/svd.ml index d64d40c..ae754fd 100644 --- a/examples/svd.ml +++ b/examples/svd.ml @@ -1,32 +1,26 @@ (* File: svd.ml - Copyright (C) 2004-2005 + Copyright © 2004-2005 - Egbert Ammicht - email: eammicht@lucent.com + Egbert Ammicht email: eammicht@lucent.com - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl email: markus.mottl@gmail.com WWW: http://www.ocaml.info - Liam Stewart - email: liam@cs.toronto.edu - WWW: http://www.cs.toronto.edu/~liam + Liam Stewart email: liam@cs.toronto.edu WWW: http://www.cs.toronto.edu/~liam - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) open Format open Lacaml.Io @@ -43,7 +37,6 @@ let () = printf "@[<2>Matrix U = @[%a@]@]@\n@\n" pp_fmat u; printf "@[<2>Matrix VT = @[%a@]@]@\n" pp_fmat vt - (* COMPLEX GESVD DEMO *) let () = diff --git a/src/CZ.ml b/src/CZ.ml index 67a6d04..f0e7dea 100644 --- a/src/CZ.ml +++ b/src/CZ.ml @@ -1,37 +1,30 @@ (* File: CZ.ml - Copyright (C) 2001- + Copyright © 2001- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umh.ac.be/an/ + Christophe Troestler - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) -(** Modules with functions specialized for simple (C) or double (Z) - precision complex numbers. *) +(** Modules with functions specialized for simple (C) or double (Z) precision + complex numbers. *) include Complexxx - include Complex_io - include Impl2_CPREC include Impl4_CPREC diff --git a/src/CZ.mli b/src/CZ.mli index 9cd0ce5..1032516 100644 --- a/src/CZ.mli +++ b/src/CZ.mli @@ -1,33 +1,32 @@ (* File: CZ.mli - Copyright (C) 2010- - - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umons.ac.be/an/ - - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. - - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) - -(** This module [Lacaml.CPREC] contains linear algebra routines for - complex numbers (precision: complexxx). It is recommended to use this - module by writing + Copyright © 2001- + + Markus Mottl + + Christophe Troestler + + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. + + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. + + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) + +(** This module [Lacaml.CPREC] contains linear algebra routines for complex + numbers (precision: complexxx). It is recommended to use this module by + writing {[ - open Lacaml.CPREC + open Lacaml.CPREC ]} - at the top of your file. *) + at the top of your file. *) open Bigarray @@ -47,8 +46,8 @@ type trans3 = [ `C | `N | `T ] (** Transpose parameter (conjugate transposed, normal, or transposed). *) val prec : (Complex.t, complexxx_elt) Bigarray.kind -(** Precision for this submodule {!CPREC}. Allows to write precision - independent code. *) +(** Precision for this submodule {!CPREC}. Allows to write precision independent + code. *) module Vec : sig type t = vec @@ -65,6 +64,5 @@ module Mat : sig end include module type of Complex_io - include module type of Impl2_CPREC include module type of Impl4_CPREC diff --git a/src/SD.ml b/src/SD.ml index b99cf53..4c24f25 100644 --- a/src/SD.ml +++ b/src/SD.ml @@ -1,34 +1,31 @@ (* File: SD.ml - Copyright (C) 2010- + Copyright © 2001- - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umons.ac.be/an/ + Markus Mottl - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + Christophe Troestler - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. -(** Modules with functions specialized for simple (S) or double (D) - precision numbers. *) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) -include Floatxx +(** Modules with functions specialized for simple (S) or double (D) precision + numbers. *) +include Floatxx include Impl2_FPREC include Impl4_FPREC - include Real_io module Vec = struct diff --git a/src/SD.mli b/src/SD.mli index a66518d..56353e0 100644 --- a/src/SD.mli +++ b/src/SD.mli @@ -1,33 +1,31 @@ (* File: SD.mli - Copyright (C) 2010- - - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umons.ac.be/an/ - - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. - - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) - -(** This module [Lacaml.FPREC] contains linear algebra routines for - real numbers (precision: floatxx). It is recommended to use this - module by writing + Copyright © 2001- + + Markus Mottl + + Christophe Troestler + + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. + + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. + + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) + +(** This module [Lacaml.FPREC] contains linear algebra routines for real numbers + (precision: floatxx). It is recommended to use this module by writing {[ - open Lacaml.FPREC + open Lacaml.FPREC ]} - at the top of your file. *) + at the top of your file. *) open Bigarray @@ -43,12 +41,12 @@ type mat = (float, floatxx_elt, fortran_layout) Array2.t (** Matrices (precision: floatxx). *) type trans3 = [ `N | `T ] -(** Transpose parameter (normal or transposed). For complex matrices, - conjugate transpose is also offered, hence the name. *) +(** Transpose parameter (normal or transposed). For complex matrices, conjugate + transpose is also offered, hence the name. *) val prec : (float, floatxx_elt) Bigarray.kind -(** Precision for this submodule {!FPREC}. Allows to write precision - independent code. *) +(** Precision for this submodule {!FPREC}. Allows to write precision independent + code. *) module Vec : sig type t = vec @@ -65,6 +63,5 @@ module Mat : sig end include module type of Real_io - include module type of Impl2_FPREC include module type of Impl4_FPREC diff --git a/src/common.ml b/src/common.ml index 90095e4..975cfe1 100644 --- a/src/common.ml +++ b/src/common.ml @@ -1,37 +1,28 @@ (* File: common.ml - Copyright (C) 2001- + Copyright © 2001- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - Liam Stewart - email: liam@cs.toronto.edu - WWW: http://www.cs.toronto.edu/~liam + Liam Stewart - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umh.ac.be/an/ + Christophe Troestler - Florent Hoareau - email: h.florent@gmail.com - WWW: none + Florent Hoareau - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) open Bigarray @@ -53,80 +44,79 @@ type side = [ `L | `R ] type diag = [ `U | `N ] type norm2 = [ `O | `I ] type norm4 = [ `M | `O | `I | `F ] - type svd_job = [ `A | `S | `O | `N ] - type schur_vectors = [ `No_Schur_vectors | `Compute_Schur_vectors ] -type eigen_value_sort = [ - | `No_sort +type eigen_value_sort = + [ `No_sort | `Select_left_plane | `Select_right_plane | `Select_interior_disk | `Select_exterior_disk - | `Select_custom of Complex.t -> bool -] + | `Select_custom of Complex.t -> bool ] module Types = struct module Vec = struct type 'vec unop = - ?n : int -> - ?ofsy : int -> - ?incy : int -> - ?y : 'vec -> - ?ofsx : int -> - ?incx : int -> + ?n:int -> + ?ofsy:int -> + ?incy:int -> + ?y:'vec -> + ?ofsx:int -> + ?incx:int -> + 'vec -> 'vec - -> 'vec type 'vec binop = - ?n : int -> - ?ofsz : int -> - ?incz : int -> - ?z : 'vec -> - ?ofsx : int -> - ?incx : int -> + ?n:int -> + ?ofsz:int -> + ?incz:int -> + ?z:'vec -> + ?ofsx:int -> + ?incx:int -> + 'vec -> + ?ofsy:int -> + ?incy:int -> 'vec -> - ?ofsy : int -> - ?incy : int -> 'vec - -> 'vec - end (* Vec *) + end + (* Vec *) module Mat = struct - type patt = [ - | `Full (* Full matrix *) - | `Utr (* Upper triangular or trapezoidal matrix *) - | `Ltr (* lower triangular or trapezoidal matrix *) - | `Upent of int (* Initial full rows of pentagonal matrix *) - | `Lpent of int (* Initial full columns of pentagonal matrix *) - ] + type patt = + [ `Full (* Full matrix *) + | `Utr (* Upper triangular or trapezoidal matrix *) + | `Ltr (* lower triangular or trapezoidal matrix *) + | `Upent of int (* Initial full rows of pentagonal matrix *) + | `Lpent of int (* Initial full columns of pentagonal matrix *) ] type 'mat unop = - ?patt : patt -> - ?m : int -> - ?n : int -> - ?br : int -> - ?bc : int -> - ?b : 'mat -> - ?ar : int -> - ?ac : int -> + ?patt:patt -> + ?m:int -> + ?n:int -> + ?br:int -> + ?bc:int -> + ?b:'mat -> + ?ar:int -> + ?ac:int -> + 'mat -> 'mat - -> 'mat type 'mat binop = - ?patt : patt -> - ?m : int -> - ?n : int -> - ?cr : int -> - ?cc : int -> - ?c : 'mat -> - ?ar : int -> - ?ac : int -> + ?patt:patt -> + ?m:int -> + ?n:int -> + ?cr:int -> + ?cc:int -> + ?c:'mat -> + ?ar:int -> + ?ac:int -> + 'mat -> + ?br:int -> + ?bc:int -> 'mat -> - ?br : int -> - ?bc : int -> 'mat - -> 'mat - end (* Mat *) -end (* Types *) + end + (* Mat *) +end +(* Types *) diff --git a/src/common.mli b/src/common.mli index 648f0b6..efd94f4 100644 --- a/src/common.mli +++ b/src/common.mli @@ -1,33 +1,26 @@ (* File: common.mli - Copyright (C) 2001- + Copyright © 2001- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - Liam Stewart - email: liam@cs.toronto.edu - WWW: http://www.cs.toronto.edu/~liam + Liam Stewart - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umh.ac.be/an/ + Christophe Troestler - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) (** [Lacaml.common] contains definitions independent of the precision. *) @@ -55,14 +48,13 @@ type svd_job = [ `A | `S | `O | `N ] type schur_vectors = [ `No_Schur_vectors | `Compute_Schur_vectors ] (** GEES job option *) -type eigen_value_sort = [ - | `No_sort +type eigen_value_sort = + [ `No_sort | `Select_left_plane | `Select_right_plane | `Select_interior_disk | `Select_exterior_disk - | `Select_custom of Complex.t -> bool -] + | `Select_custom of Complex.t -> bool ] (** GEES eigenvalue sort option *) exception InternalError of string @@ -83,114 +75,98 @@ val create_int32_vec : int -> int32_vec val mat_from_vec : ('a, 'b, 'c) Array1.t -> ('a, 'b, 'c) Array2.t (** [mat_from_vec a] converts the vector [a] into a matrix with [Array1.dim a] - rows and 1 column. The data is shared between the two matrices. *) + rows and 1 column. The data is shared between the two matrices. *) (** Common types used for vector and matrix operations *) module Types : sig module Vec : sig type 'vec unop = - ?n : int -> - ?ofsy : int -> - ?incy : int -> - ?y : 'vec -> - ?ofsx : int -> - ?incx : int -> + ?n:int -> + ?ofsy:int -> + ?incy:int -> + ?y:'vec -> + ?ofsx:int -> + ?incx:int -> + 'vec -> 'vec - -> 'vec type 'vec binop = - ?n : int -> - ?ofsz : int -> - ?incz : int -> - ?z : 'vec -> - ?ofsx : int -> - ?incx : int -> + ?n:int -> + ?ofsz:int -> + ?incz:int -> + ?z:'vec -> + ?ofsx:int -> + ?incx:int -> + 'vec -> + ?ofsy:int -> + ?incy:int -> 'vec -> - ?ofsy : int -> - ?incy : int -> 'vec - -> 'vec - end (* Vec *) + end + (* Vec *) module Mat : sig + type patt = + [ `Full (* Full matrix *) + | `Utr (* Upper triangular or trapezoidal matrix *) + | `Ltr (* lower triangular or trapezoidal matrix *) + | `Upent of int (* Initial full rows of pentagonal matrix *) + | `Lpent of int (* Initial full columns of pentagonal matrix *) ] (** Pattern of a matrix operation Documentation of matrix patterns: - x = accessed - ? = not accessed + x = accessed ? = not accessed [`Full] for an [(m, n) = (3, 4)] full matrix operation: - x x x x - x x x x - x x x x + x x x x x x x x x x x x [`Utr] for an [(m, n) = (3, 4)] upper trapezoidal matrix operation: - x x x x - ? x x x - ? ? x x + x x x x ? x x x ? ? x x [`Utr] for an [(m, n) = (4, 3)] upper trapezoidal matrix operation (the accessed part is actually only upper triangular due to dimension constraints): - x x x - ? x x - ? ? x - ? ? ? + x x x ? x x ? ? x ? ? ? [`Utr] for an [(m, n) = (3, 3)] upper triangular matrix operation: - x x x - ? x x - ? ? x + x x x ? x x ? ? x [`Ltr] for an [(m, n) = (4, 3)] lower trapezoidal matrix operation: - x ? ? - x x ? - x x x - x x x + x ? ? x x ? x x x x x x [`Ltr] for an [(m, n) = (3, 4)] lower trapezoidal matrix operation (the accessed part is actually only lower triangular due to dimension constraints): - x ? ? ? - x x ? ? - x x x ? + x ? ? ? x x ? ? x x x ? [`Ltr] for an [(m, n) = (3, 3)] lower triangular matrix operation: - x x x - ? x x - ? ? x + x x x ? x x ? ? x [`Upent 2] for an [(m, n) = (4, 3)] upper pentagonal matrix operation. The pattern argument describes the number of topmost full rows: - x x x - x x x - ? x x - ? ? x + x x x x x x ? x x ? ? x [`Lpent 2] for an [(m, n) = (3, 4)] lower pentagonal matrix operation. The pattern argument describes the number of leftmost full columns: - x x ? ? - x x x ? - x x x x + x x ? ? x x x ? x x x x The transpose of a [`Upent l] operation is an [`Lpent l] operation if [m] and [n] are also flipped. Note that the following holds: - * [`Utr = `Upent 1] - * [`Ltr = `Lpent 1] + * [`Utr = `Upent 1] * [`Ltr = `Lpent 1] Whether an operation operates on a triangular or trapezoidal part of a matrix is inferred from size parameters [m] and [n], which are passed @@ -199,45 +175,39 @@ module Types : sig Pentagonal matrix patterns have the advantage of being fractal: it is always possible to cut a pentagonal pattern along an arbitrary row or column and obtain two sub-problems that can also be described by a - pentagonal pattern. This makes pentagonal patterns suitable for + pentagonal pattern. This makes pentagonal patterns suitable for parallelizing many operations, e.g. on triagonal matrices, by cutting - them into smaller problems using pentagonal patterns. Neither triagonal - nor trapezoidal patterns are fractal. Rectangular patterns are fractal, - but too limited in expressiveness. - *) - type patt = [ - | `Full (* Full matrix *) - | `Utr (* Upper triangular or trapezoidal matrix *) - | `Ltr (* lower triangular or trapezoidal matrix *) - | `Upent of int (* Initial full rows of pentagonal matrix *) - | `Lpent of int (* Initial full columns of pentagonal matrix *) - ] + them into smaller problems using pentagonal patterns. Neither triagonal + nor trapezoidal patterns are fractal. Rectangular patterns are fractal, + but too limited in expressiveness. *) type 'mat unop = - ?patt : patt -> - ?m : int -> - ?n : int -> - ?br : int -> - ?bc : int -> - ?b : 'mat -> - ?ar : int -> - ?ac : int -> + ?patt:patt -> + ?m:int -> + ?n:int -> + ?br:int -> + ?bc:int -> + ?b:'mat -> + ?ar:int -> + ?ac:int -> + 'mat -> 'mat - -> 'mat type 'mat binop = - ?patt : patt -> - ?m : int -> - ?n : int -> - ?cr : int -> - ?cc : int -> - ?c : 'mat -> - ?ar : int -> - ?ac : int -> + ?patt:patt -> + ?m:int -> + ?n:int -> + ?cr:int -> + ?cc:int -> + ?c:'mat -> + ?ar:int -> + ?ac:int -> + 'mat -> + ?br:int -> + ?bc:int -> 'mat -> - ?br : int -> - ?bc : int -> 'mat - -> 'mat - end (* Mat *) -end (* Types *) + end + (* Mat *) +end +(* Types *) diff --git a/src/complex32.ml b/src/complex32.ml index 176ccf4..7fe54f8 100644 --- a/src/complex32.ml +++ b/src/complex32.ml @@ -1,25 +1,22 @@ (* File: complex32.ml - Copyright (C) 2005- + Copyright © 2005- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) open Bigarray @@ -28,27 +25,27 @@ type num_type = Complex.t type vec = (Complex.t, complex32_elt, fortran_layout) Array1.t type rvec = (float, float32_elt, fortran_layout) Array1.t type mat = (Complex.t, complex32_elt, fortran_layout) Array2.t - type trans3 = [ `N | `T | `C ] let prec = complex32 let zero = Complex.zero let one = Complex.one let add = Complex.add - let vec_create n = Array1.create prec fortran_layout n - let int_of_complex32 z = int_of_float z.Complex.re module Types = struct module Vec = struct type unop = vec Common.Types.Vec.unop type binop = vec Common.Types.Vec.binop - end (* Vec *) + end + (* Vec *) module Mat = struct type patt = Common.Types.Mat.patt type unop = mat Common.Types.Mat.unop type binop = mat Common.Types.Mat.binop - end (* Mat *) -end (* Types *) + end + (* Mat *) +end +(* Types *) diff --git a/src/complex64.ml b/src/complex64.ml index d2a347f..e8f70b2 100644 --- a/src/complex64.ml +++ b/src/complex64.ml @@ -1,25 +1,22 @@ (* File: complex64.ml - Copyright (C) 2005- + Copyright © 2005- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) open Bigarray @@ -28,27 +25,27 @@ type num_type = Complex.t type vec = (Complex.t, complex64_elt, fortran_layout) Array1.t type rvec = (float, float64_elt, fortran_layout) Array1.t type mat = (Complex.t, complex64_elt, fortran_layout) Array2.t - type trans3 = [ `N | `T | `C ] let prec = complex64 let zero = Complex.zero let one = Complex.one let add = Complex.add - let vec_create n = Array1.create prec fortran_layout n - let int_of_complex64 z = int_of_float z.Complex.re module Types = struct module Vec = struct type unop = vec Common.Types.Vec.unop type binop = vec Common.Types.Vec.binop - end (* Vec *) + end + (* Vec *) module Mat = struct type patt = Common.Types.Mat.patt type unop = mat Common.Types.Mat.unop type binop = mat Common.Types.Mat.binop - end (* Mat *) -end (* Types *) + end + (* Mat *) +end +(* Types *) diff --git a/src/complex_io.ml b/src/complex_io.ml index cf1b393..2956629 100644 --- a/src/complex_io.ml +++ b/src/complex_io.ml @@ -1,29 +1,24 @@ (* File: complex_io.ml - Copyright (C) 2001- - - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info - - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umh.ac.be/an/ - - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. - - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + Copyright © 2001- + + Markus Mottl + + Christophe Troestler + + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. + + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. + + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) open Io diff --git a/src/complex_io.mli b/src/complex_io.mli index 58148eb..4c25f80 100644 --- a/src/complex_io.mli +++ b/src/complex_io.mli @@ -1,25 +1,22 @@ (* File: complex_io.mli - Copyright (C) 2010- - - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umons.ac.be/an/ - - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. - - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + Copyright © 2010- + + Christophe Troestler + + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. + + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. + + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) val pp_num : Format.formatter -> Complex.t -> unit (** [pp_num ppf el] is equivalent to [fprintf ppf "(%G, %Gi)" diff --git a/src/config/dune b/src/config/dune index b8176cb..9e7be16 100644 --- a/src/config/dune +++ b/src/config/dune @@ -1,42 +1,41 @@ (executable - (name discover) - (modules discover) - (libraries dune.configurator) - (modes byte exe) -) + (name discover) + (modules discover) + (libraries dune.configurator) + (modes byte exe)) (executable - (name make_prec_dep) - (modules make_prec_dep) - (libraries str) - (modes byte exe) -) + (name make_prec_dep) + (modules make_prec_dep) + (libraries str) + (modes byte exe)) (rule - (targets c_flags.sexp extra_c_flags.sexp c_library_flags.sexp) - (action (run ./discover.exe))) + (targets c_flags.sexp extra_c_flags.sexp c_library_flags.sexp) + (action + (run ./discover.exe))) (library - (name discover_utils) - (modules) - (foreign_stubs - (language c) - (names zdot_is_procedure_stubs zdot_is_function_stubs) - (flags - (:standard) - (:include c_flags.sexp) - (:include extra_c_flags.sexp) - )) - (c_library_flags (:include c_library_flags.sexp) -lm) -) + (name discover_utils) + (modules) + (foreign_stubs + (language c) + (names zdot_is_procedure_stubs zdot_is_function_stubs) + (flags + (:standard) + (:include c_flags.sexp) + (:include extra_c_flags.sexp))) + (c_library_flags + (:include c_library_flags.sexp) + -lm)) (executable - (name gen_blas_kind) - (modules gen_blas_kind) - (libraries dune.configurator discover_utils) - (modes byte exe) -) + (name gen_blas_kind) + (modules gen_blas_kind) + (libraries dune.configurator discover_utils) + (modes byte exe)) (rule - (targets blas_kind_flags.sexp) - (action (run ./gen_blas_kind.exe))) + (targets blas_kind_flags.sexp) + (action + (run ./gen_blas_kind.exe))) diff --git a/src/config/gen_blas_kind.ml b/src/config/gen_blas_kind.ml index 47dc7fc..fbb1ce6 100644 --- a/src/config/gen_blas_kind.ml +++ b/src/config/gen_blas_kind.ml @@ -5,10 +5,10 @@ let () = if Array.length Sys.argv = 1 then let module C = Configurator.V1 in let blas_kind_flags = - if Sys.command "./gen_blas_kind.exe procedure" = 0 - then ["-DZDOT_IS_PROCEDURE"] - else if Sys.command "./gen_blas_kind.exe function" = 0 - then ["-DZDOT_IS_FUNCTION"] + if Sys.command "./gen_blas_kind.exe procedure" = 0 then + [ "-DZDOT_IS_PROCEDURE" ] + else if Sys.command "./gen_blas_kind.exe function" = 0 then + [ "-DZDOT_IS_FUNCTION" ] else failwith "Could not determine correct zdot calling convention" in C.Flags.write_sexp "blas_kind_flags.sexp" blas_kind_flags diff --git a/src/config/make_prec_dep.ml b/src/config/make_prec_dep.ml index 5dd3b73..681509d 100644 --- a/src/config/make_prec_dep.ml +++ b/src/config/make_prec_dep.ml @@ -18,33 +18,35 @@ module In_channel = struct let rec iter_lines ic ~f = match input_line ic with - | line -> f line; iter_lines ic ~f + | line -> + f line; + iter_lines ic ~f | exception End_of_file -> () -end (* In_channel *) +end +(* In_channel *) module Out_channel = struct let with_file = channel_with_file open_out close_out let write_all name ~data = with_file name ~f:(fun oc -> output_string oc data) -end (* Out_channel *) +end +(* Out_channel *) let input_file ?(path = src) ?(comments = true) ?(prefix = "") fname = In_channel.with_file (Filename.concat path fname) ~f:(fun ic -> - let buf = Buffer.create 2048 in - In_channel.iter_lines ic ~f:(fun l -> - if l <> "" then begin - Buffer.add_string buf prefix; - Buffer.add_string buf l - end; - Buffer.add_char buf '\n'); - let buf = Buffer.contents buf in - if comments then buf - else Str.global_replace comment_re "" buf) + let buf = Buffer.create 2048 in + In_channel.iter_lines ic ~f:(fun l -> + if l <> "" then ( + Buffer.add_string buf prefix; + Buffer.add_string buf l); + Buffer.add_char buf '\n'); + let buf = Buffer.contents buf in + if comments then buf else Str.global_replace comment_re "" buf) let output_file ?(path = src) fname ~content = Out_channel.write_all (Filename.concat path fname) ~data:content let ocaml_major, ocaml_minor = - Scanf.sscanf Sys.ocaml_version "%i.%i" (fun v1 v2 -> v1, v2) + Scanf.sscanf Sys.ocaml_version "%i.%i" (fun v1 v2 -> (v1, v2)) let has_module_type_of = ocaml_major > 3 || (ocaml_major = 3 && ocaml_minor >= 12) @@ -55,94 +57,91 @@ let has_type_level_module_aliases = (* Generating precision dependent files ***********************************************************************) -let sig_module_type_of_re = - Str.regexp ": *module type of +\\([A-Za-z0-9_]+\\)" +let sig_module_type_of_re = Str.regexp ": *module type of +\\([A-Za-z0-9_]+\\)" let inc_module_type_of_re = Str.regexp "^\\( *\\)include module type of +\\([A-Za-z0-9_]+\\)" -(* Replace [open Types.Vec] and [open Types.Mat] by their explicit - definition (when [full_doc] is desired). [Float*] and - [Complex*] are thus internal modules. *) +(* Replace [open Types.Vec] and [open Types.Mat] by their explicit definition + (when [full_doc] is desired). [Float*] and [Complex*] are thus internal + modules. *) let explicit_vec_mat s = - let s = Str.global_replace (Str.regexp "^ *open *Float[0-9]+ *\n") - "" s in - let s = Str.global_replace (Str.regexp "^ *open *Complex[0-9]+ *\n") - "" s in + let s = Str.global_replace (Str.regexp "^ *open *Float[0-9]+ *\n") "" s in + let s = Str.global_replace (Str.regexp "^ *open *Complex[0-9]+ *\n") "" s in (* Only replace the 1st ones. *) let type_vec = Str.regexp " *open *Types.Vec *" in - let s = Str.replace_first type_vec - " type unop =\n \ - ?n : int ->\n \ - ?ofsy : int -> ?incy : int -> ?y : vec ->\n \ - ?ofsx : int -> ?incx : int -> vec\n \ - -> vec\n\ - \n \ - type binop =\n \ - ?n : int ->\n \ - ?ofsz : int -> ?incz : int -> ?z : vec ->\n \ - ?ofsx : int -> ?incx : int -> vec ->\n \ - ?ofsy : int -> ?incy : int -> vec\n \ - -> vec" s in + let s = + Str.replace_first type_vec + " type unop =\n\ + \ ?n : int ->\n\ + \ ?ofsy : int -> ?incy : int -> ?y : vec ->\n\ + \ ?ofsx : int -> ?incx : int -> vec\n\ + \ -> vec\n\n\ + \ type binop =\n\ + \ ?n : int ->\n\ + \ ?ofsz : int -> ?incz : int -> ?z : vec ->\n\ + \ ?ofsx : int -> ?incx : int -> vec ->\n\ + \ ?ofsy : int -> ?incy : int -> vec\n\ + \ -> vec" s + in let s = Str.global_replace type_vec "" s in let type_mat = Str.regexp " *open *Types.Mat *" in - let s = Str.replace_first type_mat - " type patt = [\n \ - | `Full (* Full matrix *)\n \ - | `Utr (* Upper triangular or trapezoidal matrix *)\n \ - | `Ltr (* lower triangular or trapezoidal matrix *)\n \ - | `Upent of int \ - (* Initial full rows of pentagonal matrix *)\n \ - | `Lpent of int \ - (* Initial full columns of pentagonal matrix *)\n \ - ]\n\ - \n \ - type unop =\n \ - ?patt : patt ->\n \ - ?m : int -> ?n : int ->\n \ - ?br : int -> ?bc : int -> ?b : mat ->\n \ - ?ar : int -> ?ac : int -> mat\n \ - -> mat\n\ - \n \ - type binop =\n \ - ?patt : patt ->\n \ - ?m : int -> ?n : int ->\n \ - ?cr : int -> ?cc : int -> ?c : mat ->\n \ - ?ar : int -> ?ac : int -> mat ->\n \ - ?br : int -> ?bc : int -> mat\n \ - -> mat" s in + let s = + Str.replace_first type_mat + " type patt = [\n\ + \ | `Full (* Full matrix *)\n\ + \ | `Utr (* Upper triangular or trapezoidal matrix *)\n\ + \ | `Ltr (* lower triangular or trapezoidal matrix *)\n\ + \ | `Upent of int (* Initial full rows of pentagonal matrix *)\n\ + \ | `Lpent of int (* Initial full columns of pentagonal matrix *)\n\ + \ ]\n\n\ + \ type unop =\n\ + \ ?patt : patt ->\n\ + \ ?m : int -> ?n : int ->\n\ + \ ?br : int -> ?bc : int -> ?b : mat ->\n\ + \ ?ar : int -> ?ac : int -> mat\n\ + \ -> mat\n\n\ + \ type binop =\n\ + \ ?patt : patt ->\n\ + \ ?m : int -> ?n : int ->\n\ + \ ?cr : int -> ?cc : int -> ?c : mat ->\n\ + \ ?ar : int -> ?ac : int -> mat ->\n\ + \ ?br : int -> ?bc : int -> mat\n\ + \ -> mat" s + in Str.global_replace type_mat "" s -(* [full_doc] means that one wants all "include module type of" to be - replaced with the actual .mli content to be easier to read and search. *) -let rec substitute fname0 fname1 ?(full_doc=false) subs = +(* [full_doc] means that one wants all "include module type of" to be replaced + with the actual .mli content to be easier to read and search. *) +let rec substitute fname0 fname1 ?(full_doc = false) subs = let ml0 = input_file fname0 in let s = substitute_string ~full_doc ml0 subs in output_file fname1 ~content:(if full_doc then explicit_vec_mat s else s) and substitute_string ~full_doc s subs = - let s = - List.fold_left (fun l (r,s) -> Str.global_replace r s l) s subs - in + let s = List.fold_left (fun l (r, s) -> Str.global_replace r s l) s subs in (* Substitute [module type of] used alone as a sig. *) let s = if has_type_level_module_aliases then Str.global_replace sig_module_type_of_re "= \\1" s else if not has_module_type_of then let subst s = - let m = string_of_mod_name ~prefix:" " ~full_doc - (Str.matched_group 1 s) subs in - String.concat "" [": sig\n"; m; "\nend\n"] in + let m = + string_of_mod_name ~prefix:" " ~full_doc (Str.matched_group 1 s) subs + in + String.concat "" [ ": sig\n"; m; "\nend\n" ] + in Str.global_substitute sig_module_type_of_re subst s - else s in + else s + in (* Substitute [module type of] if not supported or explicit doc is desired. *) if has_module_type_of && not full_doc then s - else ( + else let subst s = string_of_mod_name ~prefix:(Str.matched_group 1 s) ~full_doc - (Str.matched_group 2 s) subs in + (Str.matched_group 2 s) subs + in Str.global_substitute inc_module_type_of_re subst s - ) and string_of_mod_name ~prefix ~full_doc mname subs = let fincl = String.uncapitalize_ascii mname ^ ".mli" in @@ -150,128 +149,148 @@ and string_of_mod_name ~prefix ~full_doc mname subs = let s' = input_file fincl ~comments:false ~prefix in substitute_string ~full_doc s' subs with Sys_error _ -> - failwith(sprintf "Trying to replace \"include module type of %s\" \ - but the file %S does not exist" - mname fincl) - -(* [derived] is a list of (new_suffix, substitutions). Returns the - list of created files. *) + failwith + (sprintf + "Trying to replace \"include module type of %s\" but the file %S does \ + not exist" + mname fincl) + +(* [derived] is a list of (new_suffix, substitutions). Returns the list of + created files. *) let derived_files ?full_doc fnames suffix derived = let re = Str.regexp ("\\([a-zA-Z]*\\)" ^ suffix ^ "$") in let derive fname = - if Str.string_match re fname 0 then ( + if Str.string_match re fname 0 then let seed = Str.matched_group 1 fname in - if seed <> "lacaml" then ( + if seed <> "lacaml" then let derive1 (new_suffix, subs) = let fname1 = seed ^ new_suffix in - substitute fname fname1 ?full_doc subs; + substitute fname fname1 ?full_doc subs in - List.iter derive1 derived; - )) in + List.iter derive1 derived + in Array.iter derive fnames let () = let fnames = Sys.readdir src in let derive ?full_doc suffix subs = - derived_files ?full_doc fnames suffix subs in - let r subs = List.map (fun (r,s) -> (Str.regexp r, s)) subs in + derived_files ?full_doc fnames suffix subs + in + let r subs = List.map (fun (r, s) -> (Str.regexp r, s)) subs in let num_type n = (Str.regexp "num_type\\( *[^= ]\\)", n ^ "\\1") in let num_type_float = num_type "float" in let num_type_complex = num_type "Complex.t" in let float32 = - r [ - "NPREC", "S"; - "NBPREC", "S"; - "numberxx", "float32"; - "Numberxx", "Float32"; - "num_type_arg", "(float [@unboxed])"; - ] - + r + [ + ("NPREC", "S"); + ("NBPREC", "S"); + ("numberxx", "float32"); + ("Numberxx", "Float32"); + ("num_type_arg", "(float [@unboxed])"); + ] and float64 = - r [ - "NPREC", "D"; - "NBPREC", "D"; - "numberxx", "float64"; - "Numberxx", "Float64"; - "num_type_arg", "(float [@unboxed])"; - ] - + r + [ + ("NPREC", "D"); + ("NBPREC", "D"); + ("numberxx", "float64"); + ("Numberxx", "Float64"); + ("num_type_arg", "(float [@unboxed])"); + ] and complex32 = - r [ - "NPREC", "C"; - "NBPREC", "S"; - "numberxx", "complex32"; - "Numberxx", "Complex32"; - "num_type_arg", "num_type"; - ] - + r + [ + ("NPREC", "C"); + ("NBPREC", "S"); + ("numberxx", "complex32"); + ("Numberxx", "Complex32"); + ("num_type_arg", "num_type"); + ] and complex64 = - r [ - "NPREC", "Z"; - "NBPREC", "D"; - "numberxx", "complex64"; - "Numberxx", "Complex64"; - "num_type_arg", "num_type"; - ] + r + [ + ("NPREC", "Z"); + ("NBPREC", "D"); + ("numberxx", "complex64"); + ("Numberxx", "Complex64"); + ("num_type_arg", "num_type"); + ] in - derive "_SDCZ.mli" [("4_S.mli", num_type_float :: float32); - ("4_D.mli", num_type_float :: float64); - ("4_C.mli", num_type_complex :: complex32); - ("4_Z.mli", num_type_complex :: complex64) ]; - derive "_SDCZ.ml" [("4_S.ml", float32); ("4_D.ml", float64); - ("4_C.ml", complex32); ("4_Z.ml", complex64) ]; + derive "_SDCZ.mli" + [ + ("4_S.mli", num_type_float :: float32); + ("4_D.mli", num_type_float :: float64); + ("4_C.mli", num_type_complex :: complex32); + ("4_Z.mli", num_type_complex :: complex64); + ]; + derive "_SDCZ.ml" + [ + ("4_S.ml", float32); + ("4_D.ml", float64); + ("4_C.ml", complex32); + ("4_Z.ml", complex64); + ]; let float32 = - r [ - "FPREC", "S"; - "floatxx", "float32"; - "Floatxx", "Float32"; - "num_type_arg", "(float [@unboxed])"; - ] - + r + [ + ("FPREC", "S"); + ("floatxx", "float32"); + ("Floatxx", "Float32"); + ("num_type_arg", "(float [@unboxed])"); + ] and float64 = - r [ - "FPREC", "D"; - "floatxx", "float64"; - "Floatxx", "Float64"; - "num_type_arg", "(float [@unboxed])"; - ] - + r + [ + ("FPREC", "D"); + ("floatxx", "float64"); + ("Floatxx", "Float64"); + ("num_type_arg", "(float [@unboxed])"); + ] and complex32 = - r [ - "CPREC", "C"; "CBPREC", "S"; - "floatxx", "float32"; - "Floatxx", "Float32"; - "complexxx", "complex32"; - "Complexxx", "Complex32"; - "num_type_arg", "num_type"; - ] - + r + [ + ("CPREC", "C"); + ("CBPREC", "S"); + ("floatxx", "float32"); + ("Floatxx", "Float32"); + ("complexxx", "complex32"); + ("Complexxx", "Complex32"); + ("num_type_arg", "num_type"); + ] and complex64 = - r [ - "CPREC", "Z"; - "CBPREC", "D"; - "floatxx", "float64"; - "Floatxx", "Float64"; - "complexxx", "complex64"; - "Complexxx", "Complex64"; - "num_type_arg", "num_type"; - ] + r + [ + ("CPREC", "Z"); + ("CBPREC", "D"); + ("floatxx", "float64"); + ("Floatxx", "Float64"); + ("complexxx", "complex64"); + ("Complexxx", "Complex64"); + ("num_type_arg", "num_type"); + ] in - derive "_SD.mli" [("2_S.mli", float32); ("2_D.mli", float64)]; - derive "_SD.ml" [("2_S.ml", float32); ("2_D.ml", float64)]; - derive "SD.ml" [("S.ml", float32); ("D.ml", float64)]; - derive "SD.mli" [("S.mli", num_type_float :: float32); - ("D.mli", num_type_float :: float64)] ~full_doc:true; - derive "_CZ.mli" [("2_C.mli", complex32); ("2_Z.mli", complex64)]; - derive "_CZ.ml" [("2_C.ml", complex32); ("2_Z.ml", complex64)]; - derive "CZ.ml" [("C.ml", complex32); ("Z.ml", complex64)]; - derive "CZ.mli" [("C.mli", num_type_complex :: complex32); - ("Z.mli", num_type_complex :: complex64)] ~full_doc:true - + derive "_SD.mli" [ ("2_S.mli", float32); ("2_D.mli", float64) ]; + derive "_SD.ml" [ ("2_S.ml", float32); ("2_D.ml", float64) ]; + derive "SD.ml" [ ("S.ml", float32); ("D.ml", float64) ]; + derive "SD.mli" + [ + ("S.mli", num_type_float :: float32); ("D.mli", num_type_float :: float64); + ] + ~full_doc:true; + derive "_CZ.mli" [ ("2_C.mli", complex32); ("2_Z.mli", complex64) ]; + derive "_CZ.ml" [ ("2_C.ml", complex32); ("2_Z.ml", complex64) ]; + derive "CZ.ml" [ ("C.ml", complex32); ("Z.ml", complex64) ]; + derive "CZ.mli" + [ + ("C.mli", num_type_complex :: complex32); + ("Z.mli", num_type_complex :: complex64); + ] + ~full_doc:true (* lacaml.mli ***********************************************************************) diff --git a/src/dune b/src/dune index 8ded52c..1eb739d 100644 --- a/src/dune +++ b/src/dune @@ -1,84 +1,92 @@ (library - (public_name lacaml) - (modules - Lacaml - Common Io - S D C Z - Utils Version - Float32 Float64 - Complex32 Complex64 - Real_io Complex_io - Impl4_S Impl4_D Impl4_C Impl4_Z - Impl2_S Impl2_D Impl2_C Impl2_Z - Vec4_S Vec4_D Vec4_C Vec4_Z - Vec2_S Vec2_D Vec2_C Vec2_Z - Mat4_S Mat4_D Mat4_C Mat4_Z - Mat2_S Mat2_D Mat2_C Mat2_Z - ) - (foreign_stubs - (language c) - (names - impl_c utils_c - vec2_S_c vec2_D_c vec2_C_c vec2_Z_c - vec4_S_c vec4_D_c vec4_C_c vec4_Z_c - mat2_S_c mat2_D_c mat2_C_c mat2_Z_c - mat4_S_c mat4_D_c mat4_C_c mat4_Z_c - impl2_S_c impl2_D_c impl2_C_c impl2_Z_c - impl4_S_c impl4_D_c impl4_C_c impl4_Z_c) - (flags - (:standard) - (:include config/c_flags.sexp) - (:include config/blas_kind_flags.sexp) - (:include config/extra_c_flags.sexp) - )) - (c_library_flags (:include config/c_library_flags.sexp) -lm) - - (libraries bigarray) -) + (public_name lacaml) + (modules Lacaml Common Io S D C Z Utils Version Float32 Float64 Complex32 + Complex64 Real_io Complex_io Impl4_S Impl4_D Impl4_C Impl4_Z Impl2_S + Impl2_D Impl2_C Impl2_Z Vec4_S Vec4_D Vec4_C Vec4_Z Vec2_S Vec2_D Vec2_C + Vec2_Z Mat4_S Mat4_D Mat4_C Mat4_Z Mat2_S Mat2_D Mat2_C Mat2_Z) + (foreign_stubs + (language c) + (names impl_c utils_c vec2_S_c vec2_D_c vec2_C_c vec2_Z_c vec4_S_c vec4_D_c + vec4_C_c vec4_Z_c mat2_S_c mat2_D_c mat2_C_c mat2_Z_c mat4_S_c mat4_D_c + mat4_C_c mat4_Z_c impl2_S_c impl2_D_c impl2_C_c impl2_Z_c impl4_S_c + impl4_D_c impl4_C_c impl4_Z_c) + (flags + (:standard) + (:include config/c_flags.sexp) + (:include config/blas_kind_flags.sexp) + (:include config/extra_c_flags.sexp))) + (c_library_flags + (:include config/c_library_flags.sexp) + -lm) + (libraries bigarray)) (rule - (targets - lacaml.mli - ; - S.mli S.ml - D.mli D.ml - C.mli C.ml - Z.mli Z.ml - ; - impl4_S.mli impl4_S.ml - impl4_D.mli impl4_D.ml - impl4_C.mli impl4_C.ml - impl4_Z.mli impl4_Z.ml - impl2_S.mli impl2_S.ml - impl2_D.mli impl2_D.ml - impl2_C.mli impl2_C.ml - impl2_Z.mli impl2_Z.ml - ; - mat4_S.mli mat4_S.ml - mat4_D.mli mat4_D.ml - mat4_C.mli mat4_C.ml - mat4_Z.mli mat4_Z.ml - mat2_S.mli mat2_S.ml - mat2_D.mli mat2_D.ml - mat2_C.mli mat2_C.ml - mat2_Z.mli mat2_Z.ml - ; - vec4_S.mli vec4_S.ml - vec4_D.mli vec4_D.ml - vec4_C.mli vec4_C.ml - vec4_Z.mli vec4_Z.ml - vec2_S.mli vec2_S.ml - vec2_D.mli vec2_D.ml - vec2_C.mli vec2_C.ml - vec2_Z.mli vec2_Z.ml - ) - (deps - config/make_prec_dep.exe - lacaml.pre.mli - SD.mli SD.ml CZ.mli CZ.ml - impl_SDCZ.mli impl_SDCZ.ml impl_SD.mli impl_SD.ml impl_CZ.mli impl_CZ.ml - mat_SDCZ.mli mat_SDCZ.ml mat_SD.mli mat_SD.ml mat_CZ.mli mat_CZ.ml - vec_SDCZ.mli vec_SDCZ.ml vec_SD.mli vec_SD.ml vec_CZ.mli vec_CZ.ml - real_io.mli complex_io.mli - ) - (action (run ./config/make_prec_dep.exe))) + (targets + lacaml.mli + ; + S.mli + S.ml + D.mli + D.ml + C.mli + C.ml + Z.mli + Z.ml + ; + impl4_S.mli + impl4_S.ml + impl4_D.mli + impl4_D.ml + impl4_C.mli + impl4_C.ml + impl4_Z.mli + impl4_Z.ml + impl2_S.mli + impl2_S.ml + impl2_D.mli + impl2_D.ml + impl2_C.mli + impl2_C.ml + impl2_Z.mli + impl2_Z.ml + ; + mat4_S.mli + mat4_S.ml + mat4_D.mli + mat4_D.ml + mat4_C.mli + mat4_C.ml + mat4_Z.mli + mat4_Z.ml + mat2_S.mli + mat2_S.ml + mat2_D.mli + mat2_D.ml + mat2_C.mli + mat2_C.ml + mat2_Z.mli + mat2_Z.ml + ; + vec4_S.mli + vec4_S.ml + vec4_D.mli + vec4_D.ml + vec4_C.mli + vec4_C.ml + vec4_Z.mli + vec4_Z.ml + vec2_S.mli + vec2_S.ml + vec2_D.mli + vec2_D.ml + vec2_C.mli + vec2_C.ml + vec2_Z.mli + vec2_Z.ml) + (deps config/make_prec_dep.exe lacaml.pre.mli SD.mli SD.ml CZ.mli CZ.ml + impl_SDCZ.mli impl_SDCZ.ml impl_SD.mli impl_SD.ml impl_CZ.mli impl_CZ.ml + mat_SDCZ.mli mat_SDCZ.ml mat_SD.mli mat_SD.ml mat_CZ.mli mat_CZ.ml + vec_SDCZ.mli vec_SDCZ.ml vec_SD.mli vec_SD.ml vec_CZ.mli vec_CZ.ml + real_io.mli complex_io.mli) + (action + (run ./config/make_prec_dep.exe))) diff --git a/src/float32.ml b/src/float32.ml index ff8cc42..c57ccbb 100644 --- a/src/float32.ml +++ b/src/float32.ml @@ -1,25 +1,22 @@ (* File: float32.ml - Copyright (C) 2005 + Copyright © 2005 - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) open Bigarray @@ -28,27 +25,27 @@ type num_type = float type vec = (float, float32_elt, fortran_layout) Array1.t type rvec = vec type mat = (float, float32_elt, fortran_layout) Array2.t - type trans3 = [ `N | `T ] let prec = float32 let zero = 0.0 let one = 1.0 -let add = (+.) - +let add = ( +. ) let vec_create n = Array1.create prec fortran_layout n - let int_of_float32 = int_of_float module Types = struct module Vec = struct type unop = vec Common.Types.Vec.unop type binop = vec Common.Types.Vec.binop - end (* Vec *) + end + (* Vec *) module Mat = struct type patt = Common.Types.Mat.patt type unop = mat Common.Types.Mat.unop type binop = mat Common.Types.Mat.binop - end (* Mat *) -end (* Types *) + end + (* Mat *) +end +(* Types *) diff --git a/src/float64.ml b/src/float64.ml index 3d82d4e..1e49286 100644 --- a/src/float64.ml +++ b/src/float64.ml @@ -1,25 +1,22 @@ (* File: float64.ml - Copyright (C) 2005 + Copyright © 2005 - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) open Bigarray @@ -28,27 +25,27 @@ type num_type = float type vec = (float, float64_elt, fortran_layout) Array1.t type rvec = vec type mat = (float, float64_elt, fortran_layout) Array2.t - type trans3 = [ `N | `T ] let prec = float64 let zero = 0.0 let one = 1.0 -let add = (+.) - +let add = ( +. ) let vec_create n = Array1.create prec fortran_layout n - let int_of_float64 = int_of_float module Types = struct module Vec = struct type unop = vec Common.Types.Vec.unop type binop = vec Common.Types.Vec.binop - end (* Vec *) + end + (* Vec *) module Mat = struct type patt = Common.Types.Mat.patt type unop = mat Common.Types.Mat.unop type binop = mat Common.Types.Mat.binop - end (* Mat *) -end (* Types *) + end + (* Mat *) +end +(* Types *) diff --git a/src/fold2_col.h b/src/fold2_col.h index 451cd3d..6a14d8d 100644 --- a/src/fold2_col.h +++ b/src/fold2_col.h @@ -1,14 +1,10 @@ /* File: fold2_col.h - Copyright (C) 2001- + Copyright © 2001- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umh.ac.be/an/ + Christophe Troestler This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public @@ -22,39 +18,36 @@ You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "lacaml_macros.h" -CAMLprim vNUMBER NAME( - intnat vN, - intnat vOFSX, intnat vINCX, value vX, - intnat vOFSY, intnat vINCY, value vY) -{ +CAMLprim vNUMBER NAME(intnat vN, intnat vOFSX, intnat vINCX, value vX, + intnat vOFSY, intnat vINCY, value vY) { CAMLparam2(vX, vY); - integer GET_INT(N), - GET_INT(INCX), - GET_INT(INCY); + integer GET_INT(N), GET_INT(INCX), GET_INT(INCY); VEC_PARAMS(X); VEC_PARAMS(Y); NUMBER *start1, *last1, *start2, acc = INIT; - caml_enter_blocking_section(); /* Allow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ if (INCX > 0) { start1 = X_data; - last1 = start1 + N*INCX; + last1 = start1 + N * INCX; } else { - start1 = X_data - (N - 1)*INCX; + start1 = X_data - (N - 1) * INCX; last1 = X_data + INCX; }; - if (INCY > 0) start2 = Y_data; - else start2 = Y_data - (N - 1)*INCY; + if (INCY > 0) + start2 = Y_data; + else + start2 = Y_data - (N - 1) * INCY; if (INCX == 1 && INCY == 1) /* NOTE: may improve SIMD optimization */ @@ -70,23 +63,15 @@ CAMLprim vNUMBER NAME( start2 += INCY; } - caml_leave_blocking_section(); /* Disallow other threads */ + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturnNUMBER(acc); } -CAMLprim value BC_NAME(value *argv, int __unused argn) -{ - return - COPY_NUMBER( - NAME( - Int_val(argv[0]), - Int_val(argv[1]), - Int_val(argv[2]), - argv[3], - Int_val(argv[4]), - Int_val(argv[5]), - argv[6])); +CAMLprim value BC_NAME(value *argv, int __unused argn) { + return COPY_NUMBER(NAME(Int_val(argv[0]), Int_val(argv[1]), Int_val(argv[2]), + argv[3], Int_val(argv[4]), Int_val(argv[5]), + argv[6])); } #undef NAME diff --git a/src/fold_col.h b/src/fold_col.h index a8f5fcd..7a62dae 100644 --- a/src/fold_col.h +++ b/src/fold_col.h @@ -1,14 +1,10 @@ /* File: fold_col.h - Copyright (C) 2001- + Copyright © 2001- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umh.ac.be/an/ + Christophe Troestler This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public @@ -22,20 +18,20 @@ You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "lacaml_macros.h" -static inline NUMBER STR(NAME, _blocking)( - integer N, NUMBER *X_data, integer INCX, NUMBER acc) { +static inline NUMBER STR(NAME, _blocking)(integer N, NUMBER *X_data, + integer INCX, NUMBER acc) { #ifdef DECLARE_EXTRA DECLARE_EXTRA; #undef DECLARE_EXTRA #endif #ifdef INIT_HAVE_LOCK - INIT_HAVE_LOCK; + INIT_HAVE_LOCK; #undef INIT_HAVE_LOCK #endif @@ -43,10 +39,9 @@ static inline NUMBER STR(NAME, _blocking)( if (INCX > 0) { start = X_data; - last = start + N*INCX; - } - else { - start = X_data - (N - 1)*INCX; + last = start + N * INCX; + } else { + start = X_data - (N - 1) * INCX; last = X_data + INCX; }; @@ -64,43 +59,34 @@ static inline NUMBER STR(NAME, _blocking)( } #ifdef FINISH_HAVE_LOCK - FINISH_HAVE_LOCK; + FINISH_HAVE_LOCK; #undef FINISH_HAVE_LOCK #endif return acc; } -CAMLprim vNUMBER NAME(intnat vN, intnat vOFSX, intnat vINCX, value vX) -{ +CAMLprim vNUMBER NAME(intnat vN, intnat vOFSX, intnat vINCX, value vX) { CAMLparam1(vX); - integer GET_INT(N), - GET_INT(INCX); + integer GET_INT(N), GET_INT(INCX); NUMBER acc = INIT; if (N > 0) { VEC_PARAMS(X); - caml_enter_blocking_section(); /* Allow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ - acc = STR(NAME, _blocking)(N, X_data, INCX, acc); + acc = STR(NAME, _blocking)(N, X_data, INCX, acc); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_leave_blocking_section(); /* Disallow other threads */ } CAMLreturnNUMBER(acc); } -CAMLprim value BC_NAME(value vN, value vOFSX, value vINCX, value vX) -{ - return - COPY_NUMBER( - NAME( - Int_val(vN), - Int_val(vOFSX), - Int_val(vINCX), - vX)); +CAMLprim value BC_NAME(value vN, value vOFSX, value vINCX, value vX) { + return COPY_NUMBER(NAME(Int_val(vN), Int_val(vOFSX), Int_val(vINCX), vX)); } #undef NAME diff --git a/src/impl_CZ.h b/src/impl_CZ.h index 7a036cd..6b559f8 100644 --- a/src/impl_CZ.h +++ b/src/impl_CZ.h @@ -1,25 +1,16 @@ /* File: impl_CZ.h - Copyright (C) 2001- + Copyright © 2001- - Egbert Ammicht - email: eammicht@lucent.com + Egbert Ammicht - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - Liam Stewart - email: liam@cs.toronto.edu - WWW: http://www.cs.toronto.edu/~liam + Liam Stewart - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umh.ac.be/an/ + Christophe Troestler - Florent Hoareau - email: h.florent@gmail.com - WWW: none + Florent Hoareau This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public @@ -33,7 +24,7 @@ You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #define LACAML_COMPLEX @@ -47,94 +38,58 @@ #define WRAPPER_NAME DOTU #include "lacaml_dot_wrappers.h" -CAMLprim value LFUN(dotu_stub)( - intnat vN, - intnat vOFSX, intnat vINCX, value vX, - intnat vOFSY, intnat vINCY, value vY) -{ +CAMLprim value LFUN(dotu_stub)(intnat vN, intnat vOFSX, intnat vINCX, value vX, + intnat vOFSY, intnat vINCY, value vY) { CAMLparam2(vX, vY); - integer GET_INT(N), - GET_INT(INCX), - GET_INT(INCY); + integer GET_INT(N), GET_INT(INCX), GET_INT(INCY); COMPLEX res; VEC_PARAMS(X); VEC_PARAMS(Y); - caml_enter_blocking_section(); /* Allow other threads */ - res = - DOTU( - &N, - X_data, &INCX, - Y_data, &INCY); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + res = DOTU(&N, X_data, &INCX, Y_data, &INCY); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(copy_two_doubles(res.r, res.i)); } -CAMLprim value LFUN(dotu_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(dotu_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - Int_val(argv[2]), - argv[3], - Int_val(argv[4]), - Int_val(argv[5]), - argv[6]); +CAMLprim value LFUN(dotu_stub_bc)(value *argv, int __unused argn) { + return LFUN(dotu_stub)(Int_val(argv[0]), Int_val(argv[1]), Int_val(argv[2]), + argv[3], Int_val(argv[4]), Int_val(argv[5]), argv[6]); } - /** DOTC */ #define NAME FUN(dotc) #define WRAPPER_NAME DOTC #include "lacaml_dot_wrappers.h" -CAMLprim value LFUN(dotc_stub)( - intnat vN, - intnat vOFSX, intnat vINCX, value vX, - intnat vOFSY, intnat vINCY, value vY) -{ +CAMLprim value LFUN(dotc_stub)(intnat vN, intnat vOFSX, intnat vINCX, value vX, + intnat vOFSY, intnat vINCY, value vY) { CAMLparam2(vX, vY); - integer GET_INT(N), - GET_INT(INCX), - GET_INT(INCY); + integer GET_INT(N), GET_INT(INCX), GET_INT(INCY); COMPLEX res; VEC_PARAMS(X); VEC_PARAMS(Y); - caml_enter_blocking_section(); /* Allow other threads */ - res = - DOTC( - &N, - X_data, &INCX, - Y_data, &INCY); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + res = DOTC(&N, X_data, &INCX, Y_data, &INCY); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(copy_two_doubles(res.r, res.i)); } -CAMLprim value LFUN(dotc_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(dotc_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - Int_val(argv[2]), - argv[3], - Int_val(argv[4]), - Int_val(argv[5]), - argv[6]); +CAMLprim value LFUN(dotc_stub_bc)(value *argv, int __unused argn) { + return LFUN(dotc_stub)(Int_val(argv[0]), Int_val(argv[1]), Int_val(argv[2]), + argv[3], Int_val(argv[4]), Int_val(argv[5]), argv[6]); } - /*** BLAS-2 */ /** TODO: HEMV */ @@ -143,7 +98,6 @@ CAMLprim value LFUN(dotc_stub_bc)(value *argv, int __unused argn) /** TODO: HPMV */ - /*** LAPACK */ /* Auxiliary Routines @@ -151,19 +105,12 @@ CAMLprim value LFUN(dotc_stub_bc)(value *argv, int __unused argn) /** LANSY */ -extern REAL FUN(lansy)( - char *NORM, char *UPLO, - integer *N, - NUMBER *A, integer *LDA, - REAL *WORK); - -CAMLprim double LFUN(lansy_stub)( - value vNORM, - value vUPLO, - intnat vN, - intnat vAR, intnat vAC, value vA, - value vWORK) -{ +extern REAL FUN(lansy)(char *NORM, char *UPLO, integer *N, NUMBER *A, + integer *LDA, REAL *WORK); + +CAMLprim double LFUN(lansy_stub)(value vNORM, value vUPLO, intnat vN, + intnat vAR, intnat vAC, value vA, + value vWORK) { CAMLparam2(vA, vWORK); char GET_CHAR(NORM), GET_CHAR(UPLO); @@ -174,52 +121,31 @@ CAMLprim double LFUN(lansy_stub)( MAT_PARAMS(A); RVEC_PARAMS1(WORK); - caml_enter_blocking_section(); /* Allow other threads */ - res = FUN(lansy)( - &NORM, &UPLO, &N, - A_data, &rows_A, - WORK_data); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + res = FUN(lansy)(&NORM, &UPLO, &N, A_data, &rows_A, WORK_data); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturnT(double, res); } -CAMLprim value LFUN(lansy_stub_bc)(value *argv, int __unused argn) -{ - return - caml_copy_double( - LFUN(lansy_stub)( - argv[0], - argv[1], - Int_val(argv[2]), - Int_val(argv[3]), - Int_val(argv[4]), - argv[5], - argv[6])); +CAMLprim value LFUN(lansy_stub_bc)(value *argv, int __unused argn) { + return caml_copy_double(LFUN(lansy_stub)(argv[0], argv[1], Int_val(argv[2]), + Int_val(argv[3]), Int_val(argv[4]), + argv[5], argv[6])); } - /* Computational functions ************************************************************************/ /** GECON */ -extern void FUN(gecon)( - char *NORM, - integer *N, - COMPLEX *A, integer *LDA, - REAL *ANORM, REAL *RCOND, - COMPLEX *WORK, REAL *RWORK, - integer *INFO); - -CAMLprim value LFUN(gecon_stub)( - intnat vN, - intnat vAR, intnat vAC, value vA, - value vWORK, - value vRWORK, - value vNORM, - double vANORM) -{ +extern void FUN(gecon)(char *NORM, integer *N, COMPLEX *A, integer *LDA, + REAL *ANORM, REAL *RCOND, COMPLEX *WORK, REAL *RWORK, + integer *INFO); + +CAMLprim value LFUN(gecon_stub)(intnat vN, intnat vAR, intnat vAC, value vA, + value vWORK, value vRWORK, value vNORM, + double vANORM) { CAMLparam3(vA, vWORK, vRWORK); CAMLlocal1(v_rcond); @@ -233,12 +159,9 @@ CAMLprim value LFUN(gecon_stub)( VEC_PARAMS1(WORK); RVEC_PARAMS1(RWORK); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(gecon)( - &NORM, &N, - A_data, &rows_A, - &ANORM, &RCOND, - WORK_data, RWORK_data, &INFO); + caml_enter_blocking_section(); /* Allow other threads */ + FUN(gecon)(&NORM, &N, A_data, &rows_A, &ANORM, &RCOND, WORK_data, RWORK_data, + &INFO); caml_leave_blocking_section(); /* Disallow other threads */ v_rcond = caml_copy_double(RCOND); @@ -249,39 +172,21 @@ CAMLprim value LFUN(gecon_stub)( CAMLreturn(v_res); } -CAMLprim value LFUN(gecon_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(gecon_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - Int_val(argv[2]), - argv[3], - argv[4], - argv[5], - argv[6], - Double_val(argv[7])); +CAMLprim value LFUN(gecon_stub_bc)(value *argv, int __unused argn) { + return LFUN(gecon_stub)(Int_val(argv[0]), Int_val(argv[1]), Int_val(argv[2]), + argv[3], argv[4], argv[5], argv[6], + Double_val(argv[7])); } /** SYCON */ -extern void FUN(sycon)( - char *UPLO, - integer *N, - COMPLEX *A, integer *LDA, - integer *IPIV, - REAL *ANORM, REAL *RCOND, - COMPLEX *WORK, - integer *INFO); - -CAMLprim value LFUN(sycon_stub)( - value vUPLO, - intnat vN, - intnat vAR, intnat vAC, value vA, - value vIPIV, - value vWORK, - double vANORM) -{ +extern void FUN(sycon)(char *UPLO, integer *N, COMPLEX *A, integer *LDA, + integer *IPIV, REAL *ANORM, REAL *RCOND, COMPLEX *WORK, + integer *INFO); + +CAMLprim value LFUN(sycon_stub)(value vUPLO, intnat vN, intnat vAR, intnat vAC, + value vA, value vIPIV, value vWORK, + double vANORM) { CAMLparam3(vA, vIPIV, vWORK); CAMLlocal1(v_rcond); @@ -295,13 +200,9 @@ CAMLprim value LFUN(sycon_stub)( INT_VEC_PARAMS(IPIV); VEC_PARAMS1(WORK); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(sycon)( - &UPLO, &N, - A_data, &rows_A, - IPIV_data, - &ANORM, &RCOND, - WORK_data, &INFO); + caml_enter_blocking_section(); /* Allow other threads */ + FUN(sycon)(&UPLO, &N, A_data, &rows_A, IPIV_data, &ANORM, &RCOND, WORK_data, + &INFO); caml_leave_blocking_section(); /* Disallow other threads */ v_rcond = caml_copy_double(RCOND); @@ -312,38 +213,21 @@ CAMLprim value LFUN(sycon_stub)( CAMLreturn(v_res); } -CAMLprim value LFUN(sycon_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(sycon_stub)( - argv[0], - Int_val(argv[1]), - Int_val(argv[2]), - Int_val(argv[3]), - argv[4], - argv[5], - argv[6], - Double_val(argv[7])); +CAMLprim value LFUN(sycon_stub_bc)(value *argv, int __unused argn) { + return LFUN(sycon_stub)(argv[0], Int_val(argv[1]), Int_val(argv[2]), + Int_val(argv[3]), argv[4], argv[5], argv[6], + Double_val(argv[7])); } /** POCON */ -extern void FUN(pocon)( - char *UPLO, - integer *N, - COMPLEX *A, integer *LDA, - REAL *ANORM, REAL *RCOND, - COMPLEX *WORK, REAL *RWORK, - integer *INFO); - -CAMLprim value LFUN(pocon_stub)( - value vUPLO, - intnat vN, - intnat vAR, intnat vAC, value vA, - value vWORK, - value vRWORK, - double vANORM) -{ +extern void FUN(pocon)(char *UPLO, integer *N, COMPLEX *A, integer *LDA, + REAL *ANORM, REAL *RCOND, COMPLEX *WORK, REAL *RWORK, + integer *INFO); + +CAMLprim value LFUN(pocon_stub)(value vUPLO, intnat vN, intnat vAR, intnat vAC, + value vA, value vWORK, value vRWORK, + double vANORM) { CAMLparam3(vA, vWORK, vRWORK); CAMLlocal1(v_rcond); @@ -357,12 +241,9 @@ CAMLprim value LFUN(pocon_stub)( VEC_PARAMS1(WORK); RVEC_PARAMS1(RWORK); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(pocon)( - &UPLO, &N, - A_data, &rows_A, - &ANORM, &RCOND, - WORK_data, RWORK_data, &INFO); + caml_enter_blocking_section(); /* Allow other threads */ + FUN(pocon)(&UPLO, &N, A_data, &rows_A, &ANORM, &RCOND, WORK_data, RWORK_data, + &INFO); caml_leave_blocking_section(); /* Disallow other threads */ v_rcond = caml_copy_double(RCOND); @@ -373,18 +254,10 @@ CAMLprim value LFUN(pocon_stub)( CAMLreturn(v_res); } -CAMLprim value LFUN(pocon_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(pocon_stub)( - argv[0], - Int_val(argv[1]), - Int_val(argv[2]), - Int_val(argv[3]), - argv[4], - argv[5], - argv[6], - Double_val(argv[7])); +CAMLprim value LFUN(pocon_stub_bc)(value *argv, int __unused argn) { + return LFUN(pocon_stub)(argv[0], Int_val(argv[1]), Int_val(argv[2]), + Int_val(argv[3]), argv[4], argv[5], argv[6], + Double_val(argv[7])); } /* General Schur factorization @@ -394,25 +267,21 @@ CAMLprim value LFUN(pocon_stub_bc)(value *argv, int __unused argn) /* Predefined callbacks for eigenvalue selection */ -static inline integer select_left_plane(const COMPLEX *z_ptr) -{ +static inline integer select_left_plane(const COMPLEX *z_ptr) { return (z_ptr->r < 0) ? 1 : 0; } -static inline integer select_right_plane(const COMPLEX *z_ptr) -{ +static inline integer select_right_plane(const COMPLEX *z_ptr) { return (z_ptr->r > 0) ? 1 : 0; } -static inline integer select_disk_interior(const COMPLEX *z_ptr) -{ +static inline integer select_disk_interior(const COMPLEX *z_ptr) { REAL re = z_ptr->r; REAL im = z_ptr->i; return (re * re + im * im < 1) ? 1 : 0; } -static inline integer select_disk_exterior(const COMPLEX *z_ptr) -{ +static inline integer select_disk_exterior(const COMPLEX *z_ptr) { REAL re = z_ptr->r; REAL im = z_ptr->i; return (re * re + im * im > 1) ? 1 : 0; @@ -424,15 +293,13 @@ static value select_ocaml_callback = Val_unit; static value select_ocaml_callback_exn = Val_unit; static bool select_ocaml_locked_runtime = false; -CAMLprim value LFUN(init_gees)(value __unused v_unit) -{ +CAMLprim value LFUN(init_gees)(value __unused v_unit) { caml_register_generational_global_root(&select_ocaml_callback); caml_register_generational_global_root(&select_ocaml_callback_exn); return Val_unit; } -static integer select_ocaml_exec_callback(const COMPLEX *z_ptr) -{ +static integer select_ocaml_exec_callback(const COMPLEX *z_ptr) { value v_res, v_arg; if (!select_ocaml_locked_runtime) { @@ -441,12 +308,13 @@ static integer select_ocaml_exec_callback(const COMPLEX *z_ptr) } v_arg = caml_alloc_small(2, Double_array_tag); - Store_double_field(v_arg, 0, (double) z_ptr->r); - Store_double_field(v_arg, 1, (double) z_ptr->i); + Store_double_field(v_arg, 0, (double)z_ptr->r); + Store_double_field(v_arg, 1, (double)z_ptr->i); v_res = caml_callback_exn(select_ocaml_callback, v_arg); - if (!Is_exception_result(v_res)) return Bool_val(v_res); + if (!Is_exception_result(v_res)) + return Bool_val(v_res); else { /* Callout raised an exception */ if (select_ocaml_callback_exn == Val_unit) { @@ -457,45 +325,26 @@ static integer select_ocaml_exec_callback(const COMPLEX *z_ptr) } } -typedef integer (*LAPACK_CZ_SELECT1) ( const COMPLEX* ); - -extern void FUN(gees)( - char *JOBVS, char *SORT, - LAPACK_CZ_SELECT1 SELECT, - integer *N, - COMPLEX *A, integer *LDA, - integer *SDIM, - COMPLEX *W, - COMPLEX *VS, integer *LDVS, - COMPLEX *WORK, - integer *LWORK, - REAL *RWORK, - integer *BWORK, - integer *INFO); - -CAMLprim value LFUN(gees_stub)( - value vJOBVS, value vSORT, - intnat vSELECT, value vSELECT_FUN, - intnat vN, - intnat vAR, intnat vAC, value vA, - value vW, - intnat vVSR, intnat vVSC, value vVS, - value vWORK, intnat vLWORK, - value vRWORK, - value vBWORK) -{ +typedef integer (*LAPACK_CZ_SELECT1)(const COMPLEX *); + +extern void FUN(gees)(char *JOBVS, char *SORT, LAPACK_CZ_SELECT1 SELECT, + integer *N, COMPLEX *A, integer *LDA, integer *SDIM, + COMPLEX *W, COMPLEX *VS, integer *LDVS, COMPLEX *WORK, + integer *LWORK, REAL *RWORK, integer *BWORK, + integer *INFO); + +CAMLprim value LFUN(gees_stub)(value vJOBVS, value vSORT, intnat vSELECT, + value vSELECT_FUN, intnat vN, intnat vAR, + intnat vAC, value vA, value vW, intnat vVSR, + intnat vVSC, value vVS, value vWORK, + intnat vLWORK, value vRWORK, value vBWORK) { CAMLparam5(vA, vVS, vW, vWORK, vRWORK); CAMLxparam2(vBWORK, vSELECT_FUN); CAMLlocal1(v_res); - char GET_CHAR(JOBVS), - GET_CHAR(SORT); + char GET_CHAR(JOBVS), GET_CHAR(SORT); - integer GET_INT(SELECT), - GET_INT(N), - GET_INT(LWORK), - SDIM, - INFO; + integer GET_INT(SELECT), GET_INT(N), GET_INT(LWORK), SDIM, INFO; MAT_PARAMS(A); MAT_PARAMS(VS); @@ -509,61 +358,55 @@ CAMLprim value LFUN(gees_stub)( if (SORT == 'S') { switch (SELECT) { - case 0 : - select_function = select_left_plane; - break; - case 1 : - select_function = select_right_plane; - break; - case 2 : - select_function = select_disk_interior; - break; - case 3 : - select_function = select_disk_exterior; - break; - case 4 : - custom_sort = true; - select_function = select_ocaml_exec_callback; - while (select_ocaml_callback != Val_unit) { - caml_enter_blocking_section(); /* Allow other threads */ - /* Wait 1ms before polling again */ - portable_sleep(1); - caml_leave_blocking_section(); /* Disallow other threads */ - } - caml_modify_generational_global_root( - &select_ocaml_callback, vSELECT_FUN); - break; - default : - caml_failwith("internal error: unknown SELECT value in gees_stub"); + case 0: + select_function = select_left_plane; + break; + case 1: + select_function = select_right_plane; + break; + case 2: + select_function = select_disk_interior; + break; + case 3: + select_function = select_disk_exterior; + break; + case 4: + custom_sort = true; + select_function = select_ocaml_exec_callback; + while (select_ocaml_callback != Val_unit) { + caml_enter_blocking_section(); /* Allow other threads */ + /* Wait 1ms before polling again */ + portable_sleep(1); + caml_leave_blocking_section(); /* Disallow other threads */ + } + caml_modify_generational_global_root(&select_ocaml_callback, vSELECT_FUN); + break; + default: + caml_failwith("internal error: unknown SELECT value in gees_stub"); } } caml_enter_blocking_section(); /* Allow other threads */ - FUN(gees)( - &JOBVS, &SORT, - select_function, - &N, - A_data, &rows_A, - &SDIM, - W_data, - VS_data, &rows_VS, - WORK_data, - &LWORK, RWORK_data, BWORK_data, - &INFO); + FUN(gees)(&JOBVS, &SORT, select_function, &N, A_data, &rows_A, &SDIM, W_data, + VS_data, &rows_VS, WORK_data, &LWORK, RWORK_data, BWORK_data, + &INFO); if (custom_sort) { - if (select_ocaml_locked_runtime) select_ocaml_locked_runtime = false; - else caml_leave_blocking_section(); /* Disallow other threads */ + if (select_ocaml_locked_runtime) + select_ocaml_locked_runtime = false; + else + caml_leave_blocking_section(); /* Disallow other threads */ caml_modify_generational_global_root(&select_ocaml_callback, Val_unit); if (select_ocaml_callback_exn != Val_unit) { CAMLlocal1(v_exn); v_exn = select_ocaml_callback_exn; - caml_modify_generational_global_root( - &select_ocaml_callback_exn, Val_unit); + caml_modify_generational_global_root(&select_ocaml_callback_exn, + Val_unit); caml_raise(v_exn); } - } else caml_leave_blocking_section(); /* Disallow other threads */ + } else + caml_leave_blocking_section(); /* Disallow other threads */ v_res = caml_alloc_small(2, 0); Field(v_res, 0) = Val_long(SDIM); @@ -572,26 +415,12 @@ CAMLprim value LFUN(gees_stub)( CAMLreturn(v_res); } -CAMLprim value LFUN(gees_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(gees_stub)( - argv[0], - argv[1], - Int_val(argv[2]), - argv[3], - Int_val(argv[4]), - Int_val(argv[5]), - Int_val(argv[6]), - argv[7], - argv[8], - Int_val(argv[9]), - Int_val(argv[10]), - argv[11], - argv[12], - Int_val(argv[13]), - argv[14], - argv[15]); +CAMLprim value LFUN(gees_stub_bc)(value *argv, int __unused argn) { + return LFUN(gees_stub)(argv[0], argv[1], Int_val(argv[2]), argv[3], + Int_val(argv[4]), Int_val(argv[5]), Int_val(argv[6]), + argv[7], argv[8], Int_val(argv[9]), Int_val(argv[10]), + argv[11], argv[12], Int_val(argv[13]), argv[14], + argv[15]); } /* General SVD routines @@ -599,36 +428,22 @@ CAMLprim value LFUN(gees_stub_bc)(value *argv, int __unused argn) /** GESVD */ -extern void FUN(gesvd)( - char* JOBU, char* JOBVT, - integer *M, integer* N, - COMPLEX *A, integer *LDA, - REAL *S, - COMPLEX *U, integer* LDU, - COMPLEX *VT, integer *LDVT, - COMPLEX *WORK, integer *LWORK, - REAL *RWORK, - integer *INFO); - -CAMLprim intnat LFUN(gesvd_stub)( - value vJOBU, value vJOBVT, - intnat vM, intnat vN, - intnat vAR, intnat vAC, value vA, - value vS, - intnat vUR, intnat vUC, value vU, - intnat vVTR, intnat vVTC, value vVT, - value vWORK, intnat vLWORK, - value vRWORK) -{ +extern void FUN(gesvd)(char *JOBU, char *JOBVT, integer *M, integer *N, + COMPLEX *A, integer *LDA, REAL *S, COMPLEX *U, + integer *LDU, COMPLEX *VT, integer *LDVT, COMPLEX *WORK, + integer *LWORK, REAL *RWORK, integer *INFO); + +CAMLprim intnat LFUN(gesvd_stub)(value vJOBU, value vJOBVT, intnat vM, + intnat vN, intnat vAR, intnat vAC, value vA, + value vS, intnat vUR, intnat vUC, value vU, + intnat vVTR, intnat vVTC, value vVT, + value vWORK, intnat vLWORK, value vRWORK) { CAMLparam5(vA, vS, vU, vVT, vWORK); CAMLxparam1(vRWORK); - char GET_CHAR(JOBU), - GET_CHAR(JOBVT); + char GET_CHAR(JOBU), GET_CHAR(JOBVT); - integer GET_INT(M), GET_INT(N), - GET_INT(LWORK), - INFO; + integer GET_INT(M), GET_INT(N), GET_INT(LWORK), INFO; MAT_PARAMS(A); RVEC_PARAMS1(S); @@ -638,81 +453,45 @@ CAMLprim intnat LFUN(gesvd_stub)( RVEC_PARAMS1(RWORK); caml_enter_blocking_section(); /* Allow other threads */ - FUN(gesvd)( - &JOBU, &JOBVT, - &M, &N, - A_data, &rows_A, - S_data, - U_data, &rows_U, - VT_data, &rows_VT, - WORK_data, &LWORK, - RWORK_data, - &INFO); + FUN(gesvd)(&JOBU, &JOBVT, &M, &N, A_data, &rows_A, S_data, U_data, &rows_U, + VT_data, &rows_VT, WORK_data, &LWORK, RWORK_data, &INFO); caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(INFO); } -CAMLprim value LFUN(gesvd_stub_bc)(value *argv, int __unused argn) -{ - return - Val_int( - LFUN(gesvd_stub)( - argv[0], - argv[1], - Int_val(argv[2]), - Int_val(argv[3]), - Int_val(argv[4]), - Int_val(argv[5]), - argv[6], - argv[7], - Int_val(argv[8]), - Int_val(argv[9]), - argv[10], - Int_val(argv[11]), - Int_val(argv[12]), - argv[13], - argv[14], - Int_val(argv[15]), - argv[16])); +CAMLprim value LFUN(gesvd_stub_bc)(value *argv, int __unused argn) { + return Val_int(LFUN(gesvd_stub)( + argv[0], argv[1], Int_val(argv[2]), Int_val(argv[3]), Int_val(argv[4]), + Int_val(argv[5]), argv[6], argv[7], Int_val(argv[8]), Int_val(argv[9]), + argv[10], Int_val(argv[11]), Int_val(argv[12]), argv[13], argv[14], + Int_val(argv[15]), argv[16])); } /** TODO: GESDD */ - /* General eigenvalue problem (simple drivers) ************************************************************************/ /** GEEV */ -extern void FUN(geev)( - char *JOBVL, char *JOBVR, - integer *N, - COMPLEX *A, integer *LDA, - COMPLEX *W, - COMPLEX *VL, integer *LDVL, - COMPLEX *VR, integer *LDVR, - COMPLEX *WORK, integer *LWORK, - REAL *RWORK, - integer *INFO); - -CAMLprim intnat LFUN(geev_stub)( - intnat vAR, intnat vAC, value vA, - intnat vN, - intnat vOFSW, value vW, - intnat vVLR, intnat vVLC, value vVL, value vJOBVL, - intnat vVRR, intnat vVRC, value vVR, value vJOBVR, - value vWORK, intnat vLWORK, value vRWORK) -{ +extern void FUN(geev)(char *JOBVL, char *JOBVR, integer *N, COMPLEX *A, + integer *LDA, COMPLEX *W, COMPLEX *VL, integer *LDVL, + COMPLEX *VR, integer *LDVR, COMPLEX *WORK, integer *LWORK, + REAL *RWORK, integer *INFO); + +CAMLprim intnat LFUN(geev_stub)(intnat vAR, intnat vAC, value vA, intnat vN, + intnat vOFSW, value vW, intnat vVLR, + intnat vVLC, value vVL, value vJOBVL, + intnat vVRR, intnat vVRC, value vVR, + value vJOBVR, value vWORK, intnat vLWORK, + value vRWORK) { CAMLparam5(vA, vW, vVL, vVR, vWORK); CAMLxparam1(vRWORK); - char GET_CHAR(JOBVL), - GET_CHAR(JOBVR); + char GET_CHAR(JOBVL), GET_CHAR(JOBVR); - integer GET_INT(N), - GET_INT(LWORK), - INFO; + integer GET_INT(N), GET_INT(LWORK), INFO; MAT_PARAMS(A); VEC_PARAMS(W); @@ -724,45 +503,23 @@ CAMLprim intnat LFUN(geev_stub)( /* weird GEEV requirement: * even when the arrays aren't * referenced, LD's have to be >= 1 */ - if(JOBVL == 'N') rows_VL = 1; - if(JOBVR == 'N') rows_VR = 1; + if (JOBVL == 'N') + rows_VL = 1; + if (JOBVR == 'N') + rows_VR = 1; caml_enter_blocking_section(); /* Allow other threads */ - FUN(geev)( - &JOBVL, &JOBVR, - &N, - A_data, &rows_A, - W_data, - VL_data, &rows_VL, - VR_data, &rows_VR, - WORK_data, &LWORK, - RWORK_data, - &INFO); + FUN(geev)(&JOBVL, &JOBVR, &N, A_data, &rows_A, W_data, VL_data, &rows_VL, + VR_data, &rows_VR, WORK_data, &LWORK, RWORK_data, &INFO); caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(INFO); } -CAMLprim value LFUN(geev_stub_bc)(value *argv, int __unused argn) -{ - return - Val_int( - LFUN(geev_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - argv[2], - Int_val(argv[3]), - Int_val(argv[4]), - argv[5], - Int_val(argv[6]), - Int_val(argv[7]), - argv[8], - argv[9], - Int_val(argv[10]), - Int_val(argv[11]), - argv[12], - argv[13], - argv[14], - Int_val(argv[15]), - argv[16])); +CAMLprim value LFUN(geev_stub_bc)(value *argv, int __unused argn) { + return Val_int(LFUN(geev_stub)( + Int_val(argv[0]), Int_val(argv[1]), argv[2], Int_val(argv[3]), + Int_val(argv[4]), argv[5], Int_val(argv[6]), Int_val(argv[7]), argv[8], + argv[9], Int_val(argv[10]), Int_val(argv[11]), argv[12], argv[13], + argv[14], Int_val(argv[15]), argv[16])); } diff --git a/src/impl_CZ.ml b/src/impl_CZ.ml index f4c545d..13e638d 100644 --- a/src/impl_CZ.ml +++ b/src/impl_CZ.ml @@ -1,40 +1,32 @@ (* File: impl_CZ.ml - Copyright (C) 2005- + Copyright © 2005- - Egbert Ammicht - email: eammicht@lucent.com + Egbert Ammicht - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - Liam Stewart - email: liam@cs.toronto.edu - WWW: http://www.cs.toronto.edu/~liam + Liam Stewart - Oleg Trott - email: ot14@columbia.edu - WWW: http://www.columbia.edu/~ot14 + Christophe Troestler - Florent Hoareau - email: h.florent@gmail.com - WWW: none + Oleg Trott - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + Florent Hoareau - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. + + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) open Printf open Bigarray @@ -43,56 +35,55 @@ open Complexxx open Common open Utils open Impl4_CPREC - module Vec = Vec4_CPREC module Mat = Mat4_CPREC - module RVec = Vec4_CBPREC (* BLAS-1 interface *) external direct_dotu : - n : (int [@untagged]) -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> + n:(int[@untagged]) -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> Complex.t = "lacaml_CPRECdotu_stub_bc" "lacaml_CPRECdotu_stub" external direct_dotc : - n : (int [@untagged]) -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> + n:(int[@untagged]) -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> Complex.t = "lacaml_CPRECdotc_stub_bc" "lacaml_CPRECdotc_stub" -let gen_dot loc dot_fun = (); fun ?n ?ofsx ?incx x ?ofsy ?incy y -> - let ofsx, incx = get_vec_geom loc x_str ofsx incx in - let ofsy, incy = get_vec_geom loc y_str ofsy incy in - let n = get_dim_vec loc x_str ofsx incx x n_str n in - check_vec loc y_str y (ofsy + (n - 1) * abs incy); - dot_fun ~n ~ofsx ~incx ~x ~ofsy ~incy ~y +let gen_dot loc dot_fun = + (); + fun ?n ?ofsx ?incx x ?ofsy ?incy y -> + let ofsx, incx = get_vec_geom loc x_str ofsx incx in + let ofsy, incy = get_vec_geom loc y_str ofsy incy in + let n = get_dim_vec loc x_str ofsx incx x n_str n in + check_vec loc y_str y (ofsy + ((n - 1) * abs incy)); + dot_fun ~n ~ofsx ~incx ~x ~ofsy ~incy ~y let dotu = gen_dot "Lacaml.CPREC.dotu" direct_dotu let dotc = gen_dot "Lacaml.CPREC.dotc" direct_dotc - (* Auxiliary routines *) external direct_lansy : - norm : char -> - uplo : char -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - work : rvec -> - (float [@unboxed]) = "lacaml_CPREClansy_stub_bc" "lacaml_CPREClansy_stub" + norm:char -> + uplo:char -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + work:rvec -> + (float[@unboxed]) = "lacaml_CPREClansy_stub_bc" "lacaml_CPREClansy_stub" let lansy_min_lwork n = function `I -> n | _ -> 0 @@ -105,36 +96,34 @@ let lansy ?n ?(up = true) ?(norm = `O) ?work ?(ar = 1) ?(ac = 1) a = let norm = get_norm_char norm in direct_lansy ~norm ~uplo ~n ~ar ~ac ~a ~work - (* Linear equations (computational routines) *) (* GECON *) external direct_gecon : - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - work : vec -> - rwork : rvec -> - norm : char -> - anorm : (float [@unboxed]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + work:vec -> + rwork:rvec -> + norm:char -> + anorm:(float[@unboxed]) -> int * float = "lacaml_CPRECgecon_stub_bc" "lacaml_CPRECgecon_stub" let gecon_min_lwork n = 2 * n - let gecon_min_lrwork n = 2 * n let gecon ?n ?(norm = `O) ?anorm ?work ?rwork ?(ar = 1) ?(ac = 1) a = let loc = "Lacaml.CPREC.gecon" in let n = get_n_of_a loc ar ac a n in let work, _lwork = - get_work - loc Vec.create work (gecon_min_lwork n) (gecon_min_lwork n) "lwork" in + get_work loc Vec.create work (gecon_min_lwork n) (gecon_min_lwork n) "lwork" + in let rwork, _lrwork = - get_work - loc RVec.create rwork - (gecon_min_lrwork n) (gecon_min_lrwork n) "lrwork" in + get_work loc RVec.create rwork (gecon_min_lrwork n) (gecon_min_lrwork n) + "lrwork" + in let anorm = match anorm with | None -> lange ~norm:(norm :> norm4) ~m:n ~n ~work:rwork a @@ -142,20 +131,19 @@ let gecon ?n ?(norm = `O) ?anorm ?work ?rwork ?(ar = 1) ?(ac = 1) a = in let norm = get_norm_char norm in let info, rcond = direct_gecon ~n ~ar ~ac ~a ~work ~rwork ~norm ~anorm in - if info = 0 then rcond - else gecon_err loc norm n a info + if info = 0 then rcond else gecon_err loc norm n a info (* SYCON *) external direct_sycon : - uplo : char -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - ipiv : int32_vec -> - work : vec -> - anorm : (float [@unboxed]) -> + uplo:char -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + ipiv:int32_vec -> + work:vec -> + anorm:(float[@unboxed]) -> int * float = "lacaml_CPRECsycon_stub_bc" "lacaml_CPRECsycon_stub" let sycon_min_lwork n = 2 * n @@ -165,158 +153,137 @@ let sycon ?n ?(up = true) ?ipiv ?anorm ?work ?(ar = 1) ?(ac = 1) a = let n = get_n_of_a loc ar ac a n in let uplo = get_uplo_char up in let work, _lwork = - get_work - loc Vec.create work (sycon_min_lwork n) (sycon_min_lwork n) "lwork" in + get_work loc Vec.create work (sycon_min_lwork n) (sycon_min_lwork n) "lwork" + in let ipiv = if ipiv = None then sytrf ~n ~up ~work ~ar ~ac a - else sytrf_get_ipiv loc ipiv n in + else sytrf_get_ipiv loc ipiv n + in let anorm = - match anorm with - | None -> lange ~m:n ~n ~ar ~ac a - | Some anorm -> anorm in + match anorm with None -> lange ~m:n ~n ~ar ~ac a | Some anorm -> anorm + in let info, rcond = direct_sycon ~uplo ~n ~ar ~ac ~a ~ipiv ~work ~anorm in - if info = 0 then rcond - else xxcon_err loc n a info + if info = 0 then rcond else xxcon_err loc n a info (* POCON *) external direct_pocon : - uplo : char -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - work : vec -> - rwork : rvec -> - anorm : (float [@unboxed]) -> + uplo:char -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + work:vec -> + rwork:rvec -> + anorm:(float[@unboxed]) -> int * float = "lacaml_CPRECpocon_stub_bc" "lacaml_CPRECpocon_stub" let pocon_min_lwork n = 3 * n - let pocon_min_lrwork n = n let pocon ?n ?(up = true) ?anorm ?work ?rwork ?(ar = 1) ?(ac = 1) a = let loc = "Lacaml.CPREC.pocon" in let n = get_n_of_a loc ar ac a n in let uplo = get_uplo_char up in - let min_lwork, min_lrwork = pocon_min_lwork n, pocon_min_lrwork n in - let work, _lwork = - get_work loc Vec.create work min_lwork min_lwork "lwork" in + let min_lwork, min_lrwork = (pocon_min_lwork n, pocon_min_lrwork n) in + let work, _lwork = get_work loc Vec.create work min_lwork min_lwork "lwork" in let rwork, _lrwork = - get_work loc RVec.create rwork min_lrwork min_lrwork "lrwork" in + get_work loc RVec.create rwork min_lrwork min_lrwork "lrwork" + in let anorm = - match anorm with - | None -> lange ~m:n ~n ~ar ~ac a - | Some anorm -> anorm in + match anorm with None -> lange ~m:n ~n ~ar ~ac a | Some anorm -> anorm + in let info, rcond = direct_pocon ~uplo ~n ~ar ~ac ~a ~work ~rwork ~anorm in - if info = 0 then rcond - else xxcon_err loc n a info - + if info = 0 then rcond else xxcon_err loc n a info (* General Schur factorization *) (* GEES *) external direct_gees : - jobvs : char -> - sort : char -> - select : (int [@untagged]) -> - select_fun : (Complex.t -> bool) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - w : vec -> - vsr : (int [@untagged]) -> - vsc : (int [@untagged]) -> - vs : mat -> - work : vec -> - lwork : (int [@untagged]) -> - rwork : rvec -> - bwork : int32_vec - -> int * int = "lacaml_CPRECgees_stub_bc" "lacaml_CPRECgees_stub" - (* result : (SDIM, INFO) *) + jobvs:char -> + sort:char -> + select:(int[@untagged]) -> + select_fun:(Complex.t -> bool) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + w:vec -> + vsr:(int[@untagged]) -> + vsc:(int[@untagged]) -> + vs:mat -> + work:vec -> + lwork:(int[@untagged]) -> + rwork:rvec -> + bwork:int32_vec -> + int * int = "lacaml_CPRECgees_stub_bc" "lacaml_CPRECgees_stub" +(* result : (SDIM, INFO) *) external init_gees : unit -> unit = "lacaml_CPRECinit_gees" let () = init_gees () -let gees_get_opt_lwork - ~loc ~jobvs ~sort ~select ~select_fun ~n - ~ar ~ac ~a ~w ~vsr ~vsc ~vs ~rwork ~bwork = +let gees_get_opt_lwork ~loc ~jobvs ~sort ~select ~select_fun ~n ~ar ~ac ~a ~w + ~vsr ~vsc ~vs ~rwork ~bwork = let lwork = -1 in let work = Vec.create 1 in let _, info = - direct_gees ~jobvs ~sort ~select ~select_fun ~n ~ar ~ac ~a - ~w ~vsr ~vsc ~vs ~work ~lwork ~rwork ~bwork + direct_gees ~jobvs ~sort ~select ~select_fun ~n ~ar ~ac ~a ~w ~vsr ~vsc ~vs + ~work ~lwork ~rwork ~bwork in - if info = 0 then int_of_float work.{1}.re - else gees_err loc n info jobvs sort - -let gees - ?n - ?(jobvs = `Compute_Schur_vectors) - ?(sort = `No_sort) - ?w - ?(vsr = 1) - ?(vsc = 1) - ?vs - ?work - ?(ar = 1) - ?(ac = 1) - a = + if info = 0 then int_of_float work.{1}.re else gees_err loc n info jobvs sort + +let gees ?n ?(jobvs = `Compute_Schur_vectors) ?(sort = `No_sort) ?w ?(vsr = 1) + ?(vsc = 1) ?vs ?work ?(ar = 1) ?(ac = 1) a = let loc = "Lacaml.CPREC.gees" in let jobvs, sort_char, select, select_fun, n, vs, w = - gees_get_params_complex - loc Vec.create Mat.create Mat.empty jobvs sort n ar ac a w vsr vsc vs + gees_get_params_complex loc Vec.create Mat.create Mat.empty jobvs sort n ar + ac a w vsr vsc vs in let bwork = - match sort with - | `No_sort -> empty_int32_vec - | _ -> create_int32_vec n + match sort with `No_sort -> empty_int32_vec | _ -> create_int32_vec n in let rwork = RVec.create n in let work, lwork = match work with - | Some work -> work, Array1.dim work + | Some work -> (work, Array1.dim work) | None -> let lwork = - gees_get_opt_lwork ~loc ~jobvs ~sort:sort_char ~select ~select_fun - ~n ~ar ~ac ~a ~w ~vsr ~vsc ~vs ~rwork ~bwork + gees_get_opt_lwork ~loc ~jobvs ~sort:sort_char ~select ~select_fun ~n + ~ar ~ac ~a ~w ~vsr ~vsc ~vs ~rwork ~bwork in - Vec.create lwork, lwork + (Vec.create lwork, lwork) in let sdim, info = - direct_gees ~jobvs ~sort:sort_char ~select ~select_fun - ~n ~ar ~ac ~a ~w ~vsr ~vsc ~vs ~work ~lwork ~rwork ~bwork + direct_gees ~jobvs ~sort:sort_char ~select ~select_fun ~n ~ar ~ac ~a ~w ~vsr + ~vsc ~vs ~work ~lwork ~rwork ~bwork in - if info = 0 then sdim, w, vs - else gees_err loc n info jobvs sort_char - + if info = 0 then (sdim, w, vs) else gees_err loc n info jobvs sort_char (* General SVD routines *) (* GESVD *) external direct_gesvd : - jobu : char -> - jobvt : char -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - s : rvec -> - ur : (int [@untagged]) -> - uc : (int [@untagged]) -> - u : mat -> - vtc : (int [@untagged]) -> - vtr : (int [@untagged]) -> - vt : mat -> - work : vec -> - lwork : (int [@untagged]) -> - rwork : rvec -> - (int [@untagged]) = "lacaml_CPRECgesvd_stub_bc" "lacaml_CPRECgesvd_stub" + jobu:char -> + jobvt:char -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + s:rvec -> + ur:(int[@untagged]) -> + uc:(int[@untagged]) -> + u:mat -> + vtc:(int[@untagged]) -> + vtr:(int[@untagged]) -> + vt:mat -> + work:vec -> + lwork:(int[@untagged]) -> + rwork:rvec -> + (int[@untagged]) = "lacaml_CPRECgesvd_stub_bc" "lacaml_CPRECgesvd_stub" let gesvd_min_lwork ~m ~n = let min_m_n = min m n in @@ -328,41 +295,37 @@ let gesvd_get_opt_lwork loc jobu jobvt m n ar ac a s ur uc u vtr vtc vt = let lwork = -1 in let work = Vec.create 1 in let info = - direct_gesvd - ~jobu ~jobvt ~m ~n ~ar ~ac ~a ~s ~ur ~uc ~u ~vtr ~vtc ~vt - ~work ~lwork ~rwork:RVec.empty + direct_gesvd ~jobu ~jobvt ~m ~n ~ar ~ac ~a ~s ~ur ~uc ~u ~vtr ~vtc ~vt ~work + ~lwork ~rwork:RVec.empty in if info = 0 then Floatxx.int_of_floatxx work.{1}.re else gesvd_err loc jobu jobvt m n a u vt lwork info -let gesvd_opt_lwork - ?m ?n - ?(jobu = `A) ?(jobvt = `A) ?s - ?(ur = 1) ?(uc = 1) ?u +let gesvd_opt_lwork ?m ?n ?(jobu = `A) ?(jobvt = `A) ?s ?(ur = 1) ?(uc = 1) ?u ?(vtr = 1) ?(vtc = 1) ?vt ?(ar = 1) ?(ac = 1) a = let loc = "Lacaml.CPREC.gesvd_opt_lwork" in let jobu, jobvt, m, n, s, u, vt = - gesvd_get_params - loc RVec.create Mat.create jobu jobvt m n ar ac a s ur uc u vtr vtc vt in + gesvd_get_params loc RVec.create Mat.create jobu jobvt m n ar ac a s ur uc u + vtr vtc vt + in gesvd_get_opt_lwork loc jobu jobvt m n ar ac a s ur uc u vtr vtc vt -let gesvd - ?m ?n - ?(jobu = `A) ?(jobvt = `A) ?s - ?(ur = 1) ?(uc = 1) ?u - ?(vtr = 1) ?(vtc = 1) ?vt ?work ?rwork ?(ar = 1) ?(ac = 1) a = +let gesvd ?m ?n ?(jobu = `A) ?(jobvt = `A) ?s ?(ur = 1) ?(uc = 1) ?u ?(vtr = 1) + ?(vtc = 1) ?vt ?work ?rwork ?(ar = 1) ?(ac = 1) a = let loc = "Lacaml.CPREC.gesvd" in let jobu, jobvt, m, n, s, u, vt = - gesvd_get_params - loc RVec.create Mat.create jobu jobvt m n ar ac a s ur uc u vtr vtc vt in + gesvd_get_params loc RVec.create Mat.create jobu jobvt m n ar ac a s ur uc u + vtr vtc vt + in let work, lwork = match work with - | Some work -> work, Array1.dim work + | Some work -> (work, Array1.dim work) | None -> let lwork = - gesvd_get_opt_lwork - loc jobu jobvt m n ar ac a s ur uc u vtr vtc vt in - Vec.create lwork, lwork in + gesvd_get_opt_lwork loc jobu jobvt m n ar ac a s ur uc u vtr vtc vt + in + (Vec.create lwork, lwork) + in let rwork = match rwork with | None -> RVec.create (gesvd_lrwork ~m ~n) @@ -372,16 +335,15 @@ let gesvd if lrwork < min_lrwork then invalid_arg (sprintf "%s: lrwork: valid=[%d..[ got=%d" loc min_lrwork lrwork) - else rwork in + else rwork + in let info = - direct_gesvd - ~jobu ~jobvt ~m ~n ~ar ~ac ~a ~s ~ur ~uc ~u ~vtc ~vtr ~vt - ~work ~lwork ~rwork + direct_gesvd ~jobu ~jobvt ~m ~n ~ar ~ac ~a ~s ~ur ~uc ~u ~vtc ~vtr ~vt ~work + ~lwork ~rwork in - if info = 0 then s, u, vt + if info = 0 then (s, u, vt) else gesvd_err loc jobu jobvt m n a u vt lwork info - (* General eigenvalue problem (simple drivers) *) (* GEEV error handler *) @@ -389,10 +351,11 @@ let gesvd let geev_err loc min_work a n vl vr lwork err = if err > 0 then let msg = - sprintf "\ - %s: The QR algorithm failed to compute all the eigenvalues, and\n\ - no eigenvectors have been computed; elements %d:%d of WR and WI\n\ - contain eigenvalues which have converged" loc (err + 1) n in + sprintf + "%s: The QR algorithm failed to compute all the eigenvalues, and\n\ + no eigenvectors have been computed; elements %d:%d of WR and WI\n\ + contain eigenvalues which have converged" loc (err + 1) n + in failwith msg else let msg = @@ -400,31 +363,34 @@ let geev_err loc min_work a n vl vr lwork err = | -3 -> sprintf "n: valid=[0..[ got=%d" n | -5 -> sprintf "dim1(a): valid=[%d..[ got=%d" (max 1 n) (Array2.dim1 a) | -8 -> sprintf "dim1(vl): valid=[%d..[ got=%d" (max 1 n) (Array2.dim1 vl) - | -10-> sprintf "dim1(vr): valid=[%d..[ got=%d" (max 1 n) (Array2.dim1 vr) + | -10 -> + sprintf "dim1(vr): valid=[%d..[ got=%d" (max 1 n) (Array2.dim1 vr) | -12 -> sprintf "dim(work): valid=[%d..[ got=%d" (min_work n) lwork - | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) in + | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) + in invalid_arg (sprintf "%s: %s" loc msg) (* GEEV *) external direct_geev : - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - n : (int [@untagged]) -> - ofsw : (int [@untagged]) -> w : vec -> - vlr : (int [@untagged]) -> - vlc : (int [@untagged]) -> - vl : mat -> - jobvl : char -> - vrr : (int [@untagged]) -> - vrc : (int [@untagged]) -> - vr : mat -> - jobvr : char -> - work : vec -> - lwork : (int [@untagged]) -> - rwork : vec -> - (int [@untagged]) = "lacaml_CPRECgeev_stub_bc" "lacaml_CPRECgeev_stub" + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + n:(int[@untagged]) -> + ofsw:(int[@untagged]) -> + w:vec -> + vlr:(int[@untagged]) -> + vlc:(int[@untagged]) -> + vl:mat -> + jobvl:char -> + vrr:(int[@untagged]) -> + vrc:(int[@untagged]) -> + vr:mat -> + jobvr:char -> + work:vec -> + lwork:(int[@untagged]) -> + rwork:vec -> + (int[@untagged]) = "lacaml_CPRECgeev_stub_bc" "lacaml_CPRECgeev_stub" let geev_min_lwork n = max 1 (n + n) let geev_min_lrwork n = n + n @@ -432,39 +398,32 @@ let geev_min_lrwork n = n + n let geev_get_opt_lwork loc n vlr vlc vl jobvl vrr vrc vr jobvr ofsw w ar ac a = let work = Vec.create 1 in let info = - direct_geev ~ar ~ac ~a ~n ~ofsw ~w ~vlr ~vlc ~vl ~jobvl - ~vrr ~vrc ~vr ~jobvr ~work ~lwork:~-1 ~rwork:Vec.empty + direct_geev ~ar ~ac ~a ~n ~ofsw ~w ~vlr ~vlc ~vl ~jobvl ~vrr ~vrc ~vr ~jobvr + ~work ~lwork:~-1 ~rwork:Vec.empty in if info = 0 then int_of_float work.{1}.re else geev_err loc geev_min_lwork a n vl vr ~-1 info let geev_get_params loc ar ac a n vlr vlc vl vrr vrc vr ofsw w = - let n, _, _, _, _, _, _, _, _, _ as params = - geev_gen_get_params - loc Mat.empty Mat.create ar ac a n vlr vlc vl vrr vrc vr in - params, xxev_get_wx Vec.create loc w_str ofsw w n - -let geev_opt_lwork - ?n - ?(vlr = 1) ?(vlc = 1) ?vl - ?(vrr = 1) ?(vrc = 1) ?vr - ?(ofsw = 1) ?w - ?(ar = 1) ?(ac = 1) a = + let ((n, _, _, _, _, _, _, _, _, _) as params) = + geev_gen_get_params loc Mat.empty Mat.create ar ac a n vlr vlc vl vrr vrc vr + in + (params, xxev_get_wx Vec.create loc w_str ofsw w n) + +let geev_opt_lwork ?n ?(vlr = 1) ?(vlc = 1) ?vl ?(vrr = 1) ?(vrc = 1) ?vr + ?(ofsw = 1) ?w ?(ar = 1) ?(ac = 1) a = let loc = "Lacaml.CPREC.geev_opt_lwork" in let (n, vlr, vlc, vl, jobvl, vrr, vrc, vr, jobvr, _), w = geev_get_params loc ar ac a n vlr vlc vl vrr vrc vr ofsw w in geev_get_opt_lwork loc n vlr vlc vl jobvl vrr vrc vr jobvr ofsw w ar ac a -let geev - ?n ?work ?rwork - ?(vlr = 1) ?(vlc = 1) ?vl - ?(vrr = 1) ?(vrc = 1) ?vr - ?(ofsw = 1) ?w - ?(ar = 1) ?(ac = 1) a = +let geev ?n ?work ?rwork ?(vlr = 1) ?(vlc = 1) ?vl ?(vrr = 1) ?(vrc = 1) ?vr + ?(ofsw = 1) ?w ?(ar = 1) ?(ac = 1) a = let loc = "Lacaml.CPREC.geev" in let (n, vlr, vlc, vl, jobvl, vrr, vrc, vr, jobvr, _), w = - geev_get_params loc ar ac a n vlr vlc vl vrr vrc vr ofsw w in + geev_get_params loc ar ac a n vlr vlc vl vrr vrc vr ofsw w + in let work, lwork = match work with @@ -474,12 +433,14 @@ let geev if lwork < min_lwork then invalid_arg (sprintf "%s: lwork: valid=[%d..[ got=%d" loc min_lwork lwork) - else work, lwork + else (work, lwork) | None -> let lwork = - geev_get_opt_lwork loc n vlr vlc vl jobvl vrr vrc vr jobvr - ofsw w ar ac a in - Vec.create lwork, lwork in + geev_get_opt_lwork loc n vlr vlc vl jobvl vrr vrc vr jobvr ofsw w ar + ac a + in + (Vec.create lwork, lwork) + in let rwork = match rwork with @@ -490,13 +451,13 @@ let geev if lrwork < min_lrwork then invalid_arg (sprintf "%s: lrwork: valid=[%d..[ got=%d" loc min_lrwork lrwork) - else rwork in + else rwork + in let info = - direct_geev - ~ar ~ac ~a ~n ~ofsw ~w ~vlr ~vlc ~vl ~jobvl - ~vrr ~vrc ~vr ~jobvr ~work ~lwork ~rwork + direct_geev ~ar ~ac ~a ~n ~ofsw ~w ~vlr ~vlc ~vl ~jobvl ~vrr ~vrc ~vr ~jobvr + ~work ~lwork ~rwork in - if info = 0 then vl, w, vr + if info = 0 then (vl, w, vr) else geev_err loc geev_min_lwork a n vl vr lwork info diff --git a/src/impl_CZ.mli b/src/impl_CZ.mli index 164a556..fc4672d 100644 --- a/src/impl_CZ.mli +++ b/src/impl_CZ.mli @@ -1,40 +1,30 @@ (* File: impl_CZ.mli - Copyright (C) 2005- + Copyright © 2005- - Egbert Ammicht - email: eammicht@lucent.com + Egbert Ammicht - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - Liam Stewart - email: liam@cs.toronto.edu - WWW: http://www.cs.toronto.edu/~liam + Liam Stewart - Oleg Trott - email: ot14@columbia.edu - WWW: http://www.columbia.edu/~ot14 + Oleg Trott - Florent Hoareau - email: h.florent@gmail.com - WWW: none + Florent Hoareau - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) open Common open Complexxx @@ -42,41 +32,38 @@ open Complexxx (** {6 BLAS-1 interface} *) val dotu : - ?n : int -> - ?ofsx : int -> - ?incx : int -> + ?n:int -> + ?ofsx:int -> + ?incx:int -> vec -> - ?ofsy : int -> - ?incy : int -> - vec - -> Complex.t + ?ofsy:int -> + ?incy:int -> + vec -> + Complex.t (** [dotu ?n ?ofsx ?incx x ?ofsy ?incy y] see BLAS documentation! @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsx default = 1 @param incx default = 1 @param ofsy default = 1 - @param incy default = 1 -*) + @param incy default = 1 *) val dotc : - ?n : int -> - ?ofsx : int -> - ?incx : int -> + ?n:int -> + ?ofsx:int -> + ?incx:int -> + vec -> + ?ofsy:int -> + ?incy:int -> vec -> - ?ofsy : int -> - ?incy : int -> - vec - -> Complex.t + Complex.t (** [dotc ?n ?ofsx ?incx x ?ofsy ?incy y] see BLAS documentation! @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsx default = 1 @param incx default = 1 @param ofsy default = 1 - @param incy default = 1 -*) - + @param incy default = 1 *) (** {6 LAPACK interface} *) @@ -89,12 +76,12 @@ val lansy_min_lwork : int -> norm4 -> int @param n the number of columns (and rows) in the matrix *) val lansy : - ?n : int -> - ?up : bool -> - ?norm : norm4 -> - ?work : rvec -> - ?ar : int -> - ?ac : int -> + ?n:int -> + ?up:bool -> + ?norm:norm4 -> + ?work:rvec -> + ?ar:int -> + ?ac:int -> mat -> float (** [lansy ?n ?up ?norm ?work ?ar ?ac a] see LAPACK documentation! @@ -117,13 +104,13 @@ val gecon_min_lrwork : int -> int @param n the logical dimensions of the matrix given to [gecon]-function *) val gecon : - ?n : int -> - ?norm : norm2 -> - ?anorm : float -> - ?work : vec -> - ?rwork : rvec -> - ?ar : int -> - ?ac : int -> + ?n:int -> + ?norm:norm2 -> + ?anorm:float -> + ?work:vec -> + ?rwork:rvec -> + ?ar:int -> + ?ac:int -> mat -> float (** [gecon ?n ?norm ?anorm ?work ?rwork ?ar ?ac a] @@ -145,18 +132,18 @@ val sycon_min_lwork : int -> int the [sycon]-function *) val sycon : - ?n : int -> - ?up : bool -> - ?ipiv : int32_vec -> - ?anorm : float -> - ?work : vec -> - ?ar : int -> - ?ac : int -> - mat -> - float + ?n:int -> + ?up:bool -> + ?ipiv:int32_vec -> + ?anorm:float -> + ?work:vec -> + ?ar:int -> + ?ac:int -> + mat -> + float (** [sycon ?n ?up ?ipiv ?anorm ?work ?ar ?ac a] - @return estimate of the reciprocal of the - condition number of symmetric matrix [a] + @return + estimate of the reciprocal of the condition number of symmetric matrix [a] @param n default = available number of columns of matrix [a] @param up default = upper triangle of the factorization of [a] is stored @param ipiv default = vec of length [n] @@ -177,21 +164,22 @@ val pocon_min_lrwork : int -> int @param n the logical dimensions of the matrix given to [pocon]-function *) val pocon : - ?n : int -> - ?up : bool -> - ?anorm : float -> - ?work : vec -> - ?rwork : rvec -> - ?ar : int -> - ?ac : int -> - mat -> - float + ?n:int -> + ?up:bool -> + ?anorm:float -> + ?work:vec -> + ?rwork:rvec -> + ?ar:int -> + ?ac:int -> + mat -> + float (** [pocon ?n ?up ?anorm ?work ?rwork ?ar ?ac a] - @return estimate of the reciprocal of the condition number of - complex Hermitian positive definite matrix [a] + @return + estimate of the reciprocal of the condition number of complex Hermitian + positive definite matrix [a] @param n default = available number of columns of matrix [a] - @param up default = upper triangle of Cholesky factorization - of [a] is stored + @param up + default = upper triangle of Cholesky factorization of [a] is stored @param work default = automatically allocated workspace @param rwork default = automatically allocated workspace @param anorm default = 1-norm of the matrix [a] as returned by [lange] *) @@ -199,53 +187,69 @@ val pocon : (** {7 General Schur factorization} *) val gees : - ?n : int -> - ?jobvs : Common.schur_vectors -> - ?sort : Common.eigen_value_sort -> - ?w : vec -> - ?vsr : int -> ?vsc : int -> ?vs : mat -> - ?work : vec -> - ?ar : int -> ?ac : int -> - mat -> int * vec * mat - (** [gees ?n ?jobvs ?sort ?w ?vsr ?vsc ?vs ?work ?ar ?ac a] - See [gees]-function for details about arguments. - @return (sdim, w, vs) *) - + ?n:int -> + ?jobvs:Common.schur_vectors -> + ?sort:Common.eigen_value_sort -> + ?w:vec -> + ?vsr:int -> + ?vsc:int -> + ?vs:mat -> + ?work:vec -> + ?ar:int -> + ?ac:int -> + mat -> + int * vec * mat +(** [gees ?n ?jobvs ?sort ?w ?vsr ?vsc ?vs ?work ?ar ?ac a] See [gees]-function + for details about arguments. + @return (sdim, w, vs) *) (** {7 General SVD routines} *) -val gesvd_min_lwork : m : int -> n : int -> int +val gesvd_min_lwork : m:int -> n:int -> int (** [gesvd_min_lwork ~m ~n] @return the minimum length of the work array used by the [gesvd]-function for matrices with [m] rows and [n] columns. *) -val gesvd_lrwork : m : int -> n : int -> int +val gesvd_lrwork : m:int -> n:int -> int (** [gesvd_lrwork m n] @return the (minimum) length of the rwork array used by the [gesvd]-function. *) val gesvd_opt_lwork : - ?m : int -> ?n : int -> - ?jobu : svd_job -> - ?jobvt : svd_job -> - ?s : rvec -> - ?ur : int -> ?uc : int -> ?u : mat -> - ?vtr : int -> ?vtc : int -> ?vt : mat -> - ?ar : int -> ?ac : int -> mat -> + ?m:int -> + ?n:int -> + ?jobu:svd_job -> + ?jobvt:svd_job -> + ?s:rvec -> + ?ur:int -> + ?uc:int -> + ?u:mat -> + ?vtr:int -> + ?vtc:int -> + ?vt:mat -> + ?ar:int -> + ?ac:int -> + mat -> int val gesvd : - ?m : int -> ?n : int -> - ?jobu : svd_job -> - ?jobvt : svd_job -> - ?s : rvec -> - ?ur : int -> ?uc : int -> ?u : mat -> - ?vtr : int -> ?vtc : int -> ?vt : mat -> - ?work : vec -> - ?rwork : rvec -> - ?ar : int -> ?ac : int -> mat -> + ?m:int -> + ?n:int -> + ?jobu:svd_job -> + ?jobvt:svd_job -> + ?s:rvec -> + ?ur:int -> + ?uc:int -> + ?u:mat -> + ?vtr:int -> + ?vtc:int -> + ?vt:mat -> + ?work:vec -> + ?rwork:rvec -> + ?ar:int -> + ?ac:int -> + mat -> rvec * mat * mat - (** {7 General eigenvalue problem (simple drivers)} *) val geev_min_lwork : int -> int @@ -259,45 +263,60 @@ val geev_min_lrwork : int -> int @param n the logical dimensions of the matrix given to [geev]-function *) val geev_opt_lwork : - ?n : int -> - ?vlr : int -> ?vlc : int -> ?vl : mat option -> - ?vrr : int -> ?vrc : int -> ?vr : mat option -> - ?ofsw : int -> ?w : vec -> - ?ar : int -> ?ac : int -> mat -> + ?n:int -> + ?vlr:int -> + ?vlc:int -> + ?vl:mat option -> + ?vrr:int -> + ?vrc:int -> + ?vr:mat option -> + ?ofsw:int -> + ?w:vec -> + ?ar:int -> + ?ac:int -> + mat -> int - (** [geev ?work ?rwork ?n ?vlr ?vlc ?vl ?vrr ?vrc ?vr ?ofsw w ?ar ?ac a] - See [geev]-function for details about arguments. - @return "optimal" work size *) +(** [geev ?work ?rwork ?n ?vlr ?vlc ?vl ?vrr ?vrc ?vr ?ofsw w ?ar ?ac a] See + [geev]-function for details about arguments. + @return "optimal" work size *) val geev : - ?n : int -> - ?work : vec -> - ?rwork : vec -> - ?vlr : int -> ?vlc : int -> ?vl : mat option -> - ?vrr : int -> ?vrc : int -> ?vr : mat option -> - ?ofsw : int -> ?w : vec -> - ?ar : int -> ?ac : int -> mat -> + ?n:int -> + ?work:vec -> + ?rwork:vec -> + ?vlr:int -> + ?vlc:int -> + ?vl:mat option -> + ?vrr:int -> + ?vrc:int -> + ?vr:mat option -> + ?ofsw:int -> + ?w:vec -> + ?ar:int -> + ?ac:int -> + mat -> mat * vec * mat (** [geev ?work ?rwork ?n ?vlr ?vlc ?vl ?vrr ?vrc ?vr ?ofsw w ?ar ?ac a] - @return [(lv, w, rv)], where [lv] and [rv] correspond to the left and - right eigenvectors respectively, [w] to the eigenvalues. [lv] ([rv]) - is the empty matrix if [vl] ([vr]) is set to [None]. + @return + [(lv, w, rv)], where [lv] and [rv] correspond to the left and right + eigenvectors respectively, [w] to the eigenvalues. [lv] ([rv]) is the + empty matrix if [vl] ([vr]) is set to [None]. @raise Failure if the function fails to converge @param n default = available number of columns of matrix [a] @param work default = automatically allocated workspace @param rwork default = automatically allocated workspace - @param vl default = Automatically allocated left eigenvectors. - Pass [None] if you do not want to compute them, - [Some lv] if you want to provide the storage. - You can set [vlr], [vlc] in the last case. - (See LAPACK GEEV docs for details about storage of complex eigenvectors) - @param vr default = Automatically allocated right eigenvectors. - Pass [None] if you do not want to compute them, - [Some rv] if you want to provide the storage. - You can set [vrr], [vrc] in the last case. + @param vl + default = Automatically allocated left eigenvectors. Pass [None] if you do + not want to compute them, [Some lv] if you want to provide the storage. + You can set [vlr], [vlc] in the last case. (See LAPACK GEEV docs for + details about storage of complex eigenvectors) + @param vr + default = Automatically allocated right eigenvectors. Pass [None] if you + do not want to compute them, [Some rv] if you want to provide the storage. + You can set [vrr], [vrc] in the last case. @param w default = automatically allocate eigenvalues @param a the matrix whose eigensystem is computed *) diff --git a/src/impl_SD.h b/src/impl_SD.h index 2ba770b..b3da679 100644 --- a/src/impl_SD.h +++ b/src/impl_SD.h @@ -1,22 +1,14 @@ /* File: impl_SD.h - Copyright (C) 2001- + Copyright © 2001- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - Liam Stewart - email: liam@cs.toronto.edu - WWW: http://www.cs.toronto.edu/~liam + Liam Stewart - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umh.ac.be/an/ + Christophe Troestler - Florent Hoareau - email: h.florent@gmail.com - WWW: none + Florent Hoareau This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public @@ -30,7 +22,7 @@ You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "lacaml_macros.h" @@ -39,177 +31,110 @@ /** DOT */ -extern REAL FUN(dot)( - integer *N, - REAL *X, integer *INCX, - REAL *Y, integer *INCY); +extern REAL FUN(dot)(integer *N, REAL *X, integer *INCX, REAL *Y, + integer *INCY); -CAMLprim double LFUN(dot_stub)( - intnat vN, - intnat vOFSX, intnat vINCX, value vX, - intnat vOFSY, intnat vINCY, value vY) -{ +CAMLprim double LFUN(dot_stub)(intnat vN, intnat vOFSX, intnat vINCX, value vX, + intnat vOFSY, intnat vINCY, value vY) { CAMLparam2(vX, vY); - integer GET_INT(N), - GET_INT(INCX), - GET_INT(INCY); + integer GET_INT(N), GET_INT(INCX), GET_INT(INCY); REAL res; VEC_PARAMS(X); VEC_PARAMS(Y); - caml_enter_blocking_section(); /* Allow other threads */ - res = - FUN(dot)( - &N, - X_data, &INCX, - Y_data, &INCY); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + res = FUN(dot)(&N, X_data, &INCX, Y_data, &INCY); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturnT(double, res); } -CAMLprim value LFUN(dot_stub_bc)(value *argv, int __unused argn) -{ - return - caml_copy_double( - LFUN(dot_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - Int_val(argv[2]), - argv[3], - Int_val(argv[4]), - Int_val(argv[5]), - argv[6])); +CAMLprim value LFUN(dot_stub_bc)(value *argv, int __unused argn) { + return caml_copy_double( + LFUN(dot_stub)(Int_val(argv[0]), Int_val(argv[1]), Int_val(argv[2]), + argv[3], Int_val(argv[4]), Int_val(argv[5]), argv[6])); } - /** ASUM */ extern REAL FUN(asum)(integer *N, REAL *X, integer *INCX); -CAMLprim double LFUN(asum_stub)(intnat vN, intnat vOFSX, intnat vINCX, value vX) -{ +CAMLprim double LFUN(asum_stub)(intnat vN, intnat vOFSX, intnat vINCX, + value vX) { CAMLparam1(vX); - integer GET_INT(N), - GET_INT(INCX); + integer GET_INT(N), GET_INT(INCX); REAL res; VEC_PARAMS(X); - caml_enter_blocking_section(); /* Allow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ res = FUN(asum)(&N, X_data, &INCX); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturnT(double, res); } -CAMLprim value LFUN(asum_stub_bc)(value vN, value vOFSX, value vINCX, value vX) -{ - return - caml_copy_double( - LFUN(asum_stub)( - Int_val(vN), - Int_val(vOFSX), - Int_val(vINCX), - vX)); +CAMLprim value LFUN(asum_stub_bc)(value vN, value vOFSX, value vINCX, + value vX) { + return caml_copy_double( + LFUN(asum_stub)(Int_val(vN), Int_val(vOFSX), Int_val(vINCX), vX)); } - /*** BLAS-2 */ /** SBMV */ -extern void FUN(sbmv)( - char *UPLO, - integer *N, integer *K, - REAL *ALPHA, - REAL *A, integer *LDA, - REAL *X, integer *INCX, - REAL *BETA, - REAL *Y, integer *INCY); - -CAMLprim value LFUN(sbmv_stub)( - intnat vOFSY, intnat vINCY, value vY, - intnat vAR, intnat vAC, value vA, - intnat vN, intnat vK, - value vUPLO, - double vALPHA, - double vBETA, - intnat vOFSX, intnat vINCX, value vX) -{ +extern void FUN(sbmv)(char *UPLO, integer *N, integer *K, REAL *ALPHA, REAL *A, + integer *LDA, REAL *X, integer *INCX, REAL *BETA, REAL *Y, + integer *INCY); + +CAMLprim value LFUN(sbmv_stub)(intnat vOFSY, intnat vINCY, value vY, intnat vAR, + intnat vAC, value vA, intnat vN, intnat vK, + value vUPLO, double vALPHA, double vBETA, + intnat vOFSX, intnat vINCX, value vX) { CAMLparam3(vA, vX, vY); char GET_CHAR(UPLO); - integer GET_INT(N), - GET_INT(K), - GET_INT(INCX), - GET_INT(INCY); + integer GET_INT(N), GET_INT(K), GET_INT(INCX), GET_INT(INCY); - REAL GET_DOUBLE(ALPHA), - GET_DOUBLE(BETA); + REAL GET_DOUBLE(ALPHA), GET_DOUBLE(BETA); MAT_PARAMS(A); VEC_PARAMS(X); VEC_PARAMS(Y); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(sbmv)( - &UPLO, - &N, &K, - &ALPHA, - A_data, &rows_A, - X_data, &INCX, - &BETA, - Y_data, &INCY); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(sbmv)(&UPLO, &N, &K, &ALPHA, A_data, &rows_A, X_data, &INCX, &BETA, + Y_data, &INCY); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(Val_unit); } -CAMLprim value LFUN(sbmv_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(sbmv_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - argv[2], - Int_val(argv[3]), - Int_val(argv[4]), - argv[5], - Int_val(argv[6]), - Int_val(argv[7]), - argv[8], - Double_val(argv[9]), - Double_val(argv[10]), - Int_val(argv[11]), - Int_val(argv[12]), - argv[13]); +CAMLprim value LFUN(sbmv_stub_bc)(value *argv, int __unused argn) { + return LFUN(sbmv_stub)(Int_val(argv[0]), Int_val(argv[1]), argv[2], + Int_val(argv[3]), Int_val(argv[4]), argv[5], + Int_val(argv[6]), Int_val(argv[7]), argv[8], + Double_val(argv[9]), Double_val(argv[10]), + Int_val(argv[11]), Int_val(argv[12]), argv[13]); } - /** GER */ -extern void FUN(ger)( - integer *M, - integer *N, - REAL *ALPHA, - REAL *X, integer *INCX, - REAL *Y, integer *INCY, - REAL *A, integer *LDA); - -CAMLprim value LFUN(ger_stub)( - intnat vM, intnat vN, - double vALPHA, - intnat vOFSX, intnat vINCX, value vX, - intnat vOFSY, intnat vINCY, value vY, - intnat vAR, intnat vAC, value vA) -{ +extern void FUN(ger)(integer *M, integer *N, REAL *ALPHA, REAL *X, + integer *INCX, REAL *Y, integer *INCY, REAL *A, + integer *LDA); + +CAMLprim value LFUN(ger_stub)(intnat vM, intnat vN, double vALPHA, intnat vOFSX, + intnat vINCX, value vX, intnat vOFSY, + intnat vINCY, value vY, intnat vAR, intnat vAC, + value vA) { CAMLparam3(vA, vX, vY); integer GET_INT(M), GET_INT(N), GET_INT(INCX), GET_INT(INCY); @@ -220,110 +145,61 @@ CAMLprim value LFUN(ger_stub)( VEC_PARAMS(X); VEC_PARAMS(Y); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(ger)( - &M, - &N, - &ALPHA, - X_data, &INCX, - Y_data, &INCY, - A_data, &rows_A); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(ger)(&M, &N, &ALPHA, X_data, &INCX, Y_data, &INCY, A_data, &rows_A); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(Val_unit); } -CAMLprim value LFUN(ger_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(ger_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - Double_val(argv[2]), - Int_val(argv[3]), - Int_val(argv[4]), - argv[5], - Int_val(argv[6]), - Int_val(argv[7]), - argv[8], - Int_val(argv[9]), - Int_val(argv[10]), - argv[11]); +CAMLprim value LFUN(ger_stub_bc)(value *argv, int __unused argn) { + return LFUN(ger_stub)(Int_val(argv[0]), Int_val(argv[1]), Double_val(argv[2]), + Int_val(argv[3]), Int_val(argv[4]), argv[5], + Int_val(argv[6]), Int_val(argv[7]), argv[8], + Int_val(argv[9]), Int_val(argv[10]), argv[11]); } - /** SYR */ -extern void FUN(syr)( - char *UPLO, - integer *N, - REAL *ALPHA, - REAL *X, integer *INCX, - REAL *A, integer *LDA); - -CAMLprim value LFUN(syr_stub)( - value vUPLO, - intnat vN, - double vALPHA, - intnat vOFSX, intnat vINCX, value vX, - intnat vAR, intnat vAC, value vA) -{ +extern void FUN(syr)(char *UPLO, integer *N, REAL *ALPHA, REAL *X, + integer *INCX, REAL *A, integer *LDA); + +CAMLprim value LFUN(syr_stub)(value vUPLO, intnat vN, double vALPHA, + intnat vOFSX, intnat vINCX, value vX, intnat vAR, + intnat vAC, value vA) { CAMLparam2(vA, vX); char GET_CHAR(UPLO); - integer GET_INT(N), - GET_INT(INCX); + integer GET_INT(N), GET_INT(INCX); REAL GET_DOUBLE(ALPHA); MAT_PARAMS(A); VEC_PARAMS(X); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(syr)( - &UPLO, - &N, - &ALPHA, - X_data, &INCX, - A_data, &rows_A); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(syr)(&UPLO, &N, &ALPHA, X_data, &INCX, A_data, &rows_A); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(Val_unit); } -CAMLprim value LFUN(syr_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(syr_stub)( - argv[0], - Int_val(argv[1]), - Double_val(argv[2]), - Int_val(argv[3]), - Int_val(argv[4]), - argv[5], - Int_val(argv[6]), - Int_val(argv[7]), - argv[8]); +CAMLprim value LFUN(syr_stub_bc)(value *argv, int __unused argn) { + return LFUN(syr_stub)(argv[0], Int_val(argv[1]), Double_val(argv[2]), + Int_val(argv[3]), Int_val(argv[4]), argv[5], + Int_val(argv[6]), Int_val(argv[7]), argv[8]); } - /*** LAPACK */ /** LANSY */ -extern REAL FUN(lansy)( - char *NORM, char *UPLO, - integer *N, - REAL *A, integer *LDA, - REAL *WORK); - -CAMLprim double LFUN(lansy_stub)( - value vNORM, - value vUPLO, - intnat vN, - intnat vAR, intnat vAC, value vA, - value vWORK) -{ +extern REAL FUN(lansy)(char *NORM, char *UPLO, integer *N, REAL *A, + integer *LDA, REAL *WORK); + +CAMLprim double LFUN(lansy_stub)(value vNORM, value vUPLO, intnat vN, + intnat vAR, intnat vAC, value vA, + value vWORK) { CAMLparam2(vA, vWORK); char GET_CHAR(NORM), GET_CHAR(UPLO); @@ -334,64 +210,41 @@ CAMLprim double LFUN(lansy_stub)( MAT_PARAMS(A); RVEC_PARAMS1(WORK); - caml_enter_blocking_section(); /* Allow other threads */ - res = FUN(lansy)( - &NORM, &UPLO, &N, - A_data, &rows_A, - WORK_data); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + res = FUN(lansy)(&NORM, &UPLO, &N, A_data, &rows_A, WORK_data); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturnT(double, res); } -CAMLprim value LFUN(lansy_stub_bc)(value *argv, int __unused argn) -{ - return - caml_copy_double( - LFUN(lansy_stub)( - argv[0], - argv[1], - Int_val(argv[2]), - Int_val(argv[3]), - Int_val(argv[4]), - argv[5], - argv[6])); +CAMLprim value LFUN(lansy_stub_bc)(value *argv, int __unused argn) { + return caml_copy_double(LFUN(lansy_stub)(argv[0], argv[1], Int_val(argv[2]), + Int_val(argv[3]), Int_val(argv[4]), + argv[5], argv[6])); } - /** LAMCH */ extern REAL FUN(lamch)(char *CMACH); -CAMLprim double LFUN(lamch_stub)(value vCMACH) -{ +CAMLprim double LFUN(lamch_stub)(value vCMACH) { char GET_CHAR(CMACH); return FUN(lamch)(&CMACH); } -CAMLprim value LFUN(lamch_stub_bc)(value vCMACH) -{ +CAMLprim value LFUN(lamch_stub_bc)(value vCMACH) { return caml_copy_double(LFUN(lamch_stub)(vCMACH)); } - /** ORGQR */ -extern void FUN(orgqr)( - integer *M, - integer *N, - integer *K, - REAL *A, integer *LDA, - REAL *TAU, - REAL *WORK, integer *LWORK, - integer *INFO); - -CAMLprim intnat LFUN(orgqr_stub)( - intnat vM, intnat vN, intnat vK, - value vWORK, intnat vLWORK, - value vTAU, - intnat vAR, intnat vAC, value vA) -{ +extern void FUN(orgqr)(integer *M, integer *N, integer *K, REAL *A, + integer *LDA, REAL *TAU, REAL *WORK, integer *LWORK, + integer *INFO); + +CAMLprim intnat LFUN(orgqr_stub)(intnat vM, intnat vN, intnat vK, value vWORK, + intnat vLWORK, value vTAU, intnat vAR, + intnat vAC, value vA) { CAMLparam2(vTAU, vA); integer GET_INT(M), GET_INT(N), GET_INT(K), GET_INT(LWORK), INFO; @@ -400,57 +253,30 @@ CAMLprim intnat LFUN(orgqr_stub)( VEC_PARAMS1(TAU); MAT_PARAMS(A); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(orgqr)( - &M, &N, &K, - A_data, &rows_A, - TAU_data, - WORK_data, &LWORK, &INFO); + caml_enter_blocking_section(); /* Allow other threads */ + FUN(orgqr)(&M, &N, &K, A_data, &rows_A, TAU_data, WORK_data, &LWORK, &INFO); caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(INFO); } -CAMLprim value LFUN(orgqr_stub_bc)(value *argv, int __unused argn) -{ - return - Val_int( - LFUN(orgqr_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - Int_val(argv[2]), - argv[3], - Int_val(argv[4]), - argv[5], - Int_val(argv[6]), - Int_val(argv[7]), - argv[8])); +CAMLprim value LFUN(orgqr_stub_bc)(value *argv, int __unused argn) { + return Val_int(LFUN(orgqr_stub)( + Int_val(argv[0]), Int_val(argv[1]), Int_val(argv[2]), argv[3], + Int_val(argv[4]), argv[5], Int_val(argv[6]), Int_val(argv[7]), argv[8])); } - /** ORMQR */ -extern void FUN(ormqr)( - char *SIDE, - char *TRANS, - integer *M, - integer *N, - integer *K, - REAL *A, integer *LDA, - REAL *TAU, - REAL *C, integer *LDC, - REAL *WORK, integer *LWORK, - integer *INFO); - -CAMLprim intnat LFUN(ormqr_stub)( - value vSIDE, - value vTRANS, - intnat vM, intnat vN, intnat vK, - value vWORK, intnat vLWORK, - value vTAU, - intnat vAR, intnat vAC, value vA, - intnat vCR, intnat vCC, value vC) -{ +extern void FUN(ormqr)(char *SIDE, char *TRANS, integer *M, integer *N, + integer *K, REAL *A, integer *LDA, REAL *TAU, REAL *C, + integer *LDC, REAL *WORK, integer *LWORK, integer *INFO); + +CAMLprim intnat LFUN(ormqr_stub)(value vSIDE, value vTRANS, intnat vM, + intnat vN, intnat vK, value vWORK, + intnat vLWORK, value vTAU, intnat vAR, + intnat vAC, value vA, intnat vCR, intnat vCC, + value vC) { CAMLparam3(vTAU, vA, vC); char GET_CHAR(SIDE), GET_CHAR(TRANS); @@ -461,58 +287,30 @@ CAMLprim intnat LFUN(ormqr_stub)( MAT_PARAMS(A); MAT_PARAMS(C); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(ormqr)( - &SIDE, &TRANS, &M, &N, &K, - A_data, &rows_A, - TAU_data, - C_data, &rows_C, - WORK_data, &LWORK, &INFO); + caml_enter_blocking_section(); /* Allow other threads */ + FUN(ormqr)(&SIDE, &TRANS, &M, &N, &K, A_data, &rows_A, TAU_data, C_data, + &rows_C, WORK_data, &LWORK, &INFO); caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(INFO); } -CAMLprim value LFUN(ormqr_stub_bc)(value *argv, int __unused argn) -{ - return - Val_int( - LFUN(ormqr_stub)( - argv[0], - argv[1], - Int_val(argv[2]), - Int_val(argv[3]), - Int_val(argv[4]), - argv[5], - Int_val(argv[6]), - argv[7], - Int_val(argv[8]), - Int_val(argv[9]), - argv[10], - Int_val(argv[11]), - Int_val(argv[12]), - argv[13])); +CAMLprim value LFUN(ormqr_stub_bc)(value *argv, int __unused argn) { + return Val_int(LFUN(ormqr_stub)( + argv[0], argv[1], Int_val(argv[2]), Int_val(argv[3]), Int_val(argv[4]), + argv[5], Int_val(argv[6]), argv[7], Int_val(argv[8]), Int_val(argv[9]), + argv[10], Int_val(argv[11]), Int_val(argv[12]), argv[13])); } - /** GECON */ -extern void FUN(gecon)( - char *NORM, - integer *N, - REAL *A, integer *LDA, - REAL *ANORM, REAL *RCOND, - REAL *WORK, integer *IWORK, - integer *INFO); - -CAMLprim value LFUN(gecon_stub)( - intnat vN, - intnat vAR, intnat vAC, value vA, - value vWORK, - value vIWORK, - value vNORM, - double vANORM) -{ +extern void FUN(gecon)(char *NORM, integer *N, REAL *A, integer *LDA, + REAL *ANORM, REAL *RCOND, REAL *WORK, integer *IWORK, + integer *INFO); + +CAMLprim value LFUN(gecon_stub)(intnat vN, intnat vAR, intnat vAC, value vA, + value vWORK, value vIWORK, value vNORM, + double vANORM) { CAMLparam3(vA, vWORK, vIWORK); CAMLlocal1(v_rcond); @@ -526,12 +324,9 @@ CAMLprim value LFUN(gecon_stub)( VEC_PARAMS1(WORK); INT_VEC_PARAMS(IWORK); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(gecon)( - &NORM, &N, - A_data, &rows_A, - &ANORM, &RCOND, - WORK_data, IWORK_data, &INFO); + caml_enter_blocking_section(); /* Allow other threads */ + FUN(gecon)(&NORM, &N, A_data, &rows_A, &ANORM, &RCOND, WORK_data, IWORK_data, + &INFO); caml_leave_blocking_section(); /* Disallow other threads */ v_rcond = caml_copy_double(RCOND); @@ -542,40 +337,21 @@ CAMLprim value LFUN(gecon_stub)( CAMLreturn(v_res); } -CAMLprim value LFUN(gecon_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(gecon_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - Int_val(argv[2]), - argv[3], - argv[4], - argv[5], - argv[6], - Double_val(argv[7])); +CAMLprim value LFUN(gecon_stub_bc)(value *argv, int __unused argn) { + return LFUN(gecon_stub)(Int_val(argv[0]), Int_val(argv[1]), Int_val(argv[2]), + argv[3], argv[4], argv[5], argv[6], + Double_val(argv[7])); } /** SYCON */ -extern void FUN(sycon)( - char *UPLO, - integer *N, - REAL *A, integer *LDA, - integer *IPIV, - REAL *ANORM, REAL *RCOND, - REAL *WORK, integer *IWORK, - integer *INFO); - -CAMLprim value LFUN(sycon_stub)( - value vUPLO, - intnat vN, - intnat vAR, intnat vAC, value vA, - value vIPIV, - value vWORK, - value vIWORK, - double vANORM) -{ +extern void FUN(sycon)(char *UPLO, integer *N, REAL *A, integer *LDA, + integer *IPIV, REAL *ANORM, REAL *RCOND, REAL *WORK, + integer *IWORK, integer *INFO); + +CAMLprim value LFUN(sycon_stub)(value vUPLO, intnat vN, intnat vAR, intnat vAC, + value vA, value vIPIV, value vWORK, + value vIWORK, double vANORM) { CAMLparam4(vA, vIPIV, vWORK, vIWORK); CAMLlocal1(v_rcond); @@ -590,13 +366,9 @@ CAMLprim value LFUN(sycon_stub)( VEC_PARAMS1(WORK); INT_VEC_PARAMS(IWORK); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(sycon)( - &UPLO, &N, - A_data, &rows_A, - IPIV_data, - &ANORM, &RCOND, - WORK_data, IWORK_data, &INFO); + caml_enter_blocking_section(); /* Allow other threads */ + FUN(sycon)(&UPLO, &N, A_data, &rows_A, IPIV_data, &ANORM, &RCOND, WORK_data, + IWORK_data, &INFO); caml_leave_blocking_section(); /* Disallow other threads */ v_rcond = caml_copy_double(RCOND); @@ -607,39 +379,21 @@ CAMLprim value LFUN(sycon_stub)( CAMLreturn(v_res); } -CAMLprim value LFUN(sycon_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(sycon_stub)( - argv[0], - Int_val(argv[1]), - Int_val(argv[2]), - Int_val(argv[3]), - argv[4], - argv[5], - argv[6], - argv[7], - Double_val(argv[8])); +CAMLprim value LFUN(sycon_stub_bc)(value *argv, int __unused argn) { + return LFUN(sycon_stub)(argv[0], Int_val(argv[1]), Int_val(argv[2]), + Int_val(argv[3]), argv[4], argv[5], argv[6], argv[7], + Double_val(argv[8])); } /** POCON */ -extern void FUN(pocon)( - char *UPLO, - integer *N, - REAL *A, integer *LDA, - REAL *ANORM, REAL *RCOND, - REAL *WORK, integer *IWORK, - integer *INFO); - -CAMLprim value LFUN(pocon_stub)( - value vUPLO, - intnat vN, - intnat vAR, intnat vAC, value vA, - value vWORK, - value vIWORK, - double vANORM) -{ +extern void FUN(pocon)(char *UPLO, integer *N, REAL *A, integer *LDA, + REAL *ANORM, REAL *RCOND, REAL *WORK, integer *IWORK, + integer *INFO); + +CAMLprim value LFUN(pocon_stub)(value vUPLO, intnat vN, intnat vAR, intnat vAC, + value vA, value vWORK, value vIWORK, + double vANORM) { CAMLparam3(vA, vWORK, vIWORK); CAMLlocal1(v_rcond); @@ -653,12 +407,9 @@ CAMLprim value LFUN(pocon_stub)( VEC_PARAMS1(WORK); INT_VEC_PARAMS(IWORK); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(pocon)( - &UPLO, &N, - A_data, &rows_A, - &ANORM, &RCOND, - WORK_data, IWORK_data, &INFO); + caml_enter_blocking_section(); /* Allow other threads */ + FUN(pocon)(&UPLO, &N, A_data, &rows_A, &ANORM, &RCOND, WORK_data, IWORK_data, + &INFO); caml_leave_blocking_section(); /* Disallow other threads */ v_rcond = caml_copy_double(RCOND); @@ -669,18 +420,10 @@ CAMLprim value LFUN(pocon_stub)( CAMLreturn(v_res); } -CAMLprim value LFUN(pocon_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(pocon_stub)( - argv[0], - Int_val(argv[1]), - Int_val(argv[2]), - Int_val(argv[3]), - argv[4], - argv[5], - argv[6], - Double_val(argv[7])); +CAMLprim value LFUN(pocon_stub_bc)(value *argv, int __unused argn) { + return LFUN(pocon_stub)(argv[0], Int_val(argv[1]), Int_val(argv[2]), + Int_val(argv[3]), argv[4], argv[5], argv[6], + Double_val(argv[7])); } /* Least squares (expert drivers) @@ -688,32 +431,18 @@ CAMLprim value LFUN(pocon_stub_bc)(value *argv, int __unused argn) /** GELSY */ -extern void FUN(gelsy)( - integer *M, integer *N, integer *NRHS, - REAL *A, integer *LDA, - REAL *B, integer *LDB, - integer *JPVT, REAL *RCOND, integer *RANK, - REAL *WORK, integer *LWORK, - integer *INFO); - -CAMLprim value LFUN(gelsy_stub)( - intnat vAR, intnat vAC, value vA, - intnat vM, intnat vN, - value vJPVT, - double vRCOND, - value vWORK, - intnat vLWORK, - intnat vNRHS, - intnat vBR, intnat vBC, value vB) -{ +extern void FUN(gelsy)(integer *M, integer *N, integer *NRHS, REAL *A, + integer *LDA, REAL *B, integer *LDB, integer *JPVT, + REAL *RCOND, integer *RANK, REAL *WORK, integer *LWORK, + integer *INFO); + +CAMLprim value LFUN(gelsy_stub)(intnat vAR, intnat vAC, value vA, intnat vM, + intnat vN, value vJPVT, double vRCOND, + value vWORK, intnat vLWORK, intnat vNRHS, + intnat vBR, intnat vBC, value vB) { CAMLparam4(vA, vB, vJPVT, vWORK); - integer GET_INT(M), - GET_INT(N), - GET_INT(LWORK), - GET_INT(NRHS), - RANK, - INFO; + integer GET_INT(M), GET_INT(N), GET_INT(LWORK), GET_INT(NRHS), RANK, INFO; REAL GET_DOUBLE(RCOND); @@ -725,15 +454,10 @@ CAMLprim value LFUN(gelsy_stub)( value v_res; - caml_enter_blocking_section(); /* Allow other threads */ - FUN(gelsy)( - &M, &N, &NRHS, - A_data, &rows_A, - B_data, &rows_B, - JPVT_data, &RCOND, &RANK, - WORK_data, &LWORK, - &INFO); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(gelsy)(&M, &N, &NRHS, A_data, &rows_A, B_data, &rows_B, JPVT_data, &RCOND, + &RANK, WORK_data, &LWORK, &INFO); + caml_leave_blocking_section(); /* Disallow other threads */ v_res = caml_alloc_small(2, 0); Field(v_res, 0) = Val_int(INFO); @@ -742,54 +466,28 @@ CAMLprim value LFUN(gelsy_stub)( CAMLreturn(v_res); } -CAMLprim value LFUN(gelsy_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(gelsy_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - argv[2], - Int_val(argv[3]), - Int_val(argv[4]), - argv[5], - Double_val(argv[6]), - argv[7], - Int_val(argv[8]), - Int_val(argv[9]), - Int_val(argv[10]), - Int_val(argv[11]), - argv[12]); +CAMLprim value LFUN(gelsy_stub_bc)(value *argv, int __unused argn) { + return LFUN(gelsy_stub)( + Int_val(argv[0]), Int_val(argv[1]), argv[2], Int_val(argv[3]), + Int_val(argv[4]), argv[5], Double_val(argv[6]), argv[7], Int_val(argv[8]), + Int_val(argv[9]), Int_val(argv[10]), Int_val(argv[11]), argv[12]); } - /** GELSD */ -extern void FUN(gelsd)( - integer *M, integer *N, integer *NRHS, - REAL *A, integer *LDA, - REAL *B, integer *LDB, - REAL *S, REAL *RCOND, integer *RANK, - REAL *WORK, integer *LWORK, REAL *IWORK, - integer *INFO); - -CAMLprim value LFUN(gelsd_stub)( - intnat vAR, intnat vAC, value vA, - intnat vM, intnat vN, - intnat vOFSS, value vS, - double vRCOND, - value vWORK, intnat vLWORK, - value vIWORK, - intnat vNRHS, - intnat vBR, intnat vBC, value vB) -{ +extern void FUN(gelsd)(integer *M, integer *N, integer *NRHS, REAL *A, + integer *LDA, REAL *B, integer *LDB, REAL *S, + REAL *RCOND, integer *RANK, REAL *WORK, integer *LWORK, + REAL *IWORK, integer *INFO); + +CAMLprim value LFUN(gelsd_stub)(intnat vAR, intnat vAC, value vA, intnat vM, + intnat vN, intnat vOFSS, value vS, + double vRCOND, value vWORK, intnat vLWORK, + value vIWORK, intnat vNRHS, intnat vBR, + intnat vBC, value vB) { CAMLparam5(vA, vB, vS, vWORK, vIWORK); - integer GET_INT(M), - GET_INT(N), - GET_INT(LWORK), - GET_INT(NRHS), - RANK, - INFO; + integer GET_INT(M), GET_INT(N), GET_INT(LWORK), GET_INT(NRHS), RANK, INFO; REAL GET_DOUBLE(RCOND); @@ -802,16 +500,10 @@ CAMLprim value LFUN(gelsd_stub)( value v_res; - caml_enter_blocking_section(); /* Allow other threads */ - FUN(gelsd)( - &M, &N, &NRHS, - A_data, &rows_A, - B_data, &rows_B, - S_data, &RCOND, &RANK, - WORK_data, &LWORK, - IWORK_data, - &INFO); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(gelsd)(&M, &N, &NRHS, A_data, &rows_A, B_data, &rows_B, S_data, &RCOND, + &RANK, WORK_data, &LWORK, IWORK_data, &INFO); + caml_leave_blocking_section(); /* Disallow other threads */ v_res = caml_alloc_small(2, 0); Field(v_res, 0) = Val_int(INFO); @@ -820,55 +512,29 @@ CAMLprim value LFUN(gelsd_stub)( CAMLreturn(v_res); } -CAMLprim value LFUN(gelsd_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(gelsd_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - argv[2], - Int_val(argv[3]), - Int_val(argv[4]), - Int_val(argv[5]), - argv[6], - Double_val(argv[7]), - argv[8], - Int_val(argv[9]), - argv[10], - Int_val(argv[11]), - Int_val(argv[12]), - Int_val(argv[13]), - argv[14]); +CAMLprim value LFUN(gelsd_stub_bc)(value *argv, int __unused argn) { + return LFUN(gelsd_stub)(Int_val(argv[0]), Int_val(argv[1]), argv[2], + Int_val(argv[3]), Int_val(argv[4]), Int_val(argv[5]), + argv[6], Double_val(argv[7]), argv[8], + Int_val(argv[9]), argv[10], Int_val(argv[11]), + Int_val(argv[12]), Int_val(argv[13]), argv[14]); } - /** GELSS */ -extern void FUN(gelss)( - integer *M, integer *N, integer *NRHS, - NUMBER *A, integer *LDA, - NUMBER *B, integer *LDB, - REAL *S, REAL *RCOND, integer *RANK, - NUMBER *WORK, integer *LWORK, - integer *INFO); - -CAMLprim value LFUN(gelss_stub)( - intnat vAR, intnat vAC, value vA, - intnat vM, intnat vN, - intnat vOFSS, value vS, - double vRCOND, - value vWORK, intnat vLWORK, - intnat vNRHS, - intnat vBR, intnat vBC, value vB) -{ +extern void FUN(gelss)(integer *M, integer *N, integer *NRHS, NUMBER *A, + integer *LDA, NUMBER *B, integer *LDB, REAL *S, + REAL *RCOND, integer *RANK, NUMBER *WORK, integer *LWORK, + integer *INFO); + +CAMLprim value LFUN(gelss_stub)(intnat vAR, intnat vAC, value vA, intnat vM, + intnat vN, intnat vOFSS, value vS, + double vRCOND, value vWORK, intnat vLWORK, + intnat vNRHS, intnat vBR, intnat vBC, + value vB) { CAMLparam4(vA, vB, vS, vWORK); - integer GET_INT(M), - GET_INT(N), - GET_INT(LWORK), - GET_INT(NRHS), - RANK, - INFO; + integer GET_INT(M), GET_INT(N), GET_INT(LWORK), GET_INT(NRHS), RANK, INFO; REAL GET_DOUBLE(RCOND); @@ -880,15 +546,10 @@ CAMLprim value LFUN(gelss_stub)( value v_res; - caml_enter_blocking_section(); /* Allow other threads */ - FUN(gelss)( - &M, &N, &NRHS, - A_data, &rows_A, - B_data, &rows_B, - S_data, &RCOND, &RANK, - WORK_data, &LWORK, - &INFO); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(gelss)(&M, &N, &NRHS, A_data, &rows_A, B_data, &rows_B, S_data, &RCOND, + &RANK, WORK_data, &LWORK, &INFO); + caml_leave_blocking_section(); /* Disallow other threads */ v_res = caml_alloc_small(2, 0); Field(v_res, 0) = Val_int(INFO); @@ -897,24 +558,12 @@ CAMLprim value LFUN(gelss_stub)( CAMLreturn(v_res); } -CAMLprim value LFUN(gelss_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(gelss_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - argv[2], - Int_val(argv[3]), - Int_val(argv[4]), - Int_val(argv[5]), - argv[6], - Double_val(argv[7]), - argv[8], - Int_val(argv[9]), - Int_val(argv[10]), - Int_val(argv[11]), - Int_val(argv[12]), - argv[13]); +CAMLprim value LFUN(gelss_stub_bc)(value *argv, int __unused argn) { + return LFUN(gelss_stub)(Int_val(argv[0]), Int_val(argv[1]), argv[2], + Int_val(argv[3]), Int_val(argv[4]), Int_val(argv[5]), + argv[6], Double_val(argv[7]), argv[8], + Int_val(argv[9]), Int_val(argv[10]), + Int_val(argv[11]), Int_val(argv[12]), argv[13]); } /* General Schur factorization @@ -924,29 +573,25 @@ CAMLprim value LFUN(gelss_stub_bc)(value *argv, int __unused argn) /* Predefined callbacks for eigenvalue selection */ -static inline integer select_left_plane( - const REAL *re_ptr, const REAL *im_ptr __attribute__((unused))) -{ +static inline integer select_left_plane(const REAL *re_ptr, const REAL *im_ptr + __attribute__((unused))) { return (*re_ptr < 0) ? 1 : 0; } -static inline integer select_right_plane( - const REAL *re_ptr, const REAL *im_ptr __attribute__((unused)) ) -{ +static inline integer select_right_plane(const REAL *re_ptr, const REAL *im_ptr + __attribute__((unused))) { return (*re_ptr > 0) ? 1 : 0; } -static inline integer select_disk_interior( - const REAL *re_ptr, const REAL *im_ptr) -{ +static inline integer select_disk_interior(const REAL *re_ptr, + const REAL *im_ptr) { REAL re = *re_ptr; REAL im = *im_ptr; return (re * re + im * im < 1) ? 1 : 0; } -static inline integer select_disk_exterior( - const REAL *re_ptr, const REAL *im_ptr) -{ +static inline integer select_disk_exterior(const REAL *re_ptr, + const REAL *im_ptr) { REAL re = *re_ptr; REAL im = *im_ptr; return (re * re + im * im > 1) ? 1 : 0; @@ -958,16 +603,14 @@ static value select_ocaml_callback = Val_unit; static value select_ocaml_callback_exn = Val_unit; static bool select_ocaml_locked_runtime = false; -CAMLprim value LFUN(init_gees)(value __unused v_unit) -{ +CAMLprim value LFUN(init_gees)(value __unused v_unit) { caml_register_generational_global_root(&select_ocaml_callback); caml_register_generational_global_root(&select_ocaml_callback_exn); return Val_unit; } -static integer select_ocaml_exec_callback( - const REAL *re_ptr, const REAL *im_ptr) -{ +static integer select_ocaml_exec_callback(const REAL *re_ptr, + const REAL *im_ptr) { value v_res, v_arg; if (!select_ocaml_locked_runtime) { @@ -976,12 +619,13 @@ static integer select_ocaml_exec_callback( } v_arg = caml_alloc_small(2, Double_array_tag); - Store_double_field(v_arg, 0, (double) (*re_ptr)); - Store_double_field(v_arg, 1, (double) (*im_ptr)); + Store_double_field(v_arg, 0, (double)(*re_ptr)); + Store_double_field(v_arg, 1, (double)(*im_ptr)); v_res = caml_callback_exn(select_ocaml_callback, v_arg); - if (!Is_exception_result(v_res)) return Bool_val(v_res); + if (!Is_exception_result(v_res)) + return Bool_val(v_res); else { /* Callout raised an exception */ if (select_ocaml_callback_exn == Val_unit) { @@ -994,41 +638,23 @@ static integer select_ocaml_exec_callback( typedef integer (*LAPACK_SELECT2)(const REAL *, const REAL *); -extern void FUN(gees)( - char *JOBVS, char *SORT, - LAPACK_SELECT2 SELECT, - integer *N, - REAL *A, integer *LDA, - integer *SDIM, - REAL *WR, REAL *WI, - REAL *VS, integer *LDVS, - REAL *WORK, - integer *LWORK, - integer *BWORK, - integer *INFO); - -CAMLprim value LFUN(gees_stub)( - value vJOBVS, value vSORT, - intnat vSELECT, value vSELECT_FUN, - intnat vN, - intnat vAR, intnat vAC, value vA, - value vWR, value vWI, - intnat vVSR, intnat vVSC, value vVS, - value vWORK, intnat vLWORK, - value vBWORK) -{ +extern void FUN(gees)(char *JOBVS, char *SORT, LAPACK_SELECT2 SELECT, + integer *N, REAL *A, integer *LDA, integer *SDIM, + REAL *WR, REAL *WI, REAL *VS, integer *LDVS, REAL *WORK, + integer *LWORK, integer *BWORK, integer *INFO); + +CAMLprim value LFUN(gees_stub)(value vJOBVS, value vSORT, intnat vSELECT, + value vSELECT_FUN, intnat vN, intnat vAR, + intnat vAC, value vA, value vWR, value vWI, + intnat vVSR, intnat vVSC, value vVS, value vWORK, + intnat vLWORK, value vBWORK) { CAMLparam5(vA, vVS, vWI, vWR, vWORK); CAMLxparam2(vBWORK, vSELECT_FUN); CAMLlocal1(v_res); - char GET_CHAR(JOBVS), - GET_CHAR(SORT); + char GET_CHAR(JOBVS), GET_CHAR(SORT); - integer GET_INT(SELECT), - GET_INT(N), - GET_INT(LWORK), - SDIM, - INFO; + integer GET_INT(SELECT), GET_INT(N), GET_INT(LWORK), SDIM, INFO; MAT_PARAMS(A); MAT_PARAMS(VS); @@ -1042,61 +668,54 @@ CAMLprim value LFUN(gees_stub)( if (SORT == 'S') { switch (SELECT) { - case 0 : - select_function = select_left_plane; - break; - case 1 : - select_function = select_right_plane; - break; - case 2 : - select_function = select_disk_interior; - break; - case 3 : - select_function = select_disk_exterior; - break; - case 4 : - custom_sort = true; - select_function = select_ocaml_exec_callback; - while (select_ocaml_callback != Val_unit) { - caml_enter_blocking_section(); /* Allow other threads */ - /* Wait 1ms before polling again */ - portable_sleep(1); - caml_leave_blocking_section(); /* Disallow other threads */ - } - caml_modify_generational_global_root( - &select_ocaml_callback, vSELECT_FUN); - break; - default : - caml_failwith("internal error: unknown SELECT value in gees_stub"); + case 0: + select_function = select_left_plane; + break; + case 1: + select_function = select_right_plane; + break; + case 2: + select_function = select_disk_interior; + break; + case 3: + select_function = select_disk_exterior; + break; + case 4: + custom_sort = true; + select_function = select_ocaml_exec_callback; + while (select_ocaml_callback != Val_unit) { + caml_enter_blocking_section(); /* Allow other threads */ + /* Wait 1ms before polling again */ + portable_sleep(1); + caml_leave_blocking_section(); /* Disallow other threads */ + } + caml_modify_generational_global_root(&select_ocaml_callback, vSELECT_FUN); + break; + default: + caml_failwith("internal error: unknown SELECT value in gees_stub"); } } caml_enter_blocking_section(); /* Allow other threads */ - FUN(gees)( - &JOBVS, &SORT, - select_function, - &N, - A_data, &rows_A, - &SDIM, - WR_data, WI_data, - VS_data, &rows_VS, - WORK_data, - &LWORK, BWORK_data, - &INFO); + FUN(gees)(&JOBVS, &SORT, select_function, &N, A_data, &rows_A, &SDIM, WR_data, + WI_data, VS_data, &rows_VS, WORK_data, &LWORK, BWORK_data, &INFO); if (custom_sort) { - if (select_ocaml_locked_runtime) select_ocaml_locked_runtime = false; - else caml_leave_blocking_section(); /* Disallow other threads */ + if (select_ocaml_locked_runtime) + select_ocaml_locked_runtime = false; + else + caml_leave_blocking_section(); /* Disallow other threads */ caml_modify_generational_global_root(&select_ocaml_callback, Val_unit); if (select_ocaml_callback_exn != Val_unit) { CAMLlocal1(v_exn); v_exn = select_ocaml_callback_exn; - caml_modify_generational_global_root( - &select_ocaml_callback_exn, Val_unit); + caml_modify_generational_global_root(&select_ocaml_callback_exn, + Val_unit); caml_raise(v_exn); } - } else caml_leave_blocking_section(); /* Disallow other threads */ + } else + caml_leave_blocking_section(); /* Disallow other threads */ v_res = caml_alloc_small(2, 0); Field(v_res, 0) = Val_int(SDIM); @@ -1105,26 +724,12 @@ CAMLprim value LFUN(gees_stub)( CAMLreturn(v_res); } -CAMLprim value LFUN(gees_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(gees_stub)( - argv[0], - argv[1], - Int_val(argv[2]), - argv[3], - Int_val(argv[4]), - Int_val(argv[5]), - Int_val(argv[6]), - argv[7], - argv[8], - argv[9], - Int_val(argv[10]), - Int_val(argv[11]), - argv[12], - argv[13], - Int_val(argv[14]), - argv[15]); +CAMLprim value LFUN(gees_stub_bc)(value *argv, int __unused argn) { + return LFUN(gees_stub)(argv[0], argv[1], Int_val(argv[2]), argv[3], + Int_val(argv[4]), Int_val(argv[5]), Int_val(argv[6]), + argv[7], argv[8], argv[9], Int_val(argv[10]), + Int_val(argv[11]), argv[12], argv[13], + Int_val(argv[14]), argv[15]); } /* General SVD routines @@ -1132,33 +737,21 @@ CAMLprim value LFUN(gees_stub_bc)(value *argv, int __unused argn) /** GESVD */ -extern void FUN(gesvd)( - char *JOBU, char *JOBVT, - integer *M, integer *N, - REAL *A, integer *LDA, - REAL *S, - REAL *U, integer *LDU, - REAL *VT, integer *LDVT, - REAL *WORK, integer *LWORK, - integer *INFO); - -CAMLprim intnat LFUN(gesvd_stub)( - value vJOBU, value vJOBVT, - intnat vM, intnat vN, - intnat vAR, intnat vAC, value vA, - value vS, - intnat vUR, intnat vUC, value vU, - intnat vVTR, intnat vVTC, value vVT, - value vWORK, intnat vLWORK) -{ +extern void FUN(gesvd)(char *JOBU, char *JOBVT, integer *M, integer *N, REAL *A, + integer *LDA, REAL *S, REAL *U, integer *LDU, REAL *VT, + integer *LDVT, REAL *WORK, integer *LWORK, + integer *INFO); + +CAMLprim intnat LFUN(gesvd_stub)(value vJOBU, value vJOBVT, intnat vM, + intnat vN, intnat vAR, intnat vAC, value vA, + value vS, intnat vUR, intnat vUC, value vU, + intnat vVTR, intnat vVTC, value vVT, + value vWORK, intnat vLWORK) { CAMLparam5(vA, vS, vU, vVT, vWORK); - char GET_CHAR(JOBU), - GET_CHAR(JOBVT); + char GET_CHAR(JOBU), GET_CHAR(JOBVT); - integer GET_INT(M), GET_INT(N), - GET_INT(LWORK), - INFO; + integer GET_INT(M), GET_INT(N), GET_INT(LWORK), INFO; MAT_PARAMS(A); VEC_PARAMS1(S); @@ -1167,75 +760,39 @@ CAMLprim intnat LFUN(gesvd_stub)( VEC_PARAMS1(WORK); caml_enter_blocking_section(); /* Allow other threads */ - FUN(gesvd)( - &JOBU, &JOBVT, - &M, &N, - A_data, &rows_A, - S_data, - U_data, &rows_U, - VT_data, &rows_VT, - WORK_data, &LWORK, - &INFO); + FUN(gesvd)(&JOBU, &JOBVT, &M, &N, A_data, &rows_A, S_data, U_data, &rows_U, + VT_data, &rows_VT, WORK_data, &LWORK, &INFO); caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(INFO); } -CAMLprim value LFUN(gesvd_stub_bc)(value *argv, int __unused argn) -{ - return - Val_int( - LFUN(gesvd_stub)( - argv[0], - argv[1], - Int_val(argv[2]), - Int_val(argv[3]), - Int_val(argv[4]), - Int_val(argv[5]), - argv[6], - argv[7], - Int_val(argv[8]), - Int_val(argv[9]), - argv[10], - Int_val(argv[11]), - Int_val(argv[12]), - argv[13], - argv[14], - Int_val(argv[15]))); +CAMLprim value LFUN(gesvd_stub_bc)(value *argv, int __unused argn) { + return Val_int(LFUN(gesvd_stub)( + argv[0], argv[1], Int_val(argv[2]), Int_val(argv[3]), Int_val(argv[4]), + Int_val(argv[5]), argv[6], argv[7], Int_val(argv[8]), Int_val(argv[9]), + argv[10], Int_val(argv[11]), Int_val(argv[12]), argv[13], argv[14], + Int_val(argv[15]))); } - /** GESDD */ -extern void FUN(gesdd)( - char *JOBZ, - integer *M, integer *N, - REAL *A, integer *LDA, - REAL *S, - REAL *U, integer *LDU, - REAL *VT, integer *LDVT, - REAL *WORK, integer *LWORK, - integer *IWORK, - integer *INFO); - -CAMLprim intnat LFUN(gesdd_stub)( - value vJOBZ, - intnat vM, intnat vN, - intnat vAR, intnat vAC, value vA, - value vS, - intnat vUR, intnat vUC, value vU, - intnat vVTR, intnat vVTC, value vVT, - value vWORK, intnat vLWORK, - value vIWORK) -{ +extern void FUN(gesdd)(char *JOBZ, integer *M, integer *N, REAL *A, + integer *LDA, REAL *S, REAL *U, integer *LDU, REAL *VT, + integer *LDVT, REAL *WORK, integer *LWORK, + integer *IWORK, integer *INFO); + +CAMLprim intnat LFUN(gesdd_stub)(value vJOBZ, intnat vM, intnat vN, intnat vAR, + intnat vAC, value vA, value vS, intnat vUR, + intnat vUC, value vU, intnat vVTR, intnat vVTC, + value vVT, value vWORK, intnat vLWORK, + value vIWORK) { CAMLparam5(vA, vS, vU, vVT, vWORK); CAMLxparam1(vIWORK); char GET_CHAR(JOBZ); - integer GET_INT(M), GET_INT(N), - GET_INT(LWORK), - INFO; + integer GET_INT(M), GET_INT(N), GET_INT(LWORK), INFO; MAT_PARAMS(A); VEC_PARAMS1(S); @@ -1245,80 +802,43 @@ CAMLprim intnat LFUN(gesdd_stub)( INT_VEC_PARAMS(IWORK); caml_enter_blocking_section(); /* Allow other threads */ - FUN(gesdd)( - &JOBZ, - &M, &N, - A_data, &rows_A, - S_data, - U_data, &rows_U, - VT_data, &rows_VT, - WORK_data, &LWORK, - IWORK_data, - &INFO); + FUN(gesdd)(&JOBZ, &M, &N, A_data, &rows_A, S_data, U_data, &rows_U, VT_data, + &rows_VT, WORK_data, &LWORK, IWORK_data, &INFO); caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(INFO); } -CAMLprim value LFUN(gesdd_stub_bc)(value *argv, int __unused argn) -{ - return - Val_int( - LFUN(gesdd_stub)( - argv[0], - Int_val(argv[1]), - Int_val(argv[2]), - Int_val(argv[3]), - Int_val(argv[4]), - argv[5], - argv[6], - Int_val(argv[7]), - Int_val(argv[8]), - argv[9], - Int_val(argv[10]), - Int_val(argv[11]), - argv[12], - argv[13], - Int_val(argv[14]), - argv[15])); +CAMLprim value LFUN(gesdd_stub_bc)(value *argv, int __unused argn) { + return Val_int(LFUN(gesdd_stub)( + argv[0], Int_val(argv[1]), Int_val(argv[2]), Int_val(argv[3]), + Int_val(argv[4]), argv[5], argv[6], Int_val(argv[7]), Int_val(argv[8]), + argv[9], Int_val(argv[10]), Int_val(argv[11]), argv[12], argv[13], + Int_val(argv[14]), argv[15])); } - /* General eigenvalue problem (simple drivers) ************************************************************************/ /** GEEV */ -extern void FUN(geev)( - char *JOBVL, char *JOBVR, - integer *N, - REAL *A, integer *LDA, - REAL *WR, REAL* WI, - REAL *VL, integer *LDVL, - REAL *VR, integer *LDVR, - REAL *WORK, integer *LWORK, - integer *INFO); - -CAMLprim intnat LFUN(geev_stub)( - intnat vAR, intnat vAC, value vA, - intnat vN, - intnat vOFSWR, value vWR, - intnat vOFSWI, value vWI, - intnat vVLR, intnat vVLC, value vVL, - value vJOBVL, - intnat vVRR, intnat vVRC, value vVR, - value vJOBVR, - value vWORK, intnat vLWORK) -{ +extern void FUN(geev)(char *JOBVL, char *JOBVR, integer *N, REAL *A, + integer *LDA, REAL *WR, REAL *WI, REAL *VL, integer *LDVL, + REAL *VR, integer *LDVR, REAL *WORK, integer *LWORK, + integer *INFO); + +CAMLprim intnat LFUN(geev_stub)(intnat vAR, intnat vAC, value vA, intnat vN, + intnat vOFSWR, value vWR, intnat vOFSWI, + value vWI, intnat vVLR, intnat vVLC, value vVL, + value vJOBVL, intnat vVRR, intnat vVRC, + value vVR, value vJOBVR, value vWORK, + intnat vLWORK) { CAMLparam5(vA, vWR, vWI, vVL, vVR); CAMLxparam1(vWORK); - char GET_CHAR(JOBVL), - GET_CHAR(JOBVR); + char GET_CHAR(JOBVL), GET_CHAR(JOBVR); - integer GET_INT(N), - GET_INT(LWORK), - INFO; + integer GET_INT(N), GET_INT(LWORK), INFO; MAT_PARAMS(A); VEC_PARAMS(WR); @@ -1330,179 +850,96 @@ CAMLprim intnat LFUN(geev_stub)( /* weird GEEV requirement: * even when the arrays are not * referenced, LD's have to be >= 1 */ - if (JOBVL == 'N') rows_VL = 1; - if (JOBVR == 'N') rows_VR = 1; + if (JOBVL == 'N') + rows_VL = 1; + if (JOBVR == 'N') + rows_VR = 1; caml_enter_blocking_section(); /* Allow other threads */ - FUN(geev)( - &JOBVL, &JOBVR, - &N, - A_data, &rows_A, - WR_data, WI_data, - VL_data, &rows_VL, - VR_data, &rows_VR, - WORK_data, &LWORK, - &INFO); + FUN(geev)(&JOBVL, &JOBVR, &N, A_data, &rows_A, WR_data, WI_data, VL_data, + &rows_VL, VR_data, &rows_VR, WORK_data, &LWORK, &INFO); caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(INFO); } -CAMLprim value LFUN(geev_stub_bc)(value *argv, int __unused argn) -{ - return - Val_int( - LFUN(geev_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - argv[2], - Int_val(argv[3]), - Int_val(argv[4]), - argv[5], - Int_val(argv[6]), - argv[7], - Int_val(argv[8]), - Int_val(argv[9]), - argv[10], - argv[11], - Int_val(argv[12]), - Int_val(argv[13]), - argv[14], - argv[15], - argv[16], - Int_val(argv[17]))); +CAMLprim value LFUN(geev_stub_bc)(value *argv, int __unused argn) { + return Val_int(LFUN(geev_stub)( + Int_val(argv[0]), Int_val(argv[1]), argv[2], Int_val(argv[3]), + Int_val(argv[4]), argv[5], Int_val(argv[6]), argv[7], Int_val(argv[8]), + Int_val(argv[9]), argv[10], argv[11], Int_val(argv[12]), + Int_val(argv[13]), argv[14], argv[15], argv[16], Int_val(argv[17]))); } - /* Symmetric-matrix eigenvalue and singular value problems (simple drivers) ************************************************************************/ /** SYEV */ -extern void FUN(syev)( - char *JOBZ, char *UPLO, - integer *N, - REAL *A, integer *LDA, - REAL *W, - REAL *WORK, integer *LWORK, - integer *INFO); - -CAMLprim intnat LFUN(syev_stub)( - intnat vAR, intnat vAC, value vA, - intnat vN, - value vJOBZ, value vUPLO, - intnat vOFSW, value vW, - value vWORK, intnat vLWORK) -{ +extern void FUN(syev)(char *JOBZ, char *UPLO, integer *N, REAL *A, integer *LDA, + REAL *W, REAL *WORK, integer *LWORK, integer *INFO); + +CAMLprim intnat LFUN(syev_stub)(intnat vAR, intnat vAC, value vA, intnat vN, + value vJOBZ, value vUPLO, intnat vOFSW, + value vW, value vWORK, intnat vLWORK) { CAMLparam3(vA, vW, vWORK); - char GET_CHAR(JOBZ), - GET_CHAR(UPLO); + char GET_CHAR(JOBZ), GET_CHAR(UPLO); - integer GET_INT(N), - GET_INT(LWORK), - INFO; + integer GET_INT(N), GET_INT(LWORK), INFO; MAT_PARAMS(A); VEC_PARAMS(W); VEC_PARAMS1(WORK); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(syev)( - &JOBZ, &UPLO, - &N, - A_data, &rows_A, - W_data, - WORK_data, &LWORK, - &INFO); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(syev)(&JOBZ, &UPLO, &N, A_data, &rows_A, W_data, WORK_data, &LWORK, + &INFO); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(INFO); } -CAMLprim value LFUN(syev_stub_bc)(value *argv, int __unused argn) -{ - return - Val_int( - LFUN(syev_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - argv[2], - Int_val(argv[3]), - argv[4], - argv[5], - Int_val(argv[6]), - argv[7], - argv[8], - Int_val(argv[9]))); +CAMLprim value LFUN(syev_stub_bc)(value *argv, int __unused argn) { + return Val_int(LFUN(syev_stub)( + Int_val(argv[0]), Int_val(argv[1]), argv[2], Int_val(argv[3]), argv[4], + argv[5], Int_val(argv[6]), argv[7], argv[8], Int_val(argv[9]))); } - /** SYEVD */ -extern void FUN(syevd)( - char *JOBZ, char *UPLO, - integer *N, - REAL *A, integer *LDA, - REAL *W, - REAL *WORK, integer *LWORK, - integer *IWORK, integer *LIWORK, - integer *INFO); - -CAMLprim intnat LFUN(syevd_stub)( - intnat vAR, intnat vAC, value vA, - intnat vN, - value vJOBZ, value vUPLO, - intnat vOFSW, value vW, - value vWORK, intnat vLWORK, - value vIWORK, intnat vLIWORK) -{ +extern void FUN(syevd)(char *JOBZ, char *UPLO, integer *N, REAL *A, + integer *LDA, REAL *W, REAL *WORK, integer *LWORK, + integer *IWORK, integer *LIWORK, integer *INFO); + +CAMLprim intnat LFUN(syevd_stub)(intnat vAR, intnat vAC, value vA, intnat vN, + value vJOBZ, value vUPLO, intnat vOFSW, + value vW, value vWORK, intnat vLWORK, + value vIWORK, intnat vLIWORK) { CAMLparam4(vA, vW, vWORK, vIWORK); - char GET_CHAR(JOBZ), - GET_CHAR(UPLO); + char GET_CHAR(JOBZ), GET_CHAR(UPLO); - integer GET_INT(N), - GET_INT(LWORK), - GET_INT(LIWORK), - INFO; + integer GET_INT(N), GET_INT(LWORK), GET_INT(LIWORK), INFO; MAT_PARAMS(A); VEC_PARAMS(W); VEC_PARAMS1(WORK); INT_VEC_PARAMS(IWORK); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(syevd)( - &JOBZ, &UPLO, - &N, - A_data, &rows_A, - W_data, - WORK_data, &LWORK, - IWORK_data, &LIWORK, - &INFO); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(syevd)(&JOBZ, &UPLO, &N, A_data, &rows_A, W_data, WORK_data, &LWORK, + IWORK_data, &LIWORK, &INFO); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(INFO); } -CAMLprim value LFUN(syevd_stub_bc)(value *argv, int __unused argn) -{ - return - Val_int( - LFUN(syevd_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - argv[2], - Int_val(argv[3]), - argv[4], - argv[5], - Int_val(argv[6]), - argv[7], - argv[8], - Int_val(argv[9]), - argv[10], - Int_val(argv[11]))); +CAMLprim value LFUN(syevd_stub_bc)(value *argv, int __unused argn) { + return Val_int(LFUN(syevd_stub)( + Int_val(argv[0]), Int_val(argv[1]), argv[2], Int_val(argv[3]), argv[4], + argv[5], Int_val(argv[6]), argv[7], argv[8], Int_val(argv[9]), argv[10], + Int_val(argv[11]))); } /** TODO: SPEV */ @@ -1511,130 +948,74 @@ CAMLprim value LFUN(syevd_stub_bc)(value *argv, int __unused argn) /** SBEV */ -extern void FUN(sbev)( - char *JOBZ, char *UPLO, - integer *N, - integer *KD, - REAL *AB, integer *LDAB, - REAL *W, - REAL *Z, integer *LDZ, - REAL *WORK, - integer *INFO); - -CAMLprim intnat LFUN(sbev_stub)( - intnat vABR, intnat vABC, value vAB, - intnat vN, intnat vKD, - value vJOBZ, value vUPLO, - intnat vOFSW, value vW, - intnat vZR, intnat vZC, value vZ, intnat vLDZ, - value vWORK) -{ +extern void FUN(sbev)(char *JOBZ, char *UPLO, integer *N, integer *KD, REAL *AB, + integer *LDAB, REAL *W, REAL *Z, integer *LDZ, REAL *WORK, + integer *INFO); + +CAMLprim intnat LFUN(sbev_stub)(intnat vABR, intnat vABC, value vAB, intnat vN, + intnat vKD, value vJOBZ, value vUPLO, + intnat vOFSW, value vW, intnat vZR, intnat vZC, + value vZ, intnat vLDZ, value vWORK) { CAMLparam4(vAB, vW, vZ, vWORK); - char GET_CHAR(JOBZ), - GET_CHAR(UPLO); + char GET_CHAR(JOBZ), GET_CHAR(UPLO); - integer GET_INT(N), - GET_INT(KD), - GET_INT(LDZ), - INFO; + integer GET_INT(N), GET_INT(KD), GET_INT(LDZ), INFO; MAT_PARAMS(AB); MAT_PARAMS(Z); VEC_PARAMS(W); VEC_PARAMS1(WORK); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(sbev)(&JOBZ, &UPLO, - &N, - &KD, - AB_data, &rows_AB, - W_data, - Z_data, &LDZ, - WORK_data, - &INFO); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(sbev)(&JOBZ, &UPLO, &N, &KD, AB_data, &rows_AB, W_data, Z_data, &LDZ, + WORK_data, &INFO); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(INFO); } -CAMLprim value LFUN(sbev_stub_bc)(value *argv, int __unused argn) -{ - return - Val_int( - LFUN(sbev_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - argv[2], - Int_val(argv[3]), - Int_val(argv[4]), - argv[5], - argv[6], - Int_val(argv[7]), - argv[8], - Int_val(argv[9]), - Int_val(argv[10]), - argv[11], - Int_val(argv[12]), - argv[13])); +CAMLprim value LFUN(sbev_stub_bc)(value *argv, int __unused argn) { + return Val_int(LFUN(sbev_stub)(Int_val(argv[0]), Int_val(argv[1]), argv[2], + Int_val(argv[3]), Int_val(argv[4]), argv[5], + argv[6], Int_val(argv[7]), argv[8], + Int_val(argv[9]), Int_val(argv[10]), argv[11], + Int_val(argv[12]), argv[13])); } - /** TODO: SBEVD */ /** TODO: STEV */ /** TODO: STEVD */ - /* Symmetric-matrix eigenvalue and singular value problems (expert & RRR drivers) ************************************************************************/ /** SYEVR */ -extern void FUN(syevr)( - char *JOBZ, char *RANGE, char *UPLO, - integer *N, - REAL *A, integer *LDA, - REAL *VL, REAL *VU, - integer *IL, integer *IU, - REAL *ABSTOL, - integer *M, - REAL *W, - REAL *Z, integer *LDZ, - integer *ISUPPZ, - REAL *WORK, integer *LWORK, - integer *IWORK, integer *LIWORK, - integer *INFO); - -CAMLprim value LFUN(syevr_stub)( - intnat vAR, intnat vAC, value vA, - intnat vN, - value vJOBZ, value vRANGE, value vUPLO, - double vVL, double vVU, - intnat vIL, intnat vIU, - double vABSTOL, - intnat vOFSW, value vW, - intnat vZR, intnat vZC, value vZ, - value vISUPPZ, - value vWORK, intnat vLWORK, - value vIWORK, intnat vLIWORK) -{ +extern void FUN(syevr)(char *JOBZ, char *RANGE, char *UPLO, integer *N, REAL *A, + integer *LDA, REAL *VL, REAL *VU, integer *IL, + integer *IU, REAL *ABSTOL, integer *M, REAL *W, REAL *Z, + integer *LDZ, integer *ISUPPZ, REAL *WORK, + integer *LWORK, integer *IWORK, integer *LIWORK, + integer *INFO); + +CAMLprim value LFUN(syevr_stub)(intnat vAR, intnat vAC, value vA, intnat vN, + value vJOBZ, value vRANGE, value vUPLO, + double vVL, double vVU, intnat vIL, intnat vIU, + double vABSTOL, intnat vOFSW, value vW, + intnat vZR, intnat vZC, value vZ, value vISUPPZ, + value vWORK, intnat vLWORK, value vIWORK, + intnat vLIWORK) { CAMLparam5(vA, vW, vZ, vISUPPZ, vWORK); CAMLxparam1(vIWORK); - char GET_CHAR(JOBZ), - GET_CHAR(RANGE), - GET_CHAR(UPLO); + char GET_CHAR(JOBZ), GET_CHAR(RANGE), GET_CHAR(UPLO); - integer GET_INT(N), - GET_INT(IL), - GET_INT(IU), - GET_INT(LWORK), - GET_INT(LIWORK), - M, - INFO; + integer GET_INT(N), GET_INT(IL), GET_INT(IU), GET_INT(LWORK), GET_INT(LIWORK), + M, INFO; MAT_PARAMS(A); MAT_PARAMS(Z); @@ -1645,28 +1026,15 @@ CAMLprim value LFUN(syevr_stub)( INT_VEC_PARAMS(ISUPPZ); INT_VEC_PARAMS(IWORK); - REAL GET_DOUBLE(VL), - GET_DOUBLE(VU), - GET_DOUBLE(ABSTOL); + REAL GET_DOUBLE(VL), GET_DOUBLE(VU), GET_DOUBLE(ABSTOL); value v_res; - caml_enter_blocking_section(); /* Allow other threads */ - FUN(syevr)( - &JOBZ, &RANGE, &UPLO, - &N, - A_data, &rows_A, - &VL, &VU, - &IL, &IU, - &ABSTOL, - &M, - W_data, - Z_data, &rows_Z, - ISUPPZ_data, - WORK_data, &LWORK, - IWORK_data, &LIWORK, - &INFO); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(syevr)(&JOBZ, &RANGE, &UPLO, &N, A_data, &rows_A, &VL, &VU, &IL, &IU, + &ABSTOL, &M, W_data, Z_data, &rows_Z, ISUPPZ_data, WORK_data, + &LWORK, IWORK_data, &LIWORK, &INFO); + caml_leave_blocking_section(); /* Disallow other threads */ v_res = caml_alloc_small(2, 0); Field(v_res, 0) = Val_int(INFO); @@ -1675,32 +1043,14 @@ CAMLprim value LFUN(syevr_stub)( CAMLreturn(v_res); } -CAMLprim value LFUN(syevr_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(syevr_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - argv[2], - Int_val(argv[3]), - argv[4], - argv[5], - argv[6], - Double_val(argv[7]), - Double_val(argv[8]), - Int_val(argv[9]), - Int_val(argv[10]), - Double_val(argv[11]), - Int_val(argv[12]), - argv[13], - Int_val(argv[14]), - Int_val(argv[15]), - argv[16], - argv[17], - argv[18], - Int_val(argv[19]), - argv[20], - Int_val(argv[21])); +CAMLprim value LFUN(syevr_stub_bc)(value *argv, int __unused argn) { + return LFUN(syevr_stub)( + Int_val(argv[0]), Int_val(argv[1]), argv[2], Int_val(argv[3]), argv[4], + argv[5], argv[6], Double_val(argv[7]), Double_val(argv[8]), + Int_val(argv[9]), Int_val(argv[10]), Double_val(argv[11]), + Int_val(argv[12]), argv[13], Int_val(argv[14]), Int_val(argv[15]), + argv[16], argv[17], argv[18], Int_val(argv[19]), argv[20], + Int_val(argv[21])); } /** TODO: SYEVX */ @@ -1719,81 +1069,45 @@ CAMLprim value LFUN(syevr_stub_bc)(value *argv, int __unused argn) /** TODO: STEVR */ - /* Generalized eigenvalue and singular value problems (simple drivers) ************************************************************************/ /** SYGV */ -extern void FUN(sygv)( - integer *ITYPE, char *JOBZ, char *UPLO, - integer *N, - REAL *A, integer *LDA, - REAL *B, integer *LDB, - REAL *W, - REAL *WORK, integer *LWORK, - integer *INFO); - -CAMLprim intnat LFUN(sygv_stub)( - intnat vAR, intnat vAC, value vA, - intnat vBR, intnat vBC, value vB, - intnat vN, - intnat vITYPE, - value vJOBZ, value vUPLO, - intnat vOFSW, value vW, - value vWORK, intnat vLWORK) -{ +extern void FUN(sygv)(integer *ITYPE, char *JOBZ, char *UPLO, integer *N, + REAL *A, integer *LDA, REAL *B, integer *LDB, REAL *W, + REAL *WORK, integer *LWORK, integer *INFO); + +CAMLprim intnat LFUN(sygv_stub)(intnat vAR, intnat vAC, value vA, intnat vBR, + intnat vBC, value vB, intnat vN, intnat vITYPE, + value vJOBZ, value vUPLO, intnat vOFSW, + value vW, value vWORK, intnat vLWORK) { CAMLparam4(vA, vB, vW, vWORK); - char GET_CHAR(JOBZ), - GET_CHAR(UPLO); + char GET_CHAR(JOBZ), GET_CHAR(UPLO); - integer GET_INT(N), - GET_INT(ITYPE), - GET_INT(LWORK), - INFO; + integer GET_INT(N), GET_INT(ITYPE), GET_INT(LWORK), INFO; MAT_PARAMS(A); MAT_PARAMS(B); VEC_PARAMS(W); VEC_PARAMS1(WORK); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(sygv)( - &ITYPE, &JOBZ, &UPLO, - &N, - A_data, &rows_A, - B_data, &rows_B, - W_data, - WORK_data, &LWORK, - &INFO); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(sygv)(&ITYPE, &JOBZ, &UPLO, &N, A_data, &rows_A, B_data, &rows_B, W_data, + WORK_data, &LWORK, &INFO); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(INFO); } -CAMLprim value LFUN(sygv_stub_bc)(value *argv, int __unused argn) -{ - return - Val_int( - LFUN(sygv_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - argv[2], - Int_val(argv[3]), - Int_val(argv[4]), - argv[5], - Int_val(argv[6]), - Int_val(argv[7]), - argv[8], - argv[9], - Int_val(argv[10]), - argv[11], - argv[12], - Int_val(argv[13]))); +CAMLprim value LFUN(sygv_stub_bc)(value *argv, int __unused argn) { + return Val_int(LFUN(sygv_stub)( + Int_val(argv[0]), Int_val(argv[1]), argv[2], Int_val(argv[3]), + Int_val(argv[4]), argv[5], Int_val(argv[6]), Int_val(argv[7]), argv[8], + argv[9], Int_val(argv[10]), argv[11], argv[12], Int_val(argv[13]))); } - /** TODO: SYGVD */ /** TODO: SPGV */ @@ -1806,35 +1120,21 @@ CAMLprim value LFUN(sygv_stub_bc)(value *argv, int __unused argn) /** SBGV */ -extern void FUN(sbgv)( - char *JOBZ, char *UPLO, - integer *N, - integer *KA, integer *KB, - REAL *AB, integer *LDAB, - REAL *BB, integer *LDBB, - REAL *W, - REAL *Z, integer *LDZ, - REAL *WORK, - integer *INFO); - -CAMLexport intnat LFUN(sbgv_stub)( - intnat vAR, intnat vAC, value vA, - intnat vBR, intnat vBC, value vB, - intnat vN, intnat vKA, intnat vKB, - value vJOBZ, value vUPLO, - intnat vOFSW, value vW, - intnat vZR, intnat vZC, value vZ, - value vWORK) -{ +extern void FUN(sbgv)(char *JOBZ, char *UPLO, integer *N, integer *KA, + integer *KB, REAL *AB, integer *LDAB, REAL *BB, + integer *LDBB, REAL *W, REAL *Z, integer *LDZ, REAL *WORK, + integer *INFO); + +CAMLexport intnat LFUN(sbgv_stub)(intnat vAR, intnat vAC, value vA, intnat vBR, + intnat vBC, value vB, intnat vN, intnat vKA, + intnat vKB, value vJOBZ, value vUPLO, + intnat vOFSW, value vW, intnat vZR, + intnat vZC, value vZ, value vWORK) { CAMLparam5(vA, vB, vW, vZ, vWORK); - char GET_CHAR(JOBZ), - GET_CHAR(UPLO); + char GET_CHAR(JOBZ), GET_CHAR(UPLO); - integer GET_INT(N), - GET_INT(KA), - GET_INT(KB), - INFO; + integer GET_INT(N), GET_INT(KA), GET_INT(KB), INFO; MAT_PARAMS(A); MAT_PARAMS(B); @@ -1842,44 +1142,20 @@ CAMLexport intnat LFUN(sbgv_stub)( MAT_PARAMS(Z); VEC_PARAMS1(WORK); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(sbgv)( - &JOBZ, &UPLO, - &N, - &KA, &KB, - A_data, &rows_A, - B_data, &rows_B, - W_data, - Z_data, &rows_Z, - WORK_data, - &INFO); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(sbgv)(&JOBZ, &UPLO, &N, &KA, &KB, A_data, &rows_A, B_data, &rows_B, + W_data, Z_data, &rows_Z, WORK_data, &INFO); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(INFO); } -CAMLexport value LFUN(sbgv_stub_bc)(value *argv, int __unused argn) -{ - return - Val_int( - LFUN(sbgv_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - argv[2], - Int_val(argv[3]), - Int_val(argv[4]), - argv[5], - Int_val(argv[6]), - Int_val(argv[7]), - Int_val(argv[8]), - argv[9], - argv[10], - Int_val(argv[11]), - argv[12], - Int_val(argv[13]), - Int_val(argv[14]), - argv[15], - argv[16])); +CAMLexport value LFUN(sbgv_stub_bc)(value *argv, int __unused argn) { + return Val_int(LFUN(sbgv_stub)( + Int_val(argv[0]), Int_val(argv[1]), argv[2], Int_val(argv[3]), + Int_val(argv[4]), argv[5], Int_val(argv[6]), Int_val(argv[7]), + Int_val(argv[8]), argv[9], argv[10], Int_val(argv[11]), argv[12], + Int_val(argv[13]), Int_val(argv[14]), argv[15], argv[16])); } /** TODO: SBGVD */ diff --git a/src/impl_SD.ml b/src/impl_SD.ml index a613327..31ee0c0 100644 --- a/src/impl_SD.ml +++ b/src/impl_SD.ml @@ -1,41 +1,30 @@ (* File: impl_SD.ml - Copyright (C) 2001- + Copyright © 2001- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - Liam Stewart - email: liam@cs.toronto.edu - WWW: http://www.cs.toronto.edu/~liam + Liam Stewart - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umh.ac.be/an/ + Christophe Troestler - Oleg Trott - email: ot14@columbia.edu - WWW: http://www.columbia.edu/~ot14 + Oleg Trott - Florent Hoareau - email: h.florent@gmail.com - WWW: none + Florent Hoareau - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) open Printf open Bigarray @@ -43,7 +32,6 @@ open Floatxx open Common open Utils open Impl4_FPREC - module Vec = Vec4_FPREC module Mat = Mat4_FPREC @@ -52,32 +40,31 @@ module Mat = Mat4_FPREC (* DOT *) external direct_dot : - n : (int [@untagged]) -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - (float [@unboxed]) = "lacaml_FPRECdot_stub_bc" "lacaml_FPRECdot_stub" + n:(int[@untagged]) -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + (float[@unboxed]) = "lacaml_FPRECdot_stub_bc" "lacaml_FPRECdot_stub" let dot ?n ?ofsx ?incx x ?ofsy ?incy y = let loc = "Lacaml.FPREC.dot" in let ofsx, incx = get_vec_geom loc x_str ofsx incx in let ofsy, incy = get_vec_geom loc y_str ofsy incy in let n = get_dim_vec loc x_str ofsx incx x n_str n in - check_vec loc y_str y (ofsy + (n - 1) * abs incy); + check_vec loc y_str y (ofsy + ((n - 1) * abs incy)); direct_dot ~n ~ofsx ~incx ~x ~ofsy ~incy ~y - (* ASUM *) external direct_asum : - n : (int [@untagged]) -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec - -> (float [@unboxed]) = "lacaml_FPRECasum_stub_bc" "lacaml_FPRECasum_stub" + n:(int[@untagged]) -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> + (float[@unboxed]) = "lacaml_FPRECasum_stub_bc" "lacaml_FPRECasum_stub" let asum ?n ?ofsx ?incx x = let loc = "Lacaml.FPREC.asum" in @@ -85,28 +72,26 @@ let asum ?n ?ofsx ?incx x = let n = get_dim_vec loc x_str ofsx incx x n_str n in direct_asum ~n ~ofsx ~incx ~x - - (* BLAS-2 *) (* SBMV *) external direct_sbmv : - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - n : (int [@untagged]) -> - k : (int [@untagged]) -> - uplo : char -> - alpha : (float [@unboxed]) -> - beta : (float [@unboxed]) -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec - -> unit = "lacaml_FPRECsbmv_stub_bc" "lacaml_FPRECsbmv_stub" + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + n:(int[@untagged]) -> + k:(int[@untagged]) -> + uplo:char -> + alpha:(float[@unboxed]) -> + beta:(float[@unboxed]) -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> + unit = "lacaml_FPRECsbmv_stub_bc" "lacaml_FPRECsbmv_stub" let sbmv ?n ?k ?ofsy ?incy ?y ?(ar = 1) ?(ac = 1) a ?(up = true) ?(alpha = 1.0) ?(beta = 0.0) ?ofsx ?incx x = @@ -117,28 +102,27 @@ let sbmv ?n ?k ?ofsy ?incy ?y ?(ar = 1) ?(ac = 1) a ?(up = true) ?(alpha = 1.0) let ofsx, incx = get_vec_geom loc x_str ofsx incx in let ofsy, incy = get_vec_geom loc y_str ofsy incy in let y = get_vec loc y_str y ofsy incy n Vec.create in - check_vec loc x_str x (ofsx + (n - 1) * abs incx); - direct_sbmv - ~ofsy ~incy ~y ~ar ~ac ~a ~n ~k ~uplo:(get_uplo_char up) - ~alpha ~beta ~ofsx ~incx ~x; + check_vec loc x_str x (ofsx + ((n - 1) * abs incx)); + direct_sbmv ~ofsy ~incy ~y ~ar ~ac ~a ~n ~k ~uplo:(get_uplo_char up) ~alpha + ~beta ~ofsx ~incx ~x; y (* GER *) external direct_ger : - m : (int [@untagged]) -> - n : (int [@untagged]) -> - alpha : (float [@unboxed]) -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat - -> unit = "lacaml_FPRECger_stub_bc" "lacaml_FPRECger_stub" + m:(int[@untagged]) -> + n:(int[@untagged]) -> + alpha:(float[@unboxed]) -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + unit = "lacaml_FPRECger_stub_bc" "lacaml_FPRECger_stub" let ger ?m ?n ?(alpha = 1.0) ?ofsx ?incx x ?ofsy ?incy y ?(ar = 1) ?(ac = 1) a = let loc = "Lacaml.FPREC.ger" in @@ -146,24 +130,24 @@ let ger ?m ?n ?(alpha = 1.0) ?ofsx ?incx x ?ofsy ?incy y ?(ar = 1) ?(ac = 1) a = let m = get_dim1_mat loc a_str a ar m_str m in let n = get_dim2_mat loc a_str a ac n_str n in let ofsx, incx = get_vec_geom loc x_str ofsx incx in - check_vec loc x_str x (ofsx + (m - 1) * abs incx); + check_vec loc x_str x (ofsx + ((m - 1) * abs incx)); let ofsy, incy = get_vec_geom loc y_str ofsy incy in - check_vec loc y_str y (ofsy + (n - 1) * abs incy); + check_vec loc y_str y (ofsy + ((n - 1) * abs incy)); direct_ger ~m ~n ~alpha ~ofsx ~incx ~x ~ofsy ~incy ~y ~ar ~ac ~a (* SYR *) external direct_syr : - uplo : char -> - n : (int [@untagged]) -> - alpha : (float [@unboxed]) -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat - -> unit = "lacaml_FPRECsyr_stub_bc" "lacaml_FPRECsyr_stub" + uplo:char -> + n:(int[@untagged]) -> + alpha:(float[@unboxed]) -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + unit = "lacaml_FPRECsyr_stub_bc" "lacaml_FPRECsyr_stub" let syr ?n ?(alpha = 1.0) ?(up = true) ?ofsx ?incx x ?(ar = 1) ?(ac = 1) a = let loc = "Lacaml.FPREC.syr" in @@ -171,27 +155,24 @@ let syr ?n ?(alpha = 1.0) ?(up = true) ?ofsx ?incx x ?(ar = 1) ?(ac = 1) a = let n = get_n_of_a loc ar ac a n in let ofsx, incx = get_vec_geom loc x_str ofsx incx in let uplo = get_uplo_char up in - check_vec loc x_str x (ofsx + (n - 1) * abs incx); + check_vec loc x_str x (ofsx + ((n - 1) * abs incx)); direct_syr ~uplo ~n ~alpha ~ofsx ~incx ~x ~ar ~ac ~a - (* LAPACK *) (* Auxiliary routines *) external direct_lansy : - norm : char -> - uplo : char -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - work : vec - -> (float [@unboxed]) = "lacaml_FPREClansy_stub_bc" "lacaml_FPREClansy_stub" - -let lansy_min_lwork n = function - | `I | `O -> n - | _ -> 0 + norm:char -> + uplo:char -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + work:vec -> + (float[@unboxed]) = "lacaml_FPREClansy_stub_bc" "lacaml_FPREClansy_stub" + +let lansy_min_lwork n = function `I | `O -> n | _ -> 0 let lansy ?n ?(up = true) ?(norm = `O) ?work ?(ar = 1) ?(ac = 1) a = let loc = "Lacaml.FPREC.lansy" in @@ -202,12 +183,12 @@ let lansy ?n ?(up = true) ?(norm = `O) ?work ?(ar = 1) ?(ac = 1) a = let norm = get_norm_char norm in direct_lansy ~norm ~uplo ~n ~ar ~ac ~a ~work -external direct_lamch : char -> (float [@unboxed]) +external direct_lamch : char -> (float[@unboxed]) = "lacaml_FPREClamch_stub_bc" "lacaml_FPREClamch_stub" let lamch cmach = - direct_lamch ( - match cmach with + direct_lamch + (match cmach with | `E -> 'E' | `S -> 'S' | `B -> 'B' @@ -219,22 +200,21 @@ let lamch cmach = | `L -> 'L' | `O -> 'O') - (* Linear equations (computational routines) *) (* ORGQR *) external direct_orgqr : - m : (int [@untagged]) -> - n : (int [@untagged]) -> - k : (int [@untagged]) -> - work : vec -> - lwork : (int [@untagged]) -> - tau : vec -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - (int [@untagged]) = "lacaml_FPRECorgqr_stub_bc" "lacaml_FPRECorgqr_stub" + m:(int[@untagged]) -> + n:(int[@untagged]) -> + k:(int[@untagged]) -> + work:vec -> + lwork:(int[@untagged]) -> + tau:vec -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + (int[@untagged]) = "lacaml_FPRECorgqr_stub_bc" "lacaml_FPRECorgqr_stub" let orgqr_min_lwork ~n = max 1 n @@ -258,55 +238,49 @@ let orgqr ?m ?n ?k ?work ~tau ?(ar = 1) ?(ac = 1) a = get_work loc Vec.create work min_lwork opt_lwork lwork_str in let info = direct_orgqr ~m ~n ~k ~work ~lwork ~tau ~ar ~ac ~a in - if info = 0 then () - else orgqr_err ~loc ~m ~n ~k ~work ~a ~err:info - + if info = 0 then () else orgqr_err ~loc ~m ~n ~k ~work ~a ~err:info (* ORMQR *) external direct_ormqr : - side : char -> - trans : char -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - k : (int [@untagged]) -> - work : vec -> - lwork : (int [@untagged]) -> - tau : vec -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - cr : (int [@untagged]) -> - cc : (int [@untagged]) -> - c : mat -> - (int [@untagged]) = "lacaml_FPRECormqr_stub_bc" "lacaml_FPRECormqr_stub" + side:char -> + trans:char -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + k:(int[@untagged]) -> + work:vec -> + lwork:(int[@untagged]) -> + tau:vec -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + cr:(int[@untagged]) -> + cc:(int[@untagged]) -> + c:mat -> + (int[@untagged]) = "lacaml_FPRECormqr_stub_bc" "lacaml_FPRECormqr_stub" let ormqr_min_lwork ~side ~m ~n = - match side with - | `L -> max 1 n - | `R -> max 1 m + match side with `L -> max 1 n | `R -> max 1 m let ormqr_get_opt_lwork loc ~side ~trans ~m ~n ~k ~tau ~ar ~ac ~a ~cr ~cc ~c = let work = Vec.create 1 in let info = let side = get_side_char side in let trans = get_trans_char trans in - direct_ormqr - ~side ~trans ~m ~n ~k ~work ~lwork:~-1 ~tau ~ar ~ac ~a ~cr ~cc ~c + direct_ormqr ~side ~trans ~m ~n ~k ~work ~lwork:~-1 ~tau ~ar ~ac ~a ~cr ~cc + ~c in if info = 0 then int_of_float work.{1} else ormqr_err ~loc ~side ~m ~n ~k ~lwork:1 ~a ~c ~err:info -let ormqr_opt_lwork - ?(side = `L) ?(trans = `N) ?m ?n ?k ~tau ?(ar = 1) ?(ac = 1) a - ?(cr = 1) ?(cc = 1) c = +let ormqr_opt_lwork ?(side = `L) ?(trans = `N) ?m ?n ?k ~tau ?(ar = 1) ?(ac = 1) + a ?(cr = 1) ?(cc = 1) c = let loc = "Lacaml.FPREC.ormqr_opt_lwork" in let m, n, k = ormqr_get_params loc ~side ?m ?n ?k ~tau ~ar ~ac a ~cr ~cc c in ormqr_get_opt_lwork loc ~side ~trans ~m ~n ~k ~tau ~ar ~ac ~a ~cr ~cc ~c -let ormqr - ?(side = `L) ?(trans = `N) ?m ?n ?k ?work ~tau ?(ar = 1) ?(ac = 1) a - ?(cr = 1) ?(cc = 1) c = +let ormqr ?(side = `L) ?(trans = `N) ?m ?n ?k ?work ~tau ?(ar = 1) ?(ac = 1) a + ?(cr = 1) ?(cc = 1) c = let loc = "Lacaml.FPREC.ormqr" in let m, n, k = ormqr_get_params loc ~side ?m ?n ?k ~tau ~ar ~ac a ~cr ~cc c in let work, lwork = @@ -321,26 +295,22 @@ let ormqr let trans = get_trans_char trans in direct_ormqr ~side ~trans ~m ~n ~k ~work ~lwork ~tau ~ar ~ac ~a ~cr ~cc ~c in - if info = 0 then () - else ormqr_err ~loc ~side ~m ~n ~k ~lwork ~a ~c ~err:info - + if info = 0 then () else ormqr_err ~loc ~side ~m ~n ~k ~lwork ~a ~c ~err:info (* GECON *) external direct_gecon : - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - work : vec -> - iwork : int32_vec -> - norm : char -> - anorm : (float [@unboxed]) - -> int * float - = "lacaml_FPRECgecon_stub_bc" "lacaml_FPRECgecon_stub" + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + work:vec -> + iwork:int32_vec -> + norm:char -> + anorm:(float[@unboxed]) -> + int * float = "lacaml_FPRECgecon_stub_bc" "lacaml_FPRECgecon_stub" let gecon_min_lwork n = 4 * n - let gecon_min_liwork n = n let gecon ?n ?(norm = `O) ?anorm ?work ?iwork ?(ar = 1) ?(ac = 1) a = @@ -351,35 +321,33 @@ let gecon ?n ?(norm = `O) ?anorm ?work ?iwork ?(ar = 1) ?(ac = 1) a = get_work loc Vec.create work min_lwork min_lwork lwork_str in let iwork, _liwork = - get_work - loc Common.create_int32_vec iwork - (gecon_min_liwork n) (gecon_min_liwork n) liwork_str in + get_work loc Common.create_int32_vec iwork (gecon_min_liwork n) + (gecon_min_liwork n) liwork_str + in let anorm = match anorm with | None -> lange ~norm:(norm :> norm4) ~m:n ~n a - | Some anorm -> anorm in + | Some anorm -> anorm + in let norm = get_norm_char norm in let info, rcond = direct_gecon ~n ~ar ~ac ~a ~work ~iwork ~norm ~anorm in - if info = 0 then rcond - else gecon_err loc norm n a info + if info = 0 then rcond else gecon_err loc norm n a info (* SYCON *) external direct_sycon : - uplo : char -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - ipiv : int32_vec -> - work : vec -> - iwork : int32_vec -> - anorm : (float [@unboxed]) - -> int * float - = "lacaml_FPRECsycon_stub_bc" "lacaml_FPRECsycon_stub" + uplo:char -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + ipiv:int32_vec -> + work:vec -> + iwork:int32_vec -> + anorm:(float[@unboxed]) -> + int * float = "lacaml_FPRECsycon_stub_bc" "lacaml_FPRECsycon_stub" let sycon_min_lwork n = 2 * n - let sycon_min_liwork n = n let sycon ?n ?(up = true) ?ipiv ?anorm ?work ?iwork ?(ar = 1) ?(ac = 1) a = @@ -387,40 +355,41 @@ let sycon ?n ?(up = true) ?ipiv ?anorm ?work ?iwork ?(ar = 1) ?(ac = 1) a = let n = get_n_of_a loc ar ac a n in let uplo = get_uplo_char up in let work, _lwork = - get_work - loc Vec.create work (sycon_min_lwork n) (sycon_min_lwork n) lwork_str in + get_work loc Vec.create work (sycon_min_lwork n) (sycon_min_lwork n) + lwork_str + in let iwork, _liwork = - get_work - loc Common.create_int32_vec iwork - (sycon_min_liwork n) (sycon_min_liwork n) liwork_str in + get_work loc Common.create_int32_vec iwork (sycon_min_liwork n) + (sycon_min_liwork n) liwork_str + in let ipiv = if ipiv = None then sytrf ~n ~up ~work ~ar ~ac a - else sytrf_get_ipiv loc ipiv n in + else sytrf_get_ipiv loc ipiv n + in let anorm = match anorm with | None -> lange ~m:n ~n ~work ~ar ~ac a - | Some anorm -> anorm in + | Some anorm -> anorm + in let info, rcond = direct_sycon ~uplo ~n ~ar ~ac ~a ~ipiv ~work ~iwork ~anorm in - if info = 0 then rcond - else xxcon_err loc n a info + if info = 0 then rcond else xxcon_err loc n a info (* POCON *) external direct_pocon : - uplo : char -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - work : vec -> - iwork : int32_vec -> - anorm : (float [@unboxed]) - -> int * float = "lacaml_FPRECpocon_stub_bc" "lacaml_FPRECpocon_stub" + uplo:char -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + work:vec -> + iwork:int32_vec -> + anorm:(float[@unboxed]) -> + int * float = "lacaml_FPRECpocon_stub_bc" "lacaml_FPRECpocon_stub" let pocon_min_lwork n = 3 * n - let pocon_min_liwork n = n let pocon ?n ?(up = true) ?anorm ?work ?iwork ?(ar = 1) ?(ac = 1) a = @@ -428,63 +397,61 @@ let pocon ?n ?(up = true) ?anorm ?work ?iwork ?(ar = 1) ?(ac = 1) a = let n = get_n_of_a loc ar ac a n in let uplo = get_uplo_char up in let work, _lwork = - get_work - loc Vec.create work (pocon_min_lwork n) (pocon_min_lwork n) lwork_str in + get_work loc Vec.create work (pocon_min_lwork n) (pocon_min_lwork n) + lwork_str + in let iwork, _liwork = - get_work - loc Common.create_int32_vec iwork - (pocon_min_liwork n) (pocon_min_liwork n) liwork_str in + get_work loc Common.create_int32_vec iwork (pocon_min_liwork n) + (pocon_min_liwork n) liwork_str + in let anorm = match anorm with | None -> lange ~m:n ~n ~work ~ar ~ac a - | Some anorm -> anorm in + | Some anorm -> anorm + in let info, rcond = direct_pocon ~uplo ~n ~ar ~ac ~a ~work ~iwork ~anorm in - if info = 0 then rcond - else xxcon_err loc n a info - + if info = 0 then rcond else xxcon_err loc n a info (* Least squares (expert drivers) *) (* GELSY *) external direct_gelsy : - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - jpvt : int32_vec -> - rcond : (float [@unboxed]) -> - work : vec -> - lwork : (int [@untagged]) -> - nrhs : (int [@untagged]) -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat - -> int * int = "lacaml_FPRECgelsy_stub_bc" "lacaml_FPRECgelsy_stub" + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + jpvt:int32_vec -> + rcond:(float[@unboxed]) -> + work:vec -> + lwork:(int[@untagged]) -> + nrhs:(int[@untagged]) -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + int * int = "lacaml_FPRECgelsy_stub_bc" "lacaml_FPRECgelsy_stub" let gelsy_min_lwork ~m ~n ~nrhs = let mn = min m n in - max (mn + 3*n + 1) (2*mn + nrhs) + max (mn + (3 * n) + 1) ((2 * mn) + nrhs) let gelsy_get_opt_lwork loc ar ac a m n nrhs br bc b = let work = Vec.create 1 in let info, _ = - direct_gelsy - ~ar ~ac ~a ~m ~n ~jpvt:empty_int32_vec - ~rcond:(-1.0) ~work ~lwork:~-1 ~nrhs ~br ~bc ~b + direct_gelsy ~ar ~ac ~a ~m ~n ~jpvt:empty_int32_vec ~rcond:(-1.0) ~work + ~lwork:~-1 ~nrhs ~br ~bc ~b in if info = 0 then int_of_float work.{1} else gelsX_err loc gelsy_min_lwork ar a m n 1 nrhs br b info -let gelsy_opt_lwork ?m ?n ?(ar = 1) ?(ac = 1) a ?nrhs - ?(br = 1) ?(bc = 1) b = +let gelsy_opt_lwork ?m ?n ?(ar = 1) ?(ac = 1) a ?nrhs ?(br = 1) ?(bc = 1) b = let loc = "Lacaml.FPREC.gelsy_opt_lwork" in let m, n, nrhs = gelsX_get_params loc ar ac a m n nrhs br bc b in gelsy_get_opt_lwork loc ar ac a m n nrhs br bc b -let gelsy ?m ?n ?(ar = 1) ?(ac = 1) a ?(rcond = -1.0) - ?jpvt ?work ?nrhs ?(br = 1) ?(bc = 1) b = +let gelsy ?m ?n ?(ar = 1) ?(ac = 1) a ?(rcond = -1.0) ?jpvt ?work ?nrhs + ?(br = 1) ?(bc = 1) b = let loc = "Lacaml.FPREC.gelsy" in let m, n, nrhs = gelsX_get_params loc ar ac a m n nrhs br bc b in @@ -498,7 +465,8 @@ let gelsy ?m ?n ?(ar = 1) ?(ac = 1) a ?(rcond = -1.0) | None -> let jpvt = create_int32_vec n in Array1.fill jpvt 0l; - jpvt in + jpvt + in let work, lwork = match work with @@ -508,10 +476,11 @@ let gelsy ?m ?n ?(ar = 1) ?(ac = 1) a ?(rcond = -1.0) if lwork < min_lwork then invalid_arg (sprintf "%s: lwork: valid=[%d..[ got=%d" loc min_lwork lwork) - else work, lwork + else (work, lwork) | None -> let lwork = gelsy_get_opt_lwork loc ar ac a m n nrhs br bc b in - Vec.create lwork, lwork in + (Vec.create lwork, lwork) + in let info, rank = direct_gelsy ~ar ~ac ~a ~m ~n ~jpvt ~rcond ~work ~lwork ~nrhs ~br ~bc ~b @@ -519,44 +488,43 @@ let gelsy ?m ?n ?(ar = 1) ?(ac = 1) a ?(rcond = -1.0) if info = 0 then rank else gelsX_err loc gelsy_min_lwork ar a m n lwork nrhs br b info - (* GELSD *) external direct_gelsd : - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ofss : (int [@untagged]) -> - s : vec -> - rcond : (float [@unboxed]) -> - work : vec -> - lwork : (int [@untagged]) -> - iwork : vec -> - nrhs : (int [@untagged]) -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat - -> int * int = "lacaml_FPRECgelsd_stub_bc" "lacaml_FPRECgelsd_stub" + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ofss:(int[@untagged]) -> + s:vec -> + rcond:(float[@unboxed]) -> + work:vec -> + lwork:(int[@untagged]) -> + iwork:vec -> + nrhs:(int[@untagged]) -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + int * int = "lacaml_FPRECgelsd_stub_bc" "lacaml_FPRECgelsd_stub" let lg2_10 = log10 2.0 let log2 n = log10 n /. lg2_10 - let gelsd_smlsiz = ilaenv 9 "FPRECGELSD" " " 0 0 0 0 let gelsd_smlsiz1 = gelsd_smlsiz + 1 let fgelsd_smlsiz1 = float gelsd_smlsiz1 let gelsd_smlsiz1_2 = gelsd_smlsiz1 * gelsd_smlsiz1 - -let gelsd_nlvl mn = - max 0 (int_of_float (log2 (float mn /. fgelsd_smlsiz1)) + 1) +let gelsd_nlvl mn = max 0 (int_of_float (log2 (float mn /. fgelsd_smlsiz1)) + 1) let gelsd_min_lwork ~m ~n ~nrhs = let mn = min m n in let nlvl = gelsd_nlvl mn in - 12*mn + 2*mn*gelsd_smlsiz + 8*mn*nlvl + mn*nrhs + gelsd_smlsiz1_2 + (12 * mn) + + (2 * mn * gelsd_smlsiz) + + (8 * mn * nlvl) + + (mn * nrhs) + gelsd_smlsiz1_2 -let gelsd_get_min_iwork mn nlvl = 3*mn*nlvl + 11*mn +let gelsd_get_min_iwork mn nlvl = (3 * mn * nlvl) + (11 * mn) let gelsd_min_iwork m n = let mn = min m n in @@ -565,10 +533,8 @@ let gelsd_min_iwork m n = let gelsd_get_opt_lwork loc ar ac a m n nrhs br bc b = let work = Vec.create 1 in let info, _ = - direct_gelsd - ~ar ~ac ~a ~m ~n ~ofss:1 ~s:Vec.empty ~rcond:(-1.0) ~work - ~lwork:~-1 ~iwork:Vec.empty - ~nrhs ~br ~bc ~b + direct_gelsd ~ar ~ac ~a ~m ~n ~ofss:1 ~s:Vec.empty ~rcond:(-1.0) ~work + ~lwork:~-1 ~iwork:Vec.empty ~nrhs ~br ~bc ~b in if info = 0 then (* FIXME: LAPACK bug??? *) @@ -576,14 +542,13 @@ let gelsd_get_opt_lwork loc ar ac a m n nrhs br bc b = max (int_of_floatxx work.{1}) (gelsd_min_lwork ~m ~n ~nrhs) else gelsX_err loc gelsd_min_lwork ar a m n 1 nrhs br b info -let gelsd_opt_lwork ?m ?n ?(ar = 1) ?(ac = 1) a ?nrhs - ?(br = 1) ?(bc = 1) b = +let gelsd_opt_lwork ?m ?n ?(ar = 1) ?(ac = 1) a ?nrhs ?(br = 1) ?(bc = 1) b = let loc = "Lacaml.FPREC.gelsd_opt_lwork" in let m, n, nrhs = gelsX_get_params loc ar ac a m n nrhs br bc b in gelsd_get_opt_lwork loc ar ac a m n nrhs br bc b -let gelsd ?m ?n ?(rcond = -1.0) ?ofss ?s ?work ?iwork - ?(ar = 1) ?(ac = 1) a ?nrhs ?(br = 1) ?(bc = 1) b = +let gelsd ?m ?n ?(rcond = -1.0) ?ofss ?s ?work ?iwork ?(ar = 1) ?(ac = 1) a + ?nrhs ?(br = 1) ?(bc = 1) b = let loc = "Lacaml.FPREC.gelsd" in let m, n, nrhs = gelsX_get_params loc ar ac a m n nrhs br bc b in let mn = min m n in @@ -599,7 +564,8 @@ let gelsd ?m ?n ?(rcond = -1.0) ?ofss ?s ?work ?iwork invalid_arg (sprintf "%s: iwork: valid=[%d..[ got=%d" loc min_iwork dim_iwork) else iwork - | None -> Vec.create min_iwork in + | None -> Vec.create min_iwork + in let work, lwork = match work with @@ -609,49 +575,48 @@ let gelsd ?m ?n ?(rcond = -1.0) ?ofss ?s ?work ?iwork if lwork < min_lwork then invalid_arg (sprintf "%s: lwork: valid=[%d..[ got=%d" loc min_lwork lwork) - else work, lwork + else (work, lwork) | None -> let lwork = gelsd_get_opt_lwork loc ar ac a m n nrhs br bc b in - Vec.create lwork, lwork in + (Vec.create lwork, lwork) + in let info, rank = - direct_gelsd - ~ar ~ac ~a ~m ~n ~ofss ~s ~rcond ~work ~lwork ~iwork ~nrhs ~br ~bc ~b + direct_gelsd ~ar ~ac ~a ~m ~n ~ofss ~s ~rcond ~work ~lwork ~iwork ~nrhs ~br + ~bc ~b in if info = 0 then rank else gelsX_err loc gelsd_min_lwork ar a m n lwork nrhs br b info - (* GELSS *) external direct_gelss : - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ofss : (int [@untagged]) -> - s : vec -> - rcond : (float [@unboxed]) -> - work : vec -> - lwork : (int [@untagged]) -> - nrhs : (int [@untagged]) -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat - -> int * int = "lacaml_FPRECgelss_stub_bc" "lacaml_FPRECgelss_stub" + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ofss:(int[@untagged]) -> + s:vec -> + rcond:(float[@unboxed]) -> + work:vec -> + lwork:(int[@untagged]) -> + nrhs:(int[@untagged]) -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + int * int = "lacaml_FPRECgelss_stub_bc" "lacaml_FPRECgelss_stub" let gelss_min_lwork ~m ~n ~nrhs = let min_dim = min m n in - max 1 (3*min_dim + max (max (2*min_dim) (max m n)) nrhs) + max 1 ((3 * min_dim) + max (max (2 * min_dim) (max m n)) nrhs) let gelss_get_opt_lwork loc ar ac a m n nrhs br bc b = let work = Vec.create 1 in let info, _ = - direct_gelss - ~ar ~ac ~a ~m ~n ~ofss:1 ~s:Vec.empty ~rcond:(-1.0) - ~work ~lwork:~-1 ~nrhs ~br ~bc ~b + direct_gelss ~ar ~ac ~a ~m ~n ~ofss:1 ~s:Vec.empty ~rcond:(-1.0) ~work + ~lwork:~-1 ~nrhs ~br ~bc ~b in if info = 0 then int_of_floatxx work.{1} else gelsX_err loc gelss_min_lwork ar a m n 1 nrhs br b info @@ -661,207 +626,183 @@ let gelss_opt_lwork ?(ar = 1) ?(ac = 1) a ?m ?n ?nrhs ?(br = 1) ?(bc = 1) b = let m, n, nrhs = gelsX_get_params loc ar ac a m n nrhs br bc b in gelss_get_opt_lwork loc ar ac a m n nrhs br bc b -let gelss ?m ?n ?(rcond = -1.0) ?ofss ?s ?work - ?(ar = 1) ?(ac = 1) a ?nrhs ?(br = 1) ?(bc = 1) b = +let gelss ?m ?n ?(rcond = -1.0) ?ofss ?s ?work ?(ar = 1) ?(ac = 1) a ?nrhs + ?(br = 1) ?(bc = 1) b = let loc = "Lacaml.FPREC.gelss" in let m, n, nrhs = gelsX_get_params loc ar ac a m n nrhs br bc b in let ofss = get_vec_ofs loc s_str ofss in let s = gelsX_get_s Vec.create loc (min m n) ofss s in let work, lwork = match work with - | Some work -> work, Array1.dim work + | Some work -> (work, Array1.dim work) | None -> let lwork = gelss_get_opt_lwork loc ar ac a m n nrhs br bc b in - Vec.create lwork, lwork in + (Vec.create lwork, lwork) + in let info, rank = direct_gelss ~ar ~ac ~a ~m ~n ~ofss ~s ~rcond ~work ~lwork ~nrhs ~br ~bc ~b in if info = 0 then rank else gelsX_err loc gelss_min_lwork ar a m n lwork nrhs br b info - (* General Schur factorization *) (* GEES *) external direct_gees : - jobvs : char -> - sort : char -> - select : (int [@untagged]) -> - select_fun : (Complex.t -> bool) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - wr : vec -> - wi : vec -> - vsr : (int [@untagged]) -> - vsc : (int [@untagged]) -> - vs : mat -> - work : vec -> - lwork : (int [@untagged]) -> - bwork : int32_vec - -> int * int = "lacaml_FPRECgees_stub_bc" "lacaml_FPRECgees_stub" - (* result : (SDIM, INFO) *) + jobvs:char -> + sort:char -> + select:(int[@untagged]) -> + select_fun:(Complex.t -> bool) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + wr:vec -> + wi:vec -> + vsr:(int[@untagged]) -> + vsc:(int[@untagged]) -> + vs:mat -> + work:vec -> + lwork:(int[@untagged]) -> + bwork:int32_vec -> + int * int = "lacaml_FPRECgees_stub_bc" "lacaml_FPRECgees_stub" +(* result : (SDIM, INFO) *) external init_gees : unit -> unit = "lacaml_FPRECinit_gees" let () = init_gees () -let gees_get_opt_lwork - ~loc ~jobvs ~sort ~select ~select_fun ~n - ~ar ~ac ~a ~wr ~wi ~vsr ~vsc ~vs ~bwork = +let gees_get_opt_lwork ~loc ~jobvs ~sort ~select ~select_fun ~n ~ar ~ac ~a ~wr + ~wi ~vsr ~vsc ~vs ~bwork = let lwork = -1 in let work = Vec.create 1 in let _, info = - direct_gees ~jobvs ~sort ~select ~select_fun ~n ~ar ~ac ~a - ~wr ~wi ~vsr ~vsc ~vs ~work ~lwork ~bwork + direct_gees ~jobvs ~sort ~select ~select_fun ~n ~ar ~ac ~a ~wr ~wi ~vsr ~vsc + ~vs ~work ~lwork ~bwork in - if info = 0 then int_of_floatxx work.{1} - else gees_err loc n info jobvs sort - -let gees - ?n - ?(jobvs = `Compute_Schur_vectors) - ?(sort = `No_sort) - ?wr - ?wi - ?(vsr = 1) - ?(vsc = 1) - ?vs - ?work - ?(ar = 1) - ?(ac = 1) - a = + if info = 0 then int_of_floatxx work.{1} else gees_err loc n info jobvs sort + +let gees ?n ?(jobvs = `Compute_Schur_vectors) ?(sort = `No_sort) ?wr ?wi + ?(vsr = 1) ?(vsc = 1) ?vs ?work ?(ar = 1) ?(ac = 1) a = let loc = "Lacaml.FPREC.gees" in let jobvs, sort_char, select, select_fun, n, vs, wr, wi = - gees_get_params_real - loc Vec.create Mat.create Mat.empty jobvs sort n ar ac a wr wi vsr vsc vs + gees_get_params_real loc Vec.create Mat.create Mat.empty jobvs sort n ar ac + a wr wi vsr vsc vs in let bwork = - match sort with - | `No_sort -> empty_int32_vec - | _ -> create_int32_vec n + match sort with `No_sort -> empty_int32_vec | _ -> create_int32_vec n in let work, lwork = match work with - | Some work -> work, Array1.dim work + | Some work -> (work, Array1.dim work) | None -> let lwork = - gees_get_opt_lwork ~loc ~jobvs ~sort:sort_char ~select ~select_fun - ~n ~ar ~ac ~a ~wr ~wi ~vsr ~vsc ~vs ~bwork + gees_get_opt_lwork ~loc ~jobvs ~sort:sort_char ~select ~select_fun ~n + ~ar ~ac ~a ~wr ~wi ~vsr ~vsc ~vs ~bwork in - Vec.create lwork, lwork + (Vec.create lwork, lwork) in let sdim, info = - direct_gees ~jobvs ~sort:sort_char ~select ~select_fun - ~n ~ar ~ac ~a ~wr ~wi ~vsr ~vsc ~vs ~work ~lwork ~bwork + direct_gees ~jobvs ~sort:sort_char ~select ~select_fun ~n ~ar ~ac ~a ~wr ~wi + ~vsr ~vsc ~vs ~work ~lwork ~bwork in - if info = 0 then sdim, wr, wi, vs - else gees_err loc n info jobvs sort_char - + if info = 0 then (sdim, wr, wi, vs) else gees_err loc n info jobvs sort_char (* General SVD routines *) (* GESVD *) external direct_gesvd : - jobu : char -> - jobvt : char -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - s : vec -> - ur : (int [@untagged]) -> - uc : (int [@untagged]) -> - u : mat -> - vtc : (int [@untagged]) -> - vtr : (int [@untagged]) -> - vt : mat -> - work : vec -> - lwork : (int [@untagged]) - -> (int [@untagged]) = "lacaml_FPRECgesvd_stub_bc" "lacaml_FPRECgesvd_stub" + jobu:char -> + jobvt:char -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + s:vec -> + ur:(int[@untagged]) -> + uc:(int[@untagged]) -> + u:mat -> + vtc:(int[@untagged]) -> + vtr:(int[@untagged]) -> + vt:mat -> + work:vec -> + lwork:(int[@untagged]) -> + (int[@untagged]) = "lacaml_FPRECgesvd_stub_bc" "lacaml_FPRECgesvd_stub" let gesvd_min_lwork ~m ~n = let min_m_n = min m n in - max 1 (max (3 * min_m_n + max m n) (5 * min_m_n)) + max 1 (max ((3 * min_m_n) + max m n) (5 * min_m_n)) let gesvd_get_opt_lwork loc jobu jobvt m n ar ac a s ur uc u vtr vtc vt = let lwork = -1 in let work = Vec.create 1 in let info = - direct_gesvd - ~jobu ~jobvt ~m ~n ~ar ~ac ~a ~s ~ur ~uc ~u ~vtr ~vtc ~vt ~work ~lwork + direct_gesvd ~jobu ~jobvt ~m ~n ~ar ~ac ~a ~s ~ur ~uc ~u ~vtr ~vtc ~vt ~work + ~lwork in if info = 0 then int_of_floatxx work.{1} else gesvd_err loc jobu jobvt m n a u vt lwork info -let gesvd_opt_lwork - ?m ?n - ?(jobu = `A) ?(jobvt = `A) ?s - ?(ur = 1) ?(uc = 1) ?u +let gesvd_opt_lwork ?m ?n ?(jobu = `A) ?(jobvt = `A) ?s ?(ur = 1) ?(uc = 1) ?u ?(vtr = 1) ?(vtc = 1) ?vt ?(ar = 1) ?(ac = 1) a = let loc = "Lacaml.FPREC.gesvd_opt_lwork" in let jobu, jobvt, m, n, s, u, vt = - gesvd_get_params - loc Vec.create Mat.create jobu jobvt m n ar ac a s ur uc u vtr vtc vt in + gesvd_get_params loc Vec.create Mat.create jobu jobvt m n ar ac a s ur uc u + vtr vtc vt + in gesvd_get_opt_lwork loc jobu jobvt m n ar ac a s ur uc u vtr vtc vt -let get_job_svecs mat = function - | `A | `S -> mat - | `O | `N -> Mat.empty +let get_job_svecs mat = function `A | `S -> mat | `O | `N -> Mat.empty -let gesvd - ?m ?n - ?jobu:(jobu_t = `A) ?jobvt:(jobvt_t = `A) ?s - ?(ur = 1) ?(uc = 1) ?u - ?(vtr = 1) ?(vtc = 1) ?vt ?work ?(ar = 1) ?(ac = 1) a = +let gesvd ?m ?n ?jobu:(jobu_t = `A) ?jobvt:(jobvt_t = `A) ?s ?(ur = 1) ?(uc = 1) + ?u ?(vtr = 1) ?(vtc = 1) ?vt ?work ?(ar = 1) ?(ac = 1) a = let loc = "Lacaml.FPREC.gesvd" in let jobu, jobvt, m, n, s, u, vt = - gesvd_get_params - loc Vec.create Mat.create jobu_t jobvt_t m n ar ac a s ur uc u vtr vtc vt + gesvd_get_params loc Vec.create Mat.create jobu_t jobvt_t m n ar ac a s ur + uc u vtr vtc vt in let work, lwork = match work with - | Some work -> work, Array1.dim work + | Some work -> (work, Array1.dim work) | None -> let lwork = - gesvd_get_opt_lwork - loc jobu jobvt m n ar ac a s ur uc u vtr vtc vt in - Vec.create lwork, lwork in + gesvd_get_opt_lwork loc jobu jobvt m n ar ac a s ur uc u vtr vtc vt + in + (Vec.create lwork, lwork) + in let info = - direct_gesvd - ~jobu ~jobvt ~m ~n ~ar ~ac ~a ~s ~ur ~uc ~u ~vtr ~vtc ~vt ~work ~lwork + direct_gesvd ~jobu ~jobvt ~m ~n ~ar ~ac ~a ~s ~ur ~uc ~u ~vtr ~vtc ~vt ~work + ~lwork in if info = 0 then let u = get_job_svecs u jobu_t in let vt = get_job_svecs vt jobvt_t in - s, u, vt + (s, u, vt) else gesvd_err loc jobu jobvt m n a u vt lwork info - (* GESDD *) external direct_gesdd : - jobz : char -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - s : vec -> - ur : (int [@untagged]) -> - uc : (int [@untagged]) -> - u : mat -> - vtr : (int [@untagged]) -> - vtc : (int [@untagged]) -> - vt : mat -> - work : vec -> - lwork : (int [@untagged]) -> - iwork : int32_vec - -> (int [@untagged]) = "lacaml_FPRECgesdd_stub_bc" "lacaml_FPRECgesdd_stub" + jobz:char -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + s:vec -> + ur:(int[@untagged]) -> + uc:(int[@untagged]) -> + u:mat -> + vtr:(int[@untagged]) -> + vtc:(int[@untagged]) -> + vt:mat -> + work:vec -> + lwork:(int[@untagged]) -> + iwork:int32_vec -> + (int[@untagged]) = "lacaml_FPRECgesdd_stub_bc" "lacaml_FPRECgesdd_stub" let gesdd_min_lwork ?(jobz = `A) ~m ~n () = let min_lwork = @@ -870,7 +811,7 @@ let gesdd_min_lwork ?(jobz = `A) ~m ~n () = let arg = match jobz with | `N -> 7 - | `O -> 5 * min_m_n + 4 + | `O -> (5 * min_m_n) + 4 | `S | `A -> 4 * (min_m_n + 1) in min_m_n_3 + max (max m n) (arg * min_m_n) @@ -891,12 +832,7 @@ let gesdd_get_iwork loc ~m ~n iwork = | None -> create_int32_vec min_liwork let gesdd_min_lwork_char jobz ~m ~n = - let jobz = - match jobz with - | 'N' -> `N - | 'O' -> `O - | 'S' -> `S - | _ -> `A in + let jobz = match jobz with 'N' -> `N | 'O' -> `O | 'S' -> `S | _ -> `A in gesdd_min_lwork ~jobz ~m ~n () let gesdd_get_opt_lwork loc jobz ?iwork m n ar ac a s ur uc u vtr vtc vt = @@ -904,8 +840,8 @@ let gesdd_get_opt_lwork loc jobz ?iwork m n ar ac a s ur uc u vtr vtc vt = let lwork = -1 in let work = Vec.create 1 in let info = - direct_gesdd - ~jobz ~m ~n ~ar ~ac ~a ~s ~ur ~uc ~u ~vtr ~vtc ~vt ~work ~lwork ~iwork + direct_gesdd ~jobz ~m ~n ~ar ~ac ~a ~s ~ur ~uc ~u ~vtr ~vtc ~vt ~work ~lwork + ~iwork in if info = 0 then (* FIXME: LAPACK bug??? *) @@ -913,48 +849,43 @@ let gesdd_get_opt_lwork loc jobz ?iwork m n ar ac a s ur uc u vtr vtc vt = max (int_of_floatxx work.{1}) (gesdd_min_lwork_char jobz ~m ~n) else gesdd_err loc jobz m n a u vt lwork info -let gesdd_opt_lwork - ?m ?n - ?(jobz = `A) ?s - ?(ur = 1) ?(uc = 1) ?u ?(vtr = 1) ?(vtc = 1) ?vt - ?iwork ?(ar = 1) ?(ac = 1) a = +let gesdd_opt_lwork ?m ?n ?(jobz = `A) ?s ?(ur = 1) ?(uc = 1) ?u ?(vtr = 1) + ?(vtc = 1) ?vt ?iwork ?(ar = 1) ?(ac = 1) a = let loc = "Lacaml.FPREC.gesdd_opt_lwork" in let jobz_c, m, n, s, u, vt = - gesdd_get_params - loc Vec.create Mat.create jobz m n ar ac a s ur uc u vtr vtc vt + gesdd_get_params loc Vec.create Mat.create jobz m n ar ac a s ur uc u vtr + vtc vt in gesdd_get_opt_lwork loc jobz_c ?iwork m n ar ac a s ur uc u vtr vtc vt -let gesdd - ?m ?n - ?jobz:(jobz_t = `A) ?s - ?(ur = 1) ?(uc = 1) ?u ?(vtr = 1) ?(vtc = 1) ?vt - ?work ?iwork ?(ar = 1) ?(ac = 1) a = +let gesdd ?m ?n ?jobz:(jobz_t = `A) ?s ?(ur = 1) ?(uc = 1) ?u ?(vtr = 1) + ?(vtc = 1) ?vt ?work ?iwork ?(ar = 1) ?(ac = 1) a = let loc = "Lacaml.FPREC.gesdd" in let jobz, m, n, s, u, vt = - gesdd_get_params - loc Vec.create Mat.create jobz_t m n ar ac a s ur uc u vtr vtc vt in + gesdd_get_params loc Vec.create Mat.create jobz_t m n ar ac a s ur uc u vtr + vtc vt + in let iwork = gesdd_get_iwork loc ~m ~n iwork in let work, lwork = match work with - | Some work -> work, Array1.dim work + | Some work -> (work, Array1.dim work) | None -> let lwork = - gesdd_get_opt_lwork - loc jobz ~iwork m n ar ac a s ur uc u vtr vtc vt in - Vec.create lwork, lwork in + gesdd_get_opt_lwork loc jobz ~iwork m n ar ac a s ur uc u vtr vtc vt + in + (Vec.create lwork, lwork) + in let info = - direct_gesdd - ~jobz ~m ~n ~ar ~ac ~a ~s ~ur ~uc ~u ~vtr ~vtc ~vt ~work ~lwork ~iwork + direct_gesdd ~jobz ~m ~n ~ar ~ac ~a ~s ~ur ~uc ~u ~vtr ~vtc ~vt ~work ~lwork + ~iwork in if info = 0 then match jobz_t with - | `A | `S -> s, u, vt - | `O -> if m >= n then s, Mat.empty, vt else s, u, Mat.empty - | `N -> s, Mat.empty, Mat.empty + | `A | `S -> (s, u, vt) + | `O -> if m >= n then (s, Mat.empty, vt) else (s, u, Mat.empty) + | `N -> (s, Mat.empty, Mat.empty) else gesdd_err loc jobz m n a u vt lwork info - (* General eigenvalue problem (simple drivers) *) (* GEEV error handler *) @@ -962,10 +893,11 @@ let gesdd let geev_err loc min_work a n vl vr lwork err = if err > 0 then let msg = - sprintf "\ - %s: The QR algorithm failed to compute all the eigenvalues,\n\ - and no eigenvectors have been computed; elements %d:%d of WR\n\ - and WI contain eigenvalues which have converged" loc (err + 1) n in + sprintf + "%s: The QR algorithm failed to compute all the eigenvalues,\n\ + and no eigenvectors have been computed; elements %d:%d of WR\n\ + and WI contain eigenvalues which have converged" loc (err + 1) n + in failwith msg else let msg = @@ -973,94 +905,74 @@ let geev_err loc min_work a n vl vr lwork err = | -3 -> sprintf "n: valid=[0..[ got=%d" n | -5 -> sprintf "dim1(a): valid=[%d..[ got=%d" (max 1 n) (Array2.dim1 a) | -9 -> sprintf "dim1(vl): valid=[%d..[ got=%d" (max 1 n) (Array2.dim1 vl) - | -11-> sprintf "dim1(vr): valid=[%d..[ got=%d" (max 1 n) (Array2.dim1 vr) + | -11 -> + sprintf "dim1(vr): valid=[%d..[ got=%d" (max 1 n) (Array2.dim1 vr) | -13 -> sprintf "dim(work): valid=[%d..[ got=%d" (min_work n) lwork - | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) in + | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) + in invalid_arg (sprintf "%s: %s" loc msg) (* GEEV *) external direct_geev : - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - n : (int [@untagged]) -> - ofswr : (int [@untagged]) -> - wr : vec -> - ofswi : (int [@untagged]) -> - wi : vec -> - vlr : (int [@untagged]) -> - vlc : (int [@untagged]) -> - vl : mat -> - jobvl : char -> - vrr : (int [@untagged]) -> - vrc : (int [@untagged]) -> - vr : mat -> - jobvr : char -> - work : vec -> - lwork : (int [@untagged]) - -> (int [@untagged]) = "lacaml_FPRECgeev_stub_bc" "lacaml_FPRECgeev_stub" + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + n:(int[@untagged]) -> + ofswr:(int[@untagged]) -> + wr:vec -> + ofswi:(int[@untagged]) -> + wi:vec -> + vlr:(int[@untagged]) -> + vlc:(int[@untagged]) -> + vl:mat -> + jobvl:char -> + vrr:(int[@untagged]) -> + vrc:(int[@untagged]) -> + vr:mat -> + jobvr:char -> + work:vec -> + lwork:(int[@untagged]) -> + (int[@untagged]) = "lacaml_FPRECgeev_stub_bc" "lacaml_FPRECgeev_stub" let geev_min_lwork ?(vectors = true) n = - if vectors then max 1 (4 * n) - else max 1 (3 * n) - -let geev_get_opt_lwork - ~loc ~n - ~vlr ~vlc ~vl ~jobvl - ~vrr ~vrc ~vr ~jobvr - ~ofswr ~wr - ~ofswi ~wi - ~ar ~ac ~a ~vectors = + if vectors then max 1 (4 * n) else max 1 (3 * n) + +let geev_get_opt_lwork ~loc ~n ~vlr ~vlc ~vl ~jobvl ~vrr ~vrc ~vr ~jobvr ~ofswr + ~wr ~ofswi ~wi ~ar ~ac ~a ~vectors = let work = Vec.create 1 in let info = - direct_geev - ~ar ~ac ~a ~n ~ofswr ~wr ~ofswi ~wi ~vlr ~vlc ~vl ~jobvl - ~vrr ~vrc ~vr ~jobvr ~work ~lwork:~-1 + direct_geev ~ar ~ac ~a ~n ~ofswr ~wr ~ofswi ~wi ~vlr ~vlc ~vl ~jobvl ~vrr + ~vrc ~vr ~jobvr ~work ~lwork:~-1 in if info = 0 then int_of_float work.{1} else geev_err loc (geev_min_lwork ~vectors) a n vl vr ~-1 info -let geev_get_params - ~loc ~ar ~ac ~a ~n ~vlr ~vlc ~vl - ~vrr ~vrc ~vr ~ofswr ~wr ~ofswi ~wi = - let n, _, _, _, _, _, _, _, _, _ as params = - geev_gen_get_params - loc Mat.empty Mat.create ar ac a n vlr vlc vl vrr vrc vr +let geev_get_params ~loc ~ar ~ac ~a ~n ~vlr ~vlc ~vl ~vrr ~vrc ~vr ~ofswr ~wr + ~ofswi ~wi = + let ((n, _, _, _, _, _, _, _, _, _) as params) = + geev_gen_get_params loc Mat.empty Mat.create ar ac a n vlr vlc vl vrr vrc vr in - ( - params, + ( params, xxev_get_wx Vec.create loc wr_str ofswr wr n, - xxev_get_wx Vec.create loc wi_str ofswi wi n - ) - -let geev_opt_lwork - ?n - ?(vlr = 1) ?(vlc = 1) ?vl - ?(vrr = 1) ?(vrc = 1) ?vr - ?(ofswr = 1) ?wr - ?(ofswi = 1) ?wi - ?(ar = 1) ?(ac = 1) a = + xxev_get_wx Vec.create loc wi_str ofswi wi n ) + +let geev_opt_lwork ?n ?(vlr = 1) ?(vlc = 1) ?vl ?(vrr = 1) ?(vrc = 1) ?vr + ?(ofswr = 1) ?wr ?(ofswi = 1) ?wi ?(ar = 1) ?(ac = 1) a = let loc = "Lacaml.FPREC.geev_opt_lwork" in let (n, vlr, vlc, vl, jobvl, vrr, vrc, vr, jobvr, vectors), wr, wi = - geev_get_params - ~loc ~ar ~ac ~a ~n ~vlr ~vlc ~vl ~vrr ~vrc ~vr ~ofswr ~wr ~ofswi ~wi - in - geev_get_opt_lwork - ~loc ~n ~vlr ~vlc ~vl ~jobvl ~vrr ~vrc ~vr ~jobvr ~ofswr ~wr - ~ofswi ~wi ~ar ~ac ~a ~vectors - -let geev - ?n ?work - ?(vlr = 1) ?(vlc = 1) ?vl - ?(vrr = 1) ?(vrc = 1) ?vr - ?(ofswr = 1) ?wr - ?(ofswi = 1) ?wi - ?(ar = 1) ?(ac = 1) a = + geev_get_params ~loc ~ar ~ac ~a ~n ~vlr ~vlc ~vl ~vrr ~vrc ~vr ~ofswr ~wr + ~ofswi ~wi + in + geev_get_opt_lwork ~loc ~n ~vlr ~vlc ~vl ~jobvl ~vrr ~vrc ~vr ~jobvr ~ofswr + ~wr ~ofswi ~wi ~ar ~ac ~a ~vectors + +let geev ?n ?work ?(vlr = 1) ?(vlc = 1) ?vl ?(vrr = 1) ?(vrc = 1) ?vr + ?(ofswr = 1) ?wr ?(ofswi = 1) ?wi ?(ar = 1) ?(ac = 1) a = let loc = "Lacaml.FPREC.geev" in let (n, vlr, vlc, vl, jobvl, vrr, vrc, vr, jobvr, vectors), wr, wi = - geev_get_params - ~loc ~ar ~ac ~a ~n ~vlr ~vlc ~vl ~vrr ~vrc ~vr ~ofswr ~wr ~ofswi ~wi + geev_get_params ~loc ~ar ~ac ~a ~n ~vlr ~vlc ~vl ~vrr ~vrc ~vr ~ofswr ~wr + ~ofswi ~wi in let work, lwork = @@ -1071,24 +983,23 @@ let geev if lwork < min_lwork then invalid_arg (sprintf "%s: lwork: valid=[%d..[ got=%d" loc min_lwork lwork) - else work, lwork + else (work, lwork) | None -> let lwork = - geev_get_opt_lwork - ~loc ~n ~vlr ~vlc ~vl ~jobvl ~vrr ~vrc ~vr ~jobvr + geev_get_opt_lwork ~loc ~n ~vlr ~vlc ~vl ~jobvl ~vrr ~vrc ~vr ~jobvr ~ofswr ~wr ~ofswi ~wi ~ar ~ac ~a ~vectors in - Vec.create lwork, lwork in + (Vec.create lwork, lwork) + in let info = - direct_geev ~ar ~ac ~a ~n ~ofswr ~wr ~ofswi ~wi ~vlr ~vlc ~vl ~jobvl - ~vrr ~vrc ~vr ~jobvr ~work ~lwork + direct_geev ~ar ~ac ~a ~n ~ofswr ~wr ~ofswi ~wi ~vlr ~vlc ~vl ~jobvl ~vrr + ~vrc ~vr ~jobvr ~work ~lwork in - if info = 0 then vl, wr, wi, vr + if info = 0 then (vl, wr, wi, vr) else geev_err loc (geev_min_lwork ~vectors) a n vl vr lwork info - (* Symmetric-matrix eigenvalue and singular value problems (simple drivers) *) (* SYEV? auxiliary functions *) @@ -1096,7 +1007,8 @@ let geev let syev_err loc min_work a n lwork err = if err > 0 then let msg = - sprintf "%s: failed to converge on off-diagonal element %d" loc err in + sprintf "%s: failed to converge on off-diagonal element %d" loc err + in failwith msg else let msg = @@ -1104,33 +1016,34 @@ let syev_err loc min_work a n lwork err = | -3 -> sprintf "n: valid=[0..[ got=%d" n | -5 -> sprintf "dim1(a): valid=[%d..[ got=%d" (max 1 n) (Array2.dim1 a) | -8 -> sprintf "dim(work): valid=[%d..[ got=%d" (min_work n) lwork - | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) in + | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) + in invalid_arg (sprintf "%s: %s" loc msg) let syevd_err loc min_work min_iwork a n lwork liwork err = if err = -10 then let msg = - sprintf "%s: dim(iwork): valid=[%d..[ got=%d" loc (min_iwork n) liwork in + sprintf "%s: dim(iwork): valid=[%d..[ got=%d" loc (min_iwork n) liwork + in invalid_arg msg else syev_err loc min_work a n lwork err - (* SYEV *) external direct_syev : - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - n : (int [@untagged]) -> - jobz : char -> - uplo : char -> - ofsw : (int [@untagged]) -> - w : vec -> - work : vec -> - lwork : (int [@untagged]) - -> (int [@untagged]) = "lacaml_FPRECsyev_stub_bc" "lacaml_FPRECsyev_stub" - -let syev_min_lwork n = max 1 (3 * n - 1) + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + n:(int[@untagged]) -> + jobz:char -> + uplo:char -> + ofsw:(int[@untagged]) -> + w:vec -> + work:vec -> + lwork:(int[@untagged]) -> + (int[@untagged]) = "lacaml_FPRECsyev_stub_bc" "lacaml_FPRECsyev_stub" + +let syev_min_lwork n = max 1 ((3 * n) - 1) let syev_get_opt_lwork loc ar ac a n jobz uplo = let work = Vec.create 1 in @@ -1145,8 +1058,8 @@ let syev_opt_lwork ?n ?(vectors = false) ?(up = true) ?(ar = 1) ?(ac = 1) a = let n, jobz, uplo = xxev_get_params loc ar ac a n vectors up in syev_get_opt_lwork loc ar ac a n jobz uplo -let syev ?n ?(vectors = false) ?(up = true) ?work ?ofsw ?w ?(ar = 1) - ?(ac = 1) a = +let syev ?n ?(vectors = false) ?(up = true) ?work ?ofsw ?w ?(ar = 1) ?(ac = 1) a + = let loc = "Lacaml.FPREC.syev" in let n, jobz, uplo = xxev_get_params loc ar ac a n vectors up in let ofsw = get_vec_ofs loc w_str ofsw in @@ -1154,56 +1067,52 @@ let syev ?n ?(vectors = false) ?(up = true) ?work ?ofsw ?w ?(ar = 1) let work, lwork = match work with - | Some work -> work, Array1.dim work + | Some work -> (work, Array1.dim work) | None -> let lwork = syev_get_opt_lwork loc ar ac a n jobz uplo in - Vec.create lwork, lwork in + (Vec.create lwork, lwork) + in let info = direct_syev ~ar ~ac ~a ~n ~jobz ~uplo ~ofsw ~w ~work ~lwork in - if info = 0 then w - else syev_err loc syev_min_lwork a n lwork info - + if info = 0 then w else syev_err loc syev_min_lwork a n lwork info (* SYEVD *) external direct_syevd : - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - n : (int [@untagged]) -> - jobz : char -> - uplo : char -> - ofsw : (int [@untagged]) -> - w : vec -> - work : vec -> - lwork : (int [@untagged]) -> - iwork : int32_vec -> - liwork : (int [@untagged]) - -> (int [@untagged]) = "lacaml_FPRECsyevd_stub_bc" "lacaml_FPRECsyevd_stub" + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + n:(int[@untagged]) -> + jobz:char -> + uplo:char -> + ofsw:(int[@untagged]) -> + w:vec -> + work:vec -> + lwork:(int[@untagged]) -> + iwork:int32_vec -> + liwork:(int[@untagged]) -> + (int[@untagged]) = "lacaml_FPRECsyevd_stub_bc" "lacaml_FPRECsyevd_stub" let syevd_min_lwork ~vectors n = if n <= 1 then 1 - else - if vectors then - let nn = n * n in - 1 + 6*n + nn + nn - else n + n + 1 + else if vectors then + let nn = n * n in + 1 + (6 * n) + nn + nn + else n + n + 1 let syevd_min_liwork ~vectors n = - if n <= 1 || not vectors then 1 - else 3 + 5*n + if n <= 1 || not vectors then 1 else 3 + (5 * n) let syevd_get_opt_l_li_work loc ar ac a n vectors jobz uplo = let work = Vec.create 1 in let iwork = Common.create_int32_vec 1 in let info = - direct_syevd - ~ar ~ac ~a ~n ~jobz ~uplo ~ofsw:1 ~w:Vec.empty - ~work ~lwork:~-1 ~iwork ~liwork:~-1 + direct_syevd ~ar ~ac ~a ~n ~jobz ~uplo ~ofsw:1 ~w:Vec.empty ~work ~lwork:~-1 + ~iwork ~liwork:~-1 in - if info = 0 then int_of_float work.{1}, Int32.to_int iwork.{1} + if info = 0 then (int_of_float work.{1}, Int32.to_int iwork.{1}) else - syevd_err - loc (syevd_min_lwork ~vectors) (syevd_min_liwork ~vectors) + syevd_err loc (syevd_min_lwork ~vectors) + (syevd_min_liwork ~vectors) a n ~-1 ~-1 info let syevd_get_opt_lwork loc ar ac a n vectors jobz uplo = @@ -1212,8 +1121,8 @@ let syevd_get_opt_lwork loc ar ac a n vectors jobz uplo = let syevd_get_opt_liwork loc ar ac a n vectors jobz uplo = snd (syevd_get_opt_l_li_work loc ar ac a n vectors jobz uplo) -let syevd_opt_l_li_work ?n ?(vectors = false) ?(up = true) - ?(ar = 1) ?(ac = 1) a = +let syevd_opt_l_li_work ?n ?(vectors = false) ?(up = true) ?(ar = 1) ?(ac = 1) a + = let loc = "Lacaml.FPREC.syevd_opt_l_li_work" in let n, jobz, uplo = xxev_get_params loc ar ac a n vectors up in syevd_get_opt_l_li_work loc ar ac a n vectors jobz uplo @@ -1224,66 +1133,70 @@ let syevd_opt_lwork ?n ?vectors ?up ?ar ?ac a = let syevd_opt_liwork ?n ?vectors ?up ?ar ?ac a = snd (syevd_opt_l_li_work ?n ?vectors ?up ?ar ?ac a) -let syevd ?n ?(vectors = false) ?(up = true) ?work ?iwork ?ofsw ?w - ?(ar = 1) ?(ac = 1) a = +let syevd ?n ?(vectors = false) ?(up = true) ?work ?iwork ?ofsw ?w ?(ar = 1) + ?(ac = 1) a = let loc = "Lacaml.FPREC.syevd" in let n, jobz, uplo = xxev_get_params loc ar ac a n vectors up in let ofsw = get_vec_ofs loc w_str ofsw in let w = xxev_get_wx Vec.create loc w_str ofsw w n in let work, iwork, lwork, liwork = - match work, iwork with + match (work, iwork) with | Some work, Some iwork -> let lwork = Array1.dim work in let liwork = Array1.dim iwork in - work, iwork, lwork, liwork + (work, iwork, lwork, liwork) | Some work, None -> let lwork = Array1.dim work in let liwork = syevd_get_opt_liwork loc ar ac a n vectors jobz uplo in let iwork = Common.create_int32_vec liwork in - work, iwork, lwork, liwork + (work, iwork, lwork, liwork) | None, Some iwork -> let lwork = syevd_get_opt_lwork loc ar ac a n vectors jobz uplo in let work = Vec.create lwork in let liwork = Array1.dim iwork in - work, iwork, lwork, liwork + (work, iwork, lwork, liwork) | None, None -> let lwork, liwork = - syevd_get_opt_l_li_work loc ar ac a n vectors jobz uplo in + syevd_get_opt_l_li_work loc ar ac a n vectors jobz uplo + in let work = Vec.create lwork in let iwork = Common.create_int32_vec liwork in - work, iwork, lwork, liwork in + (work, iwork, lwork, liwork) + in let info = direct_syevd ~ar ~ac ~a ~n ~jobz ~uplo ~ofsw ~w ~work ~lwork ~iwork ~liwork in if info = 0 then w else - syevd_err - loc (syevd_min_lwork ~vectors) (syevd_min_liwork ~vectors) + syevd_err loc (syevd_min_lwork ~vectors) + (syevd_min_liwork ~vectors) a n lwork liwork info (* SBEV *) external direct_sbev : - abr : (int [@untagged]) -> - abc : (int [@untagged]) -> - ab : mat -> - n : (int [@untagged]) -> - kd : (int [@untagged]) -> - jobz : char -> - uplo : char -> - ofsw : (int [@untagged]) -> - w : vec -> - zr : (int [@untagged]) -> - zc : (int [@untagged]) -> - z : mat -> - ldz : (int [@untagged]) -> (* require ldz = 1 when z empty (no eigenvectors) *) - work : vec - -> (int [@untagged]) = "lacaml_FPRECsbev_stub_bc" "lacaml_FPRECsbev_stub" + abr:(int[@untagged]) -> + abc:(int[@untagged]) -> + ab:mat -> + n:(int[@untagged]) -> + kd:(int[@untagged]) -> + jobz:char -> + uplo:char -> + ofsw:(int[@untagged]) -> + w:vec -> + zr:(int[@untagged]) -> + zc:(int[@untagged]) -> + z:mat -> + ldz:(int[@untagged]) -> + (* require ldz = 1 when z empty (no eigenvectors) *) + work:vec -> + (int[@untagged]) = "lacaml_FPRECsbev_stub_bc" "lacaml_FPRECsbev_stub" let sbev_err loc ab n kd err = if err > 0 then let msg = - sprintf "%s: failed to converge on %i off-diagonal elements" loc err in + sprintf "%s: failed to converge on %i off-diagonal elements" loc err + in failwith msg else let msg = @@ -1292,10 +1205,11 @@ let sbev_err loc ab n kd err = | -4 -> sprintf "kd: valid=[0..[ got=%d" kd | -6 -> sprintf "dim1(ab): valid=[%d..[ got=%d" (kd + 1) (Mat.dim1 ab) (* z fully checked *) - | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) in + | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) + in invalid_arg (sprintf "%s: %s" loc msg) -let sbev_min_lwork n = max 1 (3*n - 2) +let sbev_min_lwork n = max 1 ((3 * n) - 2) let sbev ?n ?kd ?(zr = 1) ?(zc = 1) ?z ?(up = true) ?work ?(ofsw = 1) ?w ?(abr = 1) ?(abc = 1) ab = @@ -1308,50 +1222,52 @@ let sbev ?n ?kd ?(zr = 1) ?(zc = 1) ?z ?(up = true) ?work ?(ofsw = 1) ?w let lwork = sbev_min_lwork n in let work = match work with - | Some work -> check_vec loc work_str work lwork; work - | None -> Vec.create lwork in + | Some work -> + check_vec loc work_str work lwork; + work + | None -> Vec.create lwork + in let jobz, z, ldz = match z with | Some z -> - check_mat_square loc z_str z zr zc n; - job_char_true, z, Mat.dim1 z - | None -> job_char_false, Mat.empty, 1 in + check_mat_square loc z_str z zr zc n; + (job_char_true, z, Mat.dim1 z) + | None -> (job_char_false, Mat.empty, 1) + in let info = - direct_sbev ~abr ~abc ~ab ~n ~kd ~jobz ~uplo ~ofsw ~w - ~zr ~zc ~z ~ldz ~work in - if info = 0 then w - else sbev_err loc ab n kd info - + direct_sbev ~abr ~abc ~ab ~n ~kd ~jobz ~uplo ~ofsw ~w ~zr ~zc ~z ~ldz ~work + in + if info = 0 then w else sbev_err loc ab n kd info -(* Symmetric-matrix eigenvalue and singular value problems (expert & - RRR drivers) *) +(* Symmetric-matrix eigenvalue and singular value problems (expert & RRR + drivers) *) (* SYEVR *) external direct_syevr : - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - n : (int [@untagged]) -> - jobz : char -> - range : char -> - uplo : char -> - vl : (float [@unboxed]) -> - vu : (float [@unboxed]) -> - il : (int [@untagged]) -> - iu : (int [@untagged]) -> - abstol : (float [@unboxed]) -> - ofsw : (int [@untagged]) -> - w : vec -> - zr : (int [@untagged]) -> - zc : (int [@untagged]) -> - z : mat -> - isuppz : int32_vec -> - work : vec -> - lwork : (int [@untagged]) -> - iwork : int32_vec -> - liwork : (int [@untagged]) - -> int * int = "lacaml_FPRECsyevr_stub_bc" "lacaml_FPRECsyevr_stub" + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + n:(int[@untagged]) -> + jobz:char -> + range:char -> + uplo:char -> + vl:(float[@unboxed]) -> + vu:(float[@unboxed]) -> + il:(int[@untagged]) -> + iu:(int[@untagged]) -> + abstol:(float[@unboxed]) -> + ofsw:(int[@untagged]) -> + w:vec -> + zr:(int[@untagged]) -> + zc:(int[@untagged]) -> + z:mat -> + isuppz:int32_vec -> + work:vec -> + lwork:(int[@untagged]) -> + iwork:int32_vec -> + liwork:(int[@untagged]) -> + int * int = "lacaml_FPRECsyevr_stub_bc" "lacaml_FPRECsyevr_stub" let syevr_err loc a n err = if err > 0 then @@ -1362,65 +1278,54 @@ let syevr_err loc a n err = match err with | -4 -> sprintf "n: valid=[0..[ got=%d" n | -6 -> sprintf "dim1(a): valid=[%d..[ got=%d" (max 1 n) (Array2.dim1 a) - | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) in + | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) + in invalid_arg (sprintf "%s: %s" loc msg) let syevr_min_lwork n = max 1 (26 * n) let syevr_min_liwork n = max 1 (10 * n) let syevr_get_params loc n = function - | `A -> 'A', n, 0., 0., 0, 0 + | `A -> ('A', n, 0., 0., 0, 0) | `V (vl, vu) -> if vl >= vu then invalid_arg (sprintf "%s: vl >= vu (%f >= %f)" loc vl vu); - 'V', n, vl, vu, 0, 0 + ('V', n, vl, vu, 0, 0) | `I (il, iu) -> if n = 0 && iu <> 0 then invalid_arg (sprintf "%s: n = 0 && iu <> 0 (%d)" loc iu); - if il < 1 then - invalid_arg (sprintf "%s: il < 1 (%d)" loc il); - if iu > n then - invalid_arg (sprintf "%s: iu > n (%d > %d)" loc iu n); - if il > iu then - invalid_arg (sprintf "%s: il > iu (%d > %d)" loc il iu); - 'I', iu - il + 1, 0., 0., il, iu + if il < 1 then invalid_arg (sprintf "%s: il < 1 (%d)" loc il); + if iu > n then invalid_arg (sprintf "%s: iu > n (%d > %d)" loc iu n); + if il > iu then invalid_arg (sprintf "%s: il > iu (%d > %d)" loc il iu); + ('I', iu - il + 1, 0., 0., il, iu) let syevr_get_abstol = function Some abstol -> abstol | None -> lamch `S -let syevr_get_opt_l_li_work - loc ar ac a n jobz range uplo vl vu il iu abstol ofsw w zr zc z isuppz = +let syevr_get_opt_l_li_work loc ar ac a n jobz range uplo vl vu il iu abstol + ofsw w zr zc z isuppz = let work = Vec.create 1 in let iwork = Common.create_int32_vec 1 in let info, _ = - direct_syevr - ~ar ~ac ~a ~n - ~jobz ~range ~uplo - ~vl ~vu - ~il ~iu - ~abstol - ~ofsw ~w - ~zr ~zc ~z - ~isuppz - ~work ~lwork:~-1 - ~iwork ~liwork:~-1 in - if info = 0 then int_of_float work.{1}, Int32.to_int iwork.{1} + direct_syevr ~ar ~ac ~a ~n ~jobz ~range ~uplo ~vl ~vu ~il ~iu ~abstol ~ofsw + ~w ~zr ~zc ~z ~isuppz ~work ~lwork:~-1 ~iwork ~liwork:~-1 + in + if info = 0 then (int_of_float work.{1}, Int32.to_int iwork.{1}) else syevr_err loc a n info -let syevr_get_opt_lwork - loc ar ac a n jobz range uplo vl vu il iu abstol ofsw w zr zc z isuppz = - fst ( - syevr_get_opt_l_li_work - loc ar ac a n jobz range uplo vl vu il iu abstol ofsw w zr zc z isuppz) - -let syevr_get_opt_liwork - loc ar ac a n jobz range uplo vl vu il iu abstol ofsw w zr zc z isuppz = - snd ( - syevr_get_opt_l_li_work - loc ar ac a n jobz range uplo vl vu il iu abstol ofsw w zr zc z isuppz) - -let syevr_opt_l_li_work - ?n ?(vectors = false) ?(range = `A) ?(up = true) ?(abstol = 0.) - ?(ar = 1) ?(ac = 1) a = +let syevr_get_opt_lwork loc ar ac a n jobz range uplo vl vu il iu abstol ofsw w + zr zc z isuppz = + fst + (syevr_get_opt_l_li_work loc ar ac a n jobz range uplo vl vu il iu abstol + ofsw w zr zc z isuppz) + +let syevr_get_opt_liwork loc ar ac a n jobz range uplo vl vu il iu abstol ofsw w + zr zc z isuppz = + snd + (syevr_get_opt_l_li_work loc ar ac a n jobz range uplo vl vu il iu abstol + ofsw w zr zc z isuppz) + +let syevr_opt_l_li_work ?n ?(vectors = false) ?(range = `A) ?(up = true) + ?(abstol = 0.) ?(ar = 1) ?(ac = 1) a = let loc = "Lacaml.FPREC.syevr_opt_l_li_work" in let n, jobz, uplo = xxev_get_params loc ar ac a n vectors up in let range, _m, vl, vu, il, iu = syevr_get_params loc n range in @@ -1430,8 +1335,8 @@ let syevr_opt_l_li_work let ofsw = 1 in let w = Vec.empty in let isuppz = empty_int32_vec in - syevr_get_opt_l_li_work - loc ar ac a n jobz range uplo vl vu il iu abstol ofsw w zr zc z isuppz + syevr_get_opt_l_li_work loc ar ac a n jobz range uplo vl vu il iu abstol ofsw + w zr zc z isuppz let syevr_opt_lwork ?n ?vectors ?range ?up ?abstol ?ar ?ac a = fst (syevr_opt_l_li_work ?n ?vectors ?range ?up ?abstol ?ar ?ac a) @@ -1440,13 +1345,14 @@ let syevr_opt_liwork ?n ?vectors ?range ?up ?abstol ?ar ?ac a = snd (syevr_opt_l_li_work ?n ?vectors ?range ?up ?abstol ?ar ?ac a) let syevr ?n ?(vectors = false) ?(range = `A) ?(up = true) ?abstol ?work ?iwork - ?ofsw ?w ?(zr = 1) ?(zc = 1) ?z ?isuppz ?(ar = 1) ?(ac = 1) a = + ?ofsw ?w ?(zr = 1) ?(zc = 1) ?z ?isuppz ?(ar = 1) ?(ac = 1) a = let loc = "Lacaml.FPREC.syevr" in let n, jobz, uplo = xxev_get_params loc ar ac a n vectors up in let range, m, vl, vu, il, iu = syevr_get_params loc n range in let abstol = syevr_get_abstol abstol in let ofsw = get_vec_ofs loc w_str ofsw in - let w = xxev_get_wx Vec.create loc w_str ofsw w m in (* [m] eigenvalues *) + let w = xxev_get_wx Vec.create loc w_str ofsw w m in + (* [m] eigenvalues *) let z = get_mat loc z_str Mat.create zr zc z n m (* order of n, m is ok! *) in let isuppz = let min_lisuppz_1 = max 1 m in @@ -1456,64 +1362,55 @@ let syevr ?n ?(vectors = false) ?(range = `A) ?(up = true) ?abstol ?work ?iwork | Some isuppz -> let lisuppz = Array1.dim isuppz in if lisuppz < min_lisuppz then - invalid_arg ( - sprintf "%s: dim(isuppz): valid=[%d..[ got=%d" - loc min_lisuppz lisuppz); - isuppz in + invalid_arg + (sprintf "%s: dim(isuppz): valid=[%d..[ got=%d" loc min_lisuppz + lisuppz); + isuppz + in let work, iwork, lwork, liwork = - match work, iwork with + match (work, iwork) with | Some work, Some iwork -> let lwork = Array1.dim work in let liwork = Array1.dim iwork in - work, iwork, lwork, liwork + (work, iwork, lwork, liwork) | Some work, None -> let lwork = Array1.dim work in let liwork = - syevr_get_opt_liwork - loc ar ac a n - jobz range uplo vl vu il iu abstol ofsw w zr zc z isuppz in + syevr_get_opt_liwork loc ar ac a n jobz range uplo vl vu il iu abstol + ofsw w zr zc z isuppz + in let iwork = Common.create_int32_vec liwork in - work, iwork, lwork, liwork + (work, iwork, lwork, liwork) | None, Some iwork -> let lwork = - syevr_get_opt_lwork - loc ar ac a n - jobz range uplo vl vu il iu abstol ofsw w zr zc z isuppz in + syevr_get_opt_lwork loc ar ac a n jobz range uplo vl vu il iu abstol + ofsw w zr zc z isuppz + in let work = Vec.create lwork in let liwork = Array1.dim iwork in - work, iwork, lwork, liwork + (work, iwork, lwork, liwork) | None, None -> let lwork, liwork = - syevr_get_opt_l_li_work - loc ar ac a n - jobz range uplo vl vu il iu abstol ofsw w zr zc z isuppz in + syevr_get_opt_l_li_work loc ar ac a n jobz range uplo vl vu il iu + abstol ofsw w zr zc z isuppz + in let work = Vec.create lwork in let iwork = Common.create_int32_vec liwork in - work, iwork, lwork, liwork in + (work, iwork, lwork, liwork) + in let info, m = - direct_syevr - ~ar ~ac ~a ~n - ~jobz ~range ~uplo - ~vl ~vu - ~il ~iu - ~abstol - ~ofsw ~w - ~zr ~zc ~z - ~isuppz - ~work ~lwork - ~iwork ~liwork - in - if info = 0 then m, w, z, isuppz - else syevr_err loc a n info - + direct_syevr ~ar ~ac ~a ~n ~jobz ~range ~uplo ~vl ~vu ~il ~iu ~abstol ~ofsw + ~w ~zr ~zc ~z ~isuppz ~work ~lwork ~iwork ~liwork + in + if info = 0 then (m, w, z, isuppz) else syevr_err loc a n info (* SYGV *) let sygv_err loc min_work a b n lwork err = if err > n then let msg = - sprintf "%s: leading minor of order %d of b is not positive definite" - loc (err - n) + sprintf "%s: leading minor of order %d of b is not positive definite" loc + (err - n) in failwith msg else if err > 0 then @@ -1535,36 +1432,35 @@ let sygv_err loc min_work a b n lwork err = let get_itype = function `A_B -> 1 | `AB -> 2 | `BA -> 3 external direct_sygv : - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> - n : (int [@untagged]) -> - itype : (int [@untagged]) -> - jobz : char -> - uplo : char -> - ofsw : (int [@untagged]) -> - w : vec -> - work : vec -> - lwork : (int [@untagged]) - -> (int [@untagged]) = "lacaml_FPRECsygv_stub_bc" "lacaml_FPRECsygv_stub" - -let sygv_min_lwork n = max 1 (3 * n - 1) + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + n:(int[@untagged]) -> + itype:(int[@untagged]) -> + jobz:char -> + uplo:char -> + ofsw:(int[@untagged]) -> + w:vec -> + work:vec -> + lwork:(int[@untagged]) -> + (int[@untagged]) = "lacaml_FPRECsygv_stub_bc" "lacaml_FPRECsygv_stub" + +let sygv_min_lwork n = max 1 ((3 * n) - 1) let sygv_get_opt_lwork loc ar ac a br bc b n itype jobz uplo = let work = Vec.create 1 in let info = - direct_sygv ~ar ~ac ~a ~br ~bc ~b ~n ~itype ~jobz ~uplo - ~ofsw:1 ~w:Vec.empty ~work ~lwork:(-1) + direct_sygv ~ar ~ac ~a ~br ~bc ~b ~n ~itype ~jobz ~uplo ~ofsw:1 ~w:Vec.empty + ~work ~lwork:(-1) in if info = 0 then int_of_float work.{1} else sygv_err loc sygv_min_lwork a b n (-1) info -let sygv_opt_lwork - ?n ?(vectors = false) ?(up = true) ?(itype = `A_B) - ?(ar = 1) ?(ac = 1) a ?(br = 1) ?(bc = 1) b = +let sygv_opt_lwork ?n ?(vectors = false) ?(up = true) ?(itype = `A_B) ?(ar = 1) + ?(ac = 1) a ?(br = 1) ?(bc = 1) b = let loc = "Lacaml.FPREC.sygv_opt_lwork" in let n, jobz, uplo = xxev_get_params loc ar ac a n vectors up in check_dim1_mat loc b_str b br n_str n; @@ -1572,9 +1468,8 @@ let sygv_opt_lwork let itype = get_itype itype in sygv_get_opt_lwork loc ar ac a br bc b n itype jobz uplo -let sygv - ?n ?(vectors = false) ?(up = true) ?work ?ofsw ?w ?(itype = `A_B) - ?(ar = 1) ?(ac = 1) a ?(br = 1) ?(bc = 1) b = +let sygv ?n ?(vectors = false) ?(up = true) ?work ?ofsw ?w ?(itype = `A_B) + ?(ar = 1) ?(ac = 1) a ?(br = 1) ?(bc = 1) b = let loc = "Lacaml.FPREC.sygv" in let n, jobz, uplo = xxev_get_params loc ar ac a n vectors up in check_dim1_mat loc b_str b br n_str n; @@ -1584,51 +1479,52 @@ let sygv let itype = get_itype itype in let work, lwork = match work with - | Some work -> work, Array1.dim work + | Some work -> (work, Array1.dim work) | None -> let lwork = sygv_get_opt_lwork loc ar ac a br bc b n itype jobz uplo in - Vec.create lwork, lwork + (Vec.create lwork, lwork) in let info = - direct_sygv - ~ar ~ac ~a ~br ~bc ~b ~n ~itype ~jobz ~uplo ~ofsw ~w ~work ~lwork + direct_sygv ~ar ~ac ~a ~br ~bc ~b ~n ~itype ~jobz ~uplo ~ofsw ~w ~work + ~lwork in - if info = 0 then w - else sygv_err loc sygv_min_lwork a b n lwork info + if info = 0 then w else sygv_err loc sygv_min_lwork a b n lwork info (* SBGV *) external direct_sbgv : - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> - n : (int [@untagged]) -> - ka : (int [@untagged]) -> - kb : (int [@untagged]) -> - jobz : char -> - uplo : char -> - ofsw : (int [@untagged]) -> - w : vec -> - zr : (int [@untagged]) -> - zc : (int [@untagged]) -> - z : mat -> - work : vec - -> (int [@untagged]) = "lacaml_FPRECsbgv_stub_bc" "lacaml_FPRECsbgv_stub" + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + n:(int[@untagged]) -> + ka:(int[@untagged]) -> + kb:(int[@untagged]) -> + jobz:char -> + uplo:char -> + ofsw:(int[@untagged]) -> + w:vec -> + zr:(int[@untagged]) -> + zc:(int[@untagged]) -> + z:mat -> + work:vec -> + (int[@untagged]) = "lacaml_FPRECsbgv_stub_bc" "lacaml_FPRECsbgv_stub" let sbgv_min_lwork n = 3 * n let sbgv_err loc a b n ka kb z err = if err > n then let msg = - sprintf "%s: leading minor of order %d of b is not positive definite" - loc (err - n) in + sprintf "%s: leading minor of order %d of b is not positive definite" loc + (err - n) + in failwith msg else if err > 0 then let msg = - sprintf "%s: failed to converge on off-diagonal element %d" loc err in + sprintf "%s: failed to converge on off-diagonal element %d" loc err + in failwith msg else let msg = @@ -1644,12 +1540,11 @@ let sbgv_err loc a b n ka kb z err = invalid_arg (sprintf "%s: %s" loc msg) let dummy_matrix = Mat.create 1 0 -(* The fact that the number of rows is 1 is important, otherwise SBGV - rejects LDZ as being illegal. *) +(* The fact that the number of rows is 1 is important, otherwise SBGV rejects + LDZ as being illegal. *) -let sbgv - ?n ?ka ?kb ?(zr = 1) ?(zc = 1) ?z ?(up = true) ?work ?ofsw ?w - ?(ar = 1) ?(ac = 1) a ?(br = 1) ?(bc = 1) b = +let sbgv ?n ?ka ?kb ?(zr = 1) ?(zc = 1) ?z ?(up = true) ?work ?ofsw ?w ?(ar = 1) + ?(ac = 1) a ?(br = 1) ?(bc = 1) b = let loc = "Lacaml.FPREC.sbgv" in (* [a] is a band matrix of size [ka+1]*[n]. *) let n = get_dim2_mat loc a_str a ac n_str n in @@ -1657,20 +1552,24 @@ let sbgv check_dim2_mat loc b_str b bc n_str n; let kb = get_k_mat_sb loc b_str b br kb_str kb in let uplo = get_uplo_char up in - let jobz, z = match z with - | None -> job_char_false, dummy_matrix + let jobz, z = + match z with + | None -> (job_char_false, dummy_matrix) | Some z -> - check_dim_mat loc z_str zr zc z n n; - job_char_true, z in + check_dim_mat loc z_str zr zc z n n; + (job_char_true, z) + in let ofsw = get_vec_ofs loc w_str ofsw in let w = xxev_get_wx Vec.create loc w_str ofsw w n in - let work = match work with - | Some work -> check_vec loc work_str work (sbgv_min_lwork n); work + let work = + match work with + | Some work -> + check_vec loc work_str work (sbgv_min_lwork n); + work | None -> Vec.create (sbgv_min_lwork n) in let info = - direct_sbgv - ~ar ~ac ~a ~br ~bc ~b ~n ~ka ~kb ~jobz ~uplo ~ofsw ~w ~zr ~zc ~z ~work + direct_sbgv ~ar ~ac ~a ~br ~bc ~b ~n ~ka ~kb ~jobz ~uplo ~ofsw ~w ~zr ~zc ~z + ~work in - if info = 0 then w - else sbgv_err loc a b n ka kb z info + if info = 0 then w else sbgv_err loc a b n ka kb z info diff --git a/src/impl_SD.mli b/src/impl_SD.mli index c7c8dab..d2bfc47 100644 --- a/src/impl_SD.mli +++ b/src/impl_SD.mli @@ -1,41 +1,30 @@ (* File: impl_SD.mli - Copyright (C) 2001- + Copyright © 2001- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - Liam Stewart - email: liam@cs.toronto.edu - WWW: http://www.cs.toronto.edu/~liam + Liam Stewart - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umh.ac.be/an/ + Christophe Troestler - Oleg Trott - email: ot14@columbia.edu - WWW: http://www.columbia.edu/~ot14 + Oleg Trott - Florent Hoareau - email: h.florent@gmail.com - WWW: none + Florent Hoareau - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) open Common open Floatxx @@ -43,48 +32,46 @@ open Floatxx (** {6 BLAS-1 interface} *) val dot : - ?n : int -> - ?ofsx : int -> - ?incx : int -> + ?n:int -> + ?ofsx:int -> + ?incx:int -> vec -> - ?ofsy : int -> - ?incy : int -> - vec - -> float + ?ofsy:int -> + ?incy:int -> + vec -> + float (** [dot ?n ?ofsx ?incx x ?ofsy ?incy y] see BLAS documentation! @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsx default = 1 @param incx default = 1 @param ofsy default = 1 - @param incy default = 1 -*) + @param incy default = 1 *) -val asum : ?n : int -> ?ofsx : int -> ?incx : int -> vec -> float +val asum : ?n:int -> ?ofsx:int -> ?incx:int -> vec -> float (** [asum ?n ?ofsx ?incx x] see BLAS documentation! @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsx default = 1 @param incx default = 1 *) - (** {6 BLAS-2 interface} *) val sbmv : - ?n : int -> - ?k : int -> - ?ofsy : int -> - ?incy : int -> - ?y : vec -> - ?ar : int -> - ?ac : int -> + ?n:int -> + ?k:int -> + ?ofsy:int -> + ?incy:int -> + ?y:vec -> + ?ar:int -> + ?ac:int -> mat -> - ?up : bool -> - ?alpha : float -> - ?beta : float -> - ?ofsx : int -> - ?incx : int -> + ?up:bool -> + ?alpha:float -> + ?beta:float -> + ?ofsx:int -> + ?incx:int -> + vec -> vec - -> vec (** [sbmv ?n ?k ?ofsy ?incy ?y ?ar ?ac a ?up ?alpha ?beta ?ofsx ?incx x] see BLAS documentation! @@ -101,25 +88,24 @@ val sbmv : @param alpha default = 1.0 @param beta default = 0.0 @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val ger : - ?m : int -> - ?n : int -> - ?alpha : float -> - ?ofsx : int -> - ?incx : int -> + ?m:int -> + ?n:int -> + ?alpha:float -> + ?ofsx:int -> + ?incx:int -> vec -> - ?ofsy : int -> - ?incy : int -> + ?ofsy:int -> + ?incy:int -> vec -> - ?ar : int -> - ?ac : int -> - mat - -> unit -(** [ger ?m ?n ?alpha ?ofsx ?incx x ?ofsy ?incy y n ?ar ?ac a] see - BLAS documentation! + ?ar:int -> + ?ac:int -> + mat -> + unit +(** [ger ?m ?n ?alpha ?ofsx ?incx x ?ofsy ?incy y n ?ar ?ac a] see BLAS + documentation! @param m default = number of rows of [a] @param n default = number of columns of [a] @@ -129,20 +115,19 @@ val ger : @param ofsy default = 1 @param incy default = 1 @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val syr : - ?n : int -> - ?alpha : float -> - ?up : bool -> - ?ofsx : int -> - ?incx : int -> + ?n:int -> + ?alpha:float -> + ?up:bool -> + ?ofsx:int -> + ?incx:int -> vec -> - ?ar : int -> - ?ac : int -> - mat - -> unit + ?ar:int -> + ?ac:int -> + mat -> + unit (** [syr ?n ?alpha ?up ?ofsx ?incx x ?ar ?ac a] see BLAS documentation! @param n default = number of rows of [a] @@ -151,8 +136,7 @@ val syr : @param ofsx default = 1 @param incx default = 1 @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) (** {6 LAPACK interface} *) @@ -165,42 +149,34 @@ val lansy_min_lwork : int -> norm4 -> int @param n the number of columns (and rows) in the matrix *) val lansy : - ?n : int -> - ?up : bool -> - ?norm : norm4 -> - ?work : vec -> - ?ar : int -> - ?ac : int -> - mat - -> float + ?n:int -> + ?up:bool -> + ?norm:norm4 -> + ?work:vec -> + ?ar:int -> + ?ac:int -> + mat -> + float (** [lansy ?norm ?up ?n ?ar ?ac ?work a] see LAPACK documentation! @param norm default = `O @param up default = true (reference upper triangular part of [a]) @param n default = number of columns of matrix [a] @param work default = allocated work space for norm `I *) -val lamch : [ `E | `S | `B | `P | `N | `R | `M | `U | `L | `O ] -> float +val lamch : [ `E | `S | `B | `P | `N | `R | `M | `U | `L | `O ] -> float (** [lamch cmach] see LAPACK documentation! *) - (** {7 Linear equations (computational routines)} *) (* ORGQR *) -val orgqr_min_lwork : n : int -> int +val orgqr_min_lwork : n:int -> int (** [orgqr_min_lwork ~n] @return the minimum length of the work-array used by the [orgqr]-function if the matrix has [n] columns. *) val orgqr_opt_lwork : - ?m : int -> - ?n : int -> - ?k : int -> - tau : vec -> - ?ar : int -> - ?ac : int -> - mat -> - int + ?m:int -> ?n:int -> ?k:int -> tau:vec -> ?ar:int -> ?ac:int -> mat -> int (** [orgqr_opt_lwork ?m ?n ?k ~tau ?ar ?ac a] @return the optimum length of the work-array used by the [orgqr]-function given matrix [a], optionally its logical dimensions [m] and [n], and the number of reflectors @@ -212,74 +188,70 @@ val orgqr_opt_lwork : *) val orgqr : - ?m : int -> - ?n : int -> - ?k : int -> - ?work : vec -> - tau : vec -> - ?ar : int -> - ?ac : int -> + ?m:int -> + ?n:int -> + ?k:int -> + ?work:vec -> + tau:vec -> + ?ar:int -> + ?ac:int -> mat -> unit (** [orgqr ?m ?n ?k ?work ~tau ?ar ?ac a] see LAPACK documentation! @param m default = available number of rows in matrix [a] @param n default = available number of columns in matrix [a] - @param k default = available number of elements in vector [tau] -*) - + @param k default = available number of elements in vector [tau] *) (* ORMQR *) val ormqr_opt_lwork : - ?side : side -> - ?trans : trans2 -> - ?m : int -> - ?n : int -> - ?k : int -> - tau : vec -> - ?ar : int -> - ?ac : int -> + ?side:side -> + ?trans:trans2 -> + ?m:int -> + ?n:int -> + ?k:int -> + tau:vec -> + ?ar:int -> + ?ac:int -> mat -> - ?cr : int -> - ?cc : int -> + ?cr:int -> + ?cc:int -> mat -> int (** [ormqr_opt_lwork ?side ?trans ?m ?n ?k ~tau ?ar ?ac a ?cr ?cc c] - @return the optimum length of the work-array used by the [ormqr]-function - given matrix [a] and [b], optionally its logical dimensions [m] and [n], - and the number of reflectors [k]. + @return + the optimum length of the work-array used by the [ormqr]-function given + matrix [a] and [b], optionally its logical dimensions [m] and [n], and the + number of reflectors [k]. @param m default = available number of rows in matrix [a] @param n default = available number of columns in matrix [a] - @param k default = available number of elements in vector [tau] -*) + @param k default = available number of elements in vector [tau] *) val ormqr : - ?side : side -> - ?trans : trans2 -> - ?m : int -> - ?n : int -> - ?k : int -> - ?work : vec -> - tau : vec -> - ?ar : int -> - ?ac : int -> + ?side:side -> + ?trans:trans2 -> + ?m:int -> + ?n:int -> + ?k:int -> + ?work:vec -> + tau:vec -> + ?ar:int -> + ?ac:int -> mat -> - ?cr : int -> - ?cc : int -> + ?cr:int -> + ?cc:int -> mat -> unit -(** [ormqr ?side ?trans ?m ?n ?k ?work ~tau ?ar ?ac a ?cr ?cc c] - see LAPACK documentation! +(** [ormqr ?side ?trans ?m ?n ?k ?work ~tau ?ar ?ac a ?cr ?cc c] see LAPACK + documentation! @param side default = [`L] @param trans default = [`N] @param m default = available number of rows in matrix [a] @param n default = available number of columns in matrix [a] - @param k default = available number of elements in vector [tau] -*) - + @param k default = available number of elements in vector [tau] *) (* GECON *) @@ -295,15 +267,15 @@ val gecon_min_liwork : int -> int @param n the logical dimensions of the matrix given to [gecon]-function *) val gecon : - ?n : int -> - ?norm : norm2 -> - ?anorm : float -> - ?work : vec -> - ?iwork : int32_vec -> - ?ar : int -> - ?ac : int -> - mat - -> float + ?n:int -> + ?norm:norm2 -> + ?anorm:float -> + ?work:vec -> + ?iwork:int32_vec -> + ?ar:int -> + ?ac:int -> + mat -> + float (** [gecon ?n ?norm ?anorm ?work ?rwork ?ar ?ac a] @return estimate of the reciprocal of the condition number of matrix [a] @param n default = available number of columns of matrix [a] @@ -328,19 +300,19 @@ val sycon_min_liwork : int -> int @param n the logical dimensions of the matrix given to [sycon]-function *) val sycon : - ?n : int -> - ?up : bool -> - ?ipiv : int32_vec -> - ?anorm : float -> - ?work : vec -> - ?iwork : int32_vec -> - ?ar : int -> - ?ac : int -> - mat - -> float + ?n:int -> + ?up:bool -> + ?ipiv:int32_vec -> + ?anorm:float -> + ?work:vec -> + ?iwork:int32_vec -> + ?ar:int -> + ?ac:int -> + mat -> + float (** [sycon ?n ?up ?ipiv ?anorm ?work ?iwork ?ar ?ac a] - @return estimate of the reciprocal of the condition number - of symmetric matrix [a] + @return + estimate of the reciprocal of the condition number of symmetric matrix [a] @param n default = available number of columns of matrix [a] @param up default = upper triangle of the factorization of [a] is stored @param ipiv default = vec of length [n] @@ -362,44 +334,45 @@ val pocon_min_liwork : int -> int @param n the logical dimensions of the matrix given to [pocon]-function *) val pocon : - ?n : int -> - ?up : bool -> - ?anorm : float -> - ?work : vec -> - ?iwork : int32_vec -> - ?ar : int -> - ?ac : int -> - mat - -> float + ?n:int -> + ?up:bool -> + ?anorm:float -> + ?work:vec -> + ?iwork:int32_vec -> + ?ar:int -> + ?ac:int -> + mat -> + float (** [pocon ?n ?up ?anorm ?work ?iwork ?ar ?ac a] - @return estimate of the reciprocal of the condition number of - symmetric positive definite matrix [a] + @return + estimate of the reciprocal of the condition number of symmetric positive + definite matrix [a] @param n default = available number of columns of matrix [a] - @param up default = upper triangle of Cholesky factorization - of [a] is stored + @param up + default = upper triangle of Cholesky factorization of [a] is stored @param work default = automatically allocated workspace @param iwork default = automatically allocated workspace @param anorm default = 1-norm of the matrix [a] as returned by [lange] *) (** {7 Least squares (expert drivers)} *) -val gelsy_min_lwork : m : int -> n : int -> nrhs : int -> int +val gelsy_min_lwork : m:int -> n:int -> nrhs:int -> int (** [gelsy_min_lwork ~m ~n ~nrhs] @return the minimum length of the work-array used by the [gelsy]-function if the logical dimensions of the matrix are [m] rows and [n] columns and if there are [nrhs] right hand side vectors. *) val gelsy_opt_lwork : - ?m : int -> - ?n : int -> - ?ar : int -> - ?ac : int -> + ?m:int -> + ?n:int -> + ?ar:int -> + ?ac:int -> + mat -> + ?nrhs:int -> + ?br:int -> + ?bc:int -> mat -> - ?nrhs : int -> - ?br : int -> - ?bc : int -> - mat - -> int + int (** [gelsy_opt_lwork ?m ?n ?ar ?ac a ?nrhs ?br ?bc b] @return the optimum length of the work-array used by the [gelsy]-function given matrix [a], optionally its logical dimensions [m] and [n] and given right @@ -409,19 +382,19 @@ val gelsy_opt_lwork : @param nrhs default = available number of columns in matrix [b] *) val gelsy : - ?m : int -> - ?n : int -> - ?ar : int -> - ?ac : int -> + ?m:int -> + ?n:int -> + ?ar:int -> + ?ac:int -> mat -> - ?rcond : float -> - ?jpvt : int32_vec -> - ?work : vec -> - ?nrhs : int -> - ?br : int -> - ?bc : int -> - mat - -> int + ?rcond:float -> + ?jpvt:int32_vec -> + ?work:vec -> + ?nrhs:int -> + ?br:int -> + ?bc:int -> + mat -> + int (** [gelsy ?m ?n ?ar ?ac a ?rcond ?jpvt ?ofswork ?work ?nrhs b] see LAPACK documentation! @return the effective rank of [a]. @param m default = available number of rows in matrix [a] @@ -431,23 +404,23 @@ val gelsy : @param work default = vec of optimum length (-> [gelsy_opt_lwork]) @param nrhs default = available number of columns in matrix [b] *) -val gelsd_min_lwork : m : int -> n : int -> nrhs : int -> int +val gelsd_min_lwork : m:int -> n:int -> nrhs:int -> int (** [gelsd_min_lwork ~m ~n ~nrhs] @return the minimum length of the work-array used by the [gelsd]-function if the logical dimensions of the matrix are [m] and [n] and if there are [nrhs] right hand side vectors. *) val gelsd_opt_lwork : - ?m : int -> - ?n : int -> - ?ar : int -> - ?ac : int -> + ?m:int -> + ?n:int -> + ?ar:int -> + ?ac:int -> + mat -> + ?nrhs:int -> + ?br:int -> + ?bc:int -> mat -> - ?nrhs : int -> - ?br : int -> - ?bc : int -> - mat - -> int + int (** [gelsd_opt_lwork ?m ?n ?ar ?ac a ?nrhs b] @return the optimum length of the work-array used by the [gelsd]-function given matrix [a], optionally its logical dimensions [m] and [n] and given right hand @@ -462,23 +435,23 @@ val gelsd_min_iwork : int -> int -> int dimensions of the matrix are [m] and [n]. *) val gelsd : - ?m : int -> - ?n : int -> - ?rcond : float -> - ?ofss : int -> - ?s : vec -> - ?work : vec -> - ?iwork : vec -> - ?ar : int -> - ?ac : int -> + ?m:int -> + ?n:int -> + ?rcond:float -> + ?ofss:int -> + ?s:vec -> + ?work:vec -> + ?iwork:vec -> + ?ar:int -> + ?ac:int -> + mat -> + ?nrhs:int -> + ?br:int -> + ?bc:int -> mat -> - ?nrhs : int -> - ?br : int -> - ?bc : int -> - mat - -> int -(** [gelsd ?m ?n ?rcond ?ofss ?s ?ofswork ?work ?ar ?ac a ?nrhs b] - see LAPACK documentation! + int +(** [gelsd ?m ?n ?rcond ?ofss ?s ?ofswork ?work ?ar ?ac a ?nrhs b] see LAPACK + documentation! @return the effective rank of [a]. @raise Failure if the function fails to converge. @param m default = available number of rows in matrix [a] @@ -490,23 +463,23 @@ val gelsd : @param iwork default = vec of optimum (= minimum) length @param nrhs default = available number of columns in matrix [b] *) -val gelss_min_lwork : m : int -> n : int -> nrhs : int -> int +val gelss_min_lwork : m:int -> n:int -> nrhs:int -> int (** [gelss_min_lwork ~m ~n ~nrhs] @return the minimum length of the work-array used by the [gelss]-function if the logical dimensions of the matrix are [m] rows and [n] columns and if there are [nrhs] right hand side vectors. *) val gelss_opt_lwork : - ?ar : int -> - ?ac : int -> + ?ar:int -> + ?ac:int -> mat -> - ?m : int -> - ?n : int -> - ?nrhs : int -> - ?br : int -> - ?bc : int -> - mat - -> int + ?m:int -> + ?n:int -> + ?nrhs:int -> + ?br:int -> + ?bc:int -> + mat -> + int (** [gelss_opt_lwork ?ar ?ac a ?m ?n ?nrhs ?br ?bc b] @return the optimum length of the work-array used by the [gelss]-function given matrix [a], optionally its logical dimensions [m] and [n] and given right @@ -516,22 +489,22 @@ val gelss_opt_lwork : @param nrhs default = available number of columns in matrix [b] *) val gelss : - ?m : int -> - ?n : int -> - ?rcond : float -> - ?ofss : int -> - ?s : vec -> - ?work : vec -> - ?ar : int -> - ?ac : int -> + ?m:int -> + ?n:int -> + ?rcond:float -> + ?ofss:int -> + ?s:vec -> + ?work:vec -> + ?ar:int -> + ?ac:int -> mat -> - ?nrhs : int -> - ?br : int -> - ?bc : int -> - mat - -> int -(** [gelss ?m ?n ?rcond ?ofss ?s ?ofswork ?work ?ar ?ac a ?nrhs ?br ?bc b] - see LAPACK documentation! + ?nrhs:int -> + ?br:int -> + ?bc:int -> + mat -> + int +(** [gelss ?m ?n ?rcond ?ofss ?s ?ofswork ?work ?ar ?ac a ?nrhs ?br ?bc b] see + LAPACK documentation! @return the effective rank of [a]. @raise Failure if the function fails to converge. @param m default = available number of rows in matrix [a] @@ -542,84 +515,113 @@ val gelss : @param work default = vec of optimum length (-> [gelss_opt_lwork]) @param nrhs default = available number of columns in matrix [b] *) - (** {7 General Schur factorization} *) val gees : - ?n : int -> - ?jobvs : Common.schur_vectors -> - ?sort : Common.eigen_value_sort -> - ?wr : vec -> - ?wi : vec -> - ?vsr : int -> ?vsc : int -> ?vs : mat -> - ?work : vec -> - ?ar : int -> ?ac : int -> - mat -> int * vec * vec * mat - (** [gees ?n ?jobvs ?sort ?w ?vsr ?vsc ?vs ?work ?ar ?ac a] - See [gees]-function for details about arguments. - @return (sdim, wr, wi, vs) *) - + ?n:int -> + ?jobvs:Common.schur_vectors -> + ?sort:Common.eigen_value_sort -> + ?wr:vec -> + ?wi:vec -> + ?vsr:int -> + ?vsc:int -> + ?vs:mat -> + ?work:vec -> + ?ar:int -> + ?ac:int -> + mat -> + int * vec * vec * mat +(** [gees ?n ?jobvs ?sort ?w ?vsr ?vsc ?vs ?work ?ar ?ac a] See [gees]-function + for details about arguments. + @return (sdim, wr, wi, vs) *) (** {7 General SVD routines} *) -val gesvd_min_lwork : m : int -> n : int -> int +val gesvd_min_lwork : m:int -> n:int -> int (** [gesvd_min_lwork ~m ~n] @return the minimum length of the work array used by the [gesvd]-function for matrices with [m] rows and [n] columns. *) val gesvd_opt_lwork : - ?m : int -> ?n : int -> - ?jobu : svd_job -> - ?jobvt : svd_job -> - ?s : vec -> - ?ur : int -> ?uc : int -> ?u : mat -> - ?vtr : int -> ?vtc : int -> ?vt : mat -> - ?ar : int -> ?ac : int -> mat - -> int + ?m:int -> + ?n:int -> + ?jobu:svd_job -> + ?jobvt:svd_job -> + ?s:vec -> + ?ur:int -> + ?uc:int -> + ?u:mat -> + ?vtr:int -> + ?vtc:int -> + ?vt:mat -> + ?ar:int -> + ?ac:int -> + mat -> + int val gesvd : - ?m : int -> ?n : int -> - ?jobu : svd_job -> - ?jobvt : svd_job -> - ?s : vec -> - ?ur : int -> ?uc : int -> ?u : mat -> - ?vtr : int -> ?vtc : int -> ?vt : mat -> - ?work : vec -> - ?ar : int -> ?ac : int -> mat - -> vec * mat * mat - -val gesdd_liwork : m : int -> n : int -> int - -val gesdd_min_lwork : ?jobz : svd_job -> m : int -> n : int -> unit -> int + ?m:int -> + ?n:int -> + ?jobu:svd_job -> + ?jobvt:svd_job -> + ?s:vec -> + ?ur:int -> + ?uc:int -> + ?u:mat -> + ?vtr:int -> + ?vtc:int -> + ?vt:mat -> + ?work:vec -> + ?ar:int -> + ?ac:int -> + mat -> + vec * mat * mat + +val gesdd_liwork : m:int -> n:int -> int + +val gesdd_min_lwork : ?jobz:svd_job -> m:int -> n:int -> unit -> int (** [gesdd_min_lwork ?jobz ~m ~n] @return the minimum length of the work array used by the [gesdd]-function for matrices with [m] rows and [n] columns for SVD-job [jobz]. *) val gesdd_opt_lwork : - ?m : int -> ?n : int -> - ?jobz : svd_job -> - ?s : vec -> - ?ur : int -> ?uc : int -> ?u : mat -> - ?vtr : int -> ?vtc : int -> ?vt : mat -> - ?iwork : int32_vec -> - ?ar : int -> ?ac : int -> mat - -> int + ?m:int -> + ?n:int -> + ?jobz:svd_job -> + ?s:vec -> + ?ur:int -> + ?uc:int -> + ?u:mat -> + ?vtr:int -> + ?vtc:int -> + ?vt:mat -> + ?iwork:int32_vec -> + ?ar:int -> + ?ac:int -> + mat -> + int val gesdd : - ?m : int -> ?n : int -> - ?jobz : svd_job -> - ?s : vec -> - ?ur : int -> ?uc : int -> ?u : mat -> - ?vtr : int -> ?vtc : int -> ?vt : mat -> - ?work : vec -> - ?iwork : int32_vec -> - ?ar : int -> ?ac : int -> mat - -> vec * mat * mat - + ?m:int -> + ?n:int -> + ?jobz:svd_job -> + ?s:vec -> + ?ur:int -> + ?uc:int -> + ?u:mat -> + ?vtr:int -> + ?vtc:int -> + ?vt:mat -> + ?work:vec -> + ?iwork:int32_vec -> + ?ar:int -> + ?ac:int -> + mat -> + vec * mat * mat (** {7 General eigenvalue problem (simple drivers)} *) -val geev_min_lwork : ?vectors : bool -> int -> int +val geev_min_lwork : ?vectors:bool -> int -> int (** [geev_min_lwork vectors n] @return the minimum length of the work array used by the [geev]-function. [vectors] indicates whether eigenvectors are supposed to be computed. @@ -627,14 +629,22 @@ val geev_min_lwork : ?vectors : bool -> int -> int @param vectors default = true *) val geev_opt_lwork : - ?n : int -> - ?vlr : int -> ?vlc : int -> ?vl : mat option -> - ?vrr : int -> ?vrc : int -> ?vr : mat option -> - ?ofswr : int -> ?wr : vec -> - ?ofswi : int -> ?wi : vec -> - ?ar : int -> ?ac : int -> mat -> + ?n:int -> + ?vlr:int -> + ?vlc:int -> + ?vl:mat option -> + ?vrr:int -> + ?vrc:int -> + ?vr:mat option -> + ?ofswr:int -> + ?wr:vec -> + ?ofswi:int -> + ?wi:vec -> + ?ar:int -> + ?ac:int -> + mat -> int - (** [geev_opt_lwork +(** [geev_opt_lwork ?n ?vlr ?vlc ?vl ?vrr ?vrc ?vr @@ -645,43 +655,50 @@ val geev_opt_lwork : @return "optimal" size of work array. *) val geev : - ?n : int -> - ?work : vec -> - ?vlr : int -> ?vlc : int -> ?vl : mat option -> - ?vrr : int -> ?vrc : int -> ?vr : mat option -> - ?ofswr : int -> ?wr : vec -> - ?ofswi : int -> ?wi : vec -> - ?ar : int -> ?ac : int -> mat -> + ?n:int -> + ?work:vec -> + ?vlr:int -> + ?vlc:int -> + ?vl:mat option -> + ?vrr:int -> + ?vrc:int -> + ?vr:mat option -> + ?ofswr:int -> + ?wr:vec -> + ?ofswi:int -> + ?wi:vec -> + ?ar:int -> + ?ac:int -> + mat -> mat * vec * vec * mat (** [geev ?work ?n ?vlr ?vlc ?vl ?vrr ?vrc ?vr ?ofswr ?wr ?ofswi ?wi ?ar ?ac a] - @return ([lv], [wr], [wi], [rv]), where [wr] and [wv] are the real - and imaginary components of the eigenvalues, and [lv] and [rv] - are the left and right eigenvectors. [lv] ([rv]) is the empty - matrix if [vl] ([vr]) is set to [None]. + @return + ([lv], [wr], [wi], [rv]), where [wr] and [wv] are the real and imaginary + components of the eigenvalues, and [lv] and [rv] are the left and right + eigenvectors. [lv] ([rv]) is the empty matrix if [vl] ([vr]) is set to + [None]. @raise Failure if the function fails to converge @param n default = available number of columns of matrix [a] @param work default = automatically allocated workspace - @param vl default = Automatically allocated left eigenvectors. - Pass [None] if you do not want to compute them, - [Some lv] if you want to provide the storage. - You can set [vlr], [vlc] in the last case. - (See LAPACK GEEV docs for details about storage of complex eigenvectors) - @param vr default = Automatically allocated right eigenvectors. - Pass [None] if you do not want to compute them, - [Some rv] if you want to provide the storage. - You can set [vrr], [vrc] in the last case. + @param vl + default = Automatically allocated left eigenvectors. Pass [None] if you do + not want to compute them, [Some lv] if you want to provide the storage. + You can set [vlr], [vlc] in the last case. (See LAPACK GEEV docs for + details about storage of complex eigenvectors) + @param vr + default = Automatically allocated right eigenvectors. Pass [None] if you + do not want to compute them, [Some rv] if you want to provide the storage. + You can set [vrr], [vrc] in the last case. @param wr default = vector of size [n]; real components of the eigenvalues - @param wi default = vector of size [n]; - imaginary components of the eigenvalues + @param wi + default = vector of size [n]; imaginary components of the eigenvalues @param a the matrix whose eigensystem is computed *) - -(** {7 Symmetric-matrix eigenvalue and singular value problems - (simple drivers)} *) +(** {7 Symmetric-matrix eigenvalue and singular value problems (simple drivers)} *) val syev_min_lwork : int -> int (** [syev_min_lwork n] @return the minimum length of the work-array @@ -689,13 +706,7 @@ val syev_min_lwork : int -> int are [n]. *) val syev_opt_lwork : - ?n : int -> - ?vectors : bool -> - ?up : bool -> - ?ar : int -> - ?ac : int -> - mat - -> int + ?n:int -> ?vectors:bool -> ?up:bool -> ?ar:int -> ?ac:int -> mat -> int (** [syev_opt_lwork ?n ?vectors ?up ?ar ?ac a] @return the optimum length of the work-array used by the {!syev}-function given matrix [a], optionally its logical dimension [n] and whether the eigenvectors @@ -705,19 +716,18 @@ val syev_opt_lwork : @param up default = true, i.e. upper triangle of [a] is stored *) val syev : - ?n : int -> - ?vectors : bool -> - ?up : bool -> - ?work : vec -> - ?ofsw : int -> - ?w : vec -> - ?ar : int -> - ?ac : int -> - mat - -> vec -(** [syev ?n ?vectors ?up ?ofswork ?work ?ofsw ?w ?ar ?ac a] computes - all eigenvalues and, optionally, eigenvectors of the real symmetric - matrix [a]. + ?n:int -> + ?vectors:bool -> + ?up:bool -> + ?work:vec -> + ?ofsw:int -> + ?w:vec -> + ?ar:int -> + ?ac:int -> + mat -> + vec +(** [syev ?n ?vectors ?up ?ofswork ?work ?ofsw ?w ?ar ?ac a] computes all + eigenvalues and, optionally, eigenvectors of the real symmetric matrix [a]. @return the vector [w] of eigenvalues in ascending order. @raise Failure if the function fails to converge. @@ -728,26 +738,20 @@ val syev : @param ofsw default = 1 or ignored if [w] is not given @param w default = vec of length [n] *) -val syevd_min_lwork : vectors : bool -> int -> int +val syevd_min_lwork : vectors:bool -> int -> int (** [syevd_min_lwork vectors n] @return the minimum length of the work-array used by the {!syevd}-function if the logical dimensions of the matrix are [n] and given whether eigenvectors should be computed ([vectors]). *) -val syevd_min_liwork : vectors : bool -> int -> int +val syevd_min_liwork : vectors:bool -> int -> int (** [syevd_min_liwork vectors n] @return the minimum length of the iwork-array used by the {!syevd}-function if the logical dimensions of the matrix are [n] and given whether eigenvectors should be computed ([vectors]). *) val syevd_opt_lwork : - ?n : int -> - ?vectors : bool -> - ?up : bool -> - ?ar : int -> - ?ac : int -> - mat - -> int + ?n:int -> ?vectors:bool -> ?up:bool -> ?ar:int -> ?ac:int -> mat -> int (** [syevd_opt_lwork ?n ?vectors ?up ?ar ?ac a] @return the optimum length of the work-array used by the {!syevd}-function given matrix [a], optionally its logical dimension [n] and whether the eigenvectors @@ -757,13 +761,7 @@ val syevd_opt_lwork : @param up default = true, i.e. upper triangle of [a] is stored *) val syevd_opt_liwork : - ?n : int -> - ?vectors : bool -> - ?up : bool -> - ?ar : int -> - ?ac : int -> - mat - -> int + ?n:int -> ?vectors:bool -> ?up:bool -> ?ar:int -> ?ac:int -> mat -> int (** [syevd_opt_liwork ?n ?vectors ?up ?ar ?ac a] @return the optimum length of the iwork-array used by the {!syevd}-function given matrix [a], optionally its logical dimension [n] and whether the eigenvectors @@ -773,13 +771,7 @@ val syevd_opt_liwork : @param up default = true, i.e. upper triangle of [a] is stored *) val syevd_opt_l_li_work : - ?n : int -> - ?vectors : bool -> - ?up : bool -> - ?ar : int -> - ?ac : int -> - mat - -> int * int + ?n:int -> ?vectors:bool -> ?up:bool -> ?ar:int -> ?ac:int -> mat -> int * int (** [syevd_opt_l_li_iwork ?n ?vectors ?up ?ar ?ac a] @return the tuple of optimum lengths of the work- and iwork-arrays respectively, used by the {!syevd}-function given matrix [a], optionally its @@ -790,21 +782,20 @@ val syevd_opt_l_li_work : @param up default = true, i.e. upper triangle of [a] is stored *) val syevd : - ?n : int -> - ?vectors : bool -> - ?up : bool -> - ?work : vec -> - ?iwork : int32_vec -> - ?ofsw : int -> - ?w : vec -> - ?ar : int -> - ?ac : int -> - mat - -> vec -(** [syevd ?n ?vectors ?up ?ofswork ?work ?iwork ?ofsw ?w ?ar ?ac a] - computes all eigenvalues and, optionally, eigenvectors of the real - symmetric matrix [a]. If eigenvectors are desired, it uses a - divide and conquer algorithm. + ?n:int -> + ?vectors:bool -> + ?up:bool -> + ?work:vec -> + ?iwork:int32_vec -> + ?ofsw:int -> + ?w:vec -> + ?ar:int -> + ?ac:int -> + mat -> + vec +(** [syevd ?n ?vectors ?up ?ofswork ?work ?iwork ?ofsw ?w ?ar ?ac a] computes + all eigenvalues and, optionally, eigenvectors of the real symmetric matrix + [a]. If eigenvectors are desired, it uses a divide and conquer algorithm. @return the vector [w] of eigenvalues in ascending order. @raise Failure if the function fails to converge. @@ -822,32 +813,32 @@ val sbev_min_lwork : int -> int are [n]. *) val sbev : - ?n : int -> - ?kd : int -> - ?zr : int -> - ?zc : int -> - ?z : mat -> - ?up : bool -> - ?work : vec -> - ?ofsw : int -> - ?w : vec -> - ?abr : int -> - ?abc : int -> - mat - -> vec + ?n:int -> + ?kd:int -> + ?zr:int -> + ?zc:int -> + ?z:mat -> + ?up:bool -> + ?work:vec -> + ?ofsw:int -> + ?w:vec -> + ?abr:int -> + ?abc:int -> + mat -> + vec (** [sbev ?n ?vectors ?zr ?zc ?z ?up ?ofswork ?work ?ofsw ?w ?abr ?abc ab] - computes all the eigenvalues and, optionally, eigenvectors of the - real symmetric {i band} matrix [ab]. + computes all the eigenvalues and, optionally, eigenvectors of the real + symmetric {i band} matrix [ab]. @raise Failure if the function fails to converge. @return the vector [w] of eigenvalues in ascending order. @raise Failure if the function fails to converge. @param n default = available number of columns of matrix [ab] - @param z matrix to contain the orthonormal eigenvectors of [ab], - the [i]-th column of [z] holding the eigenvector associated - with [w.{i}]. - default = [None] i.e, eigenvectors are not computed + @param z + matrix to contain the orthonormal eigenvectors of [ab], the [i]-th column + of [z] holding the eigenvector associated with [w.{i}]. default = [None] + i.e, eigenvectors are not computed @param kd default = number of rows in matrix [ab] - 1 @param up default = true i.e., upper triangle of the matrix is stored @param work default = vec of minimal length (-> {!sbev_min_lwork}) @@ -856,9 +847,8 @@ val sbev : @param abr default = 1 @param abc default = 1 *) - -(** {7 Symmetric-matrix eigenvalue and singular value problems (expert & - RRR drivers)} *) +(** {7 Symmetric-matrix eigenvalue and singular value problems (expert & RRR + drivers)} *) val syevr_min_lwork : int -> int (** [syevr_min_lwork n] @return the minimum length of the @@ -871,15 +861,15 @@ val syevr_min_liwork : int -> int of the matrix are [n]. *) val syevr_opt_lwork : - ?n : int -> - ?vectors : bool -> - ?range : [ `A | `V of float * float | `I of int * int ] -> - ?up : bool -> - ?abstol : float -> - ?ar : int -> - ?ac : int -> - mat - -> int + ?n:int -> + ?vectors:bool -> + ?range:[ `A | `V of float * float | `I of int * int ] -> + ?up:bool -> + ?abstol:float -> + ?ar:int -> + ?ac:int -> + mat -> + int (** [syevr_opt_lwork ?n ?vectors ?range ?up ?abstol ?ar ?ac a] @return the optimum length of the work-array used by the {!syevr}-function given matrix [a], optionally its logical dimension [n] and whether @@ -889,15 +879,15 @@ val syevr_opt_lwork : @param up default = true, i.e. upper triangle of [a] is stored *) val syevr_opt_liwork : - ?n : int -> - ?vectors : bool -> - ?range : [ `A | `V of float * float | `I of int * int ] -> - ?up : bool -> - ?abstol : float -> - ?ar : int -> - ?ac : int -> - mat - -> int + ?n:int -> + ?vectors:bool -> + ?range:[ `A | `V of float * float | `I of int * int ] -> + ?up:bool -> + ?abstol:float -> + ?ar:int -> + ?ac:int -> + mat -> + int (** [syevr_opt_liwork ?n ?vectors ?range ?up ?abstol ?ar ?ac a] @return the optimum length of the iwork-array used by the {!syevr}-function given matrix [a], optionally its logical dimension [n] and whether @@ -907,54 +897,54 @@ val syevr_opt_liwork : @param up default = true, i.e. upper triangle of [a] is stored *) val syevr_opt_l_li_work : - ?n : int -> - ?vectors : bool -> - ?range : [ `A | `V of float * float | `I of int * int ] -> - ?up : bool -> - ?abstol : float -> - ?ar : int -> - ?ac : int -> - mat - -> int * int + ?n:int -> + ?vectors:bool -> + ?range:[ `A | `V of float * float | `I of int * int ] -> + ?up:bool -> + ?abstol:float -> + ?ar:int -> + ?ac:int -> + mat -> + int * int (** [syevr_opt_l_li_iwork ?n ?vectors ?range ?up ?abstol ?ar ?ac a] - @return the tuple of optimum lengths of the work- and iwork-arrays - respectively, used by the {!syevr}-function given matrix [a], - optionally its logical dimension [n] and whether the eigenvectors - must be computed ([vectors]). + @return + the tuple of optimum lengths of the work- and iwork-arrays respectively, + used by the {!syevr}-function given matrix [a], optionally its logical + dimension [n] and whether the eigenvectors must be computed ([vectors]). @param n default = available number of columns of matrix [a] @param vectors default = false, i.e. eigenvectors are not computed @param up default = true, i.e. upper triangle of [a] is stored *) val syevr : - ?n : int -> - ?vectors : bool -> - ?range : [ `A | `V of float * float | `I of int * int ] -> - ?up : bool -> - ?abstol : float -> - ?work : vec -> - ?iwork : int32_vec -> - ?ofsw : int -> - ?w : vec -> - ?zr : int -> - ?zc : int -> - ?z : mat -> - ?isuppz : int32_vec -> - ?ar : int -> - ?ac : int -> - mat - -> int * vec * mat * int32_vec + ?n:int -> + ?vectors:bool -> + ?range:[ `A | `V of float * float | `I of int * int ] -> + ?up:bool -> + ?abstol:float -> + ?work:vec -> + ?iwork:int32_vec -> + ?ofsw:int -> + ?w:vec -> + ?zr:int -> + ?zc:int -> + ?z:mat -> + ?isuppz:int32_vec -> + ?ar:int -> + ?ac:int -> + mat -> + int * vec * mat * int32_vec (** [syevr ?n ?vectors ?range ?up ?abstol ?work ?iwork ?ofsw ?w ?zr ?zc ?z ?isuppz ?ar ?ac a] - [range] is either [`A] for computing all eigenpairs, [`V (vl, vu)] - defines the lower and upper range of computed eigenvalues, [`I (il, - iu)] defines the indexes of the computed eigenpairs, which are sorted - in ascending order. - @return the tuple [(m, w, z, isuppz)], where [m] is the number - of computed eigenpairs, vector [w] contains the computed - eigenvalues in ascending order, [z] contains the computed - eigenvectors in same order, and [isuppz] indicates the - nonzero elements in [z]. + [range] is either [`A] for computing all eigenpairs, [`V (vl, vu)] defines + the lower and upper range of computed eigenvalues, [`I (il, + iu)] defines + the indexes of the computed eigenpairs, which are sorted in ascending order. + @return + the tuple [(m, w, z, isuppz)], where [m] is the number of computed + eigenpairs, vector [w] contains the computed eigenvalues in ascending + order, [z] contains the computed eigenvectors in same order, and [isuppz] + indicates the nonzero elements in [z]. @param n default = available number of columns of matrix [a] @param vectors default = false i.e, eigenvectors are not computed @param range default = `A @@ -972,17 +962,17 @@ val syevr : @param ac default = 1 *) val sygv_opt_lwork : - ?n : int -> - ?vectors : bool -> - ?up : bool -> - ?itype : [ `A_B | `AB | `BA ] -> - ?ar : int -> - ?ac : int -> + ?n:int -> + ?vectors:bool -> + ?up:bool -> + ?itype:[ `A_B | `AB | `BA ] -> + ?ar:int -> + ?ac:int -> + mat -> + ?br:int -> + ?bc:int -> mat -> - ?br : int -> - ?bc : int -> - mat - -> int + int (** [sygv_opt_lwork ?n ?vectors ?up ?ar ?ac a ?br ?bc b] @return the optimum length of the work-array used by the {!sygv}-function for the given matrices [a] and [b], optionally their logical @@ -1000,26 +990,25 @@ val sygv_opt_lwork : *) val sygv : - ?n : int -> - ?vectors : bool -> - ?up : bool -> - ?work : vec -> - ?ofsw : int -> - ?w : vec -> - ?itype : [ `A_B | `AB | `BA ] -> - ?ar : int -> - ?ac : int -> + ?n:int -> + ?vectors:bool -> + ?up:bool -> + ?work:vec -> + ?ofsw:int -> + ?w:vec -> + ?itype:[ `A_B | `AB | `BA ] -> + ?ar:int -> + ?ac:int -> + mat -> + ?br:int -> + ?bc:int -> mat -> - ?br : int -> - ?bc : int -> - mat - -> vec -(** [sygv ?n ?vectors ?up ?ofswork ?work ?ofsw ?w ?ar ?ac a ?br ?bc b] - computes all the eigenvalues, and optionally, the eigenvectors - of a real generalized symmetric-definite eigenproblem, of the - form [a*x=(lambda)*b*x], [a*b*x=(lambda)*x], or [b*a*x=(lambda)*x]. - Here [a] and [b] are assumed to be symmetric and [b] is also - positive definite. + vec +(** [sygv ?n ?vectors ?up ?ofswork ?work ?ofsw ?w ?ar ?ac a ?br ?bc b] computes + all the eigenvalues, and optionally, the eigenvectors of a real generalized + symmetric-definite eigenproblem, of the form [a*x=(lambda)*b*x], + [a*b*x=(lambda)*x], or [b*a*x=(lambda)*x]. Here [a] and [b] are assumed to + be symmetric and [b] is also positive definite. @return the vector [w] of eigenvalues in ascending order. @@ -1032,48 +1021,48 @@ val sygv : @param ofsw default = 1 or ignored if [w] is not given @param w default = vec of length [n] - @param itype specifies the problem type to be solved: - - [`A_B] (default): a*x = (lambda)*a*x - - [`AB]: a*b*x = (lambda)*x - - [`BA]: b*a*x = (lambda)*x -*) - + @param itype + specifies the problem type to be + solved: + - [`A_B] (default): a*x = (lambda)*a*x + - [`AB]: a*b*x = (lambda)*x + - [`BA]: b*a*x = (lambda)*x *) val sbgv : - ?n : int -> - ?ka : int -> - ?kb : int -> - ?zr : int -> - ?zc : int -> - ?z : mat -> - ?up : bool -> - ?work : vec -> - ?ofsw : int -> - ?w : vec -> - ?ar : int -> - ?ac : int -> + ?n:int -> + ?ka:int -> + ?kb:int -> + ?zr:int -> + ?zc:int -> + ?z:mat -> + ?up:bool -> + ?work:vec -> + ?ofsw:int -> + ?w:vec -> + ?ar:int -> + ?ac:int -> mat -> - ?br : int -> - ?bc : int -> - mat - -> vec -(** [sbgv ?n ?ka ?kb ?zr ?zc ?z ?up ?work ?ofsw ?w ?ar ?ac a ?br ?bc b] - computes all the eigenvalues, and optionally, the eigenvectors of a - real generalized symmetric-definite banded eigenproblem, of the - form [a*x=(lambda)*b*x]. Here [a] and [b] are assumed to be - symmetric and banded, and [b] is also positive definite. + ?br:int -> + ?bc:int -> + mat -> + vec +(** [sbgv ?n ?ka ?kb ?zr ?zc ?z ?up ?work ?ofsw ?w ?ar ?ac a ?br ?bc b] computes + all the eigenvalues, and optionally, the eigenvectors of a real generalized + symmetric-definite banded eigenproblem, of the form [a*x=(lambda)*b*x]. Here + [a] and [b] are assumed to be symmetric and banded, and [b] is also positive + definite. @return the vector [w] of eigenvalues in ascending order. @raise Failure if the function fails to converge. @param n default = available number of columns of matrix [a] - @param ka the number of superdiagonals (or subdiagonals if [up = false]) - of the matrix [a]. Default = [dim1 a - ar]. + @param ka + the number of superdiagonals (or subdiagonals if [up = false]) of the + matrix [a]. Default = [dim1 a - ar]. @param kb same as [ka] but for the matrix [b]. @param z default = [None] i.e, eigenvectors are not computed @param up default = [true] i.e., upper triangle of [a] is stored @param work default = vec of optimum length ([3 * n]) @param ofsw default = 1 or ignored if [w] is not given - @param w default = vec of length [n] -*) + @param w default = vec of length [n] *) diff --git a/src/impl_SDCZ.h b/src/impl_SDCZ.h index 97e3b5e..670f3cf 100644 --- a/src/impl_SDCZ.h +++ b/src/impl_SDCZ.h @@ -1,18 +1,12 @@ /* File: impl_SDCZ.h - Copyright (C) 2001- + Copyright © 2001- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umh.ac.be/an/ + Christophe Troestler - Liam Stewart - email: liam@cs.toronto.edu - WWW: http://www.cs.toronto.edu/~liam + Liam Stewart This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public @@ -26,7 +20,7 @@ You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "lacaml_macros.h" @@ -37,65 +31,39 @@ static integer integer_one = 1; /** SWAP */ -extern void FUN(swap)( - integer *N, - NUMBER *X, integer *INCX, - NUMBER *Y, integer *INCY); +extern void FUN(swap)(integer *N, NUMBER *X, integer *INCX, NUMBER *Y, + integer *INCY); -CAMLprim value LFUN(swap_stub)( - intnat vN, - intnat vOFSX, intnat vINCX, value vX, - intnat vOFSY, intnat vINCY, value vY) -{ +CAMLprim value LFUN(swap_stub)(intnat vN, intnat vOFSX, intnat vINCX, value vX, + intnat vOFSY, intnat vINCY, value vY) { CAMLparam2(vX, vY); - integer GET_INT(N), - GET_INT(INCX), - GET_INT(INCY); + integer GET_INT(N), GET_INT(INCX), GET_INT(INCY); VEC_PARAMS(X); VEC_PARAMS(Y); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(swap)( - &N, - X_data, &INCX, - Y_data, &INCY); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(swap)(&N, X_data, &INCX, Y_data, &INCY); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(Val_unit); } -CAMLprim value LFUN(swap_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(swap_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - Int_val(argv[2]), - argv[3], - Int_val(argv[4]), - Int_val(argv[5]), - argv[6]); +CAMLprim value LFUN(swap_stub_bc)(value *argv, int __unused argn) { + return LFUN(swap_stub)(Int_val(argv[0]), Int_val(argv[1]), Int_val(argv[2]), + argv[3], Int_val(argv[4]), Int_val(argv[5]), argv[6]); } - /** SCAL */ -extern void FUN(scal)( - integer *N, - NUMBER *ALPHA, - NUMBER *X, integer *INCX); +extern void FUN(scal)(integer *N, NUMBER *ALPHA, NUMBER *X, integer *INCX); -CAMLprim value LFUN(scal_stub)( - intnat vN, - vNUMBER vALPHA, - intnat vOFSX, intnat vINCX, value vX) -{ +CAMLprim value LFUN(scal_stub)(intnat vN, vNUMBER vALPHA, intnat vOFSX, + intnat vINCX, value vX) { CAMLparam1(vX); - integer GET_INT(N), - GET_INT(INCX); + integer GET_INT(N), GET_INT(INCX); NUMBER ALPHA; @@ -103,77 +71,48 @@ CAMLprim value LFUN(scal_stub)( INIT_NUMBER(ALPHA); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(scal)( - &N, - &ALPHA, - X_data, &INCX); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(scal)(&N, &ALPHA, X_data, &INCX); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(Val_unit); } -CAMLprim value LFUN(scal_stub_bc)( - value vN, value vALPHA, value vOFSX, value vINCX, value vX) -{ - return - LFUN(scal_stub)( - Int_val(vN), - NUMBER_val(vALPHA), - Int_val(vOFSX), - Int_val(vINCX), - vX); +CAMLprim value LFUN(scal_stub_bc)(value vN, value vALPHA, value vOFSX, + value vINCX, value vX) { + return LFUN(scal_stub)(Int_val(vN), NUMBER_val(vALPHA), Int_val(vOFSX), + Int_val(vINCX), vX); } - /** COPY */ -extern void FUN(copy)( - integer *N, - NUMBER *X, integer *INCX, - NUMBER *Y, integer *INCY); +extern void FUN(copy)(integer *N, NUMBER *X, integer *INCX, NUMBER *Y, + integer *INCY); -CAMLprim value LFUN(copy_stub)( - intnat vN, - intnat vOFSY, intnat vINCY, value vY, - intnat vOFSX, intnat vINCX, value vX) -{ +CAMLprim value LFUN(copy_stub)(intnat vN, intnat vOFSY, intnat vINCY, value vY, + intnat vOFSX, intnat vINCX, value vX) { CAMLparam2(vX, vY); - integer GET_INT(N), - GET_INT(INCX), - GET_INT(INCY); + integer GET_INT(N), GET_INT(INCX), GET_INT(INCY); VEC_PARAMS(X); VEC_PARAMS(Y); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(copy)( - &N, - X_data, &INCX, - Y_data, &INCY); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(copy)(&N, X_data, &INCX, Y_data, &INCY); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(Val_unit); } -CAMLprim value LFUN(copy_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(copy_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - Int_val(argv[2]), - argv[3], - Int_val(argv[4]), - Int_val(argv[5]), - argv[6]); +CAMLprim value LFUN(copy_stub_bc)(value *argv, int __unused argn) { + return LFUN(copy_stub)(Int_val(argv[0]), Int_val(argv[1]), Int_val(argv[2]), + argv[3], Int_val(argv[4]), Int_val(argv[5]), argv[6]); } - /** NRM2 */ -#ifndef LACAML_COMPLEX /* Real number */ +#ifndef LACAML_COMPLEX /* Real number */ extern REAL FUN(nrm2)(integer *N, REAL *X, integer *INCX); #else #ifndef LACAML_DOUBLE @@ -183,19 +122,18 @@ extern doublereal dznrm2_(integer *N, doublecomplex *X, integer *INCX); #endif #endif -CAMLprim double LFUN(nrm2_stub)(intnat vN, intnat vOFSX, intnat vINCX, value vX) -{ +CAMLprim double LFUN(nrm2_stub)(intnat vN, intnat vOFSX, intnat vINCX, + value vX) { CAMLparam1(vX); - integer GET_INT(N), - GET_INT(INCX); + integer GET_INT(N), GET_INT(INCX); REAL res; VEC_PARAMS(X); - caml_enter_blocking_section(); /* Allow other threads */ -#ifndef LACAML_COMPLEX /* Real number */ + caml_enter_blocking_section(); /* Allow other threads */ +#ifndef LACAML_COMPLEX /* Real number */ res = FUN(nrm2)(&N, X_data, &INCX); #else #ifndef LACAML_DOUBLE @@ -204,42 +142,28 @@ CAMLprim double LFUN(nrm2_stub)(intnat vN, intnat vOFSX, intnat vINCX, value vX) res = dznrm2_(&N, X_data, &INCX); #endif #endif - caml_leave_blocking_section(); /* Disallow other threads */ + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturnT(double, res); } -CAMLprim value LFUN(nrm2_stub_bc)(value vN, value vOFSX, value vINCX, value vX) -{ - return - caml_copy_double( - LFUN(nrm2_stub)( - Int_val(vN), - Int_val(vOFSX), - Int_val(vINCX), - vX)); +CAMLprim value LFUN(nrm2_stub_bc)(value vN, value vOFSX, value vINCX, + value vX) { + return caml_copy_double( + LFUN(nrm2_stub)(Int_val(vN), Int_val(vOFSX), Int_val(vINCX), vX)); } - /** AXPY */ -extern void FUN(axpy)( - integer *N, - NUMBER *ALPHA, - NUMBER *X, integer *INCX, - NUMBER *Y, integer *INCY); - -CAMLprim value LFUN(axpy_stub)( - vNUMBER vALPHA, - intnat vN, - intnat vOFSX, intnat vINCX, value vX, - intnat vOFSY, intnat vINCY, value vY) -{ +extern void FUN(axpy)(integer *N, NUMBER *ALPHA, NUMBER *X, integer *INCX, + NUMBER *Y, integer *INCY); + +CAMLprim value LFUN(axpy_stub)(vNUMBER vALPHA, intnat vN, intnat vOFSX, + intnat vINCX, value vX, intnat vOFSY, + intnat vINCY, value vY) { CAMLparam2(vX, vY); - integer GET_INT(N), - GET_INT(INCX), - GET_INT(INCY); + integer GET_INT(N), GET_INT(INCX), GET_INT(INCY); NUMBER ALPHA; @@ -248,95 +172,61 @@ CAMLprim value LFUN(axpy_stub)( INIT_NUMBER(ALPHA); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(axpy)( - &N, - &ALPHA, - X_data, &INCX, - Y_data, &INCY); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(axpy)(&N, &ALPHA, X_data, &INCX, Y_data, &INCY); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(Val_unit); } -CAMLprim value LFUN(axpy_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(axpy_stub)( - NUMBER_val(argv[0]), - Int_val(argv[1]), - Int_val(argv[2]), - Int_val(argv[3]), - argv[4], - Int_val(argv[5]), - Int_val(argv[6]), - argv[7]); +CAMLprim value LFUN(axpy_stub_bc)(value *argv, int __unused argn) { + return LFUN(axpy_stub)(NUMBER_val(argv[0]), Int_val(argv[1]), + Int_val(argv[2]), Int_val(argv[3]), argv[4], + Int_val(argv[5]), Int_val(argv[6]), argv[7]); } - /** AMAX */ extern integer FUN2(i, amax)(integer *N, NUMBER *X, integer *INCX); -CAMLprim intnat LFUN(iamax_stub)( - intnat vN, intnat vOFSX, intnat vINCX, value vX) -{ +CAMLprim intnat LFUN(iamax_stub)(intnat vN, intnat vOFSX, intnat vINCX, + value vX) { CAMLparam1(vX); - integer GET_INT(N), - GET_INT(INCX), - index; + integer GET_INT(N), GET_INT(INCX), index; VEC_PARAMS(X); - caml_enter_blocking_section(); /* Allow other threads */ - index = FUN2(i,amax)(&N, X_data, &INCX); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + index = FUN2(i, amax)(&N, X_data, &INCX); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(index); } -CAMLprim value LFUN(iamax_stub_bc)(value vN, value vOFSX, value vINCX, value vX) -{ - return - Val_int( - LFUN(iamax_stub)( - Int_val(vN), - Int_val(vOFSX), - Int_val(vINCX), - vX)); +CAMLprim value LFUN(iamax_stub_bc)(value vN, value vOFSX, value vINCX, + value vX) { + return Val_int( + LFUN(iamax_stub)(Int_val(vN), Int_val(vOFSX), Int_val(vINCX), vX)); } - /*** BLAS-2 */ /** GEMV */ -extern void FUN(gemv)( - char *TRANS, - integer *M, integer *N, - NUMBER *ALPHA, - NUMBER *A, integer *LDA, - NUMBER *X, integer *INCX, - NUMBER *BETA, - NUMBER *Y, integer *INCY); - -CAMLprim value LFUN(gemv_stub)( - intnat vOFSY, intnat vINCY, value vY, - intnat vAR, intnat vAC, value vA, - intnat vM, intnat vN, - value vTRANS, - vNUMBER vALPHA, vNUMBER vBETA, - intnat vOFSX, intnat vINCX, value vX) -{ +extern void FUN(gemv)(char *TRANS, integer *M, integer *N, NUMBER *ALPHA, + NUMBER *A, integer *LDA, NUMBER *X, integer *INCX, + NUMBER *BETA, NUMBER *Y, integer *INCY); + +CAMLprim value LFUN(gemv_stub)(intnat vOFSY, intnat vINCY, value vY, intnat vAR, + intnat vAC, value vA, intnat vM, intnat vN, + value vTRANS, vNUMBER vALPHA, vNUMBER vBETA, + intnat vOFSX, intnat vINCX, value vX) { CAMLparam3(vA, vX, vY); char GET_CHAR(TRANS); - integer GET_INT(M), - GET_INT(N), - GET_INT(INCX), - GET_INT(INCY); + integer GET_INT(M), GET_INT(N), GET_INT(INCX), GET_INT(INCY); NUMBER ALPHA; NUMBER BETA; @@ -348,70 +238,40 @@ CAMLprim value LFUN(gemv_stub)( INIT_NUMBER(ALPHA); INIT_NUMBER(BETA); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(gemv)( - &TRANS, - &M, &N, - &ALPHA, - A_data, &rows_A, - X_data, &INCX, - &BETA, - Y_data, &INCY); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(gemv)(&TRANS, &M, &N, &ALPHA, A_data, &rows_A, X_data, &INCX, &BETA, + Y_data, &INCY); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(Val_unit); } -CAMLprim value LFUN(gemv_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(gemv_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - argv[2], - Int_val(argv[3]), - Int_val(argv[4]), - argv[5], - Int_val(argv[6]), - Int_val(argv[7]), - argv[8], - NUMBER_val(argv[9]), - NUMBER_val(argv[10]), - Int_val(argv[11]), - Int_val(argv[12]), - argv[13]); +CAMLprim value LFUN(gemv_stub_bc)(value *argv, int __unused argn) { + return LFUN(gemv_stub)(Int_val(argv[0]), Int_val(argv[1]), argv[2], + Int_val(argv[3]), Int_val(argv[4]), argv[5], + Int_val(argv[6]), Int_val(argv[7]), argv[8], + NUMBER_val(argv[9]), NUMBER_val(argv[10]), + Int_val(argv[11]), Int_val(argv[12]), argv[13]); } - /** GBMV */ -extern void FUN(gbmv)( - char *TRANS, - integer *M, integer *N, integer *KL, integer *KU, - NUMBER *ALPHA, - NUMBER *A, integer *LDA, - NUMBER *X, integer *INCX, - NUMBER *BETA, - NUMBER *Y, integer *INCY); - -CAMLprim value LFUN(gbmv_stub)( - intnat vOFSY, intnat vINCY, value vY, - intnat vAR, intnat vAC, value vA, - intnat vM, intnat vN, intnat vKL, intnat vKU, - value vTRANS, - vNUMBER vALPHA, vNUMBER vBETA, - intnat vOFSX, intnat vINCX, value vX) -{ +extern void FUN(gbmv)(char *TRANS, integer *M, integer *N, integer *KL, + integer *KU, NUMBER *ALPHA, NUMBER *A, integer *LDA, + NUMBER *X, integer *INCX, NUMBER *BETA, NUMBER *Y, + integer *INCY); + +CAMLprim value LFUN(gbmv_stub)(intnat vOFSY, intnat vINCY, value vY, intnat vAR, + intnat vAC, value vA, intnat vM, intnat vN, + intnat vKL, intnat vKU, value vTRANS, + vNUMBER vALPHA, vNUMBER vBETA, intnat vOFSX, + intnat vINCX, value vX) { CAMLparam3(vA, vX, vY); char GET_CHAR(TRANS); - integer GET_INT(M), - GET_INT(N), - GET_INT(KL), - GET_INT(KU), - GET_INT(INCX), - GET_INT(INCY); + integer GET_INT(M), GET_INT(N), GET_INT(KL), GET_INT(KU), GET_INT(INCX), + GET_INT(INCY); NUMBER ALPHA; NUMBER BETA; @@ -423,72 +283,37 @@ CAMLprim value LFUN(gbmv_stub)( INIT_NUMBER(ALPHA); INIT_NUMBER(BETA); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(gbmv)( - &TRANS, - &M, &N, &KL, &KU, - &ALPHA, - A_data, &rows_A, - X_data, &INCX, - &BETA, - Y_data, &INCY); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(gbmv)(&TRANS, &M, &N, &KL, &KU, &ALPHA, A_data, &rows_A, X_data, &INCX, + &BETA, Y_data, &INCY); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(Val_unit); } -CAMLprim value LFUN(gbmv_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(gbmv_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - argv[2], - Int_val(argv[3]), - Int_val(argv[4]), - argv[5], - Int_val(argv[6]), - Int_val(argv[7]), - Int_val(argv[8]), - Int_val(argv[9]), - argv[10], - NUMBER_val(argv[11]), - NUMBER_val(argv[12]), - Int_val(argv[13]), - Int_val(argv[14]), - argv[15]); +CAMLprim value LFUN(gbmv_stub_bc)(value *argv, int __unused argn) { + return LFUN(gbmv_stub)( + Int_val(argv[0]), Int_val(argv[1]), argv[2], Int_val(argv[3]), + Int_val(argv[4]), argv[5], Int_val(argv[6]), Int_val(argv[7]), + Int_val(argv[8]), Int_val(argv[9]), argv[10], NUMBER_val(argv[11]), + NUMBER_val(argv[12]), Int_val(argv[13]), Int_val(argv[14]), argv[15]); } - /** SYMV */ -extern void FUN(symv)( - char *UPLO, - integer *N, - NUMBER *ALPHA, - NUMBER *A, integer *LDA, - NUMBER *X, integer *INCX, - NUMBER *BETA, - NUMBER *Y, integer *INCY); - -CAMLprim value LFUN(symv_stub)( - intnat vOFSY, intnat vINCY, value vY, - intnat vAR, - intnat vAC, - value vA, - intnat vN, - value vUPLO, - vNUMBER vALPHA, - vNUMBER vBETA, - intnat vOFSX, intnat vINCX, value vX) -{ +extern void FUN(symv)(char *UPLO, integer *N, NUMBER *ALPHA, NUMBER *A, + integer *LDA, NUMBER *X, integer *INCX, NUMBER *BETA, + NUMBER *Y, integer *INCY); + +CAMLprim value LFUN(symv_stub)(intnat vOFSY, intnat vINCY, value vY, intnat vAR, + intnat vAC, value vA, intnat vN, value vUPLO, + vNUMBER vALPHA, vNUMBER vBETA, intnat vOFSX, + intnat vINCX, value vX) { CAMLparam3(vA, vX, vY); char GET_CHAR(UPLO); - integer GET_INT(N), - GET_INT(INCX), - GET_INT(INCY); + integer GET_INT(N), GET_INT(INCX), GET_INT(INCY); NUMBER ALPHA; NUMBER BETA; @@ -500,312 +325,161 @@ CAMLprim value LFUN(symv_stub)( INIT_NUMBER(ALPHA); INIT_NUMBER(BETA); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(symv)( - &UPLO, - &N, - &ALPHA, - A_data, &rows_A, - X_data, &INCX, - &BETA, - Y_data, &INCY); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(symv)(&UPLO, &N, &ALPHA, A_data, &rows_A, X_data, &INCX, &BETA, Y_data, + &INCY); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(Val_unit); } -CAMLprim value LFUN(symv_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(symv_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - argv[2], - Int_val(argv[3]), - Int_val(argv[4]), - argv[5], - Int_val(argv[6]), - argv[7], - NUMBER_val(argv[8]), - NUMBER_val(argv[9]), - Int_val(argv[10]), - Int_val(argv[11]), - argv[12]); +CAMLprim value LFUN(symv_stub_bc)(value *argv, int __unused argn) { + return LFUN(symv_stub)( + Int_val(argv[0]), Int_val(argv[1]), argv[2], Int_val(argv[3]), + Int_val(argv[4]), argv[5], Int_val(argv[6]), argv[7], NUMBER_val(argv[8]), + NUMBER_val(argv[9]), Int_val(argv[10]), Int_val(argv[11]), argv[12]); } - /** TRMV */ -extern void FUN(trmv)( - char *UPLO, - char *TRANS, - char *DIAG, - integer *N, - NUMBER *A, integer *LDA, - NUMBER *X, integer *INCX); - -CAMLprim value LFUN(trmv_stub)( - intnat vAR, - intnat vAC, - value vA, - intnat vN, - value vUPLO, - value vTRANS, - value vDIAG, - intnat vOFSX, intnat vINCX, value vX) -{ +extern void FUN(trmv)(char *UPLO, char *TRANS, char *DIAG, integer *N, + NUMBER *A, integer *LDA, NUMBER *X, integer *INCX); + +CAMLprim value LFUN(trmv_stub)(intnat vAR, intnat vAC, value vA, intnat vN, + value vUPLO, value vTRANS, value vDIAG, + intnat vOFSX, intnat vINCX, value vX) { CAMLparam2(vA, vX); - char GET_CHAR(UPLO), - GET_CHAR(TRANS), - GET_CHAR(DIAG); + char GET_CHAR(UPLO), GET_CHAR(TRANS), GET_CHAR(DIAG); - integer GET_INT(N), - GET_INT(INCX); + integer GET_INT(N), GET_INT(INCX); MAT_PARAMS(A); VEC_PARAMS(X); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(trmv)( - &UPLO, - &TRANS, - &DIAG, - &N, - A_data, &rows_A, - X_data, &INCX); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(trmv)(&UPLO, &TRANS, &DIAG, &N, A_data, &rows_A, X_data, &INCX); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(Val_unit); } -CAMLprim value LFUN(trmv_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(trmv_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - argv[2], - Int_val(argv[3]), - argv[4], - argv[5], - argv[6], - Int_val(argv[7]), - Int_val(argv[8]), - argv[9]); +CAMLprim value LFUN(trmv_stub_bc)(value *argv, int __unused argn) { + return LFUN(trmv_stub)(Int_val(argv[0]), Int_val(argv[1]), argv[2], + Int_val(argv[3]), argv[4], argv[5], argv[6], + Int_val(argv[7]), Int_val(argv[8]), argv[9]); } - /** TRSV */ -extern void FUN(trsv)( - char *UPLO, - char *TRANS, - char *DIAG, - integer *N, - NUMBER *A, integer *LDA, - NUMBER *X, integer *INCX); - -CAMLprim value LFUN(trsv_stub)( - intnat vAR, - intnat vAC, - value vA, - intnat vN, - value vUPLO, - value vTRANS, - value vDIAG, - intnat vOFSX, intnat vINCX, value vX) -{ +extern void FUN(trsv)(char *UPLO, char *TRANS, char *DIAG, integer *N, + NUMBER *A, integer *LDA, NUMBER *X, integer *INCX); + +CAMLprim value LFUN(trsv_stub)(intnat vAR, intnat vAC, value vA, intnat vN, + value vUPLO, value vTRANS, value vDIAG, + intnat vOFSX, intnat vINCX, value vX) { CAMLparam2(vA, vX); - char GET_CHAR(UPLO), - GET_CHAR(TRANS), - GET_CHAR(DIAG); + char GET_CHAR(UPLO), GET_CHAR(TRANS), GET_CHAR(DIAG); - integer GET_INT(N), - GET_INT(INCX); + integer GET_INT(N), GET_INT(INCX); MAT_PARAMS(A); VEC_PARAMS(X); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(trsv)( - &UPLO, - &TRANS, - &DIAG, - &N, - A_data, &rows_A, - X_data, &INCX); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(trsv)(&UPLO, &TRANS, &DIAG, &N, A_data, &rows_A, X_data, &INCX); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(Val_unit); } -CAMLprim value LFUN(trsv_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(trsv_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - argv[2], - Int_val(argv[3]), - argv[4], - argv[5], - argv[6], - Int_val(argv[7]), - Int_val(argv[8]), - argv[9]); +CAMLprim value LFUN(trsv_stub_bc)(value *argv, int __unused argn) { + return LFUN(trsv_stub)(Int_val(argv[0]), Int_val(argv[1]), argv[2], + Int_val(argv[3]), argv[4], argv[5], argv[6], + Int_val(argv[7]), Int_val(argv[8]), argv[9]); } - /** TPMV */ -extern void FUN(tpmv)( - char *UPLO, - char *TRANS, - char *DIAG, - integer *N, - NUMBER *AP, - NUMBER *X, integer *INCX); - -CAMLprim value LFUN(tpmv_stub)( - intnat vOFSAP, - value vAP, - intnat vN, - value vUPLO, - value vTRANS, - value vDIAG, - intnat vOFSX, intnat vINCX, value vX) -{ +extern void FUN(tpmv)(char *UPLO, char *TRANS, char *DIAG, integer *N, + NUMBER *AP, NUMBER *X, integer *INCX); + +CAMLprim value LFUN(tpmv_stub)(intnat vOFSAP, value vAP, intnat vN, value vUPLO, + value vTRANS, value vDIAG, intnat vOFSX, + intnat vINCX, value vX) { CAMLparam2(vAP, vX); - char GET_CHAR(UPLO), - GET_CHAR(TRANS), - GET_CHAR(DIAG); + char GET_CHAR(UPLO), GET_CHAR(TRANS), GET_CHAR(DIAG); - integer GET_INT(N), - GET_INT(INCX); + integer GET_INT(N), GET_INT(INCX); VEC_PARAMS(AP); VEC_PARAMS(X); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(tpmv)( - &UPLO, - &TRANS, - &DIAG, - &N, - AP_data, - X_data, &INCX); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(tpmv)(&UPLO, &TRANS, &DIAG, &N, AP_data, X_data, &INCX); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(Val_unit); } -CAMLprim value LFUN(tpmv_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(tpmv_stub)( - Int_val(argv[0]), - argv[1], - Int_val(argv[2]), - argv[3], - argv[4], - argv[5], - Int_val(argv[6]), - Int_val(argv[7]), - argv[8]); +CAMLprim value LFUN(tpmv_stub_bc)(value *argv, int __unused argn) { + return LFUN(tpmv_stub)(Int_val(argv[0]), argv[1], Int_val(argv[2]), argv[3], + argv[4], argv[5], Int_val(argv[6]), Int_val(argv[7]), + argv[8]); } - /** TPSV */ -extern void FUN(tpsv)( - char *UPLO, - char *TRANS, - char *DIAG, - integer *N, - NUMBER *AP, - NUMBER *X, integer *INCX); - -CAMLprim value LFUN(tpsv_stub)( - intnat vOFSAP, - value vAP, - intnat vN, - value vUPLO, - value vTRANS, - value vDIAG, - intnat vOFSX, intnat vINCX, value vX) -{ +extern void FUN(tpsv)(char *UPLO, char *TRANS, char *DIAG, integer *N, + NUMBER *AP, NUMBER *X, integer *INCX); + +CAMLprim value LFUN(tpsv_stub)(intnat vOFSAP, value vAP, intnat vN, value vUPLO, + value vTRANS, value vDIAG, intnat vOFSX, + intnat vINCX, value vX) { CAMLparam2(vAP, vX); - char GET_CHAR(UPLO), - GET_CHAR(TRANS), - GET_CHAR(DIAG); + char GET_CHAR(UPLO), GET_CHAR(TRANS), GET_CHAR(DIAG); - integer GET_INT(N), - GET_INT(INCX); + integer GET_INT(N), GET_INT(INCX); VEC_PARAMS(AP); VEC_PARAMS(X); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(tpsv)( - &UPLO, - &TRANS, - &DIAG, - &N, - AP_data, - X_data, &INCX); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(tpsv)(&UPLO, &TRANS, &DIAG, &N, AP_data, X_data, &INCX); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(Val_unit); } -CAMLprim value LFUN(tpsv_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(tpsv_stub)( - Int_val(argv[0]), - argv[1], - Int_val(argv[2]), - argv[3], - argv[4], - argv[5], - Int_val(argv[6]), - Int_val(argv[7]), - argv[8]); +CAMLprim value LFUN(tpsv_stub_bc)(value *argv, int __unused argn) { + return LFUN(tpsv_stub)(Int_val(argv[0]), argv[1], Int_val(argv[2]), argv[3], + argv[4], argv[5], Int_val(argv[6]), Int_val(argv[7]), + argv[8]); } - /** TODO: SPMV */ /** TODO: TBMV */ /** TODO: TBSV */ - /*** BLAS-3 */ /** GEMM */ -extern void FUN(gemm)( - char *TRANSA, char *TRANSB, - integer *M, integer *N, integer *K, - NUMBER *ALPHA, - NUMBER *A, integer *LDA, - NUMBER *B, integer *LDB, - NUMBER *BETA, - NUMBER *C, integer *LDC); - -CAMLprim value LFUN(gemm_stub)( - value vTRANSA, value vTRANSB, - intnat vM, intnat vN, intnat vK, - intnat vAR, intnat vAC, value vA, - intnat vBR, intnat vBC, value vB, - intnat vCR, intnat vCC, value vC, - vNUMBER vALPHA, vNUMBER vBETA) -{ +extern void FUN(gemm)(char *TRANSA, char *TRANSB, integer *M, integer *N, + integer *K, NUMBER *ALPHA, NUMBER *A, integer *LDA, + NUMBER *B, integer *LDB, NUMBER *BETA, NUMBER *C, + integer *LDC); + +CAMLprim value LFUN(gemm_stub)(value vTRANSA, value vTRANSB, intnat vM, + intnat vN, intnat vK, intnat vAR, intnat vAC, + value vA, intnat vBR, intnat vBC, value vB, + intnat vCR, intnat vCC, value vC, vNUMBER vALPHA, + vNUMBER vBETA) { CAMLparam3(vA, vB, vC); char GET_CHAR(TRANSA), GET_CHAR(TRANSB); @@ -821,61 +495,32 @@ CAMLprim value LFUN(gemm_stub)( INIT_NUMBER(ALPHA); INIT_NUMBER(BETA); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(gemm)( - &TRANSA, &TRANSB, - &M, &N, &K, - &ALPHA, - A_data, &rows_A, - B_data, &rows_B, - &BETA, - C_data, &rows_C); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(gemm)(&TRANSA, &TRANSB, &M, &N, &K, &ALPHA, A_data, &rows_A, B_data, + &rows_B, &BETA, C_data, &rows_C); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(Val_unit); } -CAMLprim value LFUN(gemm_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(gemm_stub)( - argv[0], - argv[1], - Int_val(argv[2]), - Int_val(argv[3]), - Int_val(argv[4]), - Int_val(argv[5]), - Int_val(argv[6]), - argv[7], - Int_val(argv[8]), - Int_val(argv[9]), - argv[10], - Int_val(argv[11]), - Int_val(argv[12]), - argv[13], - NUMBER_val(argv[14]), - NUMBER_val(argv[15])); +CAMLprim value LFUN(gemm_stub_bc)(value *argv, int __unused argn) { + return LFUN(gemm_stub)(argv[0], argv[1], Int_val(argv[2]), Int_val(argv[3]), + Int_val(argv[4]), Int_val(argv[5]), Int_val(argv[6]), + argv[7], Int_val(argv[8]), Int_val(argv[9]), argv[10], + Int_val(argv[11]), Int_val(argv[12]), argv[13], + NUMBER_val(argv[14]), NUMBER_val(argv[15])); } /** SYMM */ -extern void FUN(symm)( - char *SIDE, char *UPLO, - integer *M, integer *N, - NUMBER *ALPHA, - NUMBER *A, integer *LDA, - NUMBER *B, integer *LDB, - NUMBER *BETA, - NUMBER *C, integer *LDC); - -CAMLprim value LFUN(symm_stub)( - value vSIDE, value vUPLO, - intnat vM, intnat vN, - intnat vAR, intnat vAC, value vA, - intnat vBR, intnat vBC, value vB, - intnat vCR, intnat vCC, value vC, - vNUMBER vALPHA, vNUMBER vBETA) -{ +extern void FUN(symm)(char *SIDE, char *UPLO, integer *M, integer *N, + NUMBER *ALPHA, NUMBER *A, integer *LDA, NUMBER *B, + integer *LDB, NUMBER *BETA, NUMBER *C, integer *LDC); + +CAMLprim value LFUN(symm_stub)(value vSIDE, value vUPLO, intnat vM, intnat vN, + intnat vAR, intnat vAC, value vA, intnat vBR, + intnat vBC, value vB, intnat vCR, intnat vCC, + value vC, vNUMBER vALPHA, vNUMBER vBETA) { CAMLparam3(vA, vB, vC); char GET_CHAR(SIDE), GET_CHAR(UPLO); @@ -891,57 +536,32 @@ CAMLprim value LFUN(symm_stub)( INIT_NUMBER(ALPHA); INIT_NUMBER(BETA); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(symm)( - &SIDE, &UPLO, - &M, &N, - &ALPHA, - A_data, &rows_A, - B_data, &rows_B, - &BETA, - C_data, &rows_C); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(symm)(&SIDE, &UPLO, &M, &N, &ALPHA, A_data, &rows_A, B_data, &rows_B, + &BETA, C_data, &rows_C); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(Val_unit); } -CAMLprim value LFUN(symm_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(symm_stub)( - argv[0], - argv[1], - Int_val(argv[2]), - Int_val(argv[3]), - Int_val(argv[4]), - Int_val(argv[5]), - argv[6], - Int_val(argv[7]), - Int_val(argv[8]), - argv[9], - Int_val(argv[10]), - Int_val(argv[11]), - argv[12], - NUMBER_val(argv[13]), - NUMBER_val(argv[14])); +CAMLprim value LFUN(symm_stub_bc)(value *argv, int __unused argn) { + return LFUN(symm_stub)(argv[0], argv[1], Int_val(argv[2]), Int_val(argv[3]), + Int_val(argv[4]), Int_val(argv[5]), argv[6], + Int_val(argv[7]), Int_val(argv[8]), argv[9], + Int_val(argv[10]), Int_val(argv[11]), argv[12], + NUMBER_val(argv[13]), NUMBER_val(argv[14])); } /** TRMM */ -extern void FUN(trmm)( - char *SIDE, char *UPLO, char *TRANS, char *DIAG, - integer *M, integer *N, - NUMBER *ALPHA, - NUMBER *A, integer *LDA, - NUMBER *B, integer *LDB); - -CAMLprim value LFUN(trmm_stub)( - value vSIDE, value vUPLO, value vTRANS, value vDIAG, - intnat vM, intnat vN, - intnat vAR, intnat vAC, value vA, - intnat vBR, intnat vBC, value vB, - vNUMBER vALPHA) -{ +extern void FUN(trmm)(char *SIDE, char *UPLO, char *TRANS, char *DIAG, + integer *M, integer *N, NUMBER *ALPHA, NUMBER *A, + integer *LDA, NUMBER *B, integer *LDB); + +CAMLprim value LFUN(trmm_stub)(value vSIDE, value vUPLO, value vTRANS, + value vDIAG, intnat vM, intnat vN, intnat vAR, + intnat vAC, value vA, intnat vBR, intnat vBC, + value vB, vNUMBER vALPHA) { CAMLparam2(vA, vB); char GET_CHAR(SIDE), GET_CHAR(UPLO), GET_CHAR(TRANS), GET_CHAR(DIAG); @@ -954,53 +574,31 @@ CAMLprim value LFUN(trmm_stub)( INIT_NUMBER(ALPHA); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(trmm)( - &SIDE, &UPLO, &TRANS, &DIAG, - &M, &N, - &ALPHA, - A_data, &rows_A, - B_data, &rows_B); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(trmm)(&SIDE, &UPLO, &TRANS, &DIAG, &M, &N, &ALPHA, A_data, &rows_A, + B_data, &rows_B); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(Val_unit); } -CAMLprim value LFUN(trmm_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(trmm_stub)( - argv[0], - argv[1], - argv[2], - argv[3], - Int_val(argv[4]), - Int_val(argv[5]), - Int_val(argv[6]), - Int_val(argv[7]), - argv[8], - Int_val(argv[9]), - Int_val(argv[10]), - argv[11], - NUMBER_val(argv[12])); +CAMLprim value LFUN(trmm_stub_bc)(value *argv, int __unused argn) { + return LFUN(trmm_stub)(argv[0], argv[1], argv[2], argv[3], Int_val(argv[4]), + Int_val(argv[5]), Int_val(argv[6]), Int_val(argv[7]), + argv[8], Int_val(argv[9]), Int_val(argv[10]), argv[11], + NUMBER_val(argv[12])); } /** TRSM */ -extern void FUN(trsm)( - char *SIDE, char *UPLO, char *TRANS, char *DIAG, - integer *M, integer *N, - NUMBER *ALPHA, - NUMBER *A, integer *LDA, - NUMBER *B, integer *LDB); - -CAMLprim value LFUN(trsm_stub)( - value vSIDE, value vUPLO, value vTRANS, value vDIAG, - intnat vM, intnat vN, - intnat vAR, intnat vAC, value vA, - intnat vBR, intnat vBC, value vB, - vNUMBER vALPHA) -{ +extern void FUN(trsm)(char *SIDE, char *UPLO, char *TRANS, char *DIAG, + integer *M, integer *N, NUMBER *ALPHA, NUMBER *A, + integer *LDA, NUMBER *B, integer *LDB); + +CAMLprim value LFUN(trsm_stub)(value vSIDE, value vUPLO, value vTRANS, + value vDIAG, intnat vM, intnat vN, intnat vAR, + intnat vAC, value vA, intnat vBR, intnat vBC, + value vB, vNUMBER vALPHA) { CAMLparam2(vA, vB); char GET_CHAR(SIDE), GET_CHAR(UPLO), GET_CHAR(TRANS), GET_CHAR(DIAG); @@ -1013,54 +611,31 @@ CAMLprim value LFUN(trsm_stub)( INIT_NUMBER(ALPHA); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(trsm)( - &SIDE, &UPLO, &TRANS, &DIAG, - &M, &N, - &ALPHA, - A_data, &rows_A, - B_data, &rows_B); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(trsm)(&SIDE, &UPLO, &TRANS, &DIAG, &M, &N, &ALPHA, A_data, &rows_A, + B_data, &rows_B); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(Val_unit); } -CAMLprim value LFUN(trsm_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(trsm_stub)( - argv[0], - argv[1], - argv[2], - argv[3], - Int_val(argv[4]), - Int_val(argv[5]), - Int_val(argv[6]), - Int_val(argv[7]), - argv[8], - Int_val(argv[9]), - Int_val(argv[10]), - argv[11], - NUMBER_val(argv[12])); +CAMLprim value LFUN(trsm_stub_bc)(value *argv, int __unused argn) { + return LFUN(trsm_stub)(argv[0], argv[1], argv[2], argv[3], Int_val(argv[4]), + Int_val(argv[5]), Int_val(argv[6]), Int_val(argv[7]), + argv[8], Int_val(argv[9]), Int_val(argv[10]), argv[11], + NUMBER_val(argv[12])); } /** SYRK */ -extern void FUN(syrk)( - char *UPLO, char *TRANS, - integer *N, integer *K, - NUMBER *ALPHA, - NUMBER *A, integer *LDA, - NUMBER *BETA, - NUMBER *C, integer *LDC); - -CAMLprim value LFUN(syrk_stub)( - value vUPLO, value vTRANS, - intnat vN, intnat vK, - intnat vAR, intnat vAC, value vA, - intnat vCR, intnat vCC, value vC, - vNUMBER vALPHA, vNUMBER vBETA) -{ +extern void FUN(syrk)(char *UPLO, char *TRANS, integer *N, integer *K, + NUMBER *ALPHA, NUMBER *A, integer *LDA, NUMBER *BETA, + NUMBER *C, integer *LDC); + +CAMLprim value LFUN(syrk_stub)(value vUPLO, value vTRANS, intnat vN, intnat vK, + intnat vAR, intnat vAC, value vA, intnat vCR, + intnat vCC, value vC, vNUMBER vALPHA, + vNUMBER vBETA) { CAMLparam2(vA, vC); char GET_CHAR(UPLO), GET_CHAR(TRANS); @@ -1075,56 +650,31 @@ CAMLprim value LFUN(syrk_stub)( INIT_NUMBER(ALPHA); INIT_NUMBER(BETA); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(syrk)( - &UPLO, &TRANS, - &N, &K, - &ALPHA, - A_data, &rows_A, - &BETA, - C_data, &rows_C); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(syrk)(&UPLO, &TRANS, &N, &K, &ALPHA, A_data, &rows_A, &BETA, C_data, + &rows_C); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(Val_unit); } -CAMLprim value LFUN(syrk_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(syrk_stub)( - argv[0], - argv[1], - Int_val(argv[2]), - Int_val(argv[3]), - Int_val(argv[4]), - Int_val(argv[5]), - argv[6], - Int_val(argv[7]), - Int_val(argv[8]), - argv[9], - NUMBER_val(argv[10]), - NUMBER_val(argv[11])); +CAMLprim value LFUN(syrk_stub_bc)(value *argv, int __unused argn) { + return LFUN(syrk_stub)(argv[0], argv[1], Int_val(argv[2]), Int_val(argv[3]), + Int_val(argv[4]), Int_val(argv[5]), argv[6], + Int_val(argv[7]), Int_val(argv[8]), argv[9], + NUMBER_val(argv[10]), NUMBER_val(argv[11])); } /** SYR2K */ -extern void FUN(syr2k)( - char *UPLO, char *TRANS, - integer *N, integer *K, - NUMBER *ALPHA, - NUMBER *A, integer *LDA, - NUMBER *B, integer *LDB, - NUMBER *BETA, - NUMBER *C, integer *LDC); - -CAMLprim value LFUN(syr2k_stub)( - value vUPLO, value vTRANS, - intnat vN, intnat vK, - intnat vAR, intnat vAC, value vA, - intnat vBR, intnat vBC, value vB, - intnat vCR, intnat vCC, value vC, - vNUMBER vALPHA, vNUMBER vBETA) -{ +extern void FUN(syr2k)(char *UPLO, char *TRANS, integer *N, integer *K, + NUMBER *ALPHA, NUMBER *A, integer *LDA, NUMBER *B, + integer *LDB, NUMBER *BETA, NUMBER *C, integer *LDC); + +CAMLprim value LFUN(syr2k_stub)(value vUPLO, value vTRANS, intnat vN, intnat vK, + intnat vAR, intnat vAC, value vA, intnat vBR, + intnat vBC, value vB, intnat vCR, intnat vCC, + value vC, vNUMBER vALPHA, vNUMBER vBETA) { CAMLparam2(vA, vC); char GET_CHAR(UPLO), GET_CHAR(TRANS); @@ -1140,42 +690,22 @@ CAMLprim value LFUN(syr2k_stub)( INIT_NUMBER(ALPHA); INIT_NUMBER(BETA); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(syr2k)( - &UPLO, &TRANS, - &N, &K, - &ALPHA, - A_data, &rows_A, - B_data, &rows_B, - &BETA, - C_data, &rows_C); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(syr2k)(&UPLO, &TRANS, &N, &K, &ALPHA, A_data, &rows_A, B_data, &rows_B, + &BETA, C_data, &rows_C); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(Val_unit); } -CAMLprim value LFUN(syr2k_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(syr2k_stub)( - argv[0], - argv[1], - Int_val(argv[2]), - Int_val(argv[3]), - Int_val(argv[4]), - Int_val(argv[5]), - argv[6], - Int_val(argv[7]), - Int_val(argv[8]), - argv[9], - Int_val(argv[10]), - Int_val(argv[11]), - argv[12], - NUMBER_val(argv[13]), - NUMBER_val(argv[14])); +CAMLprim value LFUN(syr2k_stub_bc)(value *argv, int __unused argn) { + return LFUN(syr2k_stub)(argv[0], argv[1], Int_val(argv[2]), Int_val(argv[3]), + Int_val(argv[4]), Int_val(argv[5]), argv[6], + Int_val(argv[7]), Int_val(argv[8]), argv[9], + Int_val(argv[10]), Int_val(argv[11]), argv[12], + NUMBER_val(argv[13]), NUMBER_val(argv[14])); } - /*** LAPACK */ /* Auxiliary Routines @@ -1183,19 +713,10 @@ CAMLprim value LFUN(syr2k_stub_bc)(value *argv, int __unused argn) /** LARNV */ -extern void FUN(larnv)( - integer *IDIST, - integer *ISEED, - integer *N, - NUMBER *X); - -CAMLprim value LFUN(larnv_stub)( - intnat vIDIST, - value vISEED, - intnat vN, - intnat vOFSX, - value vX) -{ +extern void FUN(larnv)(integer *IDIST, integer *ISEED, integer *N, NUMBER *X); + +CAMLprim value LFUN(larnv_stub)(intnat vIDIST, value vISEED, intnat vN, + intnat vOFSX, value vX) { CAMLparam2(vISEED, vX); integer GET_INT(IDIST), GET_INT(N); @@ -1210,35 +731,20 @@ CAMLprim value LFUN(larnv_stub)( CAMLreturn(Val_unit); } -CAMLprim value LFUN(larnv_stub_bc)( - value vIDIST, value vISEED, value vN, value vOFSX, value vX) -{ - return - LFUN(larnv_stub)( - Int_val(vIDIST), - vISEED, - Int_val(vN), - Int_val(vOFSX), - vX); +CAMLprim value LFUN(larnv_stub_bc)(value vIDIST, value vISEED, value vN, + value vOFSX, value vX) { + return LFUN(larnv_stub)(Int_val(vIDIST), vISEED, Int_val(vN), Int_val(vOFSX), + vX); } - /** LACPY */ -extern void FUN(lacpy)( - char *UPLO, - integer *M, - integer *N, - NUMBER *A, integer *LDA, - NUMBER *B, integer *LDB); - -CAMLprim value LFUN(lacpy_stub)( - value vPKIND, intnat vPINIT, - value vUPLO, - intnat vM, intnat vN, - intnat vAR, intnat vAC, value vA, - intnat vBR, intnat vBC, value vB) -{ +extern void FUN(lacpy)(char *UPLO, integer *M, integer *N, NUMBER *A, + integer *LDA, NUMBER *B, integer *LDB); + +CAMLprim value LFUN(lacpy_stub)(value vPKIND, intnat vPINIT, value vUPLO, + intnat vM, intnat vN, intnat vAR, intnat vAC, + value vA, intnat vBR, intnat vBC, value vB) { CAMLparam2(vA, vB); integer GET_INT(M), GET_INT(N), GET_INT(PINIT); @@ -1247,230 +753,157 @@ CAMLprim value LFUN(lacpy_stub)( MAT_PARAMS(B); pentagon_kind PKIND = get_pentagon_kind(vPKIND); - caml_enter_blocking_section(); /* Allow other threads */ - - switch (UPLO) { - case 'A': - case 'U': - case 'L': - FUN(lacpy)( - &UPLO, &M, &N, - A_data, &rows_A, - B_data, &rows_B); - break; - default: - switch (PKIND) { - case UPPER : - { - NUMBER *A_stop = A_data + rows_A * N; - if (PINIT + N - 1 <= M) { - while (A_data < A_stop) { - FUN(copy)(&PINIT, A_data, &integer_one, B_data, &integer_one); - PINIT++; - A_data += rows_A; - B_data += rows_B; - } - } else { - while (PINIT < M) { - FUN(copy)(&PINIT, A_data, &integer_one, B_data, &integer_one); - PINIT++; - A_data += rows_A; - B_data += rows_B; - } - if (M == rows_A && M == rows_B) { - integer MN = A_stop - A_data; - FUN(copy)(&MN, A_data, &integer_one, B_data, &integer_one); - } else - while (A_data < A_stop) { - FUN(copy)(&M, A_data, &integer_one, B_data, &integer_one); - A_data += rows_A; - B_data += rows_B; - } - } - break; - } - case LOWER : - { - NUMBER *A_stop; - integer stop_col = M + PINIT; - if (stop_col > N) stop_col = N; - A_stop = A_data + stop_col*rows_A; - if (PINIT > 1) { - if (M == rows_A && M == rows_B) { - integer MP = M*PINIT; - FUN(copy)(&MP, A_data, &integer_one, B_data, &integer_one); - A_data += MP; - B_data += MP; - } else { - NUMBER *A_block_stop = A_data + PINIT*rows_A; - while (A_data < A_block_stop) { - FUN(copy)(&M, A_data, &integer_one, B_data, &integer_one); - A_data += rows_A; - B_data += rows_B; - } - } - A_data++; - B_data++; - M--; - } - rows_A++; - rows_B++; - while (A_data < A_stop) { - FUN(copy)(&M, A_data, &integer_one, B_data, &integer_one); - M--; - A_data += rows_A; - B_data += rows_B; - } - break; - } + caml_enter_blocking_section(); /* Allow other threads */ + + switch (UPLO) { + case 'A': + case 'U': + case 'L': + FUN(lacpy)(&UPLO, &M, &N, A_data, &rows_A, B_data, &rows_B); + break; + default: + switch (PKIND) { + case UPPER: { + NUMBER *A_stop = A_data + rows_A * N; + if (PINIT + N - 1 <= M) { + while (A_data < A_stop) { + FUN(copy)(&PINIT, A_data, &integer_one, B_data, &integer_one); + PINIT++; + A_data += rows_A; + B_data += rows_B; + } + } else { + while (PINIT < M) { + FUN(copy)(&PINIT, A_data, &integer_one, B_data, &integer_one); + PINIT++; + A_data += rows_A; + B_data += rows_B; + } + if (M == rows_A && M == rows_B) { + integer MN = A_stop - A_data; + FUN(copy)(&MN, A_data, &integer_one, B_data, &integer_one); + } else + while (A_data < A_stop) { + FUN(copy)(&M, A_data, &integer_one, B_data, &integer_one); + A_data += rows_A; + B_data += rows_B; + } + } + break; + } + case LOWER: { + NUMBER *A_stop; + integer stop_col = M + PINIT; + if (stop_col > N) + stop_col = N; + A_stop = A_data + stop_col * rows_A; + if (PINIT > 1) { + if (M == rows_A && M == rows_B) { + integer MP = M * PINIT; + FUN(copy)(&MP, A_data, &integer_one, B_data, &integer_one); + A_data += MP; + B_data += MP; + } else { + NUMBER *A_block_stop = A_data + PINIT * rows_A; + while (A_data < A_block_stop) { + FUN(copy)(&M, A_data, &integer_one, B_data, &integer_one); + A_data += rows_A; + B_data += rows_B; + } } - break; + A_data++; + B_data++; + M--; + } + rows_A++; + rows_B++; + while (A_data < A_stop) { + FUN(copy)(&M, A_data, &integer_one, B_data, &integer_one); + M--; + A_data += rows_A; + B_data += rows_B; + } + break; + } } + break; + } - caml_leave_blocking_section(); /* Disallow other threads */ + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(Val_unit); } -CAMLprim value LFUN(lacpy_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(lacpy_stub)( - argv[0], - Int_val(argv[1]), - argv[2], - Int_val(argv[3]), - Int_val(argv[4]), - Int_val(argv[5]), - Int_val(argv[6]), - argv[7], - Int_val(argv[8]), - Int_val(argv[9]), - argv[10]); +CAMLprim value LFUN(lacpy_stub_bc)(value *argv, int __unused argn) { + return LFUN(lacpy_stub)(argv[0], Int_val(argv[1]), argv[2], Int_val(argv[3]), + Int_val(argv[4]), Int_val(argv[5]), Int_val(argv[6]), + argv[7], Int_val(argv[8]), Int_val(argv[9]), + argv[10]); } - /** LASWP */ -extern void FUN(laswp)( - integer *N, - NUMBER *A, - integer *LDA, - integer *K1, - integer *K2, - integer *IPIV, - integer *INCX); - -CAMLprim value LFUN(laswp_stub)( - intnat vN, - intnat vAR, intnat vAC, value vA, - value vK1, value vK2, - value vIPIV, - intnat vINCX) -{ +extern void FUN(laswp)(integer *N, NUMBER *A, integer *LDA, integer *K1, + integer *K2, integer *IPIV, integer *INCX); + +CAMLprim value LFUN(laswp_stub)(intnat vN, intnat vAR, intnat vAC, value vA, + value vK1, value vK2, value vIPIV, + intnat vINCX) { CAMLparam2(vA, vIPIV); - integer GET_INT(N), - GET_INT(K1), - GET_INT(K2), - GET_INT(INCX); + integer GET_INT(N), GET_INT(K1), GET_INT(K2), GET_INT(INCX); MAT_PARAMS(A); INT_VEC_PARAMS(IPIV); caml_release_runtime_system(); /* Allow other threads */ - FUN(laswp)( - &N, - A_data, &rows_A, - &K1, &K2, - IPIV_data, &INCX); + FUN(laswp)(&N, A_data, &rows_A, &K1, &K2, IPIV_data, &INCX); caml_acquire_runtime_system(); /* Disallow other threads */ CAMLreturn(Val_unit); } -CAMLprim value LFUN(laswp_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(laswp_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - Int_val(argv[2]), - argv[3], - Int_val(argv[4]), - Int_val(argv[5]), - argv[6], - Int_val(argv[7])); +CAMLprim value LFUN(laswp_stub_bc)(value *argv, int __unused argn) { + return LFUN(laswp_stub)(Int_val(argv[0]), Int_val(argv[1]), Int_val(argv[2]), + argv[3], Int_val(argv[4]), Int_val(argv[5]), argv[6], + Int_val(argv[7])); } - /** LAPMT */ -extern void FUN(lapmt)( - logical *FORWRD, - integer *M, - integer *N, - NUMBER *X, - integer *LDX, - integer *K); - -CAMLprim value LFUN(lapmt_stub)( - value vFORWRD, - intnat vM, - intnat vN, - value vK, - intnat vAR, - intnat vAC, - value vA) -{ +extern void FUN(lapmt)(logical *FORWRD, integer *M, integer *N, NUMBER *X, + integer *LDX, integer *K); + +CAMLprim value LFUN(lapmt_stub)(value vFORWRD, intnat vM, intnat vN, value vK, + intnat vAR, intnat vAC, value vA) { CAMLparam2(vA, vK); logical GET_BOOL(FORWRD); - integer GET_INT(M), - GET_INT(N); + integer GET_INT(M), GET_INT(N); MAT_PARAMS(A); INT_VEC_PARAMS(K); caml_release_runtime_system(); /* Allow other threads */ - FUN(lapmt)( - &FORWRD, - &M, &N, - A_data, - &rows_A, - K_data); + FUN(lapmt)(&FORWRD, &M, &N, A_data, &rows_A, K_data); caml_acquire_runtime_system(); /* Disallow other threads */ CAMLreturn(Val_unit); } -CAMLprim value LFUN(lapmt_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(lapmt_stub)( - argv[0], - Int_val(argv[1]), - Int_val(argv[2]), - argv[3], - Int_val(argv[4]), - Int_val(argv[5]), - argv[6]); +CAMLprim value LFUN(lapmt_stub_bc)(value *argv, int __unused argn) { + return LFUN(lapmt_stub)(argv[0], Int_val(argv[1]), Int_val(argv[2]), argv[3], + Int_val(argv[4]), Int_val(argv[5]), argv[6]); } - /** LASSQ */ -extern void FUN(lassq)( - integer *N, - NUMBER *X, integer *INCX, - REAL *SCALE, REAL *SUMSQ); +extern void FUN(lassq)(integer *N, NUMBER *X, integer *INCX, REAL *SCALE, + REAL *SUMSQ); -CAMLprim value LFUN(lassq_stub)( - intnat vN, - intnat vOFSX, intnat vINCX, value vX, - double vSCALE, double vSUMSQ) -{ +CAMLprim value LFUN(lassq_stub)(intnat vN, intnat vOFSX, intnat vINCX, value vX, + double vSCALE, double vSUMSQ) { CAMLparam1(vX); CAMLlocal2(v_scl, v_smsq); value v_res; @@ -1481,12 +914,9 @@ CAMLprim value LFUN(lassq_stub)( REAL GET_DOUBLE(SCALE), GET_DOUBLE(SUMSQ); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(lassq)( - &N, - X_data, &INCX, - &SCALE, &SUMSQ); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(lassq)(&N, X_data, &INCX, &SCALE, &SUMSQ); + caml_leave_blocking_section(); /* Disallow other threads */ v_scl = caml_copy_double(SCALE); v_smsq = caml_copy_double(SUMSQ); @@ -1498,33 +928,18 @@ CAMLprim value LFUN(lassq_stub)( CAMLreturn(v_res); } -CAMLprim value LFUN(lassq_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(lassq_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - Int_val(argv[2]), - argv[3], - Double_val(argv[4]), - Double_val(argv[5])); +CAMLprim value LFUN(lassq_stub_bc)(value *argv, int __unused argn) { + return LFUN(lassq_stub)(Int_val(argv[0]), Int_val(argv[1]), Int_val(argv[2]), + argv[3], Double_val(argv[4]), Double_val(argv[5])); } - /** LANGE */ -extern REAL FUN(lange)( - char *NORM, - integer *M, integer *N, - NUMBER *A, integer *LDA, - REAL *WORK); - -CAMLprim double LFUN(lange_stub)( - value vNORM, - intnat vM, intnat vN, - intnat vAR, intnat vAC, value vA, - value vWORK) -{ +extern REAL FUN(lange)(char *NORM, integer *M, integer *N, NUMBER *A, + integer *LDA, REAL *WORK); + +CAMLprim double LFUN(lange_stub)(value vNORM, intnat vM, intnat vN, intnat vAR, + intnat vAC, value vA, value vWORK) { CAMLparam2(vA, vWORK); char GET_CHAR(NORM); @@ -1535,43 +950,26 @@ CAMLprim double LFUN(lange_stub)( MAT_PARAMS(A); RVEC_PARAMS1(WORK); - caml_enter_blocking_section(); /* Allow other threads */ - res = FUN(lange)( - &NORM, &M, &N, - A_data, &rows_A, - WORK_data); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + res = FUN(lange)(&NORM, &M, &N, A_data, &rows_A, WORK_data); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturnT(double, res); } -CAMLprim value LFUN(lange_stub_bc)(value *argv, int __unused argn) -{ - return - caml_copy_double( - LFUN(lange_stub)( - argv[0], - Int_val(argv[1]), - Int_val(argv[2]), - Int_val(argv[3]), - Int_val(argv[4]), - argv[5], - argv[6])); +CAMLprim value LFUN(lange_stub_bc)(value *argv, int __unused argn) { + return caml_copy_double(LFUN(lange_stub)(argv[0], Int_val(argv[1]), + Int_val(argv[2]), Int_val(argv[3]), + Int_val(argv[4]), argv[5], argv[6])); } - /** LAUUM */ -extern void FUN(lauum)( - char *UPLO, - integer *N, - NUMBER *A, integer *LDA, - integer *INFO); +extern void FUN(lauum)(char *UPLO, integer *N, NUMBER *A, integer *LDA, + integer *INFO); -CAMLprim value LFUN(lauum_stub)( - value vUPLO, intnat vN, - intnat vAR, intnat vAC, value vA) -{ +CAMLprim value LFUN(lauum_stub)(value vUPLO, intnat vN, intnat vAR, intnat vAC, + value vA) { CAMLparam1(vA); char GET_CHAR(UPLO); @@ -1579,45 +977,28 @@ CAMLprim value LFUN(lauum_stub)( MAT_PARAMS(A); - caml_enter_blocking_section(); /* Allow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ FUN(lauum)(&UPLO, &N, A_data, &rows_A, &INFO); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(Val_unit); } -CAMLprim value LFUN(lauum_stub_bc)( - value vUPLO, value vN, value vAR, value vAC, value vA) -{ - return - LFUN(lauum_stub)( - vUPLO, - Int_val(vN), - Int_val(vAR), - Int_val(vAC), - vA); +CAMLprim value LFUN(lauum_stub_bc)(value vUPLO, value vN, value vAR, value vAC, + value vA) { + return LFUN(lauum_stub)(vUPLO, Int_val(vN), Int_val(vAR), Int_val(vAC), vA); } - /* Linear Equations (computational routines) ************************************************************************/ /** GETRF */ -extern void FUN(getrf)( - integer *M, integer *N, - NUMBER *A, integer *LDA, - integer *IPIV, - integer *INFO); - -CAMLprim intnat LFUN(getrf_stub)( - intnat vM, - intnat vN, - intnat vAR, - intnat vAC, - value vA, - value vIPIV) -{ +extern void FUN(getrf)(integer *M, integer *N, NUMBER *A, integer *LDA, + integer *IPIV, integer *INFO); + +CAMLprim intnat LFUN(getrf_stub)(intnat vM, intnat vN, intnat vAR, intnat vAC, + value vA, value vIPIV) { CAMLparam2(vA, vIPIV); integer GET_INT(M), GET_INT(N), INFO; @@ -1625,52 +1006,28 @@ CAMLprim intnat LFUN(getrf_stub)( MAT_PARAMS(A); INT_VEC_PARAMS(IPIV); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(getrf)( - &M, &N, - A_data, &rows_A, - IPIV_data, - &INFO); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(getrf)(&M, &N, A_data, &rows_A, IPIV_data, &INFO); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(INFO); } -CAMLprim value LFUN(getrf_stub_bc)(value *argv, int __unused argn) -{ - return - Val_int( - LFUN(getrf_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - Int_val(argv[2]), - Int_val(argv[3]), - argv[4], - argv[5])); +CAMLprim value LFUN(getrf_stub_bc)(value *argv, int __unused argn) { + return Val_int(LFUN(getrf_stub)(Int_val(argv[0]), Int_val(argv[1]), + Int_val(argv[2]), Int_val(argv[3]), argv[4], + argv[5])); } /** GETRS */ -extern void FUN(getrs)( - char *TRANS, - integer *N, integer *NRHS, - NUMBER *A, integer *LDA, - integer *IPIV, - NUMBER *B, integer *LDB, - integer *INFO); - -CAMLprim intnat LFUN(getrs_stub)( - value vTRANS, - intnat vN, - intnat vNRHS, - intnat vAR, - intnat vAC, - value vA, - intnat vBR, - intnat vBC, - value vB, - value vIPIV) -{ +extern void FUN(getrs)(char *TRANS, integer *N, integer *NRHS, NUMBER *A, + integer *LDA, integer *IPIV, NUMBER *B, integer *LDB, + integer *INFO); + +CAMLprim intnat LFUN(getrs_stub)(value vTRANS, intnat vN, intnat vNRHS, + intnat vAR, intnat vAC, value vA, intnat vBR, + intnat vBC, value vB, value vIPIV) { CAMLparam3(vA, vB, vIPIV); char GET_CHAR(TRANS); @@ -1680,54 +1037,28 @@ CAMLprim intnat LFUN(getrs_stub)( MAT_PARAMS(B); INT_VEC_PARAMS(IPIV); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(getrs)( - &TRANS, - &N, &NRHS, - A_data, &rows_A, - IPIV_data, - B_data, &rows_B, - &INFO); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(getrs)(&TRANS, &N, &NRHS, A_data, &rows_A, IPIV_data, B_data, &rows_B, + &INFO); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(INFO); } -CAMLprim value LFUN(getrs_stub_bc)(value *argv, int __unused argn) -{ - return - Val_int( - LFUN(getrs_stub)( - argv[0], - Int_val(argv[1]), - Int_val(argv[2]), - Int_val(argv[3]), - Int_val(argv[4]), - argv[5], - Int_val(argv[6]), - Int_val(argv[7]), - argv[8], - argv[9])); +CAMLprim value LFUN(getrs_stub_bc)(value *argv, int __unused argn) { + return Val_int(LFUN(getrs_stub)(argv[0], Int_val(argv[1]), Int_val(argv[2]), + Int_val(argv[3]), Int_val(argv[4]), argv[5], + Int_val(argv[6]), Int_val(argv[7]), argv[8], + argv[9])); } /** GETRI */ -extern void FUN(getri)( - integer *N, - NUMBER *A, integer *LDA, - integer *IPIV, - NUMBER *WORK, integer *LWORK, - integer *INFO); - -CAMLprim intnat LFUN(getri_stub)( - intnat vN, - intnat vAR, - intnat vAC, - value vA, - value vIPIV, - value vWORK, - intnat vLWORK) -{ +extern void FUN(getri)(integer *N, NUMBER *A, integer *LDA, integer *IPIV, + NUMBER *WORK, integer *LWORK, integer *INFO); + +CAMLprim intnat LFUN(getri_stub)(intnat vN, intnat vAR, intnat vAC, value vA, + value vIPIV, value vWORK, intnat vLWORK) { CAMLparam3(vA, vIPIV, vWORK); integer GET_INT(N), GET_INT(LWORK), INFO; @@ -1736,50 +1067,28 @@ CAMLprim intnat LFUN(getri_stub)( INT_VEC_PARAMS(IPIV); VEC_PARAMS1(WORK); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(getri)( - &N, A_data, &rows_A, - IPIV_data, - WORK_data, &LWORK, - &INFO); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(getri)(&N, A_data, &rows_A, IPIV_data, WORK_data, &LWORK, &INFO); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(INFO); } -CAMLprim value LFUN(getri_stub_bc)(value *argv, int __unused argn) -{ - return - Val_int( - LFUN(getri_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - Int_val(argv[2]), - argv[3], - argv[4], - argv[5], - Int_val(argv[6]))); +CAMLprim value LFUN(getri_stub_bc)(value *argv, int __unused argn) { + return Val_int(LFUN(getri_stub)(Int_val(argv[0]), Int_val(argv[1]), + Int_val(argv[2]), argv[3], argv[4], argv[5], + Int_val(argv[6]))); } /** SYTRF */ -extern void FUN(sytrf)( - char *UPLO, integer *N, - NUMBER *A, integer *LDA, - integer *IPIV, - NUMBER *WORK, integer *LWORK, - integer *INFO); - -CAMLprim intnat LFUN(sytrf_stub)( - value vUPLO, - intnat vN, - intnat vAR, - intnat vAC, - value vA, - value vIPIV, - value vWORK, - intnat vLWORK) -{ +extern void FUN(sytrf)(char *UPLO, integer *N, NUMBER *A, integer *LDA, + integer *IPIV, NUMBER *WORK, integer *LWORK, + integer *INFO); + +CAMLprim intnat LFUN(sytrf_stub)(value vUPLO, intnat vN, intnat vAR, intnat vAC, + value vA, value vIPIV, value vWORK, + intnat vLWORK) { CAMLparam3(vA, vIPIV, vWORK); char GET_CHAR(UPLO); @@ -1789,55 +1098,28 @@ CAMLprim intnat LFUN(sytrf_stub)( INT_VEC_PARAMS(IPIV); VEC_PARAMS1(WORK); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(sytrf)( - &UPLO, &N, - A_data, &rows_A, - IPIV_data, - WORK_data, &LWORK, - &INFO); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(sytrf)(&UPLO, &N, A_data, &rows_A, IPIV_data, WORK_data, &LWORK, &INFO); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(INFO); } -CAMLprim value LFUN(sytrf_stub_bc)(value *argv, int __unused argn) -{ - return - Val_int( - LFUN(sytrf_stub)( - argv[0], - Int_val(argv[1]), - Int_val(argv[2]), - Int_val(argv[3]), - argv[4], - argv[5], - argv[6], - Int_val(argv[7]))); +CAMLprim value LFUN(sytrf_stub_bc)(value *argv, int __unused argn) { + return Val_int(LFUN(sytrf_stub)(argv[0], Int_val(argv[1]), Int_val(argv[2]), + Int_val(argv[3]), argv[4], argv[5], argv[6], + Int_val(argv[7]))); } /** SYTRS */ -extern void FUN(sytrs)( - char *UPLO, - integer *N, integer *NRHS, - NUMBER *A, integer *LDA, - integer *IPIV, - NUMBER *B, integer *LDB, - integer *INFO); - -CAMLprim intnat LFUN(sytrs_stub)( - value vUPLO, - intnat vN, - intnat vNRHS, - intnat vAR, - intnat vAC, - value vA, - intnat vBR, - intnat vBC, - value vB, - value vIPIV) -{ +extern void FUN(sytrs)(char *UPLO, integer *N, integer *NRHS, NUMBER *A, + integer *LDA, integer *IPIV, NUMBER *B, integer *LDB, + integer *INFO); + +CAMLprim intnat LFUN(sytrs_stub)(value vUPLO, intnat vN, intnat vNRHS, + intnat vAR, intnat vAC, value vA, intnat vBR, + intnat vBC, value vB, value vIPIV) { CAMLparam3(vA, vB, vIPIV); char GET_CHAR(UPLO); @@ -1847,55 +1129,28 @@ CAMLprim intnat LFUN(sytrs_stub)( MAT_PARAMS(B); INT_VEC_PARAMS(IPIV); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(sytrs)( - &UPLO, - &N, &NRHS, - A_data, &rows_A, - IPIV_data, - B_data, &rows_B, - &INFO); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(sytrs)(&UPLO, &N, &NRHS, A_data, &rows_A, IPIV_data, B_data, &rows_B, + &INFO); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(INFO); } -CAMLprim value LFUN(sytrs_stub_bc)(value *argv, int __unused argn) -{ - return - Val_int( - LFUN(sytrs_stub)( - argv[0], - Int_val(argv[1]), - Int_val(argv[2]), - Int_val(argv[3]), - Int_val(argv[4]), - argv[5], - Int_val(argv[6]), - Int_val(argv[7]), - argv[8], - argv[9])); +CAMLprim value LFUN(sytrs_stub_bc)(value *argv, int __unused argn) { + return Val_int(LFUN(sytrs_stub)(argv[0], Int_val(argv[1]), Int_val(argv[2]), + Int_val(argv[3]), Int_val(argv[4]), argv[5], + Int_val(argv[6]), Int_val(argv[7]), argv[8], + argv[9])); } /** SYTRI */ -extern void FUN(sytri)( - char *UPLO, - integer *N, - NUMBER *A, integer *LDA, - integer *IPIV, - NUMBER *WORK, - integer *INFO); - -CAMLprim intnat LFUN(sytri_stub)( - value vUPLO, - intnat vN, - intnat vAR, - intnat vAC, - value vA, - value vIPIV, - value vWORK) -{ +extern void FUN(sytri)(char *UPLO, integer *N, NUMBER *A, integer *LDA, + integer *IPIV, NUMBER *WORK, integer *INFO); + +CAMLprim intnat LFUN(sytri_stub)(value vUPLO, intnat vN, intnat vAR, intnat vAC, + value vA, value vIPIV, value vWORK) { CAMLparam3(vA, vIPIV, vWORK); char GET_CHAR(UPLO); @@ -1905,46 +1160,25 @@ CAMLprim intnat LFUN(sytri_stub)( INT_VEC_PARAMS(IPIV); VEC_PARAMS1(WORK); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(sytri)( - &UPLO, - &N, A_data, &rows_A, - IPIV_data, - WORK_data, - &INFO); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(sytri)(&UPLO, &N, A_data, &rows_A, IPIV_data, WORK_data, &INFO); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(INFO); } -CAMLprim value LFUN(sytri_stub_bc)(value *argv, int __unused argn) -{ - return - Val_int( - LFUN(sytri_stub)( - argv[0], - Int_val(argv[1]), - Int_val(argv[2]), - Int_val(argv[3]), - argv[4], - argv[5], - argv[6])); +CAMLprim value LFUN(sytri_stub_bc)(value *argv, int __unused argn) { + return Val_int(LFUN(sytri_stub)(argv[0], Int_val(argv[1]), Int_val(argv[2]), + Int_val(argv[3]), argv[4], argv[5], argv[6])); } /** POTRF */ -extern void FUN(potrf)( - char *UPLO, integer *N, - NUMBER *A, integer *LDA, - integer *INFO); - -CAMLprim intnat LFUN(potrf_stub)( - value vUPLO, - intnat vN, - intnat vAR, - intnat vAC, - value vA) -{ +extern void FUN(potrf)(char *UPLO, integer *N, NUMBER *A, integer *LDA, + integer *INFO); + +CAMLprim intnat LFUN(potrf_stub)(value vUPLO, intnat vN, intnat vAR, intnat vAC, + value vA) { CAMLparam1(vA); char GET_CHAR(UPLO); @@ -1952,41 +1186,27 @@ CAMLprim intnat LFUN(potrf_stub)( MAT_PARAMS(A); - caml_enter_blocking_section(); /* Allow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ FUN(potrf)(&UPLO, &N, A_data, &rows_A, &INFO); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(INFO); } -CAMLprim value LFUN(potrf_stub_bc)( - value vUPLO, value vN, value vAR, value vAC, value vA) -{ - return - Val_int( - LFUN(potrf_stub)( - vUPLO, - Int_val(vN), - Int_val(vAR), - Int_val(vAC), - vA)); +CAMLprim value LFUN(potrf_stub_bc)(value vUPLO, value vN, value vAR, value vAC, + value vA) { + return Val_int( + LFUN(potrf_stub)(vUPLO, Int_val(vN), Int_val(vAR), Int_val(vAC), vA)); } /** POTRS */ -extern void FUN(potrs)( - char *UPLO, - integer *N, integer *NRHS, - NUMBER *A, integer *LDA, - NUMBER *B, integer *LDB, - integer *INFO); - -CAMLprim intnat LFUN(potrs_stub)( - value vUPLO, - intnat vN, intnat vNRHS, - intnat vAR, intnat vAC, value vA, - intnat vBR, intnat vBC, value vB) -{ +extern void FUN(potrs)(char *UPLO, integer *N, integer *NRHS, NUMBER *A, + integer *LDA, NUMBER *B, integer *LDB, integer *INFO); + +CAMLprim intnat LFUN(potrs_stub)(value vUPLO, intnat vN, intnat vNRHS, + intnat vAR, intnat vAC, value vA, intnat vBR, + intnat vBC, value vB) { CAMLparam2(vA, vB); char GET_CHAR(UPLO); @@ -1995,46 +1215,26 @@ CAMLprim intnat LFUN(potrs_stub)( MAT_PARAMS(A); MAT_PARAMS(B); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(potrs)( - &UPLO, - &N, &NRHS, - A_data, &rows_A, - B_data, &rows_B, - &INFO); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(potrs)(&UPLO, &N, &NRHS, A_data, &rows_A, B_data, &rows_B, &INFO); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(INFO); } -CAMLprim value LFUN(potrs_stub_bc)(value *argv, int __unused argn) -{ - return - Val_int( - LFUN(potrs_stub)( - argv[0], - Int_val(argv[1]), - Int_val(argv[2]), - Int_val(argv[3]), - Int_val(argv[4]), - argv[5], - Int_val(argv[6]), - Int_val(argv[7]), - argv[8])); +CAMLprim value LFUN(potrs_stub_bc)(value *argv, int __unused argn) { + return Val_int(LFUN(potrs_stub)(argv[0], Int_val(argv[1]), Int_val(argv[2]), + Int_val(argv[3]), Int_val(argv[4]), argv[5], + Int_val(argv[6]), Int_val(argv[7]), argv[8])); } /** POTRI */ -extern void FUN(potri)( - char *UPLO, integer *N, - NUMBER *A, integer *LDA, - integer *INFO); +extern void FUN(potri)(char *UPLO, integer *N, NUMBER *A, integer *LDA, + integer *INFO); -CAMLprim intnat LFUN(potri_stub)( - value vUPLO, - intnat vN, - intnat vAR, intnat vAC, value vA) -{ +CAMLprim intnat LFUN(potri_stub)(value vUPLO, intnat vN, intnat vAR, intnat vAC, + value vA) { CAMLparam1(vA); char GET_CHAR(UPLO); @@ -2042,41 +1242,29 @@ CAMLprim intnat LFUN(potri_stub)( MAT_PARAMS(A); - caml_enter_blocking_section(); /* Allow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ FUN(potri)(&UPLO, &N, A_data, &rows_A, &INFO); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(INFO); } -CAMLprim value LFUN(potri_stub_bc)( - value vUPLO, value vN, value vAR, value vAC, value vA) -{ - return - Val_int( - LFUN(potri_stub)( - vUPLO, - Int_val(vN), - Int_val(vAR), - Int_val(vAC), - vA)); +CAMLprim value LFUN(potri_stub_bc)(value vUPLO, value vN, value vAR, value vAC, + value vA) { + return Val_int( + LFUN(potri_stub)(vUPLO, Int_val(vN), Int_val(vAR), Int_val(vAC), vA)); } /** TRTRS */ -extern void FUN(trtrs)( - char *UPLO, char *TRANS, char *DIAG, - integer *N, integer *NRHS, - NUMBER *A, integer *LDA, - NUMBER *B, integer *LDB, - integer *INFO); - -CAMLprim intnat LFUN(trtrs_stub)( - value vUPLO, value vTRANS, value vDIAG, - intnat vN, intnat vNRHS, - intnat vAR, intnat vAC, value vA, - intnat vBR, intnat vBC, value vB) -{ +extern void FUN(trtrs)(char *UPLO, char *TRANS, char *DIAG, integer *N, + integer *NRHS, NUMBER *A, integer *LDA, NUMBER *B, + integer *LDB, integer *INFO); + +CAMLprim intnat LFUN(trtrs_stub)(value vUPLO, value vTRANS, value vDIAG, + intnat vN, intnat vNRHS, intnat vAR, + intnat vAC, value vA, intnat vBR, intnat vBC, + value vB) { CAMLparam2(vA, vB); char GET_CHAR(UPLO), GET_CHAR(TRANS), GET_CHAR(DIAG); @@ -2085,49 +1273,28 @@ CAMLprim intnat LFUN(trtrs_stub)( MAT_PARAMS(A); MAT_PARAMS(B); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(trtrs)( - &UPLO, &TRANS, &DIAG, - &N, &NRHS, - A_data, &rows_A, - B_data, &rows_B, - &INFO); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(trtrs)(&UPLO, &TRANS, &DIAG, &N, &NRHS, A_data, &rows_A, B_data, &rows_B, + &INFO); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(INFO); } -CAMLprim value LFUN(trtrs_stub_bc)(value *argv, int __unused argn) -{ - return - Val_int( - LFUN(trtrs_stub)( - argv[0], - argv[1], - argv[2], - Int_val(argv[3]), - Int_val(argv[4]), - Int_val(argv[5]), - Int_val(argv[6]), - argv[7], - Int_val(argv[8]), - Int_val(argv[9]), - argv[10])); +CAMLprim value LFUN(trtrs_stub_bc)(value *argv, int __unused argn) { + return Val_int(LFUN(trtrs_stub)(argv[0], argv[1], argv[2], Int_val(argv[3]), + Int_val(argv[4]), Int_val(argv[5]), + Int_val(argv[6]), argv[7], Int_val(argv[8]), + Int_val(argv[9]), argv[10])); } /** TRTRI */ -extern void FUN(trtri)( - char *UPLO, char *DIAG, - integer *N, - NUMBER *A, integer *LDA, - integer *INFO); - -CAMLprim intnat LFUN(trtri_stub)( - value vUPLO, value vDIAG, - intnat vN, - intnat vAR, intnat vAC, value vA) -{ +extern void FUN(trtri)(char *UPLO, char *DIAG, integer *N, NUMBER *A, + integer *LDA, integer *INFO); + +CAMLprim intnat LFUN(trtri_stub)(value vUPLO, value vDIAG, intnat vN, + intnat vAR, intnat vAC, value vA) { CAMLparam1(vA); char GET_CHAR(UPLO), GET_CHAR(DIAG); @@ -2135,41 +1302,28 @@ CAMLprim intnat LFUN(trtri_stub)( MAT_PARAMS(A); - caml_enter_blocking_section(); /* Allow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ FUN(trtri)(&UPLO, &DIAG, &N, A_data, &rows_A, &INFO); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(INFO); } -CAMLprim value LFUN(trtri_stub_bc)(value *argv, int __unused argn) -{ - return - Val_int( - LFUN(trtri_stub)( - argv[0], - argv[1], - Int_val(argv[2]), - Int_val(argv[3]), - Int_val(argv[4]), - argv[5])); +CAMLprim value LFUN(trtri_stub_bc)(value *argv, int __unused argn) { + return Val_int(LFUN(trtri_stub)(argv[0], argv[1], Int_val(argv[2]), + Int_val(argv[3]), Int_val(argv[4]), argv[5])); } /** TBTRS */ -extern void FUN(tbtrs)( - char *UPLO, char *TRANS, char *DIAG, - integer *N, integer *KD, integer *NRHS, - NUMBER *AB, integer *LDAB, - NUMBER *B, integer *LDB, - integer *INFO); - -CAMLprim intnat LFUN(tbtrs_stub)( - value vUPLO, value vTRANS, value vDIAG, - intnat vN, intnat vKD, intnat vNRHS, - intnat vABR, intnat vABC, value vAB, - intnat vBR, intnat vBC, value vB) -{ +extern void FUN(tbtrs)(char *UPLO, char *TRANS, char *DIAG, integer *N, + integer *KD, integer *NRHS, NUMBER *AB, integer *LDAB, + NUMBER *B, integer *LDB, integer *INFO); + +CAMLprim intnat LFUN(tbtrs_stub)(value vUPLO, value vTRANS, value vDIAG, + intnat vN, intnat vKD, intnat vNRHS, + intnat vABR, intnat vABC, value vAB, + intnat vBR, intnat vBC, value vB) { CAMLparam2(vAB, vB); char GET_CHAR(UPLO), GET_CHAR(TRANS), GET_CHAR(DIAG); @@ -2178,53 +1332,30 @@ CAMLprim intnat LFUN(tbtrs_stub)( MAT_PARAMS(AB); MAT_PARAMS(B); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(tbtrs)( - &UPLO, &TRANS, &DIAG, - &N, &KD, &NRHS, - AB_data, &rows_AB, - B_data, &rows_B, - &INFO); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(tbtrs)(&UPLO, &TRANS, &DIAG, &N, &KD, &NRHS, AB_data, &rows_AB, B_data, + &rows_B, &INFO); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(INFO); } -CAMLprim value LFUN(tbtrs_stub_bc)(value *argv, int __unused argn) -{ - return - Val_int( - LFUN(tbtrs_stub)( - argv[0], - argv[1], - argv[2], - Int_val(argv[3]), - Int_val(argv[4]), - Int_val(argv[5]), - Int_val(argv[6]), - Int_val(argv[7]), - argv[8], - Int_val(argv[9]), - Int_val(argv[10]), - argv[11])); +CAMLprim value LFUN(tbtrs_stub_bc)(value *argv, int __unused argn) { + return Val_int(LFUN(tbtrs_stub)( + argv[0], argv[1], argv[2], Int_val(argv[3]), Int_val(argv[4]), + Int_val(argv[5]), Int_val(argv[6]), Int_val(argv[7]), argv[8], + Int_val(argv[9]), Int_val(argv[10]), argv[11])); } /** GEQRF */ -extern void FUN(geqrf)( - integer *M, - integer *N, - NUMBER *A, integer *LDA, - NUMBER *TAU, - NUMBER *WORK, integer *LWORK, - integer *INFO); - -CAMLprim intnat LFUN(geqrf_stub)( - intnat vM, intnat vN, - intnat vAR, intnat vAC, value vA, - value vTAU, - value vWORK, intnat vLWORK) -{ +extern void FUN(geqrf)(integer *M, integer *N, NUMBER *A, integer *LDA, + NUMBER *TAU, NUMBER *WORK, integer *LWORK, + integer *INFO); + +CAMLprim intnat LFUN(geqrf_stub)(intnat vM, intnat vN, intnat vAR, intnat vAC, + value vA, value vTAU, value vWORK, + intnat vLWORK) { CAMLparam3(vA, vTAU, vWORK); integer GET_INT(M), GET_INT(N), GET_INT(LWORK), INFO; @@ -2233,563 +1364,304 @@ CAMLprim intnat LFUN(geqrf_stub)( VEC_PARAMS1(TAU); VEC_PARAMS1(WORK); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(geqrf)( - &M, &N, - A_data, &rows_A, - TAU_data, - WORK_data, &LWORK, - &INFO); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(geqrf)(&M, &N, A_data, &rows_A, TAU_data, WORK_data, &LWORK, &INFO); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(INFO); } -CAMLprim value LFUN(geqrf_stub_bc)(value *argv, int __unused argn) -{ - return - Val_int( - LFUN(geqrf_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - Int_val(argv[2]), - Int_val(argv[3]), - argv[4], - argv[5], - argv[6], - Int_val(argv[7]))); +CAMLprim value LFUN(geqrf_stub_bc)(value *argv, int __unused argn) { + return Val_int(LFUN(geqrf_stub)(Int_val(argv[0]), Int_val(argv[1]), + Int_val(argv[2]), Int_val(argv[3]), argv[4], + argv[5], argv[6], Int_val(argv[7]))); } - /* Linear Equations (simple drivers) ************************************************************************/ /** GESV */ -extern void FUN(gesv)( - integer *N, integer *NRHS, - NUMBER *A, integer *LDA, - integer *IPIV, - NUMBER *B, integer *LDB, - integer *INFO); - -CAMLprim intnat LFUN(gesv_stub)( - intnat vAR, intnat vAC, value vA, - intnat vN, - value vIPIV, - intnat vNRHS, - intnat vBR, intnat vBC, value vB) -{ +extern void FUN(gesv)(integer *N, integer *NRHS, NUMBER *A, integer *LDA, + integer *IPIV, NUMBER *B, integer *LDB, integer *INFO); + +CAMLprim intnat LFUN(gesv_stub)(intnat vAR, intnat vAC, value vA, intnat vN, + value vIPIV, intnat vNRHS, intnat vBR, + intnat vBC, value vB) { CAMLparam3(vA, vB, vIPIV); - integer GET_INT(N), - GET_INT(NRHS), - INFO; + integer GET_INT(N), GET_INT(NRHS), INFO; MAT_PARAMS(A); MAT_PARAMS(B); INT_VEC_PARAMS(IPIV); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(gesv)( - &N, &NRHS, - A_data, &rows_A, - IPIV_data, - B_data, &rows_B, - &INFO); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(gesv)(&N, &NRHS, A_data, &rows_A, IPIV_data, B_data, &rows_B, &INFO); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(INFO); } -CAMLprim value LFUN(gesv_stub_bc)(value *argv, int __unused argn) -{ - return - Val_int( - LFUN(gesv_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - argv[2], - Int_val(argv[3]), - argv[4], - Int_val(argv[5]), - Int_val(argv[6]), - Int_val(argv[7]), - argv[8])); +CAMLprim value LFUN(gesv_stub_bc)(value *argv, int __unused argn) { + return Val_int(LFUN(gesv_stub)(Int_val(argv[0]), Int_val(argv[1]), argv[2], + Int_val(argv[3]), argv[4], Int_val(argv[5]), + Int_val(argv[6]), Int_val(argv[7]), argv[8])); } - /** GBSV */ -extern void FUN(gbsv)( - integer *N, integer *KL, integer *KU, integer *NRHS, - NUMBER *AB, integer *LDAB, - integer *IPIV, - NUMBER *B, integer *LDB, - integer *INFO); - -CAMLprim intnat LFUN(gbsv_stub)( - intnat vABR, intnat vABC, value vAB, - intnat vN, intnat vKL, intnat vKU, - value vIPIV, - intnat vNRHS, - intnat vBR, intnat vBC, value vB) -{ +extern void FUN(gbsv)(integer *N, integer *KL, integer *KU, integer *NRHS, + NUMBER *AB, integer *LDAB, integer *IPIV, NUMBER *B, + integer *LDB, integer *INFO); + +CAMLprim intnat LFUN(gbsv_stub)(intnat vABR, intnat vABC, value vAB, intnat vN, + intnat vKL, intnat vKU, value vIPIV, + intnat vNRHS, intnat vBR, intnat vBC, + value vB) { CAMLparam3(vAB, vB, vIPIV); - integer GET_INT(N), - GET_INT(KL), - GET_INT(KU), - GET_INT(NRHS), - INFO; + integer GET_INT(N), GET_INT(KL), GET_INT(KU), GET_INT(NRHS), INFO; MAT_PARAMS(AB); MAT_PARAMS(B); INT_VEC_PARAMS(IPIV); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(gbsv)( - &N, &KL, &KU, &NRHS, - AB_data, &rows_AB, - IPIV_data, - B_data, &rows_B, - &INFO); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(gbsv)(&N, &KL, &KU, &NRHS, AB_data, &rows_AB, IPIV_data, B_data, &rows_B, + &INFO); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(INFO); } -CAMLprim value LFUN(gbsv_stub_bc)(value *argv, int __unused argn) -{ - return - Val_int( - LFUN(gbsv_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - argv[2], - Int_val(argv[3]), - Int_val(argv[4]), - Int_val(argv[5]), - argv[6], - Int_val(argv[7]), - Int_val(argv[8]), - Int_val(argv[9]), - argv[10])); +CAMLprim value LFUN(gbsv_stub_bc)(value *argv, int __unused argn) { + return Val_int(LFUN(gbsv_stub)(Int_val(argv[0]), Int_val(argv[1]), argv[2], + Int_val(argv[3]), Int_val(argv[4]), + Int_val(argv[5]), argv[6], Int_val(argv[7]), + Int_val(argv[8]), Int_val(argv[9]), argv[10])); } - /** GTSV */ -extern void FUN(gtsv)( - integer *N, integer *NRHS, - NUMBER *DL, NUMBER *D, NUMBER *DU, - NUMBER *B, integer *LDB, - integer *INFO); - -CAMLprim intnat LFUN(gtsv_stub)( - intnat vOFSDL, value vDL, - intnat vOFSD, value vD, - intnat vOFSDU, value vDU, - intnat vN, - intnat vNRHS, - intnat vBR, - intnat vBC, - value vB) -{ +extern void FUN(gtsv)(integer *N, integer *NRHS, NUMBER *DL, NUMBER *D, + NUMBER *DU, NUMBER *B, integer *LDB, integer *INFO); + +CAMLprim intnat LFUN(gtsv_stub)(intnat vOFSDL, value vDL, intnat vOFSD, + value vD, intnat vOFSDU, value vDU, intnat vN, + intnat vNRHS, intnat vBR, intnat vBC, + value vB) { CAMLparam4(vDL, vD, vDU, vB); - integer GET_INT(N), - GET_INT(NRHS), - INFO; + integer GET_INT(N), GET_INT(NRHS), INFO; VEC_PARAMS(DL); VEC_PARAMS(D); VEC_PARAMS(DU); MAT_PARAMS(B); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(gtsv)( - &N, &NRHS, - DL_data, D_data, DU_data, - B_data, &rows_B, - &INFO); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(gtsv)(&N, &NRHS, DL_data, D_data, DU_data, B_data, &rows_B, &INFO); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(INFO); } -CAMLprim value LFUN(gtsv_stub_bc)(value *argv, int __unused argn) -{ - return - Val_int( - LFUN(gtsv_stub)( - Int_val(argv[0]), - argv[1], - Int_val(argv[2]), - argv[3], - Int_val(argv[4]), - argv[5], - Int_val(argv[6]), - Int_val(argv[7]), - Int_val(argv[8]), - Int_val(argv[9]), - argv[10])); +CAMLprim value LFUN(gtsv_stub_bc)(value *argv, int __unused argn) { + return Val_int(LFUN(gtsv_stub)(Int_val(argv[0]), argv[1], Int_val(argv[2]), + argv[3], Int_val(argv[4]), argv[5], + Int_val(argv[6]), Int_val(argv[7]), + Int_val(argv[8]), Int_val(argv[9]), argv[10])); } - /** POSV */ -extern void FUN(posv)( - char *UPLO, - integer *N, integer *NRHS, - NUMBER *A, integer *LDA, - NUMBER *B, integer *LDB, - integer *INFO); - -CAMLprim intnat LFUN(posv_stub)( - intnat vAR, intnat vAC, value vA, - intnat vN, - value vUPLO, - intnat vNRHS, - intnat vBR, intnat vBC, value vB) -{ +extern void FUN(posv)(char *UPLO, integer *N, integer *NRHS, NUMBER *A, + integer *LDA, NUMBER *B, integer *LDB, integer *INFO); + +CAMLprim intnat LFUN(posv_stub)(intnat vAR, intnat vAC, value vA, intnat vN, + value vUPLO, intnat vNRHS, intnat vBR, + intnat vBC, value vB) { CAMLparam2(vA, vB); char GET_CHAR(UPLO); - integer GET_INT(N), - GET_INT(NRHS), - INFO; + integer GET_INT(N), GET_INT(NRHS), INFO; MAT_PARAMS(A); MAT_PARAMS(B); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(posv)( - &UPLO, - &N, &NRHS, - A_data, &rows_A, - B_data, &rows_B, - &INFO); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(posv)(&UPLO, &N, &NRHS, A_data, &rows_A, B_data, &rows_B, &INFO); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(INFO); } -CAMLprim value LFUN(posv_stub_bc)(value *argv, int __unused argn) -{ - return - Val_int( - LFUN(posv_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - argv[2], - Int_val(argv[3]), - argv[4], - Int_val(argv[5]), - Int_val(argv[6]), - Int_val(argv[7]), - argv[8])); +CAMLprim value LFUN(posv_stub_bc)(value *argv, int __unused argn) { + return Val_int(LFUN(posv_stub)(Int_val(argv[0]), Int_val(argv[1]), argv[2], + Int_val(argv[3]), argv[4], Int_val(argv[5]), + Int_val(argv[6]), Int_val(argv[7]), argv[8])); } - /** PPSV */ -extern void FUN(ppsv)( - char *UPLO, - integer *N, integer *NRHS, - NUMBER *AP, - NUMBER *B, integer *LDB, - integer *INFO); - -CAMLprim intnat LFUN(ppsv_stub)( - intnat vOFSAP, value vAP, - intnat vN, - value vUPLO, - intnat vNRHS, - intnat vBR, intnat vBC, value vB) -{ +extern void FUN(ppsv)(char *UPLO, integer *N, integer *NRHS, NUMBER *AP, + NUMBER *B, integer *LDB, integer *INFO); + +CAMLprim intnat LFUN(ppsv_stub)(intnat vOFSAP, value vAP, intnat vN, + value vUPLO, intnat vNRHS, intnat vBR, + intnat vBC, value vB) { CAMLparam2(vAP, vB); char GET_CHAR(UPLO); - integer GET_INT(N), - GET_INT(NRHS), - INFO; + integer GET_INT(N), GET_INT(NRHS), INFO; VEC_PARAMS(AP); MAT_PARAMS(B); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(ppsv)( - &UPLO, - &N, &NRHS, - AP_data, - B_data, &rows_B, - &INFO); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(ppsv)(&UPLO, &N, &NRHS, AP_data, B_data, &rows_B, &INFO); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(INFO); } -CAMLprim value LFUN(ppsv_stub_bc)(value *argv, int __unused argn) -{ - return - Val_int( - LFUN(ppsv_stub)( - Int_val(argv[0]), - argv[1], - Int_val(argv[2]), - argv[3], - Int_val(argv[4]), - Int_val(argv[5]), - Int_val(argv[6]), - argv[7])); +CAMLprim value LFUN(ppsv_stub_bc)(value *argv, int __unused argn) { + return Val_int(LFUN(ppsv_stub)(Int_val(argv[0]), argv[1], Int_val(argv[2]), + argv[3], Int_val(argv[4]), Int_val(argv[5]), + Int_val(argv[6]), argv[7])); } - /** PBSV */ -extern void FUN(pbsv)( - char *UPLO, - integer *N, integer *KD, integer *NRHS, - NUMBER *AB, integer *LDAB, - NUMBER *B, integer *LDB, - integer *INFO); - -CAMLprim intnat LFUN(pbsv_stub)( - intnat vABR, intnat vABC, value vAB, - intnat vN, - intnat vKD, - value vUPLO, - intnat vNRHS, - intnat vBR, intnat vBC, value vB) -{ +extern void FUN(pbsv)(char *UPLO, integer *N, integer *KD, integer *NRHS, + NUMBER *AB, integer *LDAB, NUMBER *B, integer *LDB, + integer *INFO); + +CAMLprim intnat LFUN(pbsv_stub)(intnat vABR, intnat vABC, value vAB, intnat vN, + intnat vKD, value vUPLO, intnat vNRHS, + intnat vBR, intnat vBC, value vB) { CAMLparam2(vAB, vB); char GET_CHAR(UPLO); - integer GET_INT(N), - GET_INT(KD), - GET_INT(NRHS), - INFO; + integer GET_INT(N), GET_INT(KD), GET_INT(NRHS), INFO; MAT_PARAMS(AB); MAT_PARAMS(B); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(pbsv)( - &UPLO, - &N, &KD, &NRHS, - AB_data, &rows_AB, - B_data, &rows_B, - &INFO); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(pbsv)(&UPLO, &N, &KD, &NRHS, AB_data, &rows_AB, B_data, &rows_B, &INFO); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(INFO); } -CAMLprim value LFUN(pbsv_stub_bc)(value *argv, int __unused argn) -{ - return - Val_int( - LFUN(pbsv_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - argv[2], - Int_val(argv[3]), - Int_val(argv[4]), - argv[5], - Int_val(argv[6]), - Int_val(argv[7]), - Int_val(argv[8]), - argv[9])); +CAMLprim value LFUN(pbsv_stub_bc)(value *argv, int __unused argn) { + return Val_int(LFUN(pbsv_stub)(Int_val(argv[0]), Int_val(argv[1]), argv[2], + Int_val(argv[3]), Int_val(argv[4]), argv[5], + Int_val(argv[6]), Int_val(argv[7]), + Int_val(argv[8]), argv[9])); } - /** PTSV */ -extern void FUN(ptsv)( - integer *N, integer *NRHS, - REAL *D, NUMBER *E, - NUMBER *B, integer *LDB, - integer *INFO); - -CAMLprim intnat LFUN(ptsv_stub)( - intnat vOFSD, value vD, - intnat vOFSE, value vE, - intnat vN, - intnat vNRHS, - intnat vBR, intnat vBC, value vB) -{ +extern void FUN(ptsv)(integer *N, integer *NRHS, REAL *D, NUMBER *E, NUMBER *B, + integer *LDB, integer *INFO); + +CAMLprim intnat LFUN(ptsv_stub)(intnat vOFSD, value vD, intnat vOFSE, value vE, + intnat vN, intnat vNRHS, intnat vBR, intnat vBC, + value vB) { CAMLparam3(vD, vE, vB); - integer GET_INT(N), - GET_INT(NRHS), - INFO; + integer GET_INT(N), GET_INT(NRHS), INFO; RVEC_PARAMS(D); VEC_PARAMS(E); MAT_PARAMS(B); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(ptsv)( - &N, &NRHS, - D_data, E_data, - B_data, &rows_B, - &INFO); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(ptsv)(&N, &NRHS, D_data, E_data, B_data, &rows_B, &INFO); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(INFO); } -CAMLprim value LFUN(ptsv_stub_bc)(value *argv, int __unused argn) -{ - return - Val_int( - LFUN(ptsv_stub)( - Int_val(argv[0]), - argv[1], - Int_val(argv[2]), - argv[3], - Int_val(argv[4]), - Int_val(argv[5]), - Int_val(argv[6]), - Int_val(argv[7]), - argv[8])); +CAMLprim value LFUN(ptsv_stub_bc)(value *argv, int __unused argn) { + return Val_int(LFUN(ptsv_stub)(Int_val(argv[0]), argv[1], Int_val(argv[2]), + argv[3], Int_val(argv[4]), Int_val(argv[5]), + Int_val(argv[6]), Int_val(argv[7]), argv[8])); } - /** SYSV */ -extern void FUN(sysv)( - char *UPLO, - integer *N, integer *NRHS, - NUMBER *A, integer *LDA, - integer *IPIV, - NUMBER *B, integer *LDB, - NUMBER *WORK, integer *LWORK, - integer *INFO); - -CAMLprim intnat LFUN(sysv_stub)( - intnat vAR, intnat vAC, value vA, - intnat vN, - value vUPLO, - value vIPIV, - value vWORK, - intnat vLWORK, - intnat vNRHS, - intnat vBR, intnat vBC, value vB) -{ +extern void FUN(sysv)(char *UPLO, integer *N, integer *NRHS, NUMBER *A, + integer *LDA, integer *IPIV, NUMBER *B, integer *LDB, + NUMBER *WORK, integer *LWORK, integer *INFO); + +CAMLprim intnat LFUN(sysv_stub)(intnat vAR, intnat vAC, value vA, intnat vN, + value vUPLO, value vIPIV, value vWORK, + intnat vLWORK, intnat vNRHS, intnat vBR, + intnat vBC, value vB) { CAMLparam4(vA, vIPIV, vWORK, vB); char GET_CHAR(UPLO); - integer GET_INT(N), - GET_INT(LWORK), - GET_INT(NRHS), - INFO; + integer GET_INT(N), GET_INT(LWORK), GET_INT(NRHS), INFO; MAT_PARAMS(A); INT_VEC_PARAMS(IPIV); VEC_PARAMS1(WORK); MAT_PARAMS(B); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(sysv)( - &UPLO, - &N, &NRHS, - A_data, &rows_A, - IPIV_data, - B_data, &rows_B, - WORK_data, &LWORK, - &INFO); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(sysv)(&UPLO, &N, &NRHS, A_data, &rows_A, IPIV_data, B_data, &rows_B, + WORK_data, &LWORK, &INFO); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(INFO); } -CAMLprim value LFUN(sysv_stub_bc)(value *argv, int __unused argn) -{ - return - Val_int( - LFUN(sysv_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - argv[2], - Int_val(argv[3]), - argv[4], - argv[5], - argv[6], - Int_val(argv[7]), - Int_val(argv[8]), - Int_val(argv[9]), - Int_val(argv[10]), - argv[11])); +CAMLprim value LFUN(sysv_stub_bc)(value *argv, int __unused argn) { + return Val_int(LFUN(sysv_stub)( + Int_val(argv[0]), Int_val(argv[1]), argv[2], Int_val(argv[3]), argv[4], + argv[5], argv[6], Int_val(argv[7]), Int_val(argv[8]), Int_val(argv[9]), + Int_val(argv[10]), argv[11])); } - /** SPSV */ -extern void FUN(spsv)( - char *UPLO, - integer *N, integer *NRHS, - NUMBER *AP, - integer *IPIV, - NUMBER *B, integer *LDB, - integer *INFO); - - -CAMLprim intnat LFUN(spsv_stub)( - intnat vOFSAP, value vAP, - intnat vN, - value vUPLO, - value vIPIV, - intnat vNRHS, - intnat vBR, intnat vBC, value vB) -{ +extern void FUN(spsv)(char *UPLO, integer *N, integer *NRHS, NUMBER *AP, + integer *IPIV, NUMBER *B, integer *LDB, integer *INFO); + +CAMLprim intnat LFUN(spsv_stub)(intnat vOFSAP, value vAP, intnat vN, + value vUPLO, value vIPIV, intnat vNRHS, + intnat vBR, intnat vBC, value vB) { CAMLparam3(vAP, vIPIV, vB); char GET_CHAR(UPLO); - integer GET_INT(N), - GET_INT(NRHS), - INFO; + integer GET_INT(N), GET_INT(NRHS), INFO; VEC_PARAMS(AP); INT_VEC_PARAMS(IPIV); MAT_PARAMS(B); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(spsv)( - &UPLO, - &N, &NRHS, - AP_data, - IPIV_data, - B_data, &rows_B, - &INFO); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(spsv)(&UPLO, &N, &NRHS, AP_data, IPIV_data, B_data, &rows_B, &INFO); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(INFO); } -CAMLprim value LFUN(spsv_stub_bc)(value *argv, int __unused argn) -{ - return - Val_int( - LFUN(spsv_stub)( - Int_val(argv[0]), - argv[1], - Int_val(argv[2]), - argv[3], - argv[4], - Int_val(argv[5]), - Int_val(argv[6]), - Int_val(argv[7]), - argv[8])); +CAMLprim value LFUN(spsv_stub_bc)(value *argv, int __unused argn) { + return Val_int(LFUN(spsv_stub)(Int_val(argv[0]), argv[1], Int_val(argv[2]), + argv[3], argv[4], Int_val(argv[5]), + Int_val(argv[6]), Int_val(argv[7]), argv[8])); } - /* Linear Equations (expert drivers) ************************************************************************/ @@ -2811,86 +1683,52 @@ CAMLprim value LFUN(spsv_stub_bc)(value *argv, int __unused argn) /** TODO: SPSVX */ - /* Least squares (simple drivers) ************************************************************************/ /** GELS */ -extern void FUN(gels)( - char *TRANS, - integer *M, integer *N, integer *NRHS, - NUMBER *A, integer *LDA, - NUMBER *B, integer *LDB, - NUMBER *WORK, integer *LWORK, - integer *INFO); - -CAMLprim intnat LFUN(gels_stub)( - intnat vAR, intnat vAC, value vA, - intnat vM, intnat vN, - value vTRANS, - value vWORK, - intnat vLWORK, - intnat vNRHS, - intnat vBR, intnat vBC, value vB) -{ +extern void FUN(gels)(char *TRANS, integer *M, integer *N, integer *NRHS, + NUMBER *A, integer *LDA, NUMBER *B, integer *LDB, + NUMBER *WORK, integer *LWORK, integer *INFO); + +CAMLprim intnat LFUN(gels_stub)(intnat vAR, intnat vAC, value vA, intnat vM, + intnat vN, value vTRANS, value vWORK, + intnat vLWORK, intnat vNRHS, intnat vBR, + intnat vBC, value vB) { CAMLparam3(vA, vB, vWORK); char GET_CHAR(TRANS); - integer GET_INT(M), - GET_INT(N), - GET_INT(LWORK), - GET_INT(NRHS), - INFO; + integer GET_INT(M), GET_INT(N), GET_INT(LWORK), GET_INT(NRHS), INFO; MAT_PARAMS(A); MAT_PARAMS(B); VEC_PARAMS1(WORK); - caml_enter_blocking_section(); /* Allow other threads */ - FUN(gels)( - &TRANS, - &M, &N, &NRHS, - A_data, &rows_A, - B_data, &rows_B, - WORK_data, &LWORK, - &INFO); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ + FUN(gels)(&TRANS, &M, &N, &NRHS, A_data, &rows_A, B_data, &rows_B, WORK_data, + &LWORK, &INFO); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(INFO); } -CAMLprim value LFUN(gels_stub_bc)(value *argv, int __unused argn) -{ - return - Val_int( - LFUN(gels_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - argv[2], - Int_val(argv[3]), - Int_val(argv[4]), - argv[5], - argv[6], - Int_val(argv[7]), - Int_val(argv[8]), - Int_val(argv[9]), - Int_val(argv[10]), - argv[11])); +CAMLprim value LFUN(gels_stub_bc)(value *argv, int __unused argn) { + return Val_int(LFUN(gels_stub)( + Int_val(argv[0]), Int_val(argv[1]), argv[2], Int_val(argv[3]), + Int_val(argv[4]), argv[5], argv[6], Int_val(argv[7]), Int_val(argv[8]), + Int_val(argv[9]), Int_val(argv[10]), argv[11])); } - /** GGLSE */ - /* Standard eigenvalue and singular value problems (simple drivers) ************************************************************************/ /** TODO: GEES */ - /* Generalized eigenvalue and singular value problems (simple drivers) ************************************************************************/ @@ -2900,7 +1738,6 @@ CAMLprim value LFUN(gels_stub_bc)(value *argv, int __unused argn) /** TODO: GGSVD */ - /* Generalized eigenvalue and singular value problems (expert drivers) ************************************************************************/ diff --git a/src/impl_SDCZ.ml b/src/impl_SDCZ.ml index 4da598c..6483dde 100644 --- a/src/impl_SDCZ.ml +++ b/src/impl_SDCZ.ml @@ -1,58 +1,48 @@ (* File: impl_SDCZ.ml - Copyright (C) 2001- + Copyright © 2001- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - Liam Stewart - email: liam@cs.toronto.edu - WWW: http://www.cs.toronto.edu/~liam + Liam Stewart - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umh.ac.be/an/ + Christophe Troestler - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) open Printf open Bigarray open Numberxx open Common open Utils - module Vec = Vec4_NPREC module Mat = Mat4_NPREC - module RVec = Vec4_NBPREC - (* BLAS-1 *) (* SWAP *) external direct_swap : - n : (int [@untagged]) -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> + n:(int[@untagged]) -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> unit = "lacaml_NPRECswap_stub_bc" "lacaml_NPRECswap_stub" let swap ?n ?ofsx ?incx x ?ofsy ?incy y = @@ -60,18 +50,17 @@ let swap ?n ?ofsx ?incx x ?ofsy ?incy y = let ofsx, incx = get_vec_geom loc x_str ofsx incx in let ofsy, incy = get_vec_geom loc y_str ofsy incy in let n = get_dim_vec loc x_str ofsx incx x n_str n in - check_vec loc y_str y (ofsy + (n - 1) * abs incy); + check_vec loc y_str y (ofsy + ((n - 1) * abs incy)); direct_swap ~n ~ofsx ~incx ~x ~ofsy ~incy ~y - (* SCAL *) external direct_scal : - n : (int [@untagged]) -> - alpha : num_type_arg -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + alpha:num_type_arg -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_NPRECscal_stub_bc" "lacaml_NPRECscal_stub" let scal ?n alpha ?ofsx ?incx x = @@ -80,17 +69,16 @@ let scal ?n alpha ?ofsx ?incx x = let n = get_dim_vec loc x_str ofsx incx x n_str n in direct_scal ~n ~alpha ~ofsx ~incx ~x - (* COPY *) external direct_copy : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_NPRECcopy_stub_bc" "lacaml_NPRECcopy_stub" let copy ?n ?ofsy ?incy ?y ?ofsx ?incx x = @@ -99,22 +87,24 @@ let copy ?n ?ofsy ?incy ?y ?ofsx ?incx x = let ofsy, incy = get_vec_geom loc y_str ofsy incy in let n = get_dim_vec loc x_str ofsx incx x n_str n in let y = - let min_dim_y = ofsy + (n - 1) * abs incy in + let min_dim_y = ofsy + ((n - 1) * abs incy) in match y with - | Some y -> check_vec loc y_str y min_dim_y; y - | None -> Vec.create min_dim_y in + | Some y -> + check_vec loc y_str y min_dim_y; + y + | None -> Vec.create min_dim_y + in direct_copy ~n ~ofsy ~incy ~y ~ofsx ~incx ~x; y - (* NRM2 *) external direct_nrm2 : - n : (int [@untagged]) -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec - -> (float [@unboxed]) = "lacaml_NPRECnrm2_stub_bc" "lacaml_NPRECnrm2_stub" + n:(int[@untagged]) -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> + (float[@unboxed]) = "lacaml_NPRECnrm2_stub_bc" "lacaml_NPRECnrm2_stub" let nrm2 ?n ?ofsx ?incx x = let loc = "Lacaml.NPREC.nrm2" in @@ -122,18 +112,17 @@ let nrm2 ?n ?ofsx ?incx x = let n = get_dim_vec loc x_str ofsx incx x n_str n in direct_nrm2 ~n ~ofsx ~incx ~x - (* AXPY *) external direct_axpy : - alpha : num_type_arg -> - n : (int [@untagged]) -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> + alpha:num_type_arg -> + n:(int[@untagged]) -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> unit = "lacaml_NPRECaxpy_stub_bc" "lacaml_NPRECaxpy_stub" let axpy ?(alpha = one) ?n ?ofsx ?incx x ?ofsy ?incy y = @@ -141,18 +130,17 @@ let axpy ?(alpha = one) ?n ?ofsx ?incx x ?ofsy ?incy y = let ofsx, incx = get_vec_geom loc x_str ofsx incx in let ofsy, incy = get_vec_geom loc y_str ofsy incy in let n = get_dim_vec loc x_str ofsx incx x n_str n in - check_vec loc y_str y (ofsy + (n - 1) * abs incy); + check_vec loc y_str y (ofsy + ((n - 1) * abs incy)); direct_axpy ~alpha ~n ~ofsx ~incx ~x ~ofsy ~incy ~y - (* AMAX *) external direct_iamax : - n : (int [@untagged]) -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> - (int [@untagged]) = "lacaml_NPRECiamax_stub_bc" "lacaml_NPRECiamax_stub" + n:(int[@untagged]) -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> + (int[@untagged]) = "lacaml_NPRECiamax_stub_bc" "lacaml_NPRECiamax_stub" let iamax ?n ?ofsx ?incx x = let loc = "Lacaml.NPREC.iamax" in @@ -167,127 +155,126 @@ let amax ?n ?ofsx ?incx x = if n = 0 then invalid_arg (sprintf "%s: n = 0" loc) else x.{direct_iamax ~n ~ofsx ~incx ~x} - (* BLAS-2 *) (* GEMV *) external direct_gemv : - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - trans : char -> - alpha : num_type_arg -> - beta : num_type_arg -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + trans:char -> + alpha:num_type_arg -> + beta:num_type_arg -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_NPRECgemv_stub_bc" "lacaml_NPRECgemv_stub" let gemv ?m ?n ?(beta = zero) ?ofsy ?incy ?y ?(trans = `N) ?(alpha = one) - ?(ar = 1) ?(ac = 1) a ?ofsx ?incx x = + ?(ar = 1) ?(ac = 1) a ?ofsx ?incx x = let loc = "Lacaml.NPREC.gemv" in let m = get_dim1_mat loc a_str a ar m_str m in let n = get_dim2_mat loc a_str a ac n_str n in let ofsx, incx, ofsy, incy, y, trans = gXmv_get_params loc Vec.create m n ofsx incx x ofsy incy y trans in - direct_gemv - ~ofsy ~incy ~y ~ar ~ac ~a ~m ~n ~trans ~alpha ~beta ~ofsx ~incx ~x; + direct_gemv ~ofsy ~incy ~y ~ar ~ac ~a ~m ~n ~trans ~alpha ~beta ~ofsx ~incx ~x; y - (* GBMV *) external direct_gbmv : - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - kl : (int [@untagged]) -> - ku : (int [@untagged]) -> - trans : char -> - alpha : num_type_arg -> - beta : num_type_arg -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + kl:(int[@untagged]) -> + ku:(int[@untagged]) -> + trans:char -> + alpha:num_type_arg -> + beta:num_type_arg -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_NPRECgbmv_stub_bc" "lacaml_NPRECgbmv_stub" let gbmv ?m ?n ?(beta = zero) ?ofsy ?incy ?y ?(trans = `N) ?(alpha = one) - ?(ar = 1) ?(ac = 1) a kl ku ?ofsx ?incx x = + ?(ar = 1) ?(ac = 1) a kl ku ?ofsx ?incx x = let loc = "Lacaml.NPREC.gbmv" in check_var_lt0 ~loc ~name:kl_str kl; check_var_lt0 ~loc ~name:ku_str ku; check_dim1_mat loc a_str a ar "kl + ku + 1 for " (kl + ku + 1); let n = get_dim2_mat loc a_str a ac n_str n in - let m = match m with + let m = + match m with | None -> n - | Some m -> check_var_lt0 ~loc ~name:m_str m; m in + | Some m -> + check_var_lt0 ~loc ~name:m_str m; + m + in let ofsx, incx, ofsy, incy, y, trans = gXmv_get_params loc Vec.create m n ofsx incx x ofsy incy y trans in - direct_gbmv - ~ofsy ~incy ~y ~ar ~ac ~a ~m ~n ~kl ~ku ~trans ~alpha ~beta ~ofsx ~incx ~x; + direct_gbmv ~ofsy ~incy ~y ~ar ~ac ~a ~m ~n ~kl ~ku ~trans ~alpha ~beta ~ofsx + ~incx ~x; y - (* SYMV *) external direct_symv : - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - n : (int [@untagged]) -> - uplo : char -> - alpha : num_type_arg -> - beta : num_type_arg -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + n:(int[@untagged]) -> + uplo:char -> + alpha:num_type_arg -> + beta:num_type_arg -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_NPRECsymv_stub_bc" "lacaml_NPRECsymv_stub" -let symv ?n ?(beta = zero) ?ofsy ?incy ?y ?(up = true) ?(alpha = one) - ?(ar = 1) ?(ac = 1) a ?ofsx ?incx x = +let symv ?n ?(beta = zero) ?ofsy ?incy ?y ?(up = true) ?(alpha = one) ?(ar = 1) + ?(ac = 1) a ?ofsx ?incx x = let loc = "Lacaml.NPREC.symv" in check_mat_empty ~loc ~mat_name:a_str ~dim1:(Mat.dim1 a) ~dim2:(Mat.dim2 a); check_vec_empty ~loc ~vec_name:x_str ~dim:(Vec.dim x); let n, ofsx, incx, ofsy, incy, y, uplo = - symv_get_params loc Vec.create ar ac a n ofsx incx x ofsy incy y up in + symv_get_params loc Vec.create ar ac a n ofsx incx x ofsy incy y up + in direct_symv ~ofsy ~incy ~y ~ar ~ac ~a ~n ~uplo ~alpha ~beta ~ofsx ~incx ~x; y - (* TRMV *) external direct_trmv : - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - n : (int [@untagged]) -> - uplo : char -> - trans : char -> - diag : char -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + n:(int[@untagged]) -> + uplo:char -> + trans:char -> + diag:char -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_NPRECtrmv_stub_bc" "lacaml_NPRECtrmv_stub" -let trmv - ?n ?(trans = `N) ?(diag = `N) ?(up = true) - ?(ar = 1) ?(ac = 1) a ?ofsx ?incx x = +let trmv ?n ?(trans = `N) ?(diag = `N) ?(up = true) ?(ar = 1) ?(ac = 1) a ?ofsx + ?incx x = let loc = "Lacaml.NPREC.trmv" in check_mat_empty ~loc ~mat_name:a_str ~dim1:(Mat.dim1 a) ~dim2:(Mat.dim2 a); check_vec_empty ~loc ~vec_name:x_str ~dim:(Vec.dim x); @@ -296,25 +283,23 @@ let trmv in direct_trmv ~ar ~ac ~a ~n ~uplo ~trans ~diag ~ofsx ~incx ~x - (* TRSV *) external direct_trsv : - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - n : (int [@untagged]) -> - uplo : char -> - trans : char -> - diag : char -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + n:(int[@untagged]) -> + uplo:char -> + trans:char -> + diag:char -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_NPRECtrsv_stub_bc" "lacaml_NPRECtrsv_stub" -let trsv - ?n ?(trans = `N) ?(diag = `N) ?(up = true) - ?(ar = 1) ?(ac = 1) a ?ofsx ?incx x = +let trsv ?n ?(trans = `N) ?(diag = `N) ?(up = true) ?(ar = 1) ?(ac = 1) a ?ofsx + ?incx x = let loc = "Lacaml.NPREC.trsv" in check_mat_empty ~loc ~mat_name:a_str ~dim1:(Mat.dim1 a) ~dim2:(Mat.dim2 a); check_vec_empty ~loc ~vec_name:x_str ~dim:(Vec.dim x); @@ -323,19 +308,18 @@ let trsv in direct_trsv ~ar ~ac ~a ~n ~uplo ~trans ~diag ~ofsx ~incx ~x - (* TPMV *) external direct_tpmv : - ofsap : (int [@untagged]) -> - ap : vec -> - n : (int [@untagged]) -> - uplo : char -> - trans : char -> - diag : char -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + ofsap:(int[@untagged]) -> + ap:vec -> + n:(int[@untagged]) -> + uplo:char -> + trans:char -> + diag:char -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_NPRECtpmv_stub_bc" "lacaml_NPRECtpmv_stub" let tpmv ?n ?(trans = `N) ?(diag = `N) ?(up = true) ?ofsap ap ?ofsx ?incx x = @@ -345,19 +329,18 @@ let tpmv ?n ?(trans = `N) ?(diag = `N) ?(up = true) ?ofsap ap ?ofsx ?incx x = in direct_tpmv ~ofsap ~ap ~n ~uplo ~trans ~diag ~ofsx ~incx ~x - (* TPSV *) external direct_tpsv : - ofsap : (int [@untagged]) -> - ap : vec -> - n : (int [@untagged]) -> - uplo : char -> - trans : char -> - diag : char -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + ofsap:(int[@untagged]) -> + ap:vec -> + n:(int[@untagged]) -> + uplo:char -> + trans:char -> + diag:char -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_NPRECtpsv_stub_bc" "lacaml_NPRECtpsv_stub" let tpsv ?n ?(trans = `N) ?(diag = `N) ?(up = true) ?ofsap ap ?ofsx ?incx x = @@ -367,105 +350,101 @@ let tpsv ?n ?(trans = `N) ?(diag = `N) ?(up = true) ?ofsap ap ?ofsx ?incx x = in direct_tpsv ~ofsap ~ap ~n ~uplo ~trans ~diag ~ofsx ~incx ~x - (* BLAS-3 *) (* GEMM *) external direct_gemm : - transa : char -> - transb : char -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - k : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> - cr : (int [@untagged]) -> - cc : (int [@untagged]) -> - c : mat -> - alpha : num_type_arg -> - beta : num_type_arg -> + transa:char -> + transb:char -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + k:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + cr:(int[@untagged]) -> + cc:(int[@untagged]) -> + c:mat -> + alpha:num_type_arg -> + beta:num_type_arg -> unit = "lacaml_NPRECgemm_stub_bc" "lacaml_NPRECgemm_stub" -let gemm ?m ?n ?k ?beta ?(cr = 1) ?(cc = 1) ?c - ?(transa = `N) ?(alpha = one) ?(ar = 1) ?(ac = 1) a - ?(transb = `N) ?(br = 1) ?(bc = 1) b = +let gemm ?m ?n ?k ?beta ?(cr = 1) ?(cc = 1) ?c ?(transa = `N) ?(alpha = one) + ?(ar = 1) ?(ac = 1) a ?(transb = `N) ?(br = 1) ?(bc = 1) b = let loc = "Lacaml.NPREC.gemm" in check_mat_empty ~loc ~mat_name:a_str ~dim1:(Mat.dim1 a) ~dim2:(Mat.dim2 a); check_mat_empty ~loc ~mat_name:b_str ~dim1:(Mat.dim1 b) ~dim2:(Mat.dim2 b); let beta = - match beta, c with + match (beta, c) with | None, _ -> zero | Some beta, Some _c -> beta | Some _beta, None -> failwith (sprintf "%s: providing [beta] without [c] not allowed" loc) in let m, n, k, transa, transb, c = - gemm_get_params - loc Mat.create ar ac a transa br bc b cr transb cc c m n k in + gemm_get_params loc Mat.create ar ac a transa br bc b cr transb cc c m n k + in check_mat_empty ~loc ~mat_name:c_str ~dim1:(Mat.dim1 c) ~dim2:(Mat.dim2 c); - direct_gemm - ~transa ~transb ~m ~n ~k ~ar ~ac ~a ~br ~bc ~b ~cr ~cc ~c ~alpha ~beta; + direct_gemm ~transa ~transb ~m ~n ~k ~ar ~ac ~a ~br ~bc ~b ~cr ~cc ~c ~alpha + ~beta; c - (* SYMM *) external direct_symm : - side : char -> - uplo : char -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> - cr : (int [@untagged]) -> - cc : (int [@untagged]) -> - c : mat -> - alpha : num_type_arg -> - beta : num_type_arg -> + side:char -> + uplo:char -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + cr:(int[@untagged]) -> + cc:(int[@untagged]) -> + c:mat -> + alpha:num_type_arg -> + beta:num_type_arg -> unit = "lacaml_NPRECsymm_stub_bc" "lacaml_NPRECsymm_stub" -let symm ?m ?n ?(side = `L) ?(up = true) - ?(beta = zero) ?(cr = 1) ?(cc = 1) ?c - ?(alpha = one) ?(ar = 1) ?(ac = 1) a ?(br = 1) ?(bc = 1) b = +let symm ?m ?n ?(side = `L) ?(up = true) ?(beta = zero) ?(cr = 1) ?(cc = 1) ?c + ?(alpha = one) ?(ar = 1) ?(ac = 1) a ?(br = 1) ?(bc = 1) b = let loc = "Lacaml.NPREC.symm" in check_mat_empty ~loc ~mat_name:a_str ~dim1:(Mat.dim1 a) ~dim2:(Mat.dim2 a); check_mat_empty ~loc ~mat_name:b_str ~dim1:(Mat.dim1 b) ~dim2:(Mat.dim2 b); let m, n, side, uplo, c = - symm_get_params loc Mat.create ar ac a br bc b cr cc c m n side up in + symm_get_params loc Mat.create ar ac a br bc b cr cc c m n side up + in check_mat_empty ~loc ~mat_name:c_str ~dim1:(Mat.dim1 c) ~dim2:(Mat.dim2 c); direct_symm ~side ~uplo ~m ~n ~ar ~ac ~a ~br ~bc ~b ~cr ~cc ~c ~alpha ~beta; c - (* TRMM *) external direct_trmm : - side : char -> - uplo : char -> - transa : char -> - diag : char -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> - alpha : num_type_arg -> + side:char -> + uplo:char -> + transa:char -> + diag:char -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + alpha:num_type_arg -> unit = "lacaml_NPRECtrmm_stub_bc" "lacaml_NPRECtrmm_stub" let trmm ?m ?n ?(side = `L) ?(up = true) ?(transa = `N) ?(diag = `N) - ?(alpha = one) ?(ar = 1) ?(ac = 1) a ?(br = 1) ?(bc = 1) b = + ?(alpha = one) ?(ar = 1) ?(ac = 1) a ?(br = 1) ?(bc = 1) b = let loc = "Lacaml.NPREC.trmm" in check_mat_empty ~loc ~mat_name:a_str ~dim1:(Mat.dim1 a) ~dim2:(Mat.dim2 a); check_mat_empty ~loc ~mat_name:b_str ~dim1:(Mat.dim1 b) ~dim2:(Mat.dim2 b); @@ -474,27 +453,26 @@ let trmm ?m ?n ?(side = `L) ?(up = true) ?(transa = `N) ?(diag = `N) in direct_trmm ~side ~uplo ~transa ~diag ~m ~n ~ar ~ac ~a ~br ~bc ~b ~alpha - (* TRSM *) external direct_trsm : - side : char -> - uplo : char -> - transa : char -> - diag : char -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> - alpha : num_type_arg -> + side:char -> + uplo:char -> + transa:char -> + diag:char -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + alpha:num_type_arg -> unit = "lacaml_NPRECtrsm_stub_bc" "lacaml_NPRECtrsm_stub" let trsm ?m ?n ?(side = `L) ?(up = true) ?(transa = `N) ?(diag = `N) - ?(alpha = one) ?(ar = 1) ?(ac = 1) a ?(br = 1) ?(bc = 1) b = + ?(alpha = one) ?(ar = 1) ?(ac = 1) a ?(br = 1) ?(bc = 1) b = let loc = "Lacaml.NPREC.trsm" in check_mat_empty ~loc ~mat_name:a_str ~dim1:(Mat.dim1 a) ~dim2:(Mat.dim2 a); check_mat_empty ~loc ~mat_name:b_str ~dim1:(Mat.dim1 b) ~dim2:(Mat.dim2 b); @@ -503,57 +481,56 @@ let trsm ?m ?n ?(side = `L) ?(up = true) ?(transa = `N) ?(diag = `N) in direct_trsm ~side ~uplo ~transa ~diag ~m ~n ~ar ~ac ~a ~br ~bc ~b ~alpha - (* SYRK *) external direct_syrk : - uplo : char -> - trans : char -> - n : (int [@untagged]) -> - k : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - cr : (int [@untagged]) -> - cc : (int [@untagged]) -> - c : mat -> - alpha : num_type_arg -> - beta : num_type_arg -> + uplo:char -> + trans:char -> + n:(int[@untagged]) -> + k:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + cr:(int[@untagged]) -> + cc:(int[@untagged]) -> + c:mat -> + alpha:num_type_arg -> + beta:num_type_arg -> unit = "lacaml_NPRECsyrk_stub_bc" "lacaml_NPRECsyrk_stub" -let syrk ?n ?k ?(up = true) ?(beta = zero) ?(cr = 1) ?(cc = 1) ?c - ?(trans = `N) ?(alpha = one) ?(ar = 1) ?(ac = 1) a = +let syrk ?n ?k ?(up = true) ?(beta = zero) ?(cr = 1) ?(cc = 1) ?c ?(trans = `N) + ?(alpha = one) ?(ar = 1) ?(ac = 1) a = let loc = "Lacaml.NPREC.syrk" in check_mat_empty ~loc ~mat_name:a_str ~dim1:(Mat.dim1 a) ~dim2:(Mat.dim2 a); let n, k, uplo, trans, c = - syrk_get_params loc Mat.create ar ac a cr cc c n k up trans in + syrk_get_params loc Mat.create ar ac a cr cc c n k up trans + in check_mat_empty ~loc ~mat_name:c_str ~dim1:(Mat.dim1 c) ~dim2:(Mat.dim2 c); direct_syrk ~uplo ~trans ~n ~k ~ar ~ac ~a ~cr ~cc ~c ~alpha ~beta; c - (* SYR2K *) external direct_syr2k : - uplo : char -> - trans : char -> - n : (int [@untagged]) -> - k : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> - cr : (int [@untagged]) -> - cc : (int [@untagged]) -> - c : mat -> - alpha : num_type_arg -> - beta : num_type_arg -> + uplo:char -> + trans:char -> + n:(int[@untagged]) -> + k:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + cr:(int[@untagged]) -> + cc:(int[@untagged]) -> + c:mat -> + alpha:num_type_arg -> + beta:num_type_arg -> unit = "lacaml_NPRECsyr2k_stub_bc" "lacaml_NPRECsyr2k_stub" -let syr2k ?n ?k ?(up = true) ?(beta = zero) ?(cr = 1) ?(cc = 1) ?c - ?(trans = `N) ?(alpha = one) ?(ar = 1) ?(ac = 1) a ?(br = 1) ?(bc = 1) b = +let syr2k ?n ?k ?(up = true) ?(beta = zero) ?(cr = 1) ?(cc = 1) ?c ?(trans = `N) + ?(alpha = one) ?(ar = 1) ?(ac = 1) a ?(br = 1) ?(bc = 1) b = let loc = "Lacaml.NPREC.syr2k" in check_mat_empty ~loc ~mat_name:a_str ~dim1:(Mat.dim1 a) ~dim2:(Mat.dim2 a); check_mat_empty ~loc ~mat_name:b_str ~dim1:(Mat.dim1 b) ~dim2:(Mat.dim2 b); @@ -564,7 +541,6 @@ let syr2k ?n ?k ?(up = true) ?(beta = zero) ?(cr = 1) ?(cc = 1) ?c direct_syr2k ~uplo ~trans ~n ~k ~ar ~ac ~a ~br ~bc ~b ~cr ~cc ~c ~alpha ~beta; c - (* LAPACK *) (* Auxiliary routines *) @@ -572,17 +548,17 @@ let syr2k ?n ?k ?(up = true) ?(beta = zero) ?(cr = 1) ?(cc = 1) ?c (* LACPY *) external direct_lacpy : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - uplo : char -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + uplo:char -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_NPREClacpy_stub_bc" "lacaml_NPREClacpy_stub" let lacpy ?uplo ?patt ?m ?n ?(br = 1) ?(bc = 1) ?b ?(ar = 1) ?(ac = 1) a = @@ -591,7 +567,9 @@ let lacpy ?uplo ?patt ?m ?n ?(br = 1) ?(bc = 1) ?b ?(ar = 1) ?(ac = 1) a = let n = get_dim2_mat loc a_str a ac n_str n in let b = match b with - | Some b -> check_dim_mat loc b_str br bc b m n; b + | Some b -> + check_dim_mat loc b_str br bc b m n; + b | None -> check_var_lt0 ~loc ~name:br_str br; check_var_lt0 ~loc ~name:bc_str bc; @@ -600,29 +578,29 @@ let lacpy ?uplo ?patt ?m ?n ?(br = 1) ?(bc = 1) ?b ?(ar = 1) ?(ac = 1) a = Mat.create min_bm min_bn in let pkind, pinit, uplo = - match patt, uplo with + match (patt, uplo) with | Some _, Some _ -> failwith (sprintf "%s: only one of [patt] and [uplo] are allowed" loc) - | (None | Some `Full), None -> Mat_patt.Upper, -1, 'A' - | Some `Utr, None | None, Some `U -> Mat_patt.Upper, -1, 'U' - | Some `Ltr, None | None, Some `L -> Mat_patt.Lower, -1, 'L' - | Some `Upent pinit, None -> Mat_patt.Upper, pinit, '?' - | Some `Lpent pinit, None -> Mat_patt.Lower, pinit, '?' + | (None | Some `Full), None -> (Mat_patt.Upper, -1, 'A') + | Some `Utr, None | None, Some `U -> (Mat_patt.Upper, -1, 'U') + | Some `Ltr, None | None, Some `L -> (Mat_patt.Lower, -1, 'L') + | Some (`Upent pinit), None -> (Mat_patt.Upper, pinit, '?') + | Some (`Lpent pinit), None -> (Mat_patt.Lower, pinit, '?') in direct_lacpy ~pkind ~pinit ~uplo ~m ~n ~ar ~ac ~a ~br ~bc ~b; b -(* LASWP *) +(* LASWP *) external direct_laswp : - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - k1 : (int [@untagged]) -> - k2 : (int [@untagged]) -> - ipiv : int32_vec -> - incx : (int [@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + k1:(int[@untagged]) -> + k2:(int[@untagged]) -> + ipiv:int32_vec -> + incx:(int[@untagged]) -> unit = "lacaml_NPREClaswp_stub_bc" "lacaml_NPREClaswp_stub" let laswp ?n ?(ar = 1) ?(ac = 1) a ?(k1 = 1) ?k2 ?(incx = 1) ipiv = @@ -645,16 +623,16 @@ let laswp ?n ?(ar = 1) ?(ac = 1) a ?(k1 = 1) ?k2 ?(incx = 1) ipiv = done; direct_laswp ~n ~ar ~ac ~a ~k1 ~k2 ~ipiv ~incx -(* LAPMT *) +(* LAPMT *) external direct_lapmt : - forward : bool -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - k : int32_vec -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> + forward:bool -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + k:int32_vec -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> unit = "lacaml_NPREClapmt_stub_bc" "lacaml_NPREClapmt_stub" let lapmt ?(forward = true) ?m ?n ?(ar = 1) ?(ac = 1) a k = @@ -667,12 +645,12 @@ let lapmt ?(forward = true) ?m ?n ?(ar = 1) ?(ac = 1) a k = (* LASSQ *) external direct_lassq : - n : (int [@untagged]) -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> - scale : (float [@unboxed]) -> - sumsq : (float [@unboxed]) -> + n:(int[@untagged]) -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> + scale:(float[@unboxed]) -> + sumsq:(float[@unboxed]) -> float * float = "lacaml_NPREClassq_stub_bc" "lacaml_NPREClassq_stub" let lassq ?n ?(scale = 0.) ?(sumsq = 1.) ?ofsx ?incx x = @@ -681,15 +659,14 @@ let lassq ?n ?(scale = 0.) ?(sumsq = 1.) ?ofsx ?incx x = let n = get_dim_vec loc x_str ofsx incx x n_str n in direct_lassq ~n ~ofsx ~incx ~x ~scale ~sumsq - (* LARNV *) external direct_larnv : - idist : (int [@untagged]) -> - iseed : int32_vec -> - n : (int [@untagged]) -> - ofsx : (int [@untagged]) -> - x : vec -> + idist:(int[@untagged]) -> + iseed:int32_vec -> + n:(int[@untagged]) -> + ofsx:(int[@untagged]) -> + x:vec -> unit = "lacaml_NPREClarnv_stub_bc" "lacaml_NPREClarnv_stub" let larnv ?idist ?iseed ?n ?ofsx ?x () = @@ -705,49 +682,50 @@ let larnv ?idist ?iseed ?n ?ofsx ?x () = match iseed with | None -> let iseed = create_int32_vec (ofsiseed + 3) in - for i = ofsiseed to ofsiseed + 3 do iseed.{i} <- 1l done; + for i = ofsiseed to ofsiseed + 3 do + iseed.{i} <- 1l + done; iseed | Some iseed -> if Array1.dim iseed - ofsiseed < 3 then - invalid_arg ( - sprintf "%s: iseed needs at least four available elements" loc); + invalid_arg + (sprintf "%s: iseed needs at least four available elements" loc); for i = ofsiseed to ofsiseed + 3 do if iseed.{i} < 0l || iseed.{i} > 4095l then - invalid_arg ( - sprintf "%s: iseed entries must be between 0 and 4095" loc) + invalid_arg + (sprintf "%s: iseed entries must be between 0 and 4095" loc) done; if Int32.logand iseed.{ofsiseed + 3} 1l = 1l then iseed else invalid_arg (sprintf "%s: last iseed entry must be odd" loc) in let ofsx = get_vec_ofs loc x_str ofsx in let n, x = - match n, x with - | None, None -> 1, Vec.create ofsx + match (n, x) with + | None, None -> (1, Vec.create ofsx) | Some n, None -> check_var_lt0 ~loc ~name:n_str n; - n, Vec.create (ofsx - 1 + n) - | None, Some x -> Vec.dim x - ofsx + 1, x + (n, Vec.create (ofsx - 1 + n)) + | None, Some x -> (Vec.dim x - ofsx + 1, x) | Some n, Some x -> check_var_lt0 ~loc ~name:n_str n; let min_dim = ofsx - 1 + n in check_vec loc x_str x min_dim; - n, x + (n, x) in direct_larnv ~idist ~iseed ~n ~ofsx ~x; x - (* LANGE *) external direct_lange : - norm : char -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - work : rvec -> - (float [@unboxed]) = "lacaml_NPREClange_stub_bc" "lacaml_NPREClange_stub" + norm:char -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + work:rvec -> + (float[@unboxed]) = "lacaml_NPREClange_stub_bc" "lacaml_NPREClange_stub" let lange_min_lwork m = function `I -> m | _ -> 0 @@ -773,11 +751,11 @@ let lange ?m ?n ?(norm = `O) ?work ?(ar = 1) ?(ac = 1) a = (* DLAUUM *) external direct_lauum : - uplo : char -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> + uplo:char -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> unit = "lacaml_NPREClauum_stub_bc" "lacaml_NPREClauum_stub" let lauum ?n ?(up = true) ?(ar = 1) ?(ac = 1) a = @@ -787,19 +765,18 @@ let lauum ?n ?(up = true) ?(ar = 1) ?(ac = 1) a = let uplo = get_uplo_char up in direct_lauum ~uplo ~n ~ar ~ac ~a - (* Linear equations (computational routines) *) (* GETRF *) external direct_getrf : - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - ipiv : int32_vec -> - (int [@untagged]) = "lacaml_NPRECgetrf_stub_bc" "lacaml_NPRECgetrf_stub" + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + ipiv:int32_vec -> + (int[@untagged]) = "lacaml_NPRECgetrf_stub_bc" "lacaml_NPRECgetrf_stub" let getrf ?m ?n ?ipiv ?(ar = 1) ?(ac = 1) a = let loc = "Lacaml.NPREC.getrf" in @@ -807,47 +784,46 @@ let getrf ?m ?n ?ipiv ?(ar = 1) ?(ac = 1) a = let ipiv = getrf_get_ipiv loc ipiv m n in let info = direct_getrf ~m ~n ~ar ~ac ~a ~ipiv in if info = 0 then ipiv - else - if info > 0 then getrf_lu_err loc info - else getrf_err loc m n a info + else if info > 0 then getrf_lu_err loc info + else getrf_err loc m n a info (* GETRS *) external direct_getrs : - trans : char -> - n : (int [@untagged]) -> - nrhs : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> - ipiv : int32_vec -> - (int [@untagged]) = "lacaml_NPRECgetrs_stub_bc" "lacaml_NPRECgetrs_stub" - -let getrs - ?n ?ipiv ?(trans = `N) ?(ar = 1) ?(ac = 1) a ?nrhs ?(br = 1) ?(bc = 1) b = + trans:char -> + n:(int[@untagged]) -> + nrhs:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + ipiv:int32_vec -> + (int[@untagged]) = "lacaml_NPRECgetrs_stub_bc" "lacaml_NPRECgetrs_stub" + +let getrs ?n ?ipiv ?(trans = `N) ?(ar = 1) ?(ac = 1) a ?nrhs ?(br = 1) ?(bc = 1) + b = let loc = "Lacaml.NPREC.getrs" in let trans = get_trans_char trans in let n, nrhs = xxtrs_get_params loc ar ac a n br bc b nrhs in let ipiv = - if ipiv = None then getrf ~m:n ~n ~ar ~ac a - else getrf_get_ipiv loc ipiv n n in + if ipiv = None then getrf ~m:n ~n ~ar ~ac a else getrf_get_ipiv loc ipiv n n + in let info = direct_getrs ~trans ~n ~nrhs ~ar ~ac ~a ~br ~bc ~b ~ipiv in if info <> 0 then xxtrs_err loc n nrhs a b info (* GETRI *) external direct_getri : - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - ipiv : int32_vec -> - work : vec -> - lwork : (int [@untagged]) -> - (int [@untagged]) = "lacaml_NPRECgetri_stub_bc" "lacaml_NPRECgetri_stub" + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + ipiv:int32_vec -> + work:vec -> + lwork:(int[@untagged]) -> + (int[@untagged]) = "lacaml_NPRECgetri_stub_bc" "lacaml_NPRECgetri_stub" let getri_min_lwork n = max 1 n @@ -868,12 +844,13 @@ let getri ?n ?ipiv ?work ?(ar = 1) ?(ac = 1) a = let loc = "Lacaml.NPREC.getri" in let n = get_n_of_a loc ar ac a n in let work, lwork = - get_work - loc Vec.create work - (getri_min_lwork n) (getri_get_opt_lwork loc n ar ac a) "lwork" in + get_work loc Vec.create work (getri_min_lwork n) + (getri_get_opt_lwork loc n ar ac a) + "lwork" + in let ipiv = - if ipiv = None then getrf ~m:n ~n ~ar ~ac a - else getrf_get_ipiv loc ipiv n n in + if ipiv = None then getrf ~m:n ~n ~ar ~ac a else getrf_get_ipiv loc ipiv n n + in let info = direct_getri ~n ~ar ~ac ~a ~ipiv ~work ~lwork in if info <> 0 then if info > 0 then xxtri_singular_err loc info @@ -882,23 +859,22 @@ let getri ?n ?ipiv ?work ?(ar = 1) ?(ac = 1) a = (* SYTRF *) external direct_sytrf : - uplo : char -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - ipiv : int32_vec -> - work : vec -> - lwork : (int [@untagged]) -> - (int [@untagged]) = "lacaml_NPRECsytrf_stub_bc" "lacaml_NPRECsytrf_stub" + uplo:char -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + ipiv:int32_vec -> + work:vec -> + lwork:(int[@untagged]) -> + (int[@untagged]) = "lacaml_NPRECsytrf_stub_bc" "lacaml_NPRECsytrf_stub" let sytrf_get_opt_lwork loc uplo n ar ac a = let work = Vec.create 1 in let info = direct_sytrf ~uplo ~n ~ar ~ac ~a ~ipiv:empty_int32_vec ~work ~lwork:~-1 in - if info = 0 then int_of_numberxx work.{1} - else sytrf_err loc n a info + if info = 0 then int_of_numberxx work.{1} else sytrf_err loc n a info let sytrf_opt_lwork ?n ?(up = true) ?(ar = 1) ?(ac = 1) a = let loc = "Lacaml.NPREC.sytrf_opt_lwork" in @@ -914,53 +890,52 @@ let sytrf ?n ?(up = true) ?ipiv ?work ?(ar = 1) ?(ac = 1) a = let n = get_n_of_a loc ar ac a n in let ipiv = sytrf_get_ipiv loc ipiv n in let work, lwork = - get_work - loc Vec.create work - (sytrf_min_lwork ()) - (sytrf_get_opt_lwork loc uplo n ar ac a) "lwork" in + get_work loc Vec.create work (sytrf_min_lwork ()) + (sytrf_get_opt_lwork loc uplo n ar ac a) + "lwork" + in let info = direct_sytrf ~uplo ~n ~ar ~ac ~a ~ipiv ~work ~lwork in if info = 0 then ipiv - else - if info > 0 then sytrf_fact_err loc info - else sytrf_err loc n a info + else if info > 0 then sytrf_fact_err loc info + else sytrf_err loc n a info (* SYTRS *) external direct_sytrs : - uplo : char -> - n : (int [@untagged]) -> - nrhs : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> - ipiv : int32_vec -> - (int [@untagged]) = "lacaml_NPRECsytrs_stub_bc" "lacaml_NPRECsytrs_stub" - -let sytrs - ?n ?(up = true) ?ipiv ?(ar = 1) ?(ac = 1) a ?nrhs ?(br = 1) ?(bc = 1) b = + uplo:char -> + n:(int[@untagged]) -> + nrhs:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + ipiv:int32_vec -> + (int[@untagged]) = "lacaml_NPRECsytrs_stub_bc" "lacaml_NPRECsytrs_stub" + +let sytrs ?n ?(up = true) ?ipiv ?(ar = 1) ?(ac = 1) a ?nrhs ?(br = 1) ?(bc = 1) + b = let loc = "Lacaml.NPREC.sytrs" in let uplo = get_uplo_char up in let n, nrhs = xxtrs_get_params loc ar ac a n br bc b nrhs in let ipiv = - if ipiv = None then sytrf ~n ~up ~ar ~ac a - else sytrf_get_ipiv loc ipiv n in + if ipiv = None then sytrf ~n ~up ~ar ~ac a else sytrf_get_ipiv loc ipiv n + in let info = direct_sytrs ~uplo ~n ~nrhs ~ar ~ac ~a ~br ~bc ~b ~ipiv in if info <> 0 then xxtrs_err loc n nrhs a b info (* SYTRI *) external direct_sytri : - uplo : char -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - ipiv : int32_vec -> - work : vec -> - (int [@untagged]) = "lacaml_NPRECsytri_stub_bc" "lacaml_NPRECsytri_stub" + uplo:char -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + ipiv:int32_vec -> + work:vec -> + (int[@untagged]) = "lacaml_NPRECsytri_stub_bc" "lacaml_NPRECsytri_stub" let sytri_min_lwork n = n @@ -969,28 +944,24 @@ let sytri ?n ?(up = true) ?ipiv ?work ?(ar = 1) ?(ac = 1) a = let uplo = get_uplo_char up in let n = get_n_of_a loc ar ac a n in let work, _lwork = - get_work - loc Vec.create work - (sytri_min_lwork n) (sytri_min_lwork n) "lwork" + get_work loc Vec.create work (sytri_min_lwork n) (sytri_min_lwork n) "lwork" in let ipiv = - if ipiv = None then sytrf ~n ~up ~ar ~ac a - else sytrf_get_ipiv loc ipiv n + if ipiv = None then sytrf ~n ~up ~ar ~ac a else sytrf_get_ipiv loc ipiv n in let info = direct_sytri ~uplo ~n ~ar ~ac ~a ~ipiv ~work in if info <> 0 then - if info > 0 then xxtri_singular_err loc info - else xxtri_err loc n a info + if info > 0 then xxtri_singular_err loc info else xxtri_err loc n a info (* POTRF *) external direct_potrf : - uplo : char -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - (int [@untagged]) = "lacaml_NPRECpotrf_stub_bc" "lacaml_NPRECpotrf_stub" + uplo:char -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + (int[@untagged]) = "lacaml_NPRECpotrf_stub_bc" "lacaml_NPRECpotrf_stub" let potrf ?n ?(up = true) ?(ar = 1) ?(ac = 1) a = let loc = "Lacaml.NPREC.potrf" in @@ -998,22 +969,21 @@ let potrf ?n ?(up = true) ?(ar = 1) ?(ac = 1) a = let n = get_n_of_a loc ar ac a n in let info = direct_potrf ~uplo ~n ~ar ~ac ~a in if info <> 0 then - if info > 0 then potrf_chol_err loc info - else potrf_err loc n a info + if info > 0 then potrf_chol_err loc info else potrf_err loc n a info (* POTRS *) external direct_potrs : - uplo : char -> - n : (int [@untagged]) -> - nrhs : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> - (int [@untagged]) = "lacaml_NPRECpotrs_stub_bc" "lacaml_NPRECpotrs_stub" + uplo:char -> + n:(int[@untagged]) -> + nrhs:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + (int[@untagged]) = "lacaml_NPRECpotrs_stub_bc" "lacaml_NPRECpotrs_stub" let potrs ?n ?(up = true) ?(ar = 1) ?(ac = 1) a ?nrhs ?(br = 1) ?(bc = 1) b = let loc = "Lacaml.NPREC.potrs" in @@ -1025,12 +995,12 @@ let potrs ?n ?(up = true) ?(ar = 1) ?(ac = 1) a ?nrhs ?(br = 1) ?(bc = 1) b = (* POTRI *) external direct_potri : - uplo : char -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - (int [@untagged]) = "lacaml_NPRECpotri_stub_bc" "lacaml_NPRECpotri_stub" + uplo:char -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + (int[@untagged]) = "lacaml_NPRECpotri_stub_bc" "lacaml_NPRECpotri_stub" let potri ?n ?(up = true) ?(ar = 1) ?(ac = 1) a = let loc = "Lacaml.NPREC.potri" in @@ -1038,48 +1008,44 @@ let potri ?n ?(up = true) ?(ar = 1) ?(ac = 1) a = let uplo = get_uplo_char up in let info = direct_potri ~uplo ~n ~ar ~ac ~a in if info <> 0 then - if info > 0 then xxtri_singular_err loc info - else xxtri_err loc n a info + if info > 0 then xxtri_singular_err loc info else xxtri_err loc n a info (* TRTRS *) external direct_trtrs : - uplo : char -> - trans : char -> - diag : char -> - n : (int [@untagged]) -> - nrhs : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> - (int [@untagged]) = "lacaml_NPRECtrtrs_stub_bc" "lacaml_NPRECtrtrs_stub" - -let trtrs - ?n ?(up = true) ?(trans = `N) ?(diag = `N) - ?(ar = 1) ?(ac = 1) a ?nrhs ?(br = 1) ?(bc = 1) b = + uplo:char -> + trans:char -> + diag:char -> + n:(int[@untagged]) -> + nrhs:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + (int[@untagged]) = "lacaml_NPRECtrtrs_stub_bc" "lacaml_NPRECtrtrs_stub" + +let trtrs ?n ?(up = true) ?(trans = `N) ?(diag = `N) ?(ar = 1) ?(ac = 1) a ?nrhs + ?(br = 1) ?(bc = 1) b = let loc = "Lacaml.NPREC.trtrs" in let uplo = get_uplo_char up in let trans = get_trans_char trans in let diag = get_diag_char diag in let n, nrhs = xxtrs_get_params loc ar ac a n br bc b nrhs in - let info = - direct_trtrs ~uplo ~trans ~diag ~n ~nrhs ~ar ~ac ~a ~br ~bc ~b - in + let info = direct_trtrs ~uplo ~trans ~diag ~n ~nrhs ~ar ~ac ~a ~br ~bc ~b in if info <> 0 then trtrs_err loc n nrhs a b info (* TRTRI *) external direct_trtri : - uplo : char -> - diag : char -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - (int [@untagged]) = "lacaml_NPRECtrtri_stub_bc" "lacaml_NPRECtrtri_stub" + uplo:char -> + diag:char -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + (int[@untagged]) = "lacaml_NPRECtrtri_stub_bc" "lacaml_NPRECtrtri_stub" let trtri ?n ?(up = true) ?(diag = `N) ?(ar = 1) ?(ac = 1) a = let loc = "Lacaml.NPREC.trtri" in @@ -1088,29 +1054,27 @@ let trtri ?n ?(up = true) ?(diag = `N) ?(ar = 1) ?(ac = 1) a = let diag = get_diag_char diag in let info = direct_trtri ~uplo ~diag ~n ~ar ~ac ~a in if info <> 0 then - if info > 0 then xxtri_singular_err loc info - else trtri_err loc n a info + if info > 0 then xxtri_singular_err loc info else trtri_err loc n a info (* TBTRS *) external direct_tbtrs : - uplo : char -> - trans : char -> - diag : char -> - n : (int [@untagged]) -> - kd : (int [@untagged]) -> - nrhs : (int [@untagged]) -> - abr : (int [@untagged]) -> - abc : (int [@untagged]) -> - ab : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> - (int [@untagged]) = "lacaml_NPRECtbtrs_stub_bc" "lacaml_NPRECtbtrs_stub" - -let tbtrs - ?n ?kd ?(up = true) ?(trans = `N) ?(diag = `N) - ?(abr = 1) ?(abc = 1) ab ?nrhs ?(br = 1) ?(bc = 1) b = + uplo:char -> + trans:char -> + diag:char -> + n:(int[@untagged]) -> + kd:(int[@untagged]) -> + nrhs:(int[@untagged]) -> + abr:(int[@untagged]) -> + abc:(int[@untagged]) -> + ab:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + (int[@untagged]) = "lacaml_NPRECtbtrs_stub_bc" "lacaml_NPRECtbtrs_stub" + +let tbtrs ?n ?kd ?(up = true) ?(trans = `N) ?(diag = `N) ?(abr = 1) ?(abc = 1) + ab ?nrhs ?(br = 1) ?(bc = 1) b = let loc = "Lacaml.NPREC.tbtrs" in let uplo = get_uplo_char up in let trans = get_trans_char trans in @@ -1126,21 +1090,20 @@ let tbtrs (* GEQRF *) external direct_geqrf : - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - tau : vec -> - work : vec -> - lwork : (int [@untagged]) -> - (int [@untagged]) = "lacaml_NPRECgeqrf_stub_bc" "lacaml_NPRECgeqrf_stub" + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + tau:vec -> + work:vec -> + lwork:(int[@untagged]) -> + (int[@untagged]) = "lacaml_NPRECgeqrf_stub_bc" "lacaml_NPRECgeqrf_stub" let geqrf_get_opt_lwork loc m n ar ac a = let work = Vec.create 1 in let info = direct_geqrf ~m ~n ~ar ~ac ~a ~tau:work ~work ~lwork:~-1 in - if info = 0 then int_of_numberxx work.{1} - else geqrf_err loc m n a info + if info = 0 then int_of_numberxx work.{1} else geqrf_err loc m n a info let geqrf_opt_lwork ?m ?n ?(ar = 1) ?(ac = 1) a = let loc = "Lacaml.NPREC.geqrf_opt_lwork" in @@ -1162,31 +1125,28 @@ let geqrf ?m ?n ?work ?tau ?(ar = 1) ?(ac = 1) a = else tau in let work, lwork = - get_work - loc Vec.create work - (geqrf_min_lwork ~n) - (geqrf_get_opt_lwork loc m n ar ac a) "lwork" + get_work loc Vec.create work (geqrf_min_lwork ~n) + (geqrf_get_opt_lwork loc m n ar ac a) + "lwork" in let info = direct_geqrf ~m ~n ~ar ~ac ~a ~tau ~work ~lwork in - if info = 0 then tau - else geqrf_err loc m n a info - + if info = 0 then tau else geqrf_err loc m n a info (* Linear equations (simple drivers) *) (* GESV *) external direct_gesv : - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - n : (int [@untagged]) -> - ipiv : int32_vec -> - nrhs : (int [@untagged]) -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> - (int [@untagged]) = "lacaml_NPRECgesv_stub_bc" "lacaml_NPRECgesv_stub" + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + n:(int[@untagged]) -> + ipiv:int32_vec -> + nrhs:(int[@untagged]) -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + (int[@untagged]) = "lacaml_NPRECgesv_stub_bc" "lacaml_NPRECgesv_stub" let gesv ?n ?ipiv ?(ar = 1) ?(ac = 1) a ?nrhs ?(br = 1) ?(bc = 1) b = let loc = "Lacaml.NPREC.gesv" in @@ -1202,23 +1162,23 @@ let gesv ?n ?ipiv ?(ar = 1) ?(ac = 1) a ?nrhs ?(br = 1) ?(bc = 1) b = (* GBSV *) external direct_gbsv : - abr : (int [@untagged]) -> - abc : (int [@untagged]) -> - ab : mat -> - n : (int [@untagged]) -> - kl : (int [@untagged]) -> - ku : (int [@untagged]) -> - ipiv : int32_vec -> - nrhs : (int [@untagged]) -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> - (int [@untagged]) = "lacaml_NPRECgbsv_stub_bc" "lacaml_NPRECgbsv_stub" + abr:(int[@untagged]) -> + abc:(int[@untagged]) -> + ab:mat -> + n:(int[@untagged]) -> + kl:(int[@untagged]) -> + ku:(int[@untagged]) -> + ipiv:int32_vec -> + nrhs:(int[@untagged]) -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + (int[@untagged]) = "lacaml_NPRECgbsv_stub_bc" "lacaml_NPRECgbsv_stub" let gbsv ?n ?ipiv ?(abr = 1) ?(abc = 1) ab kl ku ?nrhs ?(br = 1) ?(bc = 1) b = let loc = "Lacaml.NPREC.gbsv" in let n = get_dim2_mat loc ab_str ab abc n_str n in - let min_dim1 = 2*kl + ku + 1 in + let min_dim1 = (2 * kl) + ku + 1 in (* kl >= 0, ku >= 0: tested by the FORTRAN routine. *) check_dim1_mat loc ab_str ab abr "2*kl + ku + 1 for " min_dim1; let nrhs = get_nrhs_of_b loc n br bc b nrhs in @@ -1232,26 +1192,26 @@ let gbsv ?n ?ipiv ?(abr = 1) ?(abc = 1) ab kl ku ?nrhs ?(br = 1) ?(bc = 1) b = | -3 -> invalid_arg (sprintf "%s: ku: valid=[0..[ got=%d" loc ku) | -6 -> let msg = - sprintf "%s: dim1(ab): valid=[%d..[ got=%d" - loc min_dim1 (Mat.dim1 ab) in + sprintf "%s: dim1(ab): valid=[%d..[ got=%d" loc min_dim1 (Mat.dim1 ab) + in invalid_arg msg | _ -> xxsv_err loc n nrhs b (info + 2) (* GTSV *) external direct_gtsv : - ofsdl : (int [@untagged]) -> - dl : vec -> - ofsd : (int [@untagged]) -> - d : vec -> - ofsdu : (int [@untagged]) -> - du : vec -> - n : (int [@untagged]) -> - nrhs : (int [@untagged]) -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> - (int [@untagged]) = "lacaml_NPRECgtsv_stub_bc" "lacaml_NPRECgtsv_stub" + ofsdl:(int[@untagged]) -> + dl:vec -> + ofsd:(int[@untagged]) -> + d:vec -> + ofsdu:(int[@untagged]) -> + du:vec -> + n:(int[@untagged]) -> + nrhs:(int[@untagged]) -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + (int[@untagged]) = "lacaml_NPRECgtsv_stub_bc" "lacaml_NPRECgtsv_stub" let gtsv ?n ?ofsdl dl ?ofsd d ?ofsdu du ?nrhs ?(br = 1) ?(bc = 1) b = let loc = "Lacaml.NPREC.gtsv" in @@ -1263,23 +1223,22 @@ let gtsv ?n ?ofsdl dl ?ofsd d ?ofsdu du ?nrhs ?(br = 1) ?(bc = 1) b = check_vec loc dl_str dl (ofsdl + n - 2); check_vec loc du_str du (ofsdu + n - 2); let info = direct_gtsv ~ofsdl ~dl ~ofsd ~d ~ofsdu ~du ~n ~nrhs ~br ~bc ~b in - if info <> 0 then ( - if info > 0 then xxsv_lu_err loc info - else xxsv_err loc n nrhs b info) + if info <> 0 then + if info > 0 then xxsv_lu_err loc info else xxsv_err loc n nrhs b info (* POSV *) external direct_posv : - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - n : (int [@untagged]) -> - uplo : char -> - nrhs : (int [@untagged]) -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> - (int [@untagged]) = "lacaml_NPRECposv_stub_bc" "lacaml_NPRECposv_stub" + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + n:(int[@untagged]) -> + uplo:char -> + nrhs:(int[@untagged]) -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + (int[@untagged]) = "lacaml_NPRECposv_stub_bc" "lacaml_NPRECposv_stub" let posv ?n ?(up = true) ?(ar = 1) ?(ac = 1) a ?nrhs ?(br = 1) ?(bc = 1) b = let loc = "Lacaml.NPREC.posv" in @@ -1296,15 +1255,15 @@ let posv ?n ?(up = true) ?(ar = 1) ?(ac = 1) a ?nrhs ?(br = 1) ?(bc = 1) b = (* PPSV *) external direct_ppsv : - ofsap : (int [@untagged]) -> - ap : vec -> - n : (int [@untagged]) -> - uplo : char -> - nrhs : (int [@untagged]) -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> - (int [@untagged]) = "lacaml_NPRECppsv_stub_bc" "lacaml_NPRECppsv_stub" + ofsap:(int[@untagged]) -> + ap:vec -> + n:(int[@untagged]) -> + uplo:char -> + nrhs:(int[@untagged]) -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + (int[@untagged]) = "lacaml_NPRECppsv_stub_bc" "lacaml_NPRECppsv_stub" let ppsv ?n ?(up = true) ?ofsap ap ?nrhs ?(br = 1) ?(bc = 1) b = let loc = "Lacaml.NPREC.ppsv" in @@ -1315,26 +1274,26 @@ let ppsv ?n ?(up = true) ?ofsap ap ?nrhs ?(br = 1) ?(bc = 1) b = direct_ppsv ~ofsap ~ap ~n ~uplo:(get_uplo_char up) ~nrhs ~br ~bc ~b in if info <> 0 then - if info > 0 then xxsv_pos_err loc info - else xxsv_err loc n nrhs b (info - 1) (* only: LDB *) + if info > 0 then xxsv_pos_err loc info else xxsv_err loc n nrhs b (info - 1) +(* only: LDB *) (* PBSV *) external direct_pbsv : - abr : (int [@untagged]) -> - abc : (int [@untagged]) -> - ab : mat -> - n : (int [@untagged]) -> - kd : (int [@untagged]) -> - uplo : char -> - nrhs : (int [@untagged]) -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> - (int [@untagged]) = "lacaml_NPRECpbsv_stub_bc" "lacaml_NPRECpbsv_stub" - -let pbsv ?n ?(up = true) ?kd ?(abr = 1) ?(abc = 1) ab - ?nrhs ?(br = 1) ?(bc = 1) b = + abr:(int[@untagged]) -> + abc:(int[@untagged]) -> + ab:mat -> + n:(int[@untagged]) -> + kd:(int[@untagged]) -> + uplo:char -> + nrhs:(int[@untagged]) -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + (int[@untagged]) = "lacaml_NPRECpbsv_stub_bc" "lacaml_NPRECpbsv_stub" + +let pbsv ?n ?(up = true) ?kd ?(abr = 1) ?(abc = 1) ab ?nrhs ?(br = 1) ?(bc = 1) + b = let loc = "Lacaml.NPREC.pbsv" in (* [a] is a band matrix of size [k+1]*[n]. *) let n = get_dim2_mat loc ab_str ab abc n_str n in @@ -1350,24 +1309,24 @@ let pbsv ?n ?(up = true) ?kd ?(abr = 1) ?(abc = 1) ab | -3 -> invalid_arg (sprintf "%s: kd: valid=[0..[ got=%d" loc kd) | -6 -> let msg = - sprintf - "%s: dim1(ab): valid=[%d..[ got=%d" loc (kd + 1) (Mat.dim1 ab) in + sprintf "%s: dim1(ab): valid=[%d..[ got=%d" loc (kd + 1) (Mat.dim1 ab) + in invalid_arg msg | _ -> xxsv_err loc n nrhs b (info + 2) (* PTSV *) external direct_ptsv : - ofsd : (int [@untagged]) -> - d : rvec -> - ofse : (int [@untagged]) -> - e : vec -> - n : (int [@untagged]) -> - nrhs : (int [@untagged]) -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> - (int [@untagged]) = "lacaml_NPRECptsv_stub_bc" "lacaml_NPRECptsv_stub" + ofsd:(int[@untagged]) -> + d:rvec -> + ofse:(int[@untagged]) -> + e:vec -> + n:(int[@untagged]) -> + nrhs:(int[@untagged]) -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + (int[@untagged]) = "lacaml_NPRECptsv_stub_bc" "lacaml_NPRECptsv_stub" let ptsv ?n ?ofsd d ?ofse e ?nrhs ?(br = 1) ?(bc = 1) b = let loc = "Lacaml.NPREC.ptsv" in @@ -1378,55 +1337,53 @@ let ptsv ?n ?ofsd d ?ofse e ?nrhs ?(br = 1) ?(bc = 1) b = check_vec loc e_str e (ofse + n - 2); let info = direct_ptsv ~ofsd ~d ~ofse ~e ~n ~nrhs ~br ~bc ~b in if info <> 0 then - if info > 0 then xxsv_pos_err loc info - else xxsv_err loc n nrhs b (info - 1) + if info > 0 then xxsv_pos_err loc info else xxsv_err loc n nrhs b (info - 1) (* SYSV *) external direct_sysv : - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - n : (int [@untagged]) -> - uplo : char -> - ipiv : int32_vec -> - work : vec -> - lwork : (int [@untagged]) -> - nrhs : (int [@untagged]) -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> - (int [@untagged]) = "lacaml_NPRECsysv_stub_bc" "lacaml_NPRECsysv_stub" + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + n:(int[@untagged]) -> + uplo:char -> + ipiv:int32_vec -> + work:vec -> + lwork:(int[@untagged]) -> + nrhs:(int[@untagged]) -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + (int[@untagged]) = "lacaml_NPRECsysv_stub_bc" "lacaml_NPRECsysv_stub" let sysv_get_opt_lwork loc ar ac a n uplo nrhs br bc b = let work = Vec.create 1 in let info = - direct_sysv - ~ar ~ac ~a ~n ~uplo - ~ipiv:empty_int32_vec ~work ~lwork:~-1 ~nrhs ~br ~bc ~b + direct_sysv ~ar ~ac ~a ~n ~uplo ~ipiv:empty_int32_vec ~work ~lwork:~-1 ~nrhs + ~br ~bc ~b in - if info = 0 then int_of_numberxx work.{1} - else xxsv_err loc n nrhs b (info + 1) + if info = 0 then int_of_numberxx work.{1} else xxsv_err loc n nrhs b (info + 1) -let sysv_opt_lwork ?n ?(up = true) ?(ar = 1) ?(ac = 1) a - ?nrhs ?(br = 1) ?(bc = 1) b = +let sysv_opt_lwork ?n ?(up = true) ?(ar = 1) ?(ac = 1) a ?nrhs ?(br = 1) + ?(bc = 1) b = let loc = "Lacaml.NPREC.sysv_opt_lwork" in let n, nrhs = xxsv_get_params loc ar ac a n br bc b nrhs in let uplo = get_uplo_char up in sysv_get_opt_lwork loc ar ac a n uplo nrhs br bc b -let sysv ?n ?(up = true) ?ipiv ?work ?(ar = 1) ?(ac = 1) a - ?nrhs ?(br = 1) ?(bc = 1) b = +let sysv ?n ?(up = true) ?ipiv ?work ?(ar = 1) ?(ac = 1) a ?nrhs ?(br = 1) + ?(bc = 1) b = let loc = "Lacaml.NPREC.sysv" in let n, nrhs = xxsv_get_params loc ar ac a n br bc b nrhs in let uplo = get_uplo_char up in let ipiv = xxsv_get_ipiv loc ipiv n in let work, lwork = match work with - | Some work -> work, Array1.dim work + | Some work -> (work, Array1.dim work) | None -> let lwork = sysv_get_opt_lwork loc ar ac a n uplo nrhs br bc b in - Vec.create lwork, lwork in + (Vec.create lwork, lwork) + in let info = direct_sysv ~ar ~ac ~a ~n ~uplo ~ipiv ~work ~lwork ~nrhs ~br ~bc ~b in @@ -1439,16 +1396,16 @@ let sysv ?n ?(up = true) ?ipiv ?work ?(ar = 1) ?(ac = 1) a (* SPSV *) external direct_spsv : - ofsap : (int [@untagged]) -> - ap : vec -> - n : (int [@untagged]) -> - uplo : char -> - ipiv : int32_vec -> - nrhs : (int [@untagged]) -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> - (int [@untagged]) = "lacaml_NPRECspsv_stub_bc" "lacaml_NPRECspsv_stub" + ofsap:(int[@untagged]) -> + ap:vec -> + n:(int[@untagged]) -> + uplo:char -> + ipiv:int32_vec -> + nrhs:(int[@untagged]) -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + (int[@untagged]) = "lacaml_NPRECspsv_stub_bc" "lacaml_NPRECspsv_stub" let spsv ?n ?(up = true) ?ipiv ?ofsap ap ?nrhs ?(br = 1) ?(bc = 1) b = let loc = "Lacaml.NPREC.spsv" in @@ -1460,9 +1417,8 @@ let spsv ?n ?(up = true) ?ipiv ?ofsap ap ?nrhs ?(br = 1) ?(bc = 1) b = direct_spsv ~ofsap ~ap ~n ~uplo:(get_uplo_char up) ~ipiv ~nrhs ~br ~bc ~b in if info <> 0 then - if info > 0 then xxsv_ind_err loc info - else xxsv_err loc n nrhs b (info - 1) (* only possibility: LDB *) - + if info > 0 then xxsv_ind_err loc info else xxsv_err loc n nrhs b (info - 1) +(* only possibility: LDB *) (* Linear Equations (expert drivers) *) @@ -1484,25 +1440,24 @@ let spsv ?n ?(up = true) ?ipiv ?ofsap ap ?nrhs ?(br = 1) ?(bc = 1) b = (* TODO: SPSVX *) - (* Least squares (simple drivers) *) (* GELS *) external direct_gels : - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - trans : char -> - work : vec -> - lwork : (int [@untagged]) -> - nrhs : (int [@untagged]) -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> - (int [@untagged]) = "lacaml_NPRECgels_stub_bc" "lacaml_NPRECgels_stub" + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + trans:char -> + work:vec -> + lwork:(int[@untagged]) -> + nrhs:(int[@untagged]) -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + (int[@untagged]) = "lacaml_NPRECgels_stub_bc" "lacaml_NPRECgels_stub" let gels_min_lwork ~m ~n ~nrhs = let min_dim = min m n in @@ -1520,24 +1475,24 @@ let gels_get_opt_lwork loc ar ac a m n trans nrhs br bc b = if info = 0 then int_of_numberxx work.{1} else gels_err loc ar a m n 1 nrhs br b info -let gels_opt_lwork ?m ?n ?(trans = `N) ?(ar = 1) ?(ac = 1) a - ?nrhs ?(br = 1) ?(bc = 1) b = +let gels_opt_lwork ?m ?n ?(trans = `N) ?(ar = 1) ?(ac = 1) a ?nrhs ?(br = 1) + ?(bc = 1) b = let loc = "Lacaml.NPREC.gels_opt_lwork" in let m, n, nrhs = gelsX_get_params loc ar ac a m n nrhs br bc b in - gels_get_opt_lwork loc ar ac a m n - (get_trans_char trans) nrhs br bc b + gels_get_opt_lwork loc ar ac a m n (get_trans_char trans) nrhs br bc b -let gels ?m ?n ?work ?(trans = `N) ?(ar = 1) ?(ac = 1) a - ?nrhs ?(br = 1) ?(bc = 1) b = +let gels ?m ?n ?work ?(trans = `N) ?(ar = 1) ?(ac = 1) a ?nrhs ?(br = 1) + ?(bc = 1) b = let loc = "Lacaml.NPREC.gels" in let m, n, nrhs = gelsX_get_params loc ar ac a m n nrhs br bc b in let trans = get_trans_char trans in let work, lwork = match work with - | Some work -> work, Array1.dim work + | Some work -> (work, Array1.dim work) | None -> let lwork = gels_get_opt_lwork loc ar ac a m n trans nrhs br bc b in - Vec.create lwork, lwork in + (Vec.create lwork, lwork) + in let info = direct_gels ~ar ~ac ~a ~m ~n ~trans ~work ~lwork ~nrhs ~br ~bc ~b in diff --git a/src/impl_SDCZ.mli b/src/impl_SDCZ.mli index 91c39e8..e9c1604 100644 --- a/src/impl_SDCZ.mli +++ b/src/impl_SDCZ.mli @@ -1,33 +1,26 @@ (* File: impl_SDCZ.mli - Copyright (C) 2001- + Copyright © 2001- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - Liam Stewart - email: liam@cs.toronto.edu - WWW: http://www.cs.toronto.edu/~liam + Liam Stewart - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umh.ac.be/an/ + Christophe Troestler - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) (* Interface to BLAS/LAPACK *) @@ -37,12 +30,12 @@ open Numberxx (** {6 BLAS-1 interface} *) val swap : - ?n : int -> - ?ofsx : int -> - ?incx : int -> + ?n:int -> + ?ofsx:int -> + ?incx:int -> vec -> - ?ofsy : int -> - ?incy : int -> + ?ofsy:int -> + ?incy:int -> vec -> unit (** [swap ?n ?ofsx ?incx x ?ofsy ?incy y] see BLAS documentation! @@ -52,19 +45,19 @@ val swap : @param ofsy default = 1 @param incy default = 1 *) -val scal : ?n : int -> num_type -> ?ofsx : int -> ?incx : int -> vec -> unit +val scal : ?n:int -> num_type -> ?ofsx:int -> ?incx:int -> vec -> unit (** [scal ?n alpha ?ofsx ?incx x] see BLAS documentation! @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsx default = 1 @param incx default = 1 *) val copy : - ?n : int -> - ?ofsy : int -> - ?incy : int -> - ?y : vec -> - ?ofsx : int -> - ?incx : int -> + ?n:int -> + ?ofsy:int -> + ?incy:int -> + ?y:vec -> + ?ofsx:int -> + ?incx:int -> vec -> vec (** [copy ?n ?ofsy ?incy ?y ?ofsx ?incx x] see BLAS documentation! @@ -76,21 +69,20 @@ val copy : @param ofsx default = 1 @param incx default = 1 *) -val nrm2 : ?n : int -> ?ofsx : int -> ?incx : int -> vec -> float +val nrm2 : ?n:int -> ?ofsx:int -> ?incx:int -> vec -> float (** [nrm2 ?n ?ofsx ?incx x] see BLAS documentation! @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val axpy : - ?alpha : num_type -> - ?n : int -> - ?ofsx : int -> - ?incx : int -> + ?alpha:num_type -> + ?n:int -> + ?ofsx:int -> + ?incx:int -> vec -> - ?ofsy : int -> - ?incy : int -> + ?ofsy:int -> + ?incy:int -> vec -> unit (** [axpy ?alpha ?n ?ofsx ?incx x ?ofsy ?incy y] see BLAS documentation! @@ -101,51 +93,43 @@ val axpy : @param ofsy default = 1 @param incy default = 1 *) -val iamax : ?n : int -> ?ofsx : int -> ?incx : int -> vec -> int +val iamax : ?n:int -> ?ofsx:int -> ?incx:int -> vec -> int (** [iamax ?n ?ofsx ?incx x] see BLAS documentation! @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsx default = 1 @param incx default = 1 *) -val amax : - ?n : int -> - ?ofsx : int -> - ?incx : int -> - vec -> - num_type +val amax : ?n:int -> ?ofsx:int -> ?incx:int -> vec -> num_type (** [amax ?n ?ofsx ?incx x] @return the greater of the absolute values of the elements of the vector [x]. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsx default = 1 @param incx default = 1 *) - (** {6 BLAS-2 interface} *) val gemv : - ?m : int -> - ?n : int -> - ?beta : num_type -> - ?ofsy : int -> - ?incy : int -> - ?y : vec -> - ?trans : trans3 -> - ?alpha : num_type -> - ?ar : int -> - ?ac : int -> + ?m:int -> + ?n:int -> + ?beta:num_type -> + ?ofsy:int -> + ?incy:int -> + ?y:vec -> + ?trans:trans3 -> + ?alpha:num_type -> + ?ar:int -> + ?ac:int -> mat -> - ?ofsx : int -> - ?incx : int -> + ?ofsx:int -> + ?incx:int -> vec -> vec (** [gemv ?m ?n ?beta ?ofsy ?incy ?y ?trans ?alpha ?ar ?ac a ?ofsx ?incx x] - performs the operation - [y] := [alpha] * op([a]) * [x] + [beta] * [y] - where op([a]) = [a] or [a]ᵀ according to the value of [trans]. - See BLAS documentation for more information. - BEWARE that the 1988 BLAS-2 specification mandates that this - function has no effect when [n=0] while the mathematically - expected behavior is [y ← beta * y]. + performs the operation [y] := [alpha] * op([a]) * [x] + [beta] * [y] where + op([a]) = [a] or [a]ᵀ according to the value of [trans]. See BLAS + documentation for more information. BEWARE that the 1988 BLAS-2 + specification mandates that this function has no effect when [n=0] while the + mathematically expected behavior is [y ← beta * y]. @return vector [y], which is overwritten. @param m default = number of available rows in matrix [a] @param n default = available columns in matrix [a] @@ -161,21 +145,21 @@ val gemv : @param incx default = 1 *) val gbmv : - ?m : int -> - ?n : int -> - ?beta : num_type -> - ?ofsy : int -> - ?incy : int -> - ?y : vec -> - ?trans : trans3 -> - ?alpha : num_type -> - ?ar : int -> - ?ac : int -> + ?m:int -> + ?n:int -> + ?beta:num_type -> + ?ofsy:int -> + ?incy:int -> + ?y:vec -> + ?trans:trans3 -> + ?alpha:num_type -> + ?ar:int -> + ?ac:int -> mat -> int -> int -> - ?ofsx : int -> - ?incx : int -> + ?ofsx:int -> + ?incx:int -> vec -> vec (** [gbmv @@ -196,22 +180,22 @@ val gbmv : @param incx default = 1 *) val symv : - ?n : int -> - ?beta : num_type -> - ?ofsy : int -> - ?incy : int -> - ?y : vec -> - ?up : bool -> - ?alpha : num_type -> - ?ar : int -> - ?ac : int -> + ?n:int -> + ?beta:num_type -> + ?ofsy:int -> + ?incy:int -> + ?y:vec -> + ?up:bool -> + ?alpha:num_type -> + ?ar:int -> + ?ac:int -> mat -> - ?ofsx : int -> - ?incx : int -> + ?ofsx:int -> + ?incx:int -> vec -> vec -(** [symv ?n ?beta ?ofsy ?incy ?y ?up ?alpha ?ar ?ac a ?ofsx ?incx x] - see BLAS documentation! +(** [symv ?n ?beta ?ofsy ?incy ?y ?up ?alpha ?ar ?ac a ?ofsx ?incx x] see BLAS + documentation! @return vector [y], which is overwritten. @param n default = dimension of symmetric matrix [a] @param beta default = [{ re = 0.; im = 0. }] @@ -226,19 +210,18 @@ val symv : @param incx default = 1 *) val trmv : - ?n : int -> - ?trans : trans3 -> - ?diag : diag -> - ?up : bool -> - ?ar : int -> - ?ac : int -> + ?n:int -> + ?trans:trans3 -> + ?diag:diag -> + ?up:bool -> + ?ar:int -> + ?ac:int -> mat -> - ?ofsx : int -> - ?incx : int -> + ?ofsx:int -> + ?incx:int -> vec -> unit -(** [trmv ?n ?trans ?diag ?up ?ar ?ac a ?ofsx ?incx x] - see BLAS documentation! +(** [trmv ?n ?trans ?diag ?up ?ar ?ac a ?ofsx ?incx x] see BLAS documentation! @param n default = dimension of triangular matrix [a] @param trans default = `N @param diag default = false (not a unit triangular matrix) @@ -249,19 +232,18 @@ val trmv : @param incx default = 1 *) val trsv : - ?n : int -> - ?trans : trans3 -> - ?diag : diag -> - ?up : bool -> - ?ar : int -> - ?ac : int -> + ?n:int -> + ?trans:trans3 -> + ?diag:diag -> + ?up:bool -> + ?ar:int -> + ?ac:int -> mat -> - ?ofsx : int -> - ?incx : int -> + ?ofsx:int -> + ?incx:int -> vec -> unit -(** [trsv ?n ?trans ?diag ?up ?ar ?ac a ?ofsx ?incx x] - see BLAS documentation! +(** [trsv ?n ?trans ?diag ?up ?ar ?ac a ?ofsx ?incx x] see BLAS documentation! @param n default = dimension of triangular matrix [a] @param trans default = `N @param diag default = false (not a unit triangular matrix) @@ -272,18 +254,17 @@ val trsv : @param incx default = 1 *) val tpmv : - ?n : int -> - ?trans : trans3 -> - ?diag : diag -> - ?up : bool -> - ?ofsap : int -> + ?n:int -> + ?trans:trans3 -> + ?diag:diag -> + ?up:bool -> + ?ofsap:int -> vec -> - ?ofsx : int -> - ?incx : int -> + ?ofsx:int -> + ?incx:int -> vec -> unit -(** [tpmv ?n ?trans ?diag ?up ?ofsap ap ?ofsx ?incx x] - see BLAS documentation! +(** [tpmv ?n ?trans ?diag ?up ?ofsap ap ?ofsx ?incx x] see BLAS documentation! @param n default = dimension of packed triangular matrix [ap] @param trans default = `N @param diag default = false (not a unit triangular matrix) @@ -293,18 +274,17 @@ val tpmv : @param incx default = 1 *) val tpsv : - ?n : int -> - ?trans : trans3 -> - ?diag : diag -> - ?up : bool -> - ?ofsap : int -> + ?n:int -> + ?trans:trans3 -> + ?diag:diag -> + ?up:bool -> + ?ofsap:int -> vec -> - ?ofsx : int -> - ?incx : int -> + ?ofsx:int -> + ?incx:int -> vec -> unit -(** [tpsv ?n ?trans ?diag ?up ?ofsap ap ?ofsx ?incx x] - see BLAS documentation! +(** [tpsv ?n ?trans ?diag ?up ?ofsap ap ?ofsx ?incx x] see BLAS documentation! @param n default = dimension of packed triangular matrix [ap] @param trans default = `N @param diag default = false (not a unit triangular matrix) @@ -313,37 +293,36 @@ val tpsv : @param ofsx default = 1 @param incx default = 1 *) - (** {6 BLAS-3 interface} *) val gemm : - ?m : int -> - ?n : int -> - ?k : int -> - ?beta : num_type -> - ?cr : int -> - ?cc : int -> - ?c : mat -> - ?transa : trans3 -> - ?alpha : num_type -> - ?ar : int -> - ?ac : int -> + ?m:int -> + ?n:int -> + ?k:int -> + ?beta:num_type -> + ?cr:int -> + ?cc:int -> + ?c:mat -> + ?transa:trans3 -> + ?alpha:num_type -> + ?ar:int -> + ?ac:int -> mat -> - ?transb : trans3 -> - ?br : int -> - ?bc : int -> + ?transb:trans3 -> + ?br:int -> + ?bc:int -> mat -> mat (** [gemm ?m ?n ?k ?beta ?cr ?cc ?c ?transa ?alpha ?ar ?ac a ?transb ?br ?bc b] - performs the operation - [c] := [alpha] * op([a]) * op([b]) + [beta] * [c] - where op([x]) = [x] or [x]ᵀ depending on [transx]. - See BLAS documentation for more information. + performs the operation [c] := [alpha] * op([a]) * op([b]) + [beta] * [c] + where op([x]) = [x] or [x]ᵀ depending on [transx]. See BLAS documentation + for more information. @return matrix [c], which is overwritten. @param m default = number of rows of [a] (or tr [a]) and [c] @param n default = number of columns of [b] (or tr [b]) and [c] - @param k default = number of columns of [a] (or tr [a]) and - number of rows of [b] (or tr [b]) + @param k + default = number of columns of [a] (or tr [a]) and number of rows of [b] + (or tr [b]) @param beta default = [{ re = 0.; im = 0. }] @param cr default = 1 @param cc default = 1 @@ -357,24 +336,24 @@ val gemm : @param bc default = 1 *) val symm : - ?m : int -> - ?n : int -> - ?side : side -> - ?up : bool -> - ?beta : num_type -> - ?cr : int -> - ?cc : int -> - ?c : mat -> - ?alpha : num_type -> - ?ar : int -> - ?ac : int -> + ?m:int -> + ?n:int -> + ?side:side -> + ?up:bool -> + ?beta:num_type -> + ?cr:int -> + ?cc:int -> + ?c:mat -> + ?alpha:num_type -> + ?ar:int -> + ?ac:int -> mat -> - ?br : int -> - ?bc : int -> + ?br:int -> + ?bc:int -> mat -> mat -(** [symm ?m ?n ?side ?up ?beta ?cr ?cc ?c ?alpha ?ar ?ac a ?br ?bc b] - see BLAS documentation! +(** [symm ?m ?n ?side ?up ?beta ?cr ?cc ?c ?alpha ?ar ?ac a ?br ?bc b] see BLAS + documentation! @return matrix [c], which is overwritten. @param m default = number of rows of [c] @param n default = number of columns of [c] @@ -391,22 +370,22 @@ val symm : @param bc default = 1 *) val trmm : - ?m : int -> - ?n : int -> - ?side : side -> - ?up : bool -> - ?transa : trans3 -> - ?diag : diag -> - ?alpha : num_type -> - ?ar : int -> - ?ac : int -> + ?m:int -> + ?n:int -> + ?side:side -> + ?up:bool -> + ?transa:trans3 -> + ?diag:diag -> + ?alpha:num_type -> + ?ar:int -> + ?ac:int -> mat -> - ?br : int -> - ?bc : int -> + ?br:int -> + ?bc:int -> mat -> unit -(** [trmm ?m ?n ?side ?up ?transa ?diag ?alpha ?ar ?ac a ?br ?bc b] - see BLAS documentation! +(** [trmm ?m ?n ?side ?up ?transa ?diag ?alpha ?ar ?ac a ?br ?bc b] see BLAS + documentation! @param m default = number of rows of [b] @param n default = number of columns of [b] @param side default = `L (left - multiplication is [a][b]) @@ -420,22 +399,22 @@ val trmm : @param bc default = 1 *) val trsm : - ?m : int -> - ?n : int -> - ?side : side -> - ?up : bool -> - ?transa : trans3 -> - ?diag : diag -> - ?alpha : num_type -> - ?ar : int -> - ?ac : int -> + ?m:int -> + ?n:int -> + ?side:side -> + ?up:bool -> + ?transa:trans3 -> + ?diag:diag -> + ?alpha:num_type -> + ?ar:int -> + ?ac:int -> mat -> - ?br : int -> - ?bc : int -> + ?br:int -> + ?bc:int -> mat -> unit -(** [trsm ?m ?n ?side ?up ?transa ?diag ?alpha ?ar ?ac ~a ?br ?bc b] - see BLAS documentation! +(** [trsm ?m ?n ?side ?up ?transa ?diag ?alpha ?ar ?ac ~a ?br ?bc b] see BLAS + documentation! @return matrix [b], which is overwritten. @param m default = number of rows of [b] @param n default = number of columns of [b] @@ -450,21 +429,21 @@ val trsm : @param bc default = 1 *) val syrk : - ?n : int -> - ?k : int -> - ?up : bool -> - ?beta : num_type -> - ?cr : int -> - ?cc : int -> - ?c : mat -> - ?trans : trans2 -> - ?alpha : num_type -> - ?ar : int -> - ?ac : int -> + ?n:int -> + ?k:int -> + ?up:bool -> + ?beta:num_type -> + ?cr:int -> + ?cc:int -> + ?c:mat -> + ?trans:trans2 -> + ?alpha:num_type -> + ?ar:int -> + ?ac:int -> mat -> mat -(** [syrk ?n ?k ?up ?beta ?cr ?cc ?c ?trans ?alpha ?ar ?ac a] - see BLAS documentation! +(** [syrk ?n ?k ?up ?beta ?cr ?cc ?c ?trans ?alpha ?ar ?ac a] see BLAS + documentation! @return matrix [c], which is overwritten. @param n default = number of rows of [a] (or [a]'), [c] @param k default = number of columns of [a] (or [a]') @@ -479,24 +458,24 @@ val syrk : @param ac default = 1 *) val syr2k : - ?n : int -> - ?k : int -> - ?up : bool -> - ?beta : num_type -> - ?cr : int -> - ?cc : int -> - ?c : mat -> - ?trans : trans2 -> - ?alpha : num_type -> - ?ar : int -> - ?ac : int -> + ?n:int -> + ?k:int -> + ?up:bool -> + ?beta:num_type -> + ?cr:int -> + ?cc:int -> + ?c:mat -> + ?trans:trans2 -> + ?alpha:num_type -> + ?ar:int -> + ?ac:int -> mat -> - ?br : int -> - ?bc : int -> + ?br:int -> + ?bc:int -> mat -> mat -(** [syr2k ?n ?k ?up ?beta ?cr ?cc ?c ?trans ?alpha ?ar ?ac a ?br ?bc b] - see BLAS documentation! +(** [syr2k ?n ?k ?up ?beta ?cr ?cc ?c ?trans ?alpha ?ar ?ac a ?br ?bc b] see + BLAS documentation! @return matrix [c], which is overwritten. @param n default = number of rows of [a] (or [a]'), [c] @param k default = number of columns of [a] (or [a]') @@ -510,52 +489,49 @@ val syr2k : @param ar default = 1 @param ac default = 1 @param br default = 1 - @param bc default = 1 -*) - + @param bc default = 1 *) (** {6 LAPACK interface} *) (** {7 Auxiliary routines} *) val lacpy : - ?uplo : [ `U | `L ] -> - ?patt : Types.Mat.patt -> - ?m : int -> - ?n : int -> - ?br : int -> - ?bc : int -> - ?b : mat -> - ?ar : int -> - ?ac : int -> + ?uplo:[ `U | `L ] -> + ?patt:Types.Mat.patt -> + ?m:int -> + ?n:int -> + ?br:int -> + ?bc:int -> + ?b:mat -> + ?ar:int -> + ?ac:int -> mat -> mat (** [lacpy ?patt ?uplo ?m ?n ?br ?bc ?b ?ar ?ac a] copy the (triangular) - (sub-)matrix [a] (to an optional (sub-)matrix [b]) and return it. - [patt] is more general than [uplo] and should be used in its place - whenever strict BLAS conformance is not required. Only one of [patt] - and [uplo] can be specified at a time. + (sub-)matrix [a] (to an optional (sub-)matrix [b]) and return it. [patt] is + more general than [uplo] and should be used in its place whenever strict + BLAS conformance is not required. Only one of [patt] and [uplo] can be + specified at a time. @raise Failure if both [patt] and [uplo] are specified simultaneously @param patt default = [`Full] @param uplo default = whole matrix - @param b The target matrix. By default a fresh matrix to - accommodate the sizes [m] and [n] and the offsets [br] - and [bc] is created. *) + @param b + The target matrix. By default a fresh matrix to accommodate the sizes [m] + and [n] and the offsets [br] and [bc] is created. *) val laswp : - ?n : int -> - ?ar : int -> - ?ac : int -> + ?n:int -> + ?ar:int -> + ?ac:int -> mat -> - ?k1 : int -> - ?k2 : int -> - ?incx : int -> + ?k1:int -> + ?k2:int -> + ?incx:int -> int32_vec -> unit (** [laswp ?n ?ar ?ac a ?k1 ?k2 ?incx ipiv] swap rows of [a] according to - [ipiv]. - See LAPACK-documentation for details! + [ipiv]. See LAPACK-documentation for details! @param n default = number of columns of matrix @param ar default = 1 @@ -563,40 +539,38 @@ val laswp : @param k1 default = 1 @param k2 default = dimension of ipiv @param incx default = 1 - @param ipiv is a vector of sequential row interchanges. -*) + @param ipiv is a vector of sequential row interchanges. *) val lapmt : - ?forward : bool -> - ?m : int -> - ?n : int -> - ?ar : int -> - ?ac : int -> + ?forward:bool -> + ?m:int -> + ?n:int -> + ?ar:int -> + ?ac:int -> mat -> int32_vec -> unit -(** [lapmt ?forward ?n ?m ?ar ?ac a k] swap columns of [a] - according to the permutations in [k]. - See LAPACK-documentation for details! +(** [lapmt ?forward ?n ?m ?ar ?ac a k] swap columns of [a] according to the + permutations in [k]. See LAPACK-documentation for details! @param forward default = true @param m default = number of rows of matrix @param n default = number of columns of matrix @param ar default = 1 @param ac default = 1 - @param k is vector of column permutations and must be of length [n]. Note - that checking for duplicates in [k] is not performed and this could lead - to {b undefined} behavior. Furthermore, LAPACK uses [k] as a workspace and + @param k + is vector of column permutations and must be of length [n]. Note that + checking for duplicates in [k] is not performed and this could lead to + {b undefined} behavior. Furthermore, LAPACK uses [k] as a workspace and restore it upon completion, sharing this permutation array is not thread - safe. -*) + safe. *) val lassq : - ?n : int -> - ?scale : float -> - ?sumsq : float -> - ?ofsx : int -> - ?incx : int -> + ?n:int -> + ?scale:float -> + ?sumsq:float -> + ?ofsx:int -> + ?incx:int -> vec -> float * float (** [lassq ?n ?ofsx ?incx ?scale ?sumsq] @return [(scl, ssq)], where @@ -614,11 +588,11 @@ val lassq : *) val larnv : - ?idist : [ `Uniform0 | `Uniform1 | `Normal ] -> - ?iseed : int32_vec -> - ?n : int -> - ?ofsx : int -> - ?x : vec -> + ?idist:[ `Uniform0 | `Uniform1 | `Normal ] -> + ?iseed:int32_vec -> + ?n:int -> + ?ofsx:int -> + ?x:vec -> unit -> vec (** [larnv ?idist ?iseed ?n ?ofsx ?x ()] @return a random vector with random @@ -639,12 +613,12 @@ val lange_min_lwork : int -> norm4 -> int @param norm type of norm that will be computed by [lange] *) val lange : - ?m : int -> - ?n : int -> - ?norm : norm4 -> - ?work : rvec -> - ?ar : int -> - ?ac : int -> + ?m:int -> + ?n:int -> + ?norm:norm4 -> + ?work:rvec -> + ?ar:int -> + ?ac:int -> mat -> float (** [lange ?m ?n ?norm ?work ?ar ?ac a] @return the value of the one @@ -659,37 +633,23 @@ val lange : @param ar default = 1 @param ac default = 1 *) -val lauum : - ?n : int -> - ?up : bool -> - ?ar : int -> - ?ac : int -> - mat -> - unit -(** [lauum ?n ?up ?ar ?ac a] computes the product U * U**T or L**T * L, - where the triangular factor U or L is stored in the upper or lower - triangular part of the array [a]. The upper or lower part of [a] - is overwritten. +val lauum : ?n:int -> ?up:bool -> ?ar:int -> ?ac:int -> mat -> unit +(** [lauum ?n ?up ?ar ?ac a] computes the product U * U**T or L**T * L, where + the triangular factor U or L is stored in the upper or lower triangular part + of the array [a]. The upper or lower part of [a] is overwritten. @param n default = minimum of available number of rows/columns in matrix [a] @param up default = [true] @param ar default = 1 @param ac default = 1 *) - (** {7 Linear equations (computational routines)} *) val getrf : - ?m : int -> - ?n : int -> - ?ipiv : int32_vec -> - ?ar : int -> - ?ac : int -> - mat -> - int32_vec -(** [getrf ?m ?n ?ipiv ?ar ?ac a] computes an LU factorization of a - general [m]-by-[n] matrix [a] using partial pivoting with row - interchanges. See LAPACK documentation. + ?m:int -> ?n:int -> ?ipiv:int32_vec -> ?ar:int -> ?ac:int -> mat -> int32_vec +(** [getrf ?m ?n ?ipiv ?ar ?ac a] computes an LU factorization of a general + [m]-by-[n] matrix [a] using partial pivoting with row interchanges. See + LAPACK documentation. @return [ipiv], the pivot indices. @raise Failure if the matrix is singular. @param m default = number of rows in matrix [a] @@ -699,23 +659,21 @@ val getrf : @param ac default = 1 *) val getrs : - ?n : int -> - ?ipiv : int32_vec -> - ?trans : trans3 -> - ?ar : int -> - ?ac : int -> + ?n:int -> + ?ipiv:int32_vec -> + ?trans:trans3 -> + ?ar:int -> + ?ac:int -> mat -> - ?nrhs : int -> - ?br : int -> - ?bc : int -> + ?nrhs:int -> + ?br:int -> + ?bc:int -> mat -> unit -(** [getrs ?n ?ipiv ?trans ?ar ?ac a ?nrhs ?br ?bc b] solves a system - of linear equations [a] * X = [b] or [a]' * X = [b] with a general - [n]-by-[n] matrix [a] using the LU factorization computed by - {!getrf}. - Note that matrix [a] will be passed to {!getrf} if [ipiv] was not - provided. +(** [getrs ?n ?ipiv ?trans ?ar ?ac a ?nrhs ?br ?bc b] solves a system of linear + equations [a] * X = [b] or [a]' * X = [b] with a general [n]-by-[n] matrix + [a] using the LU factorization computed by {!getrf}. Note that matrix [a] + will be passed to {!getrf} if [ipiv] was not provided. @raise Failure if the matrix is singular. @param n default = number of columns in matrix [a] @param ipiv default = result from [getrf] applied to [a] @@ -730,12 +688,7 @@ val getri_min_lwork : int -> int (** [getri_min_lwork n] @return the minimum length of the work array used by the {!getri}-function if the matrix has [n] columns. *) -val getri_opt_lwork : - ?n : int -> - ?ar : int -> - ?ac : int -> - mat -> - int +val getri_opt_lwork : ?n:int -> ?ar:int -> ?ac:int -> mat -> int (** [getri_opt_lwork ?n ?ar ?ac a] @return the optimal size of the work array used by the {!getri}-function. @param n default = number of columns of matrix [a] @@ -743,16 +696,10 @@ val getri_opt_lwork : @param ac default = 1 *) val getri : - ?n : int -> - ?ipiv : int32_vec -> - ?work : vec -> - ?ar : int -> - ?ac : int -> - mat -> - unit -(** [getri ?n ?ipiv ?work ?ar ?ac a] computes the inverse of a matrix - using the LU factorization computed by {!getrf}. Note that matrix - [a] will be passed to {!getrf} if [ipiv] was not provided. + ?n:int -> ?ipiv:int32_vec -> ?work:vec -> ?ar:int -> ?ac:int -> mat -> unit +(** [getri ?n ?ipiv ?work ?ar ?ac a] computes the inverse of a matrix using the + LU factorization computed by {!getrf}. Note that matrix [a] will be passed + to {!getrf} if [ipiv] was not provided. @raise Failure if the matrix is singular. @param n default = number of columns in matrix [a] @param ipiv default = vec of length [m] from getri @@ -764,13 +711,7 @@ val sytrf_min_lwork : unit -> int (** [sytrf_min_lwork ()] @return the minimum length of the work array used by the {!sytrf}-function. *) -val sytrf_opt_lwork : - ?n : int -> - ?up : bool -> - ?ar : int -> - ?ac : int -> - mat -> - int +val sytrf_opt_lwork : ?n:int -> ?up:bool -> ?ar:int -> ?ac:int -> mat -> int (** [sytrf_opt_lwork ?n ?up ?ar ?ac a] @return the optimal size of the work array used by the {!sytrf}-function. @param n default = number of columns of matrix [a] @@ -780,17 +721,16 @@ val sytrf_opt_lwork : @param ac default = 1 *) val sytrf : - ?n : int -> - ?up : bool -> - ?ipiv : int32_vec -> - ?work : vec -> - ?ar : int -> - ?ac : int -> + ?n:int -> + ?up:bool -> + ?ipiv:int32_vec -> + ?work:vec -> + ?ar:int -> + ?ac:int -> mat -> int32_vec -(** [sytrf ?n ?up ?ipiv ?work ?ar ?ac a] computes the factorization of - the real symmetric matrix [a] using the Bunch-Kaufman diagonal - pivoting method. +(** [sytrf ?n ?up ?ipiv ?work ?ar ?ac a] computes the factorization of the real + symmetric matrix [a] using the Bunch-Kaufman diagonal pivoting method. @raise Failure if D in [a] = U*D*U' or L*D*L' is singular. @param n default = number of columns in matrix [a] @param up default = true (store upper triangle in [a]) @@ -800,22 +740,21 @@ val sytrf : @param ac default = 1 *) val sytrs : - ?n : int -> - ?up : bool -> - ?ipiv : int32_vec -> - ?ar : int -> - ?ac : int -> + ?n:int -> + ?up:bool -> + ?ipiv:int32_vec -> + ?ar:int -> + ?ac:int -> mat -> - ?nrhs : int -> - ?br : int -> - ?bc : int -> + ?nrhs:int -> + ?br:int -> + ?bc:int -> mat -> unit -(** [sytrs ?n ?up ?ipiv ?ar ?ac a ?nrhs ?br ?bc b] solves a system of - linear equations [a]*X = [b] with a real symmetric matrix [a] - using the factorization [a] = U*D*U**T or [a] = L*D*L**T computed - by {!sytrf}. Note that matrix [a] will be passed to {!sytrf} if - [ipiv] was not provided. +(** [sytrs ?n ?up ?ipiv ?ar ?ac a ?nrhs ?br ?bc b] solves a system of linear + equations [a]*X = [b] with a real symmetric matrix [a] using the + factorization [a] = U*D*U**T or [a] = L*D*L**T computed by {!sytrf}. Note + that matrix [a] will be passed to {!sytrf} if [ipiv] was not provided. @raise Failure if the matrix is singular. @param n default = number of columns in matrix [a] @param up default = true (store upper triangle in [a]) @@ -831,18 +770,18 @@ val sytri_min_lwork : int -> int work array used by the {!sytri}-function if the matrix has [n] columns. *) val sytri : - ?n : int -> - ?up : bool -> - ?ipiv : int32_vec -> - ?work : vec -> - ?ar : int -> - ?ac : int -> + ?n:int -> + ?up:bool -> + ?ipiv:int32_vec -> + ?work:vec -> + ?ar:int -> + ?ac:int -> mat -> unit -(** [sytri ?n ?up ?ipiv ?work ?ar ?ac a] computes the inverse of the - real symmetric indefinite matrix [a] using the factorization [a] = - U*D*U**T or [a] = L*D*L**T computed by {!sytrf}. Note that matrix - [a] will be passed to {!sytrf} if [ipiv] was not provided. +(** [sytri ?n ?up ?ipiv ?work ?ar ?ac a] computes the inverse of the real + symmetric indefinite matrix [a] using the factorization [a] = U*D*U**T or + [a] = L*D*L**T computed by {!sytrf}. Note that matrix [a] will be passed to + {!sytrf} if [ipiv] was not provided. @raise Failure if the matrix is singular. @param n default = number of columns in matrix [a] @@ -852,39 +791,31 @@ val sytri : @param ar default = 1 @param ac default = 1 *) -val potrf : - ?n : int -> - ?up : bool -> - ?ar : int -> - ?ac : int -> - mat -> - unit -(** [potrf ?n ?up ?ar ?ac a] factorizes symmetric positive definite matrix - [a] (or the designated submatrix) using Cholesky factorization. +val potrf : ?n:int -> ?up:bool -> ?ar:int -> ?ac:int -> mat -> unit +(** [potrf ?n ?up ?ar ?ac a] factorizes symmetric positive definite matrix [a] + (or the designated submatrix) using Cholesky factorization. @raise Failure if the matrix is singular. @param n default = number of columns in matrix [a] @param up default = true (store upper triangle in [a]) @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val potrs : - ?n : int -> - ?up : bool -> - ?ar : int -> - ?ac : int -> + ?n:int -> + ?up:bool -> + ?ar:int -> + ?ac:int -> mat -> - ?nrhs : int -> - ?br : int -> - ?bc : int -> + ?nrhs:int -> + ?br:int -> + ?bc:int -> mat -> unit -(** [potrs ?n ?up ?ar ?ac a ?nrhs ?br ?bc b] solves - a system of linear equations [a]*X = [b], where [a] is symmetric - positive definite matrix, using the Cholesky factorization [a] = - U**T*U or [a] = L*L**T computed by {!potrf}. +(** [potrs ?n ?up ?ar ?ac a ?nrhs ?br ?bc b] solves a system of linear equations + [a]*X = [b], where [a] is symmetric positive definite matrix, using the + Cholesky factorization [a] = U**T*U or [a] = L*L**T computed by {!potrf}. @raise Failure if the matrix is singular. @@ -894,45 +825,36 @@ val potrs : @param ac default = 1 @param nrhs default = available number of columns in matrix [b] @param br default = 1 - @param bc default = 1 -*) + @param bc default = 1 *) -val potri : - ?n : int -> - ?up : bool -> - ?ar : int -> - ?ac : int -> - mat -> - unit -(** [potri ?n ?up ?ar ?ac a] computes the inverse of the real symmetric - positive definite matrix [a] using the Cholesky factorization [a] = - U**T*U or [a] = L*L**T computed by {!potrf}. +val potri : ?n:int -> ?up:bool -> ?ar:int -> ?ac:int -> mat -> unit +(** [potri ?n ?up ?ar ?ac a] computes the inverse of the real symmetric positive + definite matrix [a] using the Cholesky factorization [a] = U**T*U or [a] = + L*L**T computed by {!potrf}. @raise Failure if the matrix is singular. @param n default = number of columns in matrix [a] @param up default = true (upper triangle stored in [a]) @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val trtrs : - ?n : int -> - ?up : bool -> - ?trans : trans3 -> - ?diag : diag -> - ?ar : int -> - ?ac : int -> + ?n:int -> + ?up:bool -> + ?trans:trans3 -> + ?diag:diag -> + ?ar:int -> + ?ac:int -> mat -> - ?nrhs : int -> - ?br : int -> - ?bc : int -> + ?nrhs:int -> + ?br:int -> + ?bc:int -> mat -> unit -(** [trtrs ?n ?up ?trans ?diag ?ar ?ac a ?nrhs ?br ?bc b] solves a - triangular system of the form [a] * X = [b] or [a]**T * X = [n], - where [a] is a triangular matrix of order [n], and [b] is an - [n]-by-[nrhs] matrix. +(** [trtrs ?n ?up ?trans ?diag ?ar ?ac a ?nrhs ?br ?bc b] solves a triangular + system of the form [a] * X = [b] or [a]**T * X = [n], where [a] is a + triangular matrix of order [n], and [b] is an [n]-by-[nrhs] matrix. @raise Failure if the matrix [a] is singular. @@ -944,27 +866,26 @@ val trtrs : @param ac default = 1 @param nrhs default = available number of columns in matrix [b] @param br default = 1 - @param bc default = 1 -*) + @param bc default = 1 *) val tbtrs : - ?n : int -> - ?kd : int -> - ?up : bool -> - ?trans : trans3 -> - ?diag : diag -> - ?abr : int -> - ?abc : int -> + ?n:int -> + ?kd:int -> + ?up:bool -> + ?trans:trans3 -> + ?diag:diag -> + ?abr:int -> + ?abc:int -> mat -> - ?nrhs : int -> - ?br : int -> - ?bc : int -> + ?nrhs:int -> + ?br:int -> + ?bc:int -> mat -> unit -(** [tbtrs ?n ?kd ?up ?trans ?diag ?abr ?abc ab ?nrhs ?br ?bc b] - solves a triangular system of the form [a] * X = [b] or [a]**T * X = [b], - where [a] is a triangular band matrix of order [n], and [b] is - an [n]-by-[nrhs] matrix. +(** [tbtrs ?n ?kd ?up ?trans ?diag ?abr ?abc ab ?nrhs ?br ?bc b] solves a + triangular system of the form [a] * X = [b] or [a]**T * X = [b], where [a] + is a triangular band matrix of order [n], and [b] is an [n]-by-[nrhs] + matrix. @raise Failure if the matrix [a] is singular. @@ -977,19 +898,12 @@ val tbtrs : @param abc default = 1 @param nrhs default = available number of columns in matrix [b] @param br default = 1 - @param bc default = 1 -*) + @param bc default = 1 *) val trtri : - ?n : int -> - ?up : bool -> - ?diag : diag -> - ?ar : int -> - ?ac : int -> - mat -> - unit -(** [trtri ?n ?up ?diag ?ar ?ac a] computes the inverse of a real - upper or lower triangular matrix [a]. + ?n:int -> ?up:bool -> ?diag:diag -> ?ar:int -> ?ac:int -> mat -> unit +(** [trtri ?n ?up ?diag ?ar ?ac a] computes the inverse of a real upper or lower + triangular matrix [a]. @raise Failure if the matrix [a] is singular. @@ -997,16 +911,9 @@ val trtri : @param up default = true (upper triangle stored in [a]) @param diag default = `N @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) -val geqrf_opt_lwork : - ?m : int -> - ?n : int -> - ?ar : int -> - ?ac : int -> - mat -> - int +val geqrf_opt_lwork : ?m:int -> ?n:int -> ?ar:int -> ?ac:int -> mat -> int (** [geqrf_opt_lwork ?m ?n ?ar ?ac a] @return the optimum length of the work-array used by the {!geqrf}-function given matrix [a] and optionally its logical dimensions [m] and [n]. @@ -1017,22 +924,15 @@ val geqrf_opt_lwork : @param ac default = 1 *) -val geqrf_min_lwork : n : int -> int +val geqrf_min_lwork : n:int -> int (** [geqrf_min_lwork ~n] @return the minimum length of the work-array used by the {!geqrf}-function if the matrix has [n] columns. *) val geqrf : - ?m : int -> - ?n : int -> - ?work : vec -> - ?tau : vec -> - ?ar : int -> - ?ac : int -> - mat -> - vec -(** [geqrf ?m ?n ?work ?tau ?ar ?ac a] computes a QR factorization of - a real [m]-by-[n] matrix [a]. See LAPACK documentation. + ?m:int -> ?n:int -> ?work:vec -> ?tau:vec -> ?ar:int -> ?ac:int -> mat -> vec +(** [geqrf ?m ?n ?work ?tau ?ar ?ac a] computes a QR factorization of a real + [m]-by-[n] matrix [a]. See LAPACK documentation. @return [tau], the scalar factors of the elementary reflectors. @param m default = number of rows in matrix [a] @@ -1042,28 +942,26 @@ val geqrf : @param ar default = 1 @param ac default = 1 *) - (** {7 Linear equations (simple drivers)} *) val gesv : - ?n : int -> - ?ipiv : int32_vec -> - ?ar : int -> - ?ac : int -> + ?n:int -> + ?ipiv:int32_vec -> + ?ar:int -> + ?ac:int -> mat -> - ?nrhs : int -> - ?br : int -> - ?bc : int -> + ?nrhs:int -> + ?br:int -> + ?bc:int -> mat -> unit -(** [gesv ?n ?ipiv ?ar ?ac a ?nrhs ?br ?bc b] computes the solution to - a real system of linear equations [a] * X = [b], where [a] is an - [n]-by-[n] matrix and X and [b] are [n]-by-[nrhs] matrices. The - LU decomposition with partial pivoting and row interchanges is - used to factor [a] as [a] = P * L * U, where P is a permutation - matrix, L is unit lower triangular, and U is upper triangular. - The factored form of [a] is then used to solve the system of - equations [a] * X = [b]. On exit, [b] contains the solution matrix X. +(** [gesv ?n ?ipiv ?ar ?ac a ?nrhs ?br ?bc b] computes the solution to a real + system of linear equations [a] * X = [b], where [a] is an [n]-by-[n] matrix + and X and [b] are [n]-by-[nrhs] matrices. The LU decomposition with partial + pivoting and row interchanges is used to factor [a] as [a] = P * L * U, + where P is a permutation matrix, L is unit lower triangular, and U is upper + triangular. The factored form of [a] is then used to solve the system of + equations [a] * X = [b]. On exit, [b] contains the solution matrix X. @raise Failure if the matrix [a] is singular. @param n default = available number of columns in matrix [a] @@ -1075,26 +973,25 @@ val gesv : @param bc default = 1 *) val gbsv : - ?n : int -> - ?ipiv : int32_vec -> - ?abr : int -> - ?abc : int -> + ?n:int -> + ?ipiv:int32_vec -> + ?abr:int -> + ?abc:int -> mat -> int -> int -> - ?nrhs : int -> - ?br : int -> - ?bc : int -> + ?nrhs:int -> + ?br:int -> + ?bc:int -> mat -> unit -(** [gbsv ?n ?ipiv ?abr ?abc ab kl ku ?nrhs ?br ?bc b] computes the - solution to a real system of linear equations [a] * X = [b], where - [a] is a band matrix of order [n] with [kl] subdiagonals and [ku] - superdiagonals, and X and [b] are [n]-by-[nrhs] matrices. The LU - decomposition with partial pivoting and row interchanges is used - to factor [a] as [a] = L * U, where L is a product of permutation and - unit lower triangular matrices with [kl] subdiagonals, and U is - upper triangular with [kl+ku] superdiagonals. The factored form of +(** [gbsv ?n ?ipiv ?abr ?abc ab kl ku ?nrhs ?br ?bc b] computes the solution to + a real system of linear equations [a] * X = [b], where [a] is a band matrix + of order [n] with [kl] subdiagonals and [ku] superdiagonals, and X and [b] + are [n]-by-[nrhs] matrices. The LU decomposition with partial pivoting and + row interchanges is used to factor [a] as [a] = L * U, where L is a product + of permutation and unit lower triangular matrices with [kl] subdiagonals, + and U is upper triangular with [kl+ku] superdiagonals. The factored form of [a] is then used to solve the system of equations [a] * X = [b]. @raise Failure if the matrix [a] is singular. @@ -1107,23 +1004,22 @@ val gbsv : @param bc default = 1 *) val gtsv : - ?n : int -> - ?ofsdl : int -> + ?n:int -> + ?ofsdl:int -> vec -> - ?ofsd : int -> + ?ofsd:int -> vec -> - ?ofsdu : int -> + ?ofsdu:int -> vec -> - ?nrhs : int -> - ?br : int -> - ?bc : int -> + ?nrhs:int -> + ?br:int -> + ?bc:int -> mat -> unit -(** [gtsv ?n ?ofsdl dl ?ofsd d ?ofsdu du ?nrhs ?br ?bc b] solves the - equation [a] * X = [b] where [a] is an [n]-by-[n] tridiagonal - matrix, by Gaussian elimination with partial pivoting. Note that - the equation [A]'*X = [b] may be solved by interchanging the order - of the arguments [du] and [dl]. +(** [gtsv ?n ?ofsdl dl ?ofsd d ?ofsdu du ?nrhs ?br ?bc b] solves the equation + [a] * X = [b] where [a] is an [n]-by-[n] tridiagonal matrix, by Gaussian + elimination with partial pivoting. Note that the equation [A]'*X = [b] may + be solved by interchanging the order of the arguments [du] and [dl]. @raise Failure if the matrix is singular. @param n default = available length of vector [d] @@ -1135,26 +1031,23 @@ val gtsv : @param bc default = 1 *) val posv : - ?n : int -> - ?up : bool -> - ?ar : int -> - ?ac : int -> + ?n:int -> + ?up:bool -> + ?ar:int -> + ?ac:int -> mat -> - ?nrhs : int -> - ?br : int -> - ?bc : int -> + ?nrhs:int -> + ?br:int -> + ?bc:int -> mat -> unit -(** [posv ?n ?up ?ar ?ac a ?nrhs ?br ?bc b] computes the solution to a - real system of linear equations [a] * X = [b], where [a] is an - [n]-by-[n] symmetric positive definite matrix and X and [b] are - [n]-by-[nrhs] matrices. The Cholesky decomposition is used to - factor [a] as - [a] = U**T * U, if [up = true], or - [a] = L * L**T, if [up = false], - where U is an upper triangular matrix and L is a lower triangular - matrix. The factored form of [a] is then used to solve the system - of equations [a] * X = [b]. +(** [posv ?n ?up ?ar ?ac a ?nrhs ?br ?bc b] computes the solution to a real + system of linear equations [a] * X = [b], where [a] is an [n]-by-[n] + symmetric positive definite matrix and X and [b] are [n]-by-[nrhs] matrices. + The Cholesky decomposition is used to factor [a] as [a] = U**T * U, if + [up = true], or [a] = L * L**T, if [up = false], where U is an upper + triangular matrix and L is a lower triangular matrix. The factored form of + [a] is then used to solve the system of equations [a] * X = [b]. @raise Failure if the matrix is singular. @param n default = available number of columns in matrix [a] @@ -1166,25 +1059,23 @@ val posv : @param bc default = 1 *) val ppsv : - ?n : int -> - ?up : bool -> - ?ofsap : int -> + ?n:int -> + ?up:bool -> + ?ofsap:int -> vec -> - ?nrhs : int -> - ?br : int -> - ?bc : int -> + ?nrhs:int -> + ?br:int -> + ?bc:int -> mat -> unit -(** [ppsv ?n ?up ?ofsap ap ?nrhs ?br ?bc b] computes the solution to - the real system of linear equations [a] * X = [b], where [a] is an - [n]-by-[n] symmetric positive definite matrix stored in packed - format and X and [b] are [n]-by-[nrhs] matrices. The Cholesky - decomposition is used to factor [a] as - [a] = U**T * U, if [up = true], or - [a] = L * L**T, if [up = false], - where U is an upper triangular matrix and L is a lower triangular - matrix. The factored form of [a] is then used to solve the system - of equations [a] * X = [b]. +(** [ppsv ?n ?up ?ofsap ap ?nrhs ?br ?bc b] computes the solution to the real + system of linear equations [a] * X = [b], where [a] is an [n]-by-[n] + symmetric positive definite matrix stored in packed format and X and [b] are + [n]-by-[nrhs] matrices. The Cholesky decomposition is used to factor [a] as + [a] = U**T * U, if [up = true], or [a] = L * L**T, if [up = false], where U + is an upper triangular matrix and L is a lower triangular matrix. The + factored form of [a] is then used to solve the system of equations [a] * X = + [b]. @raise Failure if the matrix is singular. @param n default = the greater n s.t. n(n+1)/2 <= [Vec.dim ap] @@ -1195,28 +1086,25 @@ val ppsv : @param bc default = 1 *) val pbsv : - ?n : int -> - ?up : bool -> - ?kd : int -> - ?abr : int -> - ?abc : int -> + ?n:int -> + ?up:bool -> + ?kd:int -> + ?abr:int -> + ?abc:int -> mat -> - ?nrhs : int -> - ?br : int -> - ?bc : int -> + ?nrhs:int -> + ?br:int -> + ?bc:int -> mat -> unit -(** [pbsv ?n ?up ?kd ?abr ?abc ab ?nrhs ?br ?bc b] computes the - solution to a real system of linear equations [a] * X = [b], where - [a] is an [n]-by-[n] symmetric positive definite band matrix and X - and [b] are [n]-by-[nrhs] matrices. The Cholesky decomposition is - used to factor [a] as - [a] = U**T * U, if [up = true], or - [a] = L * L**T, if [up = false], - where U is an upper triangular band matrix, and L is a lower - triangular band matrix, with the same number of superdiagonals or - subdiagonals as [a]. The factored form of [a] is then used to - solve the system of equations [a] * X = [b]. +(** [pbsv ?n ?up ?kd ?abr ?abc ab ?nrhs ?br ?bc b] computes the solution to a + real system of linear equations [a] * X = [b], where [a] is an [n]-by-[n] + symmetric positive definite band matrix and X and [b] are [n]-by-[nrhs] + matrices. The Cholesky decomposition is used to factor [a] as [a] = U**T * + U, if [up = true], or [a] = L * L**T, if [up = false], where U is an upper + triangular band matrix, and L is a lower triangular band matrix, with the + same number of superdiagonals or subdiagonals as [a]. The factored form of + [a] is then used to solve the system of equations [a] * X = [b]. @raise Failure if the matrix is singular. @param n default = available number of columns in matrix [ab] @@ -1229,22 +1117,21 @@ val pbsv : @param bc default = 1 *) val ptsv : - ?n : int -> - ?ofsd : int -> + ?n:int -> + ?ofsd:int -> rvec -> - ?ofse : int -> + ?ofse:int -> vec -> - ?nrhs : int -> - ?br : int -> - ?bc : int -> + ?nrhs:int -> + ?br:int -> + ?bc:int -> mat -> unit -(** [ptsv ?n ?ofsd d ?ofse e ?nrhs ?br ?bc b] computes the solution to - the real system of linear equations [a]*X = [b], where [a] is an - [n]-by-[n] symmetric positive definite tridiagonal matrix, and X - and [b] are [n]-by-[nrhs] matrices. A is factored as [a] = - L*D*L**T, and the factored form of [a] is then used to solve the - system of equations. +(** [ptsv ?n ?ofsd d ?ofse e ?nrhs ?br ?bc b] computes the solution to the real + system of linear equations [a]*X = [b], where [a] is an [n]-by-[n] symmetric + positive definite tridiagonal matrix, and X and [b] are [n]-by-[nrhs] + matrices. A is factored as [a] = L*D*L**T, and the factored form of [a] is + then used to solve the system of equations. @raise Failure if the matrix is singular. @param n default = available length of vector [d] @@ -1255,14 +1142,14 @@ val ptsv : @param bc default = 1 *) val sysv_opt_lwork : - ?n : int -> - ?up : bool -> - ?ar : int -> - ?ac : int -> + ?n:int -> + ?up:bool -> + ?ar:int -> + ?ac:int -> mat -> - ?nrhs : int -> - ?br : int -> - ?bc : int -> + ?nrhs:int -> + ?br:int -> + ?bc:int -> mat -> int (** [sysv_opt_lwork ?n ?up ?ar ?ac a ?nrhs ?br ?bc b] @return the optimum @@ -1278,28 +1165,26 @@ val sysv_opt_lwork : @param bc default = 1 *) val sysv : - ?n : int -> - ?up : bool -> - ?ipiv : int32_vec -> - ?work : vec -> - ?ar : int -> - ?ac : int -> + ?n:int -> + ?up:bool -> + ?ipiv:int32_vec -> + ?work:vec -> + ?ar:int -> + ?ac:int -> mat -> - ?nrhs : int -> - ?br : int -> - ?bc : int -> + ?nrhs:int -> + ?br:int -> + ?bc:int -> mat -> unit -(** [sysv ?n ?up ?ipiv ?work ?ar ?ac a ?nrhs ?br ?bc b] computes the - solution to a real system of linear equations [a] * X = [b], where - [a] is an N-by-N symmetric matrix and X and [b] are [n]-by-[nrhs] - matrices. The diagonal pivoting method is used to factor [a] as - [a] = U * D * U**T, if [up = true], or - [a] = L * D * L**T, if [up = false], - where U (or L) is a product of permutation and unit upper (lower) - triangular matrices, and D is symmetric and block diagonal with - 1-by-1 and 2-by-2 diagonal blocks. The factored form of [a] is - then used to solve the system of equations [a] * X = [b]. +(** [sysv ?n ?up ?ipiv ?work ?ar ?ac a ?nrhs ?br ?bc b] computes the solution to + a real system of linear equations [a] * X = [b], where [a] is an N-by-N + symmetric matrix and X and [b] are [n]-by-[nrhs] matrices. The diagonal + pivoting method is used to factor [a] as [a] = U * D * U**T, if [up = true], + or [a] = L * D * L**T, if [up = false], where U (or L) is a product of + permutation and unit upper (lower) triangular matrices, and D is symmetric + and block diagonal with 1-by-1 and 2-by-2 diagonal blocks. The factored form + of [a] is then used to solve the system of equations [a] * X = [b]. @raise Failure if the matrix is singular. @param n default = available number of columns in matrix [a] @@ -1313,27 +1198,25 @@ val sysv : @param bc default = 1 *) val spsv : - ?n : int -> - ?up : bool -> - ?ipiv : int32_vec -> - ?ofsap : int -> + ?n:int -> + ?up:bool -> + ?ipiv:int32_vec -> + ?ofsap:int -> vec -> - ?nrhs : int -> - ?br : int -> - ?bc : int -> + ?nrhs:int -> + ?br:int -> + ?bc:int -> mat -> unit -(** [spsv ?n ?up ?ipiv ?ofsap ap ?nrhs ?br ?bc b] computes the - solution to the real system of linear equations [a] * X = [b], - where [a] is an [n]-by-[n] symmetric matrix stored in packed - format and X and [b] are [n]-by-[nrhs] matrices. The diagonal - pivoting method is used to factor [a] as - [a] = U * D * U**T, if [up = true], or - [a] = L * D * L**T, if [up = false], - where U (or L) is a product of permutation and unit upper (lower) - triangular matrices, D is symmetric and block diagonal with 1-by-1 - and 2-by-2 diagonal blocks. The factored form of [a] is then used - to solve the system of equations [a] * X = [b]. +(** [spsv ?n ?up ?ipiv ?ofsap ap ?nrhs ?br ?bc b] computes the solution to the + real system of linear equations [a] * X = [b], where [a] is an [n]-by-[n] + symmetric matrix stored in packed format and X and [b] are [n]-by-[nrhs] + matrices. The diagonal pivoting method is used to factor [a] as [a] = U * D + * U**T, if [up = true], or [a] = L * D * L**T, if [up = false], where U (or + L) is a product of permutation and unit upper (lower) triangular matrices, D + is symmetric and block diagonal with 1-by-1 and 2-by-2 diagonal blocks. The + factored form of [a] is then used to solve the system of equations [a] * X = + [b]. @raise Failure if the matrix is singular. @param n default = the greater n s.t. n(n+1)/2 <= [Vec.dim ap] @@ -1344,25 +1227,24 @@ val spsv : @param br default = 1 @param bc default = 1 *) - (** {7 Least squares (simple drivers)} *) -val gels_min_lwork : m : int -> n : int -> nrhs : int -> int +val gels_min_lwork : m:int -> n:int -> nrhs:int -> int (** [gels_min_lwork ~m ~n ~nrhs] @return the minimum length of the work-array used by the [gels]-function if the logical dimensions of the matrix are [m] rows and [n] columns and if there are [nrhs] right hand side vectors. *) val gels_opt_lwork : - ?m : int -> - ?n : int -> - ?trans : trans2 -> - ?ar : int -> - ?ac : int -> + ?m:int -> + ?n:int -> + ?trans:trans2 -> + ?ar:int -> + ?ac:int -> mat -> - ?nrhs : int -> - ?br : int -> - ?bc : int -> + ?nrhs:int -> + ?br:int -> + ?bc:int -> mat -> int (** [gels_opt_lwork ?m ?n ?trans ?ar ?ac a ?nrhs ?br ?bc b] @return @@ -1379,20 +1261,20 @@ val gels_opt_lwork : @param bc default = 1 *) val gels : - ?m : int -> - ?n : int -> - ?work : vec -> - ?trans : trans2 -> - ?ar : int -> - ?ac : int -> + ?m:int -> + ?n:int -> + ?work:vec -> + ?trans:trans2 -> + ?ar:int -> + ?ac:int -> mat -> - ?nrhs : int -> - ?br : int -> - ?bc : int -> + ?nrhs:int -> + ?br:int -> + ?bc:int -> mat -> unit -(** [gels ?m ?n ?work ?trans ?ar ?ac a ?nrhs ?br ?bc b] see - LAPACK documentation! +(** [gels ?m ?n ?work ?trans ?ar ?ac a ?nrhs ?br ?bc b] see LAPACK + documentation! @param m default = available number of rows in matrix [a] @param n default = available number of columns of matrix [a] @param work default = vec of optimum length (-> {!gels_opt_lwork}) diff --git a/src/impl_c.c b/src/impl_c.c index 6759e66..9600776 100644 --- a/src/impl_c.c +++ b/src/impl_c.c @@ -1,10 +1,8 @@ /* File: impl_c.c - Copyright (C) 2001- + Copyright © 2001- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public @@ -18,30 +16,23 @@ You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "lacaml_macros.h" /** ILAENV: fetch problem-dependent parameters for LAPACK-functions */ -extern integer ilaenv_( - integer *ISPEC, char *NAME, char *OPTS, - integer *N1, integer *N2, integer *N3, integer *N4, - ftnlen name_len, ftnlen opts_len); +extern integer ilaenv_(integer *ISPEC, char *NAME, char *OPTS, integer *N1, + integer *N2, integer *N3, integer *N4, ftnlen name_len, + ftnlen opts_len); -CAMLprim intnat lacaml_ilaenv_stub( - intnat vISPEC, value vNAME, value vOPTS, - intnat vN1, intnat vN2, intnat vN3, intnat vN4) -{ - integer GET_INT(ISPEC), - GET_INT(N1), - GET_INT(N2), - GET_INT(N3), - GET_INT(N4); +CAMLprim intnat lacaml_ilaenv_stub(intnat vISPEC, value vNAME, value vOPTS, + intnat vN1, intnat vN2, intnat vN3, + intnat vN4) { + integer GET_INT(ISPEC), GET_INT(N1), GET_INT(N2), GET_INT(N3), GET_INT(N4); - char *NAME = (char *) String_val(vNAME), - *OPTS = (char *) String_val(vOPTS); + char *NAME = (char *)String_val(vNAME), *OPTS = (char *)String_val(vOPTS); ftnlen NAME_LEN = caml_string_length(vNAME), OPTS_LEN = caml_string_length(vOPTS); @@ -49,16 +40,8 @@ CAMLprim intnat lacaml_ilaenv_stub( return ilaenv_(&ISPEC, NAME, OPTS, &N1, &N2, &N3, &N4, NAME_LEN, OPTS_LEN); } -CAMLprim value lacaml_ilaenv_stub_bc(value *argv, int __unused argn) -{ - return - Val_int ( - lacaml_ilaenv_stub( - Int_val(argv[0]), - argv[1], - argv[2], - Int_val(argv[3]), - Int_val(argv[4]), - Int_val(argv[5]), - Int_val(argv[6]))); +CAMLprim value lacaml_ilaenv_stub_bc(value *argv, int __unused argn) { + return Val_int(lacaml_ilaenv_stub(Int_val(argv[0]), argv[1], argv[2], + Int_val(argv[3]), Int_val(argv[4]), + Int_val(argv[5]), Int_val(argv[6]))); } diff --git a/src/io.ml b/src/io.ml index f28e592..b687cfd 100644 --- a/src/io.ml +++ b/src/io.ml @@ -1,30 +1,24 @@ (* File: io.ml - Copyright (C) 2005- + Copyright © 2005- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - Jane Street Holding, LLC - Author: Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Jane Street Holding, LLC - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) open Format open Bigarray @@ -32,12 +26,10 @@ open Complex let from_col_vec v = reshape_2 (genarray_of_array1 v) (Array1.dim v) 1 let from_row_vec v = reshape_2 (genarray_of_array1 v) 1 (Array1.dim v) - let pp_open ppf = pp_open_box ppf 0 let pp_close ppf = pp_close_box ppf () let pp_newline ppf = pp_force_newline ppf () let pp_space ppf = pp_print_string ppf " " - let pp_end_row_newline ppf _ = pp_newline ppf let pp_end_row_space ppf _ = pp_space ppf let pp_end_col_space ppf ~row:_ ~col:_ = pp_space ppf @@ -60,7 +52,7 @@ let extract_buf buf buf_ppf = pp_print_flush buf_ppf (); let str = Buffer.contents buf in Buffer.clear buf; - str, String.length str + (str, String.length str) let pp_el_buf pp_el buf buf_ppf el = pp_el buf_ppf el; @@ -75,41 +67,29 @@ let ignore2 _ _ = () module Context = struct type t = int - let create n = - if n < 1 then failwith "Lacaml.Io.Context.create: n < 1" - else n - + let create n = if n < 1 then failwith "Lacaml.Io.Context.create: n < 1" else n let ellipsis_default = ref "..." let vertical_default, horizontal_default = let context = if !Sys.interactive then Some 3 else None in - ref context, ref context + (ref context, ref context) let set_dim_defaults opt_n = vertical_default := opt_n; horizontal_default := opt_n let get_disp real = function - | None -> real, real - | Some virt -> min real (2 * virt), virt + | None -> (real, real) + | Some virt -> (min real (2 * virt), virt) end -let pp_mat_gen - ?(pp_open = pp_open) - ?(pp_close = pp_close) - ?pp_head - ?pp_foot - ?(pp_end_row = pp_end_row_newline) - ?(pp_end_col = pp_end_col_space) - ?pp_left - ?pp_right - ?(pad = some_space) - ?(ellipsis = !Context.ellipsis_default) +let pp_mat_gen ?(pp_open = pp_open) ?(pp_close = pp_close) ?pp_head ?pp_foot + ?(pp_end_row = pp_end_row_newline) ?(pp_end_col = pp_end_col_space) ?pp_left + ?pp_right ?(pad = some_space) ?(ellipsis = !Context.ellipsis_default) ?(vertical_context = !Context.vertical_default) - ?(horizontal_context = !Context.horizontal_default) - pp_el ppf mat = + ?(horizontal_context = !Context.horizontal_default) pp_el ppf mat = let m = Array2.dim1 mat in - if m > 0 then ( + if m > 0 then let n = Array2.dim2 mat in if n > 0 then ( let disp_m, vertical_context = Context.get_disp m vertical_context in @@ -121,12 +101,13 @@ let pp_mat_gen | Some pp_right -> let buf = Buffer.create 32 in let buf_ppf = formatter_of_buffer buf in - (fun ppf row -> + fun ppf row -> let str, n_str = - pp_buf (fun ppf -> pp_right ppf row) buf buf_ppf in + pp_buf (fun ppf -> pp_right ppf row) buf buf_ppf + in if n_str <> 0 then ( pp_end_col ppf ~row ~col:n; - pp_print_string ppf str)) + pp_print_string ppf str) in let has_ver = disp_m < m in let ver_stop = if has_ver then vertical_context - 1 else m - 1 in @@ -137,20 +118,19 @@ let pp_mat_gen let src_row_ofs = m - vertical_context + 1 in let dst_row_ofs = vertical_context in let gen_fmt_row_body ~pp_nth ?(ellipsis = ellipsis) - ?(dst_col_ofs = dst_col_ofs) src_r = + ?(dst_col_ofs = dst_col_ofs) src_r = pp_nth 0; for c = 1 to hor_stop do pp_end_col ppf ~row:src_r ~col:c; - pp_nth c; + pp_nth c done; - if has_hor then begin + if has_hor then ( pp_end_col ppf ~row:src_r ~col:horizontal_context; pp_print_string ppf ellipsis; for c = 0 to horizontal_context - 1 do pp_end_col ppf ~row:src_r ~col:(src_col_ofs + c); pp_nth (dst_col_ofs + c) - done - end + done) in let fmt_label ~src_r label = pp_print_string ppf label; @@ -172,25 +152,26 @@ let pp_mat_gen in let dst_ofs_c = dst_ofs + c in heads_foots.(dst_ofs_c) <- head_foot; - max_lens.(dst_ofs_c) <- max max_lens.(dst_ofs_c) head_foot_len; + max_lens.(dst_ofs_c) <- max max_lens.(dst_ofs_c) head_foot_len in - for c = 0 to hor_stop do fmt_col ~src_ofs:1 ~dst_ofs:0 c done; - if has_hor then begin - let src_ofs = n - horizontal_context + 1 in - let dst_ofs = horizontal_context in - for c = 0 to horizontal_context - 1 do - fmt_col ~src_ofs ~dst_ofs c - done; - end; + for c = 0 to hor_stop do + fmt_col ~src_ofs:1 ~dst_ofs:0 c + done; + (if has_hor then + let src_ofs = n - horizontal_context + 1 in + let dst_ofs = horizontal_context in + for c = 0 to horizontal_context - 1 do + fmt_col ~src_ofs ~dst_ofs c + done); heads_foots in let heads, foots = - match pp_head, pp_foot with - | None, None -> [||], [||] - | Some pp_head, None -> fmt_head_foot pp_head, [||] - | None, Some pp_foot -> [||], fmt_head_foot pp_foot + match (pp_head, pp_foot) with + | None, None -> ([||], [||]) + | Some pp_head, None -> (fmt_head_foot pp_head, [||]) + | None, Some pp_foot -> ([||], fmt_head_foot pp_foot) | Some pp_head, Some pp_foot -> - fmt_head_foot pp_head, fmt_head_foot pp_foot + (fmt_head_foot pp_head, fmt_head_foot pp_foot) in let many_strs = Array.make_matrix disp_m disp_n "" in let fmt_strs ~src_row_ofs ~dst_row_ofs r = @@ -207,23 +188,21 @@ let pp_mat_gen for c = 0 to hor_stop do fmt_col ~src_col_ofs:1 ~dst_col_ofs:0 c done; - if has_hor then begin + if has_hor then for c = 0 to horizontal_context - 1 do fmt_col ~src_col_ofs ~dst_col_ofs c done - end in for r = 0 to ver_stop do fmt_strs ~src_row_ofs:1 ~dst_row_ofs:0 r done; - if has_ver then begin + if has_ver then for r = 0 to vertical_context - 1 do fmt_strs ~src_row_ofs ~dst_row_ofs r - done - end; + done; let head_label, row_labels, foot_label = match pp_left with - | None -> "", [||], "" + | None -> ("", [||], "") | Some pp_left -> let max_len_row_labels_ref = ref 0 in let row_labels = Array.make disp_m "" in @@ -250,7 +229,7 @@ let pp_mat_gen in let padded_head0 = pad_str pad_c max_len_row_labels head0 in let padded_foot0 = pad_str pad_c max_len_row_labels foot0 in - padded_head0, padded_row_labels, padded_foot0 + (padded_head0, padded_row_labels, padded_foot0) in let fmt_row_body ?ellipsis ~src_r row = let pp_nth c = pp_padded_str ppf pad_c max_lens.(c) row.(c) in @@ -266,37 +245,36 @@ let pp_mat_gen in let head_foot_ellipsis = String.make (String.length ellipsis) pad_c in if pp_head <> None then ( - fmt_row_label - ~ellipsis:head_foot_ellipsis ~src_r:0 heads head_label; - do_pp_right ppf 0; + fmt_row_label ~ellipsis:head_foot_ellipsis ~src_r:0 heads head_label; + do_pp_right ppf 0; pp_end_row ppf 0); fmt_row_labels ~src_r:1 many_strs row_labels 0; for r = 1 to ver_stop do pp_end_row ppf r; let src_r = r + 1 in fmt_row_labels ~src_r many_strs row_labels r; - do_pp_right ppf src_r; + do_pp_right ppf src_r done; - if has_ver then begin + if has_ver then ( pp_end_row ppf vertical_context; let v1 = vertical_context + 1 in - fmt_row_label ~src_r:v1 (Array.make disp_n ellipsis) + fmt_row_label ~src_r:v1 + (Array.make disp_n ellipsis) (String.make (String.length head_label) pad_c); for r = 0 to vertical_context - 1 do let src_r = src_row_ofs + r in pp_end_row ppf (src_r - 1); let dst_r = dst_row_ofs + r in fmt_row_labels ~src_r many_strs row_labels dst_r; - do_pp_right ppf src_r; - done; - end; + do_pp_right ppf src_r + done); if pp_foot <> None then ( pp_end_row ppf m; let m1 = m + 1 in - fmt_row_label - ~ellipsis:head_foot_ellipsis ~src_r:m1 foots foot_label; + fmt_row_label ~ellipsis:head_foot_ellipsis ~src_r:m1 foots + foot_label; do_pp_right ppf m1) - | None -> + | None -> ( let maybe_pp_label row = match pp_left with | None -> () @@ -323,29 +301,27 @@ let pp_mat_gen for r = 0 to ver_stop do let src_r = r + 1 in fmt_row_body src_r; - do_pp_right ppf src_r; + do_pp_right ppf src_r done; - if has_ver then begin + if has_ver then ( pp_end_row ppf vertical_context; let v1 = vertical_context + 1 in for c = 0 to horizontal_context - 1 do pp_print_string ppf ellipsis; - pp_end_col ppf ~row:v1 ~col:(src_col_ofs + c); + pp_end_col ppf ~row:v1 ~col:(src_col_ofs + c) done; for r = 0 to vertical_context - 1 do let src_r = src_row_ofs + r in pp_end_row ppf (src_r - 1); fmt_row_body src_r; - do_pp_right ppf src_r; - done; - end; + do_pp_right ppf src_r + done); match pp_foot with | None -> () | Some pp_foot -> pp_end_row ppf m; - fmt_head_foot ~src_r:(m + 1) pp_foot); - pp_close ppf)) - + fmt_head_foot ~src_r:(m + 1) pp_foot)); + pp_close ppf) (* Pretty-printing elements *) @@ -353,24 +329,18 @@ type 'el pp_el_default = (formatter -> 'el -> unit) ref let pp_float_el_default_fun ppf el = fprintf ppf "%G" el let pp_float_el_default = ref pp_float_el_default_fun - let pp_complex_el_default_fun ppf el = fprintf ppf "(%G, %Gi)" el.re el.im let pp_complex_el_default = ref pp_complex_el_default_fun - let pp_float_el ppf el = !pp_float_el_default ppf el let pp_complex_el ppf el = !pp_complex_el_default ppf el - let pp_int32_el ppf n = fprintf ppf "%ld" n - (* Pretty-printing in standard style *) (* Vectors *) type ('el, 'elt) pp_vec = - formatter -> - ('el, 'elt, fortran_layout) Array1.t - -> unit + formatter -> ('el, 'elt, fortran_layout) Array1.t -> unit let pp_fvec ppf vec = pp_mat_gen pp_float_el ppf (from_col_vec vec) let pp_cvec ppf vec = pp_mat_gen pp_complex_el ppf (from_col_vec vec) @@ -391,55 +361,52 @@ let pp_rivec ppf vec = (* Matrices *) type ('el, 'elt) pp_mat = - formatter -> - ('el, 'elt, fortran_layout) Array2.t - -> unit + formatter -> ('el, 'elt, fortran_layout) Array2.t -> unit let pp_fmat ppf mat = pp_mat_gen pp_float_el ppf mat let pp_cmat ppf mat = pp_mat_gen pp_complex_el ppf mat let pp_imat ppf mat = pp_mat_gen pp_int32_el ppf mat - (* Labeled pretty-printing *) (* Labeled matrices *) type ('el, 'elt) pp_labeled_mat = - ?pp_head : (formatter -> int -> unit) option -> - ?pp_foot : (formatter -> int -> unit) option -> - ?pp_left : (formatter -> int -> unit) option -> - ?pp_right : (formatter -> int -> unit) option -> - ?pad : char option -> - ?ellipsis : string -> - ?vertical_context : Context.t option -> - ?horizontal_context : Context.t option -> + ?pp_head:(formatter -> int -> unit) option -> + ?pp_foot:(formatter -> int -> unit) option -> + ?pp_left:(formatter -> int -> unit) option -> + ?pp_right:(formatter -> int -> unit) option -> + ?pad:char option -> + ?ellipsis:string -> + ?vertical_context:Context.t option -> + ?horizontal_context:Context.t option -> unit -> formatter -> - ('el, 'elt, fortran_layout) Array2.t - -> unit + ('el, 'elt, fortran_layout) Array2.t -> + unit let get_pp_head_foot_mat = function | None -> Some pp_print_int | Some pp_head -> pp_head let get_some_pp_left_right m = - Some (fun ppf row_col -> - if row_col > 0 && row_col <= m then pp_print_int ppf row_col) + Some + (fun ppf row_col -> + if row_col > 0 && row_col <= m then pp_print_int ppf row_col) let get_pp_left_right m = function | None -> get_some_pp_left_right m | Some pp_left -> pp_left -let pp_labeled_mat_gen - pp_el ?pp_head ?pp_foot ?pp_left ?pp_right ?pad - ?ellipsis ?vertical_context ?horizontal_context () ppf mat = +let pp_labeled_mat_gen pp_el ?pp_head ?pp_foot ?pp_left ?pp_right ?pad ?ellipsis + ?vertical_context ?horizontal_context () ppf mat = let pp_head = get_pp_head_foot_mat pp_head in let pp_foot = get_pp_head_foot_mat pp_foot in let m = Array2.dim1 mat in let pp_left = get_pp_left_right m pp_left in let pp_right = get_pp_left_right m pp_right in - pp_mat_gen ?pp_head ?pp_foot ?pp_left ?pp_right ?pad - ?ellipsis ?vertical_context ?horizontal_context pp_el ppf mat + pp_mat_gen ?pp_head ?pp_foot ?pp_left ?pp_right ?pad ?ellipsis + ?vertical_context ?horizontal_context pp_el ppf mat let pp_labeled_fmat ?pp_head = pp_labeled_mat_gen pp_float_el ?pp_head let pp_labeled_cmat ?pp_head = pp_labeled_mat_gen pp_complex_el ?pp_head @@ -448,67 +415,60 @@ let pp_labeled_imat ?pp_head = pp_labeled_mat_gen pp_int32_el ?pp_head (* String-labeled matrices *) type ('el, 'elt) pp_lmat = - ?print_head : bool -> - ?print_foot : bool -> - ?print_left : bool -> - ?print_right : bool -> - ?row_labels : string array -> - ?col_labels : string array -> - ?pad : char option -> - ?ellipsis : string -> - ?vertical_context : Context.t option -> - ?horizontal_context : Context.t option -> + ?print_head:bool -> + ?print_foot:bool -> + ?print_left:bool -> + ?print_right:bool -> + ?row_labels:string array -> + ?col_labels:string array -> + ?pad:char option -> + ?ellipsis:string -> + ?vertical_context:Context.t option -> + ?horizontal_context:Context.t option -> unit -> formatter -> - ('el, 'elt, fortran_layout) Array2.t - -> unit + ('el, 'elt, fortran_layout) Array2.t -> + unit let get_some_pp_head_foot_mat col_labels = Some (fun ppf col -> pp_print_string ppf col_labels.(col - 1)) let get_pp_left_right_mat print m row_labels = if print then - Some (fun ppf row -> - if row > 0 && row <= m then pp_print_string ppf row_labels.(row - 1)) + Some + (fun ppf row -> + if row > 0 && row <= m then pp_print_string ppf row_labels.(row - 1)) else None -let pp_lmat_gen - (pp_labeled_mat : ('el, 'elt) pp_labeled_mat) - ?(print_head = true) - ?(print_foot = true) - ?(print_left = true) - ?(print_right = true) - ?row_labels - ?col_labels - ?pad - ?ellipsis ?vertical_context ?horizontal_context - () ppf mat = +let pp_lmat_gen (pp_labeled_mat : ('el, 'elt) pp_labeled_mat) + ?(print_head = true) ?(print_foot = true) ?(print_left = true) + ?(print_right = true) ?row_labels ?col_labels ?pad ?ellipsis + ?vertical_context ?horizontal_context () ppf mat = let pp_head, pp_foot = match col_labels with | Some col_labels when print_head -> if Array.length col_labels <> Array2.dim2 mat then - invalid_arg - "Io.pp_lmat_gen: dim(col_labels) <> dim2(mat)"; + invalid_arg "Io.pp_lmat_gen: dim(col_labels) <> dim2(mat)"; let pp_head = get_some_pp_head_foot_mat col_labels in let pp_foot = if print_foot then pp_head else None in - pp_head, pp_foot + (pp_head, pp_foot) | Some col_labels when print_foot -> - None, get_some_pp_head_foot_mat col_labels - | _ -> None, None in + (None, get_some_pp_head_foot_mat col_labels) + | _ -> (None, None) + in let pp_left, pp_right = match row_labels with | Some row_labels -> let m = Array2.dim1 mat in if Array.length row_labels <> m then - invalid_arg - "Io.pp_lmat_gen: dim(row_labels) <> dim1(mat)"; + invalid_arg "Io.pp_lmat_gen: dim(row_labels) <> dim1(mat)"; let pp_left = get_pp_left_right_mat print_left m row_labels in let pp_right = get_pp_left_right_mat print_right m row_labels in - pp_left, pp_right - | None -> None, None in - pp_labeled_mat - ~pp_head ~pp_foot ~pp_left ~pp_right ?pad - ?ellipsis ?vertical_context ?horizontal_context () ppf mat + (pp_left, pp_right) + | None -> (None, None) + in + pp_labeled_mat ~pp_head ~pp_foot ~pp_left ~pp_right ?pad ?ellipsis + ?vertical_context ?horizontal_context () ppf mat let pp_lfmat ?print_head = pp_lmat_gen pp_labeled_fmat ?print_head let pp_lcmat ?print_head = pp_lmat_gen pp_labeled_cmat ?print_head @@ -517,61 +477,52 @@ let pp_limat ?print_head = pp_lmat_gen pp_labeled_imat ?print_head (* Labeled vectors *) type ('el, 'elt) pp_labeled_vec = - ?pp_head : (formatter -> int -> unit) -> - ?pp_foot : (formatter -> int -> unit) -> - ?pp_left : (formatter -> int -> unit) option -> - ?pp_right : (formatter -> int -> unit) -> - ?pad : char option -> - ?ellipsis : string -> - ?vertical_context : Context.t option -> - ?horizontal_context : Context.t option -> + ?pp_head:(formatter -> int -> unit) -> + ?pp_foot:(formatter -> int -> unit) -> + ?pp_left:(formatter -> int -> unit) option -> + ?pp_right:(formatter -> int -> unit) -> + ?pad:char option -> + ?ellipsis:string -> + ?vertical_context:Context.t option -> + ?horizontal_context:Context.t option -> unit -> formatter -> - ('el, 'elt, fortran_layout) Array1.t - -> unit + ('el, 'elt, fortran_layout) Array1.t -> + unit -let pp_labeled_vec_gen - pp_el ?pp_head ?pp_foot ?pp_left ?pp_right ?pad - ?ellipsis ?vertical_context ?horizontal_context - () ppf vec = +let pp_labeled_vec_gen pp_el ?pp_head ?pp_foot ?pp_left ?pp_right ?pad ?ellipsis + ?vertical_context ?horizontal_context () ppf vec = let m = Array1.dim vec in let pp_left = match pp_left with | None -> get_some_pp_left_right m | Some None -> None - | Some (Some pp_left) -> Some pp_left in + | Some (Some pp_left) -> Some pp_left + in let mat = from_col_vec vec in - pp_mat_gen ?pp_head ?pp_foot ?pp_left ?pp_right ?pad - ?ellipsis ?vertical_context ?horizontal_context - pp_el ppf mat + pp_mat_gen ?pp_head ?pp_foot ?pp_left ?pp_right ?pad ?ellipsis + ?vertical_context ?horizontal_context pp_el ppf mat let pp_labeled_fvec ?pp_head = pp_labeled_vec_gen pp_float_el ?pp_head let pp_labeled_cvec ?pp_head = pp_labeled_vec_gen pp_complex_el ?pp_head let pp_labeled_ivec ?pp_head = pp_labeled_vec_gen pp_int32_el ?pp_head - let some_pp_print_int = Some pp_print_int -let pp_labeled_rvec_gen - pp_el - ?pp_head:this_pp_head - ?pp_foot:this_pp_foot - ?pp_left:this_pp_left - ?pp_right:this_pp_right - ?pad - ?ellipsis ?vertical_context ?horizontal_context - () ppf vec = +let pp_labeled_rvec_gen pp_el ?pp_head:this_pp_head ?pp_foot:this_pp_foot + ?pp_left:this_pp_left ?pp_right:this_pp_right ?pad ?ellipsis + ?vertical_context ?horizontal_context () ppf vec = let pp_head = match this_pp_left with | None -> some_pp_print_int | Some None -> None - | Some (Some this_pp_left) -> Some this_pp_left in + | Some (Some this_pp_left) -> Some this_pp_left + in let pp_foot = this_pp_right in let pp_left = this_pp_head in let pp_right = this_pp_foot in let mat = from_row_vec vec in - pp_mat_gen ?pp_head ?pp_foot ?pp_left ?pp_right ?pad - ?ellipsis ?vertical_context ?horizontal_context - pp_el ppf mat + pp_mat_gen ?pp_head ?pp_foot ?pp_left ?pp_right ?pad ?ellipsis + ?vertical_context ?horizontal_context pp_el ppf mat let pp_labeled_rfvec ?pp_head = pp_labeled_rvec_gen pp_float_el ?pp_head let pp_labeled_rcvec ?pp_head = pp_labeled_rvec_gen pp_complex_el ?pp_head @@ -580,67 +531,53 @@ let pp_labeled_rivec ?pp_head = pp_labeled_rvec_gen pp_int32_el ?pp_head (* String-labeled vectors *) type ('el, 'elt) pp_lvec = - ?print_head : bool -> - ?print_foot : bool -> - ?print_left : bool -> - ?print_right : bool -> - ?labels : string array -> - ?name : string -> - ?pad : char option -> - ?ellipsis : string -> - ?vertical_context : Context.t option -> - ?horizontal_context : Context.t option -> + ?print_head:bool -> + ?print_foot:bool -> + ?print_left:bool -> + ?print_right:bool -> + ?labels:string array -> + ?name:string -> + ?pad:char option -> + ?ellipsis:string -> + ?vertical_context:Context.t option -> + ?horizontal_context:Context.t option -> unit -> formatter -> - ('el, 'elt, fortran_layout) Array1.t - -> unit - -let get_lvec_name = function - | None -> None - | Some name -> Some [| name |] - -let pp_lvec_gen - (pp_lmat : ('el, 'elt) pp_lmat) - ?print_head ?print_foot ?print_left ?(print_right = false) - ?labels:row_labels ?name ?pad - ?ellipsis ?vertical_context ?horizontal_context - () ppf vec = + ('el, 'elt, fortran_layout) Array1.t -> + unit + +let get_lvec_name = function None -> None | Some name -> Some [| name |] + +let pp_lvec_gen (pp_lmat : ('el, 'elt) pp_lmat) ?print_head ?print_foot + ?print_left ?(print_right = false) ?labels:row_labels ?name ?pad ?ellipsis + ?vertical_context ?horizontal_context () ppf vec = let mat = from_col_vec vec in let col_labels = get_lvec_name name in - pp_lmat - ?print_head ?print_foot ?print_left ~print_right - ?row_labels ?col_labels ?pad ?ellipsis ?vertical_context - ?horizontal_context () ppf mat + pp_lmat ?print_head ?print_foot ?print_left ~print_right ?row_labels + ?col_labels ?pad ?ellipsis ?vertical_context ?horizontal_context () ppf mat let pp_lfvec ?print_head = pp_lvec_gen pp_lfmat ?print_head let pp_lcvec ?print_head = pp_lvec_gen pp_lcmat ?print_head let pp_livec ?print_head = pp_lvec_gen pp_limat ?print_head -let pp_rlvec_gen - (pp_lmat : ('el, 'elt) pp_lmat) - ?print_head:print_left - ?print_foot:print_right - ?print_left:print_head - ?print_right:this_print_right - ?labels:col_labels ?name ?pad - ?ellipsis ?vertical_context ?horizontal_context - () ppf vec = +let pp_rlvec_gen (pp_lmat : ('el, 'elt) pp_lmat) ?print_head:print_left + ?print_foot:print_right ?print_left:print_head ?print_right:this_print_right + ?labels:col_labels ?name ?pad ?ellipsis ?vertical_context + ?horizontal_context () ppf vec = let mat = from_row_vec vec in let row_labels = get_lvec_name name in let print_foot = match this_print_right with | None -> false - | Some this_print_right -> this_print_right in - pp_lmat - ?print_head ~print_foot ?print_left ?print_right - ?row_labels ?col_labels ?pad - ?ellipsis ?vertical_context ?horizontal_context () ppf mat + | Some this_print_right -> this_print_right + in + pp_lmat ?print_head ~print_foot ?print_left ?print_right ?row_labels + ?col_labels ?pad ?ellipsis ?vertical_context ?horizontal_context () ppf mat let pp_rlfvec ?print_head = pp_rlvec_gen pp_lfmat ?print_head let pp_rlcvec ?print_head = pp_rlvec_gen pp_lcmat ?print_head let pp_rlivec ?print_head = pp_rlvec_gen pp_limat ?print_head - (* Pretty-printing in OCaml-style *) (* Vectors *) @@ -648,13 +585,11 @@ let pp_rlivec ?print_head = pp_rlvec_gen pp_limat ?print_head type ('el, 'elt) pp_el_ovec = formatter -> (formatter -> 'el -> unit) -> - ('el, 'elt, fortran_layout) Array1.t - -> unit + ('el, 'elt, fortran_layout) Array1.t -> + unit type ('el, 'elt) pp_ovec = - formatter -> - ('el, 'elt, fortran_layout) Array1.t - -> unit + formatter -> ('el, 'elt, fortran_layout) Array1.t -> unit let pp_ocaml_open_vec ppf = pp_open_box ppf 2; @@ -674,13 +609,8 @@ let pp_end_row_semi ppf _ = let pp_ovec ppf pp_el vec = if Array1.dim vec = 0 then pp_print_string ppf "[||]" else - pp_mat_gen - ~pp_open:pp_ocaml_open_vec - ~pp_close:pp_ocaml_close_vec - ~pp_end_row:pp_end_row_semi - pp_el - ppf - (from_col_vec vec) + pp_mat_gen ~pp_open:pp_ocaml_open_vec ~pp_close:pp_ocaml_close_vec + ~pp_end_row:pp_end_row_semi pp_el ppf (from_col_vec vec) let pp_ocaml_open_rvec ppf = pp_open_box ppf 2; @@ -695,19 +625,12 @@ let pp_end_row_semi_space ppf _ = pp_print_string ppf "; " let pp_rovec ppf pp_el vec = if Array1.dim vec = 0 then pp_print_string ppf "[||]" else - pp_mat_gen - ~pp_open:pp_ocaml_open_rvec - ~pp_close:pp_ocaml_close_rvec - ~pp_end_row:pp_end_row_semi_space - ~pad:None - pp_el - ppf - (from_col_vec vec) + pp_mat_gen ~pp_open:pp_ocaml_open_rvec ~pp_close:pp_ocaml_close_rvec + ~pp_end_row:pp_end_row_semi_space ~pad:None pp_el ppf (from_col_vec vec) let pp_ofvec ppf vec = pp_ovec ppf pp_float_el vec let pp_ocvec ppf vec = pp_ovec ppf pp_complex_el vec let pp_oivec ppf vec = pp_ovec ppf pp_int32_el vec - let pp_rofvec ppf vec = pp_rovec ppf pp_float_el vec let pp_rocvec ppf vec = pp_rovec ppf pp_complex_el vec let pp_roivec ppf vec = pp_rovec ppf pp_int32_el vec @@ -715,9 +638,7 @@ let pp_roivec ppf vec = pp_rovec ppf pp_int32_el vec (* Matrices *) type ('el, 'elt) pp_omat = - formatter -> - ('el, 'elt, fortran_layout) Array2.t - -> unit + formatter -> ('el, 'elt, fortran_layout) Array2.t -> unit let pp_ocaml_open_mat ppf = pp_open_box ppf 2; @@ -741,20 +662,14 @@ let pp_end_col_semi_space ppf ~row:_ ~col:_ = pp_print_string ppf "; " let pp_omat ppf pp_el mat = if Array2.dim1 mat = 0 || Array2.dim2 mat = 0 then pp_print_string ppf "[||]" else - pp_mat_gen - ~pp_open:pp_ocaml_open_mat - ~pp_close:pp_ocaml_close_mat - ~pp_end_row:pp_ocaml_end_row_mat - ~pp_end_col:pp_end_col_semi_space - pp_el - ppf - mat + pp_mat_gen ~pp_open:pp_ocaml_open_mat ~pp_close:pp_ocaml_close_mat + ~pp_end_row:pp_ocaml_end_row_mat ~pp_end_col:pp_end_col_semi_space pp_el + ppf mat let pp_ofmat ppf mat = pp_omat ppf pp_float_el mat let pp_ocmat ppf mat = pp_omat ppf pp_complex_el mat let pp_oimat ppf mat = pp_omat ppf pp_int32_el mat - (* Good pretty-printers for toplevels *) module Toplevel = struct @@ -785,6 +700,5 @@ module Toplevel = struct let pp_fmat ppf mat = gen_pp_mat pp_float_el ppf mat let pp_cmat ppf mat = gen_pp_mat pp_complex_el ppf mat let pp_imat ppf mat = gen_pp_mat pp_int32_el ppf mat - let lsc n = Context.set_dim_defaults (Some (Context.create n)) end diff --git a/src/io.mli b/src/io.mli index 8e0061d..8f82f81 100644 --- a/src/io.mli +++ b/src/io.mli @@ -1,26 +1,24 @@ (* File: io.mli - Copyright (C) 2005- + Copyright © 2005- - Jane Street Holding, LLC - Author: Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + Jane Street Holding, LLC - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. + + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) (** [Lacaml.Io]: generic matrix printing functions. *) @@ -31,7 +29,6 @@ module Context : sig type t val create : int -> t - val ellipsis_default : string ref (* [ellipsis_default] := "..." *) @@ -42,80 +39,77 @@ module Context : sig (* [horizontal_default] := None *) val set_dim_defaults : t option -> unit - (* [set_dim_defaults def] sets both vertical and horizontal context - default to [def]. *) + (* [set_dim_defaults def] sets both vertical and horizontal context default to + [def]. *) end val pp_mat_gen : - ?pp_open : (formatter -> unit) -> - ?pp_close : (formatter -> unit) -> - ?pp_head : (formatter -> int -> unit) -> - ?pp_foot : (formatter -> int -> unit) -> - ?pp_end_row : (formatter -> int -> unit) -> - ?pp_end_col : (formatter -> row : int -> col : int -> unit) -> - ?pp_left : (formatter -> int -> unit) -> - ?pp_right : (formatter -> int -> unit) -> - ?pad : char option -> - ?ellipsis : string -> - ?vertical_context : Context.t option -> - ?horizontal_context : Context.t option -> + ?pp_open:(formatter -> unit) -> + ?pp_close:(formatter -> unit) -> + ?pp_head:(formatter -> int -> unit) -> + ?pp_foot:(formatter -> int -> unit) -> + ?pp_end_row:(formatter -> int -> unit) -> + ?pp_end_col:(formatter -> row:int -> col:int -> unit) -> + ?pp_left:(formatter -> int -> unit) -> + ?pp_right:(formatter -> int -> unit) -> + ?pad:char option -> + ?ellipsis:string -> + ?vertical_context:Context.t option -> + ?horizontal_context:Context.t option -> (formatter -> 'el -> unit) -> formatter -> - ('el, 'a, fortran_layout) Array2.t - -> unit + ('el, 'a, fortran_layout) Array2.t -> + unit (** [pp_mat_gen ?pp_open ?pp_close ?pp_head ?pp_foot ?pp_end_row ?pp_end_col ?pp_left ?pp_right ?pad pp_el ppf mat] Generic printing of matrices (two-dimensional bigarrays). - [pp_open ppf] is called whenever printing of a matrix [mat] - is started, [pp_close ppf] whenever printing is complete. - These functions are not called when the matrix is empty. + [pp_open ppf] is called whenever printing of a matrix [mat] is started, + [pp_close ppf] whenever printing is complete. These functions are not called + when the matrix is empty. - [pp_head other_ppf col] is used to print a header for column [col] - in matrix [mat]. This header is right-aligned and eventually padded - using [Some pad]-character to match the matrix rows in the column - beneath. The passed formatter [other_ppf] is not identical to [ppf]! + [pp_head other_ppf col] is used to print a header for column [col] in matrix + [mat]. This header is right-aligned and eventually padded using + [Some pad]-character to match the matrix rows in the column beneath. The + passed formatter [other_ppf] is not identical to [ppf]! - [pp_foot other_ppf col] is used to print a footer for column [col] - in matrix [mat]. It is similar to [pp_head col other_ppf] otherwise. + [pp_foot other_ppf col] is used to print a footer for column [col] in matrix + [mat]. It is similar to [pp_head col other_ppf] otherwise. - [pp_end_row ppf row] is called on row number [row] and formatter - [ppf] whenever the end of a row has been reached. + [pp_end_row ppf row] is called on row number [row] and formatter [ppf] + whenever the end of a row has been reached. - [pp_end_col ppf ~row ~col] is called on the row number [row], column - number [col] and formatter [ppf] whenever the element at this position - has been printed and if it is not the last element in the row. + [pp_end_col ppf ~row ~col] is called on the row number [row], column number + [col] and formatter [ppf] whenever the element at this position has been + printed and if it is not the last element in the row. - [pp_left ppf row] is called on row number [row] and formatter - [ppf] to print labels to the left of each row. The labels are - right-aligned within a virtual column. + [pp_left ppf row] is called on row number [row] and formatter [ppf] to print + labels to the left of each row. The labels are right-aligned within a + virtual column. - [pp_right ppf row] is called on row number [row] and formatter - [ppf] to print labels to the right of each row. The labels are - left-aligned. + [pp_right ppf row] is called on row number [row] and formatter [ppf] to + print labels to the right of each row. The labels are left-aligned. - The character [pad] is used to pad matrix elements for right-aligning - them appropriately. If it is set to [None], no alignment will - be performed. + The character [pad] is used to pad matrix elements for right-aligning them + appropriately. If it is set to [None], no alignment will be performed. - [ellipsis] is used as a filler when elements need to be skipped in - the case of printing with contexts. + [ellipsis] is used as a filler when elements need to be skipped in the case + of printing with contexts. - [vertical_context] determines the number of initial and final - rows to be printed. Intermediate row will be skipped, and one row - containing ellipsis elements will be printed in their place instead. - [None] chooses no context, [Some v] sets the vertical context to [v]. + [vertical_context] determines the number of initial and final rows to be + printed. Intermediate row will be skipped, and one row containing ellipsis + elements will be printed in their place instead. [None] chooses no context, + [Some v] sets the vertical context to [v]. - [horizontal_context] determines the number of initial and final - columns to be printed. Intermediate columns will be skipped, - and one columns containing ellipsis elements will be printed in - their place instead. [None] chooses no context, [Some h] sets the - horizontal context to [h]. + [horizontal_context] determines the number of initial and final columns to + be printed. Intermediate columns will be skipped, and one columns containing + ellipsis elements will be printed in their place instead. [None] chooses no + context, [Some h] sets the horizontal context to [h]. - [pp_el other_ppf el] is called on formatter [other_ppf] (not - [ppf]!) and each matrix element. + [pp_el other_ppf el] is called on formatter [other_ppf] (not [ppf]!) and + each matrix element. [ppf] is the formatter to which all output is finally printed. @@ -131,14 +125,12 @@ val pp_mat_gen : @param pad default = [Some ' '] @param ellipsis default = [!Context.ellipsis] @param vertical_context default = [Some !Context.vertical_default] - @param horizontal_context default = [Some !Context.horizontal_default] -*) - + @param horizontal_context default = [Some !Context.horizontal_default] *) (** {6 Default pretty-printers used by the other pretty-printing functions} *) -(** Type of references for default printers of elements *) type 'el pp_el_default = (formatter -> 'el -> unit) ref +(** Type of references for default printers of elements *) val pp_float_el_default : float pp_el_default (** fprintf ppf "%G" el *) @@ -149,16 +141,13 @@ val pp_complex_el_default : Complex.t pp_el_default val pp_int32_el : formatter -> int32 -> unit (** fprintf ppf "%ld" el *) - (** {6 Pretty-printing in standard style} *) (** Type of standard pretty-printers for column vectors *) type ('el, 'elt) pp_vec = - formatter -> - ('el, 'elt, fortran_layout) Array1.t - -> unit -(** [pp_vec ppf vec] prints a vector [vec] to formatter [ppf] - using the defaults. *) + formatter -> ('el, 'elt, fortran_layout) Array1.t -> unit +(** [pp_vec ppf vec] prints a vector [vec] to formatter [ppf] using the + defaults. *) val pp_fvec : (float, 'elt) pp_vec val pp_cvec : (Complex.t, 'elt) pp_vec @@ -169,9 +158,7 @@ val pp_rivec : (int32, 'elt) pp_vec (** Type of standard pretty-printers for matrices *) type ('el, 'elt) pp_mat = - formatter -> - ('el, 'elt, fortran_layout) Array2.t - -> unit + formatter -> ('el, 'elt, fortran_layout) Array2.t -> unit (** [pp_mat ppf mat] prints a matrix [mat] to formatter [ppf] using the defaults. *) @@ -179,42 +166,40 @@ val pp_fmat : (float, 'elt) pp_mat val pp_cmat : (Complex.t, 'elt) pp_mat val pp_imat : (int32, 'elt) pp_mat - (** {7 Labeled pretty-printing} *) (** {8 Vectors} *) (** Type of pretty-printers for labeled vectors *) type ('el, 'elt) pp_labeled_vec = - ?pp_head : (formatter -> int -> unit) -> - ?pp_foot : (formatter -> int -> unit) -> - ?pp_left : (formatter -> int -> unit) option -> - ?pp_right : (formatter -> int -> unit) -> - ?pad : char option -> - ?ellipsis : string -> - ?vertical_context : Context.t option -> - ?horizontal_context : Context.t option -> + ?pp_head:(formatter -> int -> unit) -> + ?pp_foot:(formatter -> int -> unit) -> + ?pp_left:(formatter -> int -> unit) option -> + ?pp_right:(formatter -> int -> unit) -> + ?pad:char option -> + ?ellipsis:string -> + ?vertical_context:Context.t option -> + ?horizontal_context:Context.t option -> unit -> formatter -> - ('el, 'elt, fortran_layout) Array1.t - -> unit + ('el, 'elt, fortran_layout) Array1.t -> + unit (** [pp_labeled_vec ?pp_head ?pp_foot ?pp_left ?pp_right ?pad ?ellipsis ?vertical_context ?horizontal_context () ppf vec] - prints vector [vec] to formatter [ppf] labeling the header using - function [pp_head], the footer using [pp_foot], the left side (of - rows for column vectors; of columns for row vectors) using [pp_left], - and the right side using [pp_right]. A [pad]-option and context - options can be passed. + prints vector [vec] to formatter [ppf] labeling the header using function + [pp_head], the footer using [pp_foot], the left side (of rows for column + vectors; of columns for row vectors) using [pp_left], and the right side + using [pp_right]. A [pad]-option and context options can be passed. - For column vectors the labels on the left side are right-aligned - while those on the right side are left-aligned. + For column vectors the labels on the left side are right-aligned while those + on the right side are left-aligned. @param pp_head default = no default (= no printing) @param pp_foot default = no default (= no printing) - @param pp_left default = [Some pp_int32_el] for vector rows/cols - (= not in header/footer row/col) - @param pp_right default = no default (= no printing) -*) + @param pp_left + default = [Some pp_int32_el] for vector rows/cols (= not in header/footer + row/col) + @param pp_right default = no default (= no printing) *) val pp_labeled_fvec : (float, 'elt) pp_labeled_vec val pp_labeled_cvec : (Complex.t, 'elt) pp_labeled_vec @@ -225,44 +210,42 @@ val pp_labeled_rivec : (int32, 'elt) pp_labeled_vec (** Type of pretty-printers for string labeled vectors *) type ('el, 'elt) pp_lvec = - ?print_head : bool -> - ?print_foot : bool -> - ?print_left : bool -> - ?print_right : bool -> - ?labels : string array -> - ?name : string -> - ?pad : char option -> - ?ellipsis : string -> - ?vertical_context : Context.t option -> - ?horizontal_context : Context.t option -> + ?print_head:bool -> + ?print_foot:bool -> + ?print_left:bool -> + ?print_right:bool -> + ?labels:string array -> + ?name:string -> + ?pad:char option -> + ?ellipsis:string -> + ?vertical_context:Context.t option -> + ?horizontal_context:Context.t option -> unit -> formatter -> - ('el, 'elt, fortran_layout) Array1.t - -> unit + ('el, 'elt, fortran_layout) Array1.t -> + unit (** [pp_lvec ?print_head ?print_foot ?print_left ?print_right ?labels ?name ?pad ?ellipsis ?vertical_context ?horizontal_context () ppf vec] - prints vector [vec] to formatter [ppf] labeling the header with [name] - if provided and if [print_head] is true, and labeling the footer with - [name] if [print_foot] is true. The left side (of rows for column - vectors; of columns for row vectors) is labeled with [labels] if - provided and if [print_left] is true, and the right side is labeled - with [labels] if [print_right] is true. A [pad]-option and context - options can be passed. + prints vector [vec] to formatter [ppf] labeling the header with [name] if + provided and if [print_head] is true, and labeling the footer with [name] if + [print_foot] is true. The left side (of rows for column vectors; of columns + for row vectors) is labeled with [labels] if provided and if [print_left] is + true, and the right side is labeled with [labels] if [print_right] is true. + A [pad]-option and context options can be passed. - For columns vectors the labels on the left side are right-aligned - while those on the right side are left-aligned. + For columns vectors the labels on the left side are right-aligned while + those on the right side are left-aligned. - It is the duty of the user to make sure that the array containing - the labels is sufficiently large for the given vector. + It is the duty of the user to make sure that the array containing the labels + is sufficiently large for the given vector. @param print_head default = [true] @param print_foot default = [true] @param print_left default = [true] @param print_right default = [false] @param labels default = no default (= no printing) - @param header default = no default (= no printing) -*) + @param header default = no default (= no printing) *) val pp_lfvec : (float, 'elt) pp_lvec val pp_lcvec : (Complex.t, 'elt) pp_lvec @@ -271,40 +254,38 @@ val pp_rlfvec : (float, 'elt) pp_lvec val pp_rlcvec : (Complex.t, 'elt) pp_lvec val pp_rlivec : (int32, 'elt) pp_lvec - (** {8 Matrices} *) (** Type of pretty-printers for labeled matrices *) type ('el, 'elt) pp_labeled_mat = - ?pp_head : (formatter -> int -> unit) option -> - ?pp_foot : (formatter -> int -> unit) option -> - ?pp_left : (formatter -> int -> unit) option -> - ?pp_right : (formatter -> int -> unit) option -> - ?pad : char option -> - ?ellipsis : string -> - ?vertical_context : Context.t option -> - ?horizontal_context : Context.t option -> + ?pp_head:(formatter -> int -> unit) option -> + ?pp_foot:(formatter -> int -> unit) option -> + ?pp_left:(formatter -> int -> unit) option -> + ?pp_right:(formatter -> int -> unit) option -> + ?pad:char option -> + ?ellipsis:string -> + ?vertical_context:Context.t option -> + ?horizontal_context:Context.t option -> unit -> formatter -> - ('el, 'elt, fortran_layout) Array2.t - -> unit + ('el, 'elt, fortran_layout) Array2.t -> + unit (** [pp_labeled_mat ?pp_head ?pp_foot ?pp_left ?pp_right ?pad ?ellipsis ?vertical_context ?horizontal_context () ppf mat] - prints a matrix [mat] to formatter [ppf] labeling the header using - function [pp_head], the footer using [pp_foot], the left side of rows - using [pp_left], and the right one using [pp_right]. A [pad]-option - and context options can be passed. + prints a matrix [mat] to formatter [ppf] labeling the header using function + [pp_head], the footer using [pp_foot], the left side of rows using + [pp_left], and the right one using [pp_right]. A [pad]-option and context + options can be passed. - If [None] is passed as argument for the default printers, the - corresponding labels will not be printed. + If [None] is passed as argument for the default printers, the corresponding + labels will not be printed. @param pp_head default = [Some pp_int32_el] @param pp_foot default = [Some pp_int32_el] - @param pp_left default = [Some pp_int32_el] for matrix rows - (= not in header/footer row) - @param pp_right default = [Some pp_int32_el] for matrix rows - (= not in header/footer row) -*) + @param pp_left + default = [Some pp_int32_el] for matrix rows (= not in header/footer row) + @param pp_right + default = [Some pp_int32_el] for matrix rows (= not in header/footer row) *) val pp_labeled_fmat : (float, 'elt) pp_labeled_mat val pp_labeled_cmat : (Complex.t, 'elt) pp_labeled_mat @@ -312,78 +293,72 @@ val pp_labeled_imat : (int32, 'elt) pp_labeled_mat (** Type of pretty-printers for string labeled matrices *) type ('el, 'elt) pp_lmat = - ?print_head : bool -> - ?print_foot : bool -> - ?print_left : bool -> - ?print_right : bool -> - ?row_labels : string array -> - ?col_labels : string array -> - ?pad : char option -> - ?ellipsis : string -> - ?vertical_context : Context.t option -> - ?horizontal_context : Context.t option -> + ?print_head:bool -> + ?print_foot:bool -> + ?print_left:bool -> + ?print_right:bool -> + ?row_labels:string array -> + ?col_labels:string array -> + ?pad:char option -> + ?ellipsis:string -> + ?vertical_context:Context.t option -> + ?horizontal_context:Context.t option -> unit -> formatter -> - ('el, 'elt, fortran_layout) Array2.t - -> unit + ('el, 'elt, fortran_layout) Array2.t -> + unit (** [pp_lmat ?print_head ?print_foot ?print_left ?print_right ?row_labels ?col_labels ?pad ?ellipsis ?vertical_context ?horizontal_context () ppf mat] - prints a matrix [mat] to formatter [ppf] labeling the header with - the column labels in [col_labels] if provided and if [print_head] is - true, and labeling the footer with the column labels if [print_foot] - is true. The left side of rows is labeled with the row labels - [row_labels] if provided and if [print_left] is true, and the right - side of rows is labeled with the row labels if [print_right] is true. - A [pad]-option and context options can be passed. + prints a matrix [mat] to formatter [ppf] labeling the header with the column + labels in [col_labels] if provided and if [print_head] is true, and labeling + the footer with the column labels if [print_foot] is true. The left side of + rows is labeled with the row labels [row_labels] if provided and if + [print_left] is true, and the right side of rows is labeled with the row + labels if [print_right] is true. A [pad]-option and context options can be + passed. - It is the duty of the user to make sure that the arrays containing the - row- and column labels are sufficiently large for the given matrix. + It is the duty of the user to make sure that the arrays containing the row- + and column labels are sufficiently large for the given matrix. @param print_head default = [true] @param print_foot default = [true] @param print_left default = [true] @param print_right default = [true] @param row_labels default = no default (= no printing) - @param col_labels default = no default (= no printing) -*) + @param col_labels default = no default (= no printing) *) val pp_lfmat : (float, 'elt) pp_lmat val pp_lcmat : (Complex.t, 'elt) pp_lmat val pp_limat : (int32, 'elt) pp_lmat - (** {6 Pretty-printing in OCaml-style} *) (** Type of pretty-printers for OCaml-vectors *) type ('el, 'elt) pp_el_ovec = formatter -> (formatter -> 'el -> unit) -> - ('el, 'elt, fortran_layout) Array1.t - -> unit -(** [pp_el_ovec ppf pp_el vec] prints the vector [vec] to formatter - [ppf] in OCaml-style using the element printer [pp_el]. *) + ('el, 'elt, fortran_layout) Array1.t -> + unit +(** [pp_el_ovec ppf pp_el vec] prints the vector [vec] to formatter [ppf] in + OCaml-style using the element printer [pp_el]. *) val pp_ovec : ('el, 'elt) pp_el_ovec -(** [pp_ovec ppf pp_el vec] prints the column vector [vec] to formatter - [ppf] in OCaml-style using the element printer [pp_el]. *) +(** [pp_ovec ppf pp_el vec] prints the column vector [vec] to formatter [ppf] in + OCaml-style using the element printer [pp_el]. *) val pp_rovec : ('el, 'elt) pp_el_ovec -(** [pp_rovec ppf pp_el vec] prints the row vector [vec] to formatter - [ppf] in OCaml-style using the element printer [pp_el]. *) +(** [pp_rovec ppf pp_el vec] prints the row vector [vec] to formatter [ppf] in + OCaml-style using the element printer [pp_el]. *) (** Type of pretty-printers for OCaml-vectors of a given element type *) type ('el, 'elt) pp_ovec = - formatter -> - ('el, 'elt, fortran_layout) Array1.t - -> unit -(** [pp_ovec ppf vec] prints the vector [vec] to formatter [ppf] in - OCaml-style. *) + formatter -> ('el, 'elt, fortran_layout) Array1.t -> unit +(** [pp_ovec ppf vec] prints the vector [vec] to formatter [ppf] in OCaml-style. *) val pp_ofvec : (float, 'elt) pp_ovec val pp_ocvec : (Complex.t, 'elt) pp_ovec val pp_oivec : (int32, 'elt) pp_ovec - val pp_rofvec : (float, 'elt) pp_ovec val pp_rocvec : (Complex.t, 'elt) pp_ovec val pp_roivec : (int32, 'elt) pp_ovec @@ -391,34 +366,30 @@ val pp_roivec : (int32, 'elt) pp_ovec val pp_omat : formatter -> (formatter -> 'el -> unit) -> - ('el, 'c, fortran_layout) Array2.t - -> unit -(** [pp_omat ppf pp_el mat] prints matrix [mat] to formatter [ppf] - in OCaml-style using the element printer [pp_el]. *) + ('el, 'c, fortran_layout) Array2.t -> + unit +(** [pp_omat ppf pp_el mat] prints matrix [mat] to formatter [ppf] in + OCaml-style using the element printer [pp_el]. *) (** Type of pretty-printers for OCaml-matrices of a given element type *) type ('el, 'elt) pp_omat = - formatter -> - ('el, 'elt, fortran_layout) Array2.t - -> unit -(** [pp_omat ppf mat] prints the matrix [mat] to formatter [ppf] in - OCaml-style. *) + formatter -> ('el, 'elt, fortran_layout) Array2.t -> unit +(** [pp_omat ppf mat] prints the matrix [mat] to formatter [ppf] in OCaml-style. *) val pp_ofmat : (float, 'elt) pp_omat val pp_ocmat : (Complex.t, 'elt) pp_omat val pp_oimat : (int32, 'elt) pp_omat - (** {6 Good pretty-printers for toplevels} *) -(** These pretty-printers will use index labels for easier identification - of rows and columns. *) +(** These pretty-printers will use index labels for easier identification of + rows and columns. *) module Toplevel : sig val lsc : int -> unit - (* Shortcut for setting both the horizontal and vertical context. - Remember as "Lacaml set contexts". This function is automatically - bound as [lsc] in toplevels for quick access. *) + (* Shortcut for setting both the horizontal and vertical context. Remember as + "Lacaml set contexts". This function is automatically bound as [lsc] in + toplevels for quick access. *) val pp_fvec : (float, 'elt) pp_vec val pp_cvec : (Complex.t, 'elt) pp_vec @@ -426,7 +397,6 @@ module Toplevel : sig val pp_rfvec : (float, 'elt) pp_vec val pp_rcvec : (Complex.t, 'elt) pp_vec val pp_rivec : (int32, 'elt) pp_vec - val pp_fmat : (float, 'elt) pp_mat val pp_cmat : (Complex.t, 'elt) pp_mat val pp_imat : (int32, 'elt) pp_mat diff --git a/src/lacaml.ml b/src/lacaml.ml index f0aa8c6..72b005f 100644 --- a/src/lacaml.ml +++ b/src/lacaml.ml @@ -1,10 +1,7 @@ - (* Module aliases *) module Io = Io - module Common = Common module Utils = Utils - module D = D module S = S module Z = Z diff --git a/src/lacaml.pre.mli b/src/lacaml.pre.mli index 35a7872..ea3584e 100644 --- a/src/lacaml.pre.mli +++ b/src/lacaml.pre.mli @@ -1,72 +1,66 @@ -(* File: lacaml.mli -*-tuareg-*- +(* File: lacaml.mli -*-tuareg-*- - Copyright (C) 2010- + Copyright © 2010- - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umons.ac.be/an/ + Christophe Troestler - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) -(** Binding to the {{:http://www.netlib.org/blas/}BLAS} and - {{:http://www.netlib.org/lapack/}LAPACK} libraries. You can make - use of this library by referring to the corresponding module you - need for your precision and number type: +(** Binding to the {{:http://www.netlib.org/blas/} BLAS} and + {{:http://www.netlib.org/lapack/} LAPACK} libraries. You can make use of + this library by referring to the corresponding module you need for your + precision and number type: {[ - open Lacaml.S - open Lacaml.D - open Lacaml.C - open Lacaml.Z]} - - To use this library, you should be familiar with BLAS and LAPACK. The - following {{:http://www.netlib.org/blas/blasqr.ps}quick reference - guide for the BLAS} and - {{:http://www.netlib.org/lapack/lapackqref.ps}LAPACK quick - reference} may be useful to you. For the precise description of - the functions, consult the man pages - {{:http://www.math.utah.edu/software/lapack/}online} or, if you - {{:http://www.netlib.org/lapack/manpages.tgz}installed} them on - your machine (if you use Linux, they should be in the packages of - your distribution), read them with Emacs: [M-x man] (under Unix) - or [M-x woman] (all systems). - *) + open Lacaml.S + open Lacaml.D + open Lacaml.C + open Lacaml.Z + ]} + + To use this library, you should be familiar with BLAS and LAPACK. The + following + {{:http://www.netlib.org/blas/blasqr.ps} quick reference guide for the BLAS} + and {{:http://www.netlib.org/lapack/lapackqref.ps} LAPACK quick reference} + may be useful to you. For the precise description of the functions, consult + the man pages {{:http://www.math.utah.edu/software/lapack/} online} or, if + you {{:http://www.netlib.org/lapack/manpages.tgz} installed} them on your + machine (if you use Linux, they should be in the packages of your + distribution), read them with Emacs: [M-x man] (under Unix) or [M-x woman] + (all systems). *) (** {2 Pretty printing} *) -(** Pretty-printing of vector and matrices. *) module Io : module type of Io - +(** Pretty-printing of vector and matrices. *) (** {2 Precision dependent modules} *) -(** Types and functions common to all precision dependent sub-modules. *) module Common : module type of Common +(** Types and functions common to all precision dependent sub-modules. *) -(** Double precision real BLAS and LAPACK functions. *) module D : module type of D +(** Double precision real BLAS and LAPACK functions. *) -(** Single precision real BLAS and LAPACK functions. *) module S : module type of S +(** Single precision real BLAS and LAPACK functions. *) -(** Double precision complex BLAS and LAPACK functions. *) module Z : module type of Z +(** Double precision complex BLAS and LAPACK functions. *) -(** Single precision complex BLAS and LAPACK functions. *) module C : module type of C +(** Single precision complex BLAS and LAPACK functions. *) - -(** {2 Utility functions} *) module Utils : module type of Utils +(** {2 Utility functions} *) diff --git a/src/lacaml_dot_wrappers.h b/src/lacaml_dot_wrappers.h index fe9cde6..d4e8b15 100644 --- a/src/lacaml_dot_wrappers.h +++ b/src/lacaml_dot_wrappers.h @@ -1,20 +1,17 @@ /* DOTU and DOTC wrappers, due to inconsistent BLAS APIs */ #ifdef ZDOT_IS_PROCEDURE -extern void NAME( - COMPLEX *RES, +extern void NAME(COMPLEX *RES, #elif ZDOT_IS_FUNCTION extern COMPLEX NAME( #else #error "Could not detect BLAS API for complex DOT" #endif - integer *N, - COMPLEX *X, integer *INCX, - COMPLEX *Y, integer *INCY); + integer *N, COMPLEX *X, integer *INCX, COMPLEX *Y, + integer *INCY); -COMPLEX WRAPPER_NAME( - integer *N, COMPLEX *X, integer *INCX, COMPLEX *Y, integer *INCY) -{ +COMPLEX WRAPPER_NAME(integer *N, COMPLEX *X, integer *INCX, COMPLEX *Y, + integer *INCY) { #ifdef ZDOT_IS_PROCEDURE COMPLEX RES; NAME(&RES, N, X, INCX, Y, INCY); diff --git a/src/lacaml_macros.h b/src/lacaml_macros.h index 3998f79..171ce4d 100644 --- a/src/lacaml_macros.h +++ b/src/lacaml_macros.h @@ -1,14 +1,10 @@ /* File: lacaml_macros.h - Copyright (C) 2001- + Copyright © 2001- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umh.ac.be/an/ + Christophe Troestler This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public @@ -22,17 +18,17 @@ You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef LACAML_MACROS -#include #include -#include -#include -#include #include +#include +#include +#include +#include #include #include @@ -43,44 +39,44 @@ #define STR(name, arg) STR_NX(name, arg) /* Defines precision-dependent macros */ -#ifndef LACAML_DOUBLE /* Single precision */ +#ifndef LACAML_DOUBLE /* Single precision */ #define REAL real #define COMPLEX complex #define FABS fabsf -#ifndef LACAML_COMPLEX /* Real number */ +#ifndef LACAML_COMPLEX /* Real number */ #define SDMATHH(name) name##f #define FUN(name) s##name##_ -#define FUN2(prefix,name) prefix##s##name##_ /* -> IxAMAX */ +#define FUN2(prefix, name) prefix##s##name##_ /* -> IxAMAX */ #define LFUN(name) lacaml_S##name -#else /* Complex number */ +#else /* Complex number */ #define FUN(name) c##name##_ -#define FUN2(prefix,name) prefix##c##name##_ /* -> IxAMAX */ +#define FUN2(prefix, name) prefix##c##name##_ /* -> IxAMAX */ #define LFUN(name) lacaml_C##name -#endif /* LACAML_COMPLEX */ +#endif /* LACAML_COMPLEX */ -#else /* Double precision */ +#else /* Double precision */ #define REAL doublereal #define COMPLEX doublecomplex #define FABS fabs -#ifndef LACAML_COMPLEX /* Real number */ +#ifndef LACAML_COMPLEX /* Real number */ #define SDMATHH(name) name #define FUN(name) d##name##_ -#define FUN2(prefix,name) prefix##d##name##_ /* -> IxAMAX */ +#define FUN2(prefix, name) prefix##d##name##_ /* -> IxAMAX */ #define LFUN(name) lacaml_D##name -#else /* Complex number */ +#else /* Complex number */ #define FUN(name) z##name##_ -#define FUN2(prefix,name) prefix##z##name##_ /* -> IxAMAX */ +#define FUN2(prefix, name) prefix##z##name##_ /* -> IxAMAX */ #define LFUN(name) lacaml_Z##name -#endif /* LACAML_COMPLEX */ +#endif /* LACAML_COMPLEX */ -#endif /* LACAML_DOUBLE */ +#endif /* LACAML_DOUBLE */ /* Real vs. imaginery */ -#ifndef LACAML_COMPLEX /* Real number */ +#ifndef LACAML_COMPLEX /* Real number */ #define NUMBER REAL #define CAMLreturnNUMBER(X) CAMLreturnT(double, X) #define COPY_NUMBER(X) caml_copy_double(X) @@ -97,29 +93,29 @@ #define MUL_NUMBER(X, Y) (X * Y) #define MUL_NUMBERP(X, Y) (*X * *Y) #define NEG_NUMBER(X) (-X) -#else /* Complex number */ +#else /* Complex number */ #define NUMBER COMPLEX #define CAMLreturnNUMBER(X) CAMLreturn(copy_two_doubles(X.r, X.i)) #define COPY_NUMBER(X) X -#define NUMBER_ZERO { 0, 0 } -#define NUMBER_ONE { 1, 0 } -#define NUMBER_MINUS_ONE { -1, 0 } +#define NUMBER_ZERO {0, 0} +#define NUMBER_ONE {1, 0} +#define NUMBER_MINUS_ONE {-1, 0} #define NUMBER_EQUAL(X, Y) (X).r == (Y).r && (X).i == (Y).i -#define INIT_NUMBER(name) \ - name.r = Double_field(v##name, 0); \ +#define INIT_NUMBER(name) \ + name.r = Double_field(v##name, 0); \ name.i = Double_field(v##name, 1) #define vNUMBER value #define NUMBER_val(X) X #define DOTU FUN(lacaml_dotu_wrap) #define DOTC FUN(lacaml_dotc_wrap) -#define ADD_NUMBER(X, Y) ((NUMBER) { X.r + Y.r, X.i + Y.i }) -#define SUB_NUMBER(X, Y) ((NUMBER) { X.r - Y.r, X.i - Y.i }) -#define MUL_NUMBER(X, Y) \ - ((NUMBER) { X.r * Y.r - X.i * Y.i, X.r * Y.i + X.i * Y.r }) -#define MUL_NUMBERP(X, Y) \ - ((NUMBER) { X->r * Y->r - X->i * Y->i, X->r * Y->i + X->i * Y->r }) -#define NEG_NUMBER(X) ((NUMBER) { -X.r, -X.i }) -#define COMLEX_CONJ(X) ((NUMBER) { X.r, -X.i }) +#define ADD_NUMBER(X, Y) ((NUMBER){X.r + Y.r, X.i + Y.i}) +#define SUB_NUMBER(X, Y) ((NUMBER){X.r - Y.r, X.i - Y.i}) +#define MUL_NUMBER(X, Y) \ + ((NUMBER){X.r * Y.r - X.i * Y.i, X.r * Y.i + X.i * Y.r}) +#define MUL_NUMBERP(X, Y) \ + ((NUMBER){X->r * Y->r - X->i * Y->i, X->r * Y->i + X->i * Y->r}) +#define NEG_NUMBER(X) ((NUMBER){-X.r, -X.i}) +#define COMLEX_CONJ(X) ((NUMBER){X.r, -X.i}) #endif /* Fetch boolean parameters */ @@ -135,48 +131,49 @@ #define GET_DOUBLE(V) V = v##V /* Fetch matrix parameters from bigarray */ -#define MAT_PARAMS(M) \ - struct caml_ba_array *big_##M = Caml_ba_array_val(v##M); \ - intnat *dims_##M = big_##M->dim; \ - integer M##R = v##M##R; \ - integer M##C = v##M##C; \ - integer rows_##M = *dims_##M++; \ - CAMLunused integer cols_##M = *dims_##M; \ - NUMBER *M##_data = ((NUMBER *) big_##M->data) + M##R + rows_##M*(M##C - 1) - 1 +#define MAT_PARAMS(M) \ + struct caml_ba_array *big_##M = Caml_ba_array_val(v##M); \ + intnat *dims_##M = big_##M->dim; \ + integer M##R = v##M##R; \ + integer M##C = v##M##C; \ + integer rows_##M = *dims_##M++; \ + CAMLunused integer cols_##M = *dims_##M; \ + NUMBER *M##_data = \ + ((NUMBER *)big_##M->data) + M##R + rows_##M * (M##C - 1) - 1 /* Fetch vector parameters from bigarray */ -#define VEC_PARAMS(V) \ - struct caml_ba_array *big_##V = Caml_ba_array_val(v##V); \ - CAMLunused integer dim_##V = *big_##V->dim; \ - NUMBER *V##_data = ((NUMBER *) big_##V->data) + (vOFS##V - 1) +#define VEC_PARAMS(V) \ + struct caml_ba_array *big_##V = Caml_ba_array_val(v##V); \ + CAMLunused integer dim_##V = *big_##V->dim; \ + NUMBER *V##_data = ((NUMBER *)big_##V->data) + (vOFS##V - 1) /* Fetch vector parameters from real bigarray */ -#define RVEC_PARAMS(V) \ - struct caml_ba_array *big_##V = Caml_ba_array_val(v##V); \ - CAMLunused integer dim_##V = *big_##V->dim; \ - REAL *V##_data = ((REAL *) big_##V->data) + (vOFS##V - 1) +#define RVEC_PARAMS(V) \ + struct caml_ba_array *big_##V = Caml_ba_array_val(v##V); \ + CAMLunused integer dim_##V = *big_##V->dim; \ + REAL *V##_data = ((REAL *)big_##V->data) + (vOFS##V - 1) /* Fetch vector parameters from bigarray with offset 1 */ -#define VEC_PARAMS1(V) \ - struct caml_ba_array *big_##V = Caml_ba_array_val(v##V); \ - CAMLunused integer dim_##V = *big_##V->dim; \ +#define VEC_PARAMS1(V) \ + struct caml_ba_array *big_##V = Caml_ba_array_val(v##V); \ + CAMLunused integer dim_##V = *big_##V->dim; \ NUMBER *V##_data = big_##V->data /* Fetch vector parameters from bigarray with offset 1 */ -#define RVEC_PARAMS1(V) \ - struct caml_ba_array *big_##V = Caml_ba_array_val(v##V); \ - CAMLunused integer dim_##V = *big_##V->dim; \ +#define RVEC_PARAMS1(V) \ + struct caml_ba_array *big_##V = Caml_ba_array_val(v##V); \ + CAMLunused integer dim_##V = *big_##V->dim; \ REAL *V##_data = big_##V->data /* Fetch vector parameters from integer bigarray */ -#define INT_VEC_PARAMS(V) \ - struct caml_ba_array *big_##V = Caml_ba_array_val(v##V); \ - CAMLunused integer dim_##V = *big_##V->dim; \ +#define INT_VEC_PARAMS(V) \ + struct caml_ba_array *big_##V = Caml_ba_array_val(v##V); \ + CAMLunused integer dim_##V = *big_##V->dim; \ integer *V##_data = big_##V->data /* Split an integer couple (int * int) into two ints */ -#define INT_COUPLE(V) \ - integer V##1 = Int_val(Field(v##V, 0)); \ +#define INT_COUPLE(V) \ + integer V##1 = Int_val(Field(v##V, 0)); \ integer V##2 = Int_val(Field(v##V, 1)) -#endif /* LACAML_MACROS */ +#endif /* LACAML_MACROS */ diff --git a/src/mat_CZ.h b/src/mat_CZ.h index c659bec..ecf420c 100644 --- a/src/mat_CZ.h +++ b/src/mat_CZ.h @@ -1,10 +1,8 @@ /* File: mat_CZ.h - Copyright (C) 2015- + Copyright © 2015- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public @@ -18,7 +16,7 @@ You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include @@ -28,69 +26,69 @@ #define NAME LFUN(neg_mat_stub) #define BC_NAME LFUN(neg_mat_stub_bc) -#define FUNC(dst, x) \ - dst->r = - x.r; \ - dst->i = - x.i +#define FUNC(dst, x) \ + dst->r = -x.r; \ + dst->i = -x.i #include "mat_map.h" #define NAME LFUN(reci_mat_stub) #define BC_NAME LFUN(reci_mat_stub_bc) -#define FUNC(dst, x) \ - if (abs(x.r) >= abs(x.i)) { \ - REAL r = x.i / x.r; \ - REAL d = x.r + r * x.i; \ - dst->r = 1 / d; \ - dst->i = -r/d; \ - } else { \ - REAL r = x.r / x.i; \ - REAL d = x.i + r * x.r; \ - dst->r = r / d; \ - dst->i = -1 / d; \ +#define FUNC(dst, x) \ + if (abs(x.r) >= abs(x.i)) { \ + REAL r = x.i / x.r; \ + REAL d = x.r + r * x.i; \ + dst->r = 1 / d; \ + dst->i = -r / d; \ + } else { \ + REAL r = x.r / x.i; \ + REAL d = x.i + r * x.r; \ + dst->r = r / d; \ + dst->i = -1 / d; \ } #include "mat_map.h" #define NAME LFUN(add_mat_stub) #define BC_NAME LFUN(add_mat_stub_bc) -#define FUNC(dst, x, y) \ - dst->r = x.r + y.r; \ +#define FUNC(dst, x, y) \ + dst->r = x.r + y.r; \ dst->i = x.i + y.i #include "mat_combine.h" #define NAME LFUN(sub_mat_stub) #define BC_NAME LFUN(sub_mat_stub_bc) -#define FUNC(dst, x, y) \ - dst->r = x.r - y.r; \ +#define FUNC(dst, x, y) \ + dst->r = x.r - y.r; \ dst->i = x.i - y.i #include "mat_combine.h" #define NAME LFUN(mul_mat_stub) #define BC_NAME LFUN(mul_mat_stub_bc) -#define FUNC(dst, x, y) \ - dst->r = x.r*y.r - x.i*y.i; \ - dst->i = x.r*y.i + x.i*y.r +#define FUNC(dst, x, y) \ + dst->r = x.r * y.r - x.i * y.i; \ + dst->i = x.r * y.i + x.i * y.r #include "mat_combine.h" #define NAME LFUN(div_mat_stub) #define BC_NAME LFUN(div_mat_stub_bc) -#define FUNC(dst, x, y) \ - REAL xr = x.r, xi = x.i, yr = y.r, yi = y.i; \ - if (FABS(yr) >= FABS(yi)) {\ - REAL r = yi / yr, d = yr + r*yi; \ - dst->r = (xr + r*xi)/d; \ - dst->i = (xi - r*xr)/d; \ - } else {\ - REAL r = yr / yi, d = yi + r*yr; \ - dst->r = (r*xr + xi)/d; \ - dst->i = (r*xi - xr)/d; \ +#define FUNC(dst, x, y) \ + REAL xr = x.r, xi = x.i, yr = y.r, yi = y.i; \ + if (FABS(yr) >= FABS(yi)) { \ + REAL r = yi / yr, d = yr + r * yi; \ + dst->r = (xr + r * xi) / d; \ + dst->i = (xi - r * xr) / d; \ + } else { \ + REAL r = yr / yi, d = yi + r * yr; \ + dst->r = (r * xr + xi) / d; \ + dst->i = (r * xi - xr) / d; \ } #include "mat_combine.h" #define NAME LFUN(ssqr_diff_mat_stub) #define BC_NAME LFUN(ssqr_diff_mat_stub_bc) -#define INIT { 0.0, 0.0 } -#define FUNC(acc, x, y) \ - x.r -= y.r; \ - x.i -= y.i; \ - acc.r += (x.r - x.i) * (x.r + x.i); \ - acc.i += 2*x.r*x.i +#define INIT {0.0, 0.0} +#define FUNC(acc, x, y) \ + x.r -= y.r; \ + x.i -= y.i; \ + acc.r += (x.r - x.i) * (x.r + x.i); \ + acc.i += 2 * x.r * x.i #include "mat_fold2.h" diff --git a/src/mat_CZ.ml b/src/mat_CZ.ml index acbba5c..cd49225 100644 --- a/src/mat_CZ.ml +++ b/src/mat_CZ.ml @@ -1,43 +1,34 @@ (* File: mat_CZ.ml - Copyright (C) 2001- + Copyright © 2001- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umh.ac.be/an/ + Christophe Troestler - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) open Complex open Mat4_CPREC -let random - ?rnd_state - ?(re_from = -1.) ?(re_range = 2.) - ?(im_from = -1.) ?(im_range = 2.) - m n = +let random ?rnd_state ?(re_from = -1.) ?(re_range = 2.) ?(im_from = -1.) + ?(im_range = 2.) m n = let mat = create m n in let state = - match rnd_state with - | None -> Random.get_state () - | Some state -> state in + match rnd_state with None -> Random.get_state () | Some state -> state + in for row = 1 to m do for col = 1 to n do mat.{row, col} <- diff --git a/src/mat_CZ.mli b/src/mat_CZ.mli index 3c5a4e8..636946a 100644 --- a/src/mat_CZ.mli +++ b/src/mat_CZ.mli @@ -1,29 +1,24 @@ (* File: mat_CZ.mli - Copyright (C) 2001- + Copyright © 2001- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umh.ac.be/an/ + Christophe Troestler - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) (** {5 Matrix operations} *) @@ -32,16 +27,19 @@ open Complexxx (** {6 Creation of matrices} *) val random : - ?rnd_state : Random.State.t -> - ?re_from : float -> ?re_range : float -> - ?im_from : float -> ?im_range : float -> - int -> int - -> mat + ?rnd_state:Random.State.t -> + ?re_from:float -> + ?re_range:float -> + ?im_from:float -> + ?im_range:float -> + int -> + int -> + mat (** [random ?rnd_state ?re_from ?re_range ?im_from ?im_range m n] - @return an [m]x[n] matrix initialized with random elements sampled - uniformly from [re_range] and [im_range] starting at [re_from] and - [im_from] for real and imaginary numbers respectively. A random state - [rnd_state] can be passed. + @return + an [m]x[n] matrix initialized with random elements sampled uniformly from + [re_range] and [im_range] starting at [re_from] and [im_from] for real and + imaginary numbers respectively. A random state [rnd_state] can be passed. @param rnd_state default = Random.get_state () @param re_from default = -1.0 diff --git a/src/mat_SD.h b/src/mat_SD.h index d025038..9bab806 100644 --- a/src/mat_SD.h +++ b/src/mat_SD.h @@ -1,10 +1,8 @@ /* File: mat_SD.h - Copyright (C) 2015- + Copyright © 2015- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public @@ -18,17 +16,17 @@ You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ -#include #include "lacaml_macros.h" +#include /* Unary matrix operations */ #define NAME LFUN(neg_mat_stub) #define BC_NAME LFUN(neg_mat_stub_bc) -#define FUNC(dst, x) *dst = - x +#define FUNC(dst, x) *dst = -x #include "mat_map.h" #define NAME LFUN(reci_mat_stub) @@ -206,7 +204,6 @@ #define FUNC(dst, x) *dst = x / (1 + SDMATHH(fabs)(x)) #include "mat_map.h" - /* Binary matrix operations */ #define NAME LFUN(add_mat_stub) @@ -221,12 +218,12 @@ #define NAME LFUN(mul_mat_stub) #define BC_NAME LFUN(mul_mat_stub_bc) -#define FUNC(dst, x, y) *dst = x*y +#define FUNC(dst, x, y) *dst = x * y #include "mat_combine.h" #define NAME LFUN(div_mat_stub) #define BC_NAME LFUN(div_mat_stub_bc) -#define FUNC(dst, x, y) *dst = x/y +#define FUNC(dst, x, y) *dst = x / y #include "mat_combine.h" #define NAME LFUN(pow_mat_stub) @@ -254,24 +251,22 @@ #define FUNC(dst, x, y) *dst = SDMATHH(fmax)(x, y) #include "mat_combine.h" - /* Ternary matrix operations */ #define NAME LFUN(cpab_stub) #define BC_NAME LFUN(cpab_stub_bc) #ifdef FP_FAST_FMA -# define FUNC(dst, x, y) *dst = SDMATHH(fma)(x, y, *dst) +#define FUNC(dst, x, y) *dst = SDMATHH(fma)(x, y, *dst) #else -# define FUNC(dst, x, y) *dst += x*y +#define FUNC(dst, x, y) *dst += x * y #endif #include "mat_combine.h" #define NAME LFUN(cmab_stub) #define BC_NAME LFUN(cmab_stub_bc) -#define FUNC(dst, x, y) *dst -= x*y +#define FUNC(dst, x, y) *dst -= x * y #include "mat_combine.h" - /* Unary matrix operations yielding floats */ #define NAME LFUN(max_el_mat_stub) @@ -283,33 +278,37 @@ #define NAME LFUN(log_sum_exp_mat_stub) #define BC_NAME LFUN(log_sum_exp_mat_stub_bc) #define DECLARE_EXTRA NUMBER x_max = -INFINITY -#define INIT_HAVE_LOCK \ - x_max = \ - LFUN(max_el_mat_stub_blocking)(PKIND, PINIT, M, N, A_data, rows_A, x_max) +#define INIT_HAVE_LOCK \ + x_max = LFUN(max_el_mat_stub_blocking)(PKIND, PINIT, M, N, A_data, rows_A, \ + x_max) #define INIT 0.0 #define FUNC(acc, x) acc += SDMATHH(exp)(x - x_max) #define FINISH_HAVE_LOCK acc = SDMATHH(log)(acc) + x_max #include "mat_fold.h" - /* Binary matrix operations yielding floats */ #define NAME LFUN(ssqr_diff_mat_stub) #define BC_NAME LFUN(ssqr_diff_mat_stub_bc) #define INIT 0.0 -# ifdef FP_FAST_FMA -# define FUNC(acc, x, y) x -= y; acc = SDMATHH(fma)(x, x, acc) -# else -# define FUNC(acc, x, y) x -= y; x *= x; acc += x -# endif +#ifdef FP_FAST_FMA +#define FUNC(acc, x, y) \ + x -= y; \ + acc = SDMATHH(fma)(x, x, acc) +#else +#define FUNC(acc, x, y) \ + x -= y; \ + x *= x; \ + acc += x +#endif #include "mat_fold2.h" #define NAME LFUN(sum_prod_mat_stub) #define BC_NAME LFUN(sum_prod_mat_stub_bc) #define INIT 0.0 -# ifdef FP_FAST_FMA -# define FUNC(acc, x, y) acc = SDMATHH(fma)(x, y, acc) -# else -# define FUNC(acc, x, y) acc += x*y -# endif +#ifdef FP_FAST_FMA +#define FUNC(acc, x, y) acc = SDMATHH(fma)(x, y, acc) +#else +#define FUNC(acc, x, y) acc += x * y +#endif #include "mat_fold2.h" diff --git a/src/mat_SD.ml b/src/mat_SD.ml index ee47db8..956d09f 100644 --- a/src/mat_SD.ml +++ b/src/mat_SD.ml @@ -1,29 +1,24 @@ (* File: mat_SD.ml - Copyright (C) 2001- + Copyright © 2001- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umh.ac.be/an/ + Christophe Troestler - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) open Bigarray open Mat4_FPREC @@ -46,10 +41,9 @@ let hankel n = let n1 = n + 1 in let rec loop c r = mat.{r, c} <- float (c + r - 1); - if c + r >= n1 then - if c = n then mat - else loop (c + 1) 1 - else loop c (r + 1) in + if c + r >= n1 then if c = n then mat else loop (c + 1) 1 + else loop c (r + 1) + in loop 1 1 let pascal n = @@ -63,14 +57,14 @@ let pascal n = let rosser_ar = [| - [| 611.; 196.; -192.; 407.; -8.; -52.; -49.; 29.; |]; - [| 196.; 899.; 113.; -192.; -71.; -43.; -8.; -44.; |]; - [| -192.; 113.; 899.; 196.; 61.; 49.; 8.; 52.; |]; - [| 407.; -192.; 196.; 611.; 8.; 44.; 59.; -23.; |]; - [| -8.; -71.; 61.; 8.; 411.; -599.; 208.; 208.; |]; - [| -52.; -43.; 49.; 44.; -599.; 411.; 208.; 208.; |]; - [| -49.; -8.; 8.; 59.; 208.; 208.; 99.; -911.; |]; - [| 29.; -44.; 52.; -23.; 208.; 208.; -911.; 99.; |]; + [| 611.; 196.; -192.; 407.; -8.; -52.; -49.; 29. |]; + [| 196.; 899.; 113.; -192.; -71.; -43.; -8.; -44. |]; + [| -192.; 113.; 899.; 196.; 61.; 49.; 8.; 52. |]; + [| 407.; -192.; 196.; 611.; 8.; 44.; 59.; -23. |]; + [| -8.; -71.; 61.; 8.; 411.; -599.; 208.; 208. |]; + [| -52.; -43.; 49.; 44.; -599.; 411.; 208.; 208. |]; + [| -49.; -8.; 8.; 59.; 208.; 208.; 99.; -911. |]; + [| 29.; -44.; 52.; -23.; 208.; 208.; -911.; 99. |]; |] let rosser () = Array2.of_array prec fortran_layout rosser_ar @@ -80,35 +74,36 @@ let toeplitz (v : vec) = if len = 0 then empty else if len = 1 then make 1 1 v.{1} else ( - if len mod 2 <> 1 then - invalid_arg "toeplitz: v has even number of elements"; + if len mod 2 <> 1 then invalid_arg "toeplitz: v has even number of elements"; let n = (len + 1) / 2 in let mat = create n n in let rec loop r c i = mat.{r, c} <- v.{i}; - if r = n then - if c = n then loop 1 2 (i + 1) - else loop (n - c) 1 (i + 1) - else - if c = n then - if r = 1 then mat - else loop 1 (n - r + 2) (i + 1) - else loop (r + 1) (c + 1) i in + if r = n then if c = n then loop 1 2 (i + 1) else loop (n - c) 1 (i + 1) + else if c = n then if r = 1 then mat else loop 1 (n - r + 2) (i + 1) + else loop (r + 1) (c + 1) i + in loop n 1 1) let vandermonde (v : vec) = let n = Array1.dim v in if n = 0 then empty else if n = 1 then make 1 1 1.0 - else ( + else let mat = create n n in - for i = 1 to n do mat.{i, 1} <- 1.0 done; - for i = 1 to n do mat.{i, 2} <- v.{i} done; + for i = 1 to n do + mat.{i, 1} <- 1.0 + done; + for i = 1 to n do + mat.{i, 2} <- v.{i} + done; for pow = 2 to n - 1 do let fpow = float pow in - for i = 1 to n do mat.{i, pow + 1} <- v.{i} ** fpow done + for i = 1 to n do + mat.{i, pow + 1} <- v.{i} ** fpow + done done; - mat) + mat let wilkinson n = if n < 3 then invalid_arg "wilkinson: n < 3"; @@ -121,16 +116,19 @@ let wilkinson n = done; let n_2 = n / 2 in let n1_2 = n_2 + 1 in - for i = 1 to n_2 do mat.{i, i} <- float (n1_2 - i) done; - for i = n1_2 + 1 to n do mat.{i, i} <- float (i - n1_2) done; + for i = 1 to n_2 do + mat.{i, i} <- float (n1_2 - i) + done; + for i = n1_2 + 1 to n do + mat.{i, i} <- float (i - n1_2) + done; mat let random ?rnd_state ?(from = -1.) ?(range = 2.) m n = let mat = create m n in let state = - match rnd_state with - | None -> Random.get_state () - | Some state -> state in + match rnd_state with None -> Random.get_state () | Some state -> state + in for row = 1 to m do for col = 1 to n do mat.{row, col} <- Random.State.float state range +. from @@ -139,7 +137,6 @@ let random ?rnd_state ?(from = -1.) ?(range = 2.) m n = if rnd_state = None then Random.set_state state; mat - (* Unary matrix operations *) let unop direct loc = @@ -153,522 +150,521 @@ let unop direct loc = b external direct_abs : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_FPRECabs_mat_stub_bc" "lacaml_FPRECabs_mat_stub" let abs = unop direct_abs "abs" external direct_signum : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_FPRECsignum_mat_stub_bc" "lacaml_FPRECsignum_mat_stub" let signum = unop direct_signum "signum" external direct_sqr : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_FPRECsqr_mat_stub_bc" "lacaml_FPRECsqr_mat_stub" let sqr = unop direct_sqr "sqr" external direct_sqrt : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_FPRECsqrt_mat_stub_bc" "lacaml_FPRECsqrt_mat_stub" let sqrt = unop direct_sqrt "sqrt" external direct_cbrt : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_FPRECcbrt_mat_stub_bc" "lacaml_FPRECcbrt_mat_stub" let cbrt = unop direct_cbrt "cbrt" external direct_exp : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_FPRECexp_mat_stub_bc" "lacaml_FPRECexp_mat_stub" let exp = unop direct_exp "exp" external direct_exp2 : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_FPRECexp2_mat_stub_bc" "lacaml_FPRECexp2_mat_stub" let exp2 = unop direct_exp2 "exp2" external direct_expm1 : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_FPRECexpm1_mat_stub_bc" "lacaml_FPRECexpm1_mat_stub" let expm1 = unop direct_expm1 "expm1" external direct_log : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_FPREClog_mat_stub_bc" "lacaml_FPREClog_mat_stub" let log = unop direct_log "log" external direct_log10 : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_FPREClog10_mat_stub_bc" "lacaml_FPREClog10_mat_stub" let log10 = unop direct_log10 "log10" external direct_log2 : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_FPREClog2_mat_stub_bc" "lacaml_FPREClog2_mat_stub" let log2 = unop direct_log2 "log2" external direct_log1p : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_FPREClog1p_mat_stub_bc" "lacaml_FPREClog1p_mat_stub" let log1p = unop direct_log1p "log1p" external direct_sin : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_FPRECsin_mat_stub_bc" "lacaml_FPRECsin_mat_stub" let sin = unop direct_sin "sin" external direct_cos : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_FPRECcos_mat_stub_bc" "lacaml_FPRECcos_mat_stub" let cos = unop direct_cos "cos" external direct_tan : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_FPRECtan_mat_stub_bc" "lacaml_FPRECtan_mat_stub" let tan = unop direct_tan "tan" external direct_asin : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_FPRECasin_mat_stub_bc" "lacaml_FPRECasin_mat_stub" let asin = unop direct_asin "asin" external direct_acos : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_FPRECacos_mat_stub_bc" "lacaml_FPRECacos_mat_stub" let acos = unop direct_acos "acos" external direct_atan : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_FPRECatan_mat_stub_bc" "lacaml_FPRECatan_mat_stub" let atan = unop direct_atan "atan" external direct_sinh : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_FPRECsinh_mat_stub_bc" "lacaml_FPRECsinh_mat_stub" let sinh = unop direct_sinh "sinh" external direct_cosh : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_FPRECcosh_mat_stub_bc" "lacaml_FPRECcosh_mat_stub" let cosh = unop direct_cosh "cosh" external direct_tanh : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_FPRECtanh_mat_stub_bc" "lacaml_FPRECtanh_mat_stub" let tanh = unop direct_tanh "tanh" external direct_asinh : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_FPRECasinh_mat_stub_bc" "lacaml_FPRECasinh_mat_stub" let asinh = unop direct_asinh "asinh" external direct_acosh : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_FPRECacosh_mat_stub_bc" "lacaml_FPRECacosh_mat_stub" let acosh = unop direct_acosh "acosh" external direct_atanh : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_FPRECatanh_mat_stub_bc" "lacaml_FPRECatanh_mat_stub" let atanh = unop direct_atanh "atanh" external direct_floor : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_FPRECfloor_mat_stub_bc" "lacaml_FPRECfloor_mat_stub" let floor = unop direct_floor "floor" external direct_ceil : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_FPRECceil_mat_stub_bc" "lacaml_FPRECceil_mat_stub" let ceil = unop direct_ceil "ceil" external direct_round : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_FPRECround_mat_stub_bc" "lacaml_FPRECround_mat_stub" let round = unop direct_round "round" external direct_trunc : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_FPRECtrunc_mat_stub_bc" "lacaml_FPRECtrunc_mat_stub" let trunc = unop direct_trunc "trunc" external direct_erf : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_FPRECerf_mat_stub_bc" "lacaml_FPRECerf_mat_stub" let erf = unop direct_erf "erf" external direct_erfc : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_FPRECerfc_mat_stub_bc" "lacaml_FPRECerfc_mat_stub" let erfc = unop direct_erfc "erfc" external direct_logistic : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_FPREClogistic_mat_stub_bc" "lacaml_FPREClogistic_mat_stub" let logistic = unop direct_logistic "logistic" external direct_relu : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_FPRECrelu_mat_stub_bc" "lacaml_FPRECrelu_mat_stub" let relu = unop direct_relu "relu" external direct_softplus : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_FPRECsoftplus_mat_stub_bc" "lacaml_FPRECsoftplus_mat_stub" let softplus = unop direct_softplus "softplus" external direct_softsign : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_FPRECsoftsign_mat_stub_bc" "lacaml_FPRECsoftsign_mat_stub" let softsign = unop direct_softsign "softsign" - (* Binary matrix operations *) let binop direct loc = let loc = "Lacaml.FPREC.Mat." ^ loc in - fun ?patt ?m ?n - ?(cr = 1) ?(cc = 1) ?c ?(ar = 1) ?(ac = 1) a ?(br = 1) ?(bc = 1) b -> + fun ?patt ?m ?n ?(cr = 1) ?(cc = 1) ?c ?(ar = 1) ?(ac = 1) a ?(br = 1) + ?(bc = 1) b -> let m = get_dim1_mat loc a_str a ar m_str m in let n = get_dim2_mat loc a_str a ac n_str n in check_dim_mat loc b_str br bc b m n; @@ -678,107 +674,107 @@ let binop direct loc = c external direct_pow : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> - cr : (int [@untagged]) -> - cc : (int [@untagged]) -> - c : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + cr:(int[@untagged]) -> + cc:(int[@untagged]) -> + c:mat -> unit = "lacaml_FPRECpow_mat_stub_bc" "lacaml_FPRECpow_mat_stub" let pow = binop direct_pow "pow" external direct_atan2 : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> - cr : (int [@untagged]) -> - cc : (int [@untagged]) -> - c : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + cr:(int[@untagged]) -> + cc:(int[@untagged]) -> + c:mat -> unit = "lacaml_FPRECatan2_mat_stub_bc" "lacaml_FPRECatan2_mat_stub" let atan2 = binop direct_atan2 "atan2" external direct_hypot : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> - cr : (int [@untagged]) -> - cc : (int [@untagged]) -> - c : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + cr:(int[@untagged]) -> + cc:(int[@untagged]) -> + c:mat -> unit = "lacaml_FPREChypot_mat_stub_bc" "lacaml_FPREChypot_mat_stub" let hypot = binop direct_hypot "hypot" external direct_min2 : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> - cr : (int [@untagged]) -> - cc : (int [@untagged]) -> - c : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + cr:(int[@untagged]) -> + cc:(int[@untagged]) -> + c:mat -> unit = "lacaml_FPRECmin2_mat_stub_bc" "lacaml_FPRECmin2_mat_stub" let min2 = binop direct_min2 "min2" external direct_max2 : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> - cr : (int [@untagged]) -> - cc : (int [@untagged]) -> - c : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + cr:(int[@untagged]) -> + cc:(int[@untagged]) -> + c:mat -> unit = "lacaml_FPRECmax2_mat_stub_bc" "lacaml_FPRECmax2_mat_stub" let max2 = binop direct_max2 "max2" external direct_sum_prod : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> - (float [@unboxed]) + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + (float[@unboxed]) = "lacaml_FPRECsum_prod_mat_stub_bc" "lacaml_FPRECsum_prod_mat_stub" let sum_prod ?patt ?m ?n ?(ar = 1) ?(ac = 1) a ?(br = 1) ?(bc = 1) b = @@ -789,13 +785,12 @@ let sum_prod ?patt ?m ?n ?(ar = 1) ?(ac = 1) a ?(br = 1) ?(bc = 1) b = let pkind, pinit = Mat_patt.normalize_args ~loc ~m ~n patt in direct_sum_prod ~pkind ~pinit ~m ~n ~ar ~ac ~a ~br ~bc ~b - (* Ternary matrix operations *) let cqab direct loc = let loc = "Lacaml.FPREC.Mat." ^ loc in - fun ?patt ?m ?n - ?(cr = 1) ?(cc = 1) c ?(ar = 1) ?(ac = 1) a ?(br = 1) ?(bc = 1) b -> + fun ?patt ?m ?n ?(cr = 1) ?(cc = 1) c ?(ar = 1) ?(ac = 1) a ?(br = 1) + ?(bc = 1) b -> let m = get_dim1_mat loc a_str a ar m_str m in let n = get_dim2_mat loc a_str a ac n_str n in check_dim_mat loc b_str br bc b m n; @@ -804,53 +799,52 @@ let cqab direct loc = direct ~pkind ~pinit ~m ~n ~ar ~ac ~a ~br ~bc ~b ~cr ~cc ~c external direct_cpab : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> - cr : (int [@untagged]) -> - cc : (int [@untagged]) -> - c : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + cr:(int[@untagged]) -> + cc:(int[@untagged]) -> + c:mat -> unit = "lacaml_FPRECcpab_stub_bc" "lacaml_FPRECcpab_stub" let cpab = cqab direct_cpab "cpab" external direct_cmab : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> - cr : (int [@untagged]) -> - cc : (int [@untagged]) -> - c : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + cr:(int[@untagged]) -> + cc:(int[@untagged]) -> + c:mat -> unit = "lacaml_FPRECcmab_stub_bc" "lacaml_FPRECcmab_stub" let cmab = cqab direct_cmab "cmab" - (* Misc functions *) external direct_log_sum_exp : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - (float [@unboxed]) + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + (float[@unboxed]) = "lacaml_FPREClog_sum_exp_mat_stub_bc" "lacaml_FPREClog_sum_exp_mat_stub" let log_sum_exp ?patt ?m ?n ?(ar = 1) ?(ac = 1) a = diff --git a/src/mat_SD.mli b/src/mat_SD.mli index c87ceda..e9ae1cd 100644 --- a/src/mat_SD.mli +++ b/src/mat_SD.mli @@ -1,29 +1,24 @@ (* File: mat_SD.mli - Copyright (C) 2001- + Copyright © 2001- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umh.ac.be/an/ + Christophe Troestler - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) (** {5 Matrix operations} *) @@ -57,10 +52,7 @@ val wilkinson : int -> mat @raise Invalid_argument if [n] is not an odd number >= 3. *) val random : - ?rnd_state : Random.State.t -> - ?from : float -> ?range : float -> - int -> int - -> mat + ?rnd_state:Random.State.t -> ?from:float -> ?range:float -> int -> int -> mat (** [random ?rnd_state ?from ?range m n] @return an [m]x[n] matrix initialized with random elements sampled uniformly from [range] starting at [from]. A random state [rnd_state] can be passed. @@ -69,744 +61,702 @@ val random : @param from default = -1.0 @param range default = 2.0 *) - (** {6 Unary matrix operations} *) val abs : unop -(** [abs ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the absolute value of - the elements in the [m] by [n] sub-matrix of the matrix [a] starting in - row [ar] and column [ac] and pattern [patt]. If [b] is given, the result - will be stored in there using offsets [br] and [bc], otherwise a fresh - matrix will be used. The resulting matrix is returned. +(** [abs ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the absolute value of the + elements in the [m] by [n] sub-matrix of the matrix [a] starting in row [ar] + and column [ac] and pattern [patt]. If [b] is given, the result will be + stored in there using offsets [br] and [bc], otherwise a fresh matrix will + be used. The resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val signum : unop (** [signum ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the sign value ([-1] for - negative numbers, [0] (or [-0]) for zero, [1] for positive numbers, - [nan] for [nan]) of the elements in the [m] by [n] sub-matrix of the - matrix [a] starting in row [ar] and column [ac] and pattern [patt]. If [b] - is given, the result will be stored in there using offsets [br] and [bc], - otherwise a fresh matrix will be used. The resulting matrix is returned. + negative numbers, [0] (or [-0]) for zero, [1] for positive numbers, [nan] + for [nan]) of the elements in the [m] by [n] sub-matrix of the matrix [a] + starting in row [ar] and column [ac] and pattern [patt]. If [b] is given, + the result will be stored in there using offsets [br] and [bc], otherwise a + fresh matrix will be used. The resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val sqr : unop (** [sqr ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the square of the elements - in the [m] by [n] sub-matrix of the matrix [a] starting in row [ar] - and column [ac] and pattern [patt]. If [b] is given, the result will - be stored in there using offsets [br] and [bc], otherwise a fresh matrix - will be used. The resulting matrix is returned. + in the [m] by [n] sub-matrix of the matrix [a] starting in row [ar] and + column [ac] and pattern [patt]. If [b] is given, the result will be stored + in there using offsets [br] and [bc], otherwise a fresh matrix will be used. + The resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val sqrt : unop (** [sqrt ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the square root of the - elements in the [m] by [n] sub-matrix of the matrix [a] starting in row - [ar] and column [ac] and pattern [patt]. If [b] is given, the result - will be stored in there using offsets [br] and [bc], otherwise a fresh - matrix will be used. The resulting matrix is returned. + elements in the [m] by [n] sub-matrix of the matrix [a] starting in row [ar] + and column [ac] and pattern [patt]. If [b] is given, the result will be + stored in there using offsets [br] and [bc], otherwise a fresh matrix will + be used. The resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val cbrt : unop (** [cbrt ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the cubic root of the - elements in the [m] by [n] sub-matrix of the matrix [a] starting in row - [ar] and column [ac] and pattern [patt]. If [b] is given, the result - will be stored in there using offsets [br] and [bc], otherwise a fresh - matrix will be used. The resulting matrix is returned. + elements in the [m] by [n] sub-matrix of the matrix [a] starting in row [ar] + and column [ac] and pattern [patt]. If [b] is given, the result will be + stored in there using offsets [br] and [bc], otherwise a fresh matrix will + be used. The resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val exp : unop (** [exp ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the exponential of the - elements in the [m] by [n] sub-matrix of the matrix [a] starting in row - [ar] and column [ac] and pattern [patt]. If [b] is given, the result - will be stored in there using offsets [br] and [bc], otherwise a fresh - matrix will be used. The resulting matrix is returned. + elements in the [m] by [n] sub-matrix of the matrix [a] starting in row [ar] + and column [ac] and pattern [patt]. If [b] is given, the result will be + stored in there using offsets [br] and [bc], otherwise a fresh matrix will + be used. The resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val exp2 : unop (** [exp2 ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the base-2 exponential of - the elements in the [m] by [n] sub-matrix of the matrix [a] starting - in row [ar] and column [ac] and pattern [patt]. If [b] is given, the - result will be stored in there using offsets [br] and [bc], otherwise - a fresh matrix will be used. The resulting matrix is returned. + the elements in the [m] by [n] sub-matrix of the matrix [a] starting in row + [ar] and column [ac] and pattern [patt]. If [b] is given, the result will be + stored in there using offsets [br] and [bc], otherwise a fresh matrix will + be used. The resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val expm1 : unop -(** [expm1 ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes [exp a -. 1.] of - the elements in the [m] by [n] sub-matrix of the matrix [a] starting - in row [ar] and column [ac] and pattern [patt]. If [b] is given, the - result will be stored in there using offsets [br] and [bc], otherwise - a fresh matrix will be used. The resulting matrix is returned. +(** [expm1 ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes [exp a -. 1.] of the + elements in the [m] by [n] sub-matrix of the matrix [a] starting in row [ar] + and column [ac] and pattern [patt]. If [b] is given, the result will be + stored in there using offsets [br] and [bc], otherwise a fresh matrix will + be used. The resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val log : unop (** [log ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the logarithm of the - elements in the [m] by [n] sub-matrix of the matrix [a] starting in row - [ar] and column [ac] and pattern [patt]. If [b] is given, the result - will be stored in there using offsets [br] and [bc], otherwise a fresh - matrix will be used. The resulting matrix is returned. + elements in the [m] by [n] sub-matrix of the matrix [a] starting in row [ar] + and column [ac] and pattern [patt]. If [b] is given, the result will be + stored in there using offsets [br] and [bc], otherwise a fresh matrix will + be used. The resulting matrix is returned. @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val log10 : unop (** [log10 ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the base-10 logarithm of - the elements in the [m] by [n] sub-matrix of the matrix [a] starting - in row [ar] and column [ac] and pattern [patt]. If [b] is given, the - result will be stored in there using offsets [br] and [bc], otherwise - a fresh matrix will be used. The resulting matrix is returned. + the elements in the [m] by [n] sub-matrix of the matrix [a] starting in row + [ar] and column [ac] and pattern [patt]. If [b] is given, the result will be + stored in there using offsets [br] and [bc], otherwise a fresh matrix will + be used. The resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val log2 : unop -(** [log2 ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes base-2 logarithm of - the elements in the [m] by [n] sub-matrix of the matrix [a] starting - in row [ar] and column [ac] and pattern [patt]. If [b] is given, the - result will be stored in there using offsets [br] and [bc], otherwise - a fresh matrix will be used. The resulting matrix is returned. +(** [log2 ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes base-2 logarithm of the + elements in the [m] by [n] sub-matrix of the matrix [a] starting in row [ar] + and column [ac] and pattern [patt]. If [b] is given, the result will be + stored in there using offsets [br] and [bc], otherwise a fresh matrix will + be used. The resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val log1p : unop -(** [log1p ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes [log (1 + a)] of - the elements in the [m] by [n] sub-matrix of the matrix [a] starting - in row [ar] and column [ac] and pattern [patt]. If [b] is given, the - result will be stored in there using offsets [br] and [bc], otherwise - a fresh matrix will be used. The resulting matrix is returned. +(** [log1p ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes [log (1 + a)] of the + elements in the [m] by [n] sub-matrix of the matrix [a] starting in row [ar] + and column [ac] and pattern [patt]. If [b] is given, the result will be + stored in there using offsets [br] and [bc], otherwise a fresh matrix will + be used. The resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val sin : unop (** [sin ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the sine of the elements in the [m] by [n] sub-matrix of the matrix [a] starting in row [ar] and column - [ac] and pattern [patt]. If [b] is given, the result will be stored in - there using offsets [br] and [bc], otherwise a fresh matrix will be used. - The resulting matrix is returned. + [ac] and pattern [patt]. If [b] is given, the result will be stored in there + using offsets [br] and [bc], otherwise a fresh matrix will be used. The + resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val cos : unop -(** [cos ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the cosine of the - elements in the [m] by [n] sub-matrix of the matrix [a] starting in row - [ar] and column [ac] and pattern [patt]. If [b] is given, the result - will be stored in there using offsets [br] and [bc], otherwise a fresh - matrix will be used. The resulting matrix is returned. +(** [cos ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the cosine of the elements + in the [m] by [n] sub-matrix of the matrix [a] starting in row [ar] and + column [ac] and pattern [patt]. If [b] is given, the result will be stored + in there using offsets [br] and [bc], otherwise a fresh matrix will be used. + The resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val tan : unop -(** [tan ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the tangent of the - elements in the [m] by [n] sub-matrix of the matrix [a] starting in row - [ar] and column [ac] and pattern [patt]. If [b] is given, the result - will be stored in there using offsets [br] and [bc], otherwise a fresh - matrix will be used. The resulting matrix is returned. +(** [tan ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the tangent of the elements + in the [m] by [n] sub-matrix of the matrix [a] starting in row [ar] and + column [ac] and pattern [patt]. If [b] is given, the result will be stored + in there using offsets [br] and [bc], otherwise a fresh matrix will be used. + The resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val asin : unop (** [asin ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the arc sine of the - elements in the [m] by [n] sub-matrix of the matrix [a] starting in row - [ar] and column [ac] and pattern [patt]. If [b] is given, the result - will be stored in there using offsets [br] and [bc], otherwise a fresh - matrix will be used. The resulting matrix is returned. + elements in the [m] by [n] sub-matrix of the matrix [a] starting in row [ar] + and column [ac] and pattern [patt]. If [b] is given, the result will be + stored in there using offsets [br] and [bc], otherwise a fresh matrix will + be used. The resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val acos : unop (** [acos ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the arc cosine of the - elements in the [m] by [n] sub-matrix of the matrix [a] starting in row - [ar] and column [ac] and pattern [patt]. If [b] is given, the result - will be stored in there using offsets [br] and [bc], otherwise a fresh - matrix will be used. The resulting matrix is returned. + elements in the [m] by [n] sub-matrix of the matrix [a] starting in row [ar] + and column [ac] and pattern [patt]. If [b] is given, the result will be + stored in there using offsets [br] and [bc], otherwise a fresh matrix will + be used. The resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val atan : unop (** [atan ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the arc tangent of the - elements in the [m] by [n] sub-matrix of the matrix [a] starting in row - [ar] and column [ac] and pattern [patt]. If [b] is given, the result - will be stored in there using offsets [br] and [bc], otherwise a fresh - matrix will be used. The resulting matrix is returned. + elements in the [m] by [n] sub-matrix of the matrix [a] starting in row [ar] + and column [ac] and pattern [patt]. If [b] is given, the result will be + stored in there using offsets [br] and [bc], otherwise a fresh matrix will + be used. The resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val sinh : unop -(** [sinh ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the hyperbolic sine of - the elements in the [m] by [n] sub-matrix of the matrix [a] starting - in row [ar] and column [ac] and pattern [patt]. If [b] is given, the - result will be stored in there using offsets [br] and [bc], otherwise - a fresh matrix will be used. The resulting matrix is returned. +(** [sinh ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the hyperbolic sine of the + elements in the [m] by [n] sub-matrix of the matrix [a] starting in row [ar] + and column [ac] and pattern [patt]. If [b] is given, the result will be + stored in there using offsets [br] and [bc], otherwise a fresh matrix will + be used. The resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val cosh : unop (** [cosh ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the hyperbolic cosine of - the elements in the [m] by [n] sub-matrix of the matrix [a] starting - in row [ar] and column [ac] and pattern [patt]. If [b] is given, the - result will be stored in there using offsets [br] and [bc], otherwise - a fresh matrix will be used. The resulting matrix is returned. + the elements in the [m] by [n] sub-matrix of the matrix [a] starting in row + [ar] and column [ac] and pattern [patt]. If [b] is given, the result will be + stored in there using offsets [br] and [bc], otherwise a fresh matrix will + be used. The resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val tanh : unop (** [tanh ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the hyperbolic tangent of - the elements in the [m] by [n] sub-matrix of the matrix [a] starting - in row [ar] and column [ac] and pattern [patt]. If [b] is given, the - result will be stored in there using offsets [br] and [bc], otherwise - a fresh matrix will be used. The resulting matrix is returned. + the elements in the [m] by [n] sub-matrix of the matrix [a] starting in row + [ar] and column [ac] and pattern [patt]. If [b] is given, the result will be + stored in there using offsets [br] and [bc], otherwise a fresh matrix will + be used. The resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val asinh : unop -(** [asinh ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the hyperbolic arc - sine of the elements in the [m] by [n] sub-matrix of the matrix [a] - starting in row [ar] and column [ac] and pattern [patt]. If [b] is - given, the result will be stored in there using offsets [br] and [bc], - otherwise a fresh matrix will be used. The resulting matrix is returned. +(** [asinh ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the hyperbolic arc sine of + the elements in the [m] by [n] sub-matrix of the matrix [a] starting in row + [ar] and column [ac] and pattern [patt]. If [b] is given, the result will be + stored in there using offsets [br] and [bc], otherwise a fresh matrix will + be used. The resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val acosh : unop -(** [acosh ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the hyperbolic arc - cosine of the elements in the [m] by [n] sub-matrix of the matrix [a] - starting in row [ar] and column [ac] and pattern [patt]. If [b] is - given, the result will be stored in there using offsets [br] and [bc], - otherwise a fresh matrix will be used. The resulting matrix is returned. +(** [acosh ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the hyperbolic arc cosine + of the elements in the [m] by [n] sub-matrix of the matrix [a] starting in + row [ar] and column [ac] and pattern [patt]. If [b] is given, the result + will be stored in there using offsets [br] and [bc], otherwise a fresh + matrix will be used. The resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val atanh : unop -(** [atanh ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the hyperbolic arc - tangent of the elements in the [m] by [n] sub-matrix of the matrix [a] - starting in row [ar] and column [ac] and pattern [patt]. If [b] is - given, the result will be stored in there using offsets [br] and [bc], - otherwise a fresh matrix will be used. The resulting matrix is returned. +(** [atanh ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the hyperbolic arc tangent + of the elements in the [m] by [n] sub-matrix of the matrix [a] starting in + row [ar] and column [ac] and pattern [patt]. If [b] is given, the result + will be stored in there using offsets [br] and [bc], otherwise a fresh + matrix will be used. The resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val floor : unop (** [floor ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the floor of the elements - in the [m] by [n] sub-matrix of the matrix [a] starting in row [ar] - and column [ac] and pattern [patt]. If [b] is given, the result will - be stored in there using offsets [br] and [bc], otherwise a fresh matrix - will be used. The resulting matrix is returned. + in the [m] by [n] sub-matrix of the matrix [a] starting in row [ar] and + column [ac] and pattern [patt]. If [b] is given, the result will be stored + in there using offsets [br] and [bc], otherwise a fresh matrix will be used. + The resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val ceil : unop -(** [ceil ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the ceiling of the - elements in the [m] by [n] sub-matrix of the matrix [a] starting in row - [ar] and column [ac] and pattern [patt]. If [b] is given, the result - will be stored in there using offsets [br] and [bc], otherwise a fresh - matrix will be used. The resulting matrix is returned. +(** [ceil ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the ceiling of the elements + in the [m] by [n] sub-matrix of the matrix [a] starting in row [ar] and + column [ac] and pattern [patt]. If [b] is given, the result will be stored + in there using offsets [br] and [bc], otherwise a fresh matrix will be used. + The resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val round : unop -(** [round ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] rounds the elements in the [m] - by [n] sub-matrix of the matrix [a] starting in row [ar] and column - [ac] and pattern [patt]. If [b] is given, the result will be stored in - there using offsets [br] and [bc], otherwise a fresh matrix will be used. - The resulting matrix is returned. +(** [round ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] rounds the elements in the [m] by + [n] sub-matrix of the matrix [a] starting in row [ar] and column [ac] and + pattern [patt]. If [b] is given, the result will be stored in there using + offsets [br] and [bc], otherwise a fresh matrix will be used. The resulting + matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val trunc : unop -(** [trunc ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the truncation of - the elements in the [m] by [n] sub-matrix of the matrix [a] starting - in row [ar] and column [ac] and pattern [patt]. If [b] is given, the - result will be stored in there using offsets [br] and [bc], otherwise - a fresh matrix will be used. The resulting matrix is returned. +(** [trunc ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the truncation of the + elements in the [m] by [n] sub-matrix of the matrix [a] starting in row [ar] + and column [ac] and pattern [patt]. If [b] is given, the result will be + stored in there using offsets [br] and [bc], otherwise a fresh matrix will + be used. The resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val erf : unop -(** [erf ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the error function of - the elements in the [m] by [n] sub-matrix of the matrix [a] starting - in row [ar] and column [ac] and pattern [patt]. If [b] is given, the - result will be stored in there using offsets [br] and [bc], otherwise - a fresh matrix will be used. The resulting matrix is returned. +(** [erf ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the error function of the + elements in the [m] by [n] sub-matrix of the matrix [a] starting in row [ar] + and column [ac] and pattern [patt]. If [b] is given, the result will be + stored in there using offsets [br] and [bc], otherwise a fresh matrix will + be used. The resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val erfc : unop (** [erfc ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the complementary error - function of the elements in the [m] by [n] sub-matrix of the matrix - [a] starting in row [ar] and column [ac] and pattern [patt]. If [b] is - given, the result will be stored in there using offsets [br] and [bc], - otherwise a fresh matrix will be used. The resulting matrix is returned. + function of the elements in the [m] by [n] sub-matrix of the matrix [a] + starting in row [ar] and column [ac] and pattern [patt]. If [b] is given, + the result will be stored in there using offsets [br] and [bc], otherwise a + fresh matrix will be used. The resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val logistic : unop (** [logistic ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the logistic function [1/(1 + exp(-a)] of the elements in the [m] by [n] sub-matrix of the matrix - [a] starting in row [ar] and column [ac] and pattern [patt]. If [b] is + [a] starting in row [ar] and column [ac] and pattern [patt]. If [b] is given, the result will be stored in there using offsets [br] and [bc], - otherwise a fresh matrix will be used. The resulting matrix is returned. + otherwise a fresh matrix will be used. The resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val relu : unop (** [relu ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the rectified linear unit function [max(a, 0)] of the elements in the [m] by [n] sub-matrix of the - matrix [a] starting in row [ar] and column [ac] and pattern [patt]. If [b] + matrix [a] starting in row [ar] and column [ac] and pattern [patt]. If [b] is given, the result will be stored in there using offsets [br] and [bc], - otherwise a fresh matrix will be used. The resulting matrix is returned. + otherwise a fresh matrix will be used. The resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val softplus : unop (** [softplus ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the softplus function [log(1 + exp(x)] of the elements in the [m] by [n] sub-matrix of the matrix - [a] starting in row [ar] and column [ac] and pattern [patt]. If [b] is + [a] starting in row [ar] and column [ac] and pattern [patt]. If [b] is given, the result will be stored in there using offsets [br] and [bc], - otherwise a fresh matrix will be used. The resulting matrix is returned. + otherwise a fresh matrix will be used. The resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val softsign : unop (** [softsign ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] computes the softsign function [x / (1 + abs(x))] of the elements in the [m] by [n] sub-matrix of the - matrix [a] starting in row [ar] and column [ac] and pattern [patt]. If [b] + matrix [a] starting in row [ar] and column [ac] and pattern [patt]. If [b] is given, the result will be stored in there using offsets [br] and [bc], - otherwise a fresh matrix will be used. The resulting matrix is returned. + otherwise a fresh matrix will be used. The resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) - + @param ac default = 1 *) (** {6 Binary matrix operations} *) val pow : binop (** [pow ?patt ?m ?n ?cr ?cc ?c ?ar ?ac a ?br ?bc b] computes [pow(a, b)] for - the [m] by [n] sub-matrix of the matrix [a] starting in row [ar] and - column [ac] and pattern [patt] with the corresponding sub-matrix of - the matrix [b] starting in row [br] and column [bc]. If [c] is given, - the result will be stored in there starting in row [cr] and column [cc], - otherwise a fresh matrix will be used. The resulting matrix is returned. + the [m] by [n] sub-matrix of the matrix [a] starting in row [ar] and column + [ac] and pattern [patt] with the corresponding sub-matrix of the matrix [b] + starting in row [br] and column [bc]. If [c] is given, the result will be + stored in there starting in row [cr] and column [cc], otherwise a fresh + matrix will be used. The resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param cr default = 1 @param cc default = 1 - @param c default = fresh matrix with [cr + m - 1] rows and - [cc + n - 1] columns + @param c + default = fresh matrix with [cr + m - 1] rows and [cc + n - 1] columns @param br default = 1 @param bc default = 1 @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val atan2 : binop -(** [atan2 ?patt ?m ?n ?cr ?cc ?c ?ar ?ac a ?br ?bc b] computes - [atan2(a, b)] for the [m] by [n] sub-matrix of the matrix [a] starting - in row [ar] and column [ac] and pattern [patt] with the corresponding - sub-matrix of the matrix [b] starting in row [br] and column [bc]. - If [c] is given, the result will be stored in there starting in row [cr] - and column [cc], otherwise a fresh matrix will be used. The resulting - matrix is returned. +(** [atan2 ?patt ?m ?n ?cr ?cc ?c ?ar ?ac a ?br ?bc b] computes [atan2(a, b)] + for the [m] by [n] sub-matrix of the matrix [a] starting in row [ar] and + column [ac] and pattern [patt] with the corresponding sub-matrix of the + matrix [b] starting in row [br] and column [bc]. If [c] is given, the result + will be stored in there starting in row [cr] and column [cc], otherwise a + fresh matrix will be used. The resulting matrix is returned. - NOTE: WARNING! From a geometric point of view, the [atan2] function takes - the y-coordinate in [a] and the x-coordinate in [b]. This confusion is - a sad consequence of the C99-standard reversing the argument order for - [atan2] for no good reason. + NOTE: WARNING! From a geometric point of view, the [atan2] function takes + the y-coordinate in [a] and the x-coordinate in [b]. This confusion is a sad + consequence of the C99-standard reversing the argument order for [atan2] for + no good reason. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param cr default = 1 @param cc default = 1 - @param c default = fresh matrix with [cr + m - 1] rows and - [cc + n - 1] columns + @param c + default = fresh matrix with [cr + m - 1] rows and [cc + n - 1] columns @param br default = 1 @param bc default = 1 @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val hypot : binop (** [hypot ?patt ?m ?n ?cr ?cc ?c ?ar ?ac a ?br ?bc b] computes [sqrt(a*a+b*b)] - for the [m] by [n] sub-matrix of the matrix [a] starting in row [ar] - and column [ac] and pattern [patt] with the corresponding sub-matrix of - the matrix [b] starting in row [br] and column [bc]. If [c] is given, - the result will be stored in there starting in row [cr] and column [cc], - otherwise a fresh matrix will be used. The resulting matrix is returned. + for the [m] by [n] sub-matrix of the matrix [a] starting in row [ar] and + column [ac] and pattern [patt] with the corresponding sub-matrix of the + matrix [b] starting in row [br] and column [bc]. If [c] is given, the result + will be stored in there starting in row [cr] and column [cc], otherwise a + fresh matrix will be used. The resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param cr default = 1 @param cc default = 1 - @param c default = fresh matrix with [cr + m - 1] rows and - [cc + n - 1] columns + @param c + default = fresh matrix with [cr + m - 1] rows and [cc + n - 1] columns @param br default = 1 @param bc default = 1 @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val min2 : binop (** [min2 ?patt ?m ?n ?cr ?cc ?c ?ar ?ac a ?br ?bc b] computes the elementwise - minimum of the [m] by [n] sub-matrix of the matrix [a] starting in row - [ar] and column [ac] and pattern [patt] with the corresponding sub-matrix - of the matrix [b] starting in row [br] and column [bc]. If [c] is given, - the result will be stored in there starting in row [cr] and column [cc], - otherwise a fresh matrix will be used. The resulting matrix is returned. + minimum of the [m] by [n] sub-matrix of the matrix [a] starting in row [ar] + and column [ac] and pattern [patt] with the corresponding sub-matrix of the + matrix [b] starting in row [br] and column [bc]. If [c] is given, the result + will be stored in there starting in row [cr] and column [cc], otherwise a + fresh matrix will be used. The resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param cr default = 1 @param cc default = 1 - @param c default = fresh matrix with [cr + m - 1] rows and - [cc + n - 1] columns + @param c + default = fresh matrix with [cr + m - 1] rows and [cc + n - 1] columns @param br default = 1 @param bc default = 1 @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val max2 : binop (** [max2 ?patt ?m ?n ?cr ?cc ?c ?ar ?ac a ?br ?bc b] computes the elementwise - maximum of the [m] by [n] sub-matrix of the matrix [a] starting in row - [ar] and column [ac] and pattern [patt] with the corresponding sub-matrix - of the matrix [b] starting in row [br] and column [bc]. If [c] is given, - the result will be stored in there starting in row [cr] and column [cc], - otherwise a fresh matrix will be used. The resulting matrix is returned. + maximum of the [m] by [n] sub-matrix of the matrix [a] starting in row [ar] + and column [ac] and pattern [patt] with the corresponding sub-matrix of the + matrix [b] starting in row [br] and column [bc]. If [c] is given, the result + will be stored in there starting in row [cr] and column [cc], otherwise a + fresh matrix will be used. The resulting matrix is returned. @param patt default = [`Full] @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param cr default = 1 @param cc default = 1 - @param c default = fresh matrix with [cr + m - 1] rows and - [cc + n - 1] columns + @param c + default = fresh matrix with [cr + m - 1] rows and [cc + n - 1] columns @param br default = 1 @param bc default = 1 @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val sum_prod : - ?patt : patt -> - ?m : int -> - ?n : int -> - ?ar : int -> - ?ac : int -> + ?patt:patt -> + ?m:int -> + ?n:int -> + ?ar:int -> + ?ac:int -> mat -> - ?br : int -> - ?bc : int -> + ?br:int -> + ?bc:int -> mat -> float (** [sum_prod ?patt ?m ?n ?ar ?ac a ?br ?bc b] @return the sum of elementwise @@ -823,43 +773,38 @@ val sum_prod : @param bc default = 1 *) - - (** {6 Miscellaneous functions} *) val log_sum_exp : - ?patt : patt -> ?m : int -> ?n : int -> - ?ar : int -> ?ac : int -> mat -> float + ?patt:patt -> ?m:int -> ?n:int -> ?ar:int -> ?ac:int -> mat -> float (** [log_sum_exp ?patt ?m ?n ?ar ?ac a] computes the logarithm of the sum of exponentials of all elements in the [m]-by-[n] submatrix using pattern [patt], starting at row [ar] and column [ac]. @param patt default = [`Full] @param m default = number of rows of [a] - @param n default = number of columns of [a] -*) - + @param n default = number of columns of [a] *) (** {6 Ternary matrix operations} *) val cpab : - ?patt : patt -> - ?m : int -> - ?n : int -> - ?cr : int -> - ?cc : int -> + ?patt:patt -> + ?m:int -> + ?n:int -> + ?cr:int -> + ?cc:int -> + mat -> + ?ar:int -> + ?ac:int -> mat -> - ?ar : int -> - ?ac : int -> + ?br:int -> + ?bc:int -> mat -> - ?br : int -> - ?bc : int -> - mat - -> unit + unit (** [cpab ?patt ?m ?n ?cr ?cc c ?ar ?ac a ?br ?bc b] multiplies designated [m]-by-[n] range of elements of matrices [a] and [b] using pattern [patt] - elementwise and adds the result to and stores it in the specified range - in [c]. This function is useful for convolutions. Similar to [Vec.zpxy]. + elementwise and adds the result to and stores it in the specified range in + [c]. This function is useful for convolutions. Similar to [Vec.zpxy]. @param patt default = [`Full] @param m default = number of rows of [a] @@ -869,28 +814,27 @@ val cpab : @param ar default = 1 @param ac default = 1 @param br default = 1 - @param bc default = 1 -*) + @param bc default = 1 *) val cmab : - ?patt : patt -> - ?m : int -> - ?n : int -> - ?cr : int -> - ?cc : int -> + ?patt:patt -> + ?m:int -> + ?n:int -> + ?cr:int -> + ?cc:int -> mat -> - ?ar : int -> - ?ac : int -> + ?ar:int -> + ?ac:int -> mat -> - ?br : int -> - ?bc : int -> - mat - -> unit + ?br:int -> + ?bc:int -> + mat -> + unit (** [cmab ?patt ?m ?n ?cr ?cc c ?ar ?ac a ?br ?bc b] multiplies designated [m]-by-[n] range of elements of matrices [a] and [b] elementwise using - pattern [patt] and subtracts the result from and stores it in the - specified range in [c]. This function is useful for convolutions. - Similar to [Vec.zmxy]. + pattern [patt] and subtracts the result from and stores it in the specified + range in [c]. This function is useful for convolutions. Similar to + [Vec.zmxy]. @param patt default = [`Full] @param m default = number of rows of [a] @@ -900,5 +844,4 @@ val cmab : @param ar default = 1 @param ac default = 1 @param br default = 1 - @param bc default = 1 -*) + @param bc default = 1 *) diff --git a/src/mat_SDCZ.h b/src/mat_SDCZ.h index 67755dc..1f07857 100644 --- a/src/mat_SDCZ.h +++ b/src/mat_SDCZ.h @@ -1,10 +1,8 @@ /* File: mat_SDCZ.h - Copyright (C) 2007- + Copyright © 2007- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public @@ -18,32 +16,29 @@ You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ -#include -#include #include "lacaml_macros.h" +#include +#include static integer integer_one = 1; static NUMBER number_zero = NUMBER_ZERO; static NUMBER number_one = NUMBER_ONE; static NUMBER number_minus_one = NUMBER_MINUS_ONE; - /* sum_mat */ -static inline NUMBER sum_range(integer N, NUMBER *data, NUMBER acc) -{ - for (int i = 0; i < N; i++) acc = ADD_NUMBER(acc, data[i]); +static inline NUMBER sum_range(integer N, NUMBER *data, NUMBER acc) { + for (int i = 0; i < N; i++) + acc = ADD_NUMBER(acc, data[i]); return acc; } -CAMLprim vNUMBER LFUN(sum_mat_stub)( - value vPKIND, intnat vPINIT, - intnat vM, intnat vN, - intnat vAR, intnat vAC, value vA) -{ +CAMLprim vNUMBER LFUN(sum_mat_stub)(value vPKIND, intnat vPINIT, intnat vM, + intnat vN, intnat vAR, intnat vAC, + value vA) { CAMLparam1(vA); integer GET_INT(M), GET_INT(N); @@ -54,95 +49,83 @@ CAMLprim vNUMBER LFUN(sum_mat_stub)( pentagon_kind PKIND = get_pentagon_kind(vPKIND); integer GET_INT(PINIT); caml_enter_blocking_section(); - switch (PKIND) { - case UPPER : - { - NUMBER *A_stop = A_data + rows_A * N; - if (PINIT + N - 1 <= M) { - while (A_data < A_stop) { - res = sum_range(PINIT, A_data, res); - PINIT++; - A_data += rows_A; - } - } else { - while (PINIT < M) { - res = sum_range(PINIT, A_data, res); - PINIT++; - A_data += rows_A; - } - if (M == rows_A) res = sum_range(A_stop - A_data, A_data, res); - else - while (A_data < A_stop) { - res = sum_range(M, A_data, res); - A_data += rows_A; - } - } - break; + switch (PKIND) { + case UPPER: { + NUMBER *A_stop = A_data + rows_A * N; + if (PINIT + N - 1 <= M) { + while (A_data < A_stop) { + res = sum_range(PINIT, A_data, res); + PINIT++; + A_data += rows_A; + } + } else { + while (PINIT < M) { + res = sum_range(PINIT, A_data, res); + PINIT++; + A_data += rows_A; + } + if (M == rows_A) + res = sum_range(A_stop - A_data, A_data, res); + else + while (A_data < A_stop) { + res = sum_range(M, A_data, res); + A_data += rows_A; } - case LOWER : - { - NUMBER *A_stop; - integer stop_col = M + PINIT; - if (stop_col > N) stop_col = N; - A_stop = A_data + stop_col*rows_A; - if (PINIT > 1) { - if (M == rows_A) { - integer MP = M*PINIT; - res = sum_range(MP, A_data, res); - A_data += MP; - } else { - NUMBER *A_block_stop = A_data + PINIT*rows_A; - while (A_data < A_block_stop) { - res = sum_range(M, A_data, res); - A_data += rows_A; - } - } - A_data++; - M--; - } - rows_A++; - while (A_data < A_stop) { - res = sum_range(M, A_data, res); - M--; - A_data += rows_A; - } - break; + } + break; + } + case LOWER: { + NUMBER *A_stop; + integer stop_col = M + PINIT; + if (stop_col > N) + stop_col = N; + A_stop = A_data + stop_col * rows_A; + if (PINIT > 1) { + if (M == rows_A) { + integer MP = M * PINIT; + res = sum_range(MP, A_data, res); + A_data += MP; + } else { + NUMBER *A_block_stop = A_data + PINIT * rows_A; + while (A_data < A_block_stop) { + res = sum_range(M, A_data, res); + A_data += rows_A; } + } + A_data++; + M--; } + rows_A++; + while (A_data < A_stop) { + res = sum_range(M, A_data, res); + M--; + A_data += rows_A; + } + break; + } + } caml_leave_blocking_section(); } CAMLreturnNUMBER(res); } -CAMLprim value LFUN(sum_mat_stub_bc)(value *argv, int __unused argn) -{ - return - COPY_NUMBER( - LFUN(sum_mat_stub)( - argv[0], - Int_val(argv[1]), - Int_val(argv[2]), - Int_val(argv[3]), - Int_val(argv[4]), - Int_val(argv[5]), - argv[6])); +CAMLprim value LFUN(sum_mat_stub_bc)(value *argv, int __unused argn) { + return COPY_NUMBER(LFUN(sum_mat_stub)( + argv[0], Int_val(argv[1]), Int_val(argv[2]), Int_val(argv[3]), + Int_val(argv[4]), Int_val(argv[5]), argv[6])); } - /* fill_mat */ -static inline void fill_range(integer N, NUMBER *data, NUMBER v) -{ - for (int i = 0; i < N; i++) data[i] = v; +static inline void fill_range(integer N, NUMBER *data, NUMBER v) { + for (int i = 0; i < N; i++) + data[i] = v; } -CAMLprim value LFUN(fill_mat_stub)( - value vPKIND, intnat vPINIT, - intnat vM, intnat vN, - intnat vAR, intnat vAC, value vA, - vNUMBER vX) -{ +CAMLprim value LFUN(fill_mat_stub)(value vPKIND, intnat vPINIT, intnat vM, + intnat vN, intnat vAR, intnat vAC, value vA, + vNUMBER vX) { CAMLparam1(vA); integer GET_INT(M), GET_INT(N); @@ -153,97 +136,85 @@ CAMLprim value LFUN(fill_mat_stub)( integer GET_INT(PINIT); INIT_NUMBER(X); caml_enter_blocking_section(); - switch (PKIND) { - case UPPER : - { - NUMBER *A_stop = A_data + rows_A * N; - if (PINIT + N - 1 <= M) { - while (A_data < A_stop) { - fill_range(PINIT, A_data, X); - PINIT++; - A_data += rows_A; - } - } else { - while (PINIT < M) { - fill_range(PINIT, A_data, X); - PINIT++; - A_data += rows_A; - } - if (M == rows_A) fill_range(A_stop - A_data, A_data, X); - else - while (A_data < A_stop) { - fill_range(M, A_data, X); - A_data += rows_A; - } - } - break; + switch (PKIND) { + case UPPER: { + NUMBER *A_stop = A_data + rows_A * N; + if (PINIT + N - 1 <= M) { + while (A_data < A_stop) { + fill_range(PINIT, A_data, X); + PINIT++; + A_data += rows_A; + } + } else { + while (PINIT < M) { + fill_range(PINIT, A_data, X); + PINIT++; + A_data += rows_A; + } + if (M == rows_A) + fill_range(A_stop - A_data, A_data, X); + else + while (A_data < A_stop) { + fill_range(M, A_data, X); + A_data += rows_A; } - case LOWER : - { - NUMBER *A_stop; - integer stop_col = M + PINIT; - if (stop_col > N) stop_col = N; - A_stop = A_data + stop_col*rows_A; - if (PINIT > 1) { - if (M == rows_A) { - integer MP = M*PINIT; - fill_range(MP, A_data, X); - A_data += MP; - } else { - NUMBER *A_block_stop = A_data + PINIT*rows_A; - while (A_data < A_block_stop) { - fill_range(M, A_data, X); - A_data += rows_A; - } - } - A_data++; - M--; - } - rows_A++; - while (A_data < A_stop) { - fill_range(M, A_data, X); - M--; - A_data += rows_A; - } - break; + } + break; + } + case LOWER: { + NUMBER *A_stop; + integer stop_col = M + PINIT; + if (stop_col > N) + stop_col = N; + A_stop = A_data + stop_col * rows_A; + if (PINIT > 1) { + if (M == rows_A) { + integer MP = M * PINIT; + fill_range(MP, A_data, X); + A_data += MP; + } else { + NUMBER *A_block_stop = A_data + PINIT * rows_A; + while (A_data < A_block_stop) { + fill_range(M, A_data, X); + A_data += rows_A; } + } + A_data++; + M--; } + rows_A++; + while (A_data < A_stop) { + fill_range(M, A_data, X); + M--; + A_data += rows_A; + } + break; + } + } caml_leave_blocking_section(); } CAMLreturn(Val_unit); } -CAMLprim value LFUN(fill_mat_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(fill_mat_stub)( - argv[0], - Int_val(argv[1]), - Int_val(argv[2]), - Int_val(argv[3]), - Int_val(argv[4]), - Int_val(argv[5]), - argv[6], - NUMBER_val(argv[7])); +CAMLprim value LFUN(fill_mat_stub_bc)(value *argv, int __unused argn) { + return LFUN(fill_mat_stub)(argv[0], Int_val(argv[1]), Int_val(argv[2]), + Int_val(argv[3]), Int_val(argv[4]), + Int_val(argv[5]), argv[6], NUMBER_val(argv[7])); } - /* add_const_mat */ -static inline void add_const_range( - integer N, NUMBER *A_data, NUMBER *B_data, NUMBER v) -{ - for (int i = 0; i < N; i++) B_data[i] = ADD_NUMBER(A_data[i], v); +static inline void add_const_range(integer N, NUMBER *A_data, NUMBER *B_data, + NUMBER v) { + for (int i = 0; i < N; i++) + B_data[i] = ADD_NUMBER(A_data[i], v); } -CAMLprim value LFUN(add_const_mat_stub)( - vNUMBER vC, - value vPKIND, intnat vPINIT, - intnat vM, intnat vN, - intnat vAR, intnat vAC, value vA, - intnat vBR, intnat vBC, value vB) -{ +CAMLprim value LFUN(add_const_mat_stub)(vNUMBER vC, value vPKIND, intnat vPINIT, + intnat vM, intnat vN, intnat vAR, + intnat vAC, value vA, intnat vBR, + intnat vBC, value vB) { CAMLparam2(vA, vB); integer GET_INT(M), GET_INT(N); @@ -256,108 +227,91 @@ CAMLprim value LFUN(add_const_mat_stub)( integer GET_INT(PINIT); INIT_NUMBER(C); - caml_enter_blocking_section(); /* Allow other threads */ - switch (PKIND) { - case UPPER : - { - NUMBER *A_stop = A_data + rows_A * N; - if (PINIT + N - 1 <= M) { - while (A_data < A_stop) { - add_const_range(PINIT, A_data, B_data, C); - PINIT++; - A_data += rows_A; - B_data += rows_B; - } - } else { - while (PINIT < M) { - add_const_range(PINIT, A_data, B_data, C); - PINIT++; - A_data += rows_A; - B_data += rows_B; - } - if (M == rows_A && M == rows_B) - add_const_range(A_stop - A_data, A_data, B_data, C); - else - while (A_data < A_stop) { - add_const_range(M, A_data, B_data, C); - A_data += rows_A; - B_data += rows_B; - } - } - break; + caml_enter_blocking_section(); /* Allow other threads */ + switch (PKIND) { + case UPPER: { + NUMBER *A_stop = A_data + rows_A * N; + if (PINIT + N - 1 <= M) { + while (A_data < A_stop) { + add_const_range(PINIT, A_data, B_data, C); + PINIT++; + A_data += rows_A; + B_data += rows_B; + } + } else { + while (PINIT < M) { + add_const_range(PINIT, A_data, B_data, C); + PINIT++; + A_data += rows_A; + B_data += rows_B; + } + if (M == rows_A && M == rows_B) + add_const_range(A_stop - A_data, A_data, B_data, C); + else + while (A_data < A_stop) { + add_const_range(M, A_data, B_data, C); + A_data += rows_A; + B_data += rows_B; } - case LOWER : - { - NUMBER *A_stop; - integer stop_col = M + PINIT; - if (stop_col > N) stop_col = N; - A_stop = A_data + stop_col*rows_A; - if (PINIT > 1) { - if (M == rows_A && M == rows_B) { - integer MP = M*PINIT; - add_const_range(MP, A_data, B_data, C); - A_data += MP; - B_data += MP; - } else { - NUMBER *A_block_stop = A_data + PINIT*rows_A; - while (A_data < A_block_stop) { - add_const_range(M, A_data, B_data, C); - A_data += rows_A; - B_data += rows_B; - } - } - A_data++; - B_data++; - M--; - } - rows_A++; - rows_B++; - while (A_data < A_stop) { - add_const_range(M, A_data, B_data, C); - M--; - A_data += rows_A; - B_data += rows_B; - } - break; + } + break; + } + case LOWER: { + NUMBER *A_stop; + integer stop_col = M + PINIT; + if (stop_col > N) + stop_col = N; + A_stop = A_data + stop_col * rows_A; + if (PINIT > 1) { + if (M == rows_A && M == rows_B) { + integer MP = M * PINIT; + add_const_range(MP, A_data, B_data, C); + A_data += MP; + B_data += MP; + } else { + NUMBER *A_block_stop = A_data + PINIT * rows_A; + while (A_data < A_block_stop) { + add_const_range(M, A_data, B_data, C); + A_data += rows_A; + B_data += rows_B; } + } + A_data++; + B_data++; + M--; + } + rows_A++; + rows_B++; + while (A_data < A_stop) { + add_const_range(M, A_data, B_data, C); + M--; + A_data += rows_A; + B_data += rows_B; } - caml_leave_blocking_section(); /* Disallow other threads */ + break; + } + } + caml_leave_blocking_section(); /* Disallow other threads */ } CAMLreturn(Val_unit); } -CAMLprim value LFUN(add_const_mat_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(add_const_mat_stub)( - NUMBER_val(argv[0]), - argv[1], - Int_val(argv[2]), - Int_val(argv[3]), - Int_val(argv[4]), - Int_val(argv[5]), - Int_val(argv[6]), - argv[7], - Int_val(argv[8]), - Int_val(argv[9]), - argv[10]); +CAMLprim value LFUN(add_const_mat_stub_bc)(value *argv, int __unused argn) { + return LFUN(add_const_mat_stub)( + NUMBER_val(argv[0]), argv[1], Int_val(argv[2]), Int_val(argv[3]), + Int_val(argv[4]), Int_val(argv[5]), Int_val(argv[6]), argv[7], + Int_val(argv[8]), Int_val(argv[9]), argv[10]); } - /* swap */ -extern void FUN(swap)( - integer *N, - NUMBER *X, integer *INCX, - NUMBER *Y, integer *INCY); - -CAMLprim value LFUN(swap_mat_stub)( - value vPKIND, intnat vPINIT, - intnat vM, intnat vN, - intnat vAR, intnat vAC, value vA, - intnat vBR, intnat vBC, value vB) -{ +extern void FUN(swap)(integer *N, NUMBER *X, integer *INCX, NUMBER *Y, + integer *INCY); + +CAMLprim value LFUN(swap_mat_stub)(value vPKIND, intnat vPINIT, intnat vM, + intnat vN, intnat vAR, intnat vAC, value vA, + intnat vBR, intnat vBC, value vB) { CAMLparam2(vA, vB); integer GET_INT(M), GET_INT(N); @@ -367,106 +321,91 @@ CAMLprim value LFUN(swap_mat_stub)( pentagon_kind PKIND = get_pentagon_kind(vPKIND); integer GET_INT(PINIT); caml_enter_blocking_section(); - switch (PKIND) { - case UPPER : - { - NUMBER *A_stop = A_data + rows_A * N; - if (PINIT + N - 1 <= M) { - while (A_data < A_stop) { - FUN(swap)(&PINIT, A_data, &integer_one, B_data, &integer_one); - PINIT++; - A_data += rows_A; - B_data += rows_B; - } - } else { - while (PINIT < M) { - FUN(swap)(&PINIT, A_data, &integer_one, B_data, &integer_one); - PINIT++; - A_data += rows_A; - B_data += rows_B; - } - if (M == rows_A && M == rows_B) { - integer MN = A_stop - A_data; - FUN(swap)(&MN, A_data, &integer_one, B_data, &integer_one); - } else - while (A_data < A_stop) { - FUN(swap)(&M, A_data, &integer_one, B_data, &integer_one); - A_data += rows_A; - B_data += rows_B; - } - } - break; + switch (PKIND) { + case UPPER: { + NUMBER *A_stop = A_data + rows_A * N; + if (PINIT + N - 1 <= M) { + while (A_data < A_stop) { + FUN(swap)(&PINIT, A_data, &integer_one, B_data, &integer_one); + PINIT++; + A_data += rows_A; + B_data += rows_B; + } + } else { + while (PINIT < M) { + FUN(swap)(&PINIT, A_data, &integer_one, B_data, &integer_one); + PINIT++; + A_data += rows_A; + B_data += rows_B; + } + if (M == rows_A && M == rows_B) { + integer MN = A_stop - A_data; + FUN(swap)(&MN, A_data, &integer_one, B_data, &integer_one); + } else + while (A_data < A_stop) { + FUN(swap)(&M, A_data, &integer_one, B_data, &integer_one); + A_data += rows_A; + B_data += rows_B; } - case LOWER : - { - NUMBER *A_stop; - integer stop_col = M + PINIT; - if (stop_col > N) stop_col = N; - A_stop = A_data + stop_col*rows_A; - if (PINIT > 1) { - if (M == rows_A && M == rows_B) { - integer MP = M*PINIT; - FUN(swap)(&MP, A_data, &integer_one, B_data, &integer_one); - A_data += MP; - B_data += MP; - } else { - NUMBER *A_block_stop = A_data + PINIT*rows_A; - while (A_data < A_block_stop) { - FUN(swap)(&M, A_data, &integer_one, B_data, &integer_one); - A_data += rows_A; - B_data += rows_B; - } - } - A_data++; - B_data++; - M--; - } - rows_A++; - rows_B++; - while (A_data < A_stop) { - FUN(swap)(&M, A_data, &integer_one, B_data, &integer_one); - M--; - A_data += rows_A; - B_data += rows_B; - } - break; + } + break; + } + case LOWER: { + NUMBER *A_stop; + integer stop_col = M + PINIT; + if (stop_col > N) + stop_col = N; + A_stop = A_data + stop_col * rows_A; + if (PINIT > 1) { + if (M == rows_A && M == rows_B) { + integer MP = M * PINIT; + FUN(swap)(&MP, A_data, &integer_one, B_data, &integer_one); + A_data += MP; + B_data += MP; + } else { + NUMBER *A_block_stop = A_data + PINIT * rows_A; + while (A_data < A_block_stop) { + FUN(swap)(&M, A_data, &integer_one, B_data, &integer_one); + A_data += rows_A; + B_data += rows_B; } + } + A_data++; + B_data++; + M--; + } + rows_A++; + rows_B++; + while (A_data < A_stop) { + FUN(swap)(&M, A_data, &integer_one, B_data, &integer_one); + M--; + A_data += rows_A; + B_data += rows_B; } + break; + } + } caml_leave_blocking_section(); } CAMLreturn(Val_unit); } -CAMLprim value LFUN(swap_mat_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(swap_mat_stub)( - argv[0], - Int_val(argv[1]), - Int_val(argv[2]), - Int_val(argv[3]), - Int_val(argv[4]), - Int_val(argv[5]), - argv[6], - Int_val(argv[7]), - Int_val(argv[8]), - argv[9]); +CAMLprim value LFUN(swap_mat_stub_bc)(value *argv, int __unused argn) { + return LFUN(swap_mat_stub)(argv[0], Int_val(argv[1]), Int_val(argv[2]), + Int_val(argv[3]), Int_val(argv[4]), + Int_val(argv[5]), argv[6], Int_val(argv[7]), + Int_val(argv[8]), argv[9]); } - /* transpose */ -extern void FUN(copy)( - integer *N, - NUMBER *X, integer *INCX, - NUMBER *Y, integer *INCY); +extern void FUN(copy)(integer *N, NUMBER *X, integer *INCX, NUMBER *Y, + integer *INCY); -CAMLprim value LFUN(transpose_copy_stub)( - intnat vM, intnat vN, - intnat vAR, intnat vAC, value vA, - intnat vBR, intnat vBC, value vB) -{ +CAMLprim value LFUN(transpose_copy_stub)(intnat vM, intnat vN, intnat vAR, + intnat vAC, value vA, intnat vBR, + intnat vBC, value vB) { CAMLparam2(vA, vB); integer GET_INT(M), GET_INT(N); @@ -475,141 +414,113 @@ CAMLprim value LFUN(transpose_copy_stub)( MAT_PARAMS(B); NUMBER *A_stop = A_data + rows_A * N; caml_enter_blocking_section(); - do { - FUN(copy)(&M, A_data, &integer_one, B_data, &rows_B); - A_data += rows_A; - B_data++; - } while (A_data != A_stop); + do { + FUN(copy)(&M, A_data, &integer_one, B_data, &rows_B); + A_data += rows_A; + B_data++; + } while (A_data != A_stop); caml_leave_blocking_section(); } CAMLreturn(Val_unit); } -CAMLprim value LFUN(transpose_copy_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(transpose_copy_stub)( - Int_val(argv[0]), - Int_val(argv[1]), - Int_val(argv[2]), - Int_val(argv[3]), - argv[4], - Int_val(argv[5]), - Int_val(argv[6]), - argv[7]); +CAMLprim value LFUN(transpose_copy_stub_bc)(value *argv, int __unused argn) { + return LFUN(transpose_copy_stub)(Int_val(argv[0]), Int_val(argv[1]), + Int_val(argv[2]), Int_val(argv[3]), argv[4], + Int_val(argv[5]), Int_val(argv[6]), argv[7]); } - /* scal */ -extern void FUN(scal)( - integer *N, - NUMBER *ALPHA, - NUMBER *X, integer *INCX); - -CAMLprim value LFUN(scal_mat_stub)( - value vPKIND, intnat vPINIT, - intnat vM, intnat vN, - vNUMBER vALPHA, - intnat vAR, intnat vAC, value vA) -{ +extern void FUN(scal)(integer *N, NUMBER *ALPHA, NUMBER *X, integer *INCX); + +CAMLprim value LFUN(scal_mat_stub)(value vPKIND, intnat vPINIT, intnat vM, + intnat vN, vNUMBER vALPHA, intnat vAR, + intnat vAC, value vA) { CAMLparam1(vA); integer GET_INT(M), GET_INT(N); - if ( M > 0 && N > 0) { + if (M > 0 && N > 0) { NUMBER ALPHA; MAT_PARAMS(A); INIT_NUMBER(ALPHA); pentagon_kind PKIND = get_pentagon_kind(vPKIND); integer GET_INT(PINIT); caml_enter_blocking_section(); - switch (PKIND) { - case UPPER : - { - NUMBER *A_stop = A_data + rows_A * N; - if (PINIT + N - 1 <= M) { - while (A_data < A_stop) { - FUN(scal)(&PINIT, &ALPHA, A_data, &integer_one); - PINIT++; - A_data += rows_A; - } - } else { - while (PINIT < M) { - FUN(scal)(&PINIT, &ALPHA, A_data, &integer_one); - PINIT++; - A_data += rows_A; - } - if (M == rows_A) { - integer MN = A_stop - A_data; - FUN(scal)(&MN, &ALPHA, A_data, &integer_one); - } else - while (A_data < A_stop) { - FUN(scal)(&M, &ALPHA, A_data, &integer_one); - A_data += rows_A; - } - } - break; + switch (PKIND) { + case UPPER: { + NUMBER *A_stop = A_data + rows_A * N; + if (PINIT + N - 1 <= M) { + while (A_data < A_stop) { + FUN(scal)(&PINIT, &ALPHA, A_data, &integer_one); + PINIT++; + A_data += rows_A; + } + } else { + while (PINIT < M) { + FUN(scal)(&PINIT, &ALPHA, A_data, &integer_one); + PINIT++; + A_data += rows_A; + } + if (M == rows_A) { + integer MN = A_stop - A_data; + FUN(scal)(&MN, &ALPHA, A_data, &integer_one); + } else + while (A_data < A_stop) { + FUN(scal)(&M, &ALPHA, A_data, &integer_one); + A_data += rows_A; } - case LOWER : - { - NUMBER *A_stop; - integer stop_col = M + PINIT; - if (stop_col > N) stop_col = N; - A_stop = A_data + stop_col*rows_A; - if (PINIT > 1) { - if (M == rows_A) { - integer MP = M*PINIT; - FUN(scal)(&MP, &ALPHA, A_data, &integer_one); - A_data += MP; - } else { - NUMBER *A_block_stop = A_data + PINIT*rows_A; - while (A_data < A_block_stop) { - FUN(scal)(&M, &ALPHA, A_data, &integer_one); - A_data += rows_A; - } - } - A_data++; - M--; - } - rows_A++; - while (A_data < A_stop) { - FUN(scal)(&M, &ALPHA, A_data, &integer_one); - M--; - A_data += rows_A; - } - break; + } + break; + } + case LOWER: { + NUMBER *A_stop; + integer stop_col = M + PINIT; + if (stop_col > N) + stop_col = N; + A_stop = A_data + stop_col * rows_A; + if (PINIT > 1) { + if (M == rows_A) { + integer MP = M * PINIT; + FUN(scal)(&MP, &ALPHA, A_data, &integer_one); + A_data += MP; + } else { + NUMBER *A_block_stop = A_data + PINIT * rows_A; + while (A_data < A_block_stop) { + FUN(scal)(&M, &ALPHA, A_data, &integer_one); + A_data += rows_A; } + } + A_data++; + M--; } + rows_A++; + while (A_data < A_stop) { + FUN(scal)(&M, &ALPHA, A_data, &integer_one); + M--; + A_data += rows_A; + } + break; + } + } caml_leave_blocking_section(); } CAMLreturn(Val_unit); } -CAMLprim value LFUN(scal_mat_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(scal_mat_stub)( - argv[0], - Int_val(argv[1]), - Int_val(argv[2]), - Int_val(argv[3]), - NUMBER_val(argv[4]), - Int_val(argv[5]), - Int_val(argv[6]), - argv[7]); +CAMLprim value LFUN(scal_mat_stub_bc)(value *argv, int __unused argn) { + return LFUN(scal_mat_stub)(argv[0], Int_val(argv[1]), Int_val(argv[2]), + Int_val(argv[3]), NUMBER_val(argv[4]), + Int_val(argv[5]), Int_val(argv[6]), argv[7]); } - /* scal_cols */ -CAMLprim value LFUN(scal_cols_stub)( - value vPKIND, intnat vPINIT, - intnat vM, intnat vN, - intnat vAR, intnat vAC, value vA, - intnat vOFSALPHAs, value vALPHAs) -{ +CAMLprim value LFUN(scal_cols_stub)(value vPKIND, intnat vPINIT, intnat vM, + intnat vN, intnat vAR, intnat vAC, value vA, + intnat vOFSALPHAs, value vALPHAs) { CAMLparam2(vALPHAs, vA); integer GET_INT(M), GET_INT(N); @@ -619,92 +530,78 @@ CAMLprim value LFUN(scal_cols_stub)( pentagon_kind PKIND = get_pentagon_kind(vPKIND); integer GET_INT(PINIT); caml_enter_blocking_section(); - switch (PKIND) { - case UPPER : - { - NUMBER *A_stop = A_data + rows_A * N; - if (PINIT + N - 1 <= M) { - while (A_data < A_stop) { - FUN(scal)(&PINIT, ALPHAs_data, A_data, &integer_one); - PINIT++; - A_data += rows_A; - ALPHAs_data++; - } - } else { - while (PINIT < M) { - FUN(scal)(&PINIT, ALPHAs_data, A_data, &integer_one); - PINIT++; - A_data += rows_A; - ALPHAs_data++; - } - if (M == rows_A) { - integer MN = A_stop - A_data; - FUN(scal)(&MN, ALPHAs_data, A_data, &integer_one); - } else - while (A_data < A_stop) { - FUN(scal)(&M, ALPHAs_data, A_data, &integer_one); - A_data += rows_A; - ALPHAs_data++; - } - } - break; - } - case LOWER : - { - NUMBER *A_stop; - integer stop_col = M + PINIT; - if (stop_col > N) stop_col = N; - A_stop = A_data + stop_col*rows_A; - if (PINIT > 1) { - NUMBER *A_block_stop = A_data + PINIT*rows_A; - while (A_data < A_block_stop) { - FUN(scal)(&M, ALPHAs_data, A_data, &integer_one); - A_data += rows_A; - ALPHAs_data++; - } - A_data++; - M--; - } - rows_A++; - while (A_data < A_stop) { - FUN(scal)(&M, ALPHAs_data, A_data, &integer_one); - M--; - A_data += rows_A; - ALPHAs_data++; - } - break; + switch (PKIND) { + case UPPER: { + NUMBER *A_stop = A_data + rows_A * N; + if (PINIT + N - 1 <= M) { + while (A_data < A_stop) { + FUN(scal)(&PINIT, ALPHAs_data, A_data, &integer_one); + PINIT++; + A_data += rows_A; + ALPHAs_data++; + } + } else { + while (PINIT < M) { + FUN(scal)(&PINIT, ALPHAs_data, A_data, &integer_one); + PINIT++; + A_data += rows_A; + ALPHAs_data++; + } + if (M == rows_A) { + integer MN = A_stop - A_data; + FUN(scal)(&MN, ALPHAs_data, A_data, &integer_one); + } else + while (A_data < A_stop) { + FUN(scal)(&M, ALPHAs_data, A_data, &integer_one); + A_data += rows_A; + ALPHAs_data++; } } + break; + } + case LOWER: { + NUMBER *A_stop; + integer stop_col = M + PINIT; + if (stop_col > N) + stop_col = N; + A_stop = A_data + stop_col * rows_A; + if (PINIT > 1) { + NUMBER *A_block_stop = A_data + PINIT * rows_A; + while (A_data < A_block_stop) { + FUN(scal)(&M, ALPHAs_data, A_data, &integer_one); + A_data += rows_A; + ALPHAs_data++; + } + A_data++; + M--; + } + rows_A++; + while (A_data < A_stop) { + FUN(scal)(&M, ALPHAs_data, A_data, &integer_one); + M--; + A_data += rows_A; + ALPHAs_data++; + } + break; + } + } caml_leave_blocking_section(); } CAMLreturn(Val_unit); } -CAMLprim value LFUN(scal_cols_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(scal_cols_stub)( - argv[0], - Int_val(argv[1]), - Int_val(argv[2]), - Int_val(argv[3]), - Int_val(argv[4]), - Int_val(argv[5]), - argv[6], - Int_val(argv[7]), - argv[8]); +CAMLprim value LFUN(scal_cols_stub_bc)(value *argv, int __unused argn) { + return LFUN(scal_cols_stub)( + argv[0], Int_val(argv[1]), Int_val(argv[2]), Int_val(argv[3]), + Int_val(argv[4]), Int_val(argv[5]), argv[6], Int_val(argv[7]), argv[8]); } - /* scal_rows */ -CAMLprim value LFUN(scal_rows_stub)( - value vPKIND, intnat vPINIT, - intnat vM, intnat vN, - intnat vOFSALPHAs, value vALPHAs, - intnat vAR, intnat vAC, value vA) -{ +CAMLprim value LFUN(scal_rows_stub)(value vPKIND, intnat vPINIT, intnat vM, + intnat vN, intnat vOFSALPHAs, value vALPHAs, + intnat vAR, intnat vAC, value vA) { CAMLparam2(vALPHAs, vA); integer GET_INT(M), GET_INT(N); @@ -714,77 +611,58 @@ CAMLprim value LFUN(scal_rows_stub)( pentagon_kind PKIND = get_pentagon_kind(vPKIND); integer GET_INT(PINIT); caml_enter_blocking_section(); - switch (PKIND) { - case UPPER : - { - NUMBER *A_stop = A_data + M + (M - PINIT + 1) * rows_A; - while (--PINIT) { - FUN(scal)(&N, ALPHAs_data, A_data, &rows_A); - A_data++; - ALPHAs_data++; - } - while (A_data != A_stop && N > 0) { - FUN(scal)(&N, ALPHAs_data, A_data, &rows_A); - A_data += rows_A + 1; - ALPHAs_data++; - N--; - } - break; - } - case LOWER : - { - NUMBER *A_stop = A_data + M; - while (A_data < A_stop && PINIT < N) { - FUN(scal)(&PINIT, ALPHAs_data, A_data, &rows_A); - A_data++; - ALPHAs_data++; - PINIT++; - } - while (A_data < A_stop) { - FUN(scal)(&PINIT, ALPHAs_data, A_data, &rows_A); - A_data++; - ALPHAs_data++; - } - break; - } + switch (PKIND) { + case UPPER: { + NUMBER *A_stop = A_data + M + (M - PINIT + 1) * rows_A; + while (--PINIT) { + FUN(scal)(&N, ALPHAs_data, A_data, &rows_A); + A_data++; + ALPHAs_data++; + } + while (A_data != A_stop && N > 0) { + FUN(scal)(&N, ALPHAs_data, A_data, &rows_A); + A_data += rows_A + 1; + ALPHAs_data++; + N--; + } + break; + } + case LOWER: { + NUMBER *A_stop = A_data + M; + while (A_data < A_stop && PINIT < N) { + FUN(scal)(&PINIT, ALPHAs_data, A_data, &rows_A); + A_data++; + ALPHAs_data++; + PINIT++; + } + while (A_data < A_stop) { + FUN(scal)(&PINIT, ALPHAs_data, A_data, &rows_A); + A_data++; + ALPHAs_data++; } + break; + } + } caml_leave_blocking_section(); } CAMLreturn(Val_unit); } -CAMLprim value LFUN(scal_rows_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(scal_rows_stub)( - argv[0], - Int_val(argv[1]), - Int_val(argv[2]), - Int_val(argv[3]), - Int_val(argv[4]), - argv[5], - Int_val(argv[6]), - Int_val(argv[7]), - argv[8]); +CAMLprim value LFUN(scal_rows_stub_bc)(value *argv, int __unused argn) { + return LFUN(scal_rows_stub)(argv[0], Int_val(argv[1]), Int_val(argv[2]), + Int_val(argv[3]), Int_val(argv[4]), argv[5], + Int_val(argv[6]), Int_val(argv[7]), argv[8]); } - /* axpy_mat */ -extern void FUN(axpy)( - integer *N, - NUMBER *ALPHA, - NUMBER *X, integer *INCX, - NUMBER *Y, integer *INCY); - -CAMLprim value LFUN(axpy_mat_stub)( - vNUMBER vALPHA, - value vPKIND, intnat vPINIT, - intnat vM, intnat vN, - intnat vXR, intnat vXC, value vX, - intnat vYR, intnat vYC, value vY) -{ +extern void FUN(axpy)(integer *N, NUMBER *ALPHA, NUMBER *X, integer *INCX, + NUMBER *Y, integer *INCY); + +CAMLprim value LFUN(axpy_mat_stub)(vNUMBER vALPHA, value vPKIND, intnat vPINIT, + intnat vM, intnat vN, intnat vXR, intnat vXC, + value vX, intnat vYR, intnat vYC, value vY) { CAMLparam2(vX, vY); integer GET_INT(M), GET_INT(N); if (M > 0 && N > 0) { @@ -795,211 +673,198 @@ CAMLprim value LFUN(axpy_mat_stub)( integer GET_INT(PINIT); INIT_NUMBER(ALPHA); caml_enter_blocking_section(); - switch (PKIND) { - case UPPER : - { - NUMBER *X_stop = X_data + rows_X * N; - if (PINIT + N - 1 <= M) { - while (X_data < X_stop) { - FUN(axpy)(&PINIT, &ALPHA, - X_data, &integer_one, Y_data, &integer_one); - PINIT++; - X_data += rows_X; - Y_data += rows_Y; - } - } else { - while (PINIT < M) { - FUN(axpy)(&PINIT, &ALPHA, - X_data, &integer_one, Y_data, &integer_one); - PINIT++; - X_data += rows_X; - Y_data += rows_Y; - } - if (M == rows_X && M == rows_Y) { - integer MN = X_stop - X_data; - FUN(axpy)(&MN, &ALPHA, - X_data, &integer_one, Y_data, &integer_one); - } else - while (X_data < X_stop) { - FUN(axpy)(&M, &ALPHA, - X_data, &integer_one, Y_data, &integer_one); - X_data += rows_X; - Y_data += rows_Y; - } - } - break; + switch (PKIND) { + case UPPER: { + NUMBER *X_stop = X_data + rows_X * N; + if (PINIT + N - 1 <= M) { + while (X_data < X_stop) { + FUN(axpy)(&PINIT, &ALPHA, X_data, &integer_one, Y_data, &integer_one); + PINIT++; + X_data += rows_X; + Y_data += rows_Y; + } + } else { + while (PINIT < M) { + FUN(axpy)(&PINIT, &ALPHA, X_data, &integer_one, Y_data, &integer_one); + PINIT++; + X_data += rows_X; + Y_data += rows_Y; + } + if (M == rows_X && M == rows_Y) { + integer MN = X_stop - X_data; + FUN(axpy)(&MN, &ALPHA, X_data, &integer_one, Y_data, &integer_one); + } else + while (X_data < X_stop) { + FUN(axpy)(&M, &ALPHA, X_data, &integer_one, Y_data, &integer_one); + X_data += rows_X; + Y_data += rows_Y; } - case LOWER : - { - NUMBER *X_stop; - integer stop_col = M + PINIT; - if (stop_col > N) stop_col = N; - X_stop = X_data + stop_col*rows_X; - if (PINIT > 1) { - if (M == rows_X && M == rows_Y) { - integer MP = M*PINIT; - FUN(axpy)(&MP, &ALPHA, - X_data, &integer_one, Y_data, &integer_one); - X_data += MP; - Y_data += MP; - } else { - NUMBER *X_block_stop = X_data + PINIT*rows_X; - while (X_data < X_block_stop) { - FUN(axpy)(&M, &ALPHA, - X_data, &integer_one, Y_data, &integer_one); - X_data += rows_X; - Y_data += rows_Y; - } - } - X_data++; - Y_data++; - M--; - } - rows_X++; - rows_Y++; - while (X_data < X_stop) { - FUN(axpy)(&M, &ALPHA, - X_data, &integer_one, Y_data, &integer_one); - M--; - X_data += rows_X; - Y_data += rows_Y; - } - break; + } + break; + } + case LOWER: { + NUMBER *X_stop; + integer stop_col = M + PINIT; + if (stop_col > N) + stop_col = N; + X_stop = X_data + stop_col * rows_X; + if (PINIT > 1) { + if (M == rows_X && M == rows_Y) { + integer MP = M * PINIT; + FUN(axpy)(&MP, &ALPHA, X_data, &integer_one, Y_data, &integer_one); + X_data += MP; + Y_data += MP; + } else { + NUMBER *X_block_stop = X_data + PINIT * rows_X; + while (X_data < X_block_stop) { + FUN(axpy)(&M, &ALPHA, X_data, &integer_one, Y_data, &integer_one); + X_data += rows_X; + Y_data += rows_Y; } + } + X_data++; + Y_data++; + M--; + } + rows_X++; + rows_Y++; + while (X_data < X_stop) { + FUN(axpy)(&M, &ALPHA, X_data, &integer_one, Y_data, &integer_one); + M--; + X_data += rows_X; + Y_data += rows_Y; } + break; + } + } caml_leave_blocking_section(); } CAMLreturn(Val_unit); } -CAMLprim value LFUN(axpy_mat_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(axpy_mat_stub)( - NUMBER_val(argv[0]), - argv[1], - Int_val(argv[2]), - Int_val(argv[3]), - Int_val(argv[4]), - Int_val(argv[5]), - Int_val(argv[6]), - argv[7], - Int_val(argv[8]), - Int_val(argv[9]), - argv[10]); +CAMLprim value LFUN(axpy_mat_stub_bc)(value *argv, int __unused argn) { + return LFUN(axpy_mat_stub)(NUMBER_val(argv[0]), argv[1], Int_val(argv[2]), + Int_val(argv[3]), Int_val(argv[4]), + Int_val(argv[5]), Int_val(argv[6]), argv[7], + Int_val(argv[8]), Int_val(argv[9]), argv[10]); } - /* gemm_diag */ -#define COMMON_DIAG_LOOP(MFUN) \ - if (NUMBER_EQUAL(ALPHA, number_zero)) \ - FUN(scal)(&N, &BETA, Y_data, &integer_one); \ - else { \ - if (NUMBER_EQUAL(ALPHA, number_one)) { \ - if (NUMBER_EQUAL(BETA, number_zero)) \ - MFUN##_DIAG_LOOP(*Y_data = d) \ - else if (NUMBER_EQUAL(BETA, number_one)) \ - MFUN##_DIAG_LOOP_WITH_Y(*Y_data = ADD_NUMBER(d, y)) \ - else if (NUMBER_EQUAL(BETA, number_minus_one)) \ - MFUN##_DIAG_LOOP_WITH_Y(*Y_data = SUB_NUMBER(d, y)) \ - else \ - MFUN##_DIAG_LOOP_WITH_Y( \ - NUMBER tmp = MUL_NUMBER(y, BETA); \ - *Y_data = ADD_NUMBER(d, tmp)) \ - } else if (NUMBER_EQUAL(ALPHA, number_minus_one)) { \ - if (NUMBER_EQUAL(BETA, number_zero)) \ - MFUN##_DIAG_LOOP(*Y_data = NEG_NUMBER(d)) \ - else if (NUMBER_EQUAL(BETA, number_one)) \ - MFUN##_DIAG_LOOP_WITH_Y(*Y_data = SUB_NUMBER(y, d)) \ - else if (NUMBER_EQUAL(BETA, number_minus_one)) \ - MFUN##_DIAG_LOOP_WITH_Y( \ - NUMBER tmp = ADD_NUMBER(d, y); \ - *Y_data = NEG_NUMBER(tmp)) \ - else \ - MFUN##_DIAG_LOOP_WITH_Y( \ - NUMBER tmp = MUL_NUMBER(y, BETA); \ - *Y_data = SUB_NUMBER(tmp, d)) \ - } else { \ - if (NUMBER_EQUAL(BETA, number_zero)) \ - MFUN##_DIAG_LOOP(*Y_data = MUL_NUMBER(ALPHA, d)) \ - else if (NUMBER_EQUAL(BETA, number_one)) \ - MFUN##_DIAG_LOOP_WITH_Y( \ - NUMBER tmp = MUL_NUMBER(ALPHA, d); \ - *Y_data = ADD_NUMBER(tmp, y)) \ - else if (NUMBER_EQUAL(BETA, number_minus_one)) \ - MFUN##_DIAG_LOOP_WITH_Y( \ - NUMBER tmp = MUL_NUMBER(ALPHA, d); \ - *Y_data = SUB_NUMBER(tmp, y)) \ - else \ - MFUN##_DIAG_LOOP_WITH_Y( \ - NUMBER ad = MUL_NUMBER(ALPHA, d); \ - NUMBER yb = MUL_NUMBER(BETA, y); \ - *Y_data = ADD_NUMBER(ad, yb)) \ - } \ +#define COMMON_DIAG_LOOP(MFUN) \ + if (NUMBER_EQUAL(ALPHA, number_zero)) \ + FUN(scal)(&N, &BETA, Y_data, &integer_one); \ + else { \ + if (NUMBER_EQUAL(ALPHA, number_one)) { \ + if (NUMBER_EQUAL(BETA, number_zero)) \ + MFUN##_DIAG_LOOP(*Y_data = d) else if (NUMBER_EQUAL(BETA, number_one)) \ + MFUN##_DIAG_LOOP_WITH_Y( \ + *Y_data = ADD_NUMBER( \ + d, y)) else if (NUMBER_EQUAL(BETA, number_minus_one)) \ + MFUN##_DIAG_LOOP_WITH_Y( \ + *Y_data = SUB_NUMBER( \ + d, \ + y)) else MFUN##_DIAG_LOOP_WITH_Y(NUMBER tmp = \ + MUL_NUMBER( \ + y, BETA); \ + *Y_data = \ + ADD_NUMBER( \ + d, tmp)) \ + } else if (NUMBER_EQUAL(ALPHA, number_minus_one)) { \ + if (NUMBER_EQUAL(BETA, number_zero)) \ + MFUN##_DIAG_LOOP(*Y_data = NEG_NUMBER( \ + d)) else if (NUMBER_EQUAL(BETA, number_one)) \ + MFUN##_DIAG_LOOP_WITH_Y( \ + *Y_data = SUB_NUMBER( \ + y, d)) else if (NUMBER_EQUAL(BETA, number_minus_one)) \ + MFUN##_DIAG_LOOP_WITH_Y( \ + NUMBER tmp = ADD_NUMBER(d, y); \ + *Y_data = NEG_NUMBER( \ + tmp)) else MFUN##_DIAG_LOOP_WITH_Y(NUMBER tmp = \ + MUL_NUMBER( \ + y, BETA); \ + *Y_data = \ + SUB_NUMBER(tmp, \ + d)) \ + } else { \ + if (NUMBER_EQUAL(BETA, number_zero)) \ + MFUN##_DIAG_LOOP(*Y_data = MUL_NUMBER( \ + ALPHA, d)) else if (NUMBER_EQUAL(BETA, \ + number_one)) \ + MFUN##_DIAG_LOOP_WITH_Y( \ + NUMBER tmp = MUL_NUMBER(ALPHA, d); \ + *Y_data = ADD_NUMBER( \ + tmp, y)) else if (NUMBER_EQUAL(BETA, number_minus_one)) \ + MFUN##_DIAG_LOOP_WITH_Y( \ + NUMBER tmp = MUL_NUMBER(ALPHA, d); \ + *Y_data = SUB_NUMBER( \ + tmp, \ + y)) else MFUN##_DIAG_LOOP_WITH_Y(NUMBER ad = \ + MUL_NUMBER(ALPHA, \ + d); \ + NUMBER yb = \ + MUL_NUMBER(BETA, \ + y); \ + *Y_data = ADD_NUMBER( \ + ad, yb)) \ + } \ } -extern NUMBER -DOTU(integer *N, NUMBER *X, integer *INCX, NUMBER *Y, integer *INCY); +extern NUMBER DOTU(integer *N, NUMBER *X, integer *INCX, NUMBER *Y, + integer *INCY); -#define GEMM_INCR \ - A_data += iter_incr_A; \ - B_data += iter_incr_B; \ +#define GEMM_INCR \ + A_data += iter_incr_A; \ + B_data += iter_incr_B; \ ++Y_data -#define COMMON_GEMM_DIAG_LOOP(DOIT) \ - while (Y_data != stop_Y) { \ - NUMBER d = DOTU(&K, A_data, &dot_incr_A, B_data, &dot_incr_B); \ - DOIT; \ - GEMM_INCR; \ +#define COMMON_GEMM_DIAG_LOOP(DOIT) \ + while (Y_data != stop_Y) { \ + NUMBER d = DOTU(&K, A_data, &dot_incr_A, B_data, &dot_incr_B); \ + DOIT; \ + GEMM_INCR; \ } -#ifndef LACAML_COMPLEX /* Real number */ +#ifndef LACAML_COMPLEX /* Real number */ #define GEMM_DIAG_LOOP(DOIT) COMMON_GEMM_DIAG_LOOP(DOIT) -#else /* Complex number */ - -extern NUMBER -DOTC(integer *N, NUMBER *X, integer *INCX, NUMBER *Y, integer *INCY); - -#define GEMM_DIAG_LOOP(DOIT) \ - if (TRANSA == 'C') \ - if (TRANSB == 'C') \ - while (Y_data != stop_Y) { \ - NUMBER cd = DOTU(&K, A_data, &dot_incr_A, B_data, &dot_incr_B); \ - NUMBER d = COMLEX_CONJ(cd); \ - DOIT; \ - GEMM_INCR; \ - } \ - else \ - while (Y_data != stop_Y) { \ - NUMBER d = DOTC(&K, A_data, &dot_incr_A, B_data, &dot_incr_B); \ - DOIT; \ - GEMM_INCR; \ - } \ - else if (TRANSB == 'C') \ - while (Y_data != stop_Y) { \ - NUMBER d = DOTC(&K, B_data, &dot_incr_B, A_data, &dot_incr_A); \ - DOIT; \ - GEMM_INCR; \ - } \ - else COMMON_GEMM_DIAG_LOOP(DOIT) +#else /* Complex number */ + +extern NUMBER DOTC(integer *N, NUMBER *X, integer *INCX, NUMBER *Y, + integer *INCY); + +#define GEMM_DIAG_LOOP(DOIT) \ + if (TRANSA == 'C') \ + if (TRANSB == 'C') \ + while (Y_data != stop_Y) { \ + NUMBER cd = DOTU(&K, A_data, &dot_incr_A, B_data, &dot_incr_B); \ + NUMBER d = COMLEX_CONJ(cd); \ + DOIT; \ + GEMM_INCR; \ + } \ + else \ + while (Y_data != stop_Y) { \ + NUMBER d = DOTC(&K, A_data, &dot_incr_A, B_data, &dot_incr_B); \ + DOIT; \ + GEMM_INCR; \ + } \ + else if (TRANSB == 'C') \ + while (Y_data != stop_Y) { \ + NUMBER d = DOTC(&K, B_data, &dot_incr_B, A_data, &dot_incr_A); \ + DOIT; \ + GEMM_INCR; \ + } \ + else \ + COMMON_GEMM_DIAG_LOOP(DOIT) #endif #define GEMM_DIAG_LOOP_WITH_Y(DOIT) GEMM_DIAG_LOOP(NUMBER y = *Y_data; DOIT) -CAMLprim value LFUN(gemm_diag_stub)( - value vTRANSA, - value vTRANSB, - intnat vN, intnat vK, - intnat vAR, intnat vAC, value vA, - intnat vBR, intnat vBC, value vB, - intnat vOFSY, - value vY, - vNUMBER vALPHA, - vNUMBER vBETA - ) -{ +CAMLprim value LFUN(gemm_diag_stub)(value vTRANSA, value vTRANSB, intnat vN, + intnat vK, intnat vAR, intnat vAC, value vA, + intnat vBR, intnat vBC, value vB, + intnat vOFSY, value vY, vNUMBER vALPHA, + vNUMBER vBETA) { CAMLparam3(vA, vB, vY); integer GET_INT(N), GET_INT(K); @@ -1027,7 +892,7 @@ CAMLprim value LFUN(gemm_diag_stub)( INIT_NUMBER(ALPHA); INIT_NUMBER(BETA); - caml_enter_blocking_section(); /* Allow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ if (TRANSA == 'N') { iter_incr_A = 1; @@ -1039,56 +904,37 @@ CAMLprim value LFUN(gemm_diag_stub)( COMMON_DIAG_LOOP(GEMM) - caml_leave_blocking_section(); /* Disallow other threads */ + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(Val_unit); } -CAMLprim value LFUN(gemm_diag_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(gemm_diag_stub)( - argv[0], - argv[1], - Int_val(argv[2]), - Int_val(argv[3]), - Int_val(argv[4]), - Int_val(argv[5]), - argv[6], - Int_val(argv[7]), - Int_val(argv[8]), - argv[9], - Int_val(argv[10]), - argv[11], - NUMBER_val(argv[12]), - NUMBER_val(argv[13])); +CAMLprim value LFUN(gemm_diag_stub_bc)(value *argv, int __unused argn) { + return LFUN(gemm_diag_stub)( + argv[0], argv[1], Int_val(argv[2]), Int_val(argv[3]), Int_val(argv[4]), + Int_val(argv[5]), argv[6], Int_val(argv[7]), Int_val(argv[8]), argv[9], + Int_val(argv[10]), argv[11], NUMBER_val(argv[12]), NUMBER_val(argv[13])); } - /* syrk_diag */ -#define SYRK_INCR \ - A_data += iter_incr_A; \ +#define SYRK_INCR \ + A_data += iter_incr_A; \ ++Y_data -#define SYRK_DIAG_LOOP(DOIT) \ - while (Y_data != stop_Y) { \ - NUMBER d = DOTU(&K, A_data, &dot_incr_A, A_data, &dot_incr_A); \ - DOIT; \ - SYRK_INCR; \ +#define SYRK_DIAG_LOOP(DOIT) \ + while (Y_data != stop_Y) { \ + NUMBER d = DOTU(&K, A_data, &dot_incr_A, A_data, &dot_incr_A); \ + DOIT; \ + SYRK_INCR; \ } #define SYRK_DIAG_LOOP_WITH_Y(DOIT) SYRK_DIAG_LOOP(NUMBER y = *Y_data; DOIT) -CAMLprim value LFUN(syrk_diag_stub)( - value vTRANS, - intnat vN, intnat vK, - intnat vAR, intnat vAC, value vA, - intnat vOFSY, - value vY, - vNUMBER vALPHA, - vNUMBER vBETA) -{ +CAMLprim value LFUN(syrk_diag_stub)(value vTRANS, intnat vN, intnat vK, + intnat vAR, intnat vAC, value vA, + intnat vOFSY, value vY, vNUMBER vALPHA, + vNUMBER vBETA) { CAMLparam2(vA, vY); integer GET_INT(N), GET_INT(K); @@ -1107,7 +953,7 @@ CAMLprim value LFUN(syrk_diag_stub)( INIT_NUMBER(ALPHA); INIT_NUMBER(BETA); - caml_enter_blocking_section(); /* Allow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ if (TRANS == 'N') { iter_incr_A = 1; @@ -1119,46 +965,35 @@ CAMLprim value LFUN(syrk_diag_stub)( COMMON_DIAG_LOOP(SYRK) - caml_leave_blocking_section(); /* Disallow other threads */ + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(Val_unit); } -CAMLprim value LFUN(syrk_diag_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(syrk_diag_stub)( - argv[0], - Int_val(argv[1]), - Int_val(argv[2]), - Int_val(argv[3]), - Int_val(argv[4]), - argv[5], - Int_val(argv[6]), - argv[7], - NUMBER_val(argv[8]), - NUMBER_val(argv[9])); +CAMLprim value LFUN(syrk_diag_stub_bc)(value *argv, int __unused argn) { + return LFUN(syrk_diag_stub)(argv[0], Int_val(argv[1]), Int_val(argv[2]), + Int_val(argv[3]), Int_val(argv[4]), argv[5], + Int_val(argv[6]), argv[7], NUMBER_val(argv[8]), + NUMBER_val(argv[9])); } - /* gemm_trace */ -#define GEMM_TRACE_INCR A_data += iter_incr_A; B_data += iter_incr_B +#define GEMM_TRACE_INCR \ + A_data += iter_incr_A; \ + B_data += iter_incr_B -#define COMMON_GEMM_TRACE_LOOP \ - while (A_data != stop_A) { \ - NUMBER d = DOTU(&K, A_data, &dot_incr_A, B_data, &dot_incr_B); \ - res = ADD_NUMBER(res, d); \ - GEMM_TRACE_INCR; \ +#define COMMON_GEMM_TRACE_LOOP \ + while (A_data != stop_A) { \ + NUMBER d = DOTU(&K, A_data, &dot_incr_A, B_data, &dot_incr_B); \ + res = ADD_NUMBER(res, d); \ + GEMM_TRACE_INCR; \ } -CAMLprim vNUMBER LFUN(gemm_trace_stub)( - value vTRANSA, - value vTRANSB, - intnat vN, intnat vK, - intnat vAR, intnat vAC, value vA, - intnat vBR, intnat vBC, value vB) -{ +CAMLprim vNUMBER LFUN(gemm_trace_stub)(value vTRANSA, value vTRANSB, intnat vN, + intnat vK, intnat vAR, intnat vAC, + value vA, intnat vBR, intnat vBC, + value vB) { CAMLparam2(vA, vB); integer GET_INT(N), GET_INT(K); @@ -1173,7 +1008,7 @@ CAMLprim vNUMBER LFUN(gemm_trace_stub)( NUMBER res = NUMBER_ZERO; NUMBER *stop_A; - caml_enter_blocking_section(); /* Allow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ if (TRANSA == 'N') { if (TRANSB == 'N') { @@ -1199,11 +1034,11 @@ CAMLprim vNUMBER LFUN(gemm_trace_stub)( integer NK = N * K; res = #ifdef LACAML_COMPLEX - (TRANSB == 'C') - ? DOTC(&NK, B_data, &integer_one, A_data, &integer_one) - : + (TRANSB == 'C') + ? DOTC(&NK, B_data, &integer_one, A_data, &integer_one) + : #endif - DOTU(&NK, B_data, &integer_one, A_data, &integer_one); + DOTU(&NK, B_data, &integer_one, A_data, &integer_one); goto end; } else { integer tmp_N = N; @@ -1224,11 +1059,11 @@ CAMLprim vNUMBER LFUN(gemm_trace_stub)( integer NK = N * K; res = #ifdef LACAML_COMPLEX - (TRANSA == 'C') - ? DOTC(&NK, A_data, &integer_one, B_data, &integer_one) - : + (TRANSA == 'C') + ? DOTC(&NK, A_data, &integer_one, B_data, &integer_one) + : #endif - DOTU(&NK, A_data, &integer_one, B_data, &integer_one); + DOTU(&NK, A_data, &integer_one, B_data, &integer_one); goto end; } else { iter_incr_A = rows_A; @@ -1259,9 +1094,9 @@ CAMLprim vNUMBER LFUN(gemm_trace_stub)( stop_A = A_data + N * iter_incr_A; -#ifndef LACAML_COMPLEX /* Real number */ +#ifndef LACAML_COMPLEX /* Real number */ COMMON_GEMM_TRACE_LOOP -#else /* Complex number */ +#else /* Complex number */ if (TRANSA == 'C') if (TRANSB == 'C') while (A_data != stop_A) { @@ -1282,44 +1117,32 @@ CAMLprim vNUMBER LFUN(gemm_trace_stub)( res = ADD_NUMBER(res, d); GEMM_TRACE_INCR; } - else COMMON_GEMM_TRACE_LOOP + else + COMMON_GEMM_TRACE_LOOP #endif end: - caml_leave_blocking_section(); /* Disallow other threads */ + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturnNUMBER(res); } -CAMLprim value LFUN(gemm_trace_stub_bc)(value *argv, int __unused argn) -{ - return - COPY_NUMBER( - LFUN(gemm_trace_stub)( - argv[0], - argv[1], - Int_val(argv[2]), - Int_val(argv[3]), - Int_val(argv[4]), - Int_val(argv[5]), - argv[6], - Int_val(argv[7]), - Int_val(argv[8]), - argv[9])); +CAMLprim value LFUN(gemm_trace_stub_bc)(value *argv, int __unused argn) { + return COPY_NUMBER(LFUN(gemm_trace_stub)( + argv[0], argv[1], Int_val(argv[2]), Int_val(argv[3]), Int_val(argv[4]), + Int_val(argv[5]), argv[6], Int_val(argv[7]), Int_val(argv[8]), argv[9])); } - /* syrk_trace */ -CAMLprim vNUMBER LFUN(syrk_trace_stub)( - intnat vN, intnat vK, intnat vAR, intnat vAC, value vA) -{ +CAMLprim vNUMBER LFUN(syrk_trace_stub)(intnat vN, intnat vK, intnat vAR, + intnat vAC, value vA) { CAMLparam1(vA); integer GET_INT(N), GET_INT(K); MAT_PARAMS(A); NUMBER res = NUMBER_ZERO; - caml_enter_blocking_section(); /* Allow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ if (N == rows_A) { integer NK = N * K; res = DOTU(&NK, A_data, &integer_one, A_data, &integer_one); @@ -1331,31 +1154,21 @@ CAMLprim vNUMBER LFUN(syrk_trace_stub)( A_data += rows_A; } } - caml_leave_blocking_section(); /* Disallow other threads */ + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturnNUMBER(res); } -CAMLprim value LFUN(syrk_trace_stub_bc)( - value vN, value vK, value vAR, value vAC, value vA) -{ - return - COPY_NUMBER( - LFUN(syrk_trace_stub)( - Int_val(vN), - Int_val(vK), - Int_val(vAR), - Int_val(vAC), - vA)); +CAMLprim value LFUN(syrk_trace_stub_bc)(value vN, value vK, value vAR, + value vAC, value vA) { + return COPY_NUMBER(LFUN(syrk_trace_stub)(Int_val(vN), Int_val(vK), + Int_val(vAR), Int_val(vAC), vA)); } - /* symm2_trace */ -CAMLprim vNUMBER LFUN(symm2_trace_stub)( - intnat vN, - value vUPLOA, intnat vAR, intnat vAC, value vA, - value vUPLOB, intnat vBR, intnat vBC, value vB) -{ +CAMLprim vNUMBER LFUN(symm2_trace_stub)(intnat vN, value vUPLOA, intnat vAR, + intnat vAC, value vA, value vUPLOB, + intnat vBR, intnat vBC, value vB) { CAMLparam2(vA, vB); integer GET_INT(N); @@ -1366,9 +1179,10 @@ CAMLprim vNUMBER LFUN(symm2_trace_stub)( NUMBER diag_sum, res = NUMBER_ZERO; - if (N == 0) CAMLreturnNUMBER(number_zero); + if (N == 0) + CAMLreturnNUMBER(number_zero); - caml_enter_blocking_section(); /* Allow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ diag_sum = MUL_NUMBERP(A_data, B_data); @@ -1431,23 +1245,13 @@ CAMLprim vNUMBER LFUN(symm2_trace_stub)( res = ADD_NUMBER(res, res); res = ADD_NUMBER(res, diag_sum); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturnNUMBER(res); } -CAMLprim value LFUN(symm2_trace_stub_bc)(value *argv, int __unused argn) -{ - return - COPY_NUMBER( - LFUN(symm2_trace_stub)( - Int_val(argv[0]), - argv[1], - Int_val(argv[2]), - Int_val(argv[3]), - argv[4], - argv[5], - Int_val(argv[6]), - Int_val(argv[7]), - argv[8])); +CAMLprim value LFUN(symm2_trace_stub_bc)(value *argv, int __unused argn) { + return COPY_NUMBER(LFUN(symm2_trace_stub)( + Int_val(argv[0]), argv[1], Int_val(argv[2]), Int_val(argv[3]), argv[4], + argv[5], Int_val(argv[6]), Int_val(argv[7]), argv[8])); } diff --git a/src/mat_SDCZ.ml b/src/mat_SDCZ.ml index d75f5de..f6df5de 100644 --- a/src/mat_SDCZ.ml +++ b/src/mat_SDCZ.ml @@ -1,29 +1,24 @@ (* File: mat_SDCZ.ml - Copyright (C) 2002- + Copyright © 2002- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umh.ac.be/an/ + Christophe Troestler - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) open Bigarray open Numberxx @@ -39,7 +34,6 @@ let make m n x = mat let make0 m n = make m n zero - let of_array ar = Array2.of_array prec fortran_layout ar let init_rows m n f = @@ -61,13 +55,14 @@ let init_cols m n f = mat let create_mvec m = create m 1 - let make_mvec m x = make m 1 x let mvec_of_array ar = let n = Array.length ar in let mat = create_mvec n in - for row = 1 to n do mat.{row, 1} <- ar.(row - 1) done; + for row = 1 to n do + mat.{row, 1} <- ar.(row - 1) + done; mat let dim1 (mat : mat) = Array2.dim1 mat @@ -81,17 +76,20 @@ let mvec_to_array mat = if n = 0 then [||] else let ar = Array.make n mat.{1, 1} in - for row = 2 to n do ar.(row - 1) <- mat.{row, 1} done; + for row = 2 to n do + ar.(row - 1) <- mat.{row, 1} + done; ar let from_col_vec vec = reshape_2 (genarray_of_array1 vec) (Array1.dim vec) 1 let from_row_vec vec = reshape_2 (genarray_of_array1 vec) 1 (Array1.dim vec) - let empty = create 0 0 let identity n = let mat = make n n zero in - for i = 1 to n do mat.{i, i} <- one done; + for i = 1 to n do + mat.{i, i} <- one + done; mat let of_diag ?n ?(br = 1) ?(bc = 1) ?b ?ofsx ?incx (x : vec) = @@ -115,7 +113,9 @@ let to_array mat = let ar = Array.make_matrix m n mat.{1, 1} in for row = 1 to m do let row_ar = ar.(row - 1) in - for col = 1 to n do row_ar.(col - 1) <- mat.{row, col} done; + for col = 1 to n do + row_ar.(col - 1) <- mat.{row, col} + done done; ar @@ -129,18 +129,21 @@ let copy_row ?vec mat r = if Array1.dim vec < n then failwith ("copy_row: dim(vec) < " ^ string_of_int n); vec - | None -> Array1.create prec fortran_layout n in - for c = 1 to n do vec.{c} <- mat.{r, c} done; + | None -> Array1.create prec fortran_layout n + in + for c = 1 to n do + vec.{c} <- mat.{r, c} + done; vec external direct_copy : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_NPRECcopy_stub_bc" "lacaml_NPRECcopy_stub" let of_col_vecs ar = @@ -163,12 +166,14 @@ let to_col_vecs mat = if n = 0 then [||] else let ar = Array.make n (col mat 1) in - for i = 2 to n do ar.(i - 1) <- col mat i done; + for i = 2 to n do + ar.(i - 1) <- col mat i + done; ar let of_col_vecs_list = function | [] -> empty - | (vec :: _) as lst -> + | vec :: _ as lst -> let n = List.length lst in let m = Array1.dim vec in let mat = create m n in @@ -178,8 +183,8 @@ let of_col_vecs_list = function if Array1.dim vec <> m then failwith "of_col_vecs_list: vectors not of same length"; if m > 0 then - direct_copy - ~n:m ~ofsy:1 ~incy:1 ~y:(col mat i) ~ofsx:1 ~incx:1 ~x:vec; + direct_copy ~n:m ~ofsy:1 ~incy:1 ~y:(col mat i) ~ofsx:1 ~incx:1 + ~x:vec; loop (i + 1) t in loop 1 lst @@ -190,20 +195,26 @@ let to_col_vecs_list mat = let of_list = function | [] -> empty - | (h :: t) as lst -> + | h :: t as lst -> let m = List.length lst in let n = List.length h in - List.iter (fun l -> - if List.length l <> n then - failwith "of_list: vectors not of same length") t; + List.iter + (fun l -> + if List.length l <> n then + failwith "of_list: vectors not of same length") + t; let mat = create m n in let rec loop_cols i j = function | [] -> () - | el :: cols -> mat.{i, j} <- el; loop_cols i (j + 1) cols + | el :: cols -> + mat.{i, j} <- el; + loop_cols i (j + 1) cols in let rec loop_rows i = function | [] -> mat - | cols :: rows -> loop_cols i 1 cols; loop_rows (i + 1) rows + | cols :: rows -> + loop_cols i 1 cols; + loop_rows (i + 1) rows in loop_rows 1 lst @@ -215,8 +226,7 @@ let to_list mat = l n [] in let rec loop i acc = - if i < 1 then acc - else loop (i - 1) (row_to_list i :: acc) + if i < 1 then acc else loop (i - 1) (row_to_list i :: acc) in loop m [] @@ -225,16 +235,16 @@ let as_vec mat = reshape_1 gen (dim1 mat * dim2 mat) external direct_swap : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_NPRECswap_mat_stub_bc" "lacaml_NPRECswap_mat_stub" let swap ?patt ?m ?n ?(ar = 1) ?(ac = 1) a ?(br = 1) ?(bc = 1) b = @@ -246,14 +256,14 @@ let swap ?patt ?m ?n ?(ar = 1) ?(ac = 1) a ?(br = 1) ?(bc = 1) b = direct_swap ~pkind ~pinit ~m ~n ~ar ~ac ~a ~br ~bc ~b external direct_transpose_copy : - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_NPRECtranspose_copy_stub_bc" "lacaml_NPRECtranspose_copy_stub" let transpose_copy ?m ?n ?(br = 1) ?(bc = 1) ?b ?(ar = 1) ?(ac = 1) a = @@ -271,26 +281,30 @@ let detri ?(up = true) ?n ?(ar = 1) ?(ac = 1) (a : mat) = for c = 1 to n - 1 do let ar_c = ar + c in let ac_c = ac + c in - for r = 0 to c - 1 do a.{ar_c, ac + r} <- a.{ar + r, ac_c} done + for r = 0 to c - 1 do + a.{ar_c, ac + r} <- a.{ar + r, ac_c} + done done else for c = 1 to n - 1 do let ar_c = ar + c in let ac_c = ac + c in - for r = 0 to c - 1 do a.{ar + r, ac_c} <- a.{ar_c, ac + r} done + for r = 0 to c - 1 do + a.{ar + r, ac_c} <- a.{ar_c, ac + r} + done done let packed ?(up = true) ?n ?(ar = 1) ?(ac = 1) (a : mat) = let loc = "Lacaml.NPREC.Mat.packed" in let n = get_n_of_square loc a_str ar ac a n in - let dst = Array1.create prec fortran_layout ((n * n + n) / 2) in + let dst = Array1.create prec fortran_layout (((n * n) + n) / 2) in let pos_ref = ref 1 in if up then for c = 1 to n do for r = 1 to c do let pos = !pos_ref in dst.{pos} <- a.{r, c}; - pos_ref := pos + 1; + pos_ref := pos + 1 done done else @@ -298,7 +312,7 @@ let packed ?(up = true) ?n ?(ar = 1) ?(ac = 1) (a : mat) = for r = c to n do let pos = !pos_ref in dst.{pos} <- a.{r, c}; - pos_ref := pos + 1; + pos_ref := pos + 1 done done; dst @@ -313,7 +327,7 @@ let unpacked ?(up = true) ?n (src : vec) = for r = 1 to c do let pos = !pos_ref in a.{r, c} <- src.{pos}; - pos_ref := pos + 1; + pos_ref := pos + 1 done done else @@ -321,7 +335,7 @@ let unpacked ?(up = true) ?n (src : vec) = for r = c to n do let pos = !pos_ref in a.{r, c} <- src.{pos}; - pos_ref := pos + 1; + pos_ref := pos + 1 done done; a @@ -344,20 +358,19 @@ let trace mat = let n = dim2 mat in let n_diag = min m n in let rec loop i trace = - if i = 0 then trace - else loop (i - 1) (add trace mat.{i, i}) + if i = 0 then trace else loop (i - 1) (add trace mat.{i, i}) in loop n_diag zero external direct_scal_mat : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - alpha : num_type_arg -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + alpha:num_type_arg -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> unit = "lacaml_NPRECscal_mat_stub_bc" "lacaml_NPRECscal_mat_stub" let scal ?patt ?m ?n alpha ?(ar = 1) ?(ac = 1) a = @@ -368,15 +381,15 @@ let scal ?patt ?m ?n alpha ?(ar = 1) ?(ac = 1) a = direct_scal_mat ~pkind ~pinit ~m ~n ~alpha ~ar ~ac ~a external direct_scal_cols : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - ofs : (int [@untagged]) -> - alphas : vec -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + ofs:(int[@untagged]) -> + alphas:vec -> unit = "lacaml_NPRECscal_cols_stub_bc" "lacaml_NPRECscal_cols_stub" let scal_cols ?patt ?m ?n ?(ar = 1) ?(ac = 1) a ?ofs alphas = @@ -389,15 +402,15 @@ let scal_cols ?patt ?m ?n ?(ar = 1) ?(ac = 1) a ?ofs alphas = direct_scal_cols ~pkind ~pinit ~m ~n ~ar ~ac ~a ~ofs ~alphas external direct_scal_rows : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ofs : (int [@untagged]) -> - alphas : vec -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ofs:(int[@untagged]) -> + alphas:vec -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> unit = "lacaml_NPRECscal_rows_stub_bc" "lacaml_NPRECscal_rows_stub" let scal_rows ?patt ?m ?n ?ofs alphas ?(ar = 1) ?(ac = 1) a = @@ -412,11 +425,11 @@ let scal_rows ?patt ?m ?n ?ofs alphas ?(ar = 1) ?(ac = 1) a = let vec_create n = Array1.create prec fortran_layout n external direct_syrk_trace : - n : (int [@untagged]) -> - k : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> + n:(int[@untagged]) -> + k:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> num_type_arg = "lacaml_NPRECsyrk_trace_stub_bc" "lacaml_NPRECsyrk_trace_stub" let syrk_trace ?n ?k ?(ar = 1) ?(ac = 1) a = @@ -425,18 +438,17 @@ let syrk_trace ?n ?k ?(ar = 1) ?(ac = 1) a = let k = get_dim2_mat loc a_str a ac k_str k in direct_syrk_trace ~n ~k ~ar ~ac ~a - (* Operations on one matrix *) external direct_fill : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - x : num_type_arg -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + x:num_type_arg -> unit = "lacaml_NPRECfill_mat_stub_bc" "lacaml_NPRECfill_mat_stub" let fill ?patt ?m ?n ?(ar = 1) ?(ac = 1) a x = @@ -447,13 +459,13 @@ let fill ?patt ?m ?n ?(ar = 1) ?(ac = 1) a x = direct_fill ~pkind ~pinit ~m ~n ~ar ~ac ~a ~x external direct_sum : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> num_type_arg = "lacaml_NPRECsum_mat_stub_bc" "lacaml_NPRECsum_mat_stub" let sum ?patt ?m ?n ?(ar = 1) ?(ac = 1) a = @@ -464,21 +476,20 @@ let sum ?patt ?m ?n ?(ar = 1) ?(ac = 1) a = direct_sum ~pkind ~pinit ~m ~n ~ar ~ac ~a external direct_add_const : - c : num_type_arg -> - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + c:num_type_arg -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_NPRECadd_const_mat_stub_bc" "lacaml_NPRECadd_const_mat_stub" -let add_const c ?patt ?m ?n - ?(br = 1) ?(bc = 1) ?b ?(ar = 1) ?(ac = 1) a = +let add_const c ?patt ?m ?n ?(br = 1) ?(bc = 1) ?b ?(ar = 1) ?(ac = 1) a = let loc = "Lacaml.NPREC.Mat.add_const" in let m = get_dim1_mat loc a_str a ar m_str m in let n = get_dim2_mat loc a_str a ac n_str n in @@ -497,16 +508,16 @@ let add_const_diag c ?n ?(ar = 1) ?(ac = 1) a = done external direct_neg : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_NPRECneg_mat_stub_bc" "lacaml_NPRECneg_mat_stub" let neg ?patt ?m ?n ?(br = 1) ?(bc = 1) ?b ?(ar = 1) ?(ac = 1) a = @@ -519,16 +530,16 @@ let neg ?patt ?m ?n ?(br = 1) ?(bc = 1) ?b ?(ar = 1) ?(ac = 1) a = b external direct_reci : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> unit = "lacaml_NPRECreci_mat_stub_bc" "lacaml_NPRECreci_mat_stub" let reci ?patt ?m ?n ?(br = 1) ?(bc = 1) ?b ?(ar = 1) ?(ac = 1) a = @@ -541,20 +552,20 @@ let reci ?patt ?m ?n ?(br = 1) ?(bc = 1) ?b ?(ar = 1) ?(ac = 1) a = b external direct_syrk_diag : - trans : char -> - n : (int [@untagged]) -> - k : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - ofsy : (int [@untagged]) -> - y : vec -> - alpha : num_type_arg -> - beta : num_type_arg -> + trans:char -> + n:(int[@untagged]) -> + k:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + ofsy:(int[@untagged]) -> + y:vec -> + alpha:num_type_arg -> + beta:num_type_arg -> unit = "lacaml_NPRECsyrk_diag_stub_bc" "lacaml_NPRECsyrk_diag_stub" -let syrk_diag ?n ?k ?(beta = zero) ?(ofsy = 1) ?y - ?(trans = `N) ?(alpha = one) ?(ar = 1) ?(ac = 1) a = +let syrk_diag ?n ?k ?(beta = zero) ?(ofsy = 1) ?y ?(trans = `N) ?(alpha = one) + ?(ar = 1) ?(ac = 1) a = let loc = "Lacaml.NPREC.Mat.syrk_diag" in let n = get_rows_mat_tr loc a_str a ar ac trans n_str n in let k = get_cols_mat_tr loc a_str a ar ac trans k_str k in @@ -563,27 +574,26 @@ let syrk_diag ?n ?k ?(beta = zero) ?(ofsy = 1) ?y direct_syrk_diag ~trans ~n ~k ~ar ~ac ~a ~ofsy ~y ~alpha ~beta; y - (* Operations on two matrices *) external direct_mat_add : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> - cr : (int [@untagged]) -> - cc : (int [@untagged]) -> - c : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + cr:(int[@untagged]) -> + cc:(int[@untagged]) -> + c:mat -> unit = "lacaml_NPRECadd_mat_stub_bc" "lacaml_NPRECadd_mat_stub" -let add ?patt ?m ?n - ?(cr = 1) ?(cc = 1) ?c ?(ar = 1) ?(ac = 1) a ?(br = 1) ?(bc = 1) b = +let add ?patt ?m ?n ?(cr = 1) ?(cc = 1) ?c ?(ar = 1) ?(ac = 1) a ?(br = 1) + ?(bc = 1) b = let loc = "Lacaml.NPREC.Mat.add" in let m = get_dim1_mat loc a_str a ar m_str m in let n = get_dim2_mat loc a_str a ac n_str n in @@ -594,23 +604,23 @@ let add ?patt ?m ?n c external direct_mat_sub : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> - cr : (int [@untagged]) -> - cc : (int [@untagged]) -> - c : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + cr:(int[@untagged]) -> + cc:(int[@untagged]) -> + c:mat -> unit = "lacaml_NPRECsub_mat_stub_bc" "lacaml_NPRECsub_mat_stub" -let sub ?patt ?m ?n - ?(cr = 1) ?(cc = 1) ?c ?(ar = 1) ?(ac = 1) a ?(br = 1) ?(bc = 1) b = +let sub ?patt ?m ?n ?(cr = 1) ?(cc = 1) ?c ?(ar = 1) ?(ac = 1) a ?(br = 1) + ?(bc = 1) b = let loc = "Lacaml.NPREC.Mat.sub" in let m = get_dim1_mat loc a_str a ar m_str m in let n = get_dim2_mat loc a_str a ac n_str n in @@ -621,23 +631,23 @@ let sub ?patt ?m ?n c external direct_mat_mul : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> - cr : (int [@untagged]) -> - cc : (int [@untagged]) -> - c : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + cr:(int[@untagged]) -> + cc:(int[@untagged]) -> + c:mat -> unit = "lacaml_NPRECmul_mat_stub_bc" "lacaml_NPRECmul_mat_stub" -let mul ?patt ?m ?n - ?(cr = 1) ?(cc = 1) ?c ?(ar = 1) ?(ac = 1) a ?(br = 1) ?(bc = 1) b = +let mul ?patt ?m ?n ?(cr = 1) ?(cc = 1) ?c ?(ar = 1) ?(ac = 1) a ?(br = 1) + ?(bc = 1) b = let loc = "Lacaml.NPREC.Mat.mul" in let m = get_dim1_mat loc a_str a ar m_str m in let n = get_dim2_mat loc a_str a ac n_str n in @@ -648,23 +658,23 @@ let mul ?patt ?m ?n c external direct_mat_div : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> - cr : (int [@untagged]) -> - cc : (int [@untagged]) -> - c : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + cr:(int[@untagged]) -> + cc:(int[@untagged]) -> + c:mat -> unit = "lacaml_NPRECdiv_mat_stub_bc" "lacaml_NPRECdiv_mat_stub" -let div ?patt ?m ?n - ?(cr = 1) ?(cc = 1) ?c ?(ar = 1) ?(ac = 1) a ?(br = 1) ?(bc = 1) b = +let div ?patt ?m ?n ?(cr = 1) ?(cc = 1) ?c ?(ar = 1) ?(ac = 1) a ?(br = 1) + ?(bc = 1) b = let loc = "Lacaml.NPREC.Mat.div" in let m = get_dim1_mat loc a_str a ar m_str m in let n = get_dim2_mat loc a_str a ac n_str n in @@ -675,21 +685,21 @@ let div ?patt ?m ?n c external direct_axpy_mat : - alpha : num_type_arg -> - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - xr : (int [@untagged]) -> - xc : (int [@untagged]) -> - x : mat -> - yr : (int [@untagged]) -> - yc : (int [@untagged]) -> - y : mat -> + alpha:num_type_arg -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + xr:(int[@untagged]) -> + xc:(int[@untagged]) -> + x:mat -> + yr:(int[@untagged]) -> + yc:(int[@untagged]) -> + y:mat -> unit = "lacaml_NPRECaxpy_mat_stub_bc" "lacaml_NPRECaxpy_mat_stub" -let axpy ?(alpha = one) ?patt ?m ?n - ?(xr = 1) ?(xc = 1) x ?(yr = 1) ?(yc = 1) y = +let axpy ?(alpha = one) ?patt ?m ?n ?(xr = 1) ?(xc = 1) x ?(yr = 1) ?(yc = 1) y + = let loc = "Lacaml.NPREC.Mat.axpy" in let m = get_dim1_mat loc x_str x xr m_str m in let n = get_dim2_mat loc x_str x xc n_str n in @@ -698,25 +708,24 @@ let axpy ?(alpha = one) ?patt ?m ?n direct_axpy_mat ~alpha ~pkind ~pinit ~m ~n ~xr ~xc ~x ~yr ~yc ~y external direct_gemm_diag : - transa : char -> - transb : char -> - n : (int [@untagged]) -> - k : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> - ofsy : (int [@untagged]) -> - y : vec -> - alpha : num_type_arg -> - beta : num_type_arg -> + transa:char -> + transb:char -> + n:(int[@untagged]) -> + k:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> + ofsy:(int[@untagged]) -> + y:vec -> + alpha:num_type_arg -> + beta:num_type_arg -> unit = "lacaml_NPRECgemm_diag_stub_bc" "lacaml_NPRECgemm_diag_stub" -let gemm_diag ?n ?k ?(beta = zero) ?(ofsy = 1) ?y - ?(transa = `N) ?(alpha = one) ?(ar = 1) ?(ac = 1) a - ?(transb = `N) ?(br = 1) ?(bc = 1) b = +let gemm_diag ?n ?k ?(beta = zero) ?(ofsy = 1) ?y ?(transa = `N) ?(alpha = one) + ?(ar = 1) ?(ac = 1) a ?(transb = `N) ?(br = 1) ?(bc = 1) b = let loc = "Lacaml.NPREC.Mat.gemm_diag" in let n = get_rows_mat_tr loc a_str a ar ac transa n_str n in let n = get_cols_mat_tr loc b_str b br bc transb n_str (Some n) in @@ -724,25 +733,25 @@ let gemm_diag ?n ?k ?(beta = zero) ?(ofsy = 1) ?y let transa = get_trans_char transa in let transb = get_trans_char transb in let y = get_vec loc y_str y ofsy 1 n vec_create in - direct_gemm_diag - ~transa ~transb ~n ~k ~ar ~ac ~a ~br ~bc ~b ~ofsy ~y ~alpha ~beta; + direct_gemm_diag ~transa ~transb ~n ~k ~ar ~ac ~a ~br ~bc ~b ~ofsy ~y ~alpha + ~beta; y external direct_gemm_trace : - transa : char -> - transb : char -> - n : (int [@untagged]) -> - k : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + transa:char -> + transb:char -> + n:(int[@untagged]) -> + k:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> num_type_arg = "lacaml_NPRECgemm_trace_stub_bc" "lacaml_NPRECgemm_trace_stub" -let gemm_trace ?n ?k ?(transa = `N) ?(ar = 1) ?(ac = 1) a - ?(transb = `N) ?(br = 1) ?(bc = 1) b = +let gemm_trace ?n ?k ?(transa = `N) ?(ar = 1) ?(ac = 1) a ?(transb = `N) + ?(br = 1) ?(bc = 1) b = let loc = "Lacaml.NPREC.Mat.gemm_trace" in let n = get_rows_mat_tr loc a_str a ar ac transa n_str n in let n = get_cols_mat_tr loc b_str b br bc transb n_str (Some n) in @@ -752,22 +761,20 @@ let gemm_trace ?n ?k ?(transa = `N) ?(ar = 1) ?(ac = 1) a direct_gemm_trace ~transa ~transb ~n ~k ~ar ~ac ~a ~br ~bc ~b external direct_symm2_trace : - n : (int [@untagged]) -> - uploa : char -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - uplob : char -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + n:(int[@untagged]) -> + uploa:char -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + uplob:char -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> num_type_arg = "lacaml_NPRECsymm2_trace_stub_bc" "lacaml_NPRECsymm2_trace_stub" -let symm2_trace - ?n - ?(upa = true) ?(ar = 1) ?(ac = 1) a - ?(upb = true) ?(br = 1) ?(bc = 1) b = +let symm2_trace ?n ?(upa = true) ?(ar = 1) ?(ac = 1) a ?(upb = true) ?(br = 1) + ?(bc = 1) b = let loc = "Lacaml.NPREC.Mat.symm2_trace" in let n = get_n_of_square loc a_str ar ac a n in let n = get_n_of_square loc b_str br bc b (Some n) in @@ -776,16 +783,16 @@ let symm2_trace direct_symm2_trace ~n ~uploa ~ar ~ac ~a ~uplob ~br ~bc ~b external direct_ssqr_diff : - pkind : Mat_patt.kind -> - pinit : (int [@untagged]) -> - m : (int [@untagged]) -> - n : (int [@untagged]) -> - ar : (int [@untagged]) -> - ac : (int [@untagged]) -> - a : mat -> - br : (int [@untagged]) -> - bc : (int [@untagged]) -> - b : mat -> + pkind:Mat_patt.kind -> + pinit:(int[@untagged]) -> + m:(int[@untagged]) -> + n:(int[@untagged]) -> + ar:(int[@untagged]) -> + ac:(int[@untagged]) -> + a:mat -> + br:(int[@untagged]) -> + bc:(int[@untagged]) -> + b:mat -> num_type_arg = "lacaml_NPRECssqr_diff_mat_stub_bc" "lacaml_NPRECssqr_diff_mat_stub" @@ -797,7 +804,6 @@ let ssqr_diff ?patt ?m ?n ?(ar = 1) ?(ac = 1) a ?(br = 1) ?(bc = 1) b = let pkind, pinit = Mat_patt.normalize_args ~loc ~m ~n patt in direct_ssqr_diff ~pkind ~pinit ~m ~n ~ar ~ac ~a ~br ~bc ~b - (* Iterators over matrices *) let map f ?m ?n ?(br = 1) ?(bc = 1) ?b ?(ar = 1) ?(ac = 1) (a : mat) = @@ -807,7 +813,9 @@ let map f ?m ?n ?(br = 1) ?(bc = 1) ?b ?(ar = 1) ?(ac = 1) (a : mat) = let b = get_mat loc b_str create br bc b m n in let max_row = m - 1 in for i = 0 to n - 1 do - for j = 0 to max_row do b.{br + j, bc + i} <- f a.{ar + j, ac + i} done; + for j = 0 to max_row do + b.{br + j, bc + i} <- f a.{ar + j, ac + i} + done done; b @@ -815,7 +823,6 @@ let fold_cols coll ?n ?(ac = 1) acc a = let loc = "Lacaml.NPREC.Mat.fold_cols" in let n = get_dim2_mat loc a_str a ac n_str n in let rec loop i acc = - if i = n then acc - else loop (i + 1) (coll acc (col a (ac + i))) + if i = n then acc else loop (i + 1) (coll acc (col a (ac + i))) in loop 0 acc diff --git a/src/mat_SDCZ.mli b/src/mat_SDCZ.mli index 7a81746..fd5f100 100644 --- a/src/mat_SDCZ.mli +++ b/src/mat_SDCZ.mli @@ -1,29 +1,24 @@ (* File: mat_SDCZ.mli - Copyright (C) 2002- + Copyright © 2002- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umh.ac.be/an/ + Christophe Troestler - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) (* Matrix operations *) @@ -121,10 +116,7 @@ val identity : int -> mat (** [identity n] @return the [n]x[n] identity matrix. *) val of_diag : - ?n : int -> - ?br : int -> ?bc : int -> ?b : mat -> - ?ofsx : int -> ?incx : int -> vec -> - mat + ?n:int -> ?br:int -> ?bc:int -> ?b:mat -> ?ofsx:int -> ?incx:int -> vec -> mat (** [of_diag ?n ?br ?bc ?b ?ofsx ?incx x] @return matrix [b] with diagonal elements in the designated sub-matrix coming from the designated sub-vector in [x]. @@ -145,43 +137,52 @@ val dim2 : mat -> int val has_zero_dim : mat -> bool (** [has_zero_dim mat] checks whether matrix [mat] has a dimension of size - [zero]. In this case it cannot contain data. *) + [zero]. In this case it cannot contain data. *) val col : mat -> int -> vec (** [col m n] @return the [n]th column of matrix [m] as a vector. The data is shared. *) -val copy_row : ?vec : vec -> mat -> int -> vec +val copy_row : ?vec:vec -> mat -> int -> vec (** [copy_row ?vec mat int] @return a copy of the [n]th row of matrix [m] in vector [vec]. @param vec default = fresh vector of length [dim2 mat] *) - (** {6 Matrix transformations} *) val swap : - ?patt : patt -> ?m : int -> ?n : int -> - ?ar : int -> ?ac : int -> mat -> - ?br : int -> ?bc : int -> mat -> + ?patt:patt -> + ?m:int -> + ?n:int -> + ?ar:int -> + ?ac:int -> + mat -> + ?br:int -> + ?bc:int -> + mat -> unit - (** [swap ?patt ?m ?n ?ar ?ac a ?br ?bc b] - swaps the contents of (sub-matrices) [a] and [b]. - - @param patt default = [`Full] - @param m default = greater n s.t. [ar + m - 1 <= dim1 a] - @param n default = greater n s.t. [ac + n - 1 <= dim2 a] - @param ar default = [1] - @param ac default = [1] - @param br default = [1] - @param bc default = [1] - *) +(** [swap ?patt ?m ?n ?ar ?ac a ?br ?bc b] swaps the contents of (sub-matrices) + [a] and [b]. + + @param patt default = [`Full] + @param m default = greater n s.t. [ar + m - 1 <= dim1 a] + @param n default = greater n s.t. [ac + n - 1 <= dim2 a] + @param ar default = [1] + @param ac default = [1] + @param br default = [1] + @param bc default = [1] *) val transpose_copy : - ?m : int -> ?n : int -> ?br : int -> - ?bc : int -> ?b : mat -> - ?ar : int -> ?ac : int -> mat -> + ?m:int -> + ?n:int -> + ?br:int -> + ?bc:int -> + ?b:mat -> + ?ar:int -> + ?ac:int -> + mat -> mat (** [transpose_copy ?m ?n ?br ?bc ?b ?ar ?ac a] @return the transpose of (sub-)matrix [a]. If [b] is given, the result will be stored in there @@ -198,19 +199,17 @@ val transpose_copy : @param ac default = [1] *) -val detri : ?up : bool -> ?n : int -> ?ar : int -> ?ac : int -> mat -> unit -(** [detri ?up ?n ?ar ?ac a] takes a triangular (sub-)matrix [a], i.e. one - where only the upper (iff [up] is true) or lower triangle is defined, - and makes it a symmetric matrix by mirroring the defined triangle - along the diagonal. +val detri : ?up:bool -> ?n:int -> ?ar:int -> ?ac:int -> mat -> unit +(** [detri ?up ?n ?ar ?ac a] takes a triangular (sub-)matrix [a], i.e. one where + only the upper (iff [up] is true) or lower triangle is defined, and makes it + a symmetric matrix by mirroring the defined triangle along the diagonal. @param up default = [true] @param n default = [Mat.dim2 a] @param ar default = [1] - @param ac default = [1] -*) + @param ac default = [1] *) -val packed : ?up : bool -> ?n : int -> ?ar : int -> ?ac : int -> mat -> vec +val packed : ?up:bool -> ?n:int -> ?ar:int -> ?ac:int -> mat -> vec (** [packed ?up ?n ?ar ?ac a] @return (sub-)matrix [a] in packed storage format. @@ -220,7 +219,7 @@ val packed : ?up : bool -> ?n : int -> ?ar : int -> ?ac : int -> mat -> vec @param ac default = [1] *) -val unpacked : ?up : bool -> ?n : int -> vec -> mat +val unpacked : ?up:bool -> ?n:int -> vec -> mat (** [unpacked ?up x] @return an upper or lower (depending on [up]) triangular matrix from packed representation [vec]. The other triangle of the matrix will be filled with zeros. @@ -229,21 +228,25 @@ val unpacked : ?up : bool -> ?n : int -> vec -> mat @param n default = [Vec.dim x] *) - (** {6 Operations on one matrix} *) val fill : - ?patt : patt -> ?m : int -> ?n : int -> - ?ar : int -> ?ac : int -> mat -> num_type -> unit -(** [fill ?patt ?m ?n ?ar ?ac a x] fills the specified sub-matrix in [a] - with value [x]. *) + ?patt:patt -> + ?m:int -> + ?n:int -> + ?ar:int -> + ?ac:int -> + mat -> + num_type -> + unit +(** [fill ?patt ?m ?n ?ar ?ac a x] fills the specified sub-matrix in [a] with + value [x]. *) val sum : - ?patt : patt -> ?m : int -> ?n : int -> - ?ar : int -> ?ac : int -> mat -> num_type -(** [sum ?patt ?m ?n ?ar ?ac a] computes the sum of all elements in - the [m]-by-[n] submatrix using pattern [patt], starting at row [ar] and - column [ac]. *) + ?patt:patt -> ?m:int -> ?n:int -> ?ar:int -> ?ac:int -> mat -> num_type +(** [sum ?patt ?m ?n ?ar ?ac a] computes the sum of all elements in the + [m]-by-[n] submatrix using pattern [patt], starting at row [ar] and column + [ac]. *) val add_const : num_type -> unop (** [add_const c ?patt ?m ?n ?br ?bc ?b ?ar ?ac a] adds constant [c] to the @@ -257,58 +260,50 @@ val add_const : num_type -> unop @param ac default = [1] @param br default = [1] @param bc default = [1] - @param b default = fresh matrix of size [m] by [n] -*) + @param b default = fresh matrix of size [m] by [n] *) -val add_const_diag : - num_type -> ?n : int -> ?ar : int -> ?ac : int -> mat -> unit +val add_const_diag : num_type -> ?n:int -> ?ar:int -> ?ac:int -> mat -> unit (** [add_const c ?n ?ar ?ac a] adds constant [c] to the diagonal of the designated [n] by [n] submatrix in [a]. @param n default = [Mat.dim2 a] @param ar default = [1] - @param ac default = [1] -*) + @param ac default = [1] *) val neg : unop (** [neg ?m ?n ?br ?bc ?b ?ar ?ac a] computes the negative of the elements in - the [m] by [n] (sub-)matrix of the matrix [a] starting in row [ar] - and column [ac]. If [b] is given, the result will be stored in there - using offsets [br] and [bc], otherwise a fresh matrix will be used. - The resulting matrix is returned. + the [m] by [n] (sub-)matrix of the matrix [a] starting in row [ar] and + column [ac]. If [b] is given, the result will be stored in there using + offsets [br] and [bc], otherwise a fresh matrix will be used. The resulting + matrix is returned. @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val reci : unop (** [reci ?m ?n ?br ?bc ?b ?ar ?ac a] computes the reciprocal of the elements in - the [m] by [n] (sub-)matrix of the matrix [a] starting in row [ar] - and column [ac]. If [b] is given, the result will be stored in there - using offsets [br] and [bc], otherwise a fresh matrix will be used. - The resulting matrix is returned. + the [m] by [n] (sub-)matrix of the matrix [a] starting in row [ar] and + column [ac]. If [b] is given, the result will be stored in there using + offsets [br] and [bc], otherwise a fresh matrix will be used. The resulting + matrix is returned. @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param br default = 1 @param bc default = 1 - @param b default = fresh matrix with [br + m - 1] rows and - [bc + n - 1] columns + @param b + default = fresh matrix with [br + m - 1] rows and [bc + n - 1] columns @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val copy_diag : - ?n : int -> - ?ofsy : int -> ?incy : int -> ?y : vec -> - ?ar : int -> ?ac : int -> mat -> - vec + ?n:int -> ?ofsy:int -> ?incy:int -> ?y:vec -> ?ar:int -> ?ac:int -> mat -> vec (** [copy_diag ?n ?ofsy ?incy ?y ?ar ?ac a] @return the diagonal of the (sub-)matrix [a] in a (sub-)vector. @@ -326,65 +321,72 @@ val trace : mat -> num_type diagonal elements will be returned. *) val scal : - ?patt : patt -> ?m : int -> ?n : int -> - num_type -> ?ar : int -> ?ac : int -> mat -> unit -(** [scal ?patt ?m ?n alpha ?ar ?ac a] BLAS [scal] function for - (sub-)matrices. *) + ?patt:patt -> + ?m:int -> + ?n:int -> + num_type -> + ?ar:int -> + ?ac:int -> + mat -> + unit +(** [scal ?patt ?m ?n alpha ?ar ?ac a] BLAS [scal] function for (sub-)matrices. *) val scal_cols : - ?patt : patt -> ?m : int -> ?n : int -> - ?ar : int -> ?ac : int -> mat -> - ?ofs : int -> vec -> + ?patt:patt -> + ?m:int -> + ?n:int -> + ?ar:int -> + ?ac:int -> + mat -> + ?ofs:int -> + vec -> unit -(** [scal_cols ?patt ?m ?n ?ar ?ac a ?ofs alphas] column-wise [scal] - function for matrices. *) +(** [scal_cols ?patt ?m ?n ?ar ?ac a ?ofs alphas] column-wise [scal] function + for matrices. *) val scal_rows : - ?patt : patt -> ?m : int -> ?n : int -> - ?ofs : int -> vec -> - ?ar : int -> ?ac : int -> mat -> - unit -(** [scal_rows ?patt ?m ?n ?ofs alphas ?ar ?ac a] row-wise [scal] - function for matrices. *) - -val syrk_trace : - ?n : int -> - ?k : int -> - ?ar : int -> - ?ac : int -> + ?patt:patt -> + ?m:int -> + ?n:int -> + ?ofs:int -> + vec -> + ?ar:int -> + ?ac:int -> mat -> - num_type -(** [syrk_trace ?n ?k ?ar ?ac a] computes the trace of either [a' * a] - or [a * a'], whichever is more efficient (results are identical), of the - (sub-)matrix [a] multiplied by its own transpose. This is the same as - the square of the Frobenius norm of a matrix. [n] is the number of rows - to consider in [a], and [k] the number of columns to consider. + unit +(** [scal_rows ?patt ?m ?n ?ofs alphas ?ar ?ac a] row-wise [scal] function for + matrices. *) + +val syrk_trace : ?n:int -> ?k:int -> ?ar:int -> ?ac:int -> mat -> num_type +(** [syrk_trace ?n ?k ?ar ?ac a] computes the trace of either [a' * a] or + [a * a'], whichever is more efficient (results are identical), of the + (sub-)matrix [a] multiplied by its own transpose. This is the same as the + square of the Frobenius norm of a matrix. [n] is the number of rows to + consider in [a], and [k] the number of columns to consider. @param n default = number of rows of [a] @param k default = number of columns of [a] @param ar default = [1] - @param ac default = [1] -*) + @param ac default = [1] *) val syrk_diag : - ?n : int -> - ?k : int -> - ?beta : num_type -> - ?ofsy : int -> - ?y : vec -> - ?trans : trans2 -> - ?alpha : num_type -> - ?ar : int -> - ?ac : int -> + ?n:int -> + ?k:int -> + ?beta:num_type -> + ?ofsy:int -> + ?y:vec -> + ?trans:trans2 -> + ?alpha:num_type -> + ?ar:int -> + ?ac:int -> mat -> vec -(** [syrk_diag ?n ?k ?beta ?ofsy ?y ?trans ?alpha ?ar ?ac a] - computes the diagonal of the symmetric rank-k product of the - (sub-)matrix [a], multiplying it with [alpha] and adding [beta] - times [y], storing the result in [y] starting at the specified - offset. [n] elements of the diagonal will be computed, and [k] - elements of the matrix will be part of the dot product associated - with each diagonal element. +(** [syrk_diag ?n ?k ?beta ?ofsy ?y ?trans ?alpha ?ar ?ac a] computes the + diagonal of the symmetric rank-k product of the (sub-)matrix [a], + multiplying it with [alpha] and adding [beta] times [y], storing the result + in [y] starting at the specified offset. [n] elements of the diagonal will + be computed, and [k] elements of the matrix will be part of the dot product + associated with each diagonal element. @param n default = number of rows of [a] (or tr[a]) @param k default = number of columns of [a] (or tr[a]) @@ -394,108 +396,102 @@ val syrk_diag : @param trans default = [`N] @param alpha default = [1] @param ar default = [1] - @param ac default = [1] -*) - + @param ac default = [1] *) (** {6 Operations on two matrices} *) val add : binop -(** [add ?m ?n ?cr ?cc ?c ?ar ?ac a ?br ?bc b] computes the sum of the [m] - by [n] sub-matrix of the matrix [a] starting in row [ar] and column [ac] - with the corresponding sub-matrix of the matrix [b] starting in row - [br] and column [bc]. If [c] is given, the result will be stored in - there starting in row [cr] and column [cc], otherwise a fresh matrix - will be used. The resulting matrix is returned. +(** [add ?m ?n ?cr ?cc ?c ?ar ?ac a ?br ?bc b] computes the sum of the [m] by + [n] sub-matrix of the matrix [a] starting in row [ar] and column [ac] with + the corresponding sub-matrix of the matrix [b] starting in row [br] and + column [bc]. If [c] is given, the result will be stored in there starting in + row [cr] and column [cc], otherwise a fresh matrix will be used. The + resulting matrix is returned. @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param cr default = 1 @param cc default = 1 - @param c default = fresh matrix with [cr + m - 1] rows and - [cc + n - 1] columns + @param c + default = fresh matrix with [cr + m - 1] rows and [cc + n - 1] columns @param br default = 1 @param bc default = 1 @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val sub : binop (** [sub ?m ?n ?cr ?cc ?c ?ar ?ac a ?br ?bc b] computes the difference of the - [m] by [n] sub-matrix of the matrix [a] starting in row [ar] and column - [ac] with the corresponding sub-matrix of the matrix [b] starting in row - [br] and column [bc]. If [c] is given, the result will be stored in - there starting in row [cr] and column [cc], otherwise a fresh matrix - will be used. The resulting matrix is returned. + [m] by [n] sub-matrix of the matrix [a] starting in row [ar] and column [ac] + with the corresponding sub-matrix of the matrix [b] starting in row [br] and + column [bc]. If [c] is given, the result will be stored in there starting in + row [cr] and column [cc], otherwise a fresh matrix will be used. The + resulting matrix is returned. @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param cr default = 1 @param cc default = 1 - @param c default = fresh matrix with [cr + m - 1] rows and - [cc + n - 1] columns + @param c + default = fresh matrix with [cr + m - 1] rows and [cc + n - 1] columns @param br default = 1 @param bc default = 1 @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val mul : binop -(** [mul ?m ?n ?cr ?cc ?c ?ar ?ac a ?br ?bc b] computes the element-wise - product of the [m] by [n] sub-matrix of the matrix [a] starting in row - [ar] and column [ac] with the corresponding sub-matrix of the matrix - [b] starting in row [br] and column [bc]. If [c] is given, the result - will be stored in there starting in row [cr] and column [cc], otherwise - a fresh matrix will be used. The resulting matrix is returned. +(** [mul ?m ?n ?cr ?cc ?c ?ar ?ac a ?br ?bc b] computes the element-wise product + of the [m] by [n] sub-matrix of the matrix [a] starting in row [ar] and + column [ac] with the corresponding sub-matrix of the matrix [b] starting in + row [br] and column [bc]. If [c] is given, the result will be stored in + there starting in row [cr] and column [cc], otherwise a fresh matrix will be + used. The resulting matrix is returned. - NOTE: please do not confuse this function with matrix multiplication! - The LAPACK-function for matrix multiplication is called [gemm], - e.g. [Lacaml.D.gemm]. + NOTE: please do not confuse this function with matrix multiplication! The + LAPACK-function for matrix multiplication is called [gemm], e.g. + [Lacaml.D.gemm]. @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param cr default = 1 @param cc default = 1 - @param c default = fresh matrix with [cr + m - 1] rows and - [cc + n - 1] columns + @param c + default = fresh matrix with [cr + m - 1] rows and [cc + n - 1] columns @param br default = 1 @param bc default = 1 @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val div : binop -(** [div ?m ?n ?cr ?cc ?c ?ar ?ac a ?br ?bc b] computes the division of the - [m] by [n] sub-matrix of the matrix [a] starting in row [ar] and column - [ac] with the corresponding sub-matrix of the matrix [b] starting in row - [br] and column [bc]. If [c] is given, the result will be stored in - there starting in row [cr] and column [cc], otherwise a fresh matrix - will be used. The resulting matrix is returned. +(** [div ?m ?n ?cr ?cc ?c ?ar ?ac a ?br ?bc b] computes the division of the [m] + by [n] sub-matrix of the matrix [a] starting in row [ar] and column [ac] + with the corresponding sub-matrix of the matrix [b] starting in row [br] and + column [bc]. If [c] is given, the result will be stored in there starting in + row [cr] and column [cc], otherwise a fresh matrix will be used. The + resulting matrix is returned. @param m default = greater n s.t. [ar + m - 1 <= dim1 a] @param n default = greater n s.t. [ac + n - 1 <= dim2 a] @param cr default = 1 @param cc default = 1 - @param c default = fresh matrix with [cr + m - 1] rows and - [cc + n - 1] columns + @param c + default = fresh matrix with [cr + m - 1] rows and [cc + n - 1] columns @param br default = 1 @param bc default = 1 @param ar default = 1 - @param ac default = 1 -*) + @param ac default = 1 *) val axpy : - ?alpha : num_type -> - ?patt : patt -> - ?m : int -> - ?n : int -> - ?xr : int -> - ?xc : int -> + ?alpha:num_type -> + ?patt:patt -> + ?m:int -> + ?n:int -> + ?xr:int -> + ?xc:int -> mat -> - ?yr : int -> - ?yc : int -> - mat - -> unit + ?yr:int -> + ?yc:int -> + mat -> + unit (** [axpy ?alpha ?patt ?m ?n ?xr ?xc x ?yr ?yc y] BLAS [axpy] function for matrices. @@ -506,37 +502,38 @@ val axpy : @param xr default = 1 @param xc default = 1 @param yr default = 1 - @param yc default = 1 -*) + @param yc default = 1 *) val gemm_diag : - ?n : int -> - ?k : int -> - ?beta : num_type -> - ?ofsy : int -> - ?y : vec -> - ?transa : trans3 -> - ?alpha : num_type -> - ?ar : int -> - ?ac : int -> + ?n:int -> + ?k:int -> + ?beta:num_type -> + ?ofsy:int -> + ?y:vec -> + ?transa:trans3 -> + ?alpha:num_type -> + ?ar:int -> + ?ac:int -> mat -> - ?transb : trans3 -> - ?br : int -> - ?bc : int -> + ?transb:trans3 -> + ?br:int -> + ?bc:int -> mat -> vec (** [gemm_diag ?n ?k ?beta ?ofsy ?y ?transa ?transb ?alpha ?ar ?ac a ?br ?bc b] - computes the diagonal of the product of the (sub-)matrices [a] - and [b] (taking into account potential transposing), multiplying - it with [alpha] and adding [beta] times [y], storing the result in - [y] starting at the specified offset. [n] elements of the diagonal - will be computed, and [k] elements of the matrices will be part of - the dot product associated with each diagonal element. - - @param n default = number of rows of [a] (or tr [a]) and - number of columns of [b] (or tr [b]) - @param k default = number of columns of [a] (or tr [a]) and - number of rows of [b] (or tr [b]) + computes the diagonal of the product of the (sub-)matrices [a] and [b] + (taking into account potential transposing), multiplying it with [alpha] and + adding [beta] times [y], storing the result in [y] starting at the specified + offset. [n] elements of the diagonal will be computed, and [k] elements of + the matrices will be part of the dot product associated with each diagonal + element. + + @param n + default = number of rows of [a] (or tr [a]) and number of columns of [b] + (or tr [b]) + @param k + default = number of columns of [a] (or tr [a]) and number of rows of [b] + (or tr [b]) @param beta default = [0] @param ofsy default = [1] @param y default = fresh vector of size [n + ofsy - 1] @@ -546,55 +543,54 @@ val gemm_diag : @param ac default = [1] @param transb default = [`N] @param br default = [1] - @param bc default = [1] -*) + @param bc default = [1] *) val gemm_trace : - ?n : int -> - ?k : int -> - ?transa : trans3 -> - ?ar : int -> - ?ac : int -> + ?n:int -> + ?k:int -> + ?transa:trans3 -> + ?ar:int -> + ?ac:int -> mat -> - ?transb : trans3 -> - ?br : int -> - ?bc : int -> + ?transb:trans3 -> + ?br:int -> + ?bc:int -> mat -> num_type -(** [gemm_trace ?n ?k ?transa ?ar ?ac a ?transb ?br ?bc b] computes - the trace of the product of the (sub-)matrices [a] and [b] (taking - into account potential transposing). When transposing [a], this - yields the so-called Frobenius product of [a] and [b]. [n] is the - number of rows (columns) to consider in [a] and the number of columns - (rows) in [b]. [k] is the inner dimension to use for the product. - - @param n default = number of rows of [a] (or tr [a]) and - number of columns of [b] (or tr [b]) - @param k default = number of columns of [a] (or tr [a]) and - number of rows of [b] (or tr [b]) +(** [gemm_trace ?n ?k ?transa ?ar ?ac a ?transb ?br ?bc b] computes the trace of + the product of the (sub-)matrices [a] and [b] (taking into account potential + transposing). When transposing [a], this yields the so-called Frobenius + product of [a] and [b]. [n] is the number of rows (columns) to consider in + [a] and the number of columns (rows) in [b]. [k] is the inner dimension to + use for the product. + + @param n + default = number of rows of [a] (or tr [a]) and number of columns of [b] + (or tr [b]) + @param k + default = number of columns of [a] (or tr [a]) and number of rows of [b] + (or tr [b]) @param transa default = [`N] @param ar default = [1] @param ac default = [1] @param transb default = [`N] @param br default = [1] - @param bc default = [1] -*) + @param bc default = [1] *) val symm2_trace : - ?n : int -> - ?upa : bool -> - ?ar : int -> - ?ac : int -> + ?n:int -> + ?upa:bool -> + ?ar:int -> + ?ac:int -> mat -> - ?upb : bool -> - ?br : int -> - ?bc : int -> + ?upb:bool -> + ?br:int -> + ?bc:int -> mat -> num_type -(** [symm2_trace ?n ?upa ?ar ?ac a ?upb ?br ?bc b] computes the - trace of the product of the symmetric (sub-)matrices [a] and - [b]. [n] is the number of rows and columns to consider in [a] - and [b]. +(** [symm2_trace ?n ?upa ?ar ?ac a ?upb ?br ?bc b] computes the trace of the + product of the symmetric (sub-)matrices [a] and [b]. [n] is the number of + rows and columns to consider in [a] and [b]. @param n default = dimensions of [a] and [b] @param upa default = true (upper triangular portion of [a] is accessed) @@ -602,18 +598,17 @@ val symm2_trace : @param ac default = [1] @param upb default = true (upper triangular portion of [b] is accessed) @param br default = [1] - @param bc default = [1] -*) + @param bc default = [1] *) val ssqr_diff : - ?patt : patt -> - ?m : int -> - ?n : int -> - ?ar : int -> - ?ac : int -> + ?patt:patt -> + ?m:int -> + ?n:int -> + ?ar:int -> + ?ac:int -> mat -> - ?br : int -> - ?bc : int -> + ?br:int -> + ?bc:int -> mat -> num_type (** [ssqr_diff ?patt ?m ?n ?ar ?ac a ?br ?bc b] @return the sum of squared @@ -630,27 +625,26 @@ val ssqr_diff : @param bc default = 1 *) - (** {6 Iterators over matrices} *) val map : (num_type -> num_type) -> - ?m : int -> - ?n : int -> - ?br : int -> - ?bc : int -> - ?b : mat -> - ?ar : int -> - ?ac : int -> + ?m:int -> + ?n:int -> + ?br:int -> + ?bc:int -> + ?b:mat -> + ?ar:int -> + ?ac:int -> + mat -> mat - -> mat (** [map f ?m ?n ?br ?bc ?b ?ar ?ac a] @return matrix with [f] applied to each element of [a]. @param m default = number of rows of [a] @param n default = number of columns of [a] @param b default = fresh matrix of size m by n *) -val fold_cols : ('a -> vec -> 'a) -> ?n : int -> ?ac : int -> 'a -> mat -> 'a +val fold_cols : ('a -> vec -> 'a) -> ?n:int -> ?ac:int -> 'a -> mat -> 'a (** [fold_cols f ?n ?ac acc a] @return accumulator resulting from folding over each column vector. @param ac default = 1 diff --git a/src/mat_combine.h b/src/mat_combine.h index 2a696d6..343e54e 100644 --- a/src/mat_combine.h +++ b/src/mat_combine.h @@ -1,10 +1,8 @@ /* File: mat_combine.h - Copyright (C) 2015- + Copyright © 2015- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public @@ -18,14 +16,13 @@ You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "lacaml_macros.h" -static inline void STR(NAME, _range)(integer N, - NUMBER *A_data, NUMBER *B_data, NUMBER *C_data) -{ +static inline void STR(NAME, _range)(integer N, NUMBER *A_data, NUMBER *B_data, + NUMBER *C_data) { for (int i = 0; i < N; i++) { NUMBER a = A_data[i]; NUMBER b = B_data[i]; @@ -34,13 +31,9 @@ static inline void STR(NAME, _range)(integer N, } } -CAMLprim value NAME( - value vPKIND, intnat vPINIT, - intnat vM, intnat vN, - intnat vAR, intnat vAC, value vA, - intnat vBR, intnat vBC, value vB, - intnat vCR, intnat vCC, value vC) -{ +CAMLprim value NAME(value vPKIND, intnat vPINIT, intnat vM, intnat vN, + intnat vAR, intnat vAC, value vA, intnat vBR, intnat vBC, + value vB, intnat vCR, intnat vCC, value vC) { CAMLparam3(vA, vB, vC); integer GET_INT(M), GET_INT(N); @@ -51,102 +44,89 @@ CAMLprim value NAME( MAT_PARAMS(C); pentagon_kind PKIND = get_pentagon_kind(vPKIND); integer GET_INT(PINIT); - caml_enter_blocking_section(); /* Allow other threads */ - switch (PKIND) { - case UPPER : - { - NUMBER *A_stop = A_data + rows_A * N; - if (PINIT + N - 1 <= M) { - while (A_data < A_stop) { - STR(NAME, _range)(PINIT, A_data, B_data, C_data); - PINIT++; - A_data += rows_A; - B_data += rows_B; - C_data += rows_C; - } - } else { - while (PINIT < M) { - STR(NAME, _range)(PINIT, A_data, B_data, C_data); - PINIT++; - A_data += rows_A; - B_data += rows_B; - C_data += rows_C; - } - if (M == rows_A && M == rows_B && M == rows_C) - STR(NAME, _range)(A_stop - A_data, A_data, B_data, C_data); - else - while (A_data < A_stop) { - STR(NAME, _range)(M, A_data, B_data, C_data); - A_data += rows_A; - B_data += rows_B; - C_data += rows_C; - } - } - break; + caml_enter_blocking_section(); /* Allow other threads */ + switch (PKIND) { + case UPPER: { + NUMBER *A_stop = A_data + rows_A * N; + if (PINIT + N - 1 <= M) { + while (A_data < A_stop) { + STR(NAME, _range)(PINIT, A_data, B_data, C_data); + PINIT++; + A_data += rows_A; + B_data += rows_B; + C_data += rows_C; + } + } else { + while (PINIT < M) { + STR(NAME, _range)(PINIT, A_data, B_data, C_data); + PINIT++; + A_data += rows_A; + B_data += rows_B; + C_data += rows_C; + } + if (M == rows_A && M == rows_B && M == rows_C) + STR(NAME, _range)(A_stop - A_data, A_data, B_data, C_data); + else + while (A_data < A_stop) { + STR(NAME, _range)(M, A_data, B_data, C_data); + A_data += rows_A; + B_data += rows_B; + C_data += rows_C; } - case LOWER : - { - NUMBER *A_stop; - integer stop_col = M + PINIT; - if (stop_col > N) stop_col = N; - A_stop = A_data + stop_col*rows_A; - if (PINIT > 1) { - if (M == rows_A && M == rows_B && M == rows_C) { - integer MP = M*PINIT; - STR(NAME, _range)(MP, A_data, B_data, C_data); - A_data += MP; - B_data += MP; - C_data += MP; - } else { - NUMBER *A_block_stop = A_data + PINIT*rows_A; - while (A_data < A_block_stop) { - STR(NAME, _range)(M, A_data, B_data, C_data); - A_data += rows_A; - B_data += rows_B; - C_data += rows_C; - } - } - A_data++; - B_data++; - C_data++; - M--; - } - rows_A++; - rows_B++; - rows_C++; - while (A_data < A_stop) { - STR(NAME, _range)(M, A_data, B_data, C_data); - M--; - A_data += rows_A; - B_data += rows_B; - C_data += rows_C; - } - break; + } + break; + } + case LOWER: { + NUMBER *A_stop; + integer stop_col = M + PINIT; + if (stop_col > N) + stop_col = N; + A_stop = A_data + stop_col * rows_A; + if (PINIT > 1) { + if (M == rows_A && M == rows_B && M == rows_C) { + integer MP = M * PINIT; + STR(NAME, _range)(MP, A_data, B_data, C_data); + A_data += MP; + B_data += MP; + C_data += MP; + } else { + NUMBER *A_block_stop = A_data + PINIT * rows_A; + while (A_data < A_block_stop) { + STR(NAME, _range)(M, A_data, B_data, C_data); + A_data += rows_A; + B_data += rows_B; + C_data += rows_C; } + } + A_data++; + B_data++; + C_data++; + M--; + } + rows_A++; + rows_B++; + rows_C++; + while (A_data < A_stop) { + STR(NAME, _range)(M, A_data, B_data, C_data); + M--; + A_data += rows_A; + B_data += rows_B; + C_data += rows_C; } - caml_leave_blocking_section(); /* Disallow other threads */ + break; + } + } + caml_leave_blocking_section(); /* Disallow other threads */ } CAMLreturn(Val_unit); } -CAMLprim value BC_NAME(value *argv, int __unused argn) -{ - return - NAME( - argv[0], - Int_val(argv[1]), - Int_val(argv[2]), - Int_val(argv[3]), - Int_val(argv[4]), - Int_val(argv[5]), - argv[6], - Int_val(argv[7]), - Int_val(argv[8]), - argv[9], - Int_val(argv[10]), - Int_val(argv[11]), - argv[12]); +CAMLprim value BC_NAME(value *argv, int __unused argn) { + return NAME(argv[0], Int_val(argv[1]), Int_val(argv[2]), Int_val(argv[3]), + Int_val(argv[4]), Int_val(argv[5]), argv[6], Int_val(argv[7]), + Int_val(argv[8]), argv[9], Int_val(argv[10]), Int_val(argv[11]), + argv[12]); } #undef NAME diff --git a/src/mat_fold.h b/src/mat_fold.h index f3316fa..203dddd 100644 --- a/src/mat_fold.h +++ b/src/mat_fold.h @@ -1,10 +1,8 @@ /* File: mat_fold.h - Copyright (C) 2015- + Copyright © 2015- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public @@ -18,102 +16,97 @@ You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "lacaml_macros.h" -#define FOLD_REGION(N_ARG) \ - integer N = N_ARG; \ - for (int i = 0; i < N; i++) { \ - NUMBER a = A_data[i]; \ - FUNC(acc, a); \ +#define FOLD_REGION(N_ARG) \ + integer N = N_ARG; \ + for (int i = 0; i < N; i++) { \ + NUMBER a = A_data[i]; \ + FUNC(acc, a); \ } -static inline NUMBER STR(NAME, _blocking)( - integer PKIND, integer PINIT, integer M, integer N, - NUMBER *A_data, integer rows_A, NUMBER acc) { +static inline NUMBER STR(NAME, _blocking)(integer PKIND, integer PINIT, + integer M, integer N, NUMBER *A_data, + integer rows_A, NUMBER acc) { #ifdef DECLARE_EXTRA - DECLARE_EXTRA; + DECLARE_EXTRA; #undef DECLARE_EXTRA #endif #ifdef INIT_HAVE_LOCK - INIT_HAVE_LOCK; + INIT_HAVE_LOCK; #undef INIT_HAVE_LOCK #endif switch (PKIND) { - case UPPER : - { - NUMBER *A_stop = A_data + rows_A * N; - if (PINIT + N - 1 <= M) { - while (A_data < A_stop) { - FOLD_REGION(PINIT); - PINIT++; - A_data += rows_A; - } - } else { - while (PINIT < M) { - FOLD_REGION(PINIT); - PINIT++; - A_data += rows_A; - } - if (M == rows_A) { - FOLD_REGION(A_stop - A_data); - } - else - while (A_data < A_stop) { - FOLD_REGION(M); - A_data += rows_A; - } - } - break; + case UPPER: { + NUMBER *A_stop = A_data + rows_A * N; + if (PINIT + N - 1 <= M) { + while (A_data < A_stop) { + FOLD_REGION(PINIT); + PINIT++; + A_data += rows_A; } - case LOWER : - { - NUMBER *A_stop; - integer stop_col = M + PINIT; - if (stop_col > N) stop_col = N; - A_stop = A_data + stop_col*rows_A; - if (PINIT > 1) { - if (M == rows_A) { - integer MP = M*PINIT; - FOLD_REGION(MP); - A_data += MP; - } else { - NUMBER *A_block_stop = A_data + PINIT*rows_A; - while (A_data < A_block_stop) { - FOLD_REGION(M); - A_data += rows_A; - } - } - A_data++; - M--; - } - rows_A++; + } else { + while (PINIT < M) { + FOLD_REGION(PINIT); + PINIT++; + A_data += rows_A; + } + if (M == rows_A) { + FOLD_REGION(A_stop - A_data); + } else while (A_data < A_stop) { FOLD_REGION(M); - M--; A_data += rows_A; } - break; + } + break; + } + case LOWER: { + NUMBER *A_stop; + integer stop_col = M + PINIT; + if (stop_col > N) + stop_col = N; + A_stop = A_data + stop_col * rows_A; + if (PINIT > 1) { + if (M == rows_A) { + integer MP = M * PINIT; + FOLD_REGION(MP); + A_data += MP; + } else { + NUMBER *A_block_stop = A_data + PINIT * rows_A; + while (A_data < A_block_stop) { + FOLD_REGION(M); + A_data += rows_A; + } } + A_data++; + M--; + } + rows_A++; + while (A_data < A_stop) { + FOLD_REGION(M); + M--; + A_data += rows_A; + } + break; + } } #ifdef FINISH_HAVE_LOCK - FINISH_HAVE_LOCK; + FINISH_HAVE_LOCK; #undef FINISH_HAVE_LOCK #endif return acc; } -CAMLprim vNUMBER NAME( - value vPKIND, intnat vPINIT, - intnat vM, intnat vN, - intnat vAR, intnat vAC, value vA) -{ +CAMLprim vNUMBER NAME(value vPKIND, intnat vPINIT, intnat vM, intnat vN, + intnat vAR, intnat vAC, value vA) { CAMLparam1(vA); integer GET_INT(M), GET_INT(N); @@ -124,28 +117,20 @@ CAMLprim vNUMBER NAME( pentagon_kind PKIND = get_pentagon_kind(vPKIND); integer GET_INT(PINIT); - caml_enter_blocking_section(); /* Allow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ - acc = STR(NAME, _blocking)(PKIND, PINIT, M, N, A_data, rows_A, acc); + acc = STR(NAME, _blocking)(PKIND, PINIT, M, N, A_data, rows_A, acc); - caml_leave_blocking_section(); /* Disallow other threads */ + caml_leave_blocking_section(); /* Disallow other threads */ } CAMLreturnNUMBER(acc); } -CAMLprim value BC_NAME(value *argv, int __unused argn) -{ - return - COPY_NUMBER( - NAME( - argv[0], - Int_val(argv[1]), - Int_val(argv[2]), - Int_val(argv[3]), - Int_val(argv[4]), - Int_val(argv[5]), - argv[6])); +CAMLprim value BC_NAME(value *argv, int __unused argn) { + return COPY_NUMBER(NAME(argv[0], Int_val(argv[1]), Int_val(argv[2]), + Int_val(argv[3]), Int_val(argv[4]), Int_val(argv[5]), + argv[6])); } #undef FOLD_REGION diff --git a/src/mat_fold2.h b/src/mat_fold2.h index 2dc69a9..9eea35a 100644 --- a/src/mat_fold2.h +++ b/src/mat_fold2.h @@ -1,10 +1,8 @@ /* File: mat_fold2.h - Copyright (C) 2015- + Copyright © 2015- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public @@ -18,14 +16,13 @@ You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "lacaml_macros.h" -static inline NUMBER STR(NAME, _range)(integer N, - NUMBER *A_data, NUMBER *B_data, NUMBER acc) -{ +static inline NUMBER STR(NAME, _range)(integer N, NUMBER *A_data, + NUMBER *B_data, NUMBER acc) { for (int i = 0; i < N; i++) { NUMBER a = A_data[i]; NUMBER b = B_data[i]; @@ -34,12 +31,9 @@ static inline NUMBER STR(NAME, _range)(integer N, return acc; } -CAMLprim vNUMBER NAME( - value vPKIND, intnat vPINIT, - intnat vM, intnat vN, - intnat vAR, intnat vAC, value vA, - intnat vBR, intnat vBC, value vB) -{ +CAMLprim vNUMBER NAME(value vPKIND, intnat vPINIT, intnat vM, intnat vN, + intnat vAR, intnat vAC, value vA, intnat vBR, intnat vBC, + value vB) { CAMLparam2(vA, vB); integer GET_INT(M), GET_INT(N); @@ -50,92 +44,81 @@ CAMLprim vNUMBER NAME( MAT_PARAMS(B); pentagon_kind PKIND = get_pentagon_kind(vPKIND); integer GET_INT(PINIT); - caml_enter_blocking_section(); /* Allow other threads */ - switch (PKIND) { - case UPPER : - { - NUMBER *A_stop = A_data + rows_A * N; - if (PINIT + N - 1 <= M) { - while (A_data < A_stop) { - acc = STR(NAME, _range)(PINIT, A_data, B_data, acc); - PINIT++; - A_data += rows_A; - B_data += rows_B; - } - } else { - while (PINIT < M) { - acc = STR(NAME, _range)(PINIT, A_data, B_data, acc); - PINIT++; - A_data += rows_A; - B_data += rows_B; - } - if (M == rows_A) - acc = STR(NAME, _range)(A_stop - A_data, A_data, B_data, acc); - else - while (A_data < A_stop) { - acc = STR(NAME, _range)(M, A_data, B_data, acc); - A_data += rows_A; - B_data += rows_B; - } - } - break; + caml_enter_blocking_section(); /* Allow other threads */ + switch (PKIND) { + case UPPER: { + NUMBER *A_stop = A_data + rows_A * N; + if (PINIT + N - 1 <= M) { + while (A_data < A_stop) { + acc = STR(NAME, _range)(PINIT, A_data, B_data, acc); + PINIT++; + A_data += rows_A; + B_data += rows_B; + } + } else { + while (PINIT < M) { + acc = STR(NAME, _range)(PINIT, A_data, B_data, acc); + PINIT++; + A_data += rows_A; + B_data += rows_B; + } + if (M == rows_A) + acc = STR(NAME, _range)(A_stop - A_data, A_data, B_data, acc); + else + while (A_data < A_stop) { + acc = STR(NAME, _range)(M, A_data, B_data, acc); + A_data += rows_A; + B_data += rows_B; } - case LOWER : - { - NUMBER *A_stop; - integer stop_col = M + PINIT; - if (stop_col > N) stop_col = N; - A_stop = A_data + stop_col*rows_A; - if (PINIT > 1) { - if (M == rows_A && M == rows_B) { - integer MP = M*PINIT; - acc = STR(NAME, _range)(MP, A_data, B_data, acc); - A_data += MP; - B_data += MP; - } else { - NUMBER *A_block_stop = A_data + PINIT*rows_A; - while (A_data < A_block_stop) { - acc = STR(NAME, _range)(M, A_data, B_data, acc); - A_data += rows_A; - B_data += rows_B; - } - } - A_data++; - B_data++; - M--; - } - rows_A++; - rows_B++; - while (A_data < A_stop) { - acc = STR(NAME, _range)(M, A_data, B_data, acc); - M--; - A_data += rows_A; - B_data += rows_B; - } - break; + } + break; + } + case LOWER: { + NUMBER *A_stop; + integer stop_col = M + PINIT; + if (stop_col > N) + stop_col = N; + A_stop = A_data + stop_col * rows_A; + if (PINIT > 1) { + if (M == rows_A && M == rows_B) { + integer MP = M * PINIT; + acc = STR(NAME, _range)(MP, A_data, B_data, acc); + A_data += MP; + B_data += MP; + } else { + NUMBER *A_block_stop = A_data + PINIT * rows_A; + while (A_data < A_block_stop) { + acc = STR(NAME, _range)(M, A_data, B_data, acc); + A_data += rows_A; + B_data += rows_B; } + } + A_data++; + B_data++; + M--; + } + rows_A++; + rows_B++; + while (A_data < A_stop) { + acc = STR(NAME, _range)(M, A_data, B_data, acc); + M--; + A_data += rows_A; + B_data += rows_B; } - caml_leave_blocking_section(); /* Disallow other threads */ + break; + } + } + caml_leave_blocking_section(); /* Disallow other threads */ } CAMLreturnNUMBER(acc); } -CAMLprim value BC_NAME(value *argv, int __unused argn) -{ - return - COPY_NUMBER( - NAME( - argv[0], - Int_val(argv[1]), - Int_val(argv[2]), - Int_val(argv[3]), - Int_val(argv[4]), - Int_val(argv[5]), - argv[6], - Int_val(argv[7]), - Int_val(argv[8]), - argv[9])); +CAMLprim value BC_NAME(value *argv, int __unused argn) { + return COPY_NUMBER(NAME(argv[0], Int_val(argv[1]), Int_val(argv[2]), + Int_val(argv[3]), Int_val(argv[4]), Int_val(argv[5]), + argv[6], Int_val(argv[7]), Int_val(argv[8]), + argv[9])); } #undef NAME diff --git a/src/mat_map.h b/src/mat_map.h index 321878d..bb1682c 100644 --- a/src/mat_map.h +++ b/src/mat_map.h @@ -1,10 +1,8 @@ /* File: mat_map.h - Copyright (C) 2015- + Copyright © 2015- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public @@ -18,13 +16,13 @@ You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "lacaml_macros.h" -static inline void STR(NAME, _range)(integer N, NUMBER *A_data, NUMBER *B_data) -{ +static inline void STR(NAME, _range)(integer N, NUMBER *A_data, + NUMBER *B_data) { for (int i = 0; i < N; i++) { NUMBER a = A_data[i]; NUMBER *dst = B_data + i; @@ -32,12 +30,9 @@ static inline void STR(NAME, _range)(integer N, NUMBER *A_data, NUMBER *B_data) } } -CAMLprim value NAME( - value vPKIND, intnat vPINIT, - intnat vM, intnat vN, - intnat vAR, intnat vAC, value vA, - intnat vBR, intnat vBC, value vB) -{ +CAMLprim value NAME(value vPKIND, intnat vPINIT, intnat vM, intnat vN, + intnat vAR, intnat vAC, value vA, intnat vBR, intnat vBC, + value vB) { CAMLparam2(vA, vB); integer GET_INT(M), GET_INT(N); @@ -47,91 +42,80 @@ CAMLprim value NAME( MAT_PARAMS(B); pentagon_kind PKIND = get_pentagon_kind(vPKIND); integer GET_INT(PINIT); - caml_enter_blocking_section(); /* Allow other threads */ - switch (PKIND) { - case UPPER : - { - NUMBER *A_stop = A_data + rows_A * N; - if (PINIT + N - 1 <= M) { - while (A_data < A_stop) { - STR(NAME, _range)(PINIT, A_data, B_data); - PINIT++; - A_data += rows_A; - B_data += rows_B; - } - } else { - while (PINIT < M) { - STR(NAME, _range)(PINIT, A_data, B_data); - PINIT++; - A_data += rows_A; - B_data += rows_B; - } - if (M == rows_A) - STR(NAME, _range)(A_stop - A_data, A_data, B_data); - else - while (A_data < A_stop) { - STR(NAME, _range)(M, A_data, B_data); - A_data += rows_A; - B_data += rows_B; - } - } - break; + caml_enter_blocking_section(); /* Allow other threads */ + switch (PKIND) { + case UPPER: { + NUMBER *A_stop = A_data + rows_A * N; + if (PINIT + N - 1 <= M) { + while (A_data < A_stop) { + STR(NAME, _range)(PINIT, A_data, B_data); + PINIT++; + A_data += rows_A; + B_data += rows_B; + } + } else { + while (PINIT < M) { + STR(NAME, _range)(PINIT, A_data, B_data); + PINIT++; + A_data += rows_A; + B_data += rows_B; + } + if (M == rows_A) + STR(NAME, _range)(A_stop - A_data, A_data, B_data); + else + while (A_data < A_stop) { + STR(NAME, _range)(M, A_data, B_data); + A_data += rows_A; + B_data += rows_B; } - case LOWER : - { - NUMBER *A_stop; - integer stop_col = M + PINIT; - if (stop_col > N) stop_col = N; - A_stop = A_data + stop_col*rows_A; - if (PINIT > 1) { - if (M == rows_A && M == rows_B) { - integer MP = M*PINIT; - STR(NAME, _range)(MP, A_data, B_data); - A_data += MP; - B_data += MP; - } else { - NUMBER *A_block_stop = A_data + PINIT*rows_A; - while (A_data < A_block_stop) { - STR(NAME, _range)(M, A_data, B_data); - A_data += rows_A; - B_data += rows_B; - } - } - A_data++; - B_data++; - M--; - } - rows_A++; - rows_B++; - while (A_data < A_stop) { - STR(NAME, _range)(M, A_data, B_data); - M--; - A_data += rows_A; - B_data += rows_B; - } - break; + } + break; + } + case LOWER: { + NUMBER *A_stop; + integer stop_col = M + PINIT; + if (stop_col > N) + stop_col = N; + A_stop = A_data + stop_col * rows_A; + if (PINIT > 1) { + if (M == rows_A && M == rows_B) { + integer MP = M * PINIT; + STR(NAME, _range)(MP, A_data, B_data); + A_data += MP; + B_data += MP; + } else { + NUMBER *A_block_stop = A_data + PINIT * rows_A; + while (A_data < A_block_stop) { + STR(NAME, _range)(M, A_data, B_data); + A_data += rows_A; + B_data += rows_B; } + } + A_data++; + B_data++; + M--; + } + rows_A++; + rows_B++; + while (A_data < A_stop) { + STR(NAME, _range)(M, A_data, B_data); + M--; + A_data += rows_A; + B_data += rows_B; } - caml_leave_blocking_section(); /* Disallow other threads */ + break; + } + } + caml_leave_blocking_section(); /* Disallow other threads */ } CAMLreturn(Val_unit); } -CAMLprim value BC_NAME(value *argv, int __unused argn) -{ - return - NAME( - argv[0], - Int_val(argv[1]), - Int_val(argv[2]), - Int_val(argv[3]), - Int_val(argv[4]), - Int_val(argv[5]), - argv[6], - Int_val(argv[7]), - Int_val(argv[8]), - argv[9]); +CAMLprim value BC_NAME(value *argv, int __unused argn) { + return NAME(argv[0], Int_val(argv[1]), Int_val(argv[2]), Int_val(argv[3]), + Int_val(argv[4]), Int_val(argv[5]), argv[6], Int_val(argv[7]), + Int_val(argv[8]), argv[9]); } #undef NAME diff --git a/src/real_io.ml b/src/real_io.ml index 9dd5ba3..c009b9f 100644 --- a/src/real_io.ml +++ b/src/real_io.ml @@ -1,29 +1,24 @@ (* File: real_io.ml - Copyright (C) 2001- - - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info - - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umh.ac.be/an/ - - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. - - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + Copyright © 2001- + + Markus Mottl + + Christophe Troestler + + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. + + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. + + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) open Io diff --git a/src/real_io.mli b/src/real_io.mli index 781f199..0aab439 100644 --- a/src/real_io.mli +++ b/src/real_io.mli @@ -1,25 +1,22 @@ (* File: real_io.mli - Copyright (C) 2010- - - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umons.ac.be/an/ - - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. - - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + Copyright © 2010- + + Christophe Troestler + + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. + + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. + + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) val pp_num : Format.formatter -> float -> unit (** [pp_num ppf el] is equivalent to [fprintf ppf "%G" el]. *) diff --git a/src/utils.ml b/src/utils.ml index b4b7387..4ad662c 100644 --- a/src/utils.ml +++ b/src/utils.ml @@ -1,37 +1,28 @@ (* File: utils.ml - Copyright (C) 2001- + Copyright © 2001- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - Liam Stewart - email: liam@cs.toronto.edu - WWW: http://www.cs.toronto.edu/~liam + Liam Stewart - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umh.ac.be/an/ + Christophe Troestler - Florent Hoareau - email: h.florent@gmail.com - WWW: none + Florent Hoareau - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) (** General auxiliary functions *) @@ -45,12 +36,12 @@ let empty_int32_vec = create_int32_vec 0 (* Char indicating type of norm to retrieve for XlanYY routines *) let get_norm_char = function `M -> 'M' | `O -> 'O' | `I -> 'I' | `F -> 'F' -(* Char indicating whether the "U"pper or "L"ower triangle of a matrix - is stored *) +(* Char indicating whether the "U"pper or "L"ower triangle of a matrix is + stored *) let get_uplo_char up = if up then 'U' else 'L' -(* Char indicating whether some operation operates on a "N"ormal, - "T"ransposed or "C"onjugated transposed matrix. *) +(* Char indicating whether some operation operates on a "N"ormal, "T"ransposed + or "C"onjugated transposed matrix. *) let get_trans_char = function `N -> 'N' | `T -> 'T' | `C -> 'C' (* Char indicating which side of the matrix B matrix A should be on *) @@ -59,8 +50,8 @@ let get_side_char = function `L -> 'L' | `R -> 'R' (* Char indicating whether a diagonal is unit or non-unit *) let get_diag_char = function `U -> 'U' | `N -> 'N' -(* Char indicating whether/how the left/right singular vectors - should be computed *) +(* Char indicating whether/how the left/right singular vectors should be + computed *) let get_s_d_job_char = function `A -> 'A' | `S -> 'S' | `O -> 'O' | `N -> 'N' (* Char indicating whether the eigen"V"ectors are computed or "N"ot *) @@ -68,7 +59,6 @@ let get_job_char = function true -> 'V' | _ -> 'N' let job_char_true = get_job_char true let job_char_false = get_job_char false - (** Preallocated strings (names) *) let a_str = "a" @@ -121,7 +111,6 @@ let x_str = "x" let y_str = "y" let z_str = "z" - (** Range checking *) (** [raise_var_lt0 ~loc ~name var] @raise Invalid_argument to indicate @@ -142,21 +131,20 @@ let check_var_within loc var_name var lb ub c = invalid_arg (sprintf "%s: %s %s > %s" loc var_name (c var) (c ub)) else () - -(** Valueless vector checking and allocation functions (do not require a - vector value as argument *) +(** Valueless vector checking and allocation functions (do not require a vector + value as argument *) (** [calc_vec_min_dim ~n ~ofs ~inc] @return minimum vector dimension given offset [ofs], increment [inc], and operation size [n] for a vector. *) let calc_vec_min_dim ~n ~ofs ~inc = - if n = 0 then ofs - 1 else ofs + (n - 1) * abs inc + if n = 0 then ofs - 1 else ofs + ((n - 1) * abs inc) (** [raise_vec_min_dim ~loc ~vec_name ~dim ~min_dim] @raise Invalid_argument to indicate that dimension [dim] of a vector with name [vec_name] exceeds the minimum [min_dim] at location [loc]. *) let raise_vec_min_dim ~loc ~vec_name ~dim ~min_dim = - invalid_arg ( - sprintf "%s: dim(%s): valid=[%d..[ got=%d" loc vec_name min_dim dim) + invalid_arg + (sprintf "%s: dim(%s): valid=[%d..[ got=%d" loc vec_name min_dim dim) (** [check_vec_min_dim ~loc ~vec_name ~dim ~min_dim] checks whether vector with name [vec_name] and dimension [dim] satisfies minimum dimension @@ -168,8 +156,8 @@ let check_vec_min_dim ~loc ~vec_name ~dim ~min_dim = to indicate that vector offset [ofs] is invalid (i.e. is outside of [1..max_ofs]). *) let raise_vec_bad_ofs ~loc ~vec_name ~ofs ~max_ofs = - invalid_arg ( - sprintf "%s: ofs%s: valid=[1..%d] got=%d" loc vec_name max_ofs ofs) + invalid_arg + (sprintf "%s: ofs%s: valid=[1..%d] got=%d" loc vec_name max_ofs ofs) (** [bad_n ~n ~max_n] @return [true] iff [n] is smaller than zero or larger than [max_n]. *) @@ -198,7 +186,7 @@ let check_vec_inc ~loc ~vec_name inc = for a vector given the dimension [dim] of the vector, the offset [ofs], and increment [inc]. Assumes that the offset has already been validated to not exceed [dim], i.e. the returned [max_n] is at least [1]. *) -let calc_vec_max_n ~dim ~ofs ~inc = 1 + (dim - ofs) / abs inc +let calc_vec_max_n ~dim ~ofs ~inc = 1 + ((dim - ofs) / abs inc) (** [calc_vec_opt_max_n ?ofs ?inc dim] @return maximum operation length [n] for a vector given the dimension [dim] of the vector, the optional offset @@ -222,11 +210,10 @@ let check_vec_dim ~loc ~vec_name ~dim ~ofs ~inc ~n_name ~n = check_vec_inc ~loc ~vec_name inc; check_var_lt0 ~loc ~name:n_name n; if n = 0 then check_vec_ofs ~loc ~vec_name ~ofs ~max_ofs:(dim + 1) - else begin + else ( check_vec_ofs ~loc ~vec_name ~ofs ~max_ofs:dim; let max_n = calc_vec_max_n ~dim ~ofs ~inc in - if n > max_n then raise_max_len ~loc ~len_name:n_name ~len:n ~max_len:max_n - end + if n > max_n then raise_max_len ~loc ~len_name:n_name ~len:n ~max_len:max_n) (** [get_vec_n ~loc ~vec_name ~dim ~ofs ~inc ~n_name n] checks or infers the vector operation length in the option parameter [n] with name [n_name] @@ -240,11 +227,12 @@ let get_vec_n ~loc ~vec_name ~dim ~ofs ~inc ~n_name = function | None -> check_vec_inc ~loc ~vec_name inc; if ofs = dim + 1 then 0 - else begin + else ( check_vec_ofs ~loc ~vec_name ~ofs ~max_ofs:dim; - calc_vec_max_n ~dim ~ofs ~inc - end - | Some n -> check_vec_dim ~loc ~vec_name ~dim ~ofs ~inc ~n_name ~n; n + calc_vec_max_n ~dim ~ofs ~inc) + | Some n -> + check_vec_dim ~loc ~vec_name ~dim ~ofs ~inc ~n_name ~n; + n (** [get_vec_min_dim ~loc ~vec_name ~ofs ~inc ~n] @return minimum vector dimension given offset [ofs], increment [inc], and operation size [n] @@ -258,21 +246,19 @@ let get_vec_min_dim ~loc ~vec_name ~ofs ~inc ~n = (** [get_vec_start_stop ~ofsx ~incx ~n] @return [(start, stop)] where [start] and [stop] reflect the start and stop of an iteration respectively. *) let get_vec_start_stop ~ofsx ~incx ~n = - if n = 0 then 0, 0 - else - if incx > 0 then ofsx, ofsx + n * incx - else ofsx - (n - 1) * incx, ofsx + incx - + if n = 0 then (0, 0) + else if incx > 0 then (ofsx, ofsx + (n * incx)) + else (ofsx - ((n - 1) * incx), ofsx + incx) -(** Valueless matrix checking and allocation functions (do not require a - matrix value as argument *) +(** Valueless matrix checking and allocation functions (do not require a matrix + value as argument *) (** [raise_bad_mat_ofs ~loc ~name ~ofs_name ~ofs ~max_ofs] @raise Invalid_argument to indicate that a matrix offset [ofs] named [ofs_name] for a matrix having [name] is invalid (i.e. is outside of [1..max_ofs]). *) let raise_bad_mat_ofs ~loc ~name ~ofs_name ~ofs ~max_ofs = - invalid_arg ( - sprintf "%s: %s%s: valid=[1..%d] got=%d" loc name ofs_name max_ofs ofs) + invalid_arg + (sprintf "%s: %s%s: valid=[1..%d] got=%d" loc name ofs_name max_ofs ofs) (** [raise_mat_bad_r ~loc ~mat_name ~r ~max_r] @raise Invalid_argument to indicate that matrix row offset [r] is invalid (i.e. is outside of @@ -327,12 +313,11 @@ let calc_mat_opt_max_cols ?(c = 1) dim2 = calc_mat_max_cols ~dim2 ~c let check_mat_rows ~loc ~mat_name ~dim1 ~r ~p ~param_name = check_var_lt0 ~loc ~name:param_name p; if p = 0 then check_mat_r ~loc ~mat_name ~r ~max_r:(dim1 + 1) - else begin + else ( check_mat_r ~loc ~mat_name ~r ~max_r:dim1; let max_rows = calc_mat_max_rows ~dim1 ~r in if p > max_rows then - raise_max_len ~loc ~len_name:param_name ~len:p ~max_len:max_rows - end + raise_max_len ~loc ~len_name:param_name ~len:p ~max_len:max_rows) (** [check_mat_m ~loc ~mat_name ~dim1 ~r ~m] checks the matrix row operation length in parameter [m] at location [loc] for matrix with name [mat_name] @@ -349,16 +334,15 @@ let check_mat_m ~loc ~mat_name ~dim1 ~r ~m = let check_mat_cols ~loc ~mat_name ~dim2 ~c ~p ~param_name = check_var_lt0 ~loc ~name:param_name p; if p = 0 then check_mat_c ~loc ~mat_name ~c ~max_c:(dim2 + 1) - else begin + else ( check_mat_c ~loc ~mat_name ~c ~max_c:dim2; let max_cols = calc_mat_max_cols ~dim2 ~c in if p > max_cols then - raise_max_len ~loc ~len_name:param_name ~len:p ~max_len:max_cols - end + raise_max_len ~loc ~len_name:param_name ~len:p ~max_len:max_cols) -(** [check_mat_n ~loc ~mat_name ~dim2 ~c ~n] checks the matrix column - operation length in parameter [n] at location [loc] for matrix with - name [mat_name] and dimension [dim2] given the operation column [c]. +(** [check_mat_n ~loc ~mat_name ~dim2 ~c ~n] checks the matrix column operation + length in parameter [n] at location [loc] for matrix with name [mat_name] + and dimension [dim2] given the operation column [c]. @raise Invalid_argument if any arguments are invalid. *) let check_mat_n ~loc ~mat_name ~dim2 ~c ~n = check_mat_cols ~loc ~mat_name ~dim2 ~c ~p:n ~param_name:n_str @@ -385,7 +369,9 @@ let get_mat_rows ~loc ~mat_name ~dim1 ~r ~p ~param_name = let max_r = dim1 + 1 in check_mat_r ~loc ~mat_name ~r ~max_r; max_r - r - | Some p -> check_mat_rows ~loc ~mat_name ~dim1 ~r ~p ~param_name; p + | Some p -> + check_mat_rows ~loc ~mat_name ~dim1 ~r ~p ~param_name; + p (** [get_mat_dim1 ~loc ~mat_name ~dim1 ~r ~m ~m_name] checks or infers the matrix row operation length in the option parameter [m] with name [m_name] @@ -415,7 +401,9 @@ let get_mat_cols ~loc ~mat_name ~dim2 ~c ~p ~param_name = let max_c = dim2 + 1 in check_mat_c ~loc ~mat_name ~c ~max_c; max_c - c - | Some p -> check_mat_cols ~loc ~mat_name ~dim2 ~c ~p ~param_name; p + | Some p -> + check_mat_cols ~loc ~mat_name ~dim2 ~c ~p ~param_name; + p (** [get_mat_dim2 ~loc ~mat_name ~dim2 ~c ~n ~n_name] checks or infers the matrix column operation length in the option parameter [n] with name @@ -454,8 +442,8 @@ let get_mat_min_dim2 ~loc ~mat_name ~c ~n = any arguments are invalid. *) let check_mat_min_dim1 ~loc ~mat_name ~dim1 ~min_dim1 = if dim1 < min_dim1 then - invalid_arg ( - sprintf "%s: dim1(%s): valid=[%d..[ got=%d" loc mat_name min_dim1 dim1) + invalid_arg + (sprintf "%s: dim1(%s): valid=[%d..[ got=%d" loc mat_name min_dim1 dim1) (** [check_mat_min_dim2 ~loc ~mat_name ~dim2 ~min_dim2] checks the minimum column dimension [min_dim2] of a matrix with name [mat_name] at location @@ -463,8 +451,8 @@ let check_mat_min_dim1 ~loc ~mat_name ~dim1 ~min_dim1 = any arguments are invalid. *) let check_mat_min_dim2 ~loc ~mat_name ~dim2 ~min_dim2 = if dim2 < min_dim2 then - invalid_arg ( - sprintf "%s: dim2(%s): valid=[%d..[ got=%d" loc mat_name min_dim2 dim2) + invalid_arg + (sprintf "%s: dim2(%s): valid=[%d..[ got=%d" loc mat_name min_dim2 dim2) (** [check_mat_min_dim2 ~loc ~mat_name ~dim2 ~min_dim2] checks the minimum column dimension [min_dim2] of a matrix with name [mat_name] at location @@ -474,14 +462,13 @@ let check_mat_min_dims ~loc ~mat_name ~dim1 ~dim2 ~min_dim1 ~min_dim2 = check_mat_min_dim1 ~loc ~mat_name ~dim1 ~min_dim1; check_mat_min_dim2 ~loc ~mat_name ~dim2 ~min_dim2 - (** (Old) Vector checking and allocation functions *) let check_vec loc vec_name vec min_dim = check_vec_min_dim ~loc ~vec_name ~dim:(Array1.dim vec) ~min_dim -(** [check_vec_is_perm loc vec_name vec n] checks whether [vec] - is a valid permutation vector. *) +(** [check_vec_is_perm loc vec_name vec n] checks whether [vec] is a valid + permutation vector. *) let check_vec_is_perm loc vec_name vec n = let dim = Array1.dim vec in if dim <> n then @@ -491,17 +478,19 @@ let check_vec_is_perm loc vec_name vec n = for i = 1 to dim do let r = Array1.get vec i in check_var_within loc (sprintf "%s(%d)" k_str i) r 1l ub Int32.to_string - done + done let get_vec loc vec_name vec ofs inc n vec_create = let min_dim = get_vec_min_dim ~loc ~vec_name ~ofs ~inc ~n in match vec with - | Some vec -> check_vec loc vec_name vec min_dim; vec + | Some vec -> + check_vec loc vec_name vec min_dim; + vec | None -> vec_create min_dim -(** [get_dim_vec loc vec_name ofs inc vec n_name n] if the dimension [n] - is given, check that the vector [vec] is big enough, otherwise return - the maximal [n] for the given vector [vec]. *) +(** [get_dim_vec loc vec_name ofs inc vec n_name n] if the dimension [n] is + given, check that the vector [vec] is big enough, otherwise return the + maximal [n] for the given vector [vec]. *) let get_dim_vec loc vec_name ofs inc vec n_name n = get_vec_n ~loc ~vec_name ~dim:(Array1.dim vec) ~ofs ~inc ~n_name n @@ -510,8 +499,6 @@ let check_vec_empty ~loc ~vec_name ~dim = invalid_arg (sprintf "%s: dimension of vector %s is zero" loc vec_name) else () - - (** (Old) Matrix checking and allocation functions *) let get_mat loc mat_name mat_create r c mat m n = @@ -552,9 +539,10 @@ let check_mat_empty ~loc ~mat_name ~dim1 ~dim2 = invalid_arg (sprintf "%s: dim2 of matrix %s is zero" loc mat_name) else () - let get_vec_inc loc vec_name = function - | Some inc -> check_vec_inc ~loc ~vec_name inc; inc + | Some inc -> + check_vec_inc ~loc ~vec_name inc; + inc | None -> 1 let get_vec_ofs loc var = function @@ -572,59 +560,62 @@ module Mat_patt = struct if l <= 0 then failwith (sprintf "%s: illegal initial rows (%d) of upper pentagon" loc l) else if l > m then - failwith ( - sprintf - "%s: initial rows (%d) of upper pentagon exceed maximum [m] (%d)" - loc l m) + failwith + (sprintf + "%s: initial rows (%d) of upper pentagon exceed maximum [m] (%d)" loc + l m) let check_lpent ~loc ~l ~n = if l <= 0 then - failwith ( - sprintf "%s: illegal initial columns (%d) of lower pentagon" loc l) + failwith + (sprintf "%s: illegal initial columns (%d) of lower pentagon" loc l) else if l > n then - failwith ( - sprintf - "%s: initial columns (%d) of lower pentagon exceed maximum [n] (%d)" - loc l n) + failwith + (sprintf + "%s: initial columns (%d) of lower pentagon exceed maximum [n] (%d)" + loc l n) - let check_args ~loc ~m ~n : Types.Mat.patt option -> unit= function + let check_args ~loc ~m ~n : Types.Mat.patt option -> unit = function | None | Some `Full | Some `Utr | Some `Ltr -> () - | Some `Upent l -> check_upent ~loc ~l ~m - | Some `Lpent l -> check_lpent ~loc ~l ~n + | Some (`Upent l) -> check_upent ~loc ~l ~m + | Some (`Lpent l) -> check_lpent ~loc ~l ~n let normalize_args ~loc ~m ~n : Types.Mat.patt option -> kind * int = function - | None | Some `Full -> Lower, n - | Some `Utr -> Upper, 1 - | Some `Ltr -> Lower, 1 - | Some `Upent l -> check_upent ~loc ~l ~m; Upper, l - | Some `Lpent l -> check_lpent ~loc ~l ~n; Lower, l - - let patt_of_uplo ~(uplo : [`U | `L] option) ~(patt : Types.Mat.patt option) = - match uplo with - | Some `U -> Some `Utr - | Some `L -> Some `Ltr - | None -> patt + | None | Some `Full -> (Lower, n) + | Some `Utr -> (Upper, 1) + | Some `Ltr -> (Lower, 1) + | Some (`Upent l) -> + check_upent ~loc ~l ~m; + (Upper, l) + | Some (`Lpent l) -> + check_lpent ~loc ~l ~n; + (Lower, l) + + let patt_of_uplo ~(uplo : [ `U | `L ] option) ~(patt : Types.Mat.patt option) + = + match uplo with Some `U -> Some `Utr | Some `L -> Some `Ltr | None -> patt let patt_of_up ~up ~(patt : Types.Mat.patt option) = match up with | Some true -> Some `Utr | Some false -> Some `Ltr | None -> patt -end (* Mat_patt *) +end +(* Mat_patt *) (**) (* Fetches problem-dependent parameters for LAPACK-functions *) external ilaenv : - (int [@untagged]) -> + (int[@untagged]) -> string -> string -> - (int [@untagged]) -> - (int [@untagged]) -> - (int [@untagged]) -> - (int [@untagged]) -> - (int [@untagged]) - = "lacaml_ilaenv_stub_bc" "lacaml_ilaenv_stub" [@@noalloc] + (int[@untagged]) -> + (int[@untagged]) -> + (int[@untagged]) -> + (int[@untagged]) -> + (int[@untagged]) = "lacaml_ilaenv_stub_bc" "lacaml_ilaenv_stub" +[@@noalloc] (* Get a work array *) let get_work loc vec_create work min_lwork opt_lwork lwork_str = @@ -632,14 +623,14 @@ let get_work loc vec_create work min_lwork opt_lwork lwork_str = | Some work -> let lwork = Array1.dim work in if lwork < min_lwork then - invalid_arg ( - sprintf "%s: %s: valid=[%d..[ got=%d" loc lwork_str min_lwork lwork) - else work, lwork - | None -> vec_create opt_lwork, opt_lwork + invalid_arg + (sprintf "%s: %s: valid=[%d..[ got=%d" loc lwork_str min_lwork lwork) + else (work, lwork) + | None -> (vec_create opt_lwork, opt_lwork) let calc_unpacked_dim loc n_vec = - let n = truncate (sqrt (float (8 * n_vec + 1)) *. 0.5) in - if (n * n + n) / 2 <> n_vec then + let n = truncate (sqrt (float ((8 * n_vec) + 1)) *. 0.5) in + if ((n * n) + n) / 2 <> n_vec then failwith (sprintf "%s: illegal vector length: %d" loc n_vec) else n @@ -654,37 +645,38 @@ let get_unpacked_dim loc ?n n_vec = else n let get_vec_geom loc var ofs inc = - get_vec_ofs loc var ofs, get_vec_inc loc var inc + (get_vec_ofs loc var ofs, get_vec_inc loc var inc) (* A symmetric band (SB) or triangular band (TB) matrix has physical size - [k+1]*[n] for a logical matrix of size [n]*[n]. Check and return the [k] + [k+1]*[n] for a logical matrix of size [n]*[n]. Check and return the [k] (possibly also given by the optional argument [k]). *) let get_k_mat_sb loc mat_name mat mat_r k_name k = let dim1 = Array2.dim1 mat in let max_k = dim1 - mat_r in if mat_r < 1 || max_k < 0 then - invalid_arg ( - sprintf "%s: mat_r(%s): valid=[1..%d] got=%d" loc mat_name dim1 mat_r); + invalid_arg + (sprintf "%s: mat_r(%s): valid=[1..%d] got=%d" loc mat_name dim1 mat_r); match k with | None -> max_k | Some k -> if k < 0 || max_k < k then - invalid_arg ( - sprintf "%s: %s(%s): valid=[0..%d] got=%d" - loc k_name mat_name max_k k) + invalid_arg + (sprintf "%s: %s(%s): valid=[0..%d] got=%d" loc k_name mat_name max_k + k) else k let get_dim_mat_packed loc mat_name ofsmat mat n_name n = let dim = Array1.dim mat in match n with | Some n -> - let n1 = ofsmat + (n - 1)*(n + 2)/2 (* ?overflow? *) in + let n1 = ofsmat + ((n - 1) * (n + 2) / 2 (* ?overflow? *)) in if n < 0 || dim < n1 then - invalid_arg (sprintf "%s: %s(%s): valid=[0..%d] got=%d" - loc n_name mat_name dim n1) + invalid_arg + (sprintf "%s: %s(%s): valid=[0..%d] got=%d" loc n_name mat_name dim n1) else n - | None -> (* the greater n s.t. ofsmat - 1 + n(n+1)/2 <= dim mat *) - max 0 (truncate((sqrt(9. +. 8. *. float(dim - ofsmat)) -. 1.) /. 2.)) + | None -> + (* the greater n s.t. ofsmat - 1 + n(n+1)/2 <= dim mat *) + max 0 (truncate ((sqrt (9. +. (8. *. float (dim - ofsmat))) -. 1.) /. 2.)) (* Makes sure that [mat] is a square matrix and [n] is within range *) let get_n_of_square loc mat_name r c mat n = @@ -699,7 +691,6 @@ let get_nrhs_of_b loc n br bc b nrhs = check_dim1_mat loc b_str b br n_str n; nrhs - (* ORGQR - Auxiliary Functions *) let orgqr_err ~loc ~m ~n ~k ~work ~a ~err = @@ -721,17 +712,12 @@ let orgqr_get_params loc ?m ?n ?k ~tau ~ar ~ac a = if m < n then invalid_arg (sprintf "%s: m(%d) < n(%d)" loc m n) else let k = get_dim_vec loc tau_str 1 1 tau k_str k in - m, n, k - + (m, n, k) (* ORMQR - Auxiliary Functions *) let ormqr_err ~loc ~side ~m ~n ~k ~lwork ~a ~c ~err = - let nq, nw = - match side with - | `L -> m, n - | `R -> n, m - in + let nq, nw = match side with `L -> (m, n) | `R -> (n, m) in let msg = match err with | -3 -> sprintf "m: valid=[0..[ got=%d" m @@ -750,17 +736,15 @@ let ormqr_get_params loc ~side ?m ?n ?k ~tau ~ar ~ac a ~cr ~cc c = let m = get_dim1_mat loc c_str c cr m_str m in let n = get_dim2_mat loc c_str c cc n_str n in let k = get_dim2_mat loc a_str a ac k_str k in - begin match side with + (match side with | `L -> if m < k then failwith (sprintf "%s: m(%d) < k(%d)" loc m k); check_dim1_mat loc a_str a ar m_str (max 1 m) | `R -> if n < k then failwith (sprintf "%s: n(%d) < k(%d)" loc n k); - check_dim1_mat loc a_str a ar n_str (max 1 n) - end; + check_dim1_mat loc a_str a ar n_str (max 1 n)); check_vec loc tau_str tau k; - m, n, k - + (m, n, k) (* GELS? - Auxiliary Functions *) @@ -776,14 +760,16 @@ let gelsX_err loc gelsX_min_work ar a m n lwork nrhs br b err = | -3 -> sprintf "nrhs: valid=[0..[ got=%d" nrhs | -5 -> sprintf "dim1(a): valid=[%d..[ got=%d" - (max 1 m + ar - 1) (Array2.dim1 a) + (max 1 m + ar - 1) + (Array2.dim1 a) | -7 -> let min_dim = max 1 (max m n) + br - 1 in sprintf "dim1(b): valid=[%d..[ got=%d" min_dim (Array2.dim1 b) | -12 -> let min_lwork = gelsX_min_work ~m ~n ~nrhs in sprintf "lwork: valid=[%d..[ got=%d" min_lwork lwork - | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) in + | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) + in invalid_arg (sprintf "%s: %s" loc msg) let gelsX_get_s vec_create loc min_dim ofss = function @@ -800,8 +786,7 @@ let gelsX_get_params loc ar ac a m n nrhs br bc b = let n = get_dim2_mat loc a_str a ac n_str n in let nrhs = get_dim2_mat loc b_str b bc nrhs_str nrhs in check_dim1_mat loc b_str b br m_str (max m n); - m, n, nrhs - + (m, n, nrhs) (* ??ev -- auxiliary functions *) @@ -809,13 +794,14 @@ let xxev_get_params loc ar ac a n vectors up = let n = get_n_of_a loc ar ac a n in let jobz = get_job_char vectors in let uplo = get_uplo_char up in - n, jobz, uplo + (n, jobz, uplo) let xxev_get_wx vec_create loc wname ofsw w n = match w with | None -> vec_create (ofsw - 1 + n) - | Some w -> check_vec loc wname w (ofsw - 1 + n); w - + | Some w -> + check_vec loc wname w (ofsw - 1 + n); + w (* geev -- auxiliary functions *) @@ -824,22 +810,23 @@ let geev_get_job_side loc mat_empty mat_create mat_name n r c mat_opt = | None -> if r < 1 then failwith (sprintf "%s: %sr < 1" loc mat_name) else if c < 1 then failwith (sprintf "%s: %sc < 1" loc mat_name) - else r, c, mat_create (n + r - 1) (n + c - 1), job_char_true, true - | Some None -> 1, 1, mat_empty, job_char_false, false + else (r, c, mat_create (n + r - 1) (n + c - 1), job_char_true, true) + | Some None -> (1, 1, mat_empty, job_char_false, false) | Some (Some mat) -> check_dim1_mat loc mat_name mat r n_str n; check_dim2_mat loc mat_name mat c n_str n; - r, c, mat, job_char_true, true + (r, c, mat, job_char_true, true) -let geev_gen_get_params loc mat_empty mat_create ar ac a n - leftr leftc left rightr rightc right = +let geev_gen_get_params loc mat_empty mat_create ar ac a n leftr leftc left + rightr rightc right = let n = get_n_of_a loc ar ac a n in let leftr, leftc, vl, jobvl, lvs = - geev_get_job_side loc mat_empty mat_create "vl" n leftr leftc left in + geev_get_job_side loc mat_empty mat_create "vl" n leftr leftc left + in let rightr, rightc, vr, jobvr, rvs = - geev_get_job_side loc mat_empty mat_create "vr" n rightr rightc right in - n, leftr, leftc, vl, jobvl, rightr, rightc, vr, jobvr, lvs || rvs - + geev_get_job_side loc mat_empty mat_create "vr" n rightr rightc right + in + (n, leftr, leftc, vl, jobvl, rightr, rightc, vr, jobvr, lvs || rvs) (* g?mv -- auxiliary functions *) @@ -848,11 +835,11 @@ let gXmv_get_params loc vec_create m n ofsx incx x ofsy incy y trans = let ofsy, incy = get_vec_geom loc y_str ofsy incy in let lx, ly, trans_char = let trans_char = get_trans_char trans in - if trans = `N then n, m, trans_char else m, n, trans_char in - check_vec loc x_str x (ofsx + (lx - 1) * abs incx); + if trans = `N then (n, m, trans_char) else (m, n, trans_char) + in + check_vec loc x_str x (ofsx + ((lx - 1) * abs incx)); let y = get_vec loc y_str y ofsy incy ly vec_create in - ofsx, incx, ofsy, incy, y, trans_char - + (ofsx, incx, ofsy, incy, y, trans_char) (* symv -- auxiliary functions *) @@ -861,11 +848,10 @@ let symv_get_params loc vec_create ar ac a n ofsx incx x ofsy incy y up = check_dim2_mat loc a_str a ac n_str n; let ofsx, incx = get_vec_geom loc x_str ofsx incx in let ofsy, incy = get_vec_geom loc y_str ofsy incy in - check_vec loc x_str x (ofsx + (n - 1) * abs incx); + check_vec loc x_str x (ofsx + ((n - 1) * abs incx)); let y = get_vec loc y_str y ofsy incy n vec_create in - check_vec loc y_str y (ofsy + (n - 1) * abs incy); - n, ofsx, incx, ofsy, incy, y, get_uplo_char up - + check_vec loc y_str y (ofsy + ((n - 1) * abs incy)); + (n, ofsx, incx, ofsy, incy, y, get_uplo_char up) (* tr?v -- auxiliary functions *) @@ -875,9 +861,8 @@ let trXv_get_params loc ar ac a n ofsx incx x up trans unit_triangular = let trans_char = get_trans_char trans in let diag_char = get_diag_char unit_triangular in let ofsx, incx = get_vec_geom loc x_str ofsx incx in - check_vec loc x_str x (ofsx + (n - 1) * abs incx); - n, ofsx, incx, get_uplo_char up, trans_char, diag_char - + check_vec loc x_str x (ofsx + ((n - 1) * abs incx)); + (n, ofsx, incx, get_uplo_char up, trans_char, diag_char) (* tp?v -- auxiliary functions *) @@ -887,9 +872,8 @@ let tpXv_get_params loc ofsap ap ?n ofsx incx x up trans unit_triangular = let trans_char = get_trans_char trans in let diag_char = get_diag_char unit_triangular in let ofsx, incx = get_vec_geom loc x_str ofsx incx in - check_vec loc x_str x (ofsx + (n - 1) * abs incx); - n, ofsap, ofsx, incx, get_uplo_char up, trans_char, diag_char - + check_vec loc x_str x (ofsx + ((n - 1) * abs incx)); + (n, ofsap, ofsx, incx, get_uplo_char up, trans_char, diag_char) (* gemm -- auxiliary functions *) @@ -898,21 +882,20 @@ let get_c loc mat_create cr cc c m n = get_mat loc c_str mat_create cr cc c m n let get_rows_mat_tr loc mat_str mat mat_r mat_c transp dim_str dim = match transp with | `N -> get_dim1_mat loc mat_str mat mat_r dim_str dim - | _ -> get_dim2_mat loc mat_str mat mat_c dim_str dim + | _ -> get_dim2_mat loc mat_str mat mat_c dim_str dim let get_cols_mat_tr loc mat_str mat mat_r mat_c transp dim_str dim = match transp with | `N -> get_dim2_mat loc mat_str mat mat_c dim_str dim - | _ -> get_dim1_mat loc mat_str mat mat_r dim_str dim + | _ -> get_dim1_mat loc mat_str mat mat_r dim_str dim -let get_inner_dim loc mat1_str mat1 mat1_r mat1_c tr1 - mat2_str mat2 mat2_r mat2_c tr2 dim_str k = +let get_inner_dim loc mat1_str mat1 mat1_r mat1_c tr1 mat2_str mat2 mat2_r + mat2_c tr2 dim_str k = let k1 = get_cols_mat_tr loc mat1_str mat1 mat1_r mat1_c tr1 dim_str k in let k2 = get_rows_mat_tr loc mat2_str mat2 mat2_r mat2_c tr2 dim_str k in if k = None && k1 <> k2 then - failwith ( - sprintf "%s: inner dimensions of matrices do not match (%d,%d)" - loc k1 k2) + failwith + (sprintf "%s: inner dimensions of matrices do not match (%d,%d)" loc k1 k2) else k1 let gemm_get_params loc mat_create ar ac a transa br bc b cr transb cc c m n k = @@ -922,8 +905,7 @@ let gemm_get_params loc mat_create ar ac a transa br bc b cr transb cc c m n k = let transa = get_trans_char transa in let transb = get_trans_char transb in let c = get_c loc mat_create cr cc c m n in - m, n, k, transa, transb, c - + (m, n, k, transa, transb, c) (* symm -- auxiliary functions *) @@ -939,8 +921,7 @@ let symm_get_params loc mat_create ar ac a br bc b cr cc c m n side up = let side_char = get_side_char side in let uplo_char = get_uplo_char up in let c = get_c loc mat_create cr cc c m n in - m, n, side_char, uplo_char, c - + (m, n, side_char, uplo_char, c) (* trmm -- auxiliary functions *) @@ -953,8 +934,7 @@ let trXm_get_params loc ar ac a br bc b m n side up transa diag = let uplo_char = get_uplo_char up in let transa = get_trans_char transa in let diag_char = get_diag_char diag in - m, n, side_char, uplo_char, transa, diag_char - + (m, n, side_char, uplo_char, transa, diag_char) (* syrk -- auxiliary functions *) @@ -964,42 +944,38 @@ let syrk_get_params loc mat_create ar ac a cr cc c n k up trans = let trans_char = get_trans_char trans in let uplo_char = get_uplo_char up in let c = get_c loc mat_create cr cc c n n in - n, k, uplo_char, trans_char, c - + (n, k, uplo_char, trans_char, c) (* syr2k -- auxiliary functions *) let syr2k_get_params loc mat_create ar ac a br bc b cr cc c n k up trans = let n = get_rows_mat_tr loc a_str a ar ac trans n_str n in let k = get_cols_mat_tr loc a_str a ar ac trans k_str k in - begin match trans with + (match trans with | `N -> check_dim1_mat loc b_str b br n_str n; - check_dim2_mat loc b_str b bc k_str k; + check_dim2_mat loc b_str b bc k_str k | _ -> check_dim1_mat loc b_str b br k_str k; - check_dim2_mat loc b_str b bc n_str n; - end; + check_dim2_mat loc b_str b bc n_str n); let trans_char = get_trans_char trans in let uplo_char = get_uplo_char up in let c = get_c loc mat_create cr cc c n n in - n, k, uplo_char, trans_char, c - + (n, k, uplo_char, trans_char, c) (* ?lange -- auxiliary functions *) let xlange_get_params loc m n ar ac a = let m = get_dim1_mat loc a_str a ar m_str m in let n = get_dim2_mat loc a_str a ac n_str n in - m, n - + (m, n) (* ??trs -- auxiliary functions *) let xxtrs_get_params loc ar ac a n br bc b nrhs = let n = get_n_of_a loc ar ac a n in let nrhs = get_nrhs_of_b loc n br bc b nrhs in - n, nrhs + (n, nrhs) let xxtrs_err loc n nrhs a b err = let msg = @@ -1008,10 +984,10 @@ let xxtrs_err loc n nrhs a b err = | -3 -> sprintf "nrhs: valid=[0..[ got=%d" nrhs | -5 -> sprintf "dim1(a): valid=[%d..[ got=%d" (max 1 n) (Array2.dim1 a) | -8 -> sprintf "dim1(b): valid=[%d..[ got=%d" (max 1 n) (Array2.dim1 b) - | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) in + | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) + in invalid_arg (sprintf "%s: %s" loc msg) - (* ??tri -- auxiliary functions *) let xxtri_singular_err loc err = @@ -1022,10 +998,10 @@ let xxtri_err loc n a err = match err with | -2 -> sprintf "n: valid=[0..[ got=%d" n | -4 -> sprintf "dim1(a): valid=[%d..[ got=%d" (max 1 n) (Array2.dim1 a) - | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) in + | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) + in invalid_arg (sprintf "%s: %s" loc msg) - (* ??con -- auxiliary functions *) let xxcon_err loc n a err = @@ -1033,17 +1009,16 @@ let xxcon_err loc n a err = match err with | -2 -> sprintf "n: valid=[0..[ got=%d" n | -4 -> sprintf "dim1(a): valid=%d..[ got=%d" (max 1 n) (Array2.dim1 a) - | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) in + | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) + in invalid_arg (sprintf "%s: %s" loc msg) - (* geXrf -- auxiliary functions *) let geXrf_get_params loc m n ar ac a = let m = get_dim1_mat loc a_str a ar m_str m in let n = get_dim2_mat loc a_str a ac n_str n in - m, n - + (m, n) (* getrf -- auxiliary functions *) @@ -1053,7 +1028,8 @@ let getrf_err loc m n a err = | -1 -> sprintf "n: valid=[0..[ got=%d" n | -2 -> sprintf "m: valid=[0..[ got=%d" m | -4 -> sprintf "dim1(a): valid=[%d..[ got=%d" (max 1 m) (Array2.dim1 a) - | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) in + | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) + in invalid_arg (sprintf "%s: %s" loc msg) let getrf_lu_err loc err = @@ -1066,7 +1042,6 @@ let getrf_get_ipiv loc ipiv m n = check_vec loc ipiv_str ipiv (min m n); ipiv - (* sytrf -- auxiliary functions *) let sytrf_get_ipiv loc ipiv n = @@ -1081,28 +1056,28 @@ let sytrf_err loc n a err = match err with | -2 -> sprintf "n: valid=[0..[ got=%d" n | -4 -> sprintf "dim1(a): valid=[%d..[ got=%d" (max 1 n) (Array2.dim1 a) - | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) in + | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) + in invalid_arg (sprintf "%s: %s" loc msg) let sytrf_fact_err loc err = failwith (sprintf "%s: D(%i,%i)=0 in the factorization" loc err err) - (* potrf -- auxiliary functions *) let potrf_chol_err loc err = - failwith ( - sprintf "%s: leading minor of order %d is not positive definite" loc err) + failwith + (sprintf "%s: leading minor of order %d is not positive definite" loc err) let potrf_err loc n a err = let msg = match err with | -2 -> sprintf "n: valid=[0..[ got=%d" n | -4 -> sprintf "dim1(a): valid=[%d..[ got=%d" (max 1 n) (Array2.dim1 a) - | _ -> raise (InternalError (sprintf "%s: error code %d" loc n)) in + | _ -> raise (InternalError (sprintf "%s: error code %d" loc n)) + in invalid_arg (sprintf "%s: %s" loc msg) - (* potrs -- auxiliary functions *) let potrs_err loc n nrhs a b err = @@ -1112,10 +1087,10 @@ let potrs_err loc n nrhs a b err = | -3 -> sprintf "nrhs: valid=[0..[ got=%d" nrhs | -5 -> sprintf "dim1(a): valid=[%d..[ got=%d" (max 1 n) (Array2.dim1 a) | -7 -> sprintf "dim1(b): valid=[%d..[ got=%d" (max 1 n) (Array2.dim1 b) - | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) in + | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) + in invalid_arg (sprintf "%s: %s" loc msg) - (* trtrs -- auxiliary functions *) let trtrs_err loc n nrhs a b err = @@ -1125,10 +1100,10 @@ let trtrs_err loc n nrhs a b err = | -5 -> sprintf "nrhs: valid=[0..[ got=%d" nrhs | -7 -> sprintf "dim1(a): valid=[%d..[ got=%d" (max 1 n) (Array2.dim1 a) | -9 -> sprintf "dim1(b): valid=[%d..[ got=%d" (max 1 n) (Array2.dim1 b) - | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) in + | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) + in invalid_arg (sprintf "%s: %s" loc msg) - (* tbtrs -- auxiliary functions *) let tbtrs_err loc n nrhs kd ab b err = @@ -1139,10 +1114,10 @@ let tbtrs_err loc n nrhs kd ab b err = | -6 -> sprintf "nrhs: valid=[0..[ got=%d" nrhs | -8 -> sprintf "dim1(ab): valid=[%d..[ got=%d" (max 1 n) (Array2.dim1 ab) | -10 -> sprintf "dim1(b): valid=[%d..[ got=%d" (max 1 n) (Array2.dim1 b) - | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) in + | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) + in invalid_arg (sprintf "%s: %s" loc msg) - (* getri -- auxiliary functions *) let getri_err loc getri_min_lwork n a lwork err = @@ -1153,10 +1128,10 @@ let getri_err loc getri_min_lwork n a lwork err = | -6 -> let min_lwork = getri_min_lwork n in sprintf "lwork: valid=[%d..[ got=%d" min_lwork lwork - | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) in + | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) + in invalid_arg (sprintf "%s: %s" loc msg) - (* trtri -- auxiliary functions *) let trtri_err loc n a err = @@ -1164,10 +1139,10 @@ let trtri_err loc n a err = match err with | -3 -> sprintf "n: valid=[0..[ got=%d" n | -5 -> sprintf "dim1(a): valid=[%d..[ got=%d" (max 1 n) (Array2.dim1 a) - | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) in + | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) + in invalid_arg (sprintf "%s: %s" loc msg) - (* geqrf -- auxiliary functions *) let geqrf_err loc m n a err = @@ -1176,10 +1151,10 @@ let geqrf_err loc m n a err = | -1 -> sprintf "m: valid=[0..[ got=%d" m | -2 -> sprintf "n: valid=[0..[ got=%d" n | -4 -> sprintf "dim1(a): valid=[%d..[ got=%d" (max 1 n) (Array2.dim1 a) - | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) in + | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) + in invalid_arg (sprintf "%s: %s" loc msg) - (* gecon -- auxiliary functions *) let gecon_err loc norm_char n a err = @@ -1188,23 +1163,25 @@ let gecon_err loc norm_char n a err = | -1 -> sprintf "norm: valid=['O', I'] got='%c'" norm_char | -2 -> sprintf "n: valid=[0..[ got=%d" n | -4 -> sprintf "dim1(a): valid=%d..[ got=%d" (max 1 n) (Array2.dim1 a) - | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) in + | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) + in invalid_arg (sprintf "%s: %s" loc msg) - (* gees -- auxiliary functions *) let gees_err loc n err jobvs sort = if err > 0 && err <= n then failwith (sprintf "%s: %d eigenvalue elements did not converge" loc err) else if err = n + 1 then - failwith ( - sprintf "%s: eigenvalues not reordered, too close to separate" loc) + failwith + (sprintf "%s: eigenvalues not reordered, too close to separate" loc) else if err = n + 2 then - failwith ( - sprintf "%s: after reordering, roundoff changed values of some \ - complex eigenvalues so that leading eigenvalues in \ - the Schur form no longer satisfy SELECT" loc) + failwith + (sprintf + "%s: after reordering, roundoff changed values of some complex \ + eigenvalues so that leading eigenvalues in the Schur form no longer \ + satisfy SELECT" + loc) else let msg = match err with @@ -1217,13 +1194,13 @@ let gees_err loc n err jobvs sort = let dummy_select_fun _ = false -let gees_get_params_generic - loc mat_create mat_empty jobvs sort n ar ac a vsr vsc vs = +let gees_get_params_generic loc mat_create mat_empty jobvs sort n ar ac a vsr + vsc vs = let n = get_n_of_a loc ar ac a n in let jobvs, min_ldvs = match jobvs with - | `No_Schur_vectors -> 'N', 1 - | `Compute_Schur_vectors -> 'V', n + | `No_Schur_vectors -> ('N', 1) + | `Compute_Schur_vectors -> ('V', n) in let vs = match vs with @@ -1236,54 +1213,57 @@ let gees_get_params_generic in let sort, select, select_fun = match sort with - | `No_sort -> 'N', 0, dummy_select_fun - | `Select_left_plane -> 'S', 0, dummy_select_fun - | `Select_right_plane -> 'S', 1, dummy_select_fun - | `Select_interior_disk -> 'S', 2, dummy_select_fun - | `Select_exterior_disk -> 'S', 3, dummy_select_fun - | `Select_custom select_fun -> 'S', 4, select_fun + | `No_sort -> ('N', 0, dummy_select_fun) + | `Select_left_plane -> ('S', 0, dummy_select_fun) + | `Select_right_plane -> ('S', 1, dummy_select_fun) + | `Select_interior_disk -> ('S', 2, dummy_select_fun) + | `Select_exterior_disk -> ('S', 3, dummy_select_fun) + | `Select_custom select_fun -> ('S', 4, select_fun) in - jobvs, sort, select, select_fun, n, vs + (jobvs, sort, select, select_fun, n, vs) -let gees_get_params_real - loc vec_create mat_create mat_empty - jobvs sort n ar ac a wr wi vsr vsc vs = +let gees_get_params_real loc vec_create mat_create mat_empty jobvs sort n ar ac + a wr wi vsr vsc vs = let jobvs, sort, select, select_fun, n, vs = - gees_get_params_generic - loc mat_create mat_empty jobvs sort n ar ac a vsr vsc vs + gees_get_params_generic loc mat_create mat_empty jobvs sort n ar ac a vsr + vsc vs in let wr = match wr with | None -> vec_create n - | Some wr -> check_vec loc wr_str wr n; wr + | Some wr -> + check_vec loc wr_str wr n; + wr in let wi = match wi with | None -> vec_create n - | Some wi -> check_vec loc wi_str wi n; wi + | Some wi -> + check_vec loc wi_str wi n; + wi in - jobvs, sort, select, select_fun, n, vs, wr, wi + (jobvs, sort, select, select_fun, n, vs, wr, wi) -let gees_get_params_complex - loc vec_create mat_create mat_empty jobvs sort n ar ac a w vsr vsc vs = +let gees_get_params_complex loc vec_create mat_create mat_empty jobvs sort n ar + ac a w vsr vsc vs = let jobvs, sort, select, select_fun, n, vs = - gees_get_params_generic - loc mat_create mat_empty jobvs sort n ar ac a vsr vsc vs + gees_get_params_generic loc mat_create mat_empty jobvs sort n ar ac a vsr + vsc vs in let w = match w with | None -> vec_create n - | Some w -> check_vec loc w_str w n; w + | Some w -> + check_vec loc w_str w n; + w in - jobvs, sort, select, select_fun, n, vs, w - + (jobvs, sort, select, select_fun, n, vs, w) (* gesvd -- auxiliary functions *) let gesvd_err loc jobu jobvt m n a u vt lwork err = if err > 0 then - failwith - (sprintf "%s: %d off-diagonal elements did not converge" loc err) + failwith (sprintf "%s: %d off-diagonal elements did not converge" loc err) else let msg = match err with @@ -1296,57 +1276,55 @@ let gesvd_err loc jobu jobvt m n a u vt lwork err = (Array2.dim1 u) | -11 -> sprintf "dim1(vt): valid=[%d..[ got=%d" - ( - match jobvt with - | 'A' -> max 1 n - | 'S' -> max 1 (min m n) - | _ -> 1 - ) + (match jobvt with + | 'A' -> max 1 n + | 'S' -> max 1 (min m n) + | _ -> 1) (Array2.dim1 vt) | -13 -> sprintf "lwork: valid=[%d..[ got=%d" 1 lwork - | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) in + | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) + in invalid_arg (sprintf "%s: %s" loc msg) -let gesvd_get_params - loc vec_create mat_create jobu jobvt m n ar ac a s ur uc u vtr vtc vt = +let gesvd_get_params loc vec_create mat_create jobu jobvt m n ar ac a s ur uc u + vtr vtc vt = let m = get_dim1_mat loc a_str a ar m_str m in let n = get_dim2_mat loc a_str a ac n_str n in let s = get_vec loc s_str s 1 1 (min m n) vec_create in let um, un = - match jobu with - | `A -> m, m - | `S -> m, min m n - | `O | `N -> 1, 1 in (* LDU >= 1 even when U not referenced *) + match jobu with `A -> (m, m) | `S -> (m, min m n) | `O | `N -> (1, 1) + in + (* LDU >= 1 even when U not referenced *) let u = match u with | Some u -> check_dim1_mat loc u_str u ur um_str um; check_dim2_mat loc u_str u uc un_str un; u - | None -> mat_create um un in + | None -> mat_create um un + in let vm, vn = - match jobvt with - | `A -> n, n - | `S -> min m n, n - | `O | `N -> 1, 1 in (* LDVT >= 1 even when VT not referenced *) + match jobvt with `A -> (n, n) | `S -> (min m n, n) | `O | `N -> (1, 1) + in + (* LDVT >= 1 even when VT not referenced *) let vt = match vt with | Some vt -> check_dim1_mat loc vt_str vt vtr vm_str vm; check_dim2_mat loc vt_str vt vtc vn_str vn; vt - | None -> mat_create vm vn in + | None -> mat_create vm vn + in let jobu_c = get_s_d_job_char jobu in let jobvt_c = get_s_d_job_char jobvt in - jobu_c, jobvt_c, m, n, s, u, vt - + (jobu_c, jobvt_c, m, n, s, u, vt) (* gesdd -- auxiliary functions *) let gesdd_err loc jobz m n a u vt lwork err = if err > 0 then - failwith ( - sprintf "%s: %d DBDSDC did not converge, updating process failed" loc err) + failwith + (sprintf "%s: %d DBDSDC did not converge, updating process failed" loc err) else let msg = match err with @@ -1355,53 +1333,52 @@ let gesdd_err loc jobz m n a u vt lwork err = | -5 -> sprintf "dim1(a): valid=[%d..[ got=%d" (max 1 m) (Array2.dim1 a) | -8 -> sprintf "dim1(u): valid=[%d..[ got=%d" - ( - if jobz = 'A' || jobz = 'S' || (jobz = 'O' && m < n) - then max 1 m - else 1 - ) + (if jobz = 'A' || jobz = 'S' || (jobz = 'O' && m < n) then max 1 m + else 1) (Array2.dim1 u) | -10 -> sprintf "dim1(vt): valid=[%d..[ got=%d" - ( - if jobz = 'A' || (jobz = 'O' && m >= n) then max 1 n - else if jobz = 'S' then max 1 (min m n) - else 1 - ) + (if jobz = 'A' || (jobz = 'O' && m >= n) then max 1 n + else if jobz = 'S' then max 1 (min m n) + else 1) (Array2.dim1 vt) | -12 -> sprintf "lwork: valid=[%d..[ got=%d" 1 lwork - | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) in + | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) + in invalid_arg (sprintf "%s: %s" loc msg) -let gesdd_get_params - loc vec_create mat_create jobz m n ar ac a s ur uc u vtr vtc vt = +let gesdd_get_params loc vec_create mat_create jobz m n ar ac a s ur uc u vtr + vtc vt = let m = get_dim1_mat loc a_str a ar m_str m in let n = get_dim2_mat loc a_str a ac n_str n in let min_m_n = min m n in let s = get_vec loc s_str s 1 1 min_m_n vec_create in let um, un, vm, vn = match jobz with - | `A -> m, m, n, n - | `S -> m, min_m_n, min_m_n, n - | `O -> if m >= n then 1, 1, n, n else m, m, m, n - | `N -> 1, 1, 1, 1 in (* LDU >= 1 even when U not referenced *) + | `A -> (m, m, n, n) + | `S -> (m, min_m_n, min_m_n, n) + | `O -> if m >= n then (1, 1, n, n) else (m, m, m, n) + | `N -> (1, 1, 1, 1) + in + (* LDU >= 1 even when U not referenced *) let u = match u with | Some u -> check_dim1_mat loc u_str u ur um_str um; check_dim2_mat loc u_str u uc un_str un; u - | None -> mat_create um un in + | None -> mat_create um un + in let vt = match vt with | Some vt -> check_dim1_mat loc vt_str vt vtr vm_str vm; check_dim2_mat loc vt_str vt vtc vn_str vn; vt - | None -> mat_create vm vn in + | None -> mat_create vm vn + in let jobz_c = get_s_d_job_char jobz in - jobz_c, m, n, s, u, vt - + (jobz_c, m, n, s, u, vt) (* ??sv -- auxiliary functions *) @@ -1411,7 +1388,8 @@ let xxsv_err loc n nrhs b err = | -1 -> sprintf "n: valid=[0..[ got=%d" n | -2 -> sprintf "nrhs: valid=[0..[ got=%d" nrhs | -7 -> sprintf "dim1(b): valid=[%d..[ got=%d" (max 1 n) (Array2.dim1 b) - | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) in + | n -> raise (InternalError (sprintf "%s: error code %d" loc n)) + in invalid_arg (sprintf "%s: %s" loc msg) let xxsv_lu_err loc err = @@ -1419,19 +1397,20 @@ let xxsv_lu_err loc err = let xxsv_pos_err loc err = let msg = - sprintf - "%s: the leading minor of order %i is not positive definite" loc err in + sprintf "%s: the leading minor of order %i is not positive definite" loc err + in failwith msg let xxsv_ind_err loc err = let msg = - sprintf - "%s: D(%i,%i)=0 in the diagonal pivoting factorization" loc err err in + sprintf "%s: D(%i,%i)=0 in the diagonal pivoting factorization" loc err err + in failwith msg let xxsv_a_err loc a n = let msg = - sprintf "%s: dim1(a): valid=[%d..[ got=%d" loc (max 1 n) (Array2.dim1 a) in + sprintf "%s: dim1(a): valid=[%d..[ got=%d" loc (max 1 n) (Array2.dim1 a) + in invalid_arg msg let xxsv_work_err loc lwork = @@ -1447,4 +1426,4 @@ let xxsv_get_ipiv loc ipiv n = let xxsv_get_params loc ar ac a n br bc b nrhs = let n = get_n_of_a loc ar ac a n in let nrhs = get_nrhs_of_b loc n br bc b nrhs in - n, nrhs + (n, nrhs) diff --git a/src/utils_c.c b/src/utils_c.c index d6c2c12..ef2e592 100644 --- a/src/utils_c.c +++ b/src/utils_c.c @@ -1,10 +1,8 @@ /* File: utils_c.c - Copyright (C) 2005- + Copyright © 2005- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public @@ -18,36 +16,33 @@ You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ // Enable POSIX.1-2001 for use of `struct timespec' and `nanosleep' #define _POSIX_C_SOURCE 200112L -#include #include +#include #include "utils_c.h" #ifdef WIN32 - #include +#include #else - #include +#include #endif // WIN32 /* Store two doubles in an OCaml-block (complex number) */ -value copy_two_doubles(double d0, double d1) -{ +value copy_two_doubles(double d0, double d1) { value res = caml_alloc_small(2 * Double_wosize, Double_array_tag); Store_double_field(res, 0, d0); Store_double_field(res, 1, d1); return res; } - /* Portable sleep function */ -int portable_sleep(int milliseconds) -{ +int portable_sleep(int milliseconds) { #ifdef WIN32 Sleep(milliseconds); return 0; @@ -56,17 +51,16 @@ int portable_sleep(int milliseconds) tim.tv_sec = 0; tim.tv_nsec = milliseconds * 1000000; - return nanosleep(&tim , &tim2); + return nanosleep(&tim, &tim2); #endif // WIN32 } - /* exp10 */ #ifdef EXTERNAL_EXP10 #ifndef M_LN10 -#define M_LN10 2.30258509299404568402 /* log_e 10 */ +#define M_LN10 2.30258509299404568402 /* log_e 10 */ #endif float exp10f(float arg) { return expf(M_LN10 * arg); } diff --git a/src/utils_c.h b/src/utils_c.h index d83e372..aae4d40 100644 --- a/src/utils_c.h +++ b/src/utils_c.h @@ -1,10 +1,8 @@ /* File: utils_c.h - Copyright (C) 2005- + Copyright © 2005- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public @@ -18,56 +16,56 @@ You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef UTILS_C #define UTILS_C +#include #include #include -#include /* Compiler pragmas and inlining */ #if defined(__GNUC__) && __GNUC__ >= 3 -# ifndef __pure -# define __pure __attribute__ ((pure)) -# endif -# ifndef __const -# define __const __attribute__ ((const)) -# endif -# ifndef __malloc -# define __malloc __attribute__ ((malloc)) -# endif -# ifndef __unused -# define __unused __attribute__ ((unused)) -# endif -# ifndef __likely -# define likely(x) __builtin_expect (!!(x), 1) -# endif -# ifndef __unlikely -# define unlikely(x) __builtin_expect (!!(x), 0) -# endif +#ifndef __pure +#define __pure __attribute__((pure)) +#endif +#ifndef __const +#define __const __attribute__((const)) +#endif +#ifndef __malloc +#define __malloc __attribute__((malloc)) +#endif +#ifndef __unused +#define __unused __attribute__((unused)) +#endif +#ifndef __likely +#define likely(x) __builtin_expect(!!(x), 1) +#endif +#ifndef __unlikely +#define unlikely(x) __builtin_expect(!!(x), 0) +#endif #else -# ifndef __pure -# define __pure -# endif -# ifndef __const -# define __const -# endif -# ifndef __malloc -# define __malloc -# endif -# ifndef __unused -# define __unused -# endif -# ifndef __likely -# define likely(x) (x) -# endif -# ifndef __unlikely -# define unlikely(x) (x) -# endif +#ifndef __pure +#define __pure +#endif +#ifndef __const +#define __const +#endif +#ifndef __malloc +#define __malloc +#endif +#ifndef __unused +#define __unused +#endif +#ifndef __likely +#define likely(x) (x) +#endif +#ifndef __unlikely +#define unlikely(x) (x) +#endif #endif /* Create an OCaml record of two floats */ @@ -79,9 +77,8 @@ int portable_sleep(int milliseconds); typedef enum { UPPER, LOWER } pentagon_kind; -static inline pentagon_kind get_pentagon_kind(value vPKIND) -{ - return (pentagon_kind) Int_val(vPKIND); +static inline pentagon_kind get_pentagon_kind(value vPKIND) { + return (pentagon_kind)Int_val(vPKIND); } extern double exp10(double arg); diff --git a/src/vec_CZ.h b/src/vec_CZ.h index a392b56..d0c6aef 100644 --- a/src/vec_CZ.h +++ b/src/vec_CZ.h @@ -1,10 +1,8 @@ /* File: vec_CZ.h - Copyright (C) 2003- + Copyright © 2003- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public @@ -18,7 +16,7 @@ You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include @@ -26,23 +24,18 @@ #define LACAML_COMPLEX #include "lacaml_macros.h" -static COMPLEX LACAML_COMPLEX_INF = { INFINITY, INFINITY }; -static COMPLEX LACAML_COMPLEX_NEG_INF = { -INFINITY, -INFINITY }; +static COMPLEX LACAML_COMPLEX_INF = {INFINITY, INFINITY}; +static COMPLEX LACAML_COMPLEX_NEG_INF = {-INFINITY, -INFINITY}; -CAMLprim value LFUN(linspace_stub)(value vY, value va, value vb, intnat vN) -{ +CAMLprim value LFUN(linspace_stub)(value vY, value va, value vb, intnat vN) { CAMLparam1(vY); integer i, GET_INT(N); - REAL ar = Double_field(va, 0), - ai = Double_field(va, 1), - N1 = N - 1., + REAL ar = Double_field(va, 0), ai = Double_field(va, 1), N1 = N - 1., hr = (Double_field(vb, 0) - ar) / N1, - hi = (Double_field(vb, 1) - ai) / N1, - xr = ar, - xi = ai; + hi = (Double_field(vb, 1) - ai) / N1, xr = ar, xi = ai; VEC_PARAMS1(Y); - caml_enter_blocking_section(); /* Allow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ for (i = 1; i <= N; i++) { Y_data->r = xr; @@ -52,22 +45,15 @@ CAMLprim value LFUN(linspace_stub)(value vY, value va, value vb, intnat vN) xi = ai + i * hi; } - caml_leave_blocking_section(); /* Disallow other threads */ + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(Val_unit); } -CAMLprim value LFUN(linspace_stub_bc)(value vY, value va, value vb, value vN) -{ - return - LFUN(linspace_stub)( - vY, - va, - vb, - Int_val(vN)); +CAMLprim value LFUN(linspace_stub_bc)(value vY, value va, value vb, value vN) { + return LFUN(linspace_stub)(vY, va, vb, Int_val(vN)); } - #ifndef LACAML_DOUBLE extern float expf(float); extern float exp10f(float); @@ -84,22 +70,17 @@ extern double exp2(double); #define myexp2 exp2 #endif -CAMLprim value LFUN(logspace_stub)(value vY, value va, value vb, - double vbase, intnat vN) -{ +CAMLprim value LFUN(logspace_stub)(value vY, value va, value vb, double vbase, + intnat vN) { CAMLparam1(vY); integer i, GET_INT(N); - REAL ar = Double_field(va, 0), - ai = Double_field(va, 1), - N1 = N - 1., + REAL ar = Double_field(va, 0), ai = Double_field(va, 1), N1 = N - 1., hr = (Double_field(vb, 0) - ar) / N1, - hi = (Double_field(vb, 1) - ai) / N1, - xr = ar, - xi = ai; + hi = (Double_field(vb, 1) - ai) / N1, xr = ar, xi = ai; double GET_DOUBLE(base); VEC_PARAMS1(Y); - caml_enter_blocking_section(); /* Allow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ if (base == 2.0) for (i = 1; i <= N; i++) { @@ -136,35 +117,24 @@ CAMLprim value LFUN(logspace_stub)(value vY, value va, value vb, } } - caml_leave_blocking_section(); /* Disallow other threads */ + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(Val_unit); } -CAMLprim value LFUN(logspace_stub_bc)( - value vY, value va, value vb, value vbase, value vN) -{ - return - LFUN(logspace_stub)( - vY, - va, - vb, - Double_val(vbase), - Int_val(vN)); +CAMLprim value LFUN(logspace_stub_bc)(value vY, value va, value vb, value vbase, + value vN) { + return LFUN(logspace_stub)(vY, va, vb, Double_val(vbase), Int_val(vN)); } - extern real scnrm2_(integer *N, complex *X, integer *INCX); extern doublereal dznrm2_(integer *N, doublecomplex *X, integer *INCX); -extern COMPLEX DOTC( - integer *N, - COMPLEX *X, integer *INCX, - COMPLEX *Y, integer *INCY); +extern COMPLEX DOTC(integer *N, COMPLEX *X, integer *INCX, COMPLEX *Y, + integer *INCY); -CAMLprim value LFUN(sqr_nrm2_stub)( - value vSTABLE, intnat vN, intnat vOFSX, intnat vINCX, value vX) -{ +CAMLprim value LFUN(sqr_nrm2_stub)(value vSTABLE, intnat vN, intnat vOFSX, + intnat vINCX, value vX) { CAMLparam1(vX); integer GET_INT(N), GET_INT(INCX); @@ -173,153 +143,140 @@ CAMLprim value LFUN(sqr_nrm2_stub)( VEC_PARAMS(X); int stable = Bool_val(vSTABLE); - // - caml_enter_blocking_section(); /* Allow other threads */ + // + caml_enter_blocking_section(); /* Allow other threads */ if (stable) { #ifndef LACAML_DOUBLE - res = scnrm2_(&N, X_data, &INCX); + res = scnrm2_(&N, X_data, &INCX); #else - res = dznrm2_(&N, X_data, &INCX); + res = dznrm2_(&N, X_data, &INCX); #endif - res *= res; + res *= res; } else { COMPLEX cres = DOTC(&N, X_data, &INCX, X_data, &INCX); res = cres.r; } - caml_leave_blocking_section(); /* Disallow other threads */ + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(caml_copy_double(res)); } -CAMLprim value LFUN(sqr_nrm2_stub_bc)( - value vSTABLE, value vN, value vOFSX, value vINCX, value vX) -{ - return - caml_copy_double( - LFUN(sqr_nrm2_stub)( - vSTABLE, - Int_val(vN), - Int_val(vOFSX), - Int_val(vINCX), - vX)); +CAMLprim value LFUN(sqr_nrm2_stub_bc)(value vSTABLE, value vN, value vOFSX, + value vINCX, value vX) { + return caml_copy_double(LFUN(sqr_nrm2_stub)( + vSTABLE, Int_val(vN), Int_val(vOFSX), Int_val(vINCX), vX)); } #define NAME LFUN(max_stub) #define BC_NAME LFUN(max_stub_bc) #define INIT LACAML_COMPLEX_NEG_INF -#define DECLARE_EXTRA \ - REAL acc_big = 0., acc_nrm = 1., x_big, x_nrm, q, r, i -#define FUNC(acc, x) \ - r = x.r; \ - i = x.i; \ - if (r < 0.) r = -r; \ - if (i < 0.) i = -i; \ - if (r >= i) { \ - if (r == 0.) continue; \ - x_big = r; \ - q = i / r; \ - x_nrm = 1. + q * q; \ - } \ - else /* r < i or NaN */ { \ - if (i == 0.) continue; \ - x_big = i; \ - q = r / i; \ - x_nrm = 1. + q * q; \ - } \ - q = x_big / acc_big; \ - if (q * q * x_nrm > acc_nrm) { \ - acc = x; \ - acc_big = x_big; \ - acc_nrm = x_nrm; \ +#define DECLARE_EXTRA REAL acc_big = 0., acc_nrm = 1., x_big, x_nrm, q, r, i +#define FUNC(acc, x) \ + r = x.r; \ + i = x.i; \ + if (r < 0.) \ + r = -r; \ + if (i < 0.) \ + i = -i; \ + if (r >= i) { \ + if (r == 0.) \ + continue; \ + x_big = r; \ + q = i / r; \ + x_nrm = 1. + q * q; \ + } else /* r < i or NaN */ { \ + if (i == 0.) \ + continue; \ + x_big = i; \ + q = r / i; \ + x_nrm = 1. + q * q; \ + } \ + q = x_big / acc_big; \ + if (q * q * x_nrm > acc_nrm) { \ + acc = x; \ + acc_big = x_big; \ + acc_nrm = x_nrm; \ } #include "fold_col.h" #define NAME LFUN(min_stub) #define BC_NAME LFUN(min_stub_bc) #define INIT LACAML_COMPLEX_INF -#define DECLARE_EXTRA \ +#define DECLARE_EXTRA \ REAL acc_big = INFINITY, acc_nrm = 1., x_big, x_nrm, q, r, i -#define FUNC(acc, x) \ - r = x.r; \ - i = x.i; \ - if (r < 0.) r = -r; \ - if (i < 0.) i = -i; \ - if (r >= i) { \ - if (r == 0.) continue; \ - x_big = r; \ - q = i / r; \ - x_nrm = 1. + q * q; \ - } \ - else /* r < i or NaN */ { \ - if (i == 0.) continue; \ - x_big = i; \ - q = r / i; \ - x_nrm = 1. + q * q; \ - } \ - q = x_big / acc_big; \ - if (q * q * x_nrm < acc_nrm) { \ - acc = x; \ - acc_big = x_big; \ - acc_nrm = x_nrm; \ +#define FUNC(acc, x) \ + r = x.r; \ + i = x.i; \ + if (r < 0.) \ + r = -r; \ + if (i < 0.) \ + i = -i; \ + if (r >= i) { \ + if (r == 0.) \ + continue; \ + x_big = r; \ + q = i / r; \ + x_nrm = 1. + q * q; \ + } else /* r < i or NaN */ { \ + if (i == 0.) \ + continue; \ + x_big = i; \ + q = r / i; \ + x_nrm = 1. + q * q; \ + } \ + q = x_big / acc_big; \ + if (q * q * x_nrm < acc_nrm) { \ + acc = x; \ + acc_big = x_big; \ + acc_nrm = x_nrm; \ } #include "fold_col.h" #define NAME LFUN(sum_vec_stub) #define BC_NAME LFUN(sum_vec_stub_bc) -#define INIT { 0.0, 0.0 } -#define FUNC(acc, x) acc.r += x.r; acc.i += x.i +#define INIT {0.0, 0.0} +#define FUNC(acc, x) \ + acc.r += x.r; \ + acc.i += x.i #include "fold_col.h" #define NAME LFUN(prod_stub) #define BC_NAME LFUN(prod_stub_bc) -#define INIT { 1.0, 1.0 } -#define FUNC(acc, x) \ - acc.r = acc.r*x.r - acc.i*x.i; \ - acc.i = acc.r*x.i + acc.i*x.r +#define INIT {1.0, 1.0} +#define FUNC(acc, x) \ + acc.r = acc.r * x.r - acc.i * x.i; \ + acc.i = acc.r * x.i + acc.i * x.r #include "fold_col.h" -extern value LFUN(dotu_stub)( - value vN, - value vOFSY, value vINCY, value vY, - value vOFSX, value vINCX, value vX); +extern value LFUN(dotu_stub)(value vN, value vOFSY, value vINCY, value vY, + value vOFSX, value vINCX, value vX); -CAMLprim value LFUN(ssqr_zero_stub)( - intnat vN, intnat vOFSX, intnat vINCX, value vX) -{ +CAMLprim value LFUN(ssqr_zero_stub)(intnat vN, intnat vOFSX, intnat vINCX, + value vX) { return LFUN(dotu_stub(vN, vOFSX, vINCX, vX, vOFSX, vINCX, vX)); } -CAMLprim value LFUN(ssqr_zero_stub_bc)( - value vN, value vOFSX, value vINCX, value vX) -{ - return - LFUN(ssqr_zero_stub)( - Int_val(vN), - Int_val(vOFSX), - Int_val(vINCX), - vX); +CAMLprim value LFUN(ssqr_zero_stub_bc)(value vN, value vOFSX, value vINCX, + value vX) { + return LFUN(ssqr_zero_stub)(Int_val(vN), Int_val(vOFSX), Int_val(vINCX), vX); } -CAMLprim value LFUN(ssqr_stub)( - intnat vN, - value vC, - intnat vOFSX, intnat vINCX, value vX) -{ +CAMLprim value LFUN(ssqr_stub)(intnat vN, value vC, intnat vOFSX, intnat vINCX, + value vX) { CAMLparam1(vX); - integer GET_INT(N), - GET_INT(INCX); + integer GET_INT(N), GET_INT(INCX); VEC_PARAMS(X); COMPLEX *start, *last; - COMPLEX acc = { 0.0, 0.0 }; + COMPLEX acc = {0.0, 0.0}; REAL cr = Double_field(vC, 0); REAL ci = Double_field(vC, 1); REAL diffr; REAL diffi; - caml_enter_blocking_section(); /* Allow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ if (INCX == 1) /* NOTE: may improve SIMD optimization */ @@ -333,10 +290,9 @@ CAMLprim value LFUN(ssqr_stub)( else { if (INCX > 0) { start = X_data; - last = start + N*INCX; - } - else { - start = X_data - (N - 1)*INCX; + last = start + N * INCX; + } else { + start = X_data - (N - 1) * INCX; last = X_data + INCX; }; @@ -349,104 +305,97 @@ CAMLprim value LFUN(ssqr_stub)( } } - caml_leave_blocking_section(); /* Disallow other threads */ + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(copy_two_doubles(acc.r, acc.i)); } -CAMLprim value LFUN(ssqr_stub_bc)( - value vN, value vC, value vOFSX, value vINCX, value vX) -{ - return - LFUN(ssqr_stub)( - Int_val(vN), - vC, - Int_val(vOFSX), - Int_val(vINCX), - vX); +CAMLprim value LFUN(ssqr_stub_bc)(value vN, value vC, value vOFSX, value vINCX, + value vX) { + return LFUN(ssqr_stub)(Int_val(vN), vC, Int_val(vOFSX), Int_val(vINCX), vX); } #define NAME LFUN(neg_stub) #define BC_NAME LFUN(neg_stub_bc) -#define FUNC(dst, x) \ - dst->r = - x.r; \ - dst->i = - x.i +#define FUNC(dst, x) \ + dst->r = -x.r; \ + dst->i = -x.i #include "vec_map.h" #define NAME LFUN(reci_stub) #define BC_NAME LFUN(reci_stub_bc) -#define FUNC(dst, x) \ - if (abs(x.r) >= abs(x.i)) { \ - REAL r = x.i / x.r; \ - REAL d = x.r + r * x.i; \ - dst->r = 1 / d; \ - dst->i = -r/d; \ - } else { \ - REAL r = x.r / x.i; \ - REAL d = x.i + r * x.r; \ - dst->r = r / d; \ - dst->i = -1 / d; \ +#define FUNC(dst, x) \ + if (abs(x.r) >= abs(x.i)) { \ + REAL r = x.i / x.r; \ + REAL d = x.r + r * x.i; \ + dst->r = 1 / d; \ + dst->i = -r / d; \ + } else { \ + REAL r = x.r / x.i; \ + REAL d = x.i + r * x.r; \ + dst->r = r / d; \ + dst->i = -1 / d; \ } #include "vec_map.h" #define NAME LFUN(add_stub) #define BC_NAME LFUN(add_stub_bc) -#define FUNC(dst, x, y) \ - dst->r = x.r + y.r; \ +#define FUNC(dst, x, y) \ + dst->r = x.r + y.r; \ dst->i = x.i + y.i #include "vec_combine.h" #define NAME LFUN(sub_stub) #define BC_NAME LFUN(sub_stub_bc) -#define FUNC(dst, x, y) \ - dst->r = x.r - y.r; \ +#define FUNC(dst, x, y) \ + dst->r = x.r - y.r; \ dst->i = x.i - y.i #include "vec_combine.h" #define NAME LFUN(mul_stub) #define BC_NAME LFUN(mul_stub_bc) -#define FUNC(dst, x, y) \ - dst->r = x.r*y.r - x.i*y.i; \ - dst->i = x.r*y.i + x.i*y.r +#define FUNC(dst, x, y) \ + dst->r = x.r * y.r - x.i * y.i; \ + dst->i = x.r * y.i + x.i * y.r #include "vec_combine.h" #define NAME LFUN(div_stub) #define BC_NAME LFUN(div_stub_bc) -#define FUNC(dst, x, y) \ - REAL xr = x.r, xi = x.i, yr = y.r, yi = y.i; \ - if (FABS(yr) >= FABS(yi)) {\ - REAL r = yi / yr, d = yr + r*yi; \ - dst->r = (xr + r*xi)/d; \ - dst->i = (xi - r*xr)/d; \ - } else {\ - REAL r = yr / yi, d = yi + r*yr; \ - dst->r = (r*xr + xi)/d; \ - dst->i = (r*xi - xr)/d; \ +#define FUNC(dst, x, y) \ + REAL xr = x.r, xi = x.i, yr = y.r, yi = y.i; \ + if (FABS(yr) >= FABS(yi)) { \ + REAL r = yi / yr, d = yr + r * yi; \ + dst->r = (xr + r * xi) / d; \ + dst->i = (xi - r * xr) / d; \ + } else { \ + REAL r = yr / yi, d = yi + r * yr; \ + dst->r = (r * xr + xi) / d; \ + dst->i = (r * xi - xr) / d; \ } #include "vec_combine.h" #define NAME LFUN(zpxy_stub) #define BC_NAME LFUN(zpxy_stub_bc) -#define FUNC(dst, x, y) \ - dst->r += x.r*y.r - x.i*y.i; \ - dst->i += x.r*y.i + x.i*y.r +#define FUNC(dst, x, y) \ + dst->r += x.r * y.r - x.i * y.i; \ + dst->i += x.r * y.i + x.i * y.r #include "vec_combine.h" #define NAME LFUN(zmxy_stub) #define BC_NAME LFUN(zmxy_stub_bc) -#define FUNC(dst, x, y) \ - dst->r -= x.r*y.r - x.i*y.i; \ - dst->i -= x.r*y.i + x.i*y.r +#define FUNC(dst, x, y) \ + dst->r -= x.r * y.r - x.i * y.i; \ + dst->i -= x.r * y.i + x.i * y.r #include "vec_combine.h" #define NAME LFUN(ssqr_diff_stub) #define BC_NAME LFUN(ssqr_diff_stub_bc) -#define INIT { 0.0, 0.0 } -#define FUNC(acc, x, y) \ - x.r -= y.r; \ - x.i -= y.i; \ - acc.r += (x.r - x.i) * (x.r + x.i); \ - acc.i += 2*x.r*x.i +#define INIT {0.0, 0.0} +#define FUNC(acc, x, y) \ + x.r -= y.r; \ + x.i -= y.i; \ + acc.r += (x.r - x.i) * (x.r + x.i); \ + acc.i += 2 * x.r * x.i #include "fold2_col.h" /* Since executing the (small) callback may dominate the running time, @@ -456,14 +405,14 @@ CAMLprim value LFUN(ssqr_stub_bc)( /* NaN are put last (greater than anything) to ensure the algo termination. If both a and b are NaN, return false (consider NaN equal for this). */ #define ANY_NAN(x) (isnan(x.r) || isnan(x.i)) -#define NAN_LAST(a, b, SORT) \ +#define NAN_LAST(a, b, SORT) \ (ANY_NAN(b) ? (!ANY_NAN(a)) : (!ANY_NAN(a) && (SORT))) #define NAME LFUN(sort_incr) #define BC_NAME LFUN(sort_incr_bc) #define NAME_PERM LFUN(sort_incr_perm) #define BC_NAME_PERM LFUN(sort_incr_perm_bc) -#define OCAML_SORT_LT(a, b) \ +#define OCAML_SORT_LT(a, b) \ NAN_LAST(a, b, a.r < b.r || (a.r == b.r && a.i < b.i)) #include "vec_sort.h" @@ -471,7 +420,7 @@ CAMLprim value LFUN(ssqr_stub_bc)( #define BC_NAME LFUN(sort_decr_bc) #define NAME_PERM LFUN(sort_decr_perm) #define BC_NAME_PERM LFUN(sort_decr_perm_bc) -#define OCAML_SORT_LT(a, b) \ +#define OCAML_SORT_LT(a, b) \ NAN_LAST(a, b, a.r > b.r || (a.r == b.r && a.i > b.i)) #include "vec_sort.h" @@ -479,10 +428,10 @@ CAMLprim value LFUN(ssqr_stub_bc)( #define BC_NAME LFUN(sort_bc) #define NAME_PERM LFUN(sort_perm) #define BC_NAME_PERM LFUN(sort_perm_bc) -#define OCAML_SORT_LT(a, b) \ - NAN_LAST(a, b, (va = copy_two_doubles(a.r, a.i), \ - vb = copy_two_doubles(b.r, b.i), \ - Int_val(caml_callback2(vCMP, va, vb)) < 0)) +#define OCAML_SORT_LT(a, b) \ + NAN_LAST(a, b, \ + (va = copy_two_doubles(a.r, a.i), vb = copy_two_doubles(b.r, b.i), \ + Int_val(caml_callback2(vCMP, va, vb)) < 0)) #define OCAML_SORT_CALLBACK #include "vec_sort.h" #undef OCAML_SORT_CALLBACK diff --git a/src/vec_CZ.ml b/src/vec_CZ.ml index 325d298..b32c69e 100644 --- a/src/vec_CZ.ml +++ b/src/vec_CZ.ml @@ -1,43 +1,34 @@ (* File: vec_CZ.ml - Copyright (C) 2001- + Copyright © 2001- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umh.ac.be/an/ + Christophe Troestler - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) open Complex open Vec4_CPREC -let random - ?rnd_state - ?(re_from = -1.) ?(re_range = 2.) - ?(im_from = -1.) ?(im_range = 2.) - n = +let random ?rnd_state ?(re_from = -1.) ?(re_range = 2.) ?(im_from = -1.) + ?(im_range = 2.) n = let vec = create n in let state = - match rnd_state with - | None -> Random.get_state () - | Some state -> state in + match rnd_state with None -> Random.get_state () | Some state -> state + in for row = 1 to n do vec.{row} <- { diff --git a/src/vec_CZ.mli b/src/vec_CZ.mli index e253b14..a5cac7b 100644 --- a/src/vec_CZ.mli +++ b/src/vec_CZ.mli @@ -1,29 +1,24 @@ (* File: vec_CZ.mli - Copyright (C) 2001- + Copyright © 2001- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umh.ac.be/an/ + Christophe Troestler - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) (** {5 Vector operations} *) @@ -32,16 +27,19 @@ open Complexxx (** {6 Creation of vectors} *) val random : - ?rnd_state : Random.State.t -> - ?re_from : float -> ?re_range : float -> - ?im_from : float -> ?im_range : float -> - int - -> vec + ?rnd_state:Random.State.t -> + ?re_from:float -> + ?re_range:float -> + ?im_from:float -> + ?im_range:float -> + int -> + vec (** [random ?rnd_state ?re_from ?re_range ?im_from ?im_range n] - @return a vector of size [n] initialized with random elements sampled - uniformly from [re_range] and [im_range] starting at [re_from] and - [im_from] for real and imaginary numbers respectively. A random state - [rnd_state] can be passed. + @return + a vector of size [n] initialized with random elements sampled uniformly + from [re_range] and [im_range] starting at [re_from] and [im_from] for + real and imaginary numbers respectively. A random state [rnd_state] can be + passed. @param rnd_state default = Random.get_state () @param re_from default = -1.0 diff --git a/src/vec_SD.h b/src/vec_SD.h index 2799096..8b50fa4 100644 --- a/src/vec_SD.h +++ b/src/vec_SD.h @@ -1,14 +1,10 @@ /* File: vec_SD.h - Copyright (C) 2001- + Copyright © 2001- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umh.ac.be/an/ + Christophe Troestler This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public @@ -22,22 +18,21 @@ You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ -#include #include "lacaml_macros.h" +#include -CAMLprim value LFUN(linspace_stub)(value vY, double va, double vb, intnat vN) -{ +CAMLprim value LFUN(linspace_stub)(value vY, double va, double vb, intnat vN) { CAMLparam1(vY); integer i, GET_INT(N); REAL GET_DOUBLE(a); REAL GET_DOUBLE(b); - REAL h = (b - a)/(N - 1), x = a; + REAL h = (b - a) / (N - 1), x = a; VEC_PARAMS1(Y); - caml_enter_blocking_section(); /* Allow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ for (i = 1; i <= N; i++) { *Y_data = x; @@ -45,22 +40,15 @@ CAMLprim value LFUN(linspace_stub)(value vY, double va, double vb, intnat vN) x = a + i * h; } - caml_leave_blocking_section(); /* Disallow other threads */ + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(Val_unit); } -CAMLprim value LFUN(linspace_stub_bc)(value vY, value va, value vb, value vN) -{ - return - LFUN(linspace_stub)( - vY, - Double_val(va), - Double_val(vb), - Int_val(vN)); +CAMLprim value LFUN(linspace_stub_bc)(value vY, value va, value vb, value vN) { + return LFUN(linspace_stub)(vY, Double_val(va), Double_val(vb), Int_val(vN)); } - #ifndef LACAML_DOUBLE extern float exp10f(float); #define myexp10 exp10f @@ -69,18 +57,17 @@ extern double exp10(double); #define myexp10 exp10 #endif -CAMLprim value LFUN(logspace_stub)( - value vY, double va, double vb, double vbase, intnat vN) -{ +CAMLprim value LFUN(logspace_stub)(value vY, double va, double vb, double vbase, + intnat vN) { CAMLparam1(vY); integer i, GET_INT(N); REAL GET_DOUBLE(a); REAL GET_DOUBLE(b); double GET_DOUBLE(base); - REAL h = (b - a)/(N - 1), x = a; + REAL h = (b - a) / (N - 1), x = a; VEC_PARAMS1(Y); - caml_enter_blocking_section(); /* Allow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ if (base == 2.0) for (i = 1; i <= N; i++) { @@ -109,34 +96,24 @@ CAMLprim value LFUN(logspace_stub)( } } - caml_leave_blocking_section(); /* Disallow other threads */ + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(Val_unit); } -CAMLprim value LFUN(logspace_stub_bc)( - value vY, value va, value vb, value vbase, value vN) -{ - return - LFUN(logspace_stub)( - vY, - Double_val(va), - Double_val(vb), - Double_val(vbase), - Int_val(vN)); +CAMLprim value LFUN(logspace_stub_bc)(value vY, value va, value vb, value vbase, + value vN) { + return LFUN(logspace_stub)(vY, Double_val(va), Double_val(vb), + Double_val(vbase), Int_val(vN)); } - extern REAL FUN(nrm2)(integer *N, REAL *X, integer *INCX); -extern REAL FUN(dot)( - integer *N, - REAL *X, integer *INCX, - REAL *Y, integer *INCY); +extern REAL FUN(dot)(integer *N, REAL *X, integer *INCX, REAL *Y, + integer *INCY); -CAMLprim double LFUN(sqr_nrm2_stub)( - value vSTABLE, intnat vN, intnat vOFSX, intnat vINCX, value vX) -{ +CAMLprim double LFUN(sqr_nrm2_stub)(value vSTABLE, intnat vN, intnat vOFSX, + intnat vINCX, value vX) { CAMLparam1(vX); integer GET_INT(N), GET_INT(INCX); @@ -146,27 +123,21 @@ CAMLprim double LFUN(sqr_nrm2_stub)( int stable = Bool_val(vSTABLE); - caml_enter_blocking_section(); /* Allow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ if (stable) { res = FUN(nrm2)(&N, X_data, &INCX); res *= res; - } else res = FUN(dot)(&N, X_data, &INCX, X_data, &INCX); - caml_leave_blocking_section(); /* Disallow other threads */ + } else + res = FUN(dot)(&N, X_data, &INCX, X_data, &INCX); + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturnT(double, res); } -CAMLprim value LFUN(sqr_nrm2_stub_bc)( - value vSTABLE, value vN, value vOFSX, value vINCX, value vX) -{ - return - caml_copy_double( - LFUN(sqr_nrm2_stub)( - vSTABLE, - Int_val(vN), - Int_val(vOFSX), - Int_val(vINCX), - vX)); +CAMLprim value LFUN(sqr_nrm2_stub_bc)(value vSTABLE, value vN, value vOFSX, + value vINCX, value vX) { + return caml_copy_double(LFUN(sqr_nrm2_stub)( + vSTABLE, Int_val(vN), Int_val(vOFSX), Int_val(vINCX), vX)); } #define NAME LFUN(max_stub) @@ -193,38 +164,25 @@ CAMLprim value LFUN(sqr_nrm2_stub_bc)( #define FUNC(acc, x) acc *= x #include "fold_col.h" -extern double LFUN(dot_stub)( - intnat vN, - intnat vOFSY, intnat vINCY, value vY, - intnat vOFSX, intnat vINCX, value vX); +extern double LFUN(dot_stub)(intnat vN, intnat vOFSY, intnat vINCY, value vY, + intnat vOFSX, intnat vINCX, value vX); -CAMLprim double LFUN(ssqr_zero_stub)( - intnat vN, intnat vOFSX, intnat vINCX, value vX) -{ +CAMLprim double LFUN(ssqr_zero_stub)(intnat vN, intnat vOFSX, intnat vINCX, + value vX) { return LFUN(dot_stub(vN, vOFSX, vINCX, vX, vOFSX, vINCX, vX)); } -CAMLprim value LFUN(ssqr_zero_stub_bc)( - value vN, value vOFSX, value vINCX, value vX) -{ - return - caml_copy_double( - LFUN(ssqr_zero_stub)( - Int_val(vN), - Int_val(vOFSX), - Int_val(vINCX), - vX)); +CAMLprim value LFUN(ssqr_zero_stub_bc)(value vN, value vOFSX, value vINCX, + value vX) { + return caml_copy_double( + LFUN(ssqr_zero_stub)(Int_val(vN), Int_val(vOFSX), Int_val(vINCX), vX)); } -CAMLprim double LFUN(ssqr_stub)( - intnat vN, - double vC, - intnat vOFSX, intnat vINCX, value vX) -{ +CAMLprim double LFUN(ssqr_stub)(intnat vN, double vC, intnat vOFSX, + intnat vINCX, value vX) { CAMLparam1(vX); - integer GET_INT(N), - GET_INT(INCX); + integer GET_INT(N), GET_INT(INCX); VEC_PARAMS(X); @@ -232,7 +190,7 @@ CAMLprim double LFUN(ssqr_stub)( REAL acc = 0.0; REAL GET_DOUBLE(C); - caml_enter_blocking_section(); /* Allow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ if (INCX == 1) /* NOTE: may improve SIMD optimization */ @@ -243,10 +201,9 @@ CAMLprim double LFUN(ssqr_stub)( else { if (INCX > 0) { start = X_data; - last = start + N*INCX; - } - else { - start = X_data - (N - 1)*INCX; + last = start + N * INCX; + } else { + start = X_data - (N - 1) * INCX; last = X_data + INCX; } @@ -257,29 +214,22 @@ CAMLprim double LFUN(ssqr_stub)( } } - caml_leave_blocking_section(); /* Disallow other threads */ + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturnT(double, acc); } -CAMLprim value LFUN(ssqr_stub_bc)( - value vN, value vC, value vOFSX, value vINCX, value vX) -{ - return - caml_copy_double( - LFUN(ssqr_stub)( - Int_val(vN), - Double_val(vC), - Int_val(vOFSX), - Int_val(vINCX), - vX)); +CAMLprim value LFUN(ssqr_stub_bc)(value vN, value vC, value vOFSX, value vINCX, + value vX) { + return caml_copy_double(LFUN(ssqr_stub)(Int_val(vN), Double_val(vC), + Int_val(vOFSX), Int_val(vINCX), vX)); } /* Unary vector operations */ #define NAME LFUN(neg_stub) #define BC_NAME LFUN(neg_stub_bc) -#define FUNC(dst, x) *dst = - x +#define FUNC(dst, x) *dst = -x #include "vec_map.h" #define NAME LFUN(reci_stub) @@ -457,7 +407,6 @@ CAMLprim value LFUN(ssqr_stub_bc)( #define FUNC(dst, x) *dst = x / (1 + SDMATHH(fabs)(x)) #include "vec_map.h" - /* Binary vector operations */ #define NAME LFUN(add_stub) @@ -472,12 +421,12 @@ CAMLprim value LFUN(ssqr_stub_bc)( #define NAME LFUN(mul_stub) #define BC_NAME LFUN(mul_stub_bc) -#define FUNC(dst, x, y) *dst = x*y +#define FUNC(dst, x, y) *dst = x * y #include "vec_combine.h" #define NAME LFUN(div_stub) #define BC_NAME LFUN(div_stub_bc) -#define FUNC(dst, x, y) *dst = x/y +#define FUNC(dst, x, y) *dst = x / y #include "vec_combine.h" #define NAME LFUN(pow_stub) @@ -505,50 +454,50 @@ CAMLprim value LFUN(ssqr_stub_bc)( #define FUNC(dst, x, y) *dst = SDMATHH(fmax)(x, y) #include "vec_combine.h" - /* Ternary matrix operations */ #define NAME LFUN(zpxy_stub) #define BC_NAME LFUN(zpxy_stub_bc) -# ifdef FP_FAST_FMA -# define FUNC(dst, x, y) *dst = SDMATHH(fma)(x, y, *dst) -# else -# define FUNC(dst, x, y) *dst += x*y -# endif +#ifdef FP_FAST_FMA +#define FUNC(dst, x, y) *dst = SDMATHH(fma)(x, y, *dst) +#else +#define FUNC(dst, x, y) *dst += x * y +#endif #include "vec_combine.h" #define NAME LFUN(zmxy_stub) #define BC_NAME LFUN(zmxy_stub_bc) -#define FUNC(dst, x, y) *dst -= x*y +#define FUNC(dst, x, y) *dst -= x * y #include "vec_combine.h" - /* Unary vector operations yielding floats */ #define NAME LFUN(log_sum_exp_vec_stub) #define BC_NAME LFUN(log_sum_exp_vec_stub_bc) #define DECLARE_EXTRA NUMBER x_max = -INFINITY -#define INIT_HAVE_LOCK \ - x_max = LFUN(max_stub_blocking)(N, X_data, INCX, x_max) +#define INIT_HAVE_LOCK x_max = LFUN(max_stub_blocking)(N, X_data, INCX, x_max) #define INIT 0.0 #define FUNC(acc, x) acc += SDMATHH(exp)(x - x_max) #define FINISH_HAVE_LOCK acc = SDMATHH(log)(acc) + x_max #include "fold_col.h" - /* Binary vector operations yielding floats */ #define NAME LFUN(ssqr_diff_stub) #define BC_NAME LFUN(ssqr_diff_stub_bc) #define INIT 0.0 -# ifdef FP_FAST_FMA -# define FUNC(acc, x, y) x -= y; acc = SDMATHH(fma)(x, x, acc) -# else -# define FUNC(acc, x, y) x -= y; x *= x; acc += x -# endif +#ifdef FP_FAST_FMA +#define FUNC(acc, x, y) \ + x -= y; \ + acc = SDMATHH(fma)(x, x, acc) +#else +#define FUNC(acc, x, y) \ + x -= y; \ + x *= x; \ + acc += x +#endif #include "fold2_col.h" - /* Misc operations */ /* Since executing the (small) callback may dominate the running time, @@ -557,8 +506,7 @@ CAMLprim value LFUN(ssqr_stub_bc)( /* NaN are put last (greater than anything) to ensure the algo termination. If both a and b are NaN, return false (consider NaN equal for this). */ -#define NAN_LAST(a, b, SORT) \ - (isnan(b) ? (!isnan(a)) : (!isnan(a) && (SORT))) +#define NAN_LAST(a, b, SORT) (isnan(b) ? (!isnan(a)) : (!isnan(a) && (SORT))) #define NAME LFUN(sort_incr) #define BC_NAME LFUN(sort_incr_bc) @@ -578,10 +526,10 @@ CAMLprim value LFUN(ssqr_stub_bc)( #define BC_NAME LFUN(sort_bc) #define NAME_PERM LFUN(sort_perm) #define BC_NAME_PERM LFUN(sort_perm_bc) -#define OCAML_SORT_LT(a, b) \ - NAN_LAST(a, b, (va = caml_copy_double(a), \ - vb = caml_copy_double(b), \ - Int_val(caml_callback2(vCMP, va, vb)) < 0)) +#define OCAML_SORT_LT(a, b) \ + NAN_LAST(a, b, \ + (va = caml_copy_double(a), vb = caml_copy_double(b), \ + Int_val(caml_callback2(vCMP, va, vb)) < 0)) #define OCAML_SORT_CALLBACK #include "vec_sort.h" #undef OCAML_SORT_CALLBACK diff --git a/src/vec_SD.ml b/src/vec_SD.ml index 0a9eb1f..e52e98d 100644 --- a/src/vec_SD.ml +++ b/src/vec_SD.ml @@ -1,29 +1,24 @@ (* File: vec_SD.ml - Copyright (C) 2001- + Copyright © 2001- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umons.ac.be/anum/ + Christophe Troestler - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) open Vec4_FPREC open Utils @@ -32,9 +27,8 @@ open Floatxx let random ?rnd_state ?(from = -1.) ?(range = 2.) n = let vec = create n in let state = - match rnd_state with - | None -> Random.get_state () - | Some state -> state in + match rnd_state with None -> Random.get_state () | Some state -> state + in for row = 1 to n do vec.{row} <- Random.State.float state range +. from done; @@ -44,7 +38,6 @@ let random ?rnd_state ?(from = -1.) ?(range = 2.) n = let get_y_vec ~loc ~ofsy ~incy ~n y = get_vec loc y_str y ofsy incy n create let get_z_vec ~loc ~ofsz ~incz ~n z = get_vec loc z_str z ofsz incz n create - (* Unary vector operations *) let int_abs = abs @@ -60,414 +53,413 @@ let unop direct loc = y external direct_abs : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_FPRECabs_stub_bc" "lacaml_FPRECabs_stub" let abs = unop direct_abs "abs" external direct_signum : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_FPRECsignum_stub_bc" "lacaml_FPRECsignum_stub" let signum = unop direct_signum "signum" external direct_sqr : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_FPRECsqr_stub_bc" "lacaml_FPRECsqr_stub" let sqr = unop direct_sqr "sqr" external direct_sqrt : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_FPRECsqrt_stub_bc" "lacaml_FPRECsqrt_stub" let sqrt = unop direct_sqrt "sqrt" external direct_cbrt : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_FPRECcbrt_stub_bc" "lacaml_FPRECcbrt_stub" let cbrt = unop direct_cbrt "cbrt" external direct_exp : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_FPRECexp_stub_bc" "lacaml_FPRECexp_stub" let exp = unop direct_exp "exp" external direct_exp2 : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_FPRECexp2_stub_bc" "lacaml_FPRECexp2_stub" let exp2 = unop direct_exp2 "exp2" external direct_expm1 : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_FPRECexpm1_stub_bc" "lacaml_FPRECexpm1_stub" let expm1 = unop direct_expm1 "expm1" external direct_log : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_FPREClog_stub_bc" "lacaml_FPREClog_stub" let log = unop direct_log "log" external direct_log10 : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_FPREClog10_stub_bc" "lacaml_FPREClog10_stub" let log10 = unop direct_log10 "log10" external direct_log2 : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_FPREClog2_stub_bc" "lacaml_FPREClog2_stub" let log2 = unop direct_log2 "log2" external direct_log1p : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_FPREClog1p_stub_bc" "lacaml_FPREClog1p_stub" let log1p = unop direct_log1p "log1p" external direct_sin : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_FPRECsin_stub_bc" "lacaml_FPRECsin_stub" let sin = unop direct_sin "sin" external direct_cos : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_FPRECcos_stub_bc" "lacaml_FPRECcos_stub" let cos = unop direct_cos "cos" external direct_tan : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_FPRECtan_stub_bc" "lacaml_FPRECtan_stub" let tan = unop direct_tan "tan" external direct_asin : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_FPRECasin_stub_bc" "lacaml_FPRECasin_stub" let asin = unop direct_asin "asin" external direct_acos : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_FPRECacos_stub_bc" "lacaml_FPRECacos_stub" let acos = unop direct_acos "acos" external direct_atan : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_FPRECatan_stub_bc" "lacaml_FPRECatan_stub" let atan = unop direct_atan "atan" external direct_sinh : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_FPRECsinh_stub_bc" "lacaml_FPRECsinh_stub" let sinh = unop direct_sinh "sinh" external direct_cosh : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_FPRECcosh_stub_bc" "lacaml_FPRECcosh_stub" let cosh = unop direct_cosh "cosh" external direct_tanh : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_FPRECtanh_stub_bc" "lacaml_FPRECtanh_stub" let tanh = unop direct_tanh "tanh" external direct_asinh : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_FPRECasinh_stub_bc" "lacaml_FPRECasinh_stub" let asinh = unop direct_asinh "asinh" external direct_acosh : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_FPRECacosh_stub_bc" "lacaml_FPRECacosh_stub" let acosh = unop direct_acosh "acosh" external direct_atanh : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_FPRECatanh_stub_bc" "lacaml_FPRECatanh_stub" let atanh = unop direct_atanh "atanh" external direct_floor : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_FPRECfloor_stub_bc" "lacaml_FPRECfloor_stub" let floor = unop direct_floor "floor" external direct_ceil : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_FPRECceil_stub_bc" "lacaml_FPRECceil_stub" let ceil = unop direct_ceil "ceil" external direct_round : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_FPRECround_stub_bc" "lacaml_FPRECround_stub" let round = unop direct_round "round" external direct_trunc : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_FPRECtrunc_stub_bc" "lacaml_FPRECtrunc_stub" let trunc = unop direct_trunc "trunc" external direct_erf : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_FPRECerf_stub_bc" "lacaml_FPRECerf_stub" let erf = unop direct_erf "erf" external direct_erfc : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_FPRECerfc_stub_bc" "lacaml_FPRECerfc_stub" let erfc = unop direct_erfc "erfc" external direct_logistic : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_FPREClogistic_stub_bc" "lacaml_FPREClogistic_stub" let logistic = unop direct_logistic "logistic" external direct_relu : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_FPRECrelu_stub_bc" "lacaml_FPRECrelu_stub" let relu = unop direct_relu "relu" external direct_softplus : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_FPRECsoftplus_stub_bc" "lacaml_FPRECsoftplus_stub" let softplus = unop direct_softplus "softplus" external direct_softsign : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_FPRECsoftsign_stub_bc" "lacaml_FPRECsoftsign_stub" let softsign = unop direct_softsign "softsign" - (* Binary vector operations *) let binop direct loc = @@ -477,95 +469,94 @@ let binop direct loc = let ofsx, incx = get_vec_geom loc x_str ofsx incx in let ofsy, incy = get_vec_geom loc y_str ofsy incy in let n = get_dim_vec loc x_str ofsx incx x n_str n in - check_vec loc y_str y (ofsy + (n - 1) * int_abs incy); + check_vec loc y_str y (ofsy + ((n - 1) * int_abs incy)); let z = get_z_vec ~loc ~ofsz ~incz ~n z in direct ~n ~ofsz ~incz ~z ~ofsx ~incx ~x ~ofsy ~incy ~y; z external direct_pow : - n : (int [@untagged]) -> - ofsz : (int [@untagged]) -> - incz : (int [@untagged]) -> - z : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> + n:(int[@untagged]) -> + ofsz:(int[@untagged]) -> + incz:(int[@untagged]) -> + z:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> unit = "lacaml_FPRECpow_stub_bc" "lacaml_FPRECpow_stub" let pow = binop direct_pow "pow" external direct_atan2 : - n : (int [@untagged]) -> - ofsz : (int [@untagged]) -> - incz : (int [@untagged]) -> - z : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> + n:(int[@untagged]) -> + ofsz:(int[@untagged]) -> + incz:(int[@untagged]) -> + z:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> unit = "lacaml_FPRECatan2_stub_bc" "lacaml_FPRECatan2_stub" let atan2 = binop direct_atan2 "atan2" external direct_hypot : - n : (int [@untagged]) -> - ofsz : (int [@untagged]) -> - incz : (int [@untagged]) -> - z : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> + n:(int[@untagged]) -> + ofsz:(int[@untagged]) -> + incz:(int[@untagged]) -> + z:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> unit = "lacaml_FPREChypot_stub_bc" "lacaml_FPREChypot_stub" let hypot = binop direct_hypot "hypot" external direct_min2 : - n : (int [@untagged]) -> - ofsz : (int [@untagged]) -> - incz : (int [@untagged]) -> - z : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> + n:(int[@untagged]) -> + ofsz:(int[@untagged]) -> + incz:(int[@untagged]) -> + z:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> unit = "lacaml_FPRECmin2_stub_bc" "lacaml_FPRECmin2_stub" let min2 = binop direct_min2 "min2" external direct_max2 : - n : (int [@untagged]) -> - ofsz : (int [@untagged]) -> - incz : (int [@untagged]) -> - z : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> + n:(int[@untagged]) -> + ofsz:(int[@untagged]) -> + incz:(int[@untagged]) -> + z:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> unit = "lacaml_FPRECmax2_stub_bc" "lacaml_FPRECmax2_stub" let max2 = binop direct_max2 "max2" - (* Misc functions *) external direct_log_sum_exp : - n : (int [@untagged]) -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> - (float [@unboxed]) + n:(int[@untagged]) -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> + (float[@unboxed]) = "lacaml_FPREClog_sum_exp_vec_stub_bc" "lacaml_FPREClog_sum_exp_vec_stub" let log_sum_exp = diff --git a/src/vec_SD.mli b/src/vec_SD.mli index 612527b..d8ff8bb 100644 --- a/src/vec_SD.mli +++ b/src/vec_SD.mli @@ -1,29 +1,24 @@ (* File: vec_SD.mli - Copyright (C) 2001- + Copyright © 2001- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umh.ac.be/an/ + Christophe Troestler - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) (** {5 Vector operations} *) @@ -33,10 +28,7 @@ open Types.Vec (** {6 Creation of vectors} *) val random : - ?rnd_state : Random.State.t -> - ?from : float -> ?range : float -> - int - -> vec + ?rnd_state:Random.State.t -> ?from:float -> ?range:float -> int -> vec (** [random ?rnd_state ?from ?range n] @return a vector of size [n] initialized with random elements sampled uniformly from [range] starting at [from]. A random state [rnd_state] can be passed. @@ -49,509 +41,462 @@ val random : (** {6 Unary vector operations} *) val abs : unop -(** [abs ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the absolute value - of [n] elements of the vector [x] using [incx] as incremental - steps. If [y] is given, the result will be stored in there - using increments of [incy], otherwise a fresh vector will be - used. The resulting vector is returned. +(** [abs ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the absolute value of [n] + elements of the vector [x] using [incx] as incremental steps. If [y] is + given, the result will be stored in there using increments of [incy], + otherwise a fresh vector will be used. The resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @param y default = fresh vector with [ofsy+(n - 1)(abs incy)] rows @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val signum : unop (** [signum ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the sign value ([-1] for - negative numbers, [0] (or [-0]) for zero, [1] for positive numbers, - [nan] for [nan]) of [n] elements of the vector [x] using [incx] as - incremental steps. If [y] is given, the result will be stored in there - using increments of [incy], otherwise a fresh vector will be used. - The resulting vector is returned. + negative numbers, [0] (or [-0]) for zero, [1] for positive numbers, [nan] + for [nan]) of [n] elements of the vector [x] using [incx] as incremental + steps. If [y] is given, the result will be stored in there using increments + of [incy], otherwise a fresh vector will be used. The resulting vector is + returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @param y default = fresh vector with [ofsy+(n - 1)(abs incy)] rows @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val sqr : unop -(** [sqr ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the square - of [n] elements of the vector [x] using [incx] as incremental - steps. If [y] is given, the result will be stored in there - using increments of [incy], otherwise a fresh vector will be - used. The resulting vector is returned. +(** [sqr ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the square of [n] elements of + the vector [x] using [incx] as incremental steps. If [y] is given, the + result will be stored in there using increments of [incy], otherwise a fresh + vector will be used. The resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @param y default = fresh vector with [ofsy+(n - 1)(abs incy)] rows @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val sqrt : unop -(** [sqrt ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the square root - of [n] elements of the vector [x] using [incx] as incremental - steps. If [y] is given, the result will be stored in there - using increments of [incy], otherwise a fresh vector will be - used. The resulting vector is returned. +(** [sqrt ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the square root of [n] + elements of the vector [x] using [incx] as incremental steps. If [y] is + given, the result will be stored in there using increments of [incy], + otherwise a fresh vector will be used. The resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @param y default = fresh vector with [ofsy+(n - 1)(abs incy)] rows @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val cbrt : unop -(** [cbrt ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the cubic root - of [n] elements of the vector [x] using [incx] as incremental - steps. If [y] is given, the result will be stored in there - using increments of [incy], otherwise a fresh vector will be - used. The resulting vector is returned. +(** [cbrt ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the cubic root of [n] + elements of the vector [x] using [incx] as incremental steps. If [y] is + given, the result will be stored in there using increments of [incy], + otherwise a fresh vector will be used. The resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @param y default = fresh vector with [ofsy+(n - 1)(abs incy)] rows @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val exp : unop -(** [exp ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the exponential - of [n] elements of the vector [x] using [incx] as incremental - steps. If [y] is given, the result will be stored in there - using increments of [incy], otherwise a fresh vector will be - used. The resulting vector is returned. +(** [exp ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the exponential of [n] + elements of the vector [x] using [incx] as incremental steps. If [y] is + given, the result will be stored in there using increments of [incy], + otherwise a fresh vector will be used. The resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @param y default = fresh vector with [ofsy+(n - 1)(abs incy)] rows @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val exp2 : unop -(** [exp2 ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the base-2 exponential - of [n] elements of the vector [x] using [incx] as incremental steps. - If [y] is given, the result will be stored in there using increments of - [incy], otherwise a fresh vector will be used. The resulting vector - is returned. +(** [exp2 ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the base-2 exponential of + [n] elements of the vector [x] using [incx] as incremental steps. If [y] is + given, the result will be stored in there using increments of [incy], + otherwise a fresh vector will be used. The resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @param y default = fresh vector with [ofsy+(n - 1)(abs incy)] rows @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val expm1 : unop -(** [expm1 ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes [exp x -. 1.] - for [n] elements of the vector [x] using [incx] as incremental steps. - If [y] is given, the result will be stored in there using increments of - [incy], otherwise a fresh vector will be used. The resulting vector - is returned. +(** [expm1 ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes [exp x -. 1.] for [n] + elements of the vector [x] using [incx] as incremental steps. If [y] is + given, the result will be stored in there using increments of [incy], + otherwise a fresh vector will be used. The resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @param y default = fresh vector with [ofsy+(n - 1)(abs incy)] rows @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val log : unop -(** [log ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the logarithm - of [n] elements of the vector [x] using [incx] as incremental - steps. If [y] is given, the result will be stored in there - using increments of [incy], otherwise a fresh vector will be - used. The resulting vector is returned. +(** [log ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the logarithm of [n] elements + of the vector [x] using [incx] as incremental steps. If [y] is given, the + result will be stored in there using increments of [incy], otherwise a fresh + vector will be used. The resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @param y default = fresh vector with [ofsy+(n - 1)(abs incy)] rows @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val log10 : unop -(** [log10 ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the base-10 logarithm - of [n] elements of the vector [x] using [incx] as incremental steps. - If [y] is given, the result will be stored in there using increments of - [incy], otherwise a fresh vector will be used. The resulting vector - is returned. +(** [log10 ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the base-10 logarithm of + [n] elements of the vector [x] using [incx] as incremental steps. If [y] is + given, the result will be stored in there using increments of [incy], + otherwise a fresh vector will be used. The resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @param y default = fresh vector with [ofsy+(n - 1)(abs incy)] rows @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val log2 : unop -(** [log2 ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the base-2 logarithm - of [n] elements of the vector [x] using [incx] as incremental steps. - If [y] is given, the result will be stored in there using increments of - [incy], otherwise a fresh vector will be used. The resulting vector - is returned. +(** [log2 ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the base-2 logarithm of [n] + elements of the vector [x] using [incx] as incremental steps. If [y] is + given, the result will be stored in there using increments of [incy], + otherwise a fresh vector will be used. The resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @param y default = fresh vector with [ofsy+(n - 1)(abs incy)] rows @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val log1p : unop (** [log1p ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes [log (1 + x)] for [n] - elements of the vector [x] using [incx] as incremental steps. If [y] - is given, the result will be stored in there using increments of [incy], - otherwise a fresh vector will be used. The resulting vector is returned. + elements of the vector [x] using [incx] as incremental steps. If [y] is + given, the result will be stored in there using increments of [incy], + otherwise a fresh vector will be used. The resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @param y default = fresh vector with [ofsy+(n - 1)(abs incy)] rows @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val sin : unop -(** [sin ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the sine of [n] elements - of the vector [x] using [incx] as incremental steps. If [y] is given, - the result will be stored in there using increments of [incy], otherwise - a fresh vector will be used. The resulting vector is returned. +(** [sin ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the sine of [n] elements of + the vector [x] using [incx] as incremental steps. If [y] is given, the + result will be stored in there using increments of [incy], otherwise a fresh + vector will be used. The resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @param y default = fresh vector with [ofsy+(n - 1)(abs incy)] rows @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val cos : unop -(** [cos ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the cosine of [n] elements - of the vector [x] using [incx] as incremental steps. If [y] is given, - the result will be stored in there using increments of [incy], otherwise - a fresh vector will be used. The resulting vector is returned. +(** [cos ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the cosine of [n] elements of + the vector [x] using [incx] as incremental steps. If [y] is given, the + result will be stored in there using increments of [incy], otherwise a fresh + vector will be used. The resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @param y default = fresh vector with [ofsy+(n - 1)(abs incy)] rows @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val tan : unop (** [tan ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the tangent of [n] elements - of the vector [x] using [incx] as incremental steps. If [y] is given, - the result will be stored in there using increments of [incy], otherwise - a fresh vector will be used. The resulting vector is returned. + of the vector [x] using [incx] as incremental steps. If [y] is given, the + result will be stored in there using increments of [incy], otherwise a fresh + vector will be used. The resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @param y default = fresh vector with [ofsy+(n - 1)(abs incy)] rows @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val asin : unop (** [asin ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the arc sine of [n] elements - of the vector [x] using [incx] as incremental steps. If [y] is given, - the result will be stored in there using increments of [incy], otherwise - a fresh vector will be used. The resulting vector is returned. + of the vector [x] using [incx] as incremental steps. If [y] is given, the + result will be stored in there using increments of [incy], otherwise a fresh + vector will be used. The resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @param y default = fresh vector with [ofsy+(n - 1)(abs incy)] rows @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val acos : unop (** [acos ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the arc cosine of [n] - elements of the vector [x] using [incx] as incremental steps. If [y] - is given, the result will be stored in there using increments of [incy], - otherwise a fresh vector will be used. The resulting vector is returned. + elements of the vector [x] using [incx] as incremental steps. If [y] is + given, the result will be stored in there using increments of [incy], + otherwise a fresh vector will be used. The resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @param y default = fresh vector with [ofsy+(n - 1)(abs incy)] rows @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val atan : unop -(** [atan ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the arc tangent of - [n] elements of the vector [x] using [incx] as incremental steps. If [y] - is given, the result will be stored in there using increments of [incy], - otherwise a fresh vector will be used. The resulting vector is returned. +(** [atan ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the arc tangent of [n] + elements of the vector [x] using [incx] as incremental steps. If [y] is + given, the result will be stored in there using increments of [incy], + otherwise a fresh vector will be used. The resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @param y default = fresh vector with [ofsy+(n - 1)(abs incy)] rows @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val sinh : unop -(** [sinh ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the hyperbolic sine of - [n] elements of the vector [x] using [incx] as incremental steps. If [y] - is given, the result will be stored in there using increments of [incy], - otherwise a fresh vector will be used. The resulting vector is returned. +(** [sinh ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the hyperbolic sine of [n] + elements of the vector [x] using [incx] as incremental steps. If [y] is + given, the result will be stored in there using increments of [incy], + otherwise a fresh vector will be used. The resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @param y default = fresh vector with [ofsy+(n - 1)(abs incy)] rows @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val cosh : unop -(** [cosh ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the hyperbolic cosine of - [n] elements of the vector [x] using [incx] as incremental steps. If [y] - is given, the result will be stored in there using increments of [incy], - otherwise a fresh vector will be used. The resulting vector is returned. +(** [cosh ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the hyperbolic cosine of [n] + elements of the vector [x] using [incx] as incremental steps. If [y] is + given, the result will be stored in there using increments of [incy], + otherwise a fresh vector will be used. The resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @param y default = fresh vector with [ofsy+(n - 1)(abs incy)] rows @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val tanh : unop (** [tanh ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the hyperbolic tangent of - [n] elements of the vector [x] using [incx] as incremental steps. If [y] - is given, the result will be stored in there using increments of [incy], - otherwise a fresh vector will be used. The resulting vector is returned. + [n] elements of the vector [x] using [incx] as incremental steps. If [y] is + given, the result will be stored in there using increments of [incy], + otherwise a fresh vector will be used. The resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @param y default = fresh vector with [ofsy+(n - 1)(abs incy)] rows @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val asinh : unop (** [asinh ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the hyperbolic arc sine of - [n] elements of the vector [x] using [incx] as incremental steps. If [y] - is given, the result will be stored in there using increments of [incy], - otherwise a fresh vector will be used. The resulting vector is returned. + [n] elements of the vector [x] using [incx] as incremental steps. If [y] is + given, the result will be stored in there using increments of [incy], + otherwise a fresh vector will be used. The resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @param y default = fresh vector with [ofsy+(n - 1)(abs incy)] rows @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val acosh : unop (** [cosh ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the hyperbolic arc cosine of - [n] elements of the vector [x] using [incx] as incremental steps. If [y] - is given, the result will be stored in there using increments of [incy], - otherwise a fresh vector will be used. The resulting vector is returned. + [n] elements of the vector [x] using [incx] as incremental steps. If [y] is + given, the result will be stored in there using increments of [incy], + otherwise a fresh vector will be used. The resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @param y default = fresh vector with [ofsy+(n - 1)(abs incy)] rows @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val atanh : unop -(** [atanh ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the hyperbolic arc - tangent of [n] elements of the vector [x] using [incx] as incremental - steps. If [y] is given, the result will be stored in there using - increments of [incy], otherwise a fresh vector will be used. The resulting - vector is returned. +(** [atanh ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the hyperbolic arc tangent + of [n] elements of the vector [x] using [incx] as incremental steps. If [y] + is given, the result will be stored in there using increments of [incy], + otherwise a fresh vector will be used. The resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @param y default = fresh vector with [ofsy+(n - 1)(abs incy)] rows @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val floor : unop -(** [floor ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the floor of [n] - elements of the vector [x] using [incx] as incremental steps. If [y] - is given, the result will be stored in there using increments of [incy], - otherwise a fresh vector will be used. The resulting vector is returned. +(** [floor ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the floor of [n] elements + of the vector [x] using [incx] as incremental steps. If [y] is given, the + result will be stored in there using increments of [incy], otherwise a fresh + vector will be used. The resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @param y default = fresh vector with [ofsy+(n - 1)(abs incy)] rows @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val ceil : unop -(** [ceil ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the ceiling of [n] - elements of the vector [x] using [incx] as incremental steps. If [y] - is given, the result will be stored in there using increments of [incy], - otherwise a fresh vector will be used. The resulting vector is returned. +(** [ceil ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the ceiling of [n] elements + of the vector [x] using [incx] as incremental steps. If [y] is given, the + result will be stored in there using increments of [incy], otherwise a fresh + vector will be used. The resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @param y default = fresh vector with [ofsy+(n - 1)(abs incy)] rows @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val round : unop (** [round ?n ?ofsy ?incy ?y ?ofsx ?incx x] rounds the [n] elements of the - vector [x] using [incx] as incremental steps. If [y] is given, the - result will be stored in there using increments of [incy], otherwise a - fresh vector will be used. The resulting vector is returned. + vector [x] using [incx] as incremental steps. If [y] is given, the result + will be stored in there using increments of [incy], otherwise a fresh vector + will be used. The resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @param y default = fresh vector with [ofsy+(n - 1)(abs incy)] rows @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val trunc : unop (** [trunc ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the truncation of the [n] - elements of the vector [x] using [incx] as incremental steps. If [y] - is given, the result will be stored in there using increments of [incy], - otherwise a fresh vector will be used. The resulting vector is returned. + elements of the vector [x] using [incx] as incremental steps. If [y] is + given, the result will be stored in there using increments of [incy], + otherwise a fresh vector will be used. The resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @param y default = fresh vector with [ofsy+(n - 1)(abs incy)] rows @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val erf : unop -(** [erf ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the error function for - [n] elements of the vector [x] using [incx] as incremental steps. - If [y] is given, the result will be stored in there using increments of - [incy], otherwise a fresh vector will be used. The resulting vector - is returned. +(** [erf ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the error function for [n] + elements of the vector [x] using [incx] as incremental steps. If [y] is + given, the result will be stored in there using increments of [incy], + otherwise a fresh vector will be used. The resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @param y default = fresh vector with [ofsy+(n - 1)(abs incy)] rows @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val erfc : unop (** [erfc ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the complementary error function for [n] elements of the vector [x] using [incx] as incremental - steps. If [y] is given, the result will be stored in there using - increments of [incy], otherwise a fresh vector will be used. The resulting - vector is returned. + steps. If [y] is given, the result will be stored in there using increments + of [incy], otherwise a fresh vector will be used. The resulting vector is + returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @param y default = fresh vector with [ofsy+(n - 1)(abs incy)] rows @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val logistic : unop -(** [logistic ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the logistict - function [1/(1 + exp(-a)] for [n] elements of the vector [x] using [incx] - as incremental steps. If [y] is given, the result will be stored in - there using increments of [incy], otherwise a fresh vector will be used. - The resulting vector is returned. +(** [logistic ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the logistict function + [1/(1 + exp(-a)] for [n] elements of the vector [x] using [incx] as + incremental steps. If [y] is given, the result will be stored in there using + increments of [incy], otherwise a fresh vector will be used. The resulting + vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @param y default = fresh vector with [ofsy+(n - 1)(abs incy)] rows @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val relu : unop -(** [relu ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the rectified linear - unit function [max(x, 0)] for [n] elements of the vector [x] using [incx] - as incremental steps. If [y] is given, the result will be stored in - there using increments of [incy], otherwise a fresh vector will be used. - The resulting vector is returned. +(** [relu ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the rectified linear unit + function [max(x, 0)] for [n] elements of the vector [x] using [incx] as + incremental steps. If [y] is given, the result will be stored in there using + increments of [incy], otherwise a fresh vector will be used. The resulting + vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @param y default = fresh vector with [ofsy+(n - 1)(abs incy)] rows @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val softplus : unop (** [softplus ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the softplus function - [log(1 + exp(x)] for [n] elements of the vector [x] using [incx] - as incremental steps. If [y] is given, the result will be stored in - there using increments of [incy], otherwise a fresh vector will be used. - The resulting vector is returned. + [log(1 + exp(x)] for [n] elements of the vector [x] using [incx] as + incremental steps. If [y] is given, the result will be stored in there using + increments of [incy], otherwise a fresh vector will be used. The resulting + vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @param y default = fresh vector with [ofsy+(n - 1)(abs incy)] rows @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val softsign : unop (** [softsign ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the softsign function - [x / (1 + abs(x))] for [n] elements of the vector [x] using [incx] - as incremental steps. If [y] is given, the result will be stored in - there using increments of [incy], otherwise a fresh vector will be used. - The resulting vector is returned. + [x / (1 + abs(x))] for [n] elements of the vector [x] using [incx] as + incremental steps. If [y] is given, the result will be stored in there using + increments of [incy], otherwise a fresh vector will be used. The resulting + vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @param y default = fresh vector with [ofsy+(n - 1)(abs incy)] rows @param ofsx default = 1 - @param incx default = 1 -*) - + @param incx default = 1 *) (** {6 Binary vector operations} *) val pow : binop -(** [pow ?n ?ofsz ?incz ?z ?ofsx ?incx x ?ofsy ?incy y] computes [pow(a, b)] - of [n] elements of vectors [x] and [y] elementwise, using [incx] and - [incy] as incremental steps respectively. If [z] is given, the result - will be stored in there using increments of [incz], otherwise a fresh - vector will be used. The resulting vector is returned. +(** [pow ?n ?ofsz ?incz ?z ?ofsx ?incx x ?ofsy ?incy y] computes [pow(a, b)] of + [n] elements of vectors [x] and [y] elementwise, using [incx] and [incy] as + incremental steps respectively. If [z] is given, the result will be stored + in there using increments of [incz], otherwise a fresh vector will be used. + The resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsz default = 1 @@ -560,20 +505,19 @@ val pow : binop @param ofsx default = 1 @param incx default = 1 @param ofsy default = 1 - @param incy default = 1 -*) + @param incy default = 1 *) val atan2 : binop -(** [atan2 ?n ?ofsz ?incz ?z ?ofsx ?incx x ?ofsy ?incy y] computes - [atan2(x, y)] of [n] elements of vectors [x] and [y] elementwise, using - [incx] and [incy] as incremental steps respectively. If [z] is given, - the result will be stored in there using increments of [incz], otherwise - a fresh vector will be used. The resulting vector is returned. +(** [atan2 ?n ?ofsz ?incz ?z ?ofsx ?incx x ?ofsy ?incy y] computes [atan2(x, y)] + of [n] elements of vectors [x] and [y] elementwise, using [incx] and [incy] + as incremental steps respectively. If [z] is given, the result will be + stored in there using increments of [incz], otherwise a fresh vector will be + used. The resulting vector is returned. - NOTE: WARNING! From a geometric point of view, the [atan2] function takes - the y-coordinate in [x] and the x-coordinate in [y]. This confusion is - a sad consequence of the C99-standard reversing the argument order for - [atan2] for no good reason. + NOTE: WARNING! From a geometric point of view, the [atan2] function takes + the y-coordinate in [x] and the x-coordinate in [y]. This confusion is a sad + consequence of the C99-standard reversing the argument order for [atan2] for + no good reason. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsz default = 1 @@ -582,15 +526,14 @@ val atan2 : binop @param ofsx default = 1 @param incx default = 1 @param ofsy default = 1 - @param incy default = 1 -*) + @param incy default = 1 *) val hypot : binop (** [hypot ?n ?ofsz ?incz ?z ?ofsx ?incx x ?ofsy ?incy y] computes - [sqrt(x*x + y*y)] of [n] elements of vectors [x] and [y] elementwise, - using [incx] and [incy] as incremental steps respectively. If [z] is - given, the result will be stored in there using increments of [incz], - otherwise a fresh vector will be used. The resulting vector is returned. + [sqrt(x*x + y*y)] of [n] elements of vectors [x] and [y] elementwise, using + [incx] and [incy] as incremental steps respectively. If [z] is given, the + result will be stored in there using increments of [incz], otherwise a fresh + vector will be used. The resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsz default = 1 @@ -599,15 +542,14 @@ val hypot : binop @param ofsx default = 1 @param incx default = 1 @param ofsy default = 1 - @param incy default = 1 -*) + @param incy default = 1 *) val min2 : binop -(** [min2 ?n ?ofsz ?incz ?z ?ofsx ?incx x ?ofsy ?incy y] computes the - minimum of [n] elements of vectors [x] and [y] elementwise, using [incx] - and [incy] as incremental steps respectively. If [z] is given, the result - will be stored in there using increments of [incz], otherwise a fresh - vector will be used. The resulting vector is returned. +(** [min2 ?n ?ofsz ?incz ?z ?ofsx ?incx x ?ofsy ?incy y] computes the minimum of + [n] elements of vectors [x] and [y] elementwise, using [incx] and [incy] as + incremental steps respectively. If [z] is given, the result will be stored + in there using increments of [incz], otherwise a fresh vector will be used. + The resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsz default = 1 @@ -616,15 +558,14 @@ val min2 : binop @param ofsx default = 1 @param incx default = 1 @param ofsy default = 1 - @param incy default = 1 -*) + @param incy default = 1 *) val max2 : binop -(** [max2 ?n ?ofsz ?incz ?z ?ofsx ?incx x ?ofsy ?incy y] computes the - maximum of [n] elements of vectors [x] and [y] elementwise, using [incx] - and [incy] as incremental steps respectively. If [z] is given, the result - will be stored in there using increments of [incz], otherwise a fresh - vector will be used. The resulting vector is returned. +(** [max2 ?n ?ofsz ?incz ?z ?ofsx ?incx x ?ofsy ?incy y] computes the maximum of + [n] elements of vectors [x] and [y] elementwise, using [incx] and [incy] as + incremental steps respectively. If [z] is given, the result will be stored + in there using increments of [incz], otherwise a fresh vector will be used. + The resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsz default = 1 @@ -633,18 +574,15 @@ val max2 : binop @param ofsx default = 1 @param incx default = 1 @param ofsy default = 1 - @param incy default = 1 -*) - + @param incy default = 1 *) (** {6 Miscellaneous functions} *) -val log_sum_exp : ?n : int -> ?ofsx : int -> ?incx : int -> vec -> float +val log_sum_exp : ?n:int -> ?ofsx:int -> ?incx:int -> vec -> float (** [log_sum_exp ?n ?ofsx ?incx x] computes the logarithm of the sum of exponentials of the [n] elements in vector [x], separated by [incx] incremental steps. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) diff --git a/src/vec_SDCZ.h b/src/vec_SDCZ.h index 4c7cfa1..34a0899 100644 --- a/src/vec_SDCZ.h +++ b/src/vec_SDCZ.h @@ -1,10 +1,8 @@ /* File: vec_SDCZ.h - Copyright (C) 2013- + Copyright © 2013- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public @@ -18,17 +16,16 @@ You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ -#include #include "lacaml_macros.h" +#include /* fill_vec */ -CAMLprim value LFUN(fill_vec_stub)( - intnat vN, intnat vOFSX, intnat vINCX, value vX, vNUMBER vA) -{ +CAMLprim value LFUN(fill_vec_stub)(intnat vN, intnat vOFSX, intnat vINCX, + value vX, vNUMBER vA) { CAMLparam1(vX); integer GET_INT(N), GET_INT(INCX); @@ -40,17 +37,18 @@ CAMLprim value LFUN(fill_vec_stub)( INIT_NUMBER(A); - caml_enter_blocking_section(); /* Allow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ if (INCX == 1) /* NOTE: may improve SIMD optimization */ - for (int i = 0; i < N; i++) X_data[i] = A; + for (int i = 0; i < N; i++) + X_data[i] = A; else { if (INCX > 0) { start = X_data; - last = start + N*INCX; + last = start + N * INCX; } else { - start = X_data - (N - 1)*INCX; + start = X_data - (N - 1) * INCX; last = X_data + INCX; }; @@ -60,30 +58,22 @@ CAMLprim value LFUN(fill_vec_stub)( } } - caml_leave_blocking_section(); /* Disallow other threads */ + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(Val_unit); } -CAMLprim value LFUN(fill_vec_stub_bc)( - value vN, value vOFSX, value vINCX, value vX, value vA) -{ - return - LFUN(fill_vec_stub)( - Int_val(vN), - Int_val(vOFSX), - Int_val(vINCX), - vX, - NUMBER_val(vA)); +CAMLprim value LFUN(fill_vec_stub_bc)(value vN, value vOFSX, value vINCX, + value vX, value vA) { + return LFUN(fill_vec_stub)(Int_val(vN), Int_val(vOFSX), Int_val(vINCX), vX, + NUMBER_val(vA)); } /* add_const_vec */ -CAMLprim value LFUN(add_const_vec_stub)( - vNUMBER vC, intnat vN, - intnat vOFSY, intnat vINCY, value vY, - intnat vOFSX, intnat vINCX, value vX) -{ +CAMLprim value LFUN(add_const_vec_stub)(vNUMBER vC, intnat vN, intnat vOFSY, + intnat vINCY, value vY, intnat vOFSX, + intnat vINCX, value vX) { CAMLparam2(vX, vY); NUMBER C; @@ -95,7 +85,7 @@ CAMLprim value LFUN(add_const_vec_stub)( NUMBER *start_src, *last_src, *dst; INIT_NUMBER(C); - caml_enter_blocking_section(); /* Allow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ if (INCX == 1 && INCY == 1) /* NOTE: may improve SIMD optimization */ @@ -106,15 +96,16 @@ CAMLprim value LFUN(add_const_vec_stub)( else { if (INCX > 0) { start_src = X_data; - last_src = start_src + N*INCX; - } - else { - start_src = X_data - (N - 1)*INCX; + last_src = start_src + N * INCX; + } else { + start_src = X_data - (N - 1) * INCX; last_src = X_data + INCX; }; - if (INCY > 0) dst = Y_data; - else dst = Y_data - (N - 1)*INCY; + if (INCY > 0) + dst = Y_data; + else + dst = Y_data - (N - 1) * INCY; while (start_src != last_src) { NUMBER src = *start_src; @@ -124,21 +115,13 @@ CAMLprim value LFUN(add_const_vec_stub)( } } - caml_leave_blocking_section(); /* Disallow other threads */ + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(Val_unit); } -CAMLprim value LFUN(add_const_vec_stub_bc)(value *argv, int __unused argn) -{ - return - LFUN(add_const_vec_stub)( - NUMBER_val(argv[0]), - Int_val(argv[1]), - Int_val(argv[2]), - Int_val(argv[3]), - argv[4], - Int_val(argv[5]), - Int_val(argv[6]), - argv[7]); +CAMLprim value LFUN(add_const_vec_stub_bc)(value *argv, int __unused argn) { + return LFUN(add_const_vec_stub)(NUMBER_val(argv[0]), Int_val(argv[1]), + Int_val(argv[2]), Int_val(argv[3]), argv[4], + Int_val(argv[5]), Int_val(argv[6]), argv[7]); } diff --git a/src/vec_SDCZ.ml b/src/vec_SDCZ.ml index ad17fcd..2fb7ff2 100644 --- a/src/vec_SDCZ.ml +++ b/src/vec_SDCZ.ml @@ -1,29 +1,24 @@ (* File: vec_SDCZ.ml - Copyright (C) 2001- + Copyright © 2001- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umh.ac.be/an/ + Christophe Troestler - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) open Bigarray open Numberxx @@ -33,16 +28,15 @@ open Utils (* Creation of vectors and dimension accessor *) let create = vec_create - let get_y_vec ~loc ~ofsy ~incy ~n y = get_vec loc y_str y ofsy incy n create let get_z_vec ~loc ~ofsz ~incz ~n z = get_vec loc z_str z ofsz incz n create external direct_fill : - n : (int [@untagged]) -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> - a : num_type_arg -> + n:(int[@untagged]) -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> + a:num_type_arg -> unit = "lacaml_NPRECfill_vec_stub_bc" "lacaml_NPRECfill_vec_stub" let make n a = @@ -54,7 +48,9 @@ let make0 n = make n zero let init n f = let v = create n in - for i = 1 to n do v.{i} <- f i done; + for i = 1 to n do + v.{i} <- f i + done; v let dim (vec : vec) = Array1.dim vec @@ -64,7 +60,7 @@ let of_array ar = let n = Array.length ar in let v = create n in for i = 1 to n do - v.{i} <- ar.(i - 1); + v.{i} <- ar.(i - 1) done; v @@ -73,21 +69,23 @@ let to_array (v : vec) = if n = 0 then [||] else let ar = Array.make n v.{1} in - for i = 2 to n do ar.(i - 1) <- v.{i} done; + for i = 2 to n do + ar.(i - 1) <- v.{i} + done; ar let of_list l = let n = List.length l in let v = create n in - let coll ix el = v.{ix} <- el; ix + 1 in + let coll ix el = + v.{ix} <- el; + ix + 1 + in ignore (List.fold_left coll 1 l); v let to_list (v : vec) = - let rec loop i acc = - if i = 0 then acc - else loop (i - 1) (v.{i} :: acc) - in + let rec loop i acc = if i = 0 then acc else loop (i - 1) (v.{i} :: acc) in loop (dim v) [] let append (v1 : vec) (v2 : vec) = @@ -95,22 +93,24 @@ let append (v1 : vec) (v2 : vec) = let n2 = dim v2 in let n = n1 + n2 in let res = create n in - for i = 1 to n1 do res.{i} <- v1.{i} done; - for i = 1 to n2 do res.{i + n1} <- v2.{i} done; + for i = 1 to n1 do + res.{i} <- v1.{i} + done; + for i = 1 to n2 do + res.{i + n1} <- v2.{i} + done; res -let rec coll_size n = function - | [] -> n - | v :: vs -> coll_size (dim v + n) vs +let rec coll_size n = function [] -> n | v :: vs -> coll_size (dim v + n) vs external direct_copy : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_NPRECcopy_stub_bc" "lacaml_NPRECcopy_stub" let concat vs = @@ -126,38 +126,40 @@ let concat vs = let empty = create 0 external direct_linspace : - y : vec -> - a : num_type_arg -> - b : num_type_arg -> - n : (int [@untagged]) -> - unit = "lacaml_NPREClinspace_stub_bc" "lacaml_NPREClinspace_stub" + y:vec -> a:num_type_arg -> b:num_type_arg -> n:(int[@untagged]) -> unit + = "lacaml_NPREClinspace_stub_bc" "lacaml_NPREClinspace_stub" let linspace ?y a b n = let y = match y with - | Some y -> check_vec "Vec.linspace" y_str y n; y - | None -> create n in + | Some y -> + check_vec "Vec.linspace" y_str y n; + y + | None -> create n + in direct_linspace ~y ~a ~b ~n; y external direct_logspace : - y : vec -> - a : num_type_arg -> - b : num_type_arg -> - base : (float [@unboxed]) -> - n : (int [@untagged]) -> + y:vec -> + a:num_type_arg -> + b:num_type_arg -> + base:(float[@unboxed]) -> + n:(int[@untagged]) -> unit = "lacaml_NPREClogspace_stub_bc" "lacaml_NPREClogspace_stub" let logspace ?y a b ?(base = 10.0) n = if base <= 0.0 then invalid_arg "Vec.logspace: base <= 0.0"; let y = match y with - | Some y -> check_vec "Vec.logspace" y_str y n; y - | None -> create n in + | Some y -> + check_vec "Vec.logspace" y_str y n; + y + | None -> create n + in direct_logspace ~y ~a ~b ~base ~n; y - (* Iterators over vectors *) let vec_map_str = "Vec.map" @@ -166,10 +168,12 @@ let map f ?n ?ofsy ?incy ?y ?ofsx ?incx (x : vec) = let ofsx, incx = get_vec_geom vec_map_str x_str ofsx incx in let ofsy, incy = get_vec_geom vec_map_str y_str ofsy incy in let n = get_dim_vec vec_map_str x_str ofsx incx x n_str n in - let min_dim_y = ofsy + (n - 1) * abs incy in + let min_dim_y = ofsy + ((n - 1) * abs incy) in let y = match y with - | Some y -> check_vec vec_map_str y_str y min_dim_y; y + | Some y -> + check_vec vec_map_str y_str y min_dim_y; + y | None -> create min_dim_y in let start, stop = get_vec_start_stop ~incx ~ofsx ~n in @@ -178,7 +182,7 @@ let map f ?n ?ofsy ?incy ?y ?ofsx ?incx (x : vec) = while !i_ref <> stop do y.{!j_ref} <- f x.{!i_ref}; i_ref := !i_ref + incx; - j_ref := !j_ref + incy; + j_ref := !j_ref + incy done; y @@ -192,7 +196,7 @@ let iter f ?n ?ofsx ?incx (x : vec) = while !i_ref <> stop do let i = !i_ref in f x.{i}; - i_ref := i + incx; + i_ref := i + incx done let vec_iteri_str = "Vec.iteri" @@ -205,7 +209,7 @@ let iteri f ?n ?ofsx ?incx (x : vec) = while !i_ref <> stop do let i = !i_ref in f i x.{i}; - i_ref := i + incx; + i_ref := i + incx done let vec_fold_str = "Vec.fold" @@ -215,12 +219,10 @@ let fold f acc ?n ?ofsx ?incx (x : vec) = let n = get_dim_vec vec_fold_str x_str ofsx incx x n_str n in let start, stop = get_vec_start_stop ~incx ~ofsx ~n in let rec loop acc i = - if i = stop then acc - else loop (f acc x.{i}) (i + incx) + if i = stop then acc else loop (f acc x.{i}) (i + incx) in loop acc start - (* Operations on one vector *) (* REV *) @@ -246,10 +248,10 @@ let fill ?n ?ofsx ?incx x a = (* MAX *) external direct_max : - n : (int [@untagged]) -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> num_type_arg = "lacaml_NPRECmax_stub_bc" "lacaml_NPRECmax_stub" let vec_max_str = "Vec.max" @@ -264,10 +266,10 @@ let max ?n ?ofsx ?incx x = let vec_min_str = "Vec.min" external direct_min : - n : (int [@untagged]) -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> num_type_arg = "lacaml_NPRECmin_stub_bc" "lacaml_NPRECmin_stub" let min ?n ?ofsx ?incx x = @@ -278,10 +280,10 @@ let min ?n ?ofsx ?incx x = (* SUM *) external direct_sum : - n : (int [@untagged]) -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> num_type_arg = "lacaml_NPRECsum_vec_stub_bc" "lacaml_NPRECsum_vec_stub" let vec_sum_str = "Vec.sum" @@ -296,10 +298,10 @@ let sum ?n ?ofsx ?incx x = let vec_prod_str = "Vec.prod" external direct_prod : - n : (int [@untagged]) -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> num_type_arg = "lacaml_NPRECprod_stub_bc" "lacaml_NPRECprod_stub" let prod ?n ?ofsx ?incx x = @@ -310,14 +312,14 @@ let prod ?n ?ofsx ?incx x = (* ADD_CONST *) external direct_add_const : - c : num_type_arg -> - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + c:num_type_arg -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_NPRECadd_const_vec_stub_bc" "lacaml_NPRECadd_const_vec_stub" let vec_add_const_str = "Vec.add_const" @@ -333,13 +335,12 @@ let add_const c ?n ?ofsy ?incy ?y ?ofsx ?incx x = (* SQR_NRM2 *) external direct_sqr_nrm2 : - stable : bool -> - n : (int [@untagged]) -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> - (float [@unboxed]) - = "lacaml_NPRECsqr_nrm2_stub_bc" "lacaml_NPRECsqr_nrm2_stub" + stable:bool -> + n:(int[@untagged]) -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> + (float[@unboxed]) = "lacaml_NPRECsqr_nrm2_stub_bc" "lacaml_NPRECsqr_nrm2_stub" let sqr_nrm2 ?(stable = false) ?n ?ofsx ?incx x = let loc = "Vec.sqr_nrm2" in @@ -350,18 +351,18 @@ let sqr_nrm2 ?(stable = false) ?n ?ofsx ?incx x = (* SSQR *) external direct_ssqr : - n : (int [@untagged]) -> - c : num_type_arg -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + c:num_type_arg -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> num_type_arg = "lacaml_NPRECssqr_stub_bc" "lacaml_NPRECssqr_stub" external direct_ssqr_zero : - n : (int [@untagged]) -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> num_type_arg = "lacaml_NPRECssqr_zero_stub_bc" "lacaml_NPRECssqr_zero_stub" let vec_ssqr_str = "Vec.ssqr" @@ -378,60 +379,65 @@ let ssqr ?n ?c ?ofsx ?incx x = (* SORT *) external direct_sort_incr : - cmp : (num_type -> num_type -> int) -> (* not used, ususal order *) - n : (int [@untagged]) -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + cmp:(num_type -> num_type -> int) -> + (* not used, ususal order *) + n:(int[@untagged]) -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_NPRECsort_incr_bc" "lacaml_NPRECsort_incr" external direct_sort_incr_perm : - cmp : (num_type -> num_type -> int) -> (* not used, ususal order *) - n : (int [@untagged]) -> - ofsp : (int [@untagged]) -> - incp : (int [@untagged]) -> - p : int_vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + cmp:(num_type -> num_type -> int) -> + (* not used, ususal order *) + n:(int[@untagged]) -> + ofsp:(int[@untagged]) -> + incp:(int[@untagged]) -> + p:int_vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_NPRECsort_incr_perm_bc" "lacaml_NPRECsort_incr_perm" external direct_sort_decr : - cmp : (num_type -> num_type -> int) -> (* not used, usual decreasing order *) - n : (int [@untagged]) -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + cmp:(num_type -> num_type -> int) -> + (* not used, usual decreasing order *) + n:(int[@untagged]) -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_NPRECsort_decr_bc" "lacaml_NPRECsort_decr" external direct_sort_decr_perm : - cmp : (num_type -> num_type -> int) -> (* not used, ususal order *) - n : (int [@untagged]) -> - ofsp : (int [@untagged]) -> - incp : (int [@untagged]) -> - p : int_vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + cmp:(num_type -> num_type -> int) -> + (* not used, ususal order *) + n:(int[@untagged]) -> + ofsp:(int[@untagged]) -> + incp:(int[@untagged]) -> + p:int_vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_NPRECsort_decr_perm_bc" "lacaml_NPRECsort_decr_perm" external direct_sort : - cmp : (num_type -> num_type -> int) -> - n : (int [@untagged]) -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + cmp:(num_type -> num_type -> int) -> + n:(int[@untagged]) -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_NPRECsort_bc" "lacaml_NPRECsort" external direct_sort_perm : - cmp : (num_type -> num_type -> int) -> (* not used, ususal order *) - n : (int [@untagged]) -> - ofsp : (int [@untagged]) -> - incp : (int [@untagged]) -> - p : int_vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + cmp:(num_type -> num_type -> int) -> + (* not used, ususal order *) + n:(int[@untagged]) -> + ofsp:(int[@untagged]) -> + incp:(int[@untagged]) -> + p:int_vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_NPRECsort_perm_bc" "lacaml_NPRECsort_perm" let vec_sort_str = "Vec.sort" @@ -442,39 +448,39 @@ let sort ?cmp ?(decr = false) ?n ?ofsp ?incp ?p ?ofsx ?incx x = let ofsx, incx = get_vec_geom vec_sort_str x_str ofsx incx in let n = get_dim_vec vec_sort_str x_str ofsx incx x n_str n in match p with - | None -> - (match cmp with - | None -> - if decr then direct_sort_decr ~cmp:dummy_cmp ~n ~ofsx ~incx ~x - else direct_sort_incr ~cmp:dummy_cmp ~n ~ofsx ~incx ~x - | Some cmp -> - let cmp = if decr then (fun x1 x2 -> cmp x2 x1) else cmp in - direct_sort ~cmp ~n ~ofsx ~incx ~x - ) - | Some p -> + | None -> ( + match cmp with + | None -> + if decr then direct_sort_decr ~cmp:dummy_cmp ~n ~ofsx ~incx ~x + else direct_sort_incr ~cmp:dummy_cmp ~n ~ofsx ~incx ~x + | Some cmp -> + let cmp = if decr then fun x1 x2 -> cmp x2 x1 else cmp in + direct_sort ~cmp ~n ~ofsx ~incx ~x) + | Some p -> ( let ofsp, incp = get_vec_geom vec_sort_str p_str ofsp incp in check_vec vec_sort_str p_str p n; - (match cmp with - | None -> - if decr then direct_sort_decr_perm ~cmp:dummy_cmp ~n - ~ofsp ~incp ~p ~ofsx ~incx ~x - else direct_sort_incr_perm ~cmp:dummy_cmp ~n - ~ofsp ~incp ~p ~ofsx ~incx ~x - | Some cmp -> - let cmp = if decr then (fun x1 x2 -> cmp x2 x1) else cmp in - direct_sort_perm ~cmp ~n ~ofsp ~incp ~p ~ofsx ~incx ~x - ) + match cmp with + | None -> + if decr then + direct_sort_decr_perm ~cmp:dummy_cmp ~n ~ofsp ~incp ~p ~ofsx ~incx + ~x + else + direct_sort_incr_perm ~cmp:dummy_cmp ~n ~ofsp ~incp ~p ~ofsx ~incx + ~x + | Some cmp -> + let cmp = if decr then fun x1 x2 -> cmp x2 x1 else cmp in + direct_sort_perm ~cmp ~n ~ofsp ~incp ~p ~ofsx ~incx ~x) (* NEG *) external direct_neg : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_NPRECneg_stub_bc" "lacaml_NPRECneg_stub" let vec_neg_str = "Vec.neg" @@ -490,13 +496,13 @@ let neg ?n ?ofsy ?incy ?y ?ofsx ?incx x = (* RECI *) external direct_reci : - n : (int [@untagged]) -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> + n:(int[@untagged]) -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> unit = "lacaml_NPRECreci_stub_bc" "lacaml_NPRECreci_stub" let vec_reci_loc = "Vec.reci" @@ -509,22 +515,21 @@ let reci ?n ?ofsy ?incy ?y ?ofsx ?incx x = direct_reci ~n ~ofsy ~incy ~y ~ofsx ~incx ~x; y - (* Operations on two vectors *) (* ADD *) external direct_add : - n : (int [@untagged]) -> - ofsz : (int [@untagged]) -> - incz : (int [@untagged]) -> - z : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> + n:(int[@untagged]) -> + ofsz:(int[@untagged]) -> + incz:(int[@untagged]) -> + z:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> unit = "lacaml_NPRECadd_stub_bc" "lacaml_NPRECadd_stub" let vec_add_str = "Vec.add" @@ -534,25 +539,24 @@ let add ?n ?ofsz ?incz ?z ?ofsx ?incx x ?ofsy ?incy y = and ofsx, incx = get_vec_geom vec_add_str x_str ofsx incx and ofsy, incy = get_vec_geom vec_add_str y_str ofsy incy in let n = get_dim_vec vec_add_str x_str ofsx incx x n_str n in - check_vec vec_add_str y_str y (ofsy + (n - 1) * abs incy); + check_vec vec_add_str y_str y (ofsy + ((n - 1) * abs incy)); let z = get_z_vec ~loc:vec_add_str ~ofsz ~incz ~n z in direct_add ~n ~ofsz ~incz ~z ~ofsx ~incx ~x ~ofsy ~incy ~y; z - (* SUB *) external direct_sub : - n : (int [@untagged]) -> - ofsz : (int [@untagged]) -> - incz : (int [@untagged]) -> - z : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> + n:(int[@untagged]) -> + ofsz:(int[@untagged]) -> + incz:(int[@untagged]) -> + z:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> unit = "lacaml_NPRECsub_stub_bc" "lacaml_NPRECsub_stub" let vec_sub_str = "Vec.sub" @@ -562,25 +566,24 @@ let sub ?n ?ofsz ?incz ?z ?ofsx ?incx x ?ofsy ?incy y = and ofsx, incx = get_vec_geom vec_sub_str x_str ofsx incx and ofsy, incy = get_vec_geom vec_sub_str y_str ofsy incy in let n = get_dim_vec vec_sub_str x_str ofsx incx x n_str n in - check_vec vec_sub_str y_str y (ofsy + (n - 1) * abs incy); + check_vec vec_sub_str y_str y (ofsy + ((n - 1) * abs incy)); let z = get_z_vec ~loc:vec_sub_str ~ofsz ~incz ~n z in direct_sub ~n ~ofsz ~incz ~z ~ofsx ~incx ~x ~ofsy ~incy ~y; z - (* MUL *) external direct_mul : - n : (int [@untagged]) -> - ofsz : (int [@untagged]) -> - incz : (int [@untagged]) -> - z : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> + n:(int[@untagged]) -> + ofsz:(int[@untagged]) -> + incz:(int[@untagged]) -> + z:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> unit = "lacaml_NPRECmul_stub_bc" "lacaml_NPRECmul_stub" let vec_mul_str = "Vec.mul" @@ -590,7 +593,7 @@ let mul ?n ?ofsz ?incz ?z ?ofsx ?incx x ?ofsy ?incy y = and ofsx, incx = get_vec_geom vec_mul_str x_str ofsx incx and ofsy, incy = get_vec_geom vec_mul_str y_str ofsy incy in let n = get_dim_vec vec_mul_str x_str ofsx incx x n_str n in - check_vec vec_mul_str y_str y (ofsy + (n - 1) * abs incy); + check_vec vec_mul_str y_str y (ofsy + ((n - 1) * abs incy)); let z = get_z_vec ~loc:vec_mul_str ~ofsz ~incz ~n z in direct_mul ~n ~ofsz ~incz ~z ~ofsx ~incx ~x ~ofsy ~incy ~y; z @@ -598,16 +601,16 @@ let mul ?n ?ofsz ?incz ?z ?ofsx ?incx x ?ofsy ?incy y = (* DIV *) external direct_div : - n : (int [@untagged]) -> - ofsz : (int [@untagged]) -> - incz : (int [@untagged]) -> - z : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> + n:(int[@untagged]) -> + ofsz:(int[@untagged]) -> + incz:(int[@untagged]) -> + z:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> unit = "lacaml_NPRECdiv_stub_bc" "lacaml_NPRECdiv_stub" let vec_div_str = "Vec.div" @@ -617,7 +620,7 @@ let div ?n ?ofsz ?incz ?z ?ofsx ?incx x ?ofsy ?incy y = and ofsx, incx = get_vec_geom vec_div_str x_str ofsx incx and ofsy, incy = get_vec_geom vec_div_str y_str ofsy incy in let n = get_dim_vec vec_div_str x_str ofsx incx x n_str n in - check_vec vec_div_str y_str y (ofsy + (n - 1) * abs incy); + check_vec vec_div_str y_str y (ofsy + ((n - 1) * abs incy)); let z = get_z_vec ~loc:vec_div_str ~ofsz ~incz ~n z in direct_div ~n ~ofsz ~incz ~z ~ofsx ~incx ~x ~ofsy ~incy ~y; z @@ -625,16 +628,16 @@ let div ?n ?ofsz ?incz ?z ?ofsx ?incx x ?ofsy ?incy y = (* ZPXY *) external direct_zpxy : - n : (int [@untagged]) -> - ofsz : (int [@untagged]) -> - incz : (int [@untagged]) -> - z : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> + n:(int[@untagged]) -> + ofsz:(int[@untagged]) -> + incz:(int[@untagged]) -> + z:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> unit = "lacaml_NPRECzpxy_stub_bc" "lacaml_NPRECzpxy_stub" let vec_zpxy_str = "Vec.zpxy" @@ -644,23 +647,23 @@ let zpxy ?n ?ofsz ?incz z ?ofsx ?incx x ?ofsy ?incy y = and ofsx, incx = get_vec_geom vec_zpxy_str x_str ofsx incx and ofsy, incy = get_vec_geom vec_zpxy_str y_str ofsy incy in let n = get_dim_vec vec_zpxy_str x_str ofsx incx x n_str n in - check_vec vec_zpxy_str y_str y (ofsy + (n - 1) * abs incy); - check_vec vec_zpxy_str z_str z (ofsz + (n - 1) * abs incz); + check_vec vec_zpxy_str y_str y (ofsy + ((n - 1) * abs incy)); + check_vec vec_zpxy_str z_str z (ofsz + ((n - 1) * abs incz)); direct_zpxy ~n ~ofsz ~incz ~z ~ofsx ~incx ~x ~ofsy ~incy ~y (* ZMXY *) external direct_zmxy : - n : (int [@untagged]) -> - ofsz : (int [@untagged]) -> - incz : (int [@untagged]) -> - z : vec -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> + n:(int[@untagged]) -> + ofsz:(int[@untagged]) -> + incz:(int[@untagged]) -> + z:vec -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> unit = "lacaml_NPRECzmxy_stub_bc" "lacaml_NPRECzmxy_stub" let vec_zmxy_str = "Vec.zmxy" @@ -670,20 +673,20 @@ let zmxy ?n ?ofsz ?incz z ?ofsx ?incx x ?ofsy ?incy y = and ofsx, incx = get_vec_geom vec_zmxy_str x_str ofsx incx and ofsy, incy = get_vec_geom vec_zmxy_str y_str ofsy incy in let n = get_dim_vec vec_zmxy_str x_str ofsx incx x n_str n in - check_vec vec_zmxy_str y_str y (ofsy + (n - 1) * abs incy); - check_vec vec_zpxy_str z_str z (ofsz + (n - 1) * abs incz); + check_vec vec_zmxy_str y_str y (ofsy + ((n - 1) * abs incy)); + check_vec vec_zpxy_str z_str z (ofsz + ((n - 1) * abs incz)); direct_zmxy ~n ~ofsz ~incz ~z ~ofsx ~incx ~x ~ofsy ~incy ~y (* SSQR_DIFF *) external direct_ssqr_diff : - n : (int [@untagged]) -> - ofsx : (int [@untagged]) -> - incx : (int [@untagged]) -> - x : vec -> - ofsy : (int [@untagged]) -> - incy : (int [@untagged]) -> - y : vec -> + n:(int[@untagged]) -> + ofsx:(int[@untagged]) -> + incx:(int[@untagged]) -> + x:vec -> + ofsy:(int[@untagged]) -> + incy:(int[@untagged]) -> + y:vec -> num_type_arg = "lacaml_NPRECssqr_diff_stub_bc" "lacaml_NPRECssqr_diff_stub" let vec_ssqr_diff_str = "Vec.ssqr_diff" @@ -692,5 +695,5 @@ let ssqr_diff ?n ?ofsx ?incx x ?ofsy ?incy y = let ofsx, incx = get_vec_geom vec_ssqr_diff_str x_str ofsx incx and ofsy, incy = get_vec_geom vec_ssqr_diff_str y_str ofsy incy in let n = get_dim_vec vec_ssqr_diff_str x_str ofsx incx x n_str n in - check_vec vec_ssqr_diff_str y_str y (ofsy + (n - 1) * abs incy); + check_vec vec_ssqr_diff_str y_str y (ofsy + ((n - 1) * abs incy)); direct_ssqr_diff ~n ~ofsx ~incx ~x ~ofsy ~incy ~y diff --git a/src/vec_SDCZ.mli b/src/vec_SDCZ.mli index 6d19347..47189fb 100644 --- a/src/vec_SDCZ.mli +++ b/src/vec_SDCZ.mli @@ -1,29 +1,24 @@ (* File: vec_SDCZ.mli - Copyright (C) 2001- + Copyright © 2001- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umh.ac.be/an/ + Christophe Troestler - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) open Common open Numberxx @@ -68,12 +63,12 @@ val concat : vec list -> vec val empty : vec (** [empty], the empty vector. *) -val linspace : ?y : vec -> num_type -> num_type -> int -> vec +val linspace : ?y:vec -> num_type -> num_type -> int -> vec (** [linspace ?z a b n] @return the vector [y] overwritten with [n] linearly spaced points between and including [a] and [b]. @param y default = fresh vector of dim [n] *) -val logspace : ?y : vec -> num_type -> num_type -> ?base : float -> int -> vec +val logspace : ?y:vec -> num_type -> num_type -> ?base:float -> int -> vec (** [logspace ?z a b base n] @return the vector [y] overwritten with [n] points logarithmically spaced using base [b] between and including [base] ** [a] and [base] ** [b]. @@ -85,21 +80,20 @@ val dim : vec -> int val has_zero_dim : vec -> bool (** [has_zero_dim vec] checks whether vector [vec] has a dimension of size - [zero]. In this case it cannot contain data. *) - + [zero]. In this case it cannot contain data. *) (** {6 Iterators over vectors} *) val map : (num_type -> num_type) -> - ?n : int -> - ?ofsy : int -> - ?incy : int -> - ?y : vec -> - ?ofsx : int -> - ?incx : int -> + ?n:int -> + ?ofsy:int -> + ?incy:int -> + ?y:vec -> + ?ofsx:int -> + ?incx:int -> + vec -> vec - -> vec (** [map f ?n ?ofsx ?incx x] @return a new vector resulting from the application of [f] to each element of [x]. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @@ -109,125 +103,103 @@ val map : @param ofsx default = 1 @param incx default = 1 *) -val iter : - (num_type -> unit) -> - ?n : int -> - ?ofsx : int -> - ?incx : int -> - vec - -> unit -(** [iter ?n ?ofsx ?incx f x] applies function [f] in turn to all elements - of vector [x]. +val iter : (num_type -> unit) -> ?n:int -> ?ofsx:int -> ?incx:int -> vec -> unit +(** [iter ?n ?ofsx ?incx f x] applies function [f] in turn to all elements of + vector [x]. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsx default = 1 @param incx default = 1 *) val iteri : - (int -> num_type -> unit) -> - ?n : int -> - ?ofsx : int -> - ?incx : int -> - vec - -> unit -(** [iteri ?n ?ofsx ?incx f x] same as [iter] but additionally passes - the index of the element as first argument and the element itself - as second argument. *) + (int -> num_type -> unit) -> ?n:int -> ?ofsx:int -> ?incx:int -> vec -> unit +(** [iteri ?n ?ofsx ?incx f x] same as [iter] but additionally passes the index + of the element as first argument and the element itself as second argument. *) val fold : - ('a -> num_type -> 'a) -> - 'a -> - ?n : int -> - ?ofsx : int -> - ?incx : int -> - vec - -> 'a + ('a -> num_type -> 'a) -> 'a -> ?n:int -> ?ofsx:int -> ?incx:int -> vec -> 'a (** [fold f a ?n ?ofsx ?incx x] is - [f (... (f (f a x.{ofsx}) x.{ofsx + incx}) ...) x.{ofsx + (n-1)*incx}] - if [incx > 0] and the same in the reverse order of appearance of the - [x] values if [incx < 0]. + [f (... (f (f a x.{ofsx}) x.{ofsx + incx}) ...) x.{ofsx + (n-1)*incx}] if + [incx > 0] and the same in the reverse order of appearance of the [x] values + if [incx < 0]. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsx default = 1 @param incx default = 1 *) - (** {6 Operations on one vector} *) val rev : vec -> vec (** [rev x] reverses vector [x] (non-destructive). *) -val max : ?n : int -> ?ofsx : int -> ?incx : int -> vec -> num_type -(** [max ?n ?ofsx ?incx x] computes the greater of the [n] elements - in vector [x] (2-norm), separated by [incx] incremental steps. NaNs - are ignored. If only NaNs are encountered, the negative [infinity] - value will be returned. +val max : ?n:int -> ?ofsx:int -> ?incx:int -> vec -> num_type +(** [max ?n ?ofsx ?incx x] computes the greater of the [n] elements in vector + [x] (2-norm), separated by [incx] incremental steps. NaNs are ignored. If + only NaNs are encountered, the negative [infinity] value will be returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsx default = 1 @param incx default = 1 *) -val min : ?n : int -> ?ofsx : int -> ?incx : int -> vec -> num_type -(** [min ?n ?ofsx ?incx x] computes the smaller of the [n] elements - in vector [x] (2-norm), separated by [incx] incremental steps. - NaNs are ignored. If only NaNs are encountered, the [infinity] value - will be returned. +val min : ?n:int -> ?ofsx:int -> ?incx:int -> vec -> num_type +(** [min ?n ?ofsx ?incx x] computes the smaller of the [n] elements in vector + [x] (2-norm), separated by [incx] incremental steps. NaNs are ignored. If + only NaNs are encountered, the [infinity] value will be returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsx default = 1 @param incx default = 1 *) val sort : - ?cmp : (num_type -> num_type -> int) -> - ?decr : bool -> - ?n : int -> - ?ofsp : int -> - ?incp : int -> - ?p : int_vec -> - ?ofsx : int -> - ?incx : int -> - vec - -> unit -(** [sort ?cmp ?n ?ofsx ?incx x] sorts the array [x] in increasing - order according to the comparison function [cmp]. - - @param cmp a function such that [cmp a b < 0] if [a] is less than - [b], [cmp a b = 0] if [a] equal [b] and [cmp a b > 0] if [a] is - greater than [b] for the desired order. Default: the usual - order on floating point values or the lexicographic order on - complex ones (a special routine makes it fast). Whatever the - order you choose, NaNs (in any component for complex numbers) - are considered larger than any other value (so they will be - last, in no specified order, in the sorted vector). Therefore, - NaN are never passed to [cmp]. - - @param p if you pass a vector of size [ofsp+(n - 1)(abs incp)], - the vector [x] will be unchanged and the permutation to sort it - will be stored in [p]. Thus [x.{p.{ofsp + (i-1) * incp}}] will - give the elements of [x] in increasing order. Default: no - vector is provided. + ?cmp:(num_type -> num_type -> int) -> + ?decr:bool -> + ?n:int -> + ?ofsp:int -> + ?incp:int -> + ?p:int_vec -> + ?ofsx:int -> + ?incx:int -> + vec -> + unit +(** [sort ?cmp ?n ?ofsx ?incx x] sorts the array [x] in increasing order + according to the comparison function [cmp]. + + @param cmp + a function such that [cmp a b < 0] if [a] is less than [b], [cmp a b = 0] + if [a] equal [b] and [cmp a b > 0] if [a] is greater than [b] for the + desired order. Default: the usual order on floating point values or the + lexicographic order on complex ones (a special routine makes it fast). + Whatever the order you choose, NaNs (in any component for complex numbers) + are considered larger than any other value (so they will be last, in no + specified order, in the sorted vector). Therefore, NaN are never passed to + [cmp]. + + @param p + if you pass a vector of size [ofsp+(n - 1)(abs incp)], the vector [x] will + be unchanged and the permutation to sort it will be stored in [p]. Thus + [x.{p.{ofsp + (i-1) * incp}}] will give the elements of [x] in increasing + order. Default: no vector is provided. @param decr sort in decreasing order (stays fast for the default [cmp]). @param n default = greater [n] s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsp default = 1 @param incp default = 1 @param ofsx default = 1 - @param incx default = 1 - *) + @param incx default = 1 *) -val fill : ?n : int -> ?ofsx : int -> ?incx : int -> vec -> num_type -> unit -(** [fill ?n ?ofsx ?incx x a] fills vector [x] with value [a] in the - designated range. +val fill : ?n:int -> ?ofsx:int -> ?incx:int -> vec -> num_type -> unit +(** [fill ?n ?ofsx ?incx x a] fills vector [x] with value [a] in the designated + range. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsx default = 1 @param incx default = 1 *) -val sum : ?n : int -> ?ofsx : int -> ?incx : int -> vec -> num_type -(** [sum ?n ?ofsx ?incx x] computes the sum of the [n] elements in - vector [x], separated by [incx] incremental steps. +val sum : ?n:int -> ?ofsx:int -> ?incx:int -> vec -> num_type +(** [sum ?n ?ofsx ?incx x] computes the sum of the [n] elements in vector [x], + separated by [incx] incremental steps. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsx default = 1 @param incx default = 1 *) -val prod : ?n : int -> ?ofsx : int -> ?incx : int -> vec -> num_type -(** [prod ?n ?ofsx ?incx x] computes the product of the [n] elements - in vector [x], separated by [incx] incremental steps. +val prod : ?n:int -> ?ofsx:int -> ?incx:int -> vec -> num_type +(** [prod ?n ?ofsx ?incx x] computes the product of the [n] elements in vector + [x], separated by [incx] incremental steps. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsx default = 1 @param incx default = 1 *) @@ -235,9 +207,9 @@ val prod : ?n : int -> ?ofsx : int -> ?incx : int -> vec -> num_type val add_const : num_type -> unop (** [add_const c ?n ?ofsy ?incy ?y ?ofsx ?incx x] adds constant [c] to the [n] elements of vector [x] and stores the result in [y], using [incx] and [incy] - as incremental steps respectively. If [y] is given, the result will - be stored in there using increments of [incy], otherwise a fresh - vector will be used. The resulting vector is returned. + as incremental steps respectively. If [y] is given, the result will be + stored in there using increments of [incy], otherwise a fresh vector will be + used. The resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @@ -245,49 +217,38 @@ val add_const : num_type -> unop @param ofsx default = 1 @param incx default = 1 *) -val sqr_nrm2 : - ?stable : bool -> ?n : int -> ?ofsx : int -> ?incx : int -> vec -> float -(** [sqr_nrm2 ?stable ?n ?c ?ofsx ?incx x] computes the square of - the 2-norm (Euclidean norm) of vector [x] separated by [incx] - incremental steps. If [stable] is true, this is equivalent to - squaring the result of calling the BLAS-function [nrm2], which - avoids over- and underflow if possible. If [stable] is false - (default), [dot] will be called instead for greatly improved - performance. +val sqr_nrm2 : ?stable:bool -> ?n:int -> ?ofsx:int -> ?incx:int -> vec -> float +(** [sqr_nrm2 ?stable ?n ?c ?ofsx ?incx x] computes the square of the 2-norm + (Euclidean norm) of vector [x] separated by [incx] incremental steps. If + [stable] is true, this is equivalent to squaring the result of calling the + BLAS-function [nrm2], which avoids over- and underflow if possible. If + [stable] is false (default), [dot] will be called instead for greatly + improved performance. @param stable default = [false] @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) -val ssqr : - ?n : int -> - ?c : num_type -> - ?ofsx : int -> - ?incx : int -> - vec - -> num_type -(** [ssqr ?n ?c ?ofsx ?incx x] computes the sum of squared differences - of the [n] elements in vector [x] from constant [c], separated - by [incx] incremental steps. Please do not confuse with - {!sqr_nrm2}! The current function behaves differently with - complex numbers when zero is passed in for [c]. It computes - the square for each entry then, whereas {!sqr_nrm2} uses the - conjugate transpose in the product. The latter will therefore - always return a real number. +val ssqr : ?n:int -> ?c:num_type -> ?ofsx:int -> ?incx:int -> vec -> num_type +(** [ssqr ?n ?c ?ofsx ?incx x] computes the sum of squared differences of the + [n] elements in vector [x] from constant [c], separated by [incx] + incremental steps. Please do not confuse with {!sqr_nrm2}! The current + function behaves differently with complex numbers when zero is passed in for + [c]. It computes the square for each entry then, whereas {!sqr_nrm2} uses + the conjugate transpose in the product. The latter will therefore always + return a real number. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param c default = zero @param ofsx default = 1 - @param incx default = 1 -*) + @param incx default = 1 *) val neg : unop -(** [neg ?n ?ofsy ?incy ?y ?ofsx ?incx x] negates [n] elements of the - vector [x] using [incx] as incremental steps. If [y] is given, - the result will be stored in there using increments of [incy], - otherwise a fresh vector will be used. The resulting vector is returned. +(** [neg ?n ?ofsy ?incy ?y ?ofsx ?incx x] negates [n] elements of the vector [x] + using [incx] as incremental steps. If [y] is given, the result will be + stored in there using increments of [incy], otherwise a fresh vector will be + used. The resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @@ -296,29 +257,26 @@ val neg : unop @param incx default = 1 *) val reci : unop -(** [reci ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the reciprocal value - of [n] elements of the vector [x] using [incx] as incremental steps. - If [y] is given, the result will be stored in there using increments of - [incy], otherwise a fresh vector will be used. The resulting vector - is returned. +(** [reci ?n ?ofsy ?incy ?y ?ofsx ?incx x] computes the reciprocal value of [n] + elements of the vector [x] using [incx] as incremental steps. If [y] is + given, the result will be stored in there using increments of [incy], + otherwise a fresh vector will be used. The resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsy default = 1 @param incy default = 1 @param y default = fresh vector with [ofsy+(n - 1)(abs incy)] rows @param ofsx default = 1 - @param incx default = 1 -*) - + @param incx default = 1 *) (** {6 Operations on two vectors} *) val add : binop -(** [add ?n ?ofsz ?incz ?z ?ofsx ?incx x ?ofsy ?incy y] adds [n] - elements of vectors [x] and [y] elementwise, using [incx] and [incy] - as incremental steps respectively. If [z] is given, the result will - be stored in there using increments of [incz], otherwise a fresh - vector will be used. The resulting vector is returned. +(** [add ?n ?ofsz ?incz ?z ?ofsx ?incx x ?ofsy ?incy y] adds [n] elements of + vectors [x] and [y] elementwise, using [incx] and [incy] as incremental + steps respectively. If [z] is given, the result will be stored in there + using increments of [incz], otherwise a fresh vector will be used. The + resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsz default = 1 @param incz default = 1 @@ -329,11 +287,11 @@ val add : binop @param incy default = 1 *) val sub : binop -(** [sub ?n ?ofsz ?incz ?z ?ofsx ?incx x ?ofsy ?incy y] subtracts [n] - elements of vectors [x] and [y] elementwise, using [incx] and [incy] - as incremental steps respectively. If [z] is given, the result will - be stored in there using increments of [incz], otherwise a fresh - vector will be used. The resulting vector is returned. +(** [sub ?n ?ofsz ?incz ?z ?ofsx ?incx x ?ofsy ?incy y] subtracts [n] elements + of vectors [x] and [y] elementwise, using [incx] and [incy] as incremental + steps respectively. If [z] is given, the result will be stored in there + using increments of [incz], otherwise a fresh vector will be used. The + resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsz default = 1 @param incz default = 1 @@ -344,11 +302,11 @@ val sub : binop @param incy default = 1 *) val mul : binop -(** [mul ?n ?ofsz ?incz ?z ?ofsx ?incx x ?ofsy ?incy y] multiplies - [n] elements of vectors [x] and [y] elementwise, using [incx] - and [incy] as incremental steps respectively. If [z] is given, the - result will be stored in there using increments of [incz], otherwise - a fresh vector will be used. The resulting vector is returned. +(** [mul ?n ?ofsz ?incz ?z ?ofsx ?incx x ?ofsy ?incy y] multiplies [n] elements + of vectors [x] and [y] elementwise, using [incx] and [incy] as incremental + steps respectively. If [z] is given, the result will be stored in there + using increments of [incz], otherwise a fresh vector will be used. The + resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsz default = 1 @param incz default = 1 @@ -359,11 +317,11 @@ val mul : binop @param incy default = 1 *) val div : binop -(** [div ?n ?ofsz ?incz ?z ?ofsx ?incx x ?ofsy ?incy y] divides [n] - elements of vectors [x] and [y] elementwise, using [incx] and [incy] - as incremental steps respectively. If [z] is given, the result will - be stored in there using increments of [incz], otherwise a fresh - vector will be used. The resulting vector is returned. +(** [div ?n ?ofsz ?incz ?z ?ofsx ?incx x ?ofsy ?incy y] divides [n] elements of + vectors [x] and [y] elementwise, using [incx] and [incy] as incremental + steps respectively. If [z] is given, the result will be stored in there + using increments of [incz], otherwise a fresh vector will be used. The + resulting vector is returned. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsz default = 1 @param incz default = 1 @@ -374,21 +332,21 @@ val div : binop @param incy default = 1 *) val zpxy : - ?n : int -> - ?ofsz : int -> - ?incz : int -> + ?n:int -> + ?ofsz:int -> + ?incz:int -> vec -> - ?ofsx : int -> - ?incx : int -> + ?ofsx:int -> + ?incx:int -> vec -> - ?ofsy : int -> - ?incy : int -> - vec - -> unit -(** [zpxy ?n ?ofsz ?incz z ?ofsx ?incx x ?ofsy ?incy y] multiplies [n] - elements of vectors [x] and [y] elementwise, using [incx] and [incy] - as incremental steps respectively, and adds the result to and stores it - in the specified range in [z]. This function is useful for convolutions. + ?ofsy:int -> + ?incy:int -> + vec -> + unit +(** [zpxy ?n ?ofsz ?incz z ?ofsx ?incx x ?ofsy ?incy y] multiplies [n] elements + of vectors [x] and [y] elementwise, using [incx] and [incy] as incremental + steps respectively, and adds the result to and stores it in the specified + range in [z]. This function is useful for convolutions. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsz default = 1 @@ -399,22 +357,21 @@ val zpxy : @param incy default = 1 *) val zmxy : - ?n : int -> - ?ofsz : int -> - ?incz : int -> + ?n:int -> + ?ofsz:int -> + ?incz:int -> vec -> - ?ofsx : int -> - ?incx : int -> + ?ofsx:int -> + ?incx:int -> vec -> - ?ofsy : int -> - ?incy : int -> - vec - -> unit -(** [zmxy ?n ?ofsz ?incz z ?ofsx ?incx x ?ofsy ?incy y] multiplies [n] - elements of vectors [x] and [y] elementwise, using [incx] and [incy] - as incremental steps respectively, and substracts the result from - and stores it in the specified range in [z]. This function is - useful for convolutions. + ?ofsy:int -> + ?incy:int -> + vec -> + unit +(** [zmxy ?n ?ofsz ?incz z ?ofsx ?incx x ?ofsy ?incy y] multiplies [n] elements + of vectors [x] and [y] elementwise, using [incx] and [incy] as incremental + steps respectively, and substracts the result from and stores it in the + specified range in [z]. This function is useful for convolutions. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsz default = 1 @@ -425,17 +382,17 @@ val zmxy : @param incy default = 1 *) val ssqr_diff : - ?n : int -> - ?ofsx : int -> - ?incx : int -> + ?n:int -> + ?ofsx:int -> + ?incx:int -> vec -> - ?ofsy : int -> - ?incy : int -> - vec - -> num_type -(** [ssqr_diff ?n ?ofsx ?incx x ?ofsy ?incy y] returns the sum of - squared differences of [n] elements of vectors [x] and [y], using - [incx] and [incy] as incremental steps respectively. + ?ofsy:int -> + ?incy:int -> + vec -> + num_type +(** [ssqr_diff ?n ?ofsx ?incx x ?ofsy ?incy y] returns the sum of squared + differences of [n] elements of vectors [x] and [y], using [incx] and [incy] + as incremental steps respectively. @param n default = greater n s.t. [ofsx+(n-1)(abs incx) <= dim x] @param ofsx default = 1 @param incx default = 1 diff --git a/src/vec_combine.h b/src/vec_combine.h index 3c9578c..dc217d6 100644 --- a/src/vec_combine.h +++ b/src/vec_combine.h @@ -1,14 +1,10 @@ /* File: vec_combine.h - Copyright (C) 2001- + Copyright © 2001- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umh.ac.be/an/ + Christophe Troestler This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public @@ -22,23 +18,17 @@ You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "lacaml_macros.h" -CAMLprim value NAME( - intnat vN, - intnat vOFSZ, intnat vINCZ, value vZ, - intnat vOFSX, intnat vINCX, value vX, - intnat vOFSY, intnat vINCY, value vY) -{ +CAMLprim value NAME(intnat vN, intnat vOFSZ, intnat vINCZ, value vZ, + intnat vOFSX, intnat vINCX, value vX, intnat vOFSY, + intnat vINCY, value vY) { CAMLparam3(vX, vY, vZ); - integer GET_INT(N), - GET_INT(INCX), - GET_INT(INCY), - GET_INT(INCZ); + integer GET_INT(N), GET_INT(INCX), GET_INT(INCY), GET_INT(INCZ); VEC_PARAMS(X); VEC_PARAMS(Y); @@ -46,7 +36,7 @@ CAMLprim value NAME( NUMBER *start_src1, *last_src1, *start_src2, *dst; - caml_enter_blocking_section(); /* Allow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ if (INCX == 1 && INCY == 1 && INCZ == 1) /* NOTE: may improve SIMD optimization */ @@ -59,18 +49,21 @@ CAMLprim value NAME( else { if (INCX > 0) { start_src1 = X_data; - last_src1 = start_src1 + N*INCX; - } - else { - start_src1 = X_data - (N - 1)*INCX; + last_src1 = start_src1 + N * INCX; + } else { + start_src1 = X_data - (N - 1) * INCX; last_src1 = X_data + INCX; }; - if (INCY > 0) start_src2 = Y_data; - else start_src2 = Y_data - (N - 1)*INCY; + if (INCY > 0) + start_src2 = Y_data; + else + start_src2 = Y_data - (N - 1) * INCY; - if (INCZ > 0) dst = Z_data; - else dst = Z_data - (N - 1)*INCZ; + if (INCZ > 0) + dst = Z_data; + else + dst = Z_data - (N - 1) * INCZ; while (start_src1 != last_src1) { NUMBER x = *start_src1; @@ -82,25 +75,15 @@ CAMLprim value NAME( } } - caml_leave_blocking_section(); /* Disallow other threads */ + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(Val_unit); } -CAMLprim value BC_NAME(value *argv, int __unused argn) -{ - return - NAME( - Int_val(argv[0]), - Int_val(argv[1]), - Int_val(argv[2]), - argv[3], - Int_val(argv[4]), - Int_val(argv[5]), - argv[6], - Int_val(argv[7]), - Int_val(argv[8]), - argv[9]); +CAMLprim value BC_NAME(value *argv, int __unused argn) { + return NAME(Int_val(argv[0]), Int_val(argv[1]), Int_val(argv[2]), argv[3], + Int_val(argv[4]), Int_val(argv[5]), argv[6], Int_val(argv[7]), + Int_val(argv[8]), argv[9]); } #undef NAME diff --git a/src/vec_map.h b/src/vec_map.h index 4053190..1b611f7 100644 --- a/src/vec_map.h +++ b/src/vec_map.h @@ -1,14 +1,10 @@ /* File: vec_map.h - Copyright (C) 2009- + Copyright © 2009- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umh.ac.be/an/ + Christophe Troestler This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public @@ -22,28 +18,23 @@ You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "lacaml_macros.h" -CAMLprim value NAME( - intnat vN, - intnat vOFSY, intnat vINCY, value vY, - intnat vOFSX, intnat vINCX, value vX) -{ +CAMLprim value NAME(intnat vN, intnat vOFSY, intnat vINCY, value vY, + intnat vOFSX, intnat vINCX, value vX) { CAMLparam2(vX, vY); - integer GET_INT(N), - GET_INT(INCX), - GET_INT(INCY); + integer GET_INT(N), GET_INT(INCX), GET_INT(INCY); VEC_PARAMS(X); VEC_PARAMS(Y); NUMBER *start1, *last1, *dst; - caml_enter_blocking_section(); /* Allow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ if (INCX == 1 && INCY == 1) /* NOTE: may improve SIMD optimization */ @@ -55,14 +46,16 @@ CAMLprim value NAME( else { if (INCX > 0) { start1 = X_data; - last1 = start1 + N*INCX; + last1 = start1 + N * INCX; } else { - start1 = X_data - (N - 1)*INCX; + start1 = X_data - (N - 1) * INCX; last1 = X_data + INCX; }; - if (INCY > 0) dst = Y_data; - else dst = Y_data - (N - 1)*INCY; + if (INCY > 0) + dst = Y_data; + else + dst = Y_data - (N - 1) * INCY; while (start1 != last1) { NUMBER x = *start1; @@ -72,22 +65,14 @@ CAMLprim value NAME( }; } - caml_leave_blocking_section(); /* Disallow other threads */ + caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(Val_unit); } -CAMLprim value BC_NAME(value *argv, int __unused argn) -{ - return - NAME( - Int_val(argv[0]), - Int_val(argv[1]), - Int_val(argv[2]), - argv[3], - Int_val(argv[4]), - Int_val(argv[5]), - argv[6]); +CAMLprim value BC_NAME(value *argv, int __unused argn) { + return NAME(Int_val(argv[0]), Int_val(argv[1]), Int_val(argv[2]), argv[3], + Int_val(argv[4]), Int_val(argv[5]), argv[6]); } #undef NAME diff --git a/src/vec_sort.h b/src/vec_sort.h index c07afd2..47ead51 100644 --- a/src/vec_sort.h +++ b/src/vec_sort.h @@ -1,10 +1,8 @@ /* File: vec_sort.h - Copyright (C) 2012- + Copyright © 2012- - Christophe Troestler - email: Christophe.Troestler@umons.ac.be - WWW: http://math.umons.ac.be/anum/ + Christophe Troestler This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public @@ -18,7 +16,7 @@ You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ /* Implementation of quicksort based on the glibc one. */ @@ -26,12 +24,12 @@ #ifndef _VEC_SORT #define _VEC_SORT -#define SWAP(TY, a, b) \ - do { \ - TY tmp = *a; \ - *a = *b; \ - *b = tmp; \ - } while(0) +#define SWAP(TY, a, b) \ + do { \ + TY tmp = *a; \ + *a = *b; \ + *b = tmp; \ + } while (0) /* Discontinue quicksort algorithm when partition gets below this size. This particular magic number was chosen to work best on a Sun 4/260. */ @@ -51,172 +49,154 @@ log(MAX_THRESH)). Since total_elements has type size_t, we get as upper bound for log (total_elements): bits per byte (CHAR_BIT) * sizeof(size_t). */ -#define STACK_SIZE (8 * sizeof(size_t)) -#define PUSH(low, high) ((void) ((top->lo = (low)), (top->hi = (high)), ++top)) -#define POP(low, high) ((void) (--top, (low = top->lo), (high = top->hi))) +#define STACK_SIZE (8 * sizeof(size_t)) +#define PUSH(low, high) ((void)((top->lo = (low)), (top->hi = (high)), ++top)) +#define POP(low, high) ((void)(--top, (low = top->lo), (high = top->hi))) #define STACK_NOT_EMPTY (stack < top) #endif /* _VEC_SORT */ -#define QUICKSORT(TY, base_ptr, INCX, max_thresh) \ - if (N > MAX_THRESH) \ - { \ - TY *lo = base_ptr; \ - TY *hi = &lo[(N - 1) * INCX]; \ - struct { \ - TY *lo; \ - TY *hi; \ - } stack[STACK_SIZE], *top = stack; \ - \ - PUSH (NULL, NULL); \ - \ - while (STACK_NOT_EMPTY) \ - { \ - TY *left_ptr; \ - TY *right_ptr; \ - \ - /* Select median value from among LO, MID, and HI. Rearrange \ - LO and HI so the three values are sorted. This lowers the \ - probability of picking a pathological pivot value and \ - skips a comparison for both the LEFT_PTR and RIGHT_PTR in \ - the while loops. */ \ - \ - TY *mid = lo + INCX * ((hi - lo) / INCX >> 1); \ - \ - if (QUICKSORT_LT(mid, lo)) { \ - SWAP (TY, mid, lo); \ - } \ - if (QUICKSORT_LT(hi, mid)) { \ - SWAP (TY, mid, hi); \ - } \ - else \ - goto jump_over; \ - if (QUICKSORT_LT(mid, lo)) { \ - SWAP (TY, mid, lo); \ - } \ - jump_over:; \ - \ - left_ptr = lo + INCX; \ - right_ptr = hi - INCX; \ - \ - /* Here's the famous ``collapse the walls'' section of quicksort. \ - Gotta like those tight inner loops! They are the main reason \ - that this algorithm runs much faster than others. */ \ - do \ - { \ - while (QUICKSORT_LT(left_ptr, mid)) \ - left_ptr += INCX; \ - \ - while (QUICKSORT_LT(mid, right_ptr)) \ - right_ptr -= INCX; \ - \ - if (left_ptr < right_ptr) \ - { \ - SWAP (TY, left_ptr, right_ptr); \ - if (mid == left_ptr) \ - mid = right_ptr; \ - else if (mid == right_ptr) \ - mid = left_ptr; \ - left_ptr += INCX; \ - right_ptr -= INCX; \ - } \ - else if (left_ptr == right_ptr) \ - { \ - left_ptr += INCX; \ - right_ptr -= INCX; \ - break; \ - } \ - } \ - while (left_ptr <= right_ptr); \ - \ - /* Set up pointers for next iteration. First determine whether \ - left and right partitions are below the threshold size. If so, \ - ignore one or both. Otherwise, push the larger partition's \ - bounds on the stack and continue sorting the smaller one. */ \ - \ - if ((size_t) (right_ptr - lo) <= max_thresh) \ - { \ - if ((size_t) (hi - left_ptr) <= max_thresh) \ - /* Ignore both small partitions. */ \ - POP (lo, hi); \ - else \ - /* Ignore small left partition. */ \ - lo = left_ptr; \ - } \ - else if ((size_t) (hi - left_ptr) <= max_thresh) \ - /* Ignore small right partition. */ \ - hi = right_ptr; \ - else if ((right_ptr - lo) > (hi - left_ptr)) \ - { \ - /* Push larger left partition indices. */ \ - PUSH (lo, right_ptr); \ - lo = left_ptr; \ - } \ - else \ - { \ - /* Push larger right partition indices. */ \ - PUSH (left_ptr, hi); \ - hi = right_ptr; \ - } \ - } \ - } \ - \ - /* Once the BASE_PTR array is partially sorted by quicksort the rest \ - is completely sorted using insertion sort, since this is efficient \ - for partitions below MAX_THRESH size. BASE_PTR points to the beginning \ - of the array to sort, and END_PTR points at the very last element in \ - the array (*not* one beyond it!). */ \ - { \ - TY *const end_ptr = &base_ptr[(N - 1) * INCX]; \ - TY *tmp_ptr = base_ptr; \ - TY *thresh = /* min(end_ptr, base_ptr + max_thresh) */ \ - end_ptr < (base_ptr + max_thresh) ? end_ptr : (base_ptr + max_thresh); \ - register TY *run_ptr; \ - \ - /* Find smallest element in first threshold and place it at the \ - array's beginning. This is the smallest array element, \ - and the operation speeds up insertion sort's inner loop. */ \ - \ - for (run_ptr = tmp_ptr + INCX; run_ptr <= thresh; run_ptr += INCX) \ - if (QUICKSORT_LT(run_ptr, tmp_ptr)) \ - tmp_ptr = run_ptr; \ - \ - if (tmp_ptr != base_ptr) { \ - SWAP (TY, tmp_ptr, base_ptr); \ - } \ - \ - /* Insertion sort, running from left-hand-side up to right-hand-side. */ \ - \ - run_ptr = base_ptr + INCX; \ - while ((run_ptr += INCX) <= end_ptr) \ - { \ - tmp_ptr = run_ptr - INCX; \ - while (QUICKSORT_LT(run_ptr, tmp_ptr)) \ - tmp_ptr -= INCX; \ - \ - tmp_ptr += INCX; \ - if (tmp_ptr != run_ptr) \ - { \ - TY *trav; \ - \ - trav = run_ptr + INCX; \ - while (--trav >= run_ptr) \ - { \ - TY c = *trav; \ - TY *hi, *lo; \ - \ - for (hi = lo = trav; (lo -= INCX) >= tmp_ptr; hi = lo) \ - *hi = *lo; \ - *hi = c; \ - } \ - } \ - } \ +#define QUICKSORT(TY, base_ptr, INCX, max_thresh) \ + if (N > MAX_THRESH) { \ + TY *lo = base_ptr; \ + TY *hi = &lo[(N - 1) * INCX]; \ + struct { \ + TY *lo; \ + TY *hi; \ + } stack[STACK_SIZE], *top = stack; \ + \ + PUSH(NULL, NULL); \ + \ + while (STACK_NOT_EMPTY) { \ + TY *left_ptr; \ + TY *right_ptr; \ + \ + /* Select median value from among LO, MID, and HI. Rearrange \ + LO and HI so the three values are sorted. This lowers the \ + probability of picking a pathological pivot value and \ + skips a comparison for both the LEFT_PTR and RIGHT_PTR in \ + the while loops. */ \ + \ + TY *mid = lo + INCX * ((hi - lo) / INCX >> 1); \ + \ + if (QUICKSORT_LT(mid, lo)) { \ + SWAP(TY, mid, lo); \ + } \ + if (QUICKSORT_LT(hi, mid)) { \ + SWAP(TY, mid, hi); \ + } else \ + goto jump_over; \ + if (QUICKSORT_LT(mid, lo)) { \ + SWAP(TY, mid, lo); \ + } \ + jump_over:; \ + \ + left_ptr = lo + INCX; \ + right_ptr = hi - INCX; \ + \ + /* Here's the famous ``collapse the walls'' section of quicksort. \ + Gotta like those tight inner loops! They are the main reason \ + that this algorithm runs much faster than others. */ \ + do { \ + while (QUICKSORT_LT(left_ptr, mid)) \ + left_ptr += INCX; \ + \ + while (QUICKSORT_LT(mid, right_ptr)) \ + right_ptr -= INCX; \ + \ + if (left_ptr < right_ptr) { \ + SWAP(TY, left_ptr, right_ptr); \ + if (mid == left_ptr) \ + mid = right_ptr; \ + else if (mid == right_ptr) \ + mid = left_ptr; \ + left_ptr += INCX; \ + right_ptr -= INCX; \ + } else if (left_ptr == right_ptr) { \ + left_ptr += INCX; \ + right_ptr -= INCX; \ + break; \ + } \ + } while (left_ptr <= right_ptr); \ + \ + /* Set up pointers for next iteration. First determine whether \ + left and right partitions are below the threshold size. If so, \ + ignore one or both. Otherwise, push the larger partition's \ + bounds on the stack and continue sorting the smaller one. */ \ + \ + if ((size_t)(right_ptr - lo) <= max_thresh) { \ + if ((size_t)(hi - left_ptr) <= max_thresh) \ + /* Ignore both small partitions. */ \ + POP(lo, hi); \ + else \ + /* Ignore small left partition. */ \ + lo = left_ptr; \ + } else if ((size_t)(hi - left_ptr) <= max_thresh) \ + /* Ignore small right partition. */ \ + hi = right_ptr; \ + else if ((right_ptr - lo) > (hi - left_ptr)) { \ + /* Push larger left partition indices. */ \ + PUSH(lo, right_ptr); \ + lo = left_ptr; \ + } else { \ + /* Push larger right partition indices. */ \ + PUSH(left_ptr, hi); \ + hi = right_ptr; \ + } \ + } \ + } \ + \ + /* Once the BASE_PTR array is partially sorted by quicksort the rest \ + is completely sorted using insertion sort, since this is efficient \ + for partitions below MAX_THRESH size. BASE_PTR points to the beginning \ + of the array to sort, and END_PTR points at the very last element in \ + the array (*not* one beyond it!). */ \ + { \ + TY *const end_ptr = &base_ptr[(N - 1) * INCX]; \ + TY *tmp_ptr = base_ptr; \ + TY *thresh = /* min(end_ptr, base_ptr + max_thresh) */ \ + end_ptr < (base_ptr + max_thresh) ? end_ptr : (base_ptr + max_thresh); \ + register TY *run_ptr; \ + \ + /* Find smallest element in first threshold and place it at the \ + array's beginning. This is the smallest array element, \ + and the operation speeds up insertion sort's inner loop. */ \ + \ + for (run_ptr = tmp_ptr + INCX; run_ptr <= thresh; run_ptr += INCX) \ + if (QUICKSORT_LT(run_ptr, tmp_ptr)) \ + tmp_ptr = run_ptr; \ + \ + if (tmp_ptr != base_ptr) { \ + SWAP(TY, tmp_ptr, base_ptr); \ + } \ + \ + /* Insertion sort, running from left-hand-side up to right-hand-side. */ \ + \ + run_ptr = base_ptr + INCX; \ + while ((run_ptr += INCX) <= end_ptr) { \ + tmp_ptr = run_ptr - INCX; \ + while (QUICKSORT_LT(run_ptr, tmp_ptr)) \ + tmp_ptr -= INCX; \ + \ + tmp_ptr += INCX; \ + if (tmp_ptr != run_ptr) { \ + TY *trav; \ + \ + trav = run_ptr + INCX; \ + while (--trav >= run_ptr) { \ + TY c = *trav; \ + TY *hi, *lo; \ + \ + for (hi = lo = trav; (lo -= INCX) >= tmp_ptr; hi = lo) \ + *hi = *lo; \ + *hi = c; \ + } \ + } \ + } \ } - -CAMLprim value NAME(value vCMP, intnat vN, - intnat vOFSX, intnat vINCX, value vX) -{ +CAMLprim value NAME(value vCMP, intnat vN, intnat vOFSX, intnat vINCX, + value vX) { CAMLparam2(vCMP, vX); #if defined(OCAML_SORT_CALLBACK) CAMLlocal2(va, vb); @@ -228,10 +208,11 @@ CAMLprim value NAME(value vCMP, intnat vN, NUMBER *const base_ptr = X_data; const size_t max_thresh = MAX_THRESH * sizeof(NUMBER) * INCX; - if (N == 0) CAMLreturn(Val_unit); + if (N == 0) + CAMLreturn(Val_unit); #ifndef OCAML_SORT_CALLBACK - caml_enter_blocking_section(); /* Allow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ #endif #define QUICKSORT_LT(a, b) OCAML_SORT_LT((*a), (*b)) @@ -239,76 +220,58 @@ CAMLprim value NAME(value vCMP, intnat vN, #undef QUICKSORT_LT #ifndef OCAML_SORT_CALLBACK - caml_leave_blocking_section(); /* Disallow other threads */ + caml_leave_blocking_section(); /* Disallow other threads */ #endif CAMLreturn(Val_unit); } -CAMLprim value BC_NAME(value vCMP, value vN, value vOFSX, value vINCX, value vX) -{ - return - NAME( - vCMP, - Int_val(vN), - Int_val(vOFSX), - Int_val(vINCX), - vX); +CAMLprim value BC_NAME(value vCMP, value vN, value vOFSX, value vINCX, + value vX) { + return NAME(vCMP, Int_val(vN), Int_val(vOFSX), Int_val(vINCX), vX); } -CAMLprim value NAME_PERM(value vCMP, intnat vN, - intnat vOFSP, intnat vINCP, value vP, - intnat vOFSX, intnat vINCX, value vX) -{ +CAMLprim value NAME_PERM(value vCMP, intnat vN, intnat vOFSP, intnat vINCP, + value vP, intnat vOFSX, intnat vINCX, value vX) { CAMLparam3(vCMP, vP, vX); #if defined(OCAML_SORT_CALLBACK) CAMLlocal2(va, vb); #endif const size_t GET_INT(N); - integer GET_INT(INCX), - GET_INT(OFSX), - GET_INT(INCP); + integer GET_INT(INCX), GET_INT(OFSX), GET_INT(INCP); VEC_PARAMS(X); - intnat *P_data = ((intnat *) Caml_ba_data_val(vP)) + (vOFSP - 1); + intnat *P_data = ((intnat *)Caml_ba_data_val(vP)) + (vOFSP - 1); size_t i; - NUMBER *const X = X_data - OFSX; /* so P values are FORTRAN indices */ + NUMBER *const X = X_data - OFSX; /* so P values are FORTRAN indices */ intnat *const base_ptr = P_data; const size_t max_thresh = MAX_THRESH * sizeof(intnat) * INCP; - if (N == 0) CAMLreturn(Val_unit); + if (N == 0) + CAMLreturn(Val_unit); #ifndef OCAML_SORT_CALLBACK - caml_enter_blocking_section(); /* Allow other threads */ + caml_enter_blocking_section(); /* Allow other threads */ #endif /* Initialize the permutation to the "identity". */ - for(i = 0; i < N; i += 1) + for (i = 0; i < N; i += 1) P_data[i * INCP] = OFSX + i * INCX; #define QUICKSORT_LT(a, b) OCAML_SORT_LT((X[*a]), (X[*b])) QUICKSORT(intnat, base_ptr, INCP, max_thresh); #undef QUICKSORT_LT #ifndef OCAML_SORT_CALLBACK - caml_leave_blocking_section(); /* Disallow other threads */ + caml_leave_blocking_section(); /* Disallow other threads */ #endif CAMLreturn(Val_unit); } - -CAMLprim value BC_NAME_PERM(value *argv, int __unused argn) -{ - return - NAME_PERM( - argv[0], - Int_val(argv[1]), - Int_val(argv[2]), - Int_val(argv[3]), - argv[4], - Int_val(argv[5]), - Int_val(argv[6]), - argv[7]); +CAMLprim value BC_NAME_PERM(value *argv, int __unused argn) { + return NAME_PERM(argv[0], Int_val(argv[1]), Int_val(argv[2]), + Int_val(argv[3]), argv[4], Int_val(argv[5]), + Int_val(argv[6]), argv[7]); } #undef NAME diff --git a/src/version.ml b/src/version.ml index f56ef20..a500f56 100644 --- a/src/version.ml +++ b/src/version.ml @@ -1,24 +1,21 @@ (* File: version.ml - Copyright (C) 2012- + Copyright © 2012- - Markus Mottl - email: markus.mottl@gmail.com - WWW: http://www.ocaml.info + Markus Mottl - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. + This library is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 2.1 of the License, or (at your option) + any later version. - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. + This library is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more + details. - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *) let version = "%%VERSION_NUM%%" diff --git a/top/dune b/top/dune index 7926358..a2aca4f 100644 --- a/top/dune +++ b/top/dune @@ -1,6 +1,5 @@ (library - (name lacaml_top) - (public_name lacaml.top) - (modes byte) - (libraries compiler-libs.toplevel lacaml) -) + (name lacaml_top) + (public_name lacaml.top) + (modes byte) + (libraries compiler-libs.toplevel lacaml)) diff --git a/top/lacaml_install_printers.ml b/top/lacaml_install_printers.ml index 413b81d..eda9488 100644 --- a/top/lacaml_install_printers.ml +++ b/top/lacaml_install_printers.ml @@ -8,8 +8,8 @@ let printers = "Lacaml.Io.Toplevel.pp_imat"; ] -let eval_string - ?(print_outcome = false) ?(err_formatter = Format.err_formatter) str = +let eval_string ?(print_outcome = false) ?(err_formatter = Format.err_formatter) + str = let lexbuf = Lexing.from_string str in let phrase = !Toploop.parse_toplevel_phrase lexbuf in Toploop.execute_phrase print_outcome err_formatter phrase