/[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 1 - (show annotations) (download) (as text)
Fri Oct 29 20:54:12 2004 UTC (17 years, 7 months ago) by aw0a
Original Path: trunk/ascend4/interface/BrowserRel_io.c
File MIME type: text/x-csrc
File size: 10509 byte(s)
Setting up web subdirectory in repository
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 "solver/slv_types.h"
58 #include "interface/HelpProc.h"
59 #include "interface/BrowserProc.h"
60 #include "interface/BrowserRel_io.h"
61 #include "interface/Qlfdid.h"
62 #include "interface/BrowserProc.h"
63 #include "interface/BrowserQuery.h"
64
65 #ifndef lint
66 static CONST char RelationOutputRoutinesRCS[]="$Id: BrowserRel_io.c,v 1.20 2003/08/23 18:43:05 ballan Exp $";
67 #endif
68
69 /* a horde of redundant code deleted. */
70 /**************************************************************************/
71 static struct gl_list_t *g_brow_rellist = NULL;
72 static struct gl_list_t *g_brow_condrellist = NULL;
73 /**************************************************************************/
74
75
76 /* Get a list of pointers to normal relations
77 * and a list of pointers to conditional relations
78 */
79
80 static
81 void BrowGetRelations(struct Instance *i)
82 {
83 CONST struct relation *rel;
84 if (i) {
85 switch(InstanceKind(i)) {
86 case REL_INST:
87 rel = GetInstanceRelationOnly(i);
88 if (!RelationIsCond(rel)) {
89 gl_append_ptr(g_brow_rellist,i);
90 } else { /* conditional relations */
91 gl_append_ptr(g_brow_condrellist,i);
92 }
93 break;
94 default:
95 break;
96 }
97 }
98 }
99
100 /* This functions sends to the interpreter the list of relations
101 * and then the list of conditional relations if required
102 */
103 int Asc_BrowWriteRelListCmd(ClientData cdata, Tcl_Interp *interp,
104 int argc, CONST84 char *argv[])
105 {
106 struct Instance *i, *rel_inst;
107 unsigned long len, c;
108 int save=0;
109
110 (void)cdata; /* stop gcc whine about unused parameter */
111
112 if (( argc < 2 ) || ( argc > 3 )) {
113 Tcl_AppendResult(interp,"wrong # args : ",
114 "Usage \"bgetrels\" ?cur?search? save",(char *)NULL);
115 return TCL_ERROR;
116 }
117
118 if (strncmp(argv[1],"current",3)==0) {
119 i = g_curinst;
120 } else if (strncmp(argv[1],"search",3)==0) {
121 i = g_search_inst;
122 } else {
123 Tcl_SetResult(interp, "invalid args to \"bgetrels\"", TCL_STATIC);
124 return TCL_ERROR;
125 }
126
127 if (argc==3) {
128 if (strncmp(argv[2],"save",4)==0) {
129 save = 1;
130 }
131 }
132
133 if (!i) {
134 return TCL_ERROR;
135 }
136 if (!g_brow_rellist) {
137 g_brow_rellist = gl_create(40L);
138 }
139 if (!g_brow_condrellist) {
140 g_brow_condrellist = gl_create(40L);
141 }
142
143 VisitInstanceTree(i,BrowGetRelations,0,0);
144
145 /* relations */
146 len = gl_length(g_brow_rellist);
147 for (c=1;c<=len;c++) { /* the "{ }" is for making proper list elems */
148 char *tmp;
149 rel_inst = (struct Instance *)gl_fetch(g_brow_rellist,c);
150 Tcl_AppendResult(interp,"{",(char *)NULL);
151 tmp = WriteRelationString(rel_inst,NULL,NULL,NULL,relio_ascend,NULL);
152 Tcl_AppendResult(interp,tmp,(char *)NULL);
153 ascfree(tmp);
154 Tcl_AppendResult(interp,"} ",(char *)NULL);
155 }
156
157 /* conditional relations. Only if required */
158 len = gl_length(g_brow_condrellist);
159 if (len) {
160 Tcl_AppendResult(interp,"{The following Relations are Conditional: } ",
161 (char *)NULL);
162 for (c=1;c<=len;c++) { /* the "{ }" is for making proper list elems */
163 char *tmp;
164 rel_inst = (struct Instance *)gl_fetch(g_brow_condrellist,c);
165 Tcl_AppendResult(interp,"{",(char *)NULL);
166 tmp = WriteRelationString(rel_inst,NULL,NULL,NULL,relio_ascend,NULL);
167 Tcl_AppendResult(interp,tmp,(char *)NULL);
168 ascfree(tmp);
169 Tcl_AppendResult(interp,"} ",(char *)NULL);
170 }
171 }
172 if (!save) {
173 gl_destroy(g_brow_rellist);
174 g_brow_rellist=NULL;
175 gl_destroy(g_brow_condrellist);
176 g_brow_condrellist=NULL;
177 }
178 return TCL_OK;
179 }
180
181
182 /* This function is particular for conditional relations */
183
184 int Asc_BrowWriteCondRelListCmd(ClientData cdata, Tcl_Interp *interp,
185 int argc, CONST84 char *argv[])
186 {
187 struct Instance *i, *rel_inst;
188 unsigned long len, c;
189 int save=0;
190
191 (void)cdata; /* stop gcc whine about unused parameter */
192
193 if (( argc < 2 ) || ( argc > 3 )) {
194 Tcl_AppendResult(interp,"wrong # args : ",
195 "Usage \"bgetcondrels\" ?cur?search? save",(char *)NULL);
196 return TCL_ERROR;
197 }
198
199 if (strncmp(argv[1],"current",3)==0) {
200 i = g_curinst;
201 } else if (strncmp(argv[1],"search",3)==0) {
202 i = g_search_inst;
203 } else {
204 Tcl_SetResult(interp, "invalid args to \"bgetcondrels\"", TCL_STATIC);
205 return TCL_ERROR;
206 }
207
208 if (argc==3) {
209 if (strncmp(argv[2],"save",4)==0) {
210 save = 1;
211 }
212 }
213 if (!i) {
214 return TCL_ERROR;
215 }
216
217 if (!g_brow_rellist) {
218 g_brow_rellist = gl_create(40L);
219 }
220 if (!g_brow_condrellist) {
221 g_brow_condrellist = gl_create(40L);
222 }
223
224 VisitInstanceTree(i,BrowGetRelations,0,0);
225
226 len = gl_length(g_brow_condrellist);
227 if (len) {
228 for (c=1;c<=len;c++) {
229 char *tmp;
230 rel_inst = (struct Instance *)gl_fetch(g_brow_condrellist,c);
231 Tcl_AppendResult(interp,"{",(char *)NULL);
232 tmp = WriteRelationString(rel_inst,NULL,NULL,NULL,relio_ascend,NULL);
233 Tcl_AppendResult(interp,tmp,(char *)NULL);
234 ascfree(tmp);
235 Tcl_AppendResult(interp,"} ",(char *)NULL);
236 }
237 }
238 if (!save) {
239 gl_destroy(g_brow_rellist);
240 g_brow_rellist=NULL;
241 gl_destroy(g_brow_condrellist);
242 g_brow_condrellist=NULL;
243 }
244 return TCL_OK;
245 }
246
247
248 int Asc_BrowWriteRelListPostfixCmd(ClientData cdata, Tcl_Interp *interp,
249 int argc, CONST84 char *argv[])
250 {
251 struct Instance *i, *rel_inst;
252 enum Expr_enum type;
253 unsigned long len, c;
254 int save=0;
255
256 (void)cdata; /* stop gcc whine about unused parameter */
257
258 if (( argc < 2 ) || ( argc > 3 )) {
259 Tcl_AppendResult(interp,"wrong # args : ",
260 "Usage \"bmake_rels\" ?cur?search? save",(char *)NULL);
261 return TCL_ERROR;
262 }
263
264 if (strncmp(argv[1],"current",3)==0) {
265 i = g_curinst;
266 } else if (strncmp(argv[1],"search",3)==0) {
267 i = g_search_inst;
268 } else {
269 Tcl_SetResult(interp, "invalid args to \"bmake_rels\"", TCL_STATIC);
270 return TCL_ERROR;
271 }
272
273 if (argc==3) {
274 if (strncmp(argv[2],"save",4)==0) {
275 save = 1;
276 }
277 }
278
279 if (!i) {
280 return TCL_ERROR;
281 }
282
283
284 if (!g_brow_rellist) {
285 g_brow_rellist = gl_create(40L);
286 }
287 if (!g_brow_condrellist) {
288 g_brow_condrellist = gl_create(40L);
289 }
290
291 VisitInstanceTree(i,BrowGetRelations,0,0);
292
293 len = gl_length(g_brow_rellist);
294 for (c=1;c<=len;c++) { /* the "{ }" is for making proper list elems */
295 char *tmp;
296 rel_inst = (struct Instance *)gl_fetch(g_brow_rellist,c);
297 type = GetInstanceRelationType(rel_inst);
298 if (type!=e_token) { /* FIX FIX FIX */
299 FPRINTF(stderr,"relation type not yet supported\n");
300 continue;
301 }
302 Tcl_AppendResult(interp,"{",(char *)NULL);
303 tmp = WriteRelationPostfixString(rel_inst,NULL);
304 Tcl_AppendResult(interp,tmp,(char *)NULL);
305 ascfree(tmp);
306 Tcl_AppendResult(interp,"} ",(char *)NULL);
307 }
308 if (!save) {
309 gl_destroy(g_brow_rellist);
310 g_brow_rellist=NULL;
311 gl_destroy(g_brow_condrellist);
312 g_brow_condrellist=NULL;
313 }
314 return TCL_OK;
315 }
316
317
318
319 int Asc_BrowWriteRelsForAtomCmd(ClientData cdata,Tcl_Interp *interp,
320 int argc, CONST84 char *argv[])
321 {
322 CONST struct relation *rel;
323 struct Instance *i, *rel_inst;
324 unsigned long nrels, c;
325
326 (void)cdata; /* stop gcc whine about unused parameter */
327
328 if ( argc != 2 ) {
329 Tcl_AppendResult(interp,"wrong # args : ",
330 "Usage :__brow_relsforatom ?cur?search?",(char *)NULL);
331 return TCL_ERROR;
332 }
333 if (strncmp(argv[1],"current",3)==0) {
334 i = g_curinst;
335 } else if (strncmp(argv[1],"search",3)==0) {
336 i = g_search_inst;
337 } else {
338 Tcl_SetResult(interp, "invalid args to \"__brow_relsforatom\"",TCL_STATIC);
339 return TCL_ERROR;
340 }
341 if (!i) {
342 return TCL_ERROR;
343 }
344 if ( (InstanceKind(i) != REAL_ATOM_INST)
345 && (InstanceKind(i)!= REAL_CONSTANT_INST) ) {
346 /* We may soon do booleans also */
347 Tcl_AppendResult(interp,"At the moment only real atoms ",
348 "are allowed in relations",(char *)NULL);
349 return TCL_ERROR;
350 }
351 nrels = RelationsCount(i);
352 for (c=1;c<=nrels;c++) { /* the "{ }" is for making proper list elems */
353 char *tmp;
354 rel_inst = RelationsForAtom(i,c);
355 rel = GetInstanceRelationOnly(rel_inst);
356 Tcl_AppendResult(interp,"{",(char *)NULL);
357 tmp = WriteRelationString(rel_inst,NULL,NULL,NULL,relio_ascend,NULL);
358 Tcl_AppendResult(interp,tmp,(char *)NULL);
359 ascfree(tmp);
360 if (RelationIsCond(rel)) {
361 Tcl_AppendResult(interp," Conditional Relation",(char *)NULL);
362 }
363 Tcl_AppendResult(interp,"} ",(char *)NULL);
364 }
365 return TCL_OK;
366 }

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