1/* name.c -- Implementation File (module.c template V1.0)
2   Copyright (C) 1995 Free Software Foundation, Inc.
3   Contributed by James Craig Burley.
4
5This file is part of GNU Fortran.
6
7GNU Fortran is free software; you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
9the Free Software Foundation; either version 2, or (at your option)
10any later version.
11
12GNU Fortran is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Fortran; see the file COPYING.  If not, write to
19the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
2002111-1307, USA.
21
22   Related Modules:
23      None.
24
25   Description:
26      Name and name space abstraction.
27
28   Modifications:
29*/
30
31/* Include files. */
32
33#include "proj.h"
34#include "bad.h"
35#include "name.h"
36#include "lex.h"
37#include "malloc.h"
38#include "src.h"
39#include "where.h"
40
41/* Externals defined here. */
42
43
44/* Simple definitions and enumerations. */
45
46
47/* Internal typedefs. */
48
49
50/* Private include files. */
51
52
53/* Internal structure definitions. */
54
55
56/* Static objects accessed by functions in this module. */
57
58
59/* Static functions (internal). */
60
61static ffename ffename_lookup_ (ffenameSpace ns, ffelexToken t, bool *found);
62
63/* Internal macros. */
64
65
66/* Searches for and returns the matching ffename object, or returns a
67   pointer to the name before which the new name should go.  */
68
69static ffename
70ffename_lookup_ (ffenameSpace ns, ffelexToken t, bool *found)
71{
72  ffename n;
73
74  for (n = ns->first; n != (ffename) &ns->first; n = n->next)
75    {
76      if (ffelex_token_strcmp (t, n->t) == 0)
77	{
78	  *found = TRUE;
79	  return n;
80	}
81    }
82
83  *found = FALSE;
84  return n;			/* (n == (ffename) &ns->first) */
85}
86
87/* Searches for and returns the matching ffename object, or creates a new
88   one (with a NULL ffesymbol) and returns that.  If last arg is TRUE,
89   check whether token meets character-content requirements (such as
90   "all characters must be uppercase", as determined by
91   ffesrc_bad_char_symbol (), issue diagnostic if it doesn't.  */
92
93ffename
94ffename_find (ffenameSpace ns, ffelexToken t)
95{
96  ffename n;
97  ffename newn;
98  bool found;
99
100  assert (ns != NULL);
101  assert ((t != NULL) && ((ffelex_token_type (t) == FFELEX_typeNAME)
102			  || (ffelex_token_type (t) == FFELEX_typeNAMES)));
103
104  n = ffename_lookup_ (ns, t, &found);
105  if (found)
106    return n;
107
108  newn = (ffename) malloc_new_ks (ns->pool, "FFENAME name", sizeof (*n));
109  newn->next = n;
110  newn->previous = n->previous;
111  n->previous = newn;
112  newn->previous->next = newn;
113  newn->t = ffelex_token_use (t);
114  newn->u.s = NULL;
115
116  return newn;
117}
118
119/* ffename_kill -- Kill name from name space
120
121   ffenameSpace ns;
122   ffename s;
123   ffename_kill(ns,s);
124
125   Removes the name from the name space.  */
126
127void
128ffename_kill (ffenameSpace ns, ffename n)
129{
130  assert (ns != NULL);
131  assert (n != NULL);
132
133  ffelex_token_kill (n->t);
134  n->next->previous = n->previous;
135  n->previous->next = n->next;
136  malloc_kill_ks (ns->pool, n, sizeof (*n));
137}
138
139/* ffename_lookup -- Look up name in name space
140
141   ffenameSpace ns;
142   ffelexToken t;
143   ffename s;
144   n = ffename_lookup(ns,t);
145
146   Searches for and returns the matching ffename object, or returns NULL.  */
147
148ffename
149ffename_lookup (ffenameSpace ns, ffelexToken t)
150{
151  ffename n;
152  bool found;
153
154  assert (ns != NULL);
155  assert ((t != NULL) && ((ffelex_token_type (t) == FFELEX_typeNAME)
156			  || (ffelex_token_type (t) == FFELEX_typeNAMES)));
157
158  n = ffename_lookup_ (ns, t, &found);
159
160  return found ? n : NULL;
161}
162
163/* ffename_space_drive_global -- Call given fn for each global in name space
164
165   ffenameSpace ns;
166   ffeglobal (*fn)();
167   ffename_space_drive_global(ns,fn);  */
168
169void
170ffename_space_drive_global (ffenameSpace ns, ffeglobal (*fn) (ffeglobal))
171{
172  ffename n;
173
174  if (ns == NULL)
175    return;
176
177  for (n = ns->first; n != (ffename) &ns->first; n = n->next)
178    {
179      if (n->u.g != NULL)
180	n->u.g = (*fn) (n->u.g);
181    }
182}
183
184/* ffename_space_drive_symbol -- Call given fn for each symbol in name space
185
186   ffenameSpace ns;
187   ffesymbol (*fn)();
188   ffename_space_drive_symbol(ns,fn);  */
189
190void
191ffename_space_drive_symbol (ffenameSpace ns, ffesymbol (*fn) (ffesymbol))
192{
193  ffename n;
194
195  if (ns == NULL)
196    return;
197
198  for (n = ns->first; n != (ffename) &ns->first; n = n->next)
199    {
200      if (n->u.s != NULL)
201	n->u.s = (*fn) (n->u.s);
202    }
203}
204
205/* ffename_space_kill -- Kill name space
206
207   ffenameSpace ns;
208   ffename_space_kill(ns);
209
210   Removes the names from the name space; kills the name space.	 */
211
212void
213ffename_space_kill (ffenameSpace ns)
214{
215  assert (ns != NULL);
216
217  while (ns->first != (ffename) &ns->first)
218    ffename_kill (ns, ns->first);
219
220  malloc_kill_ks (ns->pool, ns, sizeof (*ns));
221}
222
223/* ffename_space_new -- Create name space
224
225   ffenameSpace ns;
226   ns = ffename_space_new(malloc_pool_image());
227
228   Create new name space.  */
229
230ffenameSpace
231ffename_space_new (mallocPool pool)
232{
233  ffenameSpace ns;
234
235  ns = (ffenameSpace) malloc_new_ks (pool, "FFENAME space",
236				     sizeof (*ns));
237  ns->first = (ffename) &ns->first;
238  ns->last = (ffename) &ns->first;
239  ns->pool = pool;
240
241  return ns;
242}
243