//! @file implicit.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
//!
//! IMPLICIT declaration routines.

#include <vif.h>

IDENT *impl_decl (char *name, MODE * mode)
{
// This routine is called with a subexpression as 'name'.
//
// Filter commons, arguments and equivalences.
  if (strchr (name, '.') != NO_TEXT) {
    return NO_IDENT;
  }
  if (strstr (name, "->") != NO_TEXT) {
    return NO_IDENT;
  }
  if (strchr (name, '*') != NO_TEXT) {
    return NO_IDENT;
  }
  if (!IS_VAR (name)) {
    ERROR (2201, "not a variable name", curlex);
    return NO_IDENT;
  }
// Apparently a normal local variable.
  IDENT *idf = find_local (name, mode);
  if (idf != NO_IDENT) {
    if (idf->mode.type == NOTYPE) {
      impl_type (name, &idf->mode);
    }
  } else {
    if (nlocals >= MAX_IDENTS) {
      FATAL (2202, "too many identifiers", NO_TEXT);
      return NO_IDENT;
    }
    idf = &locals[nlocals++];
    memset (idf, 0, sizeof (IDENT));
    idf->line = curlin;
    C_NAME (idf) = c_name (name);
    F_NAME (idf) = f_stralloc (name);
    idf->external = FALSE;
    impl_type (name, &idf->mode);
    if (mode != NO_MODE) {
      *mode = idf->mode;
    }
  }
  return idf;
}

void idfs_impl (void)
{
// Implicit-type remaining stuff
  int_4 k;
  for (k = 0; k < nlocals; k++) {
    IDENT *idf = &locals[k];
    if (idf->mode.type == NOTYPE && !idf->external) {
      int_4 dim = idf->mode.dim;
      impl_type (C_NAME (idf), &(idf->mode));
      idf->mode.dim = dim;
    }
  }
}

void implicit (void)
{
  int_4 k, rc, set = 0, nest = 0;
  NEW_RECORD (mode);
  while ((rc = scan (EXPECT_NONE)) != END_OF_LINE) {
    if (TOKEN ("none")) {
      for (k = ord ('a'); k <= ord ('z'); k++) {
        f2c_type ("none", &(implic[k].mode), NOARG, NOFUN);
        set++;
      }
    } else if (rc == DECLAR) {
      RECCPY (mode, curlex);
    } else if (TOKEN ("automatic")) {
      RECCPY (mode, curlex);
    } else if (TOKEN ("save")) {
      RECCPY (mode, curlex);
    } else if (TOKEN ("undefined")) {
      RECCPY (mode, curlex);
    } else if (TOKEN ("(") && strlen (mode) > 0) {
      NEW_RECORD (a);
      NEW_RECORD (z);
      nest++;
      do {
        rc = scan (EXPECT_NONE);
        if (rc != WORD || strlen (curlex) > 1) {
          EXPECT (2203, "a-z");
          return;
        }
        RECCPY (a, curlex);
        rc = scan (EXPECT_NONE);
        if (TOKEN ("-")) {
          rc = scan (EXPECT_NONE);
          if (rc != WORD || strlen (curlex) > 1) {
            EXPECT (2204, "character range");
            return;
          }
          RECCPY (z, curlex);
          for (k = ord (a[0]); k <= ord (z[0]); k++) {
            if (EQUAL (mode, "automatic")) {
              implic[k].mode.save = AUTOMATIC;
            } else if (EQUAL (mode, "save")) {
              implic[k].mode.save = STATIC;
            } else if (EQUAL (mode, "undefined")) {
              f2c_type ("none", &(implic[k].mode), NOARG, NOFUN);
            } else {
              f2c_type (mode, &(implic[k].mode), NOARG, NOFUN);
            }
          }
          set++;
        } else {
          UNSCAN;
          k = ord (a[0]);
          if (EQUAL (mode, "automatic")) {
            implic[k].mode.save = AUTOMATIC;
          } else if (EQUAL (mode, "save")) {
            implic[k].mode.save = STATIC;
          } else if (EQUAL (mode, "undefined")) {
            f2c_type ("none", &(implic[k].mode), NOARG, NOFUN);
          } else {
            f2c_type (mode, &(implic[k].mode), NOARG, NOFUN);
          }
          set++;
        }
        rc = scan (EXPECT_NONE);
      } while (TOKEN (","));
      if (TOKEN (")")) {
        UNSCAN;
      }
    } else if (TOKEN (")")) {
      nest--;
    } else if (TOKEN (",")) {
      continue;
    } else {
      SYNTAX (2205, "implicit statement");
    }
  }
  if (set == 0) {
    SYNTAX (2206, "implicit statement");
  }
  if (nest != 0) {
    SYNTAX (2207, "parenthesis nesting");
  }
}

void get_impl (void)
{
  int_4 go_on = TRUE;
  default_impl ();
  while (go_on) {
    SAVE_POS (1);
    int_4 rc = scan (EXPECT_NONE);
    if (rc == DECLAR) {
      skip_card (FALSE);
    } else if (TOKEN ("implicit") && IS_NOT_ASSIGNMENT) {
      implicit ();
      skip_card (FALSE);
    } else if (TOKEN ("save") && IS_NOT_ASSIGNMENT) {
      skip_card (FALSE);
    } else if (TOKEN ("automatic") && IS_NOT_ASSIGNMENT) {
      skip_card (FALSE);
    } else if (TOKEN ("parameter") && IS_NOT_ASSIGNMENT) {
      skip_card (FALSE);
    } else if (TOKEN ("common") && IS_NOT_ASSIGNMENT) {
      skip_card (FALSE);
    } else if (TOKEN ("dimension") && IS_NOT_ASSIGNMENT) {
      skip_card (FALSE);
    } else if (TOKEN ("equivalence") && IS_NOT_ASSIGNMENT) {
      skip_card (FALSE);
    } else if (TOKEN ("external") && IS_NOT_ASSIGNMENT) {
      skip_card (FALSE);
    } else if (TOKEN ("intrinsic") && IS_NOT_ASSIGNMENT) {
      skip_card (FALSE);
    } else if (TOKEN ("data") && IS_NOT_ASSIGNMENT) {
      skip_card (FALSE);
    } else if (rc == WORD && IS_MACRO_DECLARATION) {
      skip_card (FALSE);
    } else if (strlen (curlex) > 0) {
// Backspace and done.
      RESTORE_POS (1);
      go_on = FALSE;
    }
  }
}
