xref: /netbsd-src/external/gpl3/gcc.old/dist/gcc/fortran/constructor.c (revision 4c3eb207d36f67d31994830c0a694161fc1ca39b)
1627f7eb2Smrg /* Array and structure constructors
2*4c3eb207Smrg    Copyright (C) 2009-2020 Free Software Foundation, Inc.
3627f7eb2Smrg 
4627f7eb2Smrg This file is part of GCC.
5627f7eb2Smrg 
6627f7eb2Smrg GCC is free software; you can redistribute it and/or modify it under
7627f7eb2Smrg the terms of the GNU General Public License as published by the Free
8627f7eb2Smrg Software Foundation; either version 3, or (at your option) any later
9627f7eb2Smrg version.
10627f7eb2Smrg 
11627f7eb2Smrg GCC is distributed in the hope that it will be useful, but WITHOUT ANY
12627f7eb2Smrg WARRANTY; without even the implied warranty of MERCHANTABILITY or
13627f7eb2Smrg FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
14627f7eb2Smrg for more details.
15627f7eb2Smrg 
16627f7eb2Smrg You should have received a copy of the GNU General Public License
17627f7eb2Smrg along with GCC; see the file COPYING3.  If not see
18627f7eb2Smrg <http://www.gnu.org/licenses/>.  */
19627f7eb2Smrg 
20627f7eb2Smrg #include "config.h"
21627f7eb2Smrg #include "system.h"
22627f7eb2Smrg #include "coretypes.h"
23627f7eb2Smrg #include "gfortran.h"
24627f7eb2Smrg #include "constructor.h"
25627f7eb2Smrg 
26627f7eb2Smrg 
27627f7eb2Smrg static void
node_free(splay_tree_value value)28627f7eb2Smrg node_free (splay_tree_value value)
29627f7eb2Smrg {
30627f7eb2Smrg   gfc_constructor *c = (gfc_constructor*)value;
31627f7eb2Smrg 
32627f7eb2Smrg   if (c->expr)
33627f7eb2Smrg     gfc_free_expr (c->expr);
34627f7eb2Smrg 
35627f7eb2Smrg   if (c->iterator)
36627f7eb2Smrg     gfc_free_iterator (c->iterator, 1);
37627f7eb2Smrg 
38627f7eb2Smrg   mpz_clear (c->offset);
39627f7eb2Smrg   mpz_clear (c->repeat);
40627f7eb2Smrg 
41627f7eb2Smrg   free (c);
42627f7eb2Smrg }
43627f7eb2Smrg 
44627f7eb2Smrg 
45627f7eb2Smrg static gfc_constructor *
node_copy(splay_tree_node node,void * base)46627f7eb2Smrg node_copy (splay_tree_node node, void *base)
47627f7eb2Smrg {
48627f7eb2Smrg   gfc_constructor *c, *src = (gfc_constructor*)node->value;
49627f7eb2Smrg 
50627f7eb2Smrg   c = XCNEW (gfc_constructor);
51627f7eb2Smrg   c->base = (gfc_constructor_base)base;
52627f7eb2Smrg   c->expr = gfc_copy_expr (src->expr);
53627f7eb2Smrg   c->iterator = gfc_copy_iterator (src->iterator);
54627f7eb2Smrg   c->where = src->where;
55627f7eb2Smrg   c->n.component = src->n.component;
56627f7eb2Smrg 
57627f7eb2Smrg   mpz_init_set (c->offset, src->offset);
58627f7eb2Smrg   mpz_init_set (c->repeat, src->repeat);
59627f7eb2Smrg 
60627f7eb2Smrg   return c;
61627f7eb2Smrg }
62627f7eb2Smrg 
63627f7eb2Smrg 
64627f7eb2Smrg static int
node_copy_and_insert(splay_tree_node node,void * base)65627f7eb2Smrg node_copy_and_insert (splay_tree_node node, void *base)
66627f7eb2Smrg {
67627f7eb2Smrg   int n = mpz_get_si (((gfc_constructor*)node->value)->offset);
68627f7eb2Smrg   gfc_constructor_insert ((gfc_constructor_base*)base,
69627f7eb2Smrg 			  node_copy (node, base), n);
70627f7eb2Smrg   return 0;
71627f7eb2Smrg }
72627f7eb2Smrg 
73627f7eb2Smrg 
74627f7eb2Smrg gfc_constructor *
gfc_constructor_get(void)75627f7eb2Smrg gfc_constructor_get (void)
76627f7eb2Smrg {
77627f7eb2Smrg   gfc_constructor *c = XCNEW (gfc_constructor);
78627f7eb2Smrg   c->base = NULL;
79627f7eb2Smrg   c->expr = NULL;
80627f7eb2Smrg   c->iterator = NULL;
81627f7eb2Smrg 
82627f7eb2Smrg   mpz_init_set_si (c->offset, 0);
83627f7eb2Smrg   mpz_init_set_si (c->repeat, 1);
84627f7eb2Smrg 
85627f7eb2Smrg   return c;
86627f7eb2Smrg }
87627f7eb2Smrg 
gfc_constructor_get_base(void)88627f7eb2Smrg gfc_constructor_base gfc_constructor_get_base (void)
89627f7eb2Smrg {
90627f7eb2Smrg   return splay_tree_new (splay_tree_compare_ints, NULL, node_free);
91627f7eb2Smrg }
92627f7eb2Smrg 
93627f7eb2Smrg 
94627f7eb2Smrg gfc_constructor_base
gfc_constructor_copy(gfc_constructor_base base)95627f7eb2Smrg gfc_constructor_copy (gfc_constructor_base base)
96627f7eb2Smrg {
97627f7eb2Smrg   gfc_constructor_base new_base;
98627f7eb2Smrg 
99627f7eb2Smrg   if (!base)
100627f7eb2Smrg     return NULL;
101627f7eb2Smrg 
102627f7eb2Smrg   new_base = gfc_constructor_get_base ();
103627f7eb2Smrg   splay_tree_foreach (base, node_copy_and_insert, &new_base);
104627f7eb2Smrg 
105627f7eb2Smrg   return new_base;
106627f7eb2Smrg }
107627f7eb2Smrg 
108627f7eb2Smrg 
109627f7eb2Smrg void
gfc_constructor_free(gfc_constructor_base base)110627f7eb2Smrg gfc_constructor_free (gfc_constructor_base base)
111627f7eb2Smrg {
112627f7eb2Smrg   if (base)
113627f7eb2Smrg     splay_tree_delete (base);
114627f7eb2Smrg }
115627f7eb2Smrg 
116627f7eb2Smrg 
117627f7eb2Smrg gfc_constructor *
gfc_constructor_append(gfc_constructor_base * base,gfc_constructor * c)118627f7eb2Smrg gfc_constructor_append (gfc_constructor_base *base, gfc_constructor *c)
119627f7eb2Smrg {
120627f7eb2Smrg   int offset = 0;
121627f7eb2Smrg   if (*base)
122627f7eb2Smrg     offset = (int)(splay_tree_max (*base)->key) + 1;
123627f7eb2Smrg 
124627f7eb2Smrg   return gfc_constructor_insert (base, c, offset);
125627f7eb2Smrg }
126627f7eb2Smrg 
127627f7eb2Smrg 
128627f7eb2Smrg gfc_constructor *
gfc_constructor_append_expr(gfc_constructor_base * base,gfc_expr * e,locus * where)129627f7eb2Smrg gfc_constructor_append_expr (gfc_constructor_base *base,
130627f7eb2Smrg 			     gfc_expr *e, locus *where)
131627f7eb2Smrg {
132627f7eb2Smrg   gfc_constructor *c = gfc_constructor_get ();
133627f7eb2Smrg   c->expr = e;
134627f7eb2Smrg   if (where)
135627f7eb2Smrg     c->where = *where;
136627f7eb2Smrg 
137627f7eb2Smrg   return gfc_constructor_append (base, c);
138627f7eb2Smrg }
139627f7eb2Smrg 
140627f7eb2Smrg 
141627f7eb2Smrg gfc_constructor *
gfc_constructor_insert(gfc_constructor_base * base,gfc_constructor * c,int n)142627f7eb2Smrg gfc_constructor_insert (gfc_constructor_base *base, gfc_constructor *c, int n)
143627f7eb2Smrg {
144627f7eb2Smrg   splay_tree_node node;
145627f7eb2Smrg 
146627f7eb2Smrg   if (*base == NULL)
147627f7eb2Smrg     *base = splay_tree_new (splay_tree_compare_ints, NULL, node_free);
148627f7eb2Smrg 
149627f7eb2Smrg   c->base = *base;
150627f7eb2Smrg   mpz_set_si (c->offset, n);
151627f7eb2Smrg 
152627f7eb2Smrg   node = splay_tree_insert (*base, (splay_tree_key) n, (splay_tree_value) c);
153627f7eb2Smrg   gcc_assert (node);
154627f7eb2Smrg 
155627f7eb2Smrg   return (gfc_constructor*)node->value;
156627f7eb2Smrg }
157627f7eb2Smrg 
158627f7eb2Smrg 
159627f7eb2Smrg gfc_constructor *
gfc_constructor_insert_expr(gfc_constructor_base * base,gfc_expr * e,locus * where,int n)160627f7eb2Smrg gfc_constructor_insert_expr (gfc_constructor_base *base,
161627f7eb2Smrg 			     gfc_expr *e, locus *where, int n)
162627f7eb2Smrg {
163627f7eb2Smrg   gfc_constructor *c = gfc_constructor_get ();
164627f7eb2Smrg   c->expr = e;
165627f7eb2Smrg   if (where)
166627f7eb2Smrg     c->where = *where;
167627f7eb2Smrg 
168627f7eb2Smrg   return gfc_constructor_insert (base, c, n);
169627f7eb2Smrg }
170627f7eb2Smrg 
171627f7eb2Smrg 
172627f7eb2Smrg gfc_constructor *
gfc_constructor_lookup(gfc_constructor_base base,int offset)173627f7eb2Smrg gfc_constructor_lookup (gfc_constructor_base base, int offset)
174627f7eb2Smrg {
175627f7eb2Smrg   gfc_constructor *c;
176627f7eb2Smrg   splay_tree_node node;
177627f7eb2Smrg 
178627f7eb2Smrg   if (!base)
179627f7eb2Smrg     return NULL;
180627f7eb2Smrg 
181627f7eb2Smrg   node = splay_tree_lookup (base, (splay_tree_key) offset);
182627f7eb2Smrg   if (node)
183627f7eb2Smrg     return (gfc_constructor *) node->value;
184627f7eb2Smrg 
185627f7eb2Smrg   /* Check if the previous node has a repeat count big enough to
186627f7eb2Smrg      cover the offset looked for.  */
187627f7eb2Smrg   node = splay_tree_predecessor (base, (splay_tree_key) offset);
188627f7eb2Smrg   if (!node)
189627f7eb2Smrg     return NULL;
190627f7eb2Smrg 
191627f7eb2Smrg   c = (gfc_constructor *) node->value;
192627f7eb2Smrg   if (mpz_cmp_si (c->repeat, 1) > 0)
193627f7eb2Smrg     {
194627f7eb2Smrg       if (mpz_get_si (c->offset) + mpz_get_si (c->repeat) <= offset)
195627f7eb2Smrg 	c = NULL;
196627f7eb2Smrg     }
197627f7eb2Smrg   else
198627f7eb2Smrg     c = NULL;
199627f7eb2Smrg 
200627f7eb2Smrg   return c;
201627f7eb2Smrg }
202627f7eb2Smrg 
203627f7eb2Smrg 
204627f7eb2Smrg gfc_expr *
gfc_constructor_lookup_expr(gfc_constructor_base base,int offset)205627f7eb2Smrg gfc_constructor_lookup_expr (gfc_constructor_base base, int offset)
206627f7eb2Smrg {
207627f7eb2Smrg   gfc_constructor *c = gfc_constructor_lookup (base, offset);
208627f7eb2Smrg   return c ? c->expr : NULL;
209627f7eb2Smrg }
210627f7eb2Smrg 
211627f7eb2Smrg 
212627f7eb2Smrg int
gfc_constructor_expr_foreach(gfc_constructor * ctor ATTRIBUTE_UNUSED,int (* f)(gfc_expr *)ATTRIBUTE_UNUSED)213627f7eb2Smrg gfc_constructor_expr_foreach (gfc_constructor *ctor ATTRIBUTE_UNUSED,
214627f7eb2Smrg 			      int(*f)(gfc_expr *) ATTRIBUTE_UNUSED)
215627f7eb2Smrg {
216627f7eb2Smrg   gcc_assert (0);
217627f7eb2Smrg   return 0;
218627f7eb2Smrg }
219627f7eb2Smrg 
220627f7eb2Smrg void
gfc_constructor_swap(gfc_constructor * ctor ATTRIBUTE_UNUSED,int n ATTRIBUTE_UNUSED,int m ATTRIBUTE_UNUSED)221627f7eb2Smrg gfc_constructor_swap (gfc_constructor *ctor ATTRIBUTE_UNUSED,
222627f7eb2Smrg                       int n ATTRIBUTE_UNUSED, int m ATTRIBUTE_UNUSED)
223627f7eb2Smrg {
224627f7eb2Smrg   gcc_assert (0);
225627f7eb2Smrg }
226627f7eb2Smrg 
227627f7eb2Smrg 
228627f7eb2Smrg 
229627f7eb2Smrg gfc_constructor *
gfc_constructor_first(gfc_constructor_base base)230627f7eb2Smrg gfc_constructor_first (gfc_constructor_base base)
231627f7eb2Smrg {
232627f7eb2Smrg   if (base)
233627f7eb2Smrg     {
234627f7eb2Smrg       splay_tree_node node = splay_tree_min (base);
235627f7eb2Smrg       return node ? (gfc_constructor*) node->value : NULL;
236627f7eb2Smrg     }
237627f7eb2Smrg   else
238627f7eb2Smrg     return NULL;
239627f7eb2Smrg }
240627f7eb2Smrg 
241627f7eb2Smrg 
242627f7eb2Smrg gfc_constructor *
gfc_constructor_next(gfc_constructor * ctor)243627f7eb2Smrg gfc_constructor_next (gfc_constructor *ctor)
244627f7eb2Smrg {
245627f7eb2Smrg   if (ctor)
246627f7eb2Smrg     {
247627f7eb2Smrg       splay_tree_node node = splay_tree_successor (ctor->base,
248627f7eb2Smrg 						   mpz_get_si (ctor->offset));
249627f7eb2Smrg       return node ? (gfc_constructor*) node->value : NULL;
250627f7eb2Smrg     }
251627f7eb2Smrg   else
252627f7eb2Smrg     return NULL;
253627f7eb2Smrg }
254627f7eb2Smrg 
255627f7eb2Smrg 
256627f7eb2Smrg void
gfc_constructor_remove(gfc_constructor * ctor)257627f7eb2Smrg gfc_constructor_remove (gfc_constructor *ctor)
258627f7eb2Smrg {
259627f7eb2Smrg   if (ctor)
260627f7eb2Smrg     splay_tree_remove (ctor->base, mpz_get_si (ctor->offset));
261627f7eb2Smrg }
262627f7eb2Smrg 
263627f7eb2Smrg 
264627f7eb2Smrg gfc_constructor *
gfc_constructor_lookup_next(gfc_constructor_base base,int offset)265627f7eb2Smrg gfc_constructor_lookup_next (gfc_constructor_base base, int offset)
266627f7eb2Smrg {
267627f7eb2Smrg   splay_tree_node node;
268627f7eb2Smrg 
269627f7eb2Smrg   if (!base)
270627f7eb2Smrg     return NULL;
271627f7eb2Smrg 
272627f7eb2Smrg   node = splay_tree_successor (base, (splay_tree_key) offset);
273627f7eb2Smrg   if (!node)
274627f7eb2Smrg     return NULL;
275627f7eb2Smrg 
276627f7eb2Smrg   return (gfc_constructor *) node->value;
277627f7eb2Smrg }
278