path: root/gcc/cobol/parse_util.h

/*
 * Copyright (c) 2021-2025 Symas Corporation
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are
 * met:
 *
 * * Redistributions of source code must retain the above copyright
 *   notice, this list of conditions and the following disclaimer.
 * * Redistributions in binary form must reproduce the above
 *   copyright notice, this list of conditions and the following disclaimer
 *   in the documentation and/or other materials provided with the
 *   distribution.
 * * Neither the name of the Symas Corporation nor the names of its
 *   contributors may be used to endorse or promote products derived from
 *   this software without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 */
// This file is included only by parse.y

#include <map>

/*
 * Intrinsics
 * types are:
 *   A Alphabetic
 *   D DBCS
 *   I Integer
 *   K Keyword
 *   N Numeric
 *   O Other
 *   U National
 *   8 UTF-8
 *   X Alphanumeric
 *   n variadic
 * We use just A, I, N, or X, choosing the most general for each parameter.
 */
static const function_descr_t function_descrs[] = {
   {         ABS,                          "ABS",
      "__gg__abs",                         "N",   {}, FldNumericBin5 },
   {         ACOS,                         "ACOS",
      "__gg__acos",                        "N",   {}, FldNumericBin5 },
   {         ANNUITY,                      "ANNUITY",
      "__gg__annuity",                     "NI",  {}, FldNumericBin5 },
   {         ASIN,                         "ASIN",
      "__gg__asin",                        "N",   {}, FldNumericBin5 },
   {         ATAN,                         "ATAN",
      "__gg__atan",                        "N",   {}, FldNumericBin5 },
   {         BASECONVERT,                         "BASECONVERT",
      "__gg__baseconvert",                        "XII",   {}, FldNumericBin5 },
   {         BIT_OF,                       "BIT-OF",
      "__gg__bit_of",                      "X",   {}, FldAlphanumeric },
   {         BIT_TO_CHAR,                  "BIT-TO-CHAR",
      "__gg__bit_to_char",                 "X",   {}, FldAlphanumeric },
   // BOOLEAN-OF-INTEGER requires FldBoolean
   {         BOOLEAN_OF_INTEGER,                         "BOOLEAN-OF-INTEGER",
      "__gg__boolean_of_integer",                        "II",   {}, FldNumericBin5 },
   {         BYTE_LENGTH,                  "BYTE-LENGTH",
       "__gg__byte_length",                "X",   {}, FldNumericBin5 },
   {         CHAR,                         "CHAR",
      "__gg__char",                        "I",   {}, FldAlphanumeric },
   {         CHAR_NATIONAL,                         "CHAR-NATIONAL",
      "__gg__char_national",                        "I",   {}, FldAlphanumeric },
   {         COMBINED_DATETIME,            "COMBINED-DATETIME",
      "__gg__combined_datetime",           "IN",  {}, FldNumericBin5 },
   {         CONCAT,                       "CONCAT",
      "__gg__concat",                      "n",   {}, FldAlphanumeric },
   {         CONVERT,                          "CONVERT",
      "__gg__convert",                         "XII",   {}, FldAlphanumeric },
   {         COS,                          "COS",
      "__gg__cos",                         "N",   {}, FldNumericBin5 },
   {         CURRENT_DATE,                 "CURRENT-DATE",
      "__gg__current_date",                 "",   {}, FldAlphanumeric },
   {         DATE_OF_INTEGER,              "DATE-OF-INTEGER",
      "__gg__date_of_integer",             "I",   {}, FldNumericBin5 },
   {         DATE_TO_YYYYMMDD,             "DATE-TO-YYYYMMDD",
      "__gg__date_to_yyyymmdd",            "III",  {}, FldNumericBin5 },
   {         DAY_OF_INTEGER,               "DAY-OF-INTEGER",
      "__gg__day_of_integer",              "I",   {}, FldNumericBin5 },
   {         DAY_TO_YYYYDDD,               "DAY-TO-YYYYDDD",
      "__gg__day_to_yyyyddd",              "III",  {}, FldNumericBin5 },
   {         DISPLAY_OF,                   "DISPLAY-OF",
      "__gg__display_of",                  "UUI", {}, FldAlphanumeric },
   {         E,                            "E",
      "__gg_e",                            "",   {}, FldNumericBin5 },

   {         EXCEPTION_FILE,               "EXCEPTION-FILE",
      "__gg__func_exception_file",         "",   {}, FldAlphanumeric },
   {         EXCEPTION_FILE_N,             "EXCEPTION-FILE-N",
      "__gg__func_exception_file_n",       "",   {}, FldAlphanumeric },
   {         EXCEPTION_LOCATION,           "EXCEPTION-LOCATION",
      "__gg__func_exception_location",     "",   {}, FldAlphanumeric },
   {         EXCEPTION_LOCATION_N,         "EXCEPTION-LOCATION-N",
      "__gg__func_exception_location_n",   "",   {}, FldAlphanumeric },
   {         EXCEPTION_STATEMENT,          "EXCEPTION-STATEMENT",
      "__gg__func_exception_statement",    "",   {}, FldAlphanumeric },
   {         EXCEPTION_STATUS,             "EXCEPTION-STATUS",
      "__gg__func_exception_status",       "",   {}, FldAlphanumeric },

   {         EXP,                          "EXP",
      "__gg__exp",                         "N",   {}, FldNumericBin5 },
   {         EXP10,                        "EXP10",
      "__gg__exp10",                       "N",   {}, FldNumericBin5 },
   {         FACTORIAL,                    "FACTORIAL",
      "__gg__factorial",                   "I",   {}, FldNumericBin5 },
   {         FIND_STRING,                    "FIND-STRING",
      "__gg__find_string",                   "AXI",   {}, FldNumericBin5 },
   {         FORMATTED_CURRENT_DATE,       "FORMATTED-CURRENT-DATE",
      "__gg__formatted_current_date",      "X",   {}, FldAlphanumeric },
   {         FORMATTED_DATE,               "FORMATTED-DATE",
      "__gg__formatted_date",              "XX",  {}, FldAlphanumeric },
   {         FORMATTED_DATETIME,           "FORMATTED-DATETIME",
      "__gg__formatted_datetime",          "XINI", {}, FldAlphanumeric },
   {         FORMATTED_TIME,               "FORMATTED-TIME",
      "__gg__formatted_time",              "INI", {}, FldNumericBin5 },
   {         FRACTION_PART,                "FRACTION-PART",
      "__gg__fraction_part",               "N",   {}, FldNumericBin5 },
   {         HEX_OF,                       "HEX-OF",
      "__gg__hex_of",                      "X",   {}, FldAlphanumeric },
   {         HEX_TO_CHAR,                  "HEX-TO-CHAR",
      "__gg__hex_to_char",                 "X",   {}, FldAlphanumeric },
   {         HIGHEST_ALGEBRAIC,            "HIGHEST-ALGEBRAIC",
      "__gg__highest_algebraic",           "N",   {}, FldNumericBin5 },
   {         INTEGER,                      "INTEGER",
      "__gg__integer",                     "N",   {}, FldNumericBin5 },
   // requires FldBoolean
   {         INTEGER_OF_BOOLEAN,                      "INTEGER-OF-BOOLEAN",
      "__gg__integer_of_boolean",                     "B",   {}, FldNumericBin5 },
   {         INTEGER_OF_DATE,              "INTEGER-OF-DATE",
      "__gg__integer_of_date",             "I",   {}, FldNumericBin5 },
   {         INTEGER_OF_DAY,               "INTEGER-OF-DAY",
      "__gg__integer_of_day",              "I",   {}, FldNumericBin5 },
   {         INTEGER_OF_FORMATTED_DATE,    "INTEGER-OF-FORMATTED-DATE",
      "__gg__integer_of_formatted_date",   "XX",  {}, FldAlphanumeric },
   {         INTEGER_PART,                 "INTEGER-PART",
      "__gg__integer_part",                "N",   {}, FldNumericBin5 },
   {         LENGTH,                       "LENGTH",
      "__gg__length",                      "X",   {}, FldNumericBin5 },
   {         LOCALE_COMPARE,               "LOCALE-COMPARE",
      "__gg__locale_compare",              "XXX",   {}, FldNumericBin5 },
   {         LOCALE_DATE,                  "LOCALE-DATE",
      "__gg__locale_date",                 "XX",   {}, FldNumericBin5 },
   {         LOCALE_TIME,                  "LOCALE-TIME",
      "__gg__locale_time",                 "XX",   {}, FldNumericBin5 },
   {         LOCALE_TIME_FROM_SECONDS,     "LOCALE-TIME-FROM-SECONDS",
      "__gg__locale_time_from_seconds",    "NX",   {}, FldNumericBin5 },

   {         LOG,                          "LOG",
      "__gg__log",                         "N",   {}, FldNumericBin5 },
   {         LOG10,                        "LOG10",
      "__gg__log10",                       "N",   {}, FldNumericBin5 },
   {         LOWER_CASE,                   "LOWER-CASE",
      "__gg__lower_case",                  "X",   {}, FldAlphanumeric },
   {         LOWEST_ALGEBRAIC,             "LOWEST-ALGEBRAIC",
      "__gg__lowest_algebraic",            "N",   {}, FldNumericBin5 },

   {         MAXX,                          "MAX",
      "__gg__max",                         "n",   {}, FldAlphanumeric },
   {         MEAN,                         "MEAN",
      "__gg__mean",                        "n",   {}, FldNumericBin5 },
   {         MEDIAN,                       "MEDIAN",
      "__gg__median",                      "n",   {}, FldNumericBin5 },
   {         MIDRANGE,                     "MIDRANGE",
      "__gg__midrange",                    "n",   {}, FldNumericBin5 },
   {         MINN,                          "MIN",
      "__gg__min",                         "n",   {}, FldAlphanumeric },
   {         MOD,                          "MOD",
      "__gg__mod",                         "IN",  {}, FldNumericBin5 },
   {         MODULE_NAME,                          "MODULE-NAME",
      "__gg__module_name",                         "I",  {}, FldAlphanumeric },
   {         NATIONAL_OF,                  "NATIONAL-OF",
      "__gg__national_of",                 "XX",  {}, FldAlphanumeric },
   {         NUMVAL,                       "NUMVAL",
      "__gg__numval",                      "X",   {}, FldNumericBin5 },
   {         NUMVAL_C,                     "NUMVAL-C",
      "__gg__numval_c",                    "XXU", {}, FldNumericBin5 },
   {         NUMVAL_F,                     "NUMVAL-F",
      "__gg__numval_f",                    "X",   {}, FldNumericBin5 },
   {         ORD,                          "ORD",
      "__gg__ord",                         "X",   {}, FldNumericBin5 },
   {         ORD_MAX,                      "ORD-MAX",
      "__gg__ord_max",                     "n",   {}, FldNumericBin5 },
   {         ORD_MIN,                      "ORD-MIN",
      "__gg__ord_min",                     "n",   {}, FldNumericBin5    },
   {         PI,                           "PI",
      "__gg__pi",                          "",   {}, FldNumericBin5 },
   {         PRESENT_VALUE,                "PRESENT-VALUE",
      "__gg__present_value",               "n",   {}, FldNumericBin5    },
   {         RANDOM,                       "RANDOM",
      "__gg__random",                      "I",   {}, FldNumericBin5 },
   {         RANGE,                        "RANGE",
      "__gg__range",                       "n",   {}, FldNumericBin5    },
   {         REM,                          "REM",
      "__gg__rem",                         "NN",  {}, FldNumericBin5 },
   {         REVERSE,                      "REVERSE",
      "__gg__reverse",                     "X",   {}, FldAlphanumeric },
   {         SECONDS_FROM_FORMATTED_TIME,  "SECONDS-FROM-FORMATTED-TIME",
      "__gg__seconds_from_formatted_time", "XX",  {}, FldAlphanumeric },
   {         SECONDS_PAST_MIDNIGHT,        "SECONDS_PAST_MIDNIGHT",
      "__gg__seconds_past_midnight",       "",    {}, FldAlphanumeric },
   {         SIGN,                         "SIGN",
      "__gg__sign",                        "N",   {}, FldNumericBin5 },
   {         SIN,                          "SIN",
      "__gg__sin",                         "N",   {}, FldNumericBin5 },
   {         SMALLEST_ALGEBRAIC,                          "SMALLEST-ALGEBRAIC",
      "__gg__smallest_algebraic",                         "N",   {}, FldNumericBin5 },
   {         SQRT,                         "SQRT",
      "__gg__sqrt",                        "N",   {}, FldNumericBin5 },
   {         STANDARD_COMPARE,                          "STANDARD-COMPARE",
      "__gg__standard_compare",                         "XXXI",   {}, FldAlphanumeric },
   {         STANDARD_DEVIATION,           "STANDARD-DEVIATION",
      "__gg__standard_deviation",          "n",   {}, FldNumericBin5 },
   {         SUBSTITUTE,                          "SUBSTITUTE",
      "__gg__substitute",                         "XXX",   {}, FldAlphanumeric },
   {         SUM,                          "SUM",
      "__gg__sum",                         "n",   {}, FldNumericBin5    },
   {         TAN,                          "TAN",
      "__gg__tan",                         "N",   {}, FldNumericBin5 },
   {         TEST_DATE_YYYYMMDD,           "TEST-DATE-YYYYMMDD",
      "__gg__test_date_yyyymmdd",          "I",   {}, FldNumericBin5 },
   {         TEST_DAY_YYYYDDD,             "TEST-DAY-YYYYDDD",
      "__gg__test_day_yyyyddd",            "I",   {}, FldNumericBin5 },
   {         TEST_FORMATTED_DATETIME,      "TEST-FORMATTED-DATETIME",
      "__gg__test_formatted_datetime",     "XX",  {}, FldNumericBin5 },
   {         TEST_NUMVAL,                  "TEST-NUMVAL",
      "__gg__test_numval",                 "X",   {}, FldNumericBin5 },
   {         TEST_NUMVAL_C,                "TEST-NUMVAL-C",
      "__gg__test_numval_c",               "XXU", {}, FldNumericBin5 },
   {         TEST_NUMVAL_F,                "TEST-NUMVAL-F",
      "__gg__test_numval_f",               "X",   {}, FldNumericBin5 },
   {         TRIM,                         "TRIM",
      "__gg__trim",                        "XI",  {}, FldNumericBin5 },
   {         ULENGTH,                      "ULENGTH",
      "__gg__ulength",                     "X",   {}, FldAlphanumeric },
   {         UPOS,                         "UPOS",
      "__gg__upos",                        "XI",  {}, FldAlphanumeric },
   {         UPPER_CASE,                   "UPPER-CASE",
      "__gg__upper_case",                  "X",   {}, FldAlphanumeric },
   {         USUBSTR,                      "USUBSTR",
      "__gg__usubstr",                     "XII", {}, FldAlphanumeric },
   {         USUPPLEMENTARY,               "USUPPLEMENTARY",
      "__gg__usupplementary",              "X",   {}, FldAlphanumeric },
   {         UUID4,                        "UUID4",
       "__gg_uuid4",                        "",   {}, FldAlphanumeric },
   {         UVALID,                       "UVALID",
      "__gg__uvalid",                      "X",   {}, FldAlphanumeric },
   {         UWIDTH,                       "UWIDTH",
      "__gg__uwidth",                      "XI",  {}, FldAlphanumeric },
   {         VARIANCE,                     "VARIANCE",
      "__gg__variance",                    "n",   {}, FldNumericBin5 },
   {         WHEN_COMPILED,                "WHEN-COMPILED",
      "__gg__when_compiled",               "",    {}, FldAlphanumeric },
   {         YEAR_TO_YYYY,                 "YEAR-TO-YYYY",
      "__gg__year_to_yyyy",                "III",  {}, FldNumericBin5 },
  };

