#!/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/>.

## generate_array_template.sh generates wrapper templates for GSL
## special function of the 'array' type'.  It is used by bootstrap.
##
## CALL: generate_array_template.sh T1 ... Tn ARRLEN NOUT OUTF
##
## where T1, T2, ... Tn are the input argument types, ARRLEN indicates
## how to compute the length of the array, NOUT is the number of
## output arguments and OUTF the template file name.

## Get the arguments
args=($@)
nargs=${#args[@]}

## Types are
let npars=$nargs-3
pars=(${args[@]:0:$ntypes})

## Array length is
arrlen=${args[nargs-3]}

## Number of outputs is
nout=${args[nargs-2]}

## Output file is
outf=${args[nargs-1]}

## Using Legendre norm parameter?
if [[ ${1} == "legnorm" ]]; then
    legnorm=1
else
    legnorm=0
fi


cat > $outf <<EOF


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

## List of output variables
if ((nout == 1)); then
    outvars="@var{z}"
else
    outvars="("
    for ((i=1; i<=nout; i++)); do
        if ((i > 1)); then
            outvars="$outvars,"
        fi
        outvars="$outvars z${i}"
    done
    outvars="$outvars )";
fi

echo -n "@deftypefn {Loadable Function} {$outvars =} 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
cat >> $outf <<EOF
)\\n\\
@deftypefnx {Loadable Function} {$outvars =} GSL_OCTAVE_NAME (@dots{})\\n\\
\\n\\
GSL_FUNC_DOCSTRING
\\n\\
EOF

## Is first argument a Legendre norm argument?
if ((legnorm)); then
    cat >> $outf <<EOF
The argument @var{arg1} must be an integer corresponding to\\n\\
\\n\\
@table @asis\\n\\
@item 0 = GSL_SF_LEGENDRE_SCHMIDT\\n\\
      Computation of the Schmidt semi-normalized associated Legendre\\n\\
      polynomials S_l^m(x).\\n\\
@item 1 = GSL_SF_LEGENDRE_SPHARM\\n\\
      Computation of the spherical harmonic associated Legendre\\n\\
      polynomials Y_l^m(x).\\n\\
@item 2 = GSL_SF_LEGENDRE_FULL\\n\\
      Computation of the fully normalized associated Legendre\\n\\
      polynomials N_l^m(x).\\n\\
@item 3 = GSL_SF_LEGENDRE_NONE\\n\\
      Computation of the unnormalized associated Legendre polynomials\\n\\
      P_l^m(x).\\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 = ${npars};

  // 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 ();
      }

  // Check that all input arguments are scalar
  for (int i = 0; i < nb_args; i++)
    if (! args(i).is_scalar_type ())
      {
        error ("Input argument #%d is not scalar. "
               "All input arguments are expected to be scalar.", i + 1);
        print_usage ();
        return octave_value ();
      }

EOF

## Check the Legendre normalization parameter
if ((legnorm)); then
    cat >> $outf <<EOF
  // Check that the Legendre normalization parameter is valid
  double legnorm_tmp = args(0).double_value ();
  gsl_sf_legendre_t legnorm;
  if (legnorm_tmp == 0.0)
    legnorm = GSL_SF_LEGENDRE_SCHMIDT;
  else if (legnorm_tmp == 1.0)
    legnorm = GSL_SF_LEGENDRE_SPHARM;
  else if (legnorm_tmp == 2.0)
    legnorm = GSL_SF_LEGENDRE_FULL;
  else if (legnorm_tmp == 3.0)
    legnorm = GSL_SF_LEGENDRE_NONE;
  else
   {
      error ("The 'legnorm' argument must be 0, 1, 2 or 3.");
      print_usage ();
      return octave_value ();
    }

EOF
fi

## Minimum index for getting arguments
imin=1
if ((legnorm)); then
    let imin++
fi

## Check upper overflow
check_overflow_upp ()
{
    echo "  if (arg$1_dbl > std::numeric_limits<$2>::max ())" >> $outf
    echo "    {" >> $outf
    echo "      error (\"Input argument #$1 exceeds the upper limit \"" >> $outf
    echo "             \"for type $2: %lu.\", std::numeric_limits<$2>::max ());" >> $outf
    echo "      print_usage ();" >> $outf
    echo "      return octave_value ();" >> $outf
    echo "    }" >> $outf
}

