1 /* info.c -- Implementation File (module.c template V1.0)
2 Copyright (C) 1995 Free Software Foundation, Inc.
3 Contributed by James Craig Burley (burley@gnu.org).
5 This file is part of GNU Fortran.
7 GNU Fortran is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Fortran is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Fortran; see the file COPYING. If not, write to
19 the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
26 An abstraction for information maintained on a per-operator and per-
27 operand basis in expression trees.
31 Extensive rewrite for new cleaner approach.
41 /* Externals defined here. */
44 /* Simple definitions and enumerations. */
47 /* Internal typedefs. */
50 /* Private include files. */
53 /* Internal structure definitions. */
56 /* Static objects accessed by functions in this module. */
58 static char *ffeinfo_basictype_string_[]
61 #define FFEINFO_BASICTYPE(KWD,LNAM,SNAM) SNAM,
63 #undef FFEINFO_BASICTYPE
65 static char *ffeinfo_kind_message_[]
68 #define FFEINFO_KIND(KWD,LNAM,SNAM) LNAM,
72 static char *ffeinfo_kind_string_[]
75 #define FFEINFO_KIND(KWD,LNAM,SNAM) SNAM,
79 static ffeinfoBasictype ffeinfo_combine_[FFEINFO_basictype][FFEINFO_basictype];
80 static char *ffeinfo_kindtype_string_[]
94 static char *ffeinfo_where_string_[]
97 #define FFEINFO_WHERE(KWD,LNAM,SNAM) SNAM,
101 static ffetype ffeinfo_types_[FFEINFO_basictype][FFEINFO_kindtype]
104 /* Static functions (internal). */
107 /* Internal macros. */
110 /* ffeinfo_basictype_combine -- Combine two basictypes into highest rank type
112 ffeinfoBasictype i, j, k;
113 k = ffeinfo_basictype_combine(i,j);
115 Returns a type based on "standard" operation between two given types. */
118 ffeinfo_basictype_combine (ffeinfoBasictype l, ffeinfoBasictype r)
120 assert (l < FFEINFO_basictype);
121 assert (r < FFEINFO_basictype);
122 return ffeinfo_combine_[l][r];
125 /* ffeinfo_basictype_string -- Return tiny string showing the basictype
128 printf("%s",ffeinfo_basictype_string(dt));
130 Returns the string based on the basic type. */
133 ffeinfo_basictype_string (ffeinfoBasictype basictype)
135 if (basictype >= ARRAY_SIZE (ffeinfo_basictype_string_))
137 return ffeinfo_basictype_string_[basictype];
140 /* ffeinfo_init_0 -- Initialize
150 assert (FFEINFO_basictype == ARRAY_SIZE (ffeinfo_basictype_string_));
151 assert (FFEINFO_kind == ARRAY_SIZE (ffeinfo_kind_message_));
152 assert (FFEINFO_kind == ARRAY_SIZE (ffeinfo_kind_string_));
153 assert (FFEINFO_kindtype == ARRAY_SIZE (ffeinfo_kindtype_string_));
154 assert (FFEINFO_where == ARRAY_SIZE (ffeinfo_where_string_));
156 /* Make array that, given two basic types, produces resulting basic type. */
158 for (i = 0; i < FFEINFO_basictype; ++i)
159 for (j = 0; j < FFEINFO_basictype; ++j)
160 if ((i == FFEINFO_basictypeANY) || (j == FFEINFO_basictypeANY))
161 ffeinfo_combine_[i][j] = FFEINFO_basictypeANY;
163 ffeinfo_combine_[i][j] = FFEINFO_basictypeNONE;
165 #define same(bt) ffeinfo_combine_[bt][bt] = bt
166 #define use2(bt1,bt2) ffeinfo_combine_[bt1][bt2] \
167 = ffeinfo_combine_[bt2][bt1] = bt2
169 same (FFEINFO_basictypeINTEGER);
170 same (FFEINFO_basictypeLOGICAL);
171 same (FFEINFO_basictypeREAL);
172 same (FFEINFO_basictypeCOMPLEX);
173 same (FFEINFO_basictypeCHARACTER);
174 use2 (FFEINFO_basictypeINTEGER, FFEINFO_basictypeREAL);
175 use2 (FFEINFO_basictypeINTEGER, FFEINFO_basictypeCOMPLEX);
176 use2 (FFEINFO_basictypeREAL, FFEINFO_basictypeCOMPLEX);
182 /* ffeinfo_kind_message -- Return helpful string showing the kind
185 printf("%s",ffeinfo_kind_message(kind));
187 Returns the string based on the kind. */
190 ffeinfo_kind_message (ffeinfoKind kind)
192 if (kind >= ARRAY_SIZE (ffeinfo_kind_message_))
194 return ffeinfo_kind_message_[kind];
197 /* ffeinfo_kind_string -- Return tiny string showing the kind
200 printf("%s",ffeinfo_kind_string(kind));
202 Returns the string based on the kind. */
205 ffeinfo_kind_string (ffeinfoKind kind)
207 if (kind >= ARRAY_SIZE (ffeinfo_kind_string_))
209 return ffeinfo_kind_string_[kind];
213 ffeinfo_kindtype_max(ffeinfoBasictype bt,
217 if ((bt == FFEINFO_basictypeANY)
218 || (k1 == FFEINFO_kindtypeANY)
219 || (k2 == FFEINFO_kindtypeANY))
220 return FFEINFO_kindtypeANY;
222 if (ffetype_size (ffeinfo_types_[bt][k1])
223 > ffetype_size (ffeinfo_types_[bt][k2]))
228 /* ffeinfo_kindtype_string -- Return tiny string showing the kind type
230 ffeinfoKindtype kind_type;
231 printf("%s",ffeinfo_kindtype_string(kind));
233 Returns the string based on the kind type. */
236 ffeinfo_kindtype_string (ffeinfoKindtype kind_type)
238 if (kind_type >= ARRAY_SIZE (ffeinfo_kindtype_string_))
240 return ffeinfo_kindtype_string_[kind_type];
244 ffeinfo_set_type (ffeinfoBasictype basictype, ffeinfoKindtype kindtype,
247 assert (basictype < FFEINFO_basictype);
248 assert (kindtype < FFEINFO_kindtype);
249 assert (ffeinfo_types_[basictype][kindtype] == NULL);
251 ffeinfo_types_[basictype][kindtype] = type;
255 ffeinfo_type (ffeinfoBasictype basictype, ffeinfoKindtype kindtype)
257 assert (basictype < FFEINFO_basictype);
258 assert (kindtype < FFEINFO_kindtype);
260 return ffeinfo_types_[basictype][kindtype];
263 /* ffeinfo_where_string -- Return tiny string showing the where
266 printf("%s",ffeinfo_where_string(where));
268 Returns the string based on the where. */
271 ffeinfo_where_string (ffeinfoWhere where)
273 if (where >= ARRAY_SIZE (ffeinfo_where_string_))
275 return ffeinfo_where_string_[where];
278 /* ffeinfo_new -- Return object representing datatype, kind, and where info
281 i = ffeinfo_new(FFEINFO_datatypeINTEGER,FFEINFO_kindSCALAR,
284 Returns the string based on the data type. */
288 ffeinfo_new (ffeinfoBasictype basictype, ffeinfoKindtype kindtype,
289 ffeinfoRank rank, ffeinfoKind kind, ffeinfoWhere where,
290 ffetargetCharacterSize size)
294 i.basictype = basictype;
295 i.kindtype = kindtype;