1 /*
2 This file is part of GNU APL, a free implementation of the
3 ISO/IEC Standard 13751, "Programming Language APL, Extended"
4
5 Copyright (C) 2008-2016 Dr. Jürgen Sauermann
6
7 This program 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 3 of the License, or
10 (at your option) any later version.
11
12 This program 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.
16
17 You should have received a copy of the GNU General Public License
18 along with this program. If not, see <http://www.gnu.org/licenses/>.
19 */
20
21 #include "Avec.hh"
22 #include "Bif_F12_FORMAT.hh"
23 #include "Bif_F12_SORT.hh"
24 #include "Bif_F12_TAKE_DROP.hh"
25 #include "Bif_OPER1_COMMUTE.hh"
26 #include "Bif_OPER1_EACH.hh"
27 #include "Bif_OPER1_REDUCE.hh"
28 #include "Bif_OPER1_SCAN.hh"
29 #include "Bif_OPER2_INNER.hh"
30 #include "Bif_OPER2_OUTER.hh"
31 #include "Bif_OPER2_POWER.hh"
32 #include "Bif_OPER2_RANK.hh"
33 #include "Common.hh"
34 #include "Id.hh"
35 #include "Output.hh"
36 #include "PrimitiveFunction.hh"
37 #include "PrintOperator.hh"
38 #include "QuadFunction.hh"
39 #include "Quad_DLX.hh"
40 #include "Quad_FFT.hh"
41 #include "Quad_FX.hh"
42 #include "Quad_GTK.hh"
43 #include "Quad_PLOT.hh"
44 #include "Quad_RE.hh"
45 #include "Quad_SQL.hh"
46 #include "Quad_SVx.hh"
47 #include "Quad_TF.hh"
48 #include "ScalarFunction.hh"
49 #include "UCS_string.hh"
50 #include "Workspace.hh"
51
52 //-----------------------------------------------------------------------------
53 /// an Id and how it looks like in APL
54 struct Id_name
55 {
56 /// compare \b key with \b item (for bsearch())
compareId_name57 static int compare(const void * key, const void * item)
58 {
59 return *reinterpret_cast<const Id *>(key)
60 - reinterpret_cast<const Id_name *>(item)->id;
61 }
62
63 /// the ID
64 Id id;
65
66 /// how \b id is being printed
67 const UTF8 * utf_name;
68 };
69
70 static Id_name id2ucs[] =
71 {
72 #define pp(i, _u, _v) { ID_ ## i, 0},
73 #define qf(i, _u, _v) {ID_Quad_ ## i, 0},
74 #define qv(i, _u, _v) {ID_Quad_ ## i, 0},
75 #define sf(i, _u, _v) {ID_ ## i, 0},
76 #define st(i, _u, _v) {ID_ ## i, 0},
77
78 #include "Id.def"
79 };
80
81 //-----------------------------------------------------------------------------
82 UCS_string
get_name_UCS(Id id)83 ID::get_name_UCS(Id id)
84 {
85 UTF8_string utf(reinterpret_cast<const char *>(get_name(id)));
86 return UCS_string(utf);
87 }
88 //-----------------------------------------------------------------------------
89 void
cleanup()90 ID::cleanup()
91 {
92 }
93 //-----------------------------------------------------------------------------
94 const UTF8 *
get_name(Id id)95 ID::get_name(Id id)
96 {
97 void * result =
98 bsearch(&id, id2ucs, sizeof(id2ucs) / sizeof(Id_name),
99 sizeof(Id_name), Id_name::compare);
100
101 Assert(result);
102 Id_name * idn = static_cast<Id_name *>(result);
103 if (const UTF8 * utf = idn->utf_name) return utf;
104
105 // the name was not yet constructed. Do it now
106 //
107 const char * name = "unknown ID";
108 switch(id)
109 {
110 #define pp(i, _u, _v) case ID_ ## i: name = #i; break;
111 #define qf(i, u, _v) case ID_Quad_ ## i: name = u; break;
112 #define qv(i, u, _v) case ID_Quad_ ## i: name = u; break;
113 #define sf(i, u, _v) case ID_ ## i: name = u; break;
114 #define st(i, u, _v) case ID_ ## i: name = u; break;
115
116 #include "Id.def"
117 }
118
119 return reinterpret_cast<const UTF8 *>(name);
120 }
121 //-----------------------------------------------------------------------------
122 ostream &
operator <<(ostream & out,Id id)123 operator << (ostream & out, Id id)
124 {
125 return out << ID::get_name(id);
126 }
127 //-----------------------------------------------------------------------------
128 Function *
get_system_function(Id id)129 ID::get_system_function(Id id)
130 {
131 switch(id)
132 {
133 #define pp(i, _u, _v)
134 #define qf(i, _u, _v) case ID_Quad_ ## i: return Quad_ ## i::fun;
135 #define qv(i, _u, _v)
136 #define sf(i, _u, _v) case ID_ ## i: return Bif_ ## i::fun;
137 #define st(i, _u, _v)
138
139 #include "Id.def"
140
141 default: break;
142 }
143
144 return 0;
145 }
146 //-----------------------------------------------------------------------------
147 Symbol *
get_system_variable(Id id)148 ID::get_system_variable(Id id)
149 {
150 switch(id)
151 {
152 #define pp(_i, _u, _v)
153 #define qf(_i, _u, _v)
154 #define qv( i, _u, _v) case ID_Quad_ ## i: \
155 return &Workspace::get_v_Quad_ ## i();
156 #define sf(_i, _u, _v)
157 #define st(_i, _u, _v)
158
159 #include "Id.def"
160
161 default: break;
162 }
163
164 return 0;
165 }
166 //-----------------------------------------------------------------------------
167 int
get_token_tag(Id id)168 ID::get_token_tag(Id id)
169 {
170 switch(id)
171 {
172 #define pp(_i, _u, _v)
173 #define qf(_i, _u, _v)
174 #define qv( i, _u, _v) case ID_Quad_ ## i: return TOK_Quad_## i;
175 #define sf(_i, _u, _v)
176 #define st(_i, _u, _v)
177
178 #include "Id.def"
179
180 default: break;
181 }
182
183 return 0;
184 }
185 //-----------------------------------------------------------------------------
186