gcc/fortran/constructor.cc

   1 /* Array and structure constructors
   2    Copyright (C) 2009-2023 Free Software Foundation, Inc.
   3
   4 This file is part of GCC.
   5
   6 GCC is free software; you can redistribute it and/or modify it under
   7 the terms of the GNU General Public License as published by the Free
   8 Software Foundation; either version 3, or (at your option) any later
   9 version.
  10
  11 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
  12 WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  14 for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with GCC; see the file COPYING3.  If not see
  18 <http://www.gnu.org/licenses/>.  */
  19
  20 #include "config.h"
  21 #include "system.h"
  22 #include "coretypes.h"
  23 #include "gfortran.h"
  24 #include "constructor.h"
  25
  26
  27 static void
  28 node_free (splay_tree_value value)
  29 {
  30   gfc_constructor *c = (gfc_constructor*)value;
  31
  32   if (c->expr)
  33     gfc_free_expr (c->expr);
  34
  35   if (c->iterator)
  36     gfc_free_iterator (c->iterator, 1);
  37
  38   mpz_clear (c->offset);
  39   mpz_clear (c->repeat);
  40
  41   free (c);
  42 }
  43
  44
  45 static gfc_constructor *
  46 node_copy (splay_tree_node node, void *base)
  47 {
  48   gfc_constructor *c, *src = (gfc_constructor*)node->value;
  49
  50   c = XCNEW (gfc_constructor);
  51   c->base = (gfc_constructor_base)base;
  52   c->expr = gfc_copy_expr (src->expr);
  53   c->iterator = gfc_copy_iterator (src->iterator);
  54   c->where = src->where;
  55   c->n.component = src->n.component;
  56
  57   mpz_init_set (c->offset, src->offset);
  58   mpz_init_set (c->repeat, src->repeat);
  59
  60   return c;
  61 }
  62
  63
  64 static int
  65 node_copy_and_insert (splay_tree_node node, void *base)
  66 {
  67   int n = mpz_get_si (((gfc_constructor*)node->value)->offset);
  68   gfc_constructor_insert ((gfc_constructor_base*)base,
  69                           node_copy (node, base), n);
  70   return 0;
  71 }
  72
  73
  74 gfc_constructor *
  75 gfc_constructor_get (void)
  76 {
  77   gfc_constructor *c = XCNEW (gfc_constructor);
  78   c->base = NULL;
  79   c->expr = NULL;
  80   c->iterator = NULL;
  81
  82   mpz_init_set_si (c->offset, 0);
  83   mpz_init_set_si (c->repeat, 1);
  84
  85   return c;
  86 }
  87
  88 static gfc_constructor_base
  89 gfc_constructor_get_base (void)
  90 {
  91   return splay_tree_new (splay_tree_compare_ints, NULL, node_free);
  92 }
  93
  94
  95 gfc_constructor_base
  96 gfc_constructor_copy (gfc_constructor_base base)
  97 {
  98   gfc_constructor_base new_base;
  99
 100   if (!base)
 101     return NULL;
 102
 103   new_base = gfc_constructor_get_base ();
 104   splay_tree_foreach (base, node_copy_and_insert, &new_base);
 105
 106   return new_base;
 107 }
 108
 109
 110 void
 111 gfc_constructor_free (gfc_constructor_base base)
 112 {
 113   if (base)
 114     splay_tree_delete (base);
 115 }
 116
 117
 118 gfc_constructor *
 119 gfc_constructor_append (gfc_constructor_base *base, gfc_constructor *c)
 120 {
 121   int offset = 0;
 122   if (*base)
 123     offset = (int)(splay_tree_max (*base)->key) + 1;
 124
 125   return gfc_constructor_insert (base, c, offset);
 126 }
 127
 128
 129 gfc_constructor *
 130 gfc_constructor_append_expr (gfc_constructor_base *base,
 131                              gfc_expr *e, locus *where)
 132 {
 133   gfc_constructor *c = gfc_constructor_get ();
 134   c->expr = e;
 135   if (where)
 136     c->where = *where;
 137
 138   return gfc_constructor_append (base, c);
 139 }
 140
 141
 142 gfc_constructor *
 143 gfc_constructor_insert (gfc_constructor_base *base, gfc_constructor *c, int n)
 144 {
 145   splay_tree_node node;
 146
 147   if (*base == NULL)
 148     *base = splay_tree_new (splay_tree_compare_ints, NULL, node_free);
 149
 150   c->base = *base;
 151   mpz_set_si (c->offset, n);
 152
 153   node = splay_tree_insert (*base, (splay_tree_key) n, (splay_tree_value) c);
 154   gcc_assert (node);
 155
 156   return (gfc_constructor*)node->value;
 157 }
 158
 159
 160 gfc_constructor *
 161 gfc_constructor_insert_expr (gfc_constructor_base *base,
 162                              gfc_expr *e, locus *where, int n)
 163 {
 164   gfc_constructor *c = gfc_constructor_get ();
 165   c->expr = e;
 166   if (where)
 167     c->where = *where;
 168
 169   return gfc_constructor_insert (base, c, n);
 170 }
 171
 172
 173 gfc_constructor *
 174 gfc_constructor_lookup (gfc_constructor_base base, int offset)
 175 {
 176   gfc_constructor *c;
 177   splay_tree_node node;
 178
 179   if (!base)
 180     return NULL;
 181
 182   node = splay_tree_lookup (base, (splay_tree_key) offset);
 183   if (node)
 184     return (gfc_constructor *) node->value;
 185
 186   /* Check if the previous node has a repeat count big enough to
 187      cover the offset looked for.  */
 188   node = splay_tree_predecessor (base, (splay_tree_key) offset);
 189   if (!node)
 190     return NULL;
 191
 192   c = (gfc_constructor *) node->value;
 193   if (mpz_cmp_si (c->repeat, 1) > 0)
 194     {
 195       if (mpz_get_si (c->offset) + mpz_get_si (c->repeat) <= offset)
 196         c = NULL;
 197     }
 198   else
 199     c = NULL;
 200
 201   return c;
 202 }
 203
 204
 205 gfc_expr *
 206 gfc_constructor_lookup_expr (gfc_constructor_base base, int offset)
 207 {
 208   gfc_constructor *c = gfc_constructor_lookup (base, offset);
 209   return c ? c->expr : NULL;
 210 }
 211
 212
 213 gfc_constructor *
 214 gfc_constructor_first (gfc_constructor_base base)
 215 {
 216   if (base)
 217     {
 218       splay_tree_node node = splay_tree_min (base);
 219       return node ? (gfc_constructor*) node->value : NULL;
 220     }
 221   else
 222     return NULL;
 223 }
 224
 225
 226 gfc_constructor *
 227 gfc_constructor_next (gfc_constructor *ctor)
 228 {
 229   if (ctor)
 230     {
 231       splay_tree_node node = splay_tree_successor (ctor->base,
 232                                                    mpz_get_si (ctor->offset));
 233       return node ? (gfc_constructor*) node->value : NULL;
 234     }
 235   else
 236     return NULL;
 237 }
 238
 239
 240 void
 241 gfc_constructor_remove (gfc_constructor *ctor)
 242 {
 243   if (ctor)
 244     splay_tree_remove (ctor->base, mpz_get_si (ctor->offset));
 245 }
 246
 247
 248 gfc_constructor *
 249 gfc_constructor_lookup_next (gfc_constructor_base base, int offset)
 250 {
 251   splay_tree_node node;
 252
 253   if (!base)
 254     return NULL;
 255
 256   node = splay_tree_successor (base, (splay_tree_key) offset);
 257   if (!node)
 258     return NULL;
 259
 260   return (gfc_constructor *) node->value;
 261 }