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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 17 - (hide annotations) (download) (as text)
Tue Dec 7 17:37:58 2004 UTC (17 years, 6 months ago) by aw0a
File MIME type: text/x-csrc
File size: 10509 byte(s)
moved interface directory one level deeper in tree
1 aw0a 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