/[ascend]/trunk/tcltk98/generic/interface/typelex.l
ViewVC logotype

Annotation of /trunk/tcltk98/generic/interface/typelex.l

Parent Directory Parent Directory | Revision Log Revision Log


Revision 390 - (hide annotations) (download)
Thu Mar 30 06:41:17 2006 UTC (18 years ago) by johnpye
File size: 25301 byte(s)
The Tcl/Tk interface now runs as well. Tried with Tcl/Tk 8.4, so needs to be run
on a system with Tcl/Tk 8.3 next up.
1 aw0a 1 %{
2     /*
3     * TypeExtractor.l
4     * by Kirk Abbott and Ben Allan
5     * Created: 1/94
6     * Version: $Revision: 1.20 $
7     * Version control file: $RCSfile: typelex.l,v $
8     * Date last modified: $Date: 2003/08/23 18:43:09 $
9     * Last modified by: $Author: ballan $
10     *
11     * This file is part of the ASCEND Tcl/Tk interface
12     *
13     * Copyright 1997, Carnegie Mellon University
14     *
15     * The ASCEND Tcl/Tk interface is free software; you can redistribute
16     * it and/or modify it under the terms of the GNU General Public License as
17     * published by the Free Software Foundation; either version 2 of the
18     * License, or (at your option) any later version.
19     *
20     * The ASCEND Tcl/Tk interface is distributed in hope that it will be
21     * useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
22     * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
23     * General Public License for more details.
24     *
25     * You should have received a copy of the GNU General Public License
26     * along with the program; if not, write to the Free Software Foundation,
27     * Inc., 675 Mass Ave, Cambridge, MA 02139 USA. Check the file named
28     * COPYING. COPYING is found in ../compiler.
29     */
30    
31     /*
32     * ASCEND Type Retriever 1.2
33     *
34     * Purpose:
35     * To extract a type definition from an input file.
36     * Usage:
37     * See the header file for use from within ASCEND.
38     * For stand-alone use:
39     * typer [flags] ascend_type_name input_file output_file
40     * flags: -c show comments
41     * If no -c given, strip out comments.
42     * Features:
43     * --Does not descend into REQUIREd files. Only examines input_file
44     * for definitions of ascend_type_name.
45     * --This version DOES handle the UNIVERSAL quantifier.
46     *
47     */
48    
49 johnpye 390 #define MY_YYMORE() yymore()
50    
51     #include <tcl.h>
52     #include <utilities/ascConfig.h>
53     #include <general/list.h>
54 aw0a 1 #ifndef TYPER_TEST
55     /* for handling string modules and results in interp */
56 johnpye 390 #include <compiler/compiler.h>
57     #include <compiler/symtab.h>
58     #include <compiler/fractions.h>
59     #include <compiler/dimen.h>
60     #include <compiler/child.h>
61     #include <compiler/type_desc.h>
62     #include <compiler/library.h>
63     #include <compiler/module.h>
64     #include "HelpProc.h" /* help is not necessary for test */
65 aw0a 1 #endif /*!typertest*/
66    
67 johnpye 390 #include "typelex.h"
68 aw0a 1
69 johnpye 390
70 aw0a 1 #ifndef lint
71     static const char TyperID[] = "$Id: typelex.l,v 1.20 2003/08/23 18:43:09 ballan Exp $";
72     #endif
73    
74 johnpye 390 #define YY_BREAK
75 aw0a 1 /*
76 johnpye 390 * Defining yybreak as above (empty) means that all of our matches must end
77     * in break or return because the normal flex supplied yybreak will
78 aw0a 1 * be preempted by our empty one.
79     * In cases where matches contain a conditional return, make sure a
80     * break follows in the failure case.
81     */
82    
83     static int CommentNestLevel = 0;
84     /*
85     * Nesting level of (* comments *)
86     */
87    
88     static int BracesNestLevel = 0;
89     /*
90     * Nesting level of {braced} expressions
91     */
92    
93     enum keyword_tokens {
94     NONE, /* Nothing to match, we're in the initial state */
95     MODEL, /* We've just read a MODEL or ATOM keyword */
96     MODEL_END, /* We've just read an END keyword inside a MODEL,
97     * an ATOM, or a DEFINITION. */
98     CONSTANT /* We've just read a CONSTANT keyword */
99     };
100     static enum keyword_tokens MatchedToken = NONE;
101     /*
102     * The recognized token we've most recently read. This usually implies
103     * that we're either in that state or we need to check the next keyword
104     * to see if we should enter (or leave, in the case of MODEL_END) that
105     * state. MODEL, ATOM, and DEFINITION state are equivalent.
106     */
107    
108     static int ShowComments = 0;
109     /*
110     * Should we print comments? (1 = yes, 0 = no)
111     * This is set to 1 with `-c' on the command line
112     */
113    
114     static unsigned long StartId = 0;
115     /*
116 johnpye 386 * The location in the `zztext' array where the MODEL, ATOM, or CONSTANT
117 johnpye 390 * identifierbegins. We save this value and call MY_YYMORE() when we find
118 aw0a 1 * a MODEL, ATOM, or CONSTANT keyword; StartId tells us where the
119     * Identifier will go.
120     */
121    
122     static char *reqType = "";
123     /*
124     * The type we are looking for. This is one of the arguments passed
125     * to Asc_ExtractType() in the argv vector.
126     */
127    
128 johnpye 386 static Tcl_Interp *g_zz_interp;
129 aw0a 1 /* during parse, set to caller's interp if string result is wanted
130     * instead of file.
131     */
132    
133     #ifdef TYPER_TEST
134     /*
135     * Specify ASCERR, ASCWAR when building stand alone.
136     */
137     FILE *ASCERR = stderr;
138     FILE *ASCWAR = stderr;
139     #endif /* TYPER_TEST */
140    
141     %}
142    
143     ws [\f\r\t\v ]
144     digit [0-9]
145     letter [a-zA-Z]
146    
147     ident {letter}({digit}|{letter}|_)*
148    
149     model MODEL{ws}+
150     atom ATOM{ws}+
151     definition DEFINITION{ws}+
152     end END{ws}+
153     univ UNIVERSAL{ws}+
154     constant CONSTANT{ws}+
155    
156     %x Comment
157     %x BracedText
158     %x Model
159     %x Constant
160     %x CheckID
161    
162     %%
163    
164     /*
165     * Code to handle (* Comments *)
166     *
167     * "(*" puts us into the Comment state. Comments nest, so in the
168     * Comment state we need to look for "(*" that increases the nesting
169     * level and "*)" that will lower it.
170     * Do NOT try to match \(\*+ since that causes "(****)" to parse
171     * incorrectly.
172     */
173    
174     <INITIAL>\(\* |
175     <Model>\(\* |
176     <Constant>\(\* {
177     /* Match "(" followed by "*" puts us into
178     * the COMMENT state. Don't use \*+ since
179     * that will parse "(***)" incorrectly.
180     * Initialize the nesting level.
181     * Print if ShowComments is TRUE and
182     * MatchedToken is not NONE
183     */
184     BEGIN(Comment);
185     CommentNestLevel = 1;
186     if( ShowComments && MatchedToken!=NONE ) {
187 johnpye 386 Asc_PutCode( zztext, zzout );
188 aw0a 1 }
189     break;
190     }
191     <Comment>\(\*[^*(]* {
192     /* Match "(" followed "*" followed by
193     * anything that's not "(" nor "*".
194     * `anything' includes newlines.
195     * Increase the commment nesting level.
196     * Print if ShowComments is TRUE and
197     * MatchedToken is not NONE.
198     */
199     CommentNestLevel++;
200     if( ShowComments && MatchedToken!=NONE ) {
201 johnpye 386 Asc_PutCode( zztext, zzout );
202 aw0a 1 }
203     break;
204     }
205     <Comment>[^*(]*\*+\) {
206     /* Match anything not "*" or "(" followed
207     * by one or more "*"s followed by ")".
208     * `anything' includes newlines.
209     * This decreases the comment nesting level
210     * and kicks us out if we're back to zero.
211     * Print if ShowComments is TRUE and
212     * MatchedToken is not NONE.
213     */
214     CommentNestLevel--;
215     if( CommentNestLevel > 0 ) {
216     /* more comments */
217     break;
218     }
219     if( MatchedToken == NONE ) {
220     BEGIN(INITIAL);
221     break;
222     }
223     if( ShowComments ) {
224 johnpye 386 Asc_PutCode( zztext, zzout );
225 aw0a 1 }
226     switch( MatchedToken ) {
227     case MODEL:
228     BEGIN(Model);
229     break;
230     case CONSTANT:
231     BEGIN(Constant);
232     break;
233     default:
234     BEGIN(INITIAL);
235     break;
236     }
237     break;
238     }
239     <Comment>[^*(]* |
240     <Comment>\(+[^*(]* |
241     <Comment>\*+[^*()]* {
242     /*
243     * These three rules eat:
244     * -- anything that's not a "*" or a "("
245     * -- "("s not followed by "*"
246     * -- "*"s not followed by ")"
247     * `anything' includes newlines.
248     * Print if ShowComments is TRUE and
249     * MatchedToken is not NONE
250     */
251     if( ShowComments && MatchedToken!=NONE ) {
252 johnpye 386 Asc_PutCode( zztext, zzout );
253 aw0a 1 }
254     break;
255     }
256    
257    
258     /*
259     * Code to handle { Text in Braces }
260     *
261     * "{" puts us into the BracedText state. Braces nest, so
262     * in the BracedText state we need to look for "{" that increases
263     * the nesting level and "}" that will lower it.
264     */
265    
266     <INITIAL>\{ |
267     <Model>\{ |
268     <Constant>\{ {
269     /* A "{" puts us into the BracedText state.
270     * Initialize the nesting level.
271     * Print if MatchedToken is not NONE.
272     *
273     */
274     BEGIN(BracedText);
275     BracesNestLevel = 1;
276     if( MatchedToken != NONE ) {
277 johnpye 386 Asc_PutCode( zztext, zzout );
278 aw0a 1 }
279     break;
280     }
281     <BracedText>[^\\{}]*\\. {
282     /* A backslash \ in the BracedText state
283     * protects any character---even a
284     * newline---and does not affect the
285     * Nesting Level.
286     * Print if MatchedToken is not NONE.
287     */
288     if( MatchedToken != NONE ) {
289 johnpye 386 Asc_PutCode( zztext, zzout );
290 aw0a 1 }
291     break;
292     }
293     <BracedText>[^\\{}]*\\\n {
294     /* A backslash \ in the BracedText state
295     * protects any character---even a
296     * newline---and does not affect the
297     * Nesting Level.
298     * Print if MatchedToken is not NONE.
299     */
300     if( MatchedToken != NONE ) {
301 johnpye 386 Asc_PutCode( zztext, zzout );
302 aw0a 1 }
303     break;
304     }
305     <BracedText>\{[^\\{}]* {
306     /* A "{" in the braces state gets added to
307     * the text and increase the nesting level.
308     * Match any non-brace character---including
309     * newlines---that follows the open brace.
310     * Print if MatchedToken is not NONE.
311     */
312     BracesNestLevel++;
313     if( MatchedToken != NONE ) {
314 johnpye 386 Asc_PutCode( zztext, zzout );
315 aw0a 1 }
316     break;
317     }
318     <BracedText>[^\\{}]*\} {
319     /* A "}" will reduce the nesting level.
320     * If the nesting level is zero, go back to
321     * the previous state. Match any
322     * non-brace character---including
323     * newlines---that precedes the close brace.
324     * Print if MatchedToken is not NONE.
325     */
326     BracesNestLevel--;
327     if (BracesNestLevel > 0) {
328     /* more braced text */
329     break;
330     }
331     if( MatchedToken == NONE ) {
332     BEGIN(INITIAL);
333     break;
334     }
335 johnpye 386 Asc_PutCode( zztext, zzout );
336 aw0a 1 switch( MatchedToken ) {
337     case MODEL:
338     BEGIN(Model);
339     break;
340     case CONSTANT:
341     BEGIN(Constant);
342     break;
343     default:
344     BEGIN(INITIAL);
345     break;
346     }
347     break;
348     }
349     <BracedText>[^\\{}]* {
350     /* Match anything that is not "{" nor "}"
351     * nor "\\"(backslash).
352     * `anything' includes newlines.
353     * Print if MatchedToken is not NONE.
354     */
355     if( MatchedToken != NONE ) {
356 johnpye 386 Asc_PutCode( zztext, zzout );
357 aw0a 1 }
358     break;
359     }
360    
361    
362    
363     /*
364     * Code to check an identifier.
365     *
366     * When we are looking for a MODEL, ATOM, CONSTANT, or DEFIITION
367     * and we find the text [UNIVERSAL]{MODEL|ATOM|CONSTANT|DEFINITION},
368     * we enter this state.
369     *
370     * When we are insided MODEL, ATOM, or DEFINITION and we find
371     * the text END, we enter this state.
372     *
373     * This state checks to see if the text following the MODEL,
374     * ATOM, CONSTANT, DEFINITION, or END keyword matches
375     * `reqType'---the type requested by the user. If so, we are
376     * at the beginning or end of a type, and should change states
377     * accordingly. If not, we should stay in our current state.
378     */
379    
380     <CheckID>{ident} {
381     /*
382     * Found an identifier.
383     * Identify the correct state.
384     */
385     if( MatchedToken == MODEL_END ) {
386     /*
387     * We're in the Model state, print the
388     * text and see if matches reqType, if
389     * so, we're at the end of the MODEL
390     * (or ATOM or DEFINITION)
391 johnpye 386 * and should exit zzlex()---return to
392 aw0a 1 * our caller, else stay in the Model
393     * state.
394     */
395 johnpye 386 Asc_PutCode( zztext, zzout );
396     if(strcmp((zztext+StartId),reqType) == 0) {
397 aw0a 1 return 0;
398     } else {
399     MatchedToken = MODEL;
400     BEGIN(Model);
401     }
402     break;
403     }
404 johnpye 386 if(strcmp((zztext+StartId),reqType)==0){
405 aw0a 1 /*
406     * We're in the INITIAL state, and we
407     * found the beginning of the
408     * requested MODEL, ATOM, CONSTANT,
409     * or DEFINITION.
410     * Print the text and set OutputState to
411     * say we are printing. Start the
412     * appropriate State by checking
413     * MatchedToken.
414     */
415 johnpye 386 Asc_PutCode( zztext, zzout );
416 aw0a 1 switch( MatchedToken ) {
417     case MODEL:
418     BEGIN(Model);
419     break;
420     case CONSTANT:
421     BEGIN(Constant);
422     break;
423     default:
424     /* something is wrong */
425     BEGIN(INITIAL);
426     break;
427     }
428     break;
429     }
430     /*
431     * We're in the INITIAL state; we found
432     * an MODEL, ATOM, CONSTANT, or
433     * DEFINITION, but it wasn't the right
434     * one. Stay in the INITIAL state.
435     */
436     MatchedToken = NONE;
437     BEGIN(INITIAL);
438     break;
439     }
440     <CheckID>. {
441     /*
442     * Some text other than an identifier
443     * was found. Print the text if
444     * MatchedToken is not NONE,
445     * and return to the correct state.
446     */
447     if( MatchedToken == NONE ) {
448     BEGIN(INITIAL);
449     break;
450     }
451 johnpye 386 Asc_PutCode( zztext, zzout );
452 aw0a 1 switch( MatchedToken ) {
453     case MODEL:
454     BEGIN(Model);
455     break;
456     case CONSTANT:
457     BEGIN(Constant);
458     break;
459     default:
460     /* something is wrong */
461     BEGIN(INITIAL);
462     break;
463     }
464     break;
465     }
466    
467    
468    
469     /*
470     * Code to handle the model/atom/definition we want.
471     *
472     * Once we've found the start of the matching MODEL, ATOM, or
473     * DEFINITION, print the text until we find the END token.
474 johnpye 386 * When we find END, save the current length of zztext and use
475 johnpye 390 * MY_YYMORE() to append the identifier, then check the identifier
476 aw0a 1 * (in the CheckID state) to see if it is what we want. If so,
477     * this is the end of this MODEL, ATOM, or DEFINITION.
478     */
479    
480     <Model>{end} {
481     /*
482     * Found the END keyword. Save the
483 johnpye 386 * current location in the zztext array,
484 aw0a 1 * then enter the CheckID state to see if
485     * the identifier matches what we want.
486     */
487 johnpye 386 StartId = zzleng;
488 aw0a 1 MatchedToken = MODEL_END;
489     BEGIN(CheckID);
490 johnpye 390 MY_YYMORE();
491 aw0a 1 break;
492     }
493     <Model>[^({A-Z]+ |
494     <Model>\(+[^*({A-Z]* |
495     <Model>[A-Z_]+;?{ws}* {
496     /*
497     * These rules match
498     * -- any character except that which
499     * would cause us to change states
500     * -- "("s not followed by "*"s
501     * -- uppercase keywords and following
502     * semicolon or whitespace.
503     * Print the text.
504     */
505 johnpye 386 Asc_PutCode( zztext, zzout );
506 aw0a 1 break;
507     }
508    
509    
510    
511     /*
512     * Code to handle the constant definition we want.
513     *
514     * Once we've found the start of the matching CONSTANT, print
515     * the text until we find a semicolon ";".
516     */
517    
518     <Constant>; {
519     /*
520     * Found the ";" which ends the CONSTANT.
521     * Do NOT print it since that will be
522     * added below. Return 0.
523     */
524     return 0;
525     }
526     <Constant>[^({;]+ |
527     <Constant>\(+[^*({;]* {
528     /*
529     * These rules match
530     * -- any character except that which
531     * would cause us to change states
532     * -- "("s not followed by "*"s
533     * Print the text.
534     */
535 johnpye 386 Asc_PutCode( zztext, zzout );
536 aw0a 1 break;
537     }
538    
539    
540    
541     /*
542     * Code to look for [UNIVERSAL ]{MODEL|ATOM|CONSTANT|DEFINITION}.
543     *
544 johnpye 390 * If we find UNIVERSAL, use yymore() to append the next
545 aw0a 1 * keyword---probably MODEL, ATOM, or CONSTANT.
546     * If we find MODEL, ATOM, CONSTANT, or DEFINITION save the
547 johnpye 390 * current length and use yymore() to append the identifier,
548 aw0a 1 * then check the identifier (in the CheckID state) to see if
549     * it is what we're looking for.
550     */
551    
552     <INITIAL>{univ} {
553     /*
554     * Found the UNIVERSAL keyword. Append
555     * the following ATOM/MODEL/CONSTANT
556     * keyword.
557     */
558 johnpye 390 MY_YYMORE();
559 aw0a 1 break;
560     }
561     <INITIAL>{model} |
562     <INITIAL>{atom} |
563     <INITIAL>{definition} {
564     /*
565     * Found an MODEL, ATOM, or DEFINITION
566     * keyword--perhaps with a UNIVERSAL
567     * modifier. Save the current location
568 johnpye 386 * in the zztext array, then enter the
569 aw0a 1 * CheckID state to see if the identifier
570     * matches what we want.
571     */
572 johnpye 386 StartId = zzleng;
573 aw0a 1 MatchedToken = MODEL;
574     BEGIN(CheckID);
575 johnpye 390 MY_YYMORE();
576 aw0a 1 break;
577     }
578     <INITIAL>{constant} {
579     /*
580     * Found a CONSTANT keyword--perhaps
581     * with a UNIVERSAL modifier. Save the
582 johnpye 386 * current location in the zztext array,
583 aw0a 1 * then enter the CheckID state to see if
584     * the identifier matches what we want.
585     */
586 johnpye 386 StartId = zzleng;
587 aw0a 1 MatchedToken = CONSTANT;
588     BEGIN(CheckID);
589 johnpye 390 MY_YYMORE();
590 aw0a 1 break;
591     }
592    
593    
594    
595     /*
596     * Rules to match other text.
597     */
598    
599    
600     <INITIAL>[^({A-Z]+ |
601     <INITIAL>\(+[^*({A-Z]* |
602     <INITIAL>[A-Z_]+;?{ws}* {
603     /*
604     * These rules match
605     * -- any character except that which
606     * would cause us to change states
607     * -- "("s not followed by "*"s
608     * -- uppercase keywords and following
609     * semicolon or whitespace.
610     * Do nothing.
611     */
612     break;
613     }
614     <INITIAL><<EOF>> {
615     /*
616     * Reached End of file without a match
617     */
618     return 1;
619     }
620    
621    
622     %%
623     /*
624 johnpye 386 * int zzwrap(void);
625 aw0a 1 *
626     * This returns 1 if the scanner should stop parsing, or 0 if
627     * the scanner should continue. Flex requires this function
628 johnpye 386 * unless the flex directive `%option nozzwrap' is given, but
629 aw0a 1 * `%option' directives are a recent addition to flex and for
630     * maximum portability should not be used.
631     */
632 johnpye 386 int zzwrap(void)
633 aw0a 1 {
634     return 1;
635     }
636    
637    
638     #ifndef TYPER_TEST
639     STDHLF(Asc_ExtractType,(Asc_ExtractTypeHL1,Asc_ExtractTypeHL2,HLFSTOP));
640     #endif
641    
642     /*
643     * int Asc_ExtractType(cdata, interp, argc, argv)
644     * ClientData cdata; --Tcl information, not used
645     * Tcl_Interp *interp; --Tcl interpreter, not used in standalone use
646     * int argc; --the number of arguments
647     * char **argv; --the array of arguments
648     *
649     * When running as part of ASCEND, returns TCL_OK or TCL_ERROR.
650     * When running as a stand alone tool (CPP macro TYPER_TEST is defined)
651     * we return:
652     * 0 --success
653     * 1 --problems with arguments
654     * 2 --problems opening file
655     * -1 --no errors occurred but the requested type was not found
656     *
657     */
658     extern int Asc_ExtractType(ClientData cdata, Tcl_Interp *interp,
659     int argc, CONST84 char **argv)
660     {
661     int ndx = 1; /* index into the argv array */
662 johnpye 386 int result; /* result from zzlex and value to return to caller */
663 aw0a 1 #ifndef TYPER_TEST
664     struct TypeDescription *desc=NULL;
665     struct module_t *mod=NULL;
666     CONST char *scanstring=NULL;
667     YY_BUFFER_STATE oldbuf=NULL;
668     YY_BUFFER_STATE scanbuf=NULL;
669     #endif /*!typertest*/
670    
671     (void)cdata; /* stop gcc whining about unused parameter */
672     #ifdef TYPER_TEST
673     (void)interp; /* stop gcc whining about unused parameter */
674     #endif
675    
676    
677     /*
678     * Reset our global set
679     */
680     BEGIN( INITIAL );
681     MatchedToken = NONE;
682     ShowComments = 0;
683     reqType = "";
684     CommentNestLevel = 0;
685     BracesNestLevel = 0;
686    
687    
688     /*
689     * Process the arguments
690     */
691     if (( argc < 2 ) || ( argc > 5 )) {
692     #ifdef TYPER_TEST
693     FPRINTF(ASCERR,
694     "Wrong number of arguments\n"
695     "Usage: %s [-c] type [source_file] [destination_file]\n",
696     argv[0]);
697     return 1;
698     #else /* ! TYPER_TEST */
699     Tcl_AppendResult(interp, "Wrong number of arguments\nUsage: ",
700     argv[0], "[-c] type [source_file] "
701     "[-s,destination_file]",
702     (char*)NULL);
703     return TCL_ERROR;
704     #endif /* TYPER_TYPER */
705     }
706    
707     if(( argc > ndx ) && ( argv[ndx][0] == '-' )) {
708     switch( argv[ndx][1] ) {
709     case 'c':
710     ShowComments = 1;
711     ndx++;
712     break;
713     default:
714     #ifdef TYPER_TEST
715     FPRINTF(ASCERR, "Unknown switch %s\n", argv[ndx]);
716     return 1;
717     #else /* ! TYPER_TEST */
718     Tcl_AppendResult(interp, "Unknown switch ", argv[ndx], (char*)NULL);
719     return TCL_ERROR;
720     #endif /* TYPER_TEST */
721     }
722     }
723    
724     if( argc > ndx ) {
725     /* The type of MODEL/ATOM to get */
726     reqType = QUIET(argv[ndx++]);
727     } else {
728     #ifdef TYPER_TEST
729     FPRINTF(ASCERR,
730     "Wrong number of arguments\n"
731     "Usage: %s [-c] type [source_file] [destination_file]\n",
732     argv[0]);
733     return 1;
734     #else /* ! TYPER_TEST */
735     Tcl_AppendResult(interp, "Wrong number of arguments\nUsage: ",
736     argv[0], "[-c] type [source_file] "
737     "[-s,destination_file]",
738     (char*)NULL);
739     return TCL_ERROR;
740     #endif /* TYPER_TEST */
741     }
742    
743     if( argc > ndx ) {
744     /* The source file; stdin if not specified. */
745     #ifndef TYPER_TEST
746     /* in ascend, find source module if possible for string module name */
747     desc = FindType(AddSymbol(reqType));
748     if (desc != NULL) {
749     mod = GetModule(desc);
750     assert(mod!=NULL);
751     scanstring = Asc_ModuleString(mod);
752     if (scanstring == NULL) {
753     mod = NULL;
754     }
755     }
756     #endif /*!typertest*/
757 johnpye 386 if(scanstring == NULL && (zzin = fopen(argv[ndx],"r")) == NULL) {
758 aw0a 1 #ifdef TYPER_TEST
759     FPRINTF(ASCERR, "Error opening source file \'%s\'\n", argv[ndx]);
760     return 2;
761     #else /* ! TYPER_TEST */
762     Tcl_AppendResult(interp, "Error opening source file \'",
763     argv[ndx], "\'", (char*)NULL);
764     return TCL_ERROR;
765     #endif /* TYPER_TEST */
766     }
767     ndx++;
768     } else {
769 johnpye 386 zzin = stdin;
770 aw0a 1 }
771    
772     if( argc > ndx ) {
773     #ifndef TYPER_TEST
774     if (argv[ndx][0] == '-' && argv[ndx][1] == 's') {
775 johnpye 386 g_zz_interp = interp;
776     zzout = NULL;
777 aw0a 1 } else {
778     #endif /* !typertest*/
779 johnpye 386 g_zz_interp = NULL;
780 aw0a 1 /* The destination file; stdout if not specified */
781 johnpye 386 if((zzout = fopen(argv[ndx],"a+")) == NULL) {
782 aw0a 1 #ifdef TYPER_TEST
783     FPRINTF(ASCERR, "Error opening destination file \'%s\'\n", argv[ndx]);
784     return 2;
785     #else /* ! TYPER_TEST */
786     Tcl_AppendResult(interp, "Error opening destination file \'",
787     argv[ndx], "\'", (char*)NULL);
788     return TCL_ERROR;
789     #endif /* TYPER_TEST */
790     }
791     #ifndef TYPER_TEST
792     }
793     #endif /* !typertest*/
794     ndx++;
795     } else {
796 johnpye 386 zzout = stdout;
797 aw0a 1 }
798    
799    
800     /*
801 johnpye 386 * Call zzlex() to process the input
802 aw0a 1 */
803     #ifndef TYPER_TEST
804     if (scanstring != NULL) {
805     oldbuf = YY_CURRENT_BUFFER;
806 johnpye 386 scanbuf = zz_scan_string(scanstring);
807     zz_switch_to_buffer(scanbuf);
808 aw0a 1 BEGIN(INITIAL);
809 johnpye 386 /* zzrestart((FILE *)NULL); */
810 aw0a 1 }
811     #else
812 johnpye 386 zzrestart(zzin);
813 aw0a 1 #endif /* !typertest */
814 johnpye 386 if( (result = zzlex()) != 0 ) {
815 aw0a 1 #ifdef TYPER_TEST
816     FPRINTF(ASCERR, "Could not find type \'%s\'\n", reqType);
817     #else /* ! TYPER_TEST */
818 johnpye 386 if (g_zz_interp!=NULL) {
819 aw0a 1 Tcl_ResetResult(interp);
820     }
821     Tcl_AppendResult(interp, "Could not find type \'", reqType, "\'",
822     (char*)NULL);
823     result = TCL_ERROR;
824     #endif /* TYPER_TEST */
825     } else {
826     /* add a closing semicolon and newline */
827 johnpye 386 Asc_PutCode( ";\n", zzout );
828 aw0a 1 #ifndef TYPER_TEST
829     result = TCL_OK;
830     #endif /* ! TYPER_TEST */
831     }
832    
833     /*
834     * Close any files/buffers we opened and exit.
835     */
836     #ifndef TYPER_TEST
837     if (scanstring != NULL) {
838 johnpye 386 zz_delete_buffer(YY_CURRENT_BUFFER);
839     zz_switch_to_buffer(oldbuf);
840 aw0a 1 BEGIN(INITIAL);
841     }
842     #endif
843 johnpye 386 if ( zzin != stdin && zzin != NULL) {
844     fclose(zzin);
845 aw0a 1 }
846 johnpye 386 if ( zzout != stdout && zzout != NULL) {
847     fclose(zzout);
848 aw0a 1 }
849    
850     return result;
851     }
852    
853     void Asc_PutCode(char *s,FILE *fp)
854     {
855     #ifndef TYPER_TEST
856 johnpye 386 if (g_zz_interp != NULL) {
857     Tcl_AppendResult(g_zz_interp,s,(char *)NULL);
858 aw0a 1 } else {
859     #endif /* typertest */
860     fputs(s,fp);
861     #ifndef TYPER_TEST
862     }
863     #endif /* typertest */
864     }
865    
866     #ifdef TYPER_TEST
867     int main(int argc, char **argv)
868     {
869     return Asc_ExtractType((ClientData)NULL, (Tcl_Interp*)NULL, argc, argv);
870     }
871     #endif /* TYPER_TEST */

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