gcc/fortran/constructor.c

   1 /* Array and structure constructors
   2    Copyright (C) 2009-2018 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 gfc_constructor_base gfc_constructor_get_base (void)
  89 {
  90   return splay_tree_new (splay_tree_compare_ints, NULL, node_free);
  91 }
  92
  93
  94 gfc_constructor_base
  95 gfc_constructor_copy (gfc_constructor_base base)
  96 {
  97   gfc_constructor_base new_base;
  98
  99   if (!base)
 100     return NULL;
 101
 102   new_base = gfc_constructor_get_base ();
 103   splay_tree_foreach (base, node_copy_and_insert, &new_base);
 104
 105   return new_base;
 106 }
 107
 108
 109 void
 110 gfc_constructor_free (gfc_constructor_base base)
 111 {
 112   if (base)
 113     splay_tree_delete (base);
 114 }
 115
 116
 117 gfc_constructor *
 118 gfc_constructor_append (gfc_constructor_base *base, gfc_constructor *c)
 119 {
 120   int offset = 0;
 121   if (*base)
 122     offset = (int)(splay_tree_max (*base)->key) + 1;
 123
 124   return gfc_constructor_insert (base, c, offset);
 125 }
 126
 127
 128 gfc_constructor *
 129 gfc_constructor_append_expr (gfc_constructor_base *base,
 130                              gfc_expr *e, locus *where)
 131 {
 132   gfc_constructor *c = gfc_constructor_get ();
 133   c->expr = e;
 134   if (where)
 135     c->where = *where;
 136
 137   return gfc_constructor_append (base, c);
 138 }
 139
 140
 141 gfc_constructor *
 142 gfc_constructor_insert (gfc_constructor_base *base, gfc_constructor *c, int n)
 143 {
 144   splay_tree_node node;
 145
 146   if (*base == NULL)
 147     *base = splay_tree_new (splay_tree_compare_ints, NULL, node_free);
 148
 149   c->base = *base;
 150   mpz_set_si (c->offset, n);
 151
 152   node = splay_tree_insert (*base, (splay_tree_key) n, (splay_tree_value) c);
 153   gcc_assert (node);
 154
 155   return (gfc_constructor*)node->value;
 156 }
 157
 158
 159 gfc_constructor *
 160 gfc_constructor_insert_expr (gfc_constructor_base *base,
 161                              gfc_expr *e, locus *where, int n)
 162 {
 163   gfc_constructor *c = gfc_constructor_get ();
 164   c->expr = e;
 165   if (where)
 166     c->where = *where;
 167
 168   return gfc_constructor_insert (base, c, n);
 169 }
 170
 171
 172 gfc_constructor *
 173 gfc_constructor_lookup (gfc_constructor_base base, int offset)
 174 {
 175   gfc_constructor *c;
 176   splay_tree_node node;
 177
 178   if (!base)
 179     return NULL;
 180
 181   node = splay_tree_lookup (base, (splay_tree_key) offset);
 182   if (node)
 183     return (gfc_constructor *) node->value;
 184
 185   /* Check if the previous node has a repeat count big enough to
 186      cover the offset looked for.  */
 187   node = splay_tree_predecessor (base, (splay_tree_key) offset);
 188   if (!node)
 189     return NULL;
 190
 191   c = (gfc_constructor *) node->value;
 192   if (mpz_cmp_si (c->repeat, 1) > 0)
 193     {
 194       if (mpz_get_si (c->offset) + mpz_get_si (c->repeat) <= offset)
 195         c = NULL;
 196     }
 197   else
 198     c = NULL;
 199
 200   return c;
 201 }
 202
 203
 204 gfc_expr *
 205 gfc_constructor_lookup_expr (gfc_constructor_base base, int offset)
 206 {
 207   gfc_constructor *c = gfc_constructor_lookup (base, offset);
 208   return c ? c->expr : NULL;
 209 }
 210
 211
 212 int
 213 gfc_constructor_expr_foreach (gfc_constructor *ctor ATTRIBUTE_UNUSED,
 214                               int(*f)(gfc_expr *) ATTRIBUTE_UNUSED)
 215 {
 216   gcc_assert (0);
 217   return 0;
 218 }
 219
 220 void
 221 gfc_constructor_swap (gfc_constructor *ctor ATTRIBUTE_UNUSED,
 222                       int n ATTRIBUTE_UNUSED, int m ATTRIBUTE_UNUSED)
 223 {
 224   gcc_assert (0);
 225 }
 226
 227
 228
 229 gfc_constructor *
 230 gfc_constructor_first (gfc_constructor_base base)
 231 {
 232   if (base)
 233     {
 234       splay_tree_node node = splay_tree_min (base);
 235       return node ? (gfc_constructor*) node->value : NULL;
 236     }
 237   else
 238     return NULL;
 239 }
 240
 241
 242 gfc_constructor *
 243 gfc_constructor_next (gfc_constructor *ctor)
 244 {
 245   if (ctor)
 246     {
 247       splay_tree_node node = splay_tree_successor (ctor->base,
 248                                                    mpz_get_si (ctor->offset));
 249       return node ? (gfc_constructor*) node->value : NULL;
 250     }
 251   else
 252     return NULL;
 253 }
 254
 255
 256 void
 257 gfc_constructor_remove (gfc_constructor *ctor)
 258 {
 259   if (ctor)
 260     splay_tree_remove (ctor->base, mpz_get_si (ctor->offset));
 261 }
 262
 263
 264 gfc_constructor *
 265 gfc_constructor_lookup_next (gfc_constructor_base base, int offset)
 266 {
 267   splay_tree_node node;
 268
 269   if (!base)
 270     return NULL;
 271
 272   node = splay_tree_successor (base, (splay_tree_key) offset);
 273   if (!node)
 274     return NULL;
 275
 276   return (gfc_constructor *) node->value;
 277 }