## Check lower overflow
check_overflow_low ()
{
    echo "  if (arg$1_dbl < std::numeric_limits<$2>::min ())" >> $outf
    echo "    {" >> $outf
    echo "      error (\"Input argument #$1 exceeds the lower limit \"" >> $outf
    echo "             \"for type $2: -%lu.\", -std::numeric_limits<$2>::min ());" >> $outf
    echo "      print_usage ();" >> $outf
    echo "      return octave_value ();" >> $outf
    echo "    }" >> $outf
}

## Check positivity
check_positivity ()
{
    echo "  if (arg$1_dbl < 0)" >> $outf
    echo "    {" >> $outf
    echo "      error (\"Input argument #$1 has a negative value. \"" >> $outf
    echo "             \"A non-negative value was expected.\");" >> $outf
    echo "      print_usage ();" >> $outf
    echo "      return octave_value ();" >> $outf
    echo "    }" >> $outf
}

## Check integrity
check_integer ()
{
    echo "  if ((static_cast<double> (arg$1)) != arg$1_dbl)" >> $outf
    echo "    {" >> $outf
    echo "      error (\"Input argument #$1 has a non-integer value. \"" >> $outf
    echo "             \"An integer value was expected.\");" >> $outf
    echo "      print_usage ();" >> $outf
    echo "      return octave_value ();" >> $outf
    echo "    }" >> $outf
}

## Get the input
for ((i=imin; i<=npars; i++)); do
    echo "  // Get the value of input argument #$i" >> $outf
    let oi=i-1
    if [[ ${!i} == "double" ]]; then
        echo "  double arg${i} = args(${oi}).scalar_value ();" >> $outf
    else
        echo "  double arg${i}_dbl = args(${oi}).scalar_value ();" >> $outf
        if [[ ${!i} == "int" ]]; then
            check_overflow_upp $i "int"
            check_overflow_low $i "int"
            echo "  int arg${i} = static_cast<int> (arg${i}_dbl);" >> $outf
        elif [[ ${!i} == "int+" ]]; then
            check_overflow_upp $i "int"
            check_positivity $i "int"
            echo "  int arg${i} = static_cast<int> (arg${i}_dbl);" >> $outf
        elif [[ ${!i} == "uint" ]]; then
            check_overflow_upp $i "unsigned int"
            check_positivity $i
            echo "  unsigned int arg${i} = static_cast<unsigned int> (arg${i}_dbl);" >> $outf
        elif [[ ${!i} == "size_t" ]]; then
            check_overflow_upp $i "size_t"
            check_positivity $i
            echo "  size_t arg${i} = static_cast<size_t> (arg${i}_dbl);" >> $outf
        else
            echo "Unknown type ${!i}!"
            exit
        fi
        check_integer $i
    fi
    echo "" >> $outf
done

## Declare result array
echo "  // Declare the array(s) where the results are stored" >> $outf
for ((i=1; i<=nout; i++)); do
    if ((legnorm)); then
        ## Legendre arrays need to be longer to account for work memory requirements
        echo "  RowVector y${i} (gsl_sf_legendre_array_n ($arrlen));" >> $outf
    else
        echo "  RowVector y${i} ($arrlen);" >> $outf
    fi
done

## Run the calculation
echo "" >> $outf
echo "  // Run the calculation" >> $outf
echo -n "  GSL_FUNC_NAME (" >> $outf
if ((legnorm)); then
    echo -n "legnorm, " >> $outf
fi
for ((i=imin; i<=npars; i++)); do
    echo -n "arg${i}, " >> $outf
done
for ((i=1; i<=nout; i++)); do
    echo -n "y${i}.fortran_vec ()" >> $outf
    if ((i != nout)); then
	echo -n ", " >> $outf
    fi
done
echo -e ");\n" >> $outf

## Resize outputs to get rid of working memory
if ((legnorm)); then
    for ((i=1; i<=nout; i++)); do
        echo "  y${i}.resize (gsl_sf_legendre_array_index ($arrlen, $arrlen) + 1);" >> $outf
    done
fi

## Return
if ((nout == 1)); then
    echo "  return octave_value (y1);" >> $outf
else
    echo "  octave_value_list retval;" >> $outf
    for ((i=1; i<=nout; i++)); do
	let io=i-1
	echo "  retval(${io}) = octave_value (y${i});" >> $outf
    done
    echo "  return retval;" >> $outf
fi

cat >> $outf <<EOF

#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