static const
function_descr_t *function_descrs_end = function_descrs + COUNT_OF(function_descrs);

class cname_cmp {
  const char *cname;
 public:
  cname_cmp( const char *cname ) : cname(cname) {}

  bool operator()( const function_descr_t& descr ) {
    return strlen(cname) == strlen(descr.cname) &&
      0 == strcmp(cname, descr.cname);
  }
  bool operator()( const char that[] ) {
    return strlen(cname) == strlen(that) &&
      0 == strcmp(cname, that);
  }
};

/*
 * For variadic intrinsic functions, ensure all parameters are commensurate.
 * Return pointer in 1st inconsistent parameter type.
 * Return NULL to indicate success.
 */
static cbl_refer_t *
intrinsic_inconsistent_parameter( size_t n, cbl_refer_t *args ) {
  class commensurate_type {
    cbl_refer_t first;
   public:
    commensurate_type( const cbl_refer_t& first ) : first(first) {}
    bool operator()( cbl_refer_t& arg )  const {
      return is_numeric(first.field) == is_numeric(arg.field);
    }
  };

  auto p = std::find_if_not(args, args + n, commensurate_type(args[0]));
  return p == args + n? NULL : p;
}

static cbl_field_type_t
intrinsic_return_type( int token ) {
  auto p = std::find_if( function_descrs,
                         function_descrs_end,
                         [token]( const auto& descr ) {
                           return token == descr.token;
                         } );
  return p == function_descrs_end? FldAlphanumeric : p->ret_type;
}

