//! @file dimension.c
//! @author J. Marcel van der Veer
//
//! @section Copyright
//
// This file is part of VIF - vintage FORTRAN compiler.
// Copyright 2020-2025 J. Marcel van der Veer <algol68g@xs4all.nl>.
//
//! @section License
//
// 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 3 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/>.

//! @section Synopsis
//!
//! Compile DIMENSION.

#include <vif.h>

void get_dims (IDENT * idf, int_4 dim)
{
  EXPR reg;
  NEW_RECORD (str);
  int_4 rc;
  memset (&reg, 0, sizeof (EXPR));
  rc = scan (EXPECT_NONE);
  if (TOKEN ("*")) {
    idf->lwb[idf->mode.dim] = f_stralloc ("1");
    idf->upb[idf->mode.dim] = f_stralloc ("0");
    idf->len[idf->mode.dim++] = f_stralloc ("VARY");
    rc = scan (EXPECT_NONE);
  } else {
    macro_depth = 0;
    express (&reg, INTEGER, 4);
    if (reg.variant != EXPR_CONST) {
      if (reg.variant == EXPR_VAR && reg.idf->arg == ARG) {
        ;
      } else if (reg.variant == EXPR_VAR && reg.idf->common > 0) {
        ;
      } else if (reg.variant == EXPR_VAR) {
        ERROR (1201, "must be common or parameter", F_NAME (reg.idf));  
      }
      idf->variable = TRUE;
      idf->mode.save = AUTOMATIC;
    }
    rc = scan (EXPECT_NONE);
    int varying = FALSE;
    if (TOKEN (":")) {
      idf->lwb[idf->mode.dim] = f_stralloc (reg.str);
      rc = scan (EXPECT_NONE);
      if (TOKEN ("*")) {
// (lwb : *)
        idf->upb[idf->mode.dim] = f_stralloc ("0");
        idf->len[idf->mode.dim++] = f_stralloc ("VARY");
        varying = TRUE;
      } else {
        macro_depth = 0;
        express (&reg, INTEGER, 4);
        if (reg.variant != EXPR_CONST) {
          if (reg.variant == EXPR_VAR && reg.idf->arg == ARG) {
            ;
          } else if (reg.variant == EXPR_VAR && reg.idf->common > 0) {
            ;
          } else if (reg.variant == EXPR_VAR) {
            ERROR (1202, "must be common or parameter", F_NAME (reg.idf));  
          }
          idf->variable = TRUE;
          idf->mode.save = AUTOMATIC;
        }
        idf->upb[idf->mode.dim] = f_stralloc (reg.str);
      }
      rc = scan (EXPECT_NONE);
    } else {
      idf->lwb[idf->mode.dim] = f_stralloc ("1");
      idf->upb[idf->mode.dim] = f_stralloc (reg.str);
    }
    if (! varying) {
      NEW_RECORD (buf);
      if (strcmp (idf->lwb[idf->mode.dim], "1") == 0) {
        _srecordf (str, "%s", idf->upb[idf->mode.dim]);
      } else {
        _srecordf (str, "%s - %s + 1", idf->upb[idf->mode.dim], idf->lwb[idf->mode.dim]);
      }
      fold_int_4 (buf, str);
      idf->len[idf->mode.dim++] = f_stralloc (buf);
    }
  }
  if (TOKEN (",")) {
    if (dim < MAX_DIMS) {
      get_dims (idf, dim + 1);
    } else {
      ERROR (1203, "too many dimensions", NO_TEXT);
    }
  }
  (void) rc;
}

void dimension (void)
{
  int_4 rc = scan (EXPECT_NONE), set = 0;
  while (rc != END_OF_LINE) {
    MODE mode;
    if (rc == WORD) {
      if (/* reserved (curlex) */ FALSE) {
        ERROR (1204, "reserved symbol", curlex);
      }
      set++;
      IDENT *idf = void_decl (curlex, &mode);
      rc = scan ("(");
      if (idf != NO_IDENT) {
        if (IS_ROW (idf->mode)) {
          ERROR (1205, "variable already dimensioned", F_NAME (idf));
        }
        get_dims (idf, 1);
        CHECKPOINT (1206, ")");
        rc = scan (EXPECT_NONE);
      }
    }
    if (TOKEN (",")) {
      rc = scan (EXPECT_NONE);
      if (! WITHIN) {
        SYNTAX (1207, NO_TEXT);
      }
    } else {
      if (rc != END_OF_LINE) {
        SYNTAX (1208, NO_TEXT);
        rc = scan (EXPECT_NONE);
      }
    }
  }
  if (set == 0) {
    SYNTAX (1209, "dimension statement");
  }
}
