//! @file assign.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 assignments.

#include <vif.h>

void assign (EXPR * reg)
{
#define ASSIGN_ERROR(s) {\
    NEW_RECORD (str);\
    _srecordf (str, "%s = %s", qtype (&(lhs.mode)), qtype (&(rhs.mode)));\
    ERROR (101, (s), str);\
    return;\
  }
  int_4 rc;
  EXPR lhs, rhs;
  memset (&lhs, 0, sizeof (lhs));
  memset (&rhs, 0, sizeof (rhs));
  lhs_factor = TRUE;
  factor (&lhs);
  lhs_factor = FALSE;
  if (lhs.variant != EXPR_VAR && lhs.variant != EXPR_SLICE && lhs.variant != EXPR_SUBSTR) {
    ERROR (102, "invalid lhs in assignment", lhs.str);
    skip_card (FALSE);
    return;
  }
  if (lhs.variant == EXPR_VAR) {
    IDENT *idf = impl_decl (lhs.str, NO_MODE);
    if (idf != NO_IDENT && IS_ROW (idf->mode)) {
      ERROR (103, "cannot assign to dimensioned variable", curlex);
      skip_card (FALSE);
      return;
    }
  }
  rc = scan (EXPECT_NONE);
  if (TOKEN ("=")) {
    rc = scan (EXPECT_NONE);
    exprio (&rhs, 1, TRUE);
    (void) fold_expr (&rhs, rhs.mode.type);
    rc = scan (EXPECT_NONE);
  } else {
    EXPECT (104, "=");
  }
// Assign.
  if (lhs.mode.type == CHARACTER && rhs.mode.type == CHARACTER) {
    // character*n = character*m; m <= n
    if (lhs.variant == EXPR_SUBSTR) {
      _srecordf (reg->str, "bufrep (%s, %s)", lhs.str, rhs.str);
    } else if (lhs.mode.len == 0) {
      _srecordf (reg->str, "strcpy (%s, %s)", lhs.str, rhs.str);
    } else {
      _srecordf (reg->str, "bufcpy (%s, %s, %d)", lhs.str, rhs.str, lhs.mode.len);
    }
  } else if (rhs.variant == EXPR_CONST && rhs.mode.type == INTEGER && lhs.mode.type == INTEGER) {
// INTEGER length denotations overlap.
    factor_integer_number (&rhs, rhs.str);
    if (rhs.mode.len > lhs.mode.len) {
      MODE_ERROR (105, qtype (&(rhs.mode)), qtype (&(lhs.mode)));
    } 
    _srecordf (reg->str, "%s = %s", lhs.str, rhs.str);
  } else if (lhs.mode.type == rhs.mode.type && lhs.mode.len == rhs.mode.len) {
    if (strcmp (lhs.str, rhs.str) == 0) {
      _srecordf (reg->str, "/* %s = %s */", lhs.str, rhs.str);
    } else {
      _srecordf (reg->str, "%s = %s", lhs.str, rhs.str);
    }
  } else {
    EXPR new = (EXPR) {.mode = lhs.mode};
    if (!coerce (&new, &rhs)) {
      MODE_ERROR (106, qtype (&(rhs.mode)), qtype (&(lhs.mode)));
    }  
    _srecordf (reg->str, "%s = %s", lhs.str, new.str);
  }
  skip_card (TRUE);
  (void) rc;
}