static const char *
intrinsic_cname( int token ) {
  auto p = std::find_if( function_descrs,
                         function_descrs_end,
                         [token]( const auto& descr ) {
                           return token == descr.token;
                         } );
  return p == function_descrs_end?  NULL :  p->cname;
}

const char *
intrinsic_function_name( int token ) {
  auto p = std::find_if( function_descrs,
                         function_descrs_end,
                         [token]( const auto& descr ) {
                           return token == descr.token;
                         } );
  return p == function_descrs_end?  NULL :  p->name;
}

/*
 * Provide supplied function parameters.
 * Return index to 1st invalid parameter type.
 * Return N to indicate success.
 */
static size_t
intrinsic_invalid_parameter( int token,
                             const std::vector<cbl_refer_t>& args )
{
  auto p = std::find_if( function_descrs,
                         function_descrs_end,
                         [token]( const auto& descr ) {
                           return token == descr.token;
                         } );
  if( p == function_descrs_end ) {
    cbl_internal_error( "%s: intrinsic function  %s not found",
                        __func__, keyword_str(token) );
  }

  gcc_assert(!args.empty());
  gcc_assert(p < function_descrs_end);

  const function_descr_t& descr = *p;

  size_t i = 0;
  for( auto arg : args ) {
    if( arg.field == NULL ) {
      i++;
      continue;
    }
    assert(i < strlen(descr.types));

    switch(descr.types[i]) {
    case 'A' : //Alphabetic
    case 'I' : //Integer
    case 'N' : //Numeric
    case 'X' : //Alphanumeric
      break;
    case 'n' : //variadic
      return args.size();
      break;
    case 'D' : //DBCS
    case 'K' : //Keyword
    case 'O' : //Other
    case 'U' : //National
    case '8' : //UTF-8
    default:
      cbl_internal_error( "%s: invalid function descr type '%c'",
           __func__, descr.types[i]);
    }

    static std::map<char, const char*> typenames
      {
        { 'A', "Alphabetic" },
        { 'I', "Integer" },
        { 'N', "Numeric" },
        { 'X', "Alphanumeric" },        
      };

    switch( arg.field->type ) {
    case FldInvalid:
    case FldClass:
    case FldConditional:
    case FldForward:
    case FldIndex:
      yyerror("%s: field '%s' (%s) invalid for %s parameter",
               descr.name,
               arg.field->name, cbl_field_type_str(arg.field->type),
               typenames[descr.types[i]]);
      return i;
      break;
    case FldGroup:
    default:
      break;
    }

    if( is_numeric(arg.field) || is_integer_literal(arg.field)) {
      if( strchr("A", descr.types[i]) != NULL ) {
        yyerror("%s: numeric field '%s' (%s) invalid for %s parameter",
                 descr.name,
                 arg.field->name, cbl_field_type_str(arg.field->type),
                 typenames[descr.types[i]]);
        return i;
      }
    } else { // string field
      if( strchr("IN", descr.types[i]) != NULL ) {
        if( data_category_of(arg.field) == data_alphabetic_e ) {
          yyerror("%s: non-numeric field '%s' (%s) invalid for %s parameter",
                   descr.name,
                   arg.field->name, cbl_field_type_str(arg.field->type),
                   typenames[descr.types[i]]);
          return i;
        }
      }
    }
    i++;
  } // end loop

  return args.size();
}

