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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

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