#!/bin/bash

## Copyright (C) 2016 Susi Lehtola
## Copyright (C) 2016 Julien Bect <jbect@users.sourceforge.net>
##
## This program is free software; you can redistribute it and/or modify
## it under the terms of the GNU General Public License as published by
## the Free Software Foundation; either version 2 of the License, or
## (at your option) any later version.
##
## This program 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 General Public License for more details.
##
## You should have received a copy of the GNU General Public License
## along with this program; if not, see <http://www.gnu.org/licenses/>.

## This script is used to generate templates for octave-gsl

## Need at least two arguments: type and output file
MINPARAMS=2

## Number of GSL parameters is
let ngsl=${#}-1
let npars=${ngsl}

## Get the position of the 'mode' argument (if there is one)
if [[ ${!npars} == "mode" ]]; then
    mode=$npars
    let npars--
else
    mode=0
fi

## Output file is
outf=${!#}

cat > $outf <<EOF


// PKG_ADD: autoload ("GSL_OCTAVE_NAME", which ("gsl_sf"));
DEFUN_DLD(GSL_OCTAVE_NAME, args, nargout, "\\
  -*- texinfo -*-\\n\\
EOF

echo -n "@deftypefn {Loadable Function} {@var{z} =} GSL_OCTAVE_NAME (" >> $outf
for ((i=1; i<=npars; i++)); do
    if (( i > 1 )); then
	echo -n ", " >> $outf
    fi
    echo -n "@var{arg${i}}" >> $outf
done
if ((mode > 0)); then
    echo -n ", @var{mode}" >> $outf
fi
cat >> $outf <<EOF
)\\n\\
@deftypefnx {Loadable Function} {[@var{z}, @var{err}] =} GSL_OCTAVE_NAME (@dots{})\\n\\
\\n\\
GSL_FUNC_DOCSTRING
\\n\\
@var{err} contains an estimate of the absolute error in the value @var{z}.\\n\\
\\n\\
EOF

## Additional documentation for functions whose last argument is a mode argument
if ((mode > 0)); then
    cat >> $outf <<EOF
The argument @var{mode} must be an integer corresponding to\\n\\
\\n\\
@table @asis\\n\\
@item 0 = GSL_PREC_DOUBLE\\n\\
    Double-precision, a relative accuracy of approximately @code{2e-16}.\\n\\
@item 1 = GSL_PREC_SINGLE\\n\\
    Single-precision, a relative accuracy of approximately @code{1e-7}.\\n\\
@item 2 = GSL_PREC_APPROX\\n\\
    Approximate values, a relative accuracy of approximately @code{5e-4}.\\n\\
@end table\\n\\
\\n\\
EOF
fi

cat >> $outf <<EOF
This function is from the GNU Scientific Library,\\n\\
see @url{http://www.gnu.org/software/gsl/} for documentation.\\n\\
DEPRECATION_WARNING
@end deftypefn\\n")
{
#ifdef HAVE_GSL_FUNC

  gsl_set_error_handler (octave_gsl_errorhandler);

  // Expected number of input arguments
  const int nb_args = ${ngsl};

  // Check the actual number of input arguments
  if (args.length() != nb_args)
    {
      print_usage ();
      return octave_value ();
    }

  // Check that all input arguments are real
  for (int i = 0; i < nb_args; i++)
    if (! ISREAL(args(i)))
      {
        error ("Input argument #%d has a complex value. "
               "A real value was expected.", i + 1);
        print_usage ();
        return octave_value ();
      }

EOF

if ((mode > 0)); then
    let ic=mode-1
    cat >> $outf <<EOF
  // Check that the mode argument is scalar
  if (! args(${ic}).is_scalar_type ())
    {
      error ("The mode argument must be scalar.");
      print_usage ();
      return octave_value ();
    }

  // Check that the mode argument has a valid value
  double tmp_mode_dbl = args(${ic}).double_value ();
  gsl_mode_t mode;
  if (tmp_mode_dbl == 0.0)
    mode = GSL_PREC_DOUBLE;
  else if (tmp_mode_dbl == 1.0)
    mode = GSL_PREC_SINGLE;
  else if (tmp_mode_dbl == 2.0)
    mode = GSL_PREC_APPROX;
  else
    {
      error ("The 'mode' argument must be 0, 1, or 2.");
      print_usage ();
      return octave_value ();
    }

EOF
fi


## Things are simpler when there is only one input argument
if ((npars == 1)); then

    ## Get input argument as NDArray object
    echo "  // Get input argument as NDArray object" >> $outf
    echo "  NDArray arg1 = args(0).array_value();" >> $outf
    echo "" >> $outf

    ## Get the dimension of the array
    echo "  // Get the dimension of the array" >> $outf
    echo "  dim_vector dim (arg1.dims ());" >> $outf
    echo "  octave_idx_type numel = dim.numel ();" >> $outf
    echo "" >> $outf

    ## Get a pointer to the data of the input array
    echo "  // Get a pointer to the data of the input array" >> $outf
    echo "  const double *arg1_data = arg1.data ();" >> $outf
    echo "" >> $outf

else

    ## Get input arguments as NDArray objects
    echo "  // Get input arguments as NDArray objects" >> $outf
    for ((i=1; i<=npars; i++)); do
        let ic=i-1
        echo "  NDArray arg${i} = args(${ic}).array_value();" >> $outf
    done
    echo "" >> $outf

    ## Get the dimensions of the arrays
    echo "  // Get the dimensions of the arrays" >> $outf
    echo "  dim_vector dim (1, 1);" >> $outf
    echo "  octave_idx_type numel = 1;" >> $outf
    echo "  bool conformant = true;" >> $outf
    for ((i=1; i<=npars; i++)); do
        echo "  bool arg${i}_scalar = check_arg_dim<NDArray> (arg${i}, dim, numel, conformant);" >> $outf
    done
    echo "" >> $outf

    ## Check if sizes are compatible
    echo "  // Error in case of non-conformant arguments" >> $outf
    echo "  if (! conformant)" >> $outf
    echo "    {" >> $outf
    echo "      error (\"Non-scalar input arguments must all have the same size.\");" >> $outf
    echo "      return octave_value ();" >> $outf
    echo "    }" >> $outf
    echo "" >> $outf

    ## Create one separate index for each argument
    echo "  // Create one separate index for each argument" >> $outf
    for ((i=1; i<=npars; i++)); do
        echo "  octave_idx_type i${i} = 0;" >> $outf
    done
    echo "" >> $outf

    ## Create one separate increment for each argument
    echo "  // Create one separate increment for each argument" >> $outf
    for ((i=1; i<=npars; i++)); do
        echo "  octave_idx_type inc${i} = (arg${i}_scalar ? 0 : 1);" >> $outf
    done
    echo "" >> $outf

    ## Get pointers to the data of the input arrays
    echo "  // Get pointers to the data of the input arrays" >> $outf
    for ((i=1; i<=npars; i++)); do
        echo "  const double *arg${i}_data = arg${i}.data ();" >> $outf
    done
    echo "" >> $outf

fi


## Access the data
##   $1 = type: "double", "int" or "uint"
##   $2 = argument number
##   $3 = name of index variable
access_data ()
{
    if [[ $1 == "double" ]]; then
        echo -n "arg$2_data[$3]" >> $outf
    elif [[ $1 == "int" ]]; then
        echo -n "x$2" >> $outf
    elif [[ $1 == "uint" ]]; then
        echo -n "x$2" >> $outf
    else
        echo "Unknown type $1"
        exit
    fi
}


## Convert double-precision values to integers
##   $1 = type: "double", "int" or "uint"
##   $2 = argument number
##   $3 = name of index variable
##   $4 = nargout
convert_check_data ()
{
    if [[ $1 == "double" ]]; then
        :
    elif [[ $1 == "int" ]]; then
        echo "          // Convert argument #$2 to int" >> $outf
        echo "          double t$2 = arg$2_data[$3];" >> $outf
        echo "          int x$2 = static_cast<int> (t$2);" >> $outf
        echo "          if ((static_cast<double> (x$2)) != t$2)" >> $outf
        set_nan_and_break $4
    elif [[ $1 == "uint" ]]; then
        echo "          // Convert argument #$2 to unsigned int" >> $outf
        echo "          double t$2 = arg$2_data[$3];" >> $outf
        echo "          unsigned int x$2 = static_cast<unsigned int> (t$2);" >> $outf
        echo "          if ((static_cast<double> (x$2)) != t$2)" >> $outf
        set_nan_and_break $4
    else
        echo "Unknown type $1"
        exit
    fi
}


## Skip to the next iteration in case of incorrect input
##   $1 = nargout
set_nan_and_break ()
{
    echo "            {" >> $outf
    echo "              y.xelem(i) = lo_ieee_nan_value ();" >> $outf
    if [[ "$1" == "2" ]]; then
        echo "              err.xelem(i) = lo_ieee_nan_value ();" >> $outf
    fi
    echo "              continue;" >> $outf
    echo "            }" >> $outf
    echo "" >> $outf

}


## Run the calculation
run_calculation ()
{
echo  "      // Run the calculation" >> $outf
echo -n "      for (octave_idx_type i = 0; i < numel; i++" >> $outf
if ((npars > 1)); then
    for ((i=1; i<=npars; i++)); do
        echo -n ", i${i} += inc${i}" >> $outf
    done
fi
echo ")" >> $outf
echo "        {" >> $outf
if ((npars == 1)); then
    convert_check_data $1 1 i ${!#}
else
    for ((i=1; i<=npars; i++)); do
        convert_check_data ${!i} $i i${i} ${!#}
    done
fi
echo -n "          GSL_FUNC_NAME (" >> $outf
if ((npars == 1)); then
    access_data $1 1 i
else
    for ((i=1; i<=npars; i++)); do
        if (( i > 1 )); then
            echo -n ", " >> $outf
        fi
        access_data ${!i} $i i${i}
    done
fi
if ((mode > 0)); then
    echo -n ", mode" >> $outf
fi
echo ", &result);" >> $outf
echo "          y.xelem(i) = result.val;" >> $outf
if [[ "${!#}" == "2" ]]; then
    echo "          err.xelem(i) = result.err;" >> $outf
fi
echo "        }" >> $outf
}


## First case: only one output argument
cat >> $outf <<EOF
  // Array of output values
  NDArray y (dim);

  // GSL structure that will hold each individual result
  gsl_sf_result result;

  if (nargout < 2)
    {
EOF
run_calculation $* 1
cat >> $outf <<EOF

      return octave_value (y);
    }
EOF


## Second case: two output arguments
cat >> $outf <<EOF
  else
    {
      // Array of error estimates
      NDArray err (dim);

EOF
run_calculation $* 2
cat >> $outf <<EOF

      octave_value_list retval (2);
      retval(0) = octave_value (y);
      retval(1) = octave_value (err);
      return retval;
    }

#else // HAVE_GSL_FUNC undefined

  error ("GSL function GSL_FUNC_NAME was found missing when "
         "the gsl package for octave was built.");
  return octave_value ();

#endif // HAVE_GSL_FUNC
}
EOF