/*
 * Functions used by code gen
 */

size_t
intrinsic_parameter_count( const char cname[] ) {
  const function_descr_t *descr = std::find_if(function_descrs,
                                               function_descrs_end, cname_cmp(cname));
  return descr == function_descrs_end || descr->types[0] == 'n'?
    size_t(-1) : strlen(descr->types);
}

#if 0
static int
yyreport_syntax_error (const yypcontext_t *ctx)
{
  int res = 0;
  YYLOCATION_PRINT (stderr, yypcontext_location (ctx));
  fprintf (stderr, ": syntax error");
  // Report the tokens expected at this point.
  {
    enum { TOKENMAX = 5 };
    yysymbol_kind_t expected[TOKENMAX];
    int n = yypcontext_expected_tokens (ctx, expected, TOKENMAX);
    if (n < 0)
      // Forward errors to yyparse.
      res = n;
    else
      for (int i = 0; i < n; ++i)
        fprintf (stderr, "%s %s",
                 i == 0 ? ": expected" : " or", yysymbol_name (expected[i]));
  }
  // Report the unexpected token.
  {
    yysymbol_kind_t lookahead = yypcontext_token (ctx);
    if (lookahead != YYSYMBOL_YYEMPTY)
      fprintf (stderr, " before %s", yysymbol_name (lookahead));
  }
  fprintf (stderr, "\n");
  return res;
}
#endif