/[ascend]/trunk/tcltk98/generic/interface/BrowserRel_io.c
ViewVC logotype

Contents of /trunk/tcltk98/generic/interface/BrowserRel_io.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 389 - (show annotations) (download) (as text)
Thu Mar 30 06:24:10 2006 UTC (16 years, 2 months ago) by johnpye
File MIME type: text/x-csrc
File size: 10478 byte(s)
Cleaning up #includes in the Tcl/Tk interface. Doing this
all as a group so that it can be reversed out if necessary.
1 /*
2 * BrowserRel_io.c
3 * by Kirk Abbott and Ben Allan
4 * Created: 1/94
5 * Version: $Revision: 1.20 $
6 * Version control file: $RCSfile: BrowserRel_io.c,v $
7 * Date last modified: $Date: 2003/08/23 18:43:05 $
8 * Last modified by: $Author: ballan $
9 *
10 * This file is part of the ASCEND Tcl/Tk interface
11 *
12 * Copyright 1997, Carnegie Mellon University
13 *
14 * The ASCEND Tcl/Tk interface is free software; you can redistribute
15 * it and/or modify it under the terms of the GNU General Public License as
16 * published by the Free Software Foundation; either version 2 of the
17 * License, or (at your option) any later version.
18 *
19 * The ASCEND Tcl/Tk interface is distributed in hope that it will be
20 * useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
21 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
22 * General Public License for more details.
23 *
24 * You should have received a copy of the GNU General Public License
25 * along with the program; if not, write to the Free Software Foundation,
26 * Inc., 675 Mass Ave, Cambridge, MA 02139 USA. Check the file named
27 * COPYING. COPYING is found in ../compiler.
28 */
29
30
31 #include <tcl.h>
32 #include <utilities/ascConfig.h>
33 #include <utilities/ascMalloc.h>
34 #include <general/list.h>
35 #include <general/dstring.h>
36 #include <compiler/compiler.h>
37 #include <compiler/instance_enum.h>
38 #include <compiler/fractions.h>
39 #include <compiler/dimen.h>
40 #include <compiler/types.h>
41 #include <compiler/relation_type.h>
42 #include <compiler/relation_io.h>
43 #include <compiler/symtab.h>
44 #include <compiler/instance_io.h>
45 #include <compiler/instquery.h>
46 #include <compiler/visitinst.h>
47 #include <compiler/mathinst.h>
48 #include <compiler/extfunc.h>
49 #include <compiler/find.h>
50 #include <compiler/functype.h>
51 #include <compiler/safe.h>
52 #include <compiler/relation.h>
53 #include <compiler/relation_util.h>
54 #include <compiler/func.h>
55 #include <compiler/extcall.h>
56 #include <compiler/instance_name.h>
57 #include <compiler/qlfdid.h>
58 #include <solver/slv_types.h>
59 #include "HelpProc.h"
60 #include "BrowserProc.h"
61 #include "BrowserRel_io.h"
62 #include "Qlfdid.h"
63 #include "BrowserProc.h"
64 #include "BrowserQuery.h"
65
66 #ifndef lint
67 static CONST char RelationOutputRoutinesRCS[]="$Id: BrowserRel_io.c,v 1.20 2003/08/23 18:43:05 ballan Exp $";
68 #endif
69
70 /* a horde of redundant code deleted. */
71 /**************************************************************************/
72 static struct gl_list_t *g_brow_rellist = NULL;
73 static struct gl_list_t *g_brow_condrellist = NULL;
74 /**************************************************************************/
75
76
77 /* Get a list of pointers to normal relations
78 * and a list of pointers to conditional relations
79 */
80
81 static
82 void BrowGetRelations(struct Instance *i)
83 {
84 CONST struct relation *rel;
85 if (i) {
86 switch(InstanceKind(i)) {
87 case REL_INST:
88 rel = GetInstanceRelationOnly(i);
89 if (!RelationIsCond(rel)) {
90 gl_append_ptr(g_brow_rellist,i);
91 } else { /* conditional relations */
92 gl_append_ptr(g_brow_condrellist,i);
93 }
94 break;
95 default:
96 break;
97 }
98 }
99 }
100
101 /* This functions sends to the interpreter the list of relations
102 * and then the list of conditional relations if required
103 */
104 int Asc_BrowWriteRelListCmd(ClientData cdata, Tcl_Interp *interp,
105 int argc, CONST84 char *argv[])
106 {
107 struct Instance *i, *rel_inst;
108 unsigned long len, c;
109 int save=0;
110
111 (void)cdata; /* stop gcc whine about unused parameter */
112
113 if (( argc < 2 ) || ( argc > 3 )) {
114 Tcl_AppendResult(interp,"wrong # args : ",
115 "Usage \"bgetrels\" ?cur?search? save",(char *)NULL);
116 return TCL_ERROR;
117 }
118
119 if (strncmp(argv[1],"current",3)==0) {
120 i = g_curinst;
121 } else if (strncmp(argv[1],"search",3)==0) {
122 i = g_search_inst;
123 } else {
124 Tcl_SetResult(interp, "invalid args to \"bgetrels\"", TCL_STATIC);
125 return TCL_ERROR;
126 }
127
128 if (argc==3) {
129 if (strncmp(argv[2],"save",4)==0) {
130 save = 1;
131 }
132 }
133
134 if (!i) {
135 return TCL_ERROR;
136 }
137 if (!g_brow_rellist) {
138 g_brow_rellist = gl_create(40L);
139 }
140 if (!g_brow_condrellist) {
141 g_brow_condrellist = gl_create(40L);
142 }
143
144 VisitInstanceTree(i,BrowGetRelations,0,0);
145
146 /* relations */
147 len = gl_length(g_brow_rellist);
148 for (c=1;c<=len;c++) { /* the "{ }" is for making proper list elems */
149 char *tmp;
150 rel_inst = (struct Instance *)gl_fetch(g_brow_rellist,c);
151 Tcl_AppendResult(interp,"{",(char *)NULL);
152 tmp = WriteRelationString(rel_inst,NULL,NULL,NULL,relio_ascend,NULL);
153 Tcl_AppendResult(interp,tmp,(char *)NULL);
154 ascfree(tmp);
155 Tcl_AppendResult(interp,"} ",(char *)NULL);
156 }
157
158 /* conditional relations. Only if required */
159 len = gl_length(g_brow_condrellist);
160 if (len) {
161 Tcl_AppendResult(interp,"{The following Relations are Conditional: } ",
162 (char *)NULL);
163 for (c=1;c<=len;c++) { /* the "{ }" is for making proper list elems */
164 char *tmp;
165 rel_inst = (struct Instance *)gl_fetch(g_brow_condrellist,c);
166 Tcl_AppendResult(interp,"{",(char *)NULL);
167 tmp = WriteRelationString(rel_inst,NULL,NULL,NULL,relio_ascend,NULL);
168 Tcl_AppendResult(interp,tmp,(char *)NULL);
169 ascfree(tmp);
170 Tcl_AppendResult(interp,"} ",(char *)NULL);
171 }
172 }
173 if (!save) {
174 gl_destroy(g_brow_rellist);
175 g_brow_rellist=NULL;
176 gl_destroy(g_brow_condrellist);
177 g_brow_condrellist=NULL;
178 }
179 return TCL_OK;
180 }
181
182
183 /* This function is particular for conditional relations */
184
185 int Asc_BrowWriteCondRelListCmd(ClientData cdata, Tcl_Interp *interp,
186 int argc, CONST84 char *argv[])
187 {
188 struct Instance *i, *rel_inst;
189 unsigned long len, c;
190 int save=0;
191
192 (void)cdata; /* stop gcc whine about unused parameter */
193
194 if (( argc < 2 ) || ( argc > 3 )) {
195 Tcl_AppendResult(interp,"wrong # args : ",
196 "Usage \"bgetcondrels\" ?cur?search? save",(char *)NULL);
197 return TCL_ERROR;
198 }
199
200 if (strncmp(argv[1],"current",3)==0) {
201 i = g_curinst;
202 } else if (strncmp(argv[1],"search",3)==0) {
203 i = g_search_inst;
204 } else {
205 Tcl_SetResult(interp, "invalid args to \"bgetcondrels\"", TCL_STATIC);
206 return TCL_ERROR;
207 }
208
209 if (argc==3) {
210 if (strncmp(argv[2],"save",4)==0) {
211 save = 1;
212 }
213 }
214 if (!i) {
215 return TCL_ERROR;
216 }
217
218 if (!g_brow_rellist) {
219 g_brow_rellist = gl_create(40L);
220 }
221 if (!g_brow_condrellist) {
222 g_brow_condrellist = gl_create(40L);
223 }
224
225 VisitInstanceTree(i,BrowGetRelations,0,0);
226
227 len = gl_length(g_brow_condrellist);
228 if (len) {
229 for (c=1;c<=len;c++) {
230 char *tmp;
231 rel_inst = (struct Instance *)gl_fetch(g_brow_condrellist,c);
232 Tcl_AppendResult(interp,"{",(char *)NULL);
233 tmp = WriteRelationString(rel_inst,NULL,NULL,NULL,relio_ascend,NULL);
234 Tcl_AppendResult(interp,tmp,(char *)NULL);
235 ascfree(tmp);
236 Tcl_AppendResult(interp,"} ",(char *)NULL);
237 }
238 }
239 if (!save) {
240 gl_destroy(g_brow_rellist);
241 g_brow_rellist=NULL;
242 gl_destroy(g_brow_condrellist);
243 g_brow_condrellist=NULL;
244 }
245 return TCL_OK;
246 }
247
248
249 int Asc_BrowWriteRelListPostfixCmd(ClientData cdata, Tcl_Interp *interp,
250 int argc, CONST84 char *argv[])
251 {
252 struct Instance *i, *rel_inst;
253 enum Expr_enum type;
254 unsigned long len, c;
255 int save=0;
256
257 (void)cdata; /* stop gcc whine about unused parameter */
258
259 if (( argc < 2 ) || ( argc > 3 )) {
260 Tcl_AppendResult(interp,"wrong # args : ",
261 "Usage \"bmake_rels\" ?cur?search? save",(char *)NULL);
262 return TCL_ERROR;
263 }
264
265 if (strncmp(argv[1],"current",3)==0) {
266 i = g_curinst;
267 } else if (strncmp(argv[1],"search",3)==0) {
268 i = g_search_inst;
269 } else {
270 Tcl_SetResult(interp, "invalid args to \"bmake_rels\"", TCL_STATIC);
271 return TCL_ERROR;
272 }
273
274 if (argc==3) {
275 if (strncmp(argv[2],"save",4)==0) {
276 save = 1;
277 }
278 }
279
280 if (!i) {
281 return TCL_ERROR;
282 }
283
284
285 if (!g_brow_rellist) {
286 g_brow_rellist = gl_create(40L);
287 }
288 if (!g_brow_condrellist) {
289 g_brow_condrellist = gl_create(40L);
290 }
291
292 VisitInstanceTree(i,BrowGetRelations,0,0);
293
294 len = gl_length(g_brow_rellist);
295 for (c=1;c<=len;c++) { /* the "{ }" is for making proper list elems */
296 char *tmp;
297 rel_inst = (struct Instance *)gl_fetch(g_brow_rellist,c);
298 type = GetInstanceRelationType(rel_inst);
299 if (type!=e_token) { /* FIX FIX FIX */
300 FPRINTF(stderr,"relation type not yet supported\n");
301 continue;
302 }
303 Tcl_AppendResult(interp,"{",(char *)NULL);
304 tmp = WriteRelationPostfixString(rel_inst,NULL);
305 Tcl_AppendResult(interp,tmp,(char *)NULL);
306 ascfree(tmp);
307 Tcl_AppendResult(interp,"} ",(char *)NULL);
308 }
309 if (!save) {
310 gl_destroy(g_brow_rellist);
311 g_brow_rellist=NULL;
312 gl_destroy(g_brow_condrellist);
313 g_brow_condrellist=NULL;
314 }
315 return TCL_OK;
316 }
317
318
319
320 int Asc_BrowWriteRelsForAtomCmd(ClientData cdata,Tcl_Interp *interp,
321 int argc, CONST84 char *argv[])
322 {
323 CONST struct relation *rel;
324 struct Instance *i, *rel_inst;
325 unsigned long nrels, c;
326
327 (void)cdata; /* stop gcc whine about unused parameter */
328
329 if ( argc != 2 ) {
330 Tcl_AppendResult(interp,"wrong # args : ",
331 "Usage :__brow_relsforatom ?cur?search?",(char *)NULL);
332 return TCL_ERROR;
333 }
334 if (strncmp(argv[1],"current",3)==0) {
335 i = g_curinst;
336 } else if (strncmp(argv[1],"search",3)==0) {
337 i = g_search_inst;
338 } else {
339 Tcl_SetResult(interp, "invalid args to \"__brow_relsforatom\"",TCL_STATIC);
340 return TCL_ERROR;
341 }
342 if (!i) {
343 return TCL_ERROR;
344 }
345 if ( (InstanceKind(i) != REAL_ATOM_INST)
346 && (InstanceKind(i)!= REAL_CONSTANT_INST) ) {
347 /* We may soon do booleans also */
348 Tcl_AppendResult(interp,"At the moment only real atoms ",
349 "are allowed in relations",(char *)NULL);
350 return TCL_ERROR;
351 }
352 nrels = RelationsCount(i);
353 for (c=1;c<=nrels;c++) { /* the "{ }" is for making proper list elems */
354 char *tmp;
355 rel_inst = RelationsForAtom(i,c);
356 rel = GetInstanceRelationOnly(rel_inst);
357 Tcl_AppendResult(interp,"{",(char *)NULL);
358 tmp = WriteRelationString(rel_inst,NULL,NULL,NULL,relio_ascend,NULL);
359 Tcl_AppendResult(interp,tmp,(char *)NULL);
360 ascfree(tmp);
361 if (RelationIsCond(rel)) {
362 Tcl_AppendResult(interp," Conditional Relation",(char *)NULL);
363 }
364 Tcl_AppendResult(interp,"} ",(char *)NULL);
365 }
366 return TCL_OK;
367 }

john.pye@anu.edu.au
ViewVC Help
Powered by ViewVC 1.1.